From 97ed1fe6523255c40eb460faca74565a9d4a5ffb Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 May 2023 09:36:49 +0200 Subject: [PATCH 001/135] addition of BLOM logic to key XML settings like CPL_SEQ_OPTION --- cime_config/config_component_cesm.xml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index dbf3b11e3..18bec3d7f 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -190,6 +190,7 @@ 24 24 + 24 @@ -198,6 +199,7 @@ 24 144 24 + 24 24 @@ -236,9 +238,8 @@ 1 - + - 24 48 run_coupling @@ -286,6 +287,8 @@ 48 1 24 + 24 + 48 run_coupling env_run.xml @@ -335,11 +338,13 @@ 1 $ATM_NCPL + $ATM_NCPL $ATM_NCPL $ATM_NCPL 1 8 8 + 8 $ATM_NCPL 1 $ATM_NCPL @@ -361,7 +366,6 @@ where basedt is equal to NCPL_BASE_PERIOD in seconds. - @@ -421,6 +425,7 @@ OPTION2 OPTION2 OPTION1 + OPTION1 OPTION1 OPTION1 OPTION2 From 48c247fbd59a545cbb06f11f451fb9b14c11d816 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 May 2023 14:49:08 +0200 Subject: [PATCH 002/135] made ogrid default for aoflux calculation - since xgrid crashes for f19_tnx1v4 --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5812542d6..bfe991383 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,7 +927,7 @@ default: ogrid - xgrid + ogrid From 4fffe1b5713d23c9c032419f7c8c9e6ff515982f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 15 Jun 2023 22:07:27 +0200 Subject: [PATCH 003/135] changes to have mediator compute dms fluxes --- cime_config/buildnml | 1 + cime_config/config_component_cesm.xml | 7 +- cime_config/namelist_definition_drv.xml | 24 ++++-- mediator/esmFlds.F90 | 3 +- mediator/esmFldsExchange_cesm_mod.F90 | 37 +++++++++ mediator/fd_cesm.yaml | 37 +++++++-- mediator/med_phases_aofluxes_mod.F90 | 99 +++++++++++++++++++++---- 7 files changed, 179 insertions(+), 29 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 32be8ead4..e11eb5009 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -51,6 +51,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["mask_grid"] = case.get_value("MASK_GRID") config["rest_option"] = case.get_value("REST_OPTION") config["comp_ocn"] = case.get_value("COMP_OCN") + config["COMPSET"] = case.get_value("COMPSET") atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 18bec3d7f..273954ee1 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -102,7 +102,7 @@ char - none,CO2A,CO2B,CO2C + none,CO2A,CO2B,CO2C,CO2C:DMS,CO2A:DMS none CO2A @@ -115,6 +115,11 @@ CO2A CO2C CO2C + CO2C:DMS + CO2A:DMS + CO2A:DMS + CO2A + CO2A CO2A CO2A diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index bfe991383..9e97f4a71 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2387,10 +2387,9 @@ .false. - .true. + .true. - logical flds @@ -2402,10 +2401,9 @@ .false. - .true. + .true. - logical flds @@ -2417,7 +2415,23 @@ .false. - .true. + .true. + + + + + logical + flds + ALLCOMP_attributes + + Pass DMS flux computed in MED to both ATM and OCN + Set this by setting the xml variable BGC_MODE. + If BGC_MODE has 'DMSmed', then DMSmed will be set to .true. + + + .false. + .true. + .true. diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index bcb3d5471..c7bd2337a 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -793,7 +793,8 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then - write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",associated(fldnames), allocated(fields%mapindex) + write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",& + associated(fldnames), allocated(fields%mapindex) call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) if(present(rc)) rc = ESMF_FAILURE return diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..233140c76 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3288,6 +3288,43 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif + !===================================================================== + ! DMS EXCHANGE + !===================================================================== + + ! Get dms concentration from ocn and compute dms flux in mediator and send to both atm and ocn + if (phase == 'advertise') then + call addfld_aoflux('Faox_dms') + call addfld_from(compocn, 'So_dms') + call addfld_to(compocn, 'Faox_dms') + call addfld_to(compatm, 'Faxx_dms') + else + ! TODO: this assumes that the aoflux grid is always the ocean + ! need to generalize this + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then + call addmrg_to(compatm , 'Faxx_dms', & + mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') + end if + if ( fldchk(is_local%wrap%FBexp(compocn), 'Faox_dms', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc) ) then + call addmrg_to(compocn, 'Faox_dms', & + mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + + ! Get dms flux from ocn and send to atm (this is a deprecated functionality - only used for testing now) + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_dms') + call addfld_to(compatm, 'Faxx_dms') + else + ! Note that Faoo_dmds should not be weighted by ifrac - since + ! it will be weighted by ifrac in the merge to the atm + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then + call addmrg_to(compatm , 'Faxx_dms', & + mrg_from=compmed, mrg_fld='Faoo_dms', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index c09a63c58..5ee8c185d 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -30,21 +30,17 @@ - standard_name: Faox_lwup alias: mean_up_lw_flx_ocn canonical_units: W m-2 - description: mediator export - long wave radiation flux over the ocean + description: long wave radiation flux over the ocean computed in mediator # - standard_name: Faox_taux alias: stress_on_air_ocn_zonal canonical_units: N m-2 - description: mediator export + description: zonal stress on ocean/air computed in mediator # - standard_name: Faox_tauy alias: stress_on_air_ocn_merid canonical_units: N m-2 - description: mediator export - # - - standard_name: area - canonical_units: radians**2 - description: mediator area for component + description: meridional stress on ocean/air computed in mediator # #----------------------------------- # section: land export @@ -1203,3 +1199,30 @@ # - standard_name: mask canonical_units: 1 + # + - standard_name: area + canonical_units: radians**2 + description: mediator area for component + # + #----------------------------------- + # section: dms exchange + #----------------------------------- + # + - standard_name: So_dms + canonical_units: nmol L-1 + description: DMS uppoer ocean concentration + # + - standard_name: Faoo_dms + alias: surface_upward_flux_of_dimethyl_sulfide + canonical_units: moles m-2 s-1 + description: Surface flux of DMS computed in ocean + # + - standard_name: Faox_dms + alias: surface_upward_flux_of_dimethyl_sulfide + canonical_units: moles m-2 s-1 + description: Surface flux of DMS computed in mediator + # + - standard_name: Faxx_dms + alias: surface_upward_flux_of_dimethyl_sulfide + canonical_units: moles m-2 s-1 + description: merged surface flux of DMS to atm diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 48055e92e..5e48b6673 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -74,9 +74,11 @@ module med_phases_aofluxes_mod ! Private data !-------------------------------------------------------------------------- - logical :: flds_wiso ! use case + logical :: flds_wiso ! use case + logical :: compute_atm_dens logical :: compute_atm_thbot + logical :: compute_dms_flux integer :: ocn_surface_flux_scheme ! use case character(len=CS), pointer :: fldnames_ocn_in(:) @@ -109,6 +111,8 @@ module med_phases_aofluxes_mod real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio + real(R8) , pointer :: dms_ocn (:) => null() ! ocn dms concentration + ! input: atm real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal @@ -125,6 +129,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux + ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell @@ -149,6 +154,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq + real(R8) , pointer :: dms (:) => null() ! ocn-> atm dms flux (optional) end type aoflux_out_type character(*), parameter :: u_FILE_u = & @@ -229,8 +235,8 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (maintask) then - write(logunit,'(a)') trim(subname)//' initializing FB for '// & - trim(compname(compatm))//'_'//trim(compname(compocn)) + write(logunit,'(a)') trim(subname)//' initialized FB for '// & + trim(compname(compatm))//'->'//trim(compname(compocn)) end if ! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed @@ -244,8 +250,8 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (maintask) then - write(logunit,'(a)') trim(subname)//' initializing FB for '// & - trim(compname(compocn))//'_'//trim(compname(compatm)) + write(logunit,'(a)') trim(subname)//' initialized FB for '// & + trim(compname(compocn))//'->'//trim(compname(compatm)) end if end if @@ -415,6 +421,15 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) compute_atm_dens = .true. end if + ! Determine if dms flux will be computed in mediator + if ( FB_fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc ) .and. & + ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faox_dms', rc=rc) .or. & + FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_dms', rc=rc) ) ) then + compute_dms_flux = .true. + else + compute_dms_flux = .false. + end if + !---------------------------------- ! Initialize aoflux !---------------------------------- @@ -968,16 +983,24 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables - type(InternalState) :: is_local - integer :: n ! indices - real(r8), parameter :: qmin = 1.0e-8_r8 - real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa - real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure - real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg - integer :: maptype - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - character(*),parameter :: subName = '(med_aofluxes_update) ' + type(InternalState) :: is_local + integer :: n ! indices + real(r8), parameter :: qmin = 1.0e-8_r8 + real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa + real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure + real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + real(r8) :: sst_c + real(r8) :: scdms + real(r8) :: kwdms + real(r8), pointer :: odms(:) + real(r8), pointer :: sst(:) + real(r8), pointer :: u10m(:) + real(r8), pointer :: flux_dms(:) + real(r8), parameter :: Xconvxa= 6.97e-07 ! Wanninkhof's a=0.251 converted to ms-1/(ms-1)^2 + character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1151,6 +1174,43 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! compute DMS fluxes to atm and ocn + if (is_local%wrap%aoflux_grid == 'ogrid') then + if (compute_dms_flux) then + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_dms', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, farrayptr=odms, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_t', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, farrayptr=sst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'So_u10', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, farrayptr=u10m, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_dms', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_src, farrayptr=flux_dms, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! flux_dms from ocean is in kg/m2/s + ! flux is downwards positive - therefore negative values to the atmosphere (this is the opposite of what is there in BLOM) + do n = 1,size(sst) + sst_c = sst(n) - 273.15_r8 + sst_c = min(40.,max(-3.,sst_c)) + scdms = 2855.7+ (-177.63 + (6.0438 + (-0.11645 + 0.00094743*sst_c)*sst_c)*sst_c)*sst_c + kwdms = Xconvxa * u10m(n)**2 * (660./scdms)**0.5 + flux_dms(n) = -62.13 *kwdms * odms(n) + end do + + end if + end if + call t_stopf('MED:'//subname) end subroutine med_aofluxes_update @@ -1663,6 +1723,11 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r allocate(aoflux_in%roce_HDO(aoflux_in%lsize)); aoflux_in%roce_HDO(:) = 0._R8 end if + if ( compute_dms_flux) then + call fldbun_getfldptr(fldbun_o, 'So_dms', aoflux_in%dms_ocn, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end subroutine set_aoflux_in_pointers !================================================================================ @@ -1716,6 +1781,10 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if + if (compute_dms_flux) then + call fldbun_getfldptr(fldbun, 'Faox_dms', aoflux_out%dms, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end subroutine set_aoflux_out_pointers From 9d3b1049bee04e324a15e801ffd3295c50184901 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 16 Jun 2023 12:58:48 +0200 Subject: [PATCH 004/135] added BGC mode to DMS qualifier --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 9e97f4a71..8b1a0d6fe 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2430,7 +2430,7 @@ .false. - .true. + .true. .true. From abbcf7e8d2c2d07c896a9584648399f648a55366 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 16 Jun 2023 13:02:24 +0200 Subject: [PATCH 005/135] added more comments --- cime_config/config_component_cesm.xml | 32 ++++++++++++++------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 273954ee1..f225f92a3 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -65,13 +65,13 @@ env_run.xml integer indicating maximum detail level to profile. This xml - variable is used to set the namelist variable - timing_detail_limit. This namelist variable is used by perf_mod + variable is used to set the config variable + timing_detail_limit. This config variable is used by perf_mod (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off and on depending on calls to the routine t_adj_detailf. If in the code a statement appears like t_adj_detailf(+1), then the current timer detail level is incremented by 1 and compared to the - time_detail_limit obtained from the namelist. If the limit is + time_detail_limit obtained from the config. If the limit is exceeded then the timer is turned off. @@ -127,22 +127,24 @@ env_run.xml Activates additional CO2-related fields to be exchanged between components. Possible values are: - CO2A: sets the driver namelist variable flds_co2a = .true.; this adds + CO2A: sets nuopc.runconfig variable flds_co2a = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean. - CO2B: sets the driver namelist variable flds_co2b = .true.; this adds + CO2B: sets nuopc.runconfig variable flds_co2b = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere just to the land, and the surface upward flux of CO2 to be sent from the land back to the atmosphere - CO2C: sets the driver namelist variable flds_co2c = .true.; this adds + CO2C: sets nuopc.runconfig variable flds_co2c = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean, and the surface upward flux of CO2 to be sent from the land and the open ocean back to the atmosphere. - The namelist variables flds_co2a, flds_co2b and flds_co2c are in the - namelist group cpl_flds_inparm. + DMS: sets nuopc.runconfig variable flds_dms_med = .true.; this adds + turns on the computation of DMS flux in the mediator and that flux is passed back to both the + ocean (if prognostic) and the atm (if prognostic) + @@ -169,7 +171,7 @@ hour Base period associated with NCPL coupling frequency. - This xml variable is only used to set the driver namelist variables, + This xml variable is only used to set the driver config variables, atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. @@ -250,7 +252,7 @@ run_coupling env_run.xml Number of atm coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, + This is used to set the driver config atm_cpl_dt, equal to basedt/ATM_NCPL, where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -263,7 +265,7 @@ run_coupling env_run.xml Number of land coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, + This is used to set the driver config atm_cpl_dt, equal to basedt/LND_NCPL, where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -276,7 +278,7 @@ run_coupling env_run.xml Number of ice coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL + This is used to set the driver config ice_cpl_dt, equal to basedt/ICE_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -298,7 +300,7 @@ run_coupling env_run.xml Number of ocn coupling intervals per NCPL_BASE_PERIOD. - Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL + Thisn is used to set the driver config ocn_cpl_dt, equal to basedt/OCN_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -357,7 +359,7 @@ run_coupling env_run.xml Number of rof coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL + This is used to set the driver config rof_cpl_dt, equal to basedt/ROF_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -367,7 +369,7 @@ run_coupling env_run.xml Number of wav coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL + This is used to set the driver config wav_cpl_dt, equal to basedt/WAV_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. From 139664470e61c22fca5732a003208b7ed9426526 Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 16 Jun 2023 13:30:51 +0200 Subject: [PATCH 006/135] fixed an issue in the PR --- cime_config/config_component_cesm.xml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index f225f92a3..11ed35c3d 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -113,15 +113,16 @@ CO2A CO2A CO2A - CO2C - CO2C CO2C:DMS CO2A:DMS - CO2A:DMS + DMS CO2A CO2A CO2A CO2A + + CO2C + CO2C run_coupling env_run.xml From 7defa6e86ab6ac04e4399171fd4ad53c1df2ad6a Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 19 Jun 2023 14:43:24 +0200 Subject: [PATCH 007/135] addressed issues in PR --- mediator/esmFldsExchange_cesm_mod.F90 | 28 ++++++--- mediator/fd_cesm.yaml | 9 +-- mediator/med_phases_aofluxes_mod.F90 | 91 +++++++++++++++++++++++---- 3 files changed, 99 insertions(+), 29 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 233140c76..66dc57cdb 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3299,20 +3299,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to(compocn, 'Faox_dms') call addfld_to(compatm, 'Faxx_dms') else - ! TODO: this assumes that the aoflux grid is always the ocean - ! need to generalize this - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then - call addmrg_to(compatm , 'Faxx_dms', & - mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') - end if - if ( fldchk(is_local%wrap%FBexp(compocn), 'Faox_dms', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc) ) then - call addmrg_to(compocn, 'Faox_dms', & - mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + ! TODO: extend this to to agrid and xgrid + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then + call addmrg_to(compatm , 'Faxx_dms', & + mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') + end if + if ( fldchk(is_local%wrap%FBexp(compocn), 'Faox_dms', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc) ) then + call addmrg_to(compocn, 'Faox_dms', & + mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') + end if + else + call ESMF_LogWrite(trim(subname)//& + ": only ogrid has been enabled for dms flux computation", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return end if end if ! Get dms flux from ocn and send to atm (this is a deprecated functionality - only used for testing now) + ! TODO: remove this if (phase == 'advertise') then call addfld_from(compocn, 'Faoo_dms') call addfld_to(compatm, 'Faxx_dms') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 5ee8c185d..1ca17feb4 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1213,16 +1213,13 @@ description: DMS uppoer ocean concentration # - standard_name: Faoo_dms - alias: surface_upward_flux_of_dimethyl_sulfide canonical_units: moles m-2 s-1 - description: Surface flux of DMS computed in ocean + description: Surface flux of DMS computed in ocean (downward positive) # - standard_name: Faox_dms - alias: surface_upward_flux_of_dimethyl_sulfide canonical_units: moles m-2 s-1 - description: Surface flux of DMS computed in mediator + description: Surface flux of DMS computed in mediator (downward positive) # - standard_name: Faxx_dms - alias: surface_upward_flux_of_dimethyl_sulfide canonical_units: moles m-2 s-1 - description: merged surface flux of DMS to atm + description: merged surface flux of DMS to atm (downward positive) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 5e48b6673..8837b9987 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -35,9 +35,15 @@ module med_phases_aofluxes_mod #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH use ufs_const_mod , only : pi => SHR_CONST_PI -#else + use ufs_const_mod , only : tfrz => SHR_CONST_TKFRZ + use ufs_const_mod , only : rdair => SHR_CONST_RDAIR + use ufs_const_mod , only : cpdair => SHR_CONST_CPDAIR +#ELSE use shr_const_mod , only : rearth => SHR_CONST_REARTH use shr_const_mod , only : pi => SHR_CONST_PI + use shr_const_mod , only : tfrz => SHR_CONST_TKFRZ + use shr_const_mod , only : rdair => SHR_CONST_RDAIR + use shr_const_mod , only : cpdair => SHR_CONST_CPDAIR #endif implicit none @@ -74,6 +80,8 @@ module med_phases_aofluxes_mod ! Private data !-------------------------------------------------------------------------- + real(r8), parameter :: rcp = rdair/cpdair ! gas constant of air / specific heat capacity at a constant pressure + logical :: flds_wiso ! use case logical :: compute_atm_dens @@ -984,11 +992,10 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! ! Local variables type(InternalState) :: is_local - integer :: n ! indices - real(r8), parameter :: qmin = 1.0e-8_r8 - real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa - real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure - real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: n ! indices + real(r8), parameter :: qmin = 1.0e-8_r8 ! minimum + real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa + real(r8), parameter :: Xconvxa= 6.97e-07 ! Wanninkhof's a=0.251 converted to ms-1/(ms-1)^2 integer :: maptype type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst @@ -999,7 +1006,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), pointer :: sst(:) real(r8), pointer :: u10m(:) real(r8), pointer :: flux_dms(:) - real(r8), parameter :: Xconvxa= 6.97e-07 ! Wanninkhof's a=0.251 converted to ms-1/(ms-1)^2 character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- @@ -1175,8 +1181,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if ! compute DMS fluxes to atm and ocn - if (is_local%wrap%aoflux_grid == 'ogrid') then - if (compute_dms_flux) then + if (compute_dms_flux) then + if (is_local%wrap%aoflux_grid == 'ogrid') then + ! TODO: extend this to to agrid and xgrid call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_dms', field=field_src, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1199,15 +1206,73 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! flux_dms from ocean is in kg/m2/s - ! flux is downwards positive - therefore negative values to the atmosphere (this is the opposite of what is there in BLOM) + ! flux is downwards positive - therefore negative values to + ! the atmosphere (this is the opposite of what is there in BLOM) + ! The following comes from the BLOM/iHAMOCC routine carchm.F90 + ! See https://noresm-docs.readthedocs.io/en/noresm2/model-description/ocn_bgc_model.html do n = 1,size(sst) - sst_c = sst(n) - 273.15_r8 - sst_c = min(40.,max(-3.,sst_c)) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + sst_c = sst(n) - tfrz + sst_c = min(40.,max(-3., sst_c)) scdms = 2855.7+ (-177.63 + (6.0438 + (-0.11645 + 0.00094743*sst_c)*sst_c)*sst_c)*sst_c kwdms = Xconvxa * u10m(n)**2 * (660./scdms)**0.5 flux_dms(n) = -62.13 *kwdms * odms(n) end do - + else + call ESMF_LogWrite(trim(subname)//& + ": only ogrid has been enabled for dms flux computation", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return end if end if From 37f203f8f4466989acb9673d7df4c7868bfe3695 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 19 Jun 2023 15:45:23 +0200 Subject: [PATCH 008/135] removed blank spaces --- mediator/med_phases_aofluxes_mod.F90 | 50 ---------------------------- 1 file changed, 50 deletions(-) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 8837b9987..b46c4e9ab 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -1211,56 +1211,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! The following comes from the BLOM/iHAMOCC routine carchm.F90 ! See https://noresm-docs.readthedocs.io/en/noresm2/model-description/ocn_bgc_model.html do n = 1,size(sst) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sst_c = sst(n) - tfrz sst_c = min(40.,max(-3., sst_c)) scdms = 2855.7+ (-177.63 + (6.0438 + (-0.11645 + 0.00094743*sst_c)*sst_c)*sst_c)*sst_c From b199f43609747a5d1c28305c90d8d2c8a03120db Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 17 Jul 2023 13:19:34 +0200 Subject: [PATCH 009/135] addition of atm_ncpl for ww3dev --- cime_config/config_component_cesm.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 18bec3d7f..6d84da68e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -241,6 +241,10 @@ 48 + + + + 72 run_coupling env_run.xml From 621620f008b4db12b918c5a801ec2f04075f139b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 17 Jul 2023 14:09:05 +0200 Subject: [PATCH 010/135] added comment suggest in PR review --- cime_config/config_component_cesm.xml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 6d84da68e..5d0e121a9 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -242,7 +242,12 @@ 48 - + + + + + + 72 From e93174f6f9728c421184c6eb9b9b25f8212d7c6f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 12 Oct 2023 12:23:00 +0200 Subject: [PATCH 011/135] added to fields from ww3dev for mediator history output --- cime_config/namelist_definition_drv.xml | 68 +++++++++++++++++++++++++ mediator/esmFldsExchange_cesm_mod.F90 | 15 ++++++ mediator/fd_cesm.yaml | 37 +++++++++++++- 3 files changed, 119 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8b1a0d6fe..9f058a891 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2080,6 +2080,74 @@ + + + + + + logical + aux_hist + MED_attributes + Auxiliary mediator wav2med average history output every day. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator wav2med average history output every day. + + Sw_hs:Sw_wlm:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + wav.24h.avg + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 30 + + + diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 66dc57cdb..59858cf49 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2263,6 +2263,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + !----------------------------- + ! from wav: for auxiliary purposes only + !----------------------------- + if (phase == 'advertise') then + call addfld_from(compwav, 'Sw_hs') + call addfld_from(compwav, 'Sw_wlm') + call addfld_from(compwav, 'Sw_thm') + call addfld_from(compwav, 'Sw_thp0') + call addfld_from(compwav, 'Sw_fp0') + call addfld_from(compwav, 'Sw_u') + call addfld_from(compwav, 'Sw_v') + call addfld_from(compwav, 'Sw_tusx') + call addfld_from(compwav, 'Sw_tusy') + end if + !----------------------------- ! to ocn: Langmuir multiplier from wave !----------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 1ca17feb4..7febde854 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1165,7 +1165,42 @@ - standard_name: Sw_pstokes_y canonical_units: m/s description: Northward partitioned stokes drift components - + # + - standard_name: Sw_hs + canonical_units: m + description: Significant wave hight (only needed for mediatory history output) + # + - standard_name: Sw_wlm + canonical_units: m + description: Mean wave length (only needed for mediatory history output) + # + - standard_name: Sw_thm + canonical_units: unitless + description: Mean wave direction (only needed for mediatory history output) + # + - standard_name: Sw_thp0 + canonical_units: unitless + description: Peak wave direction (only needed for mediatory history output) + # + - standard_name: Sw_fp0 + canonical_units: 1/s + description: Peak wave frequency (only needed for mediatory history output) + # + - standard_name: Sw_u + canonical_units: m/s + description: Surface wind zonal (only needed for mediatory history output) + # + - standard_name: Sw_v + canonical_units: m/s + description: Surface wind meridional (only needed for mediatory history output) + # + - standard_name: Sw_tusx + canonical_units: m2/s + description: Stokes zonal transport vector (only needed for mediatory history output) + # + - standard_name: Sw_tusy + canonical_units: m2/s + description: Stokes meridional transport vector (only needed for mediatory history output) # - standard_name: Sw_elevation_spectrum alias: wave_elevation_spectrum From a834c1f38d61602520fecee8fc60d5071feb373d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 16 Oct 2023 10:32:38 +0200 Subject: [PATCH 012/135] changes needed to merge cime to latest changes --- cime_config/config_component.xml | 42 +++++++++++++++++++++++-- cime_config/namelist_definition_drv.xml | 11 +++++++ 2 files changed, 51 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f986cfad2..a329be743 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -784,6 +784,34 @@ If TRUE, the component libraries are always built with OpenMP capability. + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu type enabled + + + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu offload method enabled + + + + char + + + build_def + env_build.xml + If set will attach this script to the MPI run command, mapping + different MPI ranks to different GPUs within the same compute node + + logical TRUE,FALSE @@ -1798,12 +1826,22 @@ pes or cores per node for accounting purposes + + integer + 0 + + 1 + + mach_pes_last + env_mach_pes.xml + Number of CPU cores per GPU node used for simulation + + integer 0 - 1 - 1 + 1 mach_pes env_mach_pes.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8b1a0d6fe..6f88c723a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -716,6 +716,17 @@ $ESMF_VERBOSITY_LEVEL + + logical + performance + MED_attributes + + Check for NaN values in fields returned from mediator to components. This has a small performance impact. + + + .true. + + integer control From be61af7af1e95e8169ee807688b687b17e28a6a6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 16 Oct 2023 10:41:35 +0200 Subject: [PATCH 013/135] addressed issues in PR review --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8980eae40..8c2f883ca 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2092,14 +2092,14 @@ - + logical aux_hist MED_attributes - Auxiliary mediator wav2med average history output every day. + Auxiliary mediator wav2med file1 output enabled if true .false. @@ -2108,7 +2108,7 @@ char aux_hist MED_attributes - Auxiliary mediator wav2med average history output every day. + Auxiliary mediator wav2med file1 output fields (colon delimited) Sw_hs:Sw_wlm:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy @@ -2117,7 +2117,7 @@ char aux_hist MED_attributes - history option type + Auxiliary mediator wav2med file1 output option ndays @@ -2126,7 +2126,7 @@ integer aux_hist MED_attributes - history option type + Auxiliary mediator wav2med file1 output frequency (used for option type) 1 @@ -2135,7 +2135,7 @@ logical aux_hist MED_attributes - If true, use time average for aux file output. + Auxiliary mediator wav2med file1 time averaged flag for file output. .true. @@ -2144,7 +2144,7 @@ char aux_hist MED_attributes - Auxiliary name identifier in history name + Auxiliary mediator wav2med file1 name identifier. By default will be wav.24h.avg wav.24h.avg @@ -2153,7 +2153,7 @@ integer aux_hist MED_attributes - Number of time samples per file. + Auxiliary mediator wav2med file1 number of time samples per file. By default will be 30 30 From 205b8a94bfa158c7d8b91898cdae5b2095b3ba03 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 25 Oct 2023 22:38:45 +0200 Subject: [PATCH 014/135] made histaux_wav2med_file1_enabled an ALLCOMPS attribute that can be queried by ww3dev --- cime_config/namelist_definition_drv.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8c2f883ca..8df88a81e 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2098,11 +2098,12 @@ logical aux_hist - MED_attributes + ALLCOMP_attributes Auxiliary mediator wav2med file1 output enabled if true .false. + Note that ww3dev will obtain this configuration variable and send the fields needed for wav2med char From ae3e51484996c411ea5251a97aef4b47c80afc8d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Dec 2023 16:58:23 +0100 Subject: [PATCH 015/135] updates for new ww3 auxiliary swell fields --- cime_config/namelist_definition_drv.xml | 98 +++++++++++++++++++------ mediator/esmFldsExchange_cesm_mod.F90 | 8 +- mediator/fd_cesm.yaml | 48 +++++++++--- 3 files changed, 119 insertions(+), 35 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 8df88a81e..52951f5d0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -716,17 +716,6 @@ $ESMF_VERBOSITY_LEVEL - - logical - performance - MED_attributes - - Check for NaN values in fields returned from mediator to components. This has a small performance impact. - - - .true. - - integer control @@ -2092,33 +2081,32 @@ - + logical aux_hist - ALLCOMP_attributes - Auxiliary mediator wav2med file1 output enabled if true + MED_attributes + Auxiliary mediator wav2med average history output every day. .false. - Note that ww3dev will obtain this configuration variable and send the fields needed for wav2med char aux_hist MED_attributes - Auxiliary mediator wav2med file1 output fields (colon delimited) + Auxiliary mediator wav2med average history output every day. - Sw_hs:Sw_wlm:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy + Sw_hs:Sw_Tm1:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy char aux_hist MED_attributes - Auxiliary mediator wav2med file1 output option + history option type ndays @@ -2127,7 +2115,7 @@ integer aux_hist MED_attributes - Auxiliary mediator wav2med file1 output frequency (used for option type) + history option type 1 @@ -2136,7 +2124,7 @@ logical aux_hist MED_attributes - Auxiliary mediator wav2med file1 time averaged flag for file output. + If true, use time average for aux file output. .true. @@ -2145,7 +2133,7 @@ char aux_hist MED_attributes - Auxiliary mediator wav2med file1 name identifier. By default will be wav.24h.avg + Auxiliary name identifier in history name wav.24h.avg @@ -2154,7 +2142,73 @@ integer aux_hist MED_attributes - Auxiliary mediator wav2med file1 number of time samples per file. By default will be 30 + Number of time samples per file. + + 30 + + + + + + + logical + aux_hist + MED_attributes + Auxiliary mediator wav2med average history output every day. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator wav2med average history output every day. + + Sw_phs0:Sw_phs1:Sw_pdir0:Sw_pdir1:Sw_pTm10:Sw_pTm11 + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + wav.24h.swell + + + + integer + aux_hist + MED_attributes + Number of time samples per file. 30 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 59858cf49..83273993f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2268,7 +2268,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (phase == 'advertise') then call addfld_from(compwav, 'Sw_hs') - call addfld_from(compwav, 'Sw_wlm') + call addfld_from(compwav, 'Sw_phs0') + call addfld_from(compwav, 'Sw_phs1') + call addfld_from(compwav, 'Sw_pdir0') + call addfld_from(compwav, 'Sw_pdir1') + call addfld_from(compwav, 'Sw_pTm10') + call addfld_from(compwav, 'Sw_pTm11') + call addfld_from(compwav, 'Sw_Tm1') call addfld_from(compwav, 'Sw_thm') call addfld_from(compwav, 'Sw_thp0') call addfld_from(compwav, 'Sw_fp0') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 7febde854..07e28ed0e 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1168,39 +1168,63 @@ # - standard_name: Sw_hs canonical_units: m - description: Significant wave hight (only needed for mediatory history output) + description: Significant wave hight (only needed for mediator history output) # - - standard_name: Sw_wlm + - standard_name: Sw_phs0 canonical_units: m - description: Mean wave length (only needed for mediatory history output) + description: Wind sea swh (only needed for mediator history output) + # + - standard_name: Sw_phs1 + canonical_units: m + description: Swell swh (only needed for mediator history output) + # + - standard_name: Sw_pdir0 + canonical_units: degrees + description: Wind sea swh (only needed for mediator history output) + # + - standard_name: Sw_pdir1 + canonical_units: degrees + description: Swell swh (only needed for mediator history output) + # + - standard_name: Sw_pTm10 + canonical_units: s + description: Wind sea mean wave Tm1 period (only needed for mediator history output) + # + - standard_name: Sw_pTm11 + canonical_units: s + description: Swell mean wave Tm1 period (only needed for mediator history output) + # + - standard_name: Sw_Tm1 + canonical_units: s + description: Mean wave period of the first moment (only needed for mediator history output) # - standard_name: Sw_thm - canonical_units: unitless - description: Mean wave direction (only needed for mediatory history output) + canonical_units: degrees + description: Mean wave direction (only needed for mediator history output) # - standard_name: Sw_thp0 - canonical_units: unitless - description: Peak wave direction (only needed for mediatory history output) + canonical_units: degrees + description: Peak wave direction (only needed for mediator history output) # - standard_name: Sw_fp0 canonical_units: 1/s - description: Peak wave frequency (only needed for mediatory history output) + description: Peak wave frequency (only needed for mediator history output) # - standard_name: Sw_u canonical_units: m/s - description: Surface wind zonal (only needed for mediatory history output) + description: Surface wind zonal (only needed for mediator history output) # - standard_name: Sw_v canonical_units: m/s - description: Surface wind meridional (only needed for mediatory history output) + description: Surface wind meridional (only needed for mediator history output) # - standard_name: Sw_tusx canonical_units: m2/s - description: Stokes zonal transport vector (only needed for mediatory history output) + description: Stokes zonal transport vector (only needed for mediator history output) # - standard_name: Sw_tusy canonical_units: m2/s - description: Stokes meridional transport vector (only needed for mediatory history output) + description: Stokes meridional transport vector (only needed for mediator history output) # - standard_name: Sw_elevation_spectrum alias: wave_elevation_spectrum From fe910555645cf18d9036f10896304d1c95df7719 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 4 Dec 2023 19:27:30 +0100 Subject: [PATCH 016/135] changes for new ww3dev auxiliary fiel --- cime_config/namelist_definition_drv.xml | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 52951f5d0..3f0ae6493 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -716,6 +716,17 @@ $ESMF_VERBOSITY_LEVEL + + logical + performance + MED_attributes + + Check for NaN values in fields returned from mediator to components. This has a small performance impact. + + + .true. + + integer control @@ -2081,17 +2092,18 @@ - + logical aux_hist - MED_attributes + ALLCOMP_attributes Auxiliary mediator wav2med average history output every day. .false. + Note that ww3dev will obtain this configuration variable and send the fields needed for wav2med char @@ -2101,6 +2113,7 @@ Sw_hs:Sw_Tm1:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy + Auxiliary mediator wav2med file1 output fields (colon delimited) char @@ -2110,6 +2123,7 @@ ndays + Auxiliary mediator wav2med file1 output option integer @@ -2119,6 +2133,7 @@ 1 + Auxiliary mediator wav2med file1 output frequency (used for option type) logical @@ -2128,6 +2143,7 @@ .true. + Auxiliary mediator wav2med file1 time averaged flag for file output. char @@ -2167,6 +2183,7 @@ Sw_phs0:Sw_phs1:Sw_pdir0:Sw_pdir1:Sw_pTm10:Sw_pTm11 + Auxiliary mediator wav2med file2 output fields (colon delimited) char @@ -2176,6 +2193,7 @@ ndays + Auxiliary mediator wav2med file2 output option integer @@ -2185,6 +2203,7 @@ 1 + Auxiliary mediator wav2med file2 output frequency (used for option type) logical @@ -2194,6 +2213,7 @@ .false. + Auxiliary mediator wav2med file2 time averaged flag for file output. char From 65f2eaf868363452f18f8ee2906e29a095d55028 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 Dec 2023 15:42:39 +0100 Subject: [PATCH 017/135] updates for new averaging for fields sent to mediator from ww3dev for auxiliary file output --- cime_config/namelist_definition_drv.xml | 233 +--------------- mediator/esmFldsExchange_cesm_mod.F90 | 37 +-- mediator/fd_cesm.yaml | 350 ++++++++++++------------ 3 files changed, 210 insertions(+), 410 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 3f0ae6493..7fc112927 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2103,7 +2103,9 @@ .false. - Note that ww3dev will obtain this configuration variable and send the fields needed for wav2med + Auxiliary mediator wav2med average history output every day. + Note that ww3dev will use this configuration variable and send + the fields needed for wav2med auxiliary file char @@ -2111,9 +2113,13 @@ MED_attributes Auxiliary mediator wav2med average history output every day. - Sw_hs:Sw_Tm1:Sw_thm:Sw_thp0:Sw_fp0:Sw_u:Sw_v:Sw_ustokes:Sw_vstokes:Sw_tusx:Sw_tusy + Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg - Auxiliary mediator wav2med file1 output fields (colon delimited) + Auxiliary mediator wav2med file1 colon delimited output + fields. NOTE: these are assumed to be time averaged over a day in + the WW3 cap - so the settings of histaux_wav2med_file1_history_n + and histaux_wav2med_file1_history_option should be 1 and ndays, + respectively. char @@ -2141,7 +2147,7 @@ MED_attributes If true, use time average for aux file output. - .true. + .false. Auxiliary mediator wav2med file1 time averaged flag for file output. @@ -2164,76 +2170,6 @@ - - - - logical - aux_hist - MED_attributes - Auxiliary mediator wav2med average history output every day. - - .false. - - - - char - aux_hist - MED_attributes - Auxiliary mediator wav2med average history output every day. - - Sw_phs0:Sw_phs1:Sw_pdir0:Sw_pdir1:Sw_pTm10:Sw_pTm11 - - Auxiliary mediator wav2med file2 output fields (colon delimited) - - - char - aux_hist - MED_attributes - history option type - - ndays - - Auxiliary mediator wav2med file2 output option - - - integer - aux_hist - MED_attributes - history option type - - 1 - - Auxiliary mediator wav2med file2 output frequency (used for option type) - - - logical - aux_hist - MED_attributes - If true, use time average for aux file output. - - .false. - - Auxiliary mediator wav2med file2 time averaged flag for file output. - - - char - aux_hist - MED_attributes - Auxiliary name identifier in history name - - wav.24h.swell - - - - integer - aux_hist - MED_attributes - Number of time samples per file. - - 30 - - - @@ -2797,24 +2733,6 @@ - - - - - - - - - - - - - - - - - - char time @@ -3036,137 +2954,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 83273993f..99bfb4131 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2264,24 +2264,27 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if !----------------------------- - ! from wav: for auxiliary purposes only + ! from wav: for daily averaged fields for + ! output to auxiliary file only !----------------------------- if (phase == 'advertise') then - call addfld_from(compwav, 'Sw_hs') - call addfld_from(compwav, 'Sw_phs0') - call addfld_from(compwav, 'Sw_phs1') - call addfld_from(compwav, 'Sw_pdir0') - call addfld_from(compwav, 'Sw_pdir1') - call addfld_from(compwav, 'Sw_pTm10') - call addfld_from(compwav, 'Sw_pTm11') - call addfld_from(compwav, 'Sw_Tm1') - call addfld_from(compwav, 'Sw_thm') - call addfld_from(compwav, 'Sw_thp0') - call addfld_from(compwav, 'Sw_fp0') - call addfld_from(compwav, 'Sw_u') - call addfld_from(compwav, 'Sw_v') - call addfld_from(compwav, 'Sw_tusx') - call addfld_from(compwav, 'Sw_tusy') + call addfld_from(compwav, 'Sw_ustokes_avg') + call addfld_from(compwav, 'Sw_vstokes_avg') + call addfld_from(compwav, 'Sw_hs_avg') + call addfld_from(compwav, 'Sw_phs0_avg') + call addfld_from(compwav, 'Sw_phs1_avg') + call addfld_from(compwav, 'Sw_pdir0_avg') + call addfld_from(compwav, 'Sw_pdir1_avg') + call addfld_from(compwav, 'Sw_pTm10_avg') + call addfld_from(compwav, 'Sw_pTm11_avg') + call addfld_from(compwav, 'Sw_Tm1_avg') + call addfld_from(compwav, 'Sw_thm_avg') + call addfld_from(compwav, 'Sw_thp0_avg') + call addfld_from(compwav, 'Sw_fp0_avg') + call addfld_from(compwav, 'Sw_u_avg') + call addfld_from(compwav, 'Sw_v_avg') + call addfld_from(compwav, 'Sw_tusx_avg') + call addfld_from(compwav, 'Sw_tusy_avg') end if !----------------------------- @@ -3341,7 +3344,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! Get dms flux from ocn and send to atm (this is a deprecated functionality - only used for testing now) - ! TODO: remove this + ! TODO: remove this if (phase == 'advertise') then call addfld_from(compocn, 'Faoo_dms') call addfld_to(compatm, 'Faxx_dms') diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 07e28ed0e..e41b9cffd 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -43,374 +43,374 @@ description: meridional stress on ocean/air computed in mediator # #----------------------------------- - # section: land export + # section: land import #----------------------------------- # - standard_name: Fall_evap canonical_units: kg m-2 s-1 - description: land export + description: land import # - standard_name: Fall_evap_wiso canonical_units: kg m-2 s-1 - description: land export + description: land import # - standard_name: Fall_fco2_lnd canonical_units: moles m-2 s-1 - description: land export + description: land import # - standard_name: Fall_fire canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes (1->10) + description: land import - wild fire emission fluxes (1->10) # - standard_name: Fall_flxdst canonical_units: kg m-2 s-1 - description: land export - dust fluxes from land (sizes 1->4) + description: land import - dust fluxes from land (sizes 1->4) # - standard_name: Fall_lat canonical_units: W m-2 - description: land export + description: land import # - standard_name: Fall_lwup canonical_units: W m-2 - description: land export + description: land import # - standard_name: Fall_sen canonical_units: W m-2 - description: land export + description: land import # - standard_name: Fall_swnet canonical_units: W m-2 - description: land export + description: land import # - standard_name: Fall_taux canonical_units: N m-2 - description: land export + description: land import # - standard_name: Fall_tauy canonical_units: N m-2 - description: land export + description: land import # - standard_name: Fall_voc canonical_units: molecules/m2/sec - description: land export - MEGAN voc emission fluxes from land (1->20) + description: land import - MEGAN voc emission fluxes from land (1->20) # - standard_name: Sl_anidf canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_anidr canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_avsdf canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_avsdr canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_ddvel canonical_units: cm/sec - description: land export - dry deposition velocities from (1->80) + description: land import - dry deposition velocities from (1->80) # - standard_name: Sl_fv canonical_units: m s-1 - description: land export + description: land import # - standard_name: Sl_fztop canonical_units: m - description: land export + description: land import # - standard_name: Sl_lfrac canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_lfrin canonical_units: 1 - description: land export + description: land import # - standard_name: Sl_qref canonical_units: kg kg-1 - description: land export + description: land import # - standard_name: Sl_qref_wiso canonical_units: kg kg-1 - description: land export + description: land import # - standard_name: Sl_ram1 canonical_units: s/m - description: land export + description: land import # - standard_name: Sl_snowh canonical_units: m - description: land export + description: land import # - standard_name: Sl_snowh_wiso canonical_units: m - description: land export + description: land import # - standard_name: Sl_soilw canonical_units: m3/m3 - description: land export + description: land import # - standard_name: Sl_t canonical_units: K - description: land export + description: land import # - standard_name: Sl_topo_elev canonical_units: m - description: land export to mediator in elevation classes (1->glc_nec) + description: land import to mediator in elevation classes (1->glc_nec) # - standard_name: Sl_topo canonical_units: m - description: mediator export to glc - no levation classes + description: mediator import to glc - no levation classes # - standard_name: Sl_tsrf_elev canonical_units: deg C - description: land export to mediator in elevation classes (1->glc_nec) + description: land import to mediator in elevation classes (1->glc_nec) # - standard_name: Sl_tsrf canonical_units: deg C - description: mediator export to gcl with no elevation classes + description: mediator import to gcl with no elevation classes # - standard_name: Sl_tref canonical_units: K - description: mediator export to glc - no levation classes + description: mediator import to glc - no levation classes # - standard_name: Sl_u10 canonical_units: m - description: land export + description: land import # #----------------------------------- - # section: atmosphere export + # section: atmosphere import #----------------------------------- # - standard_name: Faxa_nhx canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_noy canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_bcph canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_ocph canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_dstdry canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_dstwet canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_swdn alias: mean_down_sw_flx canonical_units: W m-2 - description: atmosphere export + description: atmosphere import mean downward SW heat flux # - standard_name: Faxa_lwdn alias: mean_down_lw_flx canonical_units: W m-2 - description: atmosphere export + description: atmosphere import mean downward SW heat flux # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec - description: atmosphere export to land and ocean - currently nhx and noy + description: atmosphere import (sent to land and ocean) - currently nhx and noy # - standard_name: Faxa_prec_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rain alias: mean_prec_rate canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rain_wiso alias: mean_prec_rate_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rainc canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rainc_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rainl canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snow alias: mean_fprec_rate canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snow_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snowc canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snowc_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snowl canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_swnet canonical_units: W m-2 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_lwnet canonical_units: W m-2 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_swndf alias: mean_down_sw_ir_dif_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward nir diffuse flux + description: atmosphere import - mean surface downward nir diffuse flux # - standard_name: Faxa_swndr alias: mean_down_sw_ir_dir_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward nir direct flux + description: atmosphere import - mean surface downward nir direct flux # - standard_name: Faxa_swvdf alias: mean_down_sw_vis_dif_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+vis diffuse flux + description: atmosphere import - mean surface downward uv+vis diffuse flux # - standard_name: Faxa_swvdr alias: mean_down_sw_vis_dir_flx canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+visvdirect flux + description: atmosphere import - mean surface downward uv+visvdirect flux # - standard_name: Sa_co2diag canonical_units: 1e-6 mol/mol - description: atmosphere export - diagnostic CO2 at the lowest model level + description: atmosphere import - diagnostic CO2 at the lowest model level # - standard_name: Sa_co2prog canonical_units: 1e-6 mol/mol - description: atmosphere export - prognostic CO2 at the lowest model level + description: atmosphere import - prognostic CO2 at the lowest model level # - standard_name: Sa_o3 canonical_units: mol/mol - description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) + description: atmosphere import - O3 in the lowest model layer (prognosed or prescribed) # - standard_name: Sa_lightning canonical_units: /min - description: atmosphere export - lightning flash freqency + description: atmosphere import - lightning flash freqency # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m - description: atmosphere export - topographic height + description: atmosphere import - topographic height # - standard_name: Sa_dens alias: air_density_height_lowest canonical_units: kg m-3 - description: atmosphere export - density at the lowest model layer + description: atmosphere import - density at the lowest model layer # - standard_name: Sa_pbot alias: inst_pres_height_lowest canonical_units: Pa - description: atmosphere export - pressure at lowest model layer + description: atmosphere import - pressure at lowest model layer # - standard_name: Sa_pslv alias: inst_pres_height_surface canonical_units: Pa - description: atmosphere export + description: atmosphere import # - standard_name: Sa_ptem canonical_units: K - description: atmosphere export - bottom layer potential temperature + description: atmosphere import - bottom layer potential temperature # - standard_name: Sa_shum alias: inst_spec_humid_height_lowest canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity + description: atmosphere import - bottom layer specific humidity # - standard_name: Sa_shum_wiso alias: inst_spec_humid_height_lowest_wiso canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 16O, 18O, HDO + description: atmosphere import - bottom layer specific humidity 16O, 18O, HDO # - standard_name: Sa_tbot alias: inst_temp_height_lowest canonical_units: K - description: atmosphere export - bottom layer temperature + description: atmosphere import - bottom layer temperature # - standard_name: Sa_tskn alias: inst_temp_skin_temperature canonical_units: K - description: atmosphere export - sea surface skin temperature + description: atmosphere import - sea surface skin temperature # - standard_name: Sa_u alias: inst_zonal_wind_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer zonal wind + description: atmosphere import - bottom layer zonal wind # - standard_name: Sa_v alias: inst_merid_wind_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer meridional wind + description: atmosphere import - bottom layer meridional wind # - standard_name: Sa_wspd alias: inst_wind_speed_height_lowest canonical_units: m s-1 - description: atmosphere export - bottom layer wind speed + description: atmosphere import - bottom layer wind speed # - standard_name: Sa_z alias: inst_height_lowest canonical_units: m - description: atmosphere export - bottom layer height + description: atmosphere import - bottom layer height # - standard_name: Faxa_taux alias: mean_zonal_moment_flx_atm canonical_units: N m-2 - description: atmosphere export - zonal component of momentum flux + description: atmosphere import - zonal component of momentum flux # - standard_name: Faxa_tauy alias: mean_merid_moment_flx_atm canonical_units: N m-2 - description: atmosphere export - meridional component of momentum flux + description: atmosphere import - meridional component of momentum flux # - standard_name: Faxa_lat alias: mean_laten_heat_flx_atm canonical_units: W m-2 - description: atmosphere export + description: atmosphere import # - standard_name: Faxa_sen alias: mean_sensi_heat_flx_atm canonical_units: W m-2 - description: atmosphere export + description: atmosphere import # #----------------------------------- - # section: atmosphere import + # section: atmosphere export #----------------------------------- # - standard_name: Faxx_evap @@ -447,7 +447,6 @@ # - standard_name: Sx_anidf canonical_units: 1 - description: atmosphere import description: to atm merged surface diffuse albedo (near-infrared radiation) # - standard_name: Sx_anidr @@ -464,24 +463,24 @@ # - standard_name: Sx_qref canonical_units: kg kg-1 - description: atmosphere import + description: atmosphere export # - standard_name: Sx_qref_wiso canonical_units: kg kg-1 - description: atmosphere import + description: atmosphere export # - standard_name: Sx_t alias: surface_temperature canonical_units: K - description: atmosphere import + description: atmosphere export # - standard_name: Sx_tref canonical_units: K - description: atmosphere import + description: atmosphere export # - standard_name: Sx_u10 canonical_units: m - description: atmosphere import + description: atmosphere export # #----------------------------------- # section: land-ice export @@ -936,59 +935,59 @@ description: land export to river # #----------------------------------- - # section: river export + # section: river import #----------------------------------- # - standard_name: Flrr_flood canonical_units: kg m-2 s-1 - description: river export to land - water flux due to flooding + description: water flux due to flooding (sent to land) # - standard_name: Flrr_flood_wiso canonical_units: kg m-2 s-1 - description: river export to land - water flux due to flooding for 16O, 18O, HDO + description: water flux due to flooding for 16O, 18O, HDO (sent to land) # - standard_name: Flrr_volr canonical_units: m - description: river export to land - river channel total water volume + description: river channel total water volume (sent to land) # - standard_name: Flrr_volr_wiso canonical_units: m - description: river export to land - river channel total water volume from 16O, 18O, HDO + description: river channel total water volume from 16O, 18O, HDO (sent to land) # - standard_name: Flrr_volrmch canonical_units: m - description: river export to land - river channel main channel water volume + description: river channel main channel water volume (sent to land) # - standard_name: Flrr_volrmch_wiso canonical_units: m - description: river export to land - river channel main channel water volume from 16O, 18O, HDO + description: river channel main channel water volume from 16O, 18O, HDO (sent to land) # - standard_name: Sr_tdepth canonical_units: m - description: river export to land - tributary channel water depth + description: tributary channel water depth (sent to land) # - standard_name: Sr_tdepth_max canonical_units: m - description: river export to land - tributary channel bankfull depth + description: tributary channel bankfull depth (sent to land) # - standard_name: Forr_rofi canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) + description: water flux due to runoff (frozen) (sent to ocean) # - standard_name: Forr_rofi_wiso canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) for 16O, 18O, HDO + description: water flux due to runoff (frozen) for 16O, 18O, HDO (sent to ocean) # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (liquid) + description: water flux due to runoff (liquid) (sent to ocean) # - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 - description: river export to ocean - water flux due to runoff (frozen) for 16O, 18O, HDO + description: water flux due to runoff (frozen) for 16O, 18O, HDO (sent to ocean) # #----------------------------------- - # section: ocean import + # section: ocean export #----------------------------------- # - standard_name: Foxx_hrain @@ -1024,123 +1023,127 @@ - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux + description: to ocn - specific humidity flux # - standard_name: Foxx_evap_wiso alias: mean_evap_rate_wiso canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 16O, 18O, HDO + description: to ocn - specific humidity flux 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 - description: ocean import - latent heat flux into ocean + description: to ocn - latent heat flux into ocean # - standard_name: Foxx_lat_wiso canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O, 18O, HDO + description: to ocn - latent heat flux into ocean for 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for HDO + description: to ocn - latent heat flux into ocean for HDO # - standard_name: Foxx_sen alias: mean_sensi_heat_flx canonical_units: W m-2 - description: ocean import - sensible heat flux into ocean + description: to ocn - sensible heat flux into ocean # - standard_name: Foxx_lwup canonical_units: W m-2 - description: ocean import - surface upward longwave heat flux + description: to ocn - surface upward longwave heat flux # - standard_name: Foxx_lwnet alias: mean_net_lw_flx canonical_units: W m-2 - description: ocean import - mean NET long wave radiation flux to ocean + description: to ocn - mean NET long wave radiation flux to ocean # - standard_name: mean_runoff_rate canonical_units: kg m-2 s-1 - description: ocean import - total runoff to ocean + description: to ocn - total runoff to ocean # - standard_name: mean_runoff_heat_flux canonical_units: kg m-2 s-1 - description: ocean import - heat content of runoff + description: to ocn - heat content of runoff # - standard_name: mean_calving_rate canonical_units: kg m-2 s-1 - description: ocean import - total calving to ocean + description: to ocn - total calving to ocean # - standard_name: mean_calving_heat_flux canonical_units: kg m-2 s-1 - description: ocean import - heat content of calving + description: to ocn - heat content of calving # - standard_name: Foxx_rofi canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (frozen) + description: to ocn - water flux due to runoff (frozen) # - standard_name: Foxx_rofi_wiso canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (frozen) for 16O, 18O, HDO + description: to ocn - water flux due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Foxx_rofl alias: mean_runoff_rate canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (liquid) + description: to ocn - water flux due to runoff (liquid) # - standard_name: Foxx_rofl_wiso canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (liquid) for 16O, 18O, HDO + description: to ocn - water flux due to runoff (liquid) for 16O, 18O, HDO # - standard_name: Foxx_swnet alias: mean_net_sw_flx canonical_units: W m-2 - description: ocean import - net shortwave radiation to ocean + description: to ocn - net shortwave radiation to ocean # - standard_name: Foxx_swnet_vdr alias: mean_net_sw_vis_dir_flx canonical_units: W m-2 - description: ocean import - net shortwave visible direct radiation to ocean + description: to ocn - net shortwave visible direct radiation to ocean # - standard_name: Foxx_swnet_vdf alias: mean_net_sw_vis_dif_flx canonical_units: W m-2 - description: ocean import - net shortwave visible diffuse radiation to ocean + description: to ocn - net shortwave visible diffuse radiation to ocean # - standard_name: Foxx_swnet_idr alias: mean_net_sw_ir_dir_flx canonical_units: W m-2 - description: ocean import - net shortwave ir direct radiation to ocean + description: to ocn - net shortwave ir direct radiation to ocean # - standard_name: Foxx_swnet_idf alias: mean_net_sw_ir_dif_flx canonical_units: W m-2 - description: ocean import - net shortwave ir diffuse radiation to ocean + description: to ocn - net shortwave ir diffuse radiation to ocean # - standard_name: Foxx_swnet_afracr canonical_units: W m-2 - description: ocean import - net shortwave radiation times atmosphere fraction + description: to ocn - net shortwave radiation times atmosphere fraction # - standard_name: Foxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: ocean import - zonal surface stress + description: to ocn - zonal surface stress # - standard_name: Foxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: ocean import - meridional surface stress + description: to ocn - meridional surface stress # - standard_name: Fioi_swpen_ifrac_n alias: mean_sw_pen_to_ocn_ifrac_n canonical_units: W m-2 - description: ocean import - net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 + description: to ocn - net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 # - standard_name: Sf_afrac canonical_units: 1 - description: ocean import - fractional atmosphere coverage wrt ocean + description: to ocn - fractional atmosphere coverage wrt ocean # - standard_name: Sf_afracr canonical_units: 1 - description: ocean import - fractional atmosphere coverage used in radiation computations wrt ocean + description: to ocn - fractional atmosphere coverage used in radiation computations wrt ocean + # + #----------------------------------- + # section: wave import + #----------------------------------- # - standard_name: Sw_hstokes canonical_units: m @@ -1166,74 +1169,81 @@ canonical_units: m/s description: Northward partitioned stokes drift components # - - standard_name: Sw_hs + - standard_name: Sw_elevation_spectrum + alias: wave_elevation_spectrum + canonical_units: m2/s + description: wave elevation spectrum + # + - standard_name: Sw_ustokes_avg + canonical_units: m/s + description: Daily averaged stokes drift u component (only needed for mediator history output) + # + - standard_name: Sw_vstokes_avg + canonical_units: m/s + description: Daily averaged stokes drift v component (only needed for mediator history output) + # + - standard_name: Sw_hs_avg canonical_units: m - description: Significant wave hight (only needed for mediator history output) + description: Daily averaged significant wave hight (only needed for mediator history output) # - - standard_name: Sw_phs0 + - standard_name: Sw_phs0_avg canonical_units: m - description: Wind sea swh (only needed for mediator history output) + description: Daily averaged averaged wind sea swh (only needed for mediator history output) # - - standard_name: Sw_phs1 + - standard_name: Sw_phs1_avg canonical_units: m - description: Swell swh (only needed for mediator history output) + description: Daily averaged swell swh (only needed for mediator history output) # - - standard_name: Sw_pdir0 + - standard_name: Sw_pdir0_avg canonical_units: degrees - description: Wind sea swh (only needed for mediator history output) + description: Daily averaged wind sea swh (only needed for mediator history output) # - - standard_name: Sw_pdir1 + - standard_name: Sw_pdir1_avg canonical_units: degrees - description: Swell swh (only needed for mediator history output) + description: Daily averaged swell swh (only needed for mediator history output) # - - standard_name: Sw_pTm10 + - standard_name: Sw_pTm10_avg canonical_units: s - description: Wind sea mean wave Tm1 period (only needed for mediator history output) + description: Daily averaged wind sea mean wave Tm1 period (only needed for mediator history output) # - - standard_name: Sw_pTm11 + - standard_name: Sw_pTm11_avg canonical_units: s - description: Swell mean wave Tm1 period (only needed for mediator history output) + description: Daily average swell mean wave Tm1 period (only needed for mediator history output) # - - standard_name: Sw_Tm1 + - standard_name: Sw_Tm1_avg canonical_units: s - description: Mean wave period of the first moment (only needed for mediator history output) + description: Daily averaged mean wave period of the first moment (only needed for mediator history output) # - - standard_name: Sw_thm + - standard_name: Sw_thm_avg canonical_units: degrees - description: Mean wave direction (only needed for mediator history output) + description: Daily averaged mean wave direction (only needed for mediator history output) # - - standard_name: Sw_thp0 + - standard_name: Sw_thp0_avg canonical_units: degrees - description: Peak wave direction (only needed for mediator history output) + description: Daily averaged peak wave direction (only needed for mediator history output) # - - standard_name: Sw_fp0 + - standard_name: Sw_fp0_avg canonical_units: 1/s - description: Peak wave frequency (only needed for mediator history output) + description: Daily averaged peak wave frequency (only needed for mediator history output) # - - standard_name: Sw_u + - standard_name: Sw_u_avg canonical_units: m/s - description: Surface wind zonal (only needed for mediator history output) + description: Daily averaged surface wind zonal (only needed for mediator history output) # - - standard_name: Sw_v + - standard_name: Sw_v_avg canonical_units: m/s - description: Surface wind meridional (only needed for mediator history output) + description: Daily averaged surface wind meridional (only needed for mediator history output) # - - standard_name: Sw_tusx + - standard_name: Sw_tusx_avg canonical_units: m2/s - description: Stokes zonal transport vector (only needed for mediator history output) + description: Daily averaged stokes zonal transport vector (only needed for mediator history output) # - - standard_name: Sw_tusy + - standard_name: Sw_tusy_avg canonical_units: m2/s - description: Stokes meridional transport vector (only needed for mediator history output) - # - - standard_name: Sw_elevation_spectrum - alias: wave_elevation_spectrum - canonical_units: m2/s - description: wave elevation spectrum - + description: Daily averaged stokes meridional transport vector (only needed for mediator history output) # #----------------------------------- - # section: wave import + # section: wave export #----------------------------------- # - standard_name: Fwxx_taux From 71bfe7a6c392346899ff35f784f2d76fb3e7fe03 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 6 Dec 2023 10:03:06 +0100 Subject: [PATCH 018/135] updated comment --- cime_config/namelist_definition_drv.xml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7fc112927..b64522504 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2149,7 +2149,8 @@ .false. - Auxiliary mediator wav2med file1 time averaged flag for file output. + Auxiliary mediator wav2med file1 time averaged flag for file output. + If this flag is set to .false. only instantaneous output will be created in the auxiliary file. char From 8a98342e11f5c473a880c0c225883dfac50d8b24 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 6 Dec 2023 10:33:28 +0100 Subject: [PATCH 019/135] removed duplicate fields --- cime_config/namelist_definition_drv.xml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b64522504..ebe0abde8 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2099,7 +2099,6 @@ logical aux_hist ALLCOMP_attributes - Auxiliary mediator wav2med average history output every day. .false. @@ -2111,7 +2110,6 @@ char aux_hist MED_attributes - Auxiliary mediator wav2med average history output every day. Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg @@ -2125,7 +2123,6 @@ char aux_hist MED_attributes - history option type ndays @@ -2135,7 +2132,6 @@ integer aux_hist MED_attributes - history option type 1 @@ -2145,7 +2141,6 @@ logical aux_hist MED_attributes - If true, use time average for aux file output. .false. @@ -2156,7 +2151,6 @@ char aux_hist MED_attributes - Auxiliary name identifier in history name wav.24h.avg From 0c007a2ee0c31bc342589f697286fdb1ea62619d Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 4 Jan 2024 13:54:01 +0100 Subject: [PATCH 020/135] obtain 10m u,v from atm and pass it to ww3d --- mediator/esmFldsExchange_cesm_mod.F90 | 26 +++++++++++++------------- mediator/fd_cesm.yaml | 8 ++++++++ 2 files changed, 21 insertions(+), 13 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 99bfb4131..42358d317 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2973,26 +2973,26 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! --------------------------------------------------------------------- - ! to wav: zonal and meridional winds at the lowest model level from atm + ! to wav: 10m zonal and meridional winds from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_u') - call addfld_to(compwav, 'Sa_u') + call addfld_from(compatm, 'Sa_u10m') + call addfld_to(compwav, 'Sa_u10m') else - if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then - call addmap_from(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg_to(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u10m', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u10m', rc=rc)) then + call addmap_from(compatm, 'Sa_u10m', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_u10m', mrg_from=compatm, mrg_fld='Sa_u10m', mrg_type='copy') end if end if if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_v') - call addfld_to(compwav, 'Sa_v') + call addfld_from(compatm, 'Sa_v10m') + call addfld_to(compwav, 'Sa_v10m') else - if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then - call addmap_from(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg_to(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v10m', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v10m', rc=rc)) then + call addmap_from(compatm, 'Sa_v10m', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_v10m', mrg_from=compatm, mrg_fld='Sa_v10m', mrg_type='copy') end if end if diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index e41b9cffd..721ef92c4 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -379,6 +379,14 @@ canonical_units: m s-1 description: atmosphere import - bottom layer meridional wind # + - standard_name: Sa_u10m + canonical_units: m s-1 + description: atmosphere import - 10m zonal wind + # + - standard_name: Sa_v10m + canonical_units: m s-1 + description: atmosphere import - 10m meridional wind + # - standard_name: Sa_wspd alias: inst_wind_speed_height_lowest canonical_units: m s-1 From 2af2904b8d1c4706e89910bb37983d2f6d0bfb4c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 7 Feb 2024 11:49:00 +0100 Subject: [PATCH 021/135] changes for additional tracers from lnd to rof --- cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 | 100 +++++++++++++++++++ cime_config/namelist_definition_drv_flds.xml | 13 +++ mediator/med_phases_prep_rof_mod.F90 | 97 +++++++++++++++--- 3 files changed, 197 insertions(+), 13 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 new file mode 100644 index 000000000..0a2766b25 --- /dev/null +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 @@ -0,0 +1,100 @@ +module shr_lnd2rof_tracers_mod + + !======================================================================== + ! Module for handling nitrogen depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_getLogUnit + use shr_kind_mod , only : r8 => shr_kind_r8, cs => shr_kind_cs + use shr_nl_mod , only : shr_nl_find_group_name + use shr_mpi_mod , only : shr_mpi_bcast + + implicit none + private + + ! !PUBLIC MEMBER FUNCTIONS + public :: shr_lnd2rof_tracers_readnl ! Read namelist + + character(len=*), parameter :: & + u_FILE_u=__FILE__ + +!==================================================================================== +CONTAINS +!==================================================================================== + + subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) + + !======================================================================== + ! reads lnd2rof_tracers_inparm namelist and sets up driver list of fields for + ! lnd -> river communications + !======================================================================== + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + character(len=*), intent(out) :: lnd2rof_tracer_list ! Colon delimited string of liquid lnd2rof tracers + + !----- local ----- + type(ESMF_VM) :: vm + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer :: rc + integer :: localpet + integer :: mpicom + integer :: logunit + character(len=CS) :: lnd2rof_tracers + character(*),parameter :: subName = '(shr_lnd2rof_tracers_readnl) ' + character(*),parameter :: F00 = "('(shr_lnd2rof_tracers_readnl) ',8a)" + ! ------------------------------------------------------------------ + + namelist /lnd2rof_tracers_inparm/ lnd2rof_tracers + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the lnd2rof_tracers field list to pass + ! First check if file exists and if not, n_lnd2rof_tracers will be zero + !----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + call shr_log_getLogUnit(logunit) + + lnd2rof_tracers = ' ' + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (localpet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(logunit,F00) 'Read in lnd2rof_tracers_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'lnd2rof_tracers_inparm', ierr) + if (ierr == 0) then + ! Note that if ierr /= 0, no namelist is present. + read(unitn, lnd2rof_tracers_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(trim(subName) //'problem of read of lnd2rof_tracers_inparm ') + endif + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( lnd2rof_tracers, mpicom ) + + lnd2rof_tracer_list = trim(lnd2rof_tracers) + + end subroutine shr_lnd2rof_tracers_readnl + +end module shr_lnd2rof_tracers_mod diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 03b6b7c6d..29a1fc3cd 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -170,4 +170,17 @@ + + + + + + char + lnd2rof_tracers + lnd2rof_tracers_inparm + + Liquid lnd2rof tracers (other than water) + + + diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index cf0ad0f4e..9a7f1e725 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf @@ -92,6 +93,8 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n, nflds + integer :: lrank + integer :: ungriddedUBound(1) type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield @@ -141,14 +144,43 @@ subroutine med_phases_prep_rof_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(lnd2rof_flds) - lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + ! Obtain import field on land grid and determine its rank + call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (lrank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Create accumulation field on lnd grid + if (lrank == 2) then + lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Add field to accumulation field bundle on lnd grid call ESMF_FieldBundleAdd(FBlndAccum2rof_l, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_l', & ESMF_LOGMSG_INFO) - lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Create accumulation field on rof grid - first determine rank and ubound if rank is 2 + if (lrank == 2) then + lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! Add field to accumulation field bundle on rof grid call ESMF_FieldBundleAdd(FBlndAccum2rof_r, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_r', & @@ -199,9 +231,12 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n + integer :: lrank logical :: exists real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr1d_accum(:) + real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr2d_accum(:,:) type(ESMF_Field) :: lfield type(ESMF_Field) :: lfield_accum character(len=*), parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_accum)' @@ -231,11 +266,22 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldName=trim(lnd2rof_flds(n)), & field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield_accum, dataptr1d_accum, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) + ! determine rank of field + if (lrank == 2) then + call field_getdata2d(lfield, dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call field_getdata2d(lfield_accum, dataptr2d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_accum(:,:) = dataptr2d_accum(:,:) + dataptr2d(:,:) + else + call field_getdata1d(lfield, dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call field_getdata1d(lfield_accum, dataptr1d_accum, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d_accum(:) = dataptr1d_accum(:) + dataptr1d(:) + end if end if end do @@ -261,6 +307,7 @@ subroutine med_phases_prep_rof(gcomp, rc) ! Prepare the ROF export Fields from the mediator !------------------------------------ + use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet @@ -277,10 +324,12 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local integer :: n + integer :: lrank integer :: count logical :: exists real(r8), pointer :: dataptr(:) real(r8), pointer :: dataptr1d(:) + real(r8), pointer :: dataptr2d(:,:) type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' @@ -319,12 +368,25 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (count == 0) then - dataptr1d(:) = czero + ! determine rank of field + if (lrank == 2) then + call field_getdata2d(lfield, dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr2d(:,:) = czero + else + dataptr2d(:,:) = dataptr2d(:,:) / real(count, r8) + end if else - dataptr1d(:) = dataptr1d(:) / real(count, r8) + call field_getdata1d(lfield, dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (count == 0) then + dataptr1d(:) = czero + else + dataptr1d(:) = dataptr1d(:) / real(count, r8) + end if end if end if end do @@ -402,9 +464,18 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr1d, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero + ! determine rank of field + if (lrank == 2) then + call field_getdata2d(lfield, dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d(:,:) = czero + else + call field_getdata1d(lfield, dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr1d(:) = czero + end if end if end do From 62f7692dc76337f24bcd7d004f9dbddb6f50d337 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 19 Feb 2024 15:01:13 +0100 Subject: [PATCH 022/135] export state to glc added to lnd2glc auxiliary file --- mediator/med_phases_history_mod.F90 | 28 ++++++++++++++----- mediator/med_phases_prep_glc_mod.F90 | 40 +++++++++++++++++----------- 2 files changed, 45 insertions(+), 23 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f150a4b7..1fc984fc9 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,7 +25,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + implicit none private @@ -515,19 +515,20 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) - ! Write yearly average of lnd -> glc fields + ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd + use med_internalstate_mod, only : complnd, compglc use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_io_mod , only : med_io_write_time, med_io_define_time use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun + type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) ! local variables type(file_desc_t) :: io_file @@ -546,8 +547,9 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(len=CL) :: hist_file - integer :: m + integer :: m,n logical :: isPresent + character(len=CS) :: cvalue character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- @@ -619,9 +621,21 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + + call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & + is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(fldbun_glc)) then + do n = 1,size(fldbun_glc) + call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & + nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do ! end of loop over m ! Close history file diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 97049d5b9..1a6fc8de0 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -632,22 +632,6 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end do - ! Write auxiliary history file if flag is set and accumulation is being done - if (lndAccum2glc_cnt > 0) then - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - else - write_histaux_l2x1yrg = .false. - end if - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if - if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) @@ -688,15 +672,39 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if + ! Determine if auxiliary file will be written + write_histaux_l2x1yrg = .false. + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if + + ! Write auxiliary history file if flag is set and accumulation is being done if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data ! Zero land accumulator and accumulated field bundles on land grid call med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + + if (write_histaux_l2x1yrg) then + call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, & + fldbun_glc=is_local%wrap%FBExp(compglc(:)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + lndAccum2glc_cnt = 0 call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + else + if (write_histaux_l2x1yrg) then + call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if end if if (dbug_flag > 1) then From b0434b4956edcdcbad96d0cb876e8834fc3f724f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 9 Mar 2024 16:35:10 +0100 Subject: [PATCH 023/135] removed changes introduced to compute dms fluxes in mediator --- mediator/esmFldsExchange_cesm_mod.F90 | 61 ++++---------- mediator/fd_cesm.yaml | 16 +--- mediator/med_phases_aofluxes_mod.F90 | 116 ++++---------------------- 3 files changed, 34 insertions(+), 159 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 42358d317..36a29e90e 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1559,6 +1559,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + !----------------------------------------------------------------------------- + ! to atm: dms flux from ocean + !----------------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compocn, 'Faoo_fdms_ocn') + call addfld_to(compatm, 'Faoo_fdms_ocn') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Faoo_fdms_ocn', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then + call addmap_from(compocn, 'Faoo_fdms_ocn', compatm, mapconsd, 'one', ocn2atm_map) + call addmrg_to(compatm , 'Faoo_fdms_ocn', & + mrg_from=compocn, mrg_fld='Faoo_fdms_ocn', mrg_type='merge', mrg_fracname='ofrac') + ! TODO: does this need a custom merge like Faoo_fco2_ocn ??? + end if + end if + !===================================================================== ! FIELDS TO OCEAN (compocn) !===================================================================== @@ -3312,51 +3328,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif - !===================================================================== - ! DMS EXCHANGE - !===================================================================== - - ! Get dms concentration from ocn and compute dms flux in mediator and send to both atm and ocn - if (phase == 'advertise') then - call addfld_aoflux('Faox_dms') - call addfld_from(compocn, 'So_dms') - call addfld_to(compocn, 'Faox_dms') - call addfld_to(compatm, 'Faxx_dms') - else - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - ! TODO: extend this to to agrid and xgrid - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then - call addmrg_to(compatm , 'Faxx_dms', & - mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') - end if - if ( fldchk(is_local%wrap%FBexp(compocn), 'Faox_dms', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc) ) then - call addmrg_to(compocn, 'Faox_dms', & - mrg_from=compmed, mrg_fld='Faox_dms', mrg_type='merge', mrg_fracname='ofrac') - end if - else - call ESMF_LogWrite(trim(subname)//& - ": only ogrid has been enabled for dms flux computation", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - end if - end if - - ! Get dms flux from ocn and send to atm (this is a deprecated functionality - only used for testing now) - ! TODO: remove this - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms') - call addfld_to(compatm, 'Faxx_dms') - else - ! Note that Faoo_dmds should not be weighted by ifrac - since - ! it will be weighted by ifrac in the merge to the atm - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_dms', rc=rc)) then - call addmrg_to(compatm , 'Faxx_dms', & - mrg_from=compmed, mrg_fld='Faoo_dms', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 721ef92c4..c1b736173 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1282,21 +1282,9 @@ description: mediator area for component # #----------------------------------- - # section: dms exchange + # section: dms exchange ocn->atm #----------------------------------- # - - standard_name: So_dms - canonical_units: nmol L-1 - description: DMS uppoer ocean concentration - # - - standard_name: Faoo_dms + - standard_name: Faoo_fdms_ocn canonical_units: moles m-2 s-1 description: Surface flux of DMS computed in ocean (downward positive) - # - - standard_name: Faox_dms - canonical_units: moles m-2 s-1 - description: Surface flux of DMS computed in mediator (downward positive) - # - - standard_name: Faxx_dms - canonical_units: moles m-2 s-1 - description: merged surface flux of DMS to atm (downward positive) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b46c4e9ab..48055e92e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -35,15 +35,9 @@ module med_phases_aofluxes_mod #ifndef CESMCOUPLED use ufs_const_mod , only : rearth => SHR_CONST_REARTH use ufs_const_mod , only : pi => SHR_CONST_PI - use ufs_const_mod , only : tfrz => SHR_CONST_TKFRZ - use ufs_const_mod , only : rdair => SHR_CONST_RDAIR - use ufs_const_mod , only : cpdair => SHR_CONST_CPDAIR -#ELSE +#else use shr_const_mod , only : rearth => SHR_CONST_REARTH use shr_const_mod , only : pi => SHR_CONST_PI - use shr_const_mod , only : tfrz => SHR_CONST_TKFRZ - use shr_const_mod , only : rdair => SHR_CONST_RDAIR - use shr_const_mod , only : cpdair => SHR_CONST_CPDAIR #endif implicit none @@ -80,13 +74,9 @@ module med_phases_aofluxes_mod ! Private data !-------------------------------------------------------------------------- - real(r8), parameter :: rcp = rdair/cpdair ! gas constant of air / specific heat capacity at a constant pressure - - logical :: flds_wiso ! use case - + logical :: flds_wiso ! use case logical :: compute_atm_dens logical :: compute_atm_thbot - logical :: compute_dms_flux integer :: ocn_surface_flux_scheme ! use case character(len=CS), pointer :: fldnames_ocn_in(:) @@ -119,8 +109,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio - real(R8) , pointer :: dms_ocn (:) => null() ! ocn dms concentration - ! input: atm real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal @@ -137,7 +125,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux - ! local size and computational mask and area: on aoflux grid integer :: lsize ! local size integer , pointer :: mask (:) => null() ! integer ocn domain mask: 0 <=> inactive cell @@ -162,7 +149,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ustar (:) => null() ! saved ustar real(R8) , pointer :: re (:) => null() ! saved re real(R8) , pointer :: ssq (:) => null() ! saved sq - real(R8) , pointer :: dms (:) => null() ! ocn-> atm dms flux (optional) end type aoflux_out_type character(*), parameter :: u_FILE_u = & @@ -243,8 +229,8 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (maintask) then - write(logunit,'(a)') trim(subname)//' initialized FB for '// & - trim(compname(compatm))//'->'//trim(compname(compocn)) + write(logunit,'(a)') trim(subname)//' initializing FB for '// & + trim(compname(compatm))//'_'//trim(compname(compocn)) end if ! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed @@ -258,8 +244,8 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (maintask) then - write(logunit,'(a)') trim(subname)//' initialized FB for '// & - trim(compname(compocn))//'->'//trim(compname(compatm)) + write(logunit,'(a)') trim(subname)//' initializing FB for '// & + trim(compname(compocn))//'_'//trim(compname(compatm)) end if end if @@ -429,15 +415,6 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) compute_atm_dens = .true. end if - ! Determine if dms flux will be computed in mediator - if ( FB_fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_dms', rc=rc ) .and. & - ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faox_dms', rc=rc) .or. & - FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_dms', rc=rc) ) ) then - compute_dms_flux = .true. - else - compute_dms_flux = .false. - end if - !---------------------------------- ! Initialize aoflux !---------------------------------- @@ -991,22 +968,16 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! ! Local variables - type(InternalState) :: is_local - integer :: n ! indices - real(r8), parameter :: qmin = 1.0e-8_r8 ! minimum - real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa - real(r8), parameter :: Xconvxa= 6.97e-07 ! Wanninkhof's a=0.251 converted to ms-1/(ms-1)^2 - integer :: maptype - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - real(r8) :: sst_c - real(r8) :: scdms - real(r8) :: kwdms - real(r8), pointer :: odms(:) - real(r8), pointer :: sst(:) - real(r8), pointer :: u10m(:) - real(r8), pointer :: flux_dms(:) - character(*),parameter :: subName = '(med_aofluxes_update) ' + type(InternalState) :: is_local + integer :: n ! indices + real(r8), parameter :: qmin = 1.0e-8_r8 + real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa + real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure + real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst + character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -1180,52 +1151,6 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! compute DMS fluxes to atm and ocn - if (compute_dms_flux) then - if (is_local%wrap%aoflux_grid == 'ogrid') then - ! TODO: extend this to to agrid and xgrid - - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_dms', field=field_src, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_src, farrayptr=odms, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldBundleGet(is_local%wrap%FBImp(compocn,compocn), 'So_t', field=field_src, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_src, farrayptr=sst, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'So_u10', field=field_src, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_src, farrayptr=u10m, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_dms', field=field_src, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field_src, farrayptr=flux_dms, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! flux_dms from ocean is in kg/m2/s - ! flux is downwards positive - therefore negative values to - ! the atmosphere (this is the opposite of what is there in BLOM) - ! The following comes from the BLOM/iHAMOCC routine carchm.F90 - ! See https://noresm-docs.readthedocs.io/en/noresm2/model-description/ocn_bgc_model.html - do n = 1,size(sst) - sst_c = sst(n) - tfrz - sst_c = min(40.,max(-3., sst_c)) - scdms = 2855.7+ (-177.63 + (6.0438 + (-0.11645 + 0.00094743*sst_c)*sst_c)*sst_c)*sst_c - kwdms = Xconvxa * u10m(n)**2 * (660./scdms)**0.5 - flux_dms(n) = -62.13 *kwdms * odms(n) - end do - else - call ESMF_LogWrite(trim(subname)//& - ": only ogrid has been enabled for dms flux computation", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) - rc = ESMF_FAILURE - return - end if - end if - call t_stopf('MED:'//subname) end subroutine med_aofluxes_update @@ -1738,11 +1663,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r allocate(aoflux_in%roce_HDO(aoflux_in%lsize)); aoflux_in%roce_HDO(:) = 0._R8 end if - if ( compute_dms_flux) then - call fldbun_getfldptr(fldbun_o, 'So_dms', aoflux_in%dms_ocn, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - end subroutine set_aoflux_in_pointers !================================================================================ @@ -1796,10 +1716,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 end if - if (compute_dms_flux) then - call fldbun_getfldptr(fldbun, 'Faox_dms', aoflux_out%dms, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end subroutine set_aoflux_out_pointers From 88e32fdb70c91cba4b073ec9ee1a48c28c89b2a8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 10 Apr 2024 11:59:37 +0200 Subject: [PATCH 024/135] more updates to cmeps --- cime_config/buildnml | 1 - mediator/med_phases_history_mod.F90 | 1 - 2 files changed, 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 4dc542ac1..ff2553be7 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -52,7 +52,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["mask_grid"] = case.get_value("MASK_GRID") config["rest_option"] = case.get_value("REST_OPTION") config["comp_ocn"] = case.get_value("COMP_OCN") - config["COMPSET"] = case.get_value("COMPSET") atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 7fa5ecd05..0a6a7775d 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -553,7 +553,6 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=CS) :: cvalue character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- From e2b453ef2905b2c56aebe637070369c40d133a8e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 10 Apr 2024 12:00:01 +0200 Subject: [PATCH 025/135] more updates to cmeps --- cime_config/namelist_definition_drv.xml | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 662882f46..b7e73e130 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2499,22 +2499,6 @@ - - logical - flds - ALLCOMP_attributes - - Pass DMS flux computed in MED to both ATM and OCN - Set this by setting the xml variable BGC_MODE. - If BGC_MODE has 'DMSmed', then DMSmed will be set to .true. - - - .false. - .true. - .true. - - - logical seq_flds @@ -2529,7 +2513,6 @@ - logical flds From f81d3577880670aa7720729969ba42094ddcc4b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 10 Apr 2024 17:02:00 +0200 Subject: [PATCH 026/135] fix problems in prealpha_noresm testing --- mediator/esmFldsExchange_cesm_mod.F90 | 21 ++------------------- mediator/fd_cesm.yaml | 2 +- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b5fc2dd5b..3dd5a9e0b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1620,6 +1620,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compocn, 'Faoo_fdms_ocn') call addfld_to(compatm, 'Faoo_fdms_ocn') else + ! Note that Faoo_dmds should not be weighted by ifrac - since + ! it will be weighted by ifrac in the merge to the atm if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Faoo_fdms_ocn', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compatm) , 'Faoo_fdms_ocn', rc=rc)) then call addmap_from(compocn, 'Faoo_fdms_ocn', compatm, mapconsd, 'one', ocn2atm_map) @@ -3392,25 +3394,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if endif - !===================================================================== - ! DMS EXCHANGE - !===================================================================== - - ! Get dms flux from ocn and send to atm - if (phase == 'advertise') then - call addfld_from(compocn, 'Faoo_dms_ocn') - call addfld_to(compatm, 'Faoo_dms_ocn') - else - ! Note that Faoo_dmds should not be weighted by ifrac - since - ! it will be weighted by ifrac in the merge to the atm - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_dms_ocn', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_dms_ocn', rc=rc)) then - call addmap_from(complnd, 'Faoo_dms_ocn', compocn, mapconsf, 'lfrac', ocn2atm_map) - call addmrg_to(compatm , 'Faoo_dms_ocn', & - mrg_from=compmed, mrg_fld='Faoo_dms_ocn', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end subroutine esmFldsExchange_cesm end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 88b4a5158..8caa9ddbd 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -859,7 +859,7 @@ canonical_units: moles m-2 s-1 description: ocn import to med # - - standard_name: Faoo_dms_ocn + - standard_name: Faoo_fdms_ocn canonical_units: moles m-2 s-1 description: ocn import to med - surface flux of DMS (downward positive) # From d135280ec1c4ffd107040d439cb035b83b7d19d8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 17 Apr 2024 04:15:05 -0600 Subject: [PATCH 027/135] updates for different fields to be sent to ww3 --- mediator/esmFlds.F90 | 3 +-- mediator/esmFldsExchange_cesm_mod.F90 | 22 +++++++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index c7bd2337a..bcb3d5471 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -793,8 +793,7 @@ subroutine med_fldList_GetFldNames(fields, fldnames, rc) if(present(rc)) rc = ESMF_SUCCESS if (.not. associated(fldnames) .or. .not. allocated(fields%mapindex)) then - write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",& - associated(fldnames), allocated(fields%mapindex) + write(msg, *) "med_fldList_GetFldNames: ERROR either fields or fldnames have not been allocated. ",associated(fldnames), allocated(fields%mapindex) call ESMF_LogWrite(msg, ESMF_LOGMSG_ERROR) if(present(rc)) rc = ESMF_FAILURE return diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 3dd5a9e0b..f79996c7b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -3045,16 +3045,18 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! --------------------------------------------------------------------- - ! to wav: 10m zonal and meridional winds from atm + ! to wav: zonal and meridional winds at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_u') + call addfld_to(compwav, 'Sa_u') call addfld_from(compatm, 'Sa_u10m') call addfld_to(compwav, 'Sa_u10m') else - if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u10m', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u10m', rc=rc)) then - call addmap_from(compatm, 'Sa_u10m', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg_to(compwav, 'Sa_u10m', mrg_from=compatm, mrg_fld='Sa_u10m', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u', rc=rc)) then + call addmap_from(compatm, 'Sa_u', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_u', mrg_from=compatm, mrg_fld='Sa_u', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_u10m', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_u10m', rc=rc)) then @@ -3063,13 +3065,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_v') + call addfld_to(compwav, 'Sa_v') call addfld_from(compatm, 'Sa_v10m') call addfld_to(compwav, 'Sa_v10m') else - if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v10m', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v10m', rc=rc)) then - call addmap_from(compatm, 'Sa_v10m', compwav, mapbilnr, 'one', atm2wav_map) - call addmrg_to(compwav, 'Sa_v10m', mrg_from=compatm, mrg_fld='Sa_v10m', mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v', rc=rc)) then + call addmap_from(compatm, 'Sa_v', compwav, mapbilnr, 'one', atm2wav_map) + call addmrg_to(compwav, 'Sa_v', mrg_from=compatm, mrg_fld='Sa_v', mrg_type='copy') end if if ( fldchk(is_local%wrap%FBexp(compwav) , 'Sa_v10m', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_v10m', rc=rc)) then From efacee46b823ed040848ad71504d5c034415d842 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Apr 2024 12:09:54 +0200 Subject: [PATCH 028/135] fixed typo --- cime_config/config_component_cesm.xml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 5903c3f1c..f98afa7e1 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -142,10 +142,6 @@ the atmosphere to the land and ocean, and the surface upward flux of CO2 to be sent from the land and the open ocean back to the atmosphere. - DMS: sets nuopc.runconfig variable flds_dms_med = .true.; this adds - turns on the computation of DMS flux in the mediator and that flux is passed back to both the - ocean (if prognostic) and the atm (if prognostic) - From edcb64634a342f4658f27daac9e94202e284d51c Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 1 Oct 2024 09:42:58 +0200 Subject: [PATCH 029/135] updated to cmeps1.0.20 --- cime_config/buildnml | 3 ++ cime_config/config_component.xml | 18 +++++++ cime_config/config_component_cesm.xml | 55 ++++++++------------ cime_config/namelist_definition_drv.xml | 37 ++++++++++++-- mediator/esmFldsExchange_cesm_mod.F90 | 67 ++++++++++++++++--------- 5 files changed, 119 insertions(+), 61 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 473cc0246..42569a7a4 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -76,6 +76,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): atm_mesh = case.get_value("ATM_DOMAIN_MESH") lnd_mesh = case.get_value("LND_DOMAIN_MESH") rof_mesh = case.get_value("ROF_DOMAIN_MESH") + ocn_mesh = case.get_value("OCN_DOMAIN_MESH") + wav_mesh = case.get_value("WAV_DOMAIN_MESH") config["samegrid_atm_lnd"] = ( "true" if atm_mesh == case.get_value("LND_DOMAIN_MESH") else "false" ) @@ -89,6 +91,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): "true" if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else "false" ) config["samegrid_lnd_rof"] = "true" if lnd_mesh == rof_mesh else "false" + config["samegrid_wav_ocn"] = "true" if ocn_mesh == wav_mesh else "false" # determine if need to set atm_domainfile scol_lon = float(case.get_value("PTS_LON")) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 63e1b09a8..b4d690a40 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1405,6 +1405,24 @@ rof2ocn runoff mapping file + + char + idmap + run_domain + env_run.xml + ocn2wav state mapping file + + + + char + + unset + + run_domain + env_run.xml + wav2ocn state mapping file + + char 1.0e-02 diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 1f6ceb940..b801f156e 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -65,13 +65,13 @@ env_run.xml integer indicating maximum detail level to profile. This xml - variable is used to set the config variable - timing_detail_limit. This config variable is used by perf_mod + variable is used to set the namelist variable + timing_detail_limit. This namelist variable is used by perf_mod (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off and on depending on calls to the routine t_adj_detailf. If in the code a statement appears like t_adj_detailf(+1), then the current timer detail level is incremented by 1 and compared to the - time_detail_limit obtained from the config. If the limit is + time_detail_limit obtained from the namelist. If the limit is exceeded then the timer is turned off. @@ -102,7 +102,7 @@ char - none,CO2A,CO2B,CO2C,CO2C:DMS,CO2A:DMS + none,CO2A,CO2B,CO2C none CO2A @@ -113,35 +113,31 @@ CO2A CO2A CO2A - CO2C:DMS - CO2A:DMS - DMS - CO2A - CO2A - CO2A - CO2A - CO2C CO2C + CO2A + CO2A run_coupling env_run.xml Activates additional CO2-related fields to be exchanged between components. Possible values are: - CO2A: sets nuopc.runconfig variable flds_co2a = .true.; this adds + CO2A: sets the driver namelist variable flds_co2a = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean. - CO2B: sets nuopc.runconfig variable flds_co2b = .true.; this adds + CO2B: sets the driver namelist variable flds_co2b = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere just to the land, and the surface upward flux of CO2 to be sent from the land back to the atmosphere - CO2C: sets nuopc.runconfig variable flds_co2c = .true.; this adds + CO2C: sets the driver namelist variable flds_co2c = .true.; this adds prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean, and the surface upward flux of CO2 to be sent from the land and the open ocean back to the atmosphere. + The namelist variables flds_co2a, flds_co2b and flds_co2c are in the + namelist group cpl_flds_inparm. @@ -216,7 +212,7 @@ hour Base period associated with NCPL coupling frequency. - This xml variable is only used to set the driver config variables, + This xml variable is only used to set the driver namelist variables, atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. @@ -287,23 +283,15 @@ 1 - + + 24 48 - - - - - - - - - 72 run_coupling env_run.xml Number of atm coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver config atm_cpl_dt, equal to basedt/ATM_NCPL, + This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -316,7 +304,7 @@ run_coupling env_run.xml Number of land coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver config atm_cpl_dt, equal to basedt/LND_NCPL, + This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -329,7 +317,7 @@ run_coupling env_run.xml Number of ice coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver config ice_cpl_dt, equal to basedt/ICE_NCPL + This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -341,13 +329,11 @@ 24 1 24 - 24 - 48 run_coupling env_run.xml Number of ocn coupling intervals per NCPL_BASE_PERIOD. - Thisn is used to set the driver config ocn_cpl_dt, equal to basedt/OCN_NCPL + Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -407,7 +393,7 @@ run_coupling env_run.xml Number of rof coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver config rof_cpl_dt, equal to basedt/ROF_NCPL + This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. @@ -417,10 +403,11 @@ run_coupling env_run.xml Number of wav coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver config wav_cpl_dt, equal to basedt/WAV_NCPL + This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL where basedt is equal to NCPL_BASE_PERIOD in seconds. + diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7dd1237fa..80a599314 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2299,6 +2299,34 @@ + + char + mapping + abs + MED_attributes + + ocn to wav state mapping file for states + + + idmap + $OCN2WAV_SMAPNAME + + + + + char + mapping + abs + MED_attributes + + wav to ocn state mapping file for states + + + idmap + $WAV2OCN_SMAPNAME + + + @@ -2388,9 +2416,10 @@ .false. - .true. + .true. + logical flds @@ -2402,9 +2431,10 @@ .false. - .true. + .true. + logical flds @@ -2416,7 +2446,7 @@ .false. - .true. + .true. @@ -2483,6 +2513,7 @@ + logical flds diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 0e9f8efb2..0f6ccf022 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -75,6 +75,10 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' + ! optional mapping files + character(len=CX) :: wav2ocn_map ='unset' + character(len=CX) :: ocn2wav_map = 'unset' + ! no mapping files (value is 'idmap' or 'unset') character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' @@ -84,9 +88,7 @@ module esmFldsExchange_cesm_mod character(len=CX) :: ice2wav_map = 'unset' character(len=CX) :: lnd2atm_map = 'unset' character(len=CX) :: ocn2atm_map = 'unset' - character(len=CX) :: ocn2wav_map = 'unset' character(len=CX) :: rof2ocn_map = 'unset' - character(len=CX) :: wav2ocn_map = 'unset' logical :: mapuv_with_cart3d ! Map U/V vector wind fields from ATM to OCN/ICE by rotating in Cartesian 3D space and then back logical :: flds_i2o_per_cat ! Ice thickness category fields passed to OCN @@ -95,6 +97,7 @@ module esmFldsExchange_cesm_mod logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND + logical :: add_gusts ! Whether to include fields related to the gustiness parameterization character(*), parameter :: u_FILE_u = & __FILE__ @@ -202,6 +205,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_map) + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_map, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (maintask) write(logunit, '(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_map) + + ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -232,6 +243,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths + ! are fields related to the gustiness parameterization enabled? + call NUOPC_CompAttributeGet(gcomp, name='add_gusts', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) add_gusts + ! write diagnostic output if (maintask) then write(logunit,'(a)' ) ' flds_co2a: prognostic and diagnostic CO2 at lowest atm level is sent to lnd and ocn' @@ -246,6 +262,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths + write(logunit,'(a,l7)') trim(subname)//' add_gusts = ', add_gusts write(logunit,'(a,l7)') trim(subname)//' mapuv_with_cart3d = ',mapuv_with_cart3d end if @@ -1414,17 +1431,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: unmerged ugust_out from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_ugustOut') - call addfld_to(compatm, 'So_ugustOut') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_ugustOut') + call addfld_to(compatm, 'So_ugustOut') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_ugustOut', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_ugustOut', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_ugustOut', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_ugustOut', & + mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_ugustOut', & - mrg_from=compmed, mrg_fld='So_ugustOut', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1432,17 +1451,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to atm: 10 m winds including/excluding gust component ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_aoflux('So_u10withGust') - call addfld_to(compatm, 'So_u10withGust') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + if (add_gusts) then + if (phase == 'advertise') then + call addfld_aoflux('So_u10withGust') + call addfld_to(compatm, 'So_u10withGust') + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'So_u10withGust', rc=rc)) then + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_u10withGust', rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_u10withGust', compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'So_u10withGust', & + mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'So_u10withGust', & - mrg_from=compmed, mrg_fld='So_u10withGust', mrg_type='merge', mrg_fracname='ofrac') end if end if end if @@ -1693,7 +1714,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------------------------------------------------------- ! to atm: surface flux of dms from ocean - !----------------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(compocn, 'Faoo_fdms_ocn') @@ -1745,7 +1765,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_fnh3_ocn', rc=rc)) then call addmap_from(compocn, 'Faoo_fnh3_ocn', compatm, mapconsd, 'one', ocn2atm_map) ! custom merge in med_phases_prep_atm - end if end if From 6bc9b063738247ffc25422b160ab8de53c4949e4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 1 Nov 2024 16:21:04 +0100 Subject: [PATCH 030/135] changes to get tracers to be updated correctly --- cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 | 19 +++--- cime_config/namelist_definition_drv_flds.xml | 26 ++++---- mediator/esmFldsExchange_cesm_mod.F90 | 30 ++++++++- mediator/fd_cesm.yaml | 14 ++++- mediator/med_phases_prep_rof_mod.F90 | 64 ++++++++------------ 5 files changed, 87 insertions(+), 66 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 index 0a2766b25..079a0a77b 100644 --- a/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 +++ b/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 @@ -1,9 +1,8 @@ module shr_lnd2rof_tracers_mod !======================================================================== - ! Module for handling nitrogen depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers + ! read lnd2rof_tracers_inparm namelist and sets up driver list of fields for + ! lnd -> river communications !======================================================================== use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet @@ -29,11 +28,6 @@ module shr_lnd2rof_tracers_mod subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) - !======================================================================== - ! reads lnd2rof_tracers_inparm namelist and sets up driver list of fields for - ! lnd -> river communications - !======================================================================== - ! input/output variables character(len=*), intent(in) :: NLFilename ! Namelist filename character(len=*), intent(out) :: lnd2rof_tracer_list ! Colon delimited string of liquid lnd2rof tracers @@ -50,7 +44,6 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) integer :: logunit character(len=CS) :: lnd2rof_tracers character(*),parameter :: subName = '(shr_lnd2rof_tracers_readnl) ' - character(*),parameter :: F00 = "('(shr_lnd2rof_tracers_readnl) ',8a)" ! ------------------------------------------------------------------ namelist /lnd2rof_tracers_inparm/ lnd2rof_tracers @@ -69,6 +62,7 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) call shr_log_getLogUnit(logunit) lnd2rof_tracers = ' ' + lnd2rof_tracer_list = ' ' call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -76,10 +70,9 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (localpet==0) then - inquire( file=trim(NLFileName), exist=exists) + inquire(file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) - write(logunit,F00) 'Read in lnd2rof_tracers_inparm namelist from: ', trim(NLFilename) call shr_nl_find_group_name(unitn, 'lnd2rof_tracers_inparm', ierr) if (ierr == 0) then ! Note that if ierr /= 0, no namelist is present. @@ -93,7 +86,9 @@ subroutine shr_lnd2rof_tracers_readnl(NLFilename, lnd2rof_tracer_list) end if call shr_mpi_bcast( lnd2rof_tracers, mpicom ) - lnd2rof_tracer_list = trim(lnd2rof_tracers) + if (lnd2rof_tracers /= ' ') then + lnd2rof_tracer_list = trim(lnd2rof_tracers) + end if end subroutine shr_lnd2rof_tracers_readnl diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index 519229401..cf5820d04 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -141,6 +141,19 @@ + + + + + + char + lnd2rof_tracers + lnd2rof_tracers_inparm + + Liquid lnd2rof tracers (other than water) + + + @@ -197,17 +210,4 @@ - - - - - - char - lnd2rof_tracers - lnd2rof_tracers_inparm - - Liquid lnd2rof tracers (other than water) - - - diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 0f6ccf022..5a8d3ad1b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -75,10 +75,10 @@ module esmFldsExchange_cesm_mod character(len=CX) :: rof2lnd_map = 'unset' character(len=CX) :: lnd2rof_map = 'unset' - ! optional mapping files + ! optional mapping files character(len=CX) :: wav2ocn_map ='unset' character(len=CX) :: ocn2wav_map = 'unset' - + ! no mapping files (value is 'idmap' or 'unset') character(len=CX) :: atm2ice_map = 'unset' character(len=CX) :: atm2ocn_map = 'unset' @@ -2383,11 +2383,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! fldlistFr(comprof) in order to be mapped correctly to the ocean but the ocean ! does not receive it so it is advertised but it will not be connected call addfld_from(comprof, 'Forr_rofl') + call addfld_from(comprof, 'Forr_rofl_nonh2o') call addfld_from(comprof, 'Forr_rofi') call addfld_from(comprof, 'Forr_rofl_glc') call addfld_from(comprof, 'Forr_rofi_glc') call addfld_to(compocn, 'Foxx_rofl') call addfld_to(compocn, 'Foxx_rofi') + call addfld_to(compocn, 'Forr_rofl_nonh2o') call addfld_to(compocn, 'Forr_rofl_glc') call addfld_to(compocn, 'Forr_rofi_glc') call addfld_to(compocn, 'Flrr_flood') @@ -2402,6 +2404,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_nonh2o' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_nonh2o' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + end if + end if if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) @@ -3243,6 +3254,21 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to rof: non-water flux(es) from land (liquid surface) + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofsur_nonh2o') + call addfld_to(comprof, 'Flrl_rofsur_nonh2o') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur_nonh2o', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur_nonh2o', rc=rc)) then + call addmap_from(complnd, 'Flrl_rofsur_nonh2o', comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_rofsur_nonh2o', & + mrg_from=complnd, mrg_fld='Flrl_rofsur_nonh2o', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if + end if + ! --------------------------------------------------------------------- ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index e41c61dff..93cad82d5 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -222,6 +222,10 @@ canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofsur_nonh2o + canonical_units: kg m-2 s-1 + description: lnd export to river for non-water liquid tracers + # - standard_name: Sl_topo_elev canonical_units: m description: lnd import to med with elevation classes (1->glc_nec) @@ -1204,12 +1208,20 @@ # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (liquid) + description: river import to med - liquid water flux due to runoff + # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux due to runoff # - standard_name: Forr_rofl_glc canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff originating from glc (liquid) # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux(es) due to runoff originating from lnd (liquid) + # - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 752db2160..a8a7525f8 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -95,12 +95,12 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, nflds integer :: lrank - integer :: ungriddedUBound(1) + integer :: n, nflds type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield + integer :: ungriddedUBound(1) type(med_fldList_type), pointer :: fldList type(med_fldList_entry_type), pointer :: fldptr character(len=CS) :: fldname @@ -125,14 +125,20 @@ subroutine med_phases_prep_rof_init(gcomp, rc) do while(associated(fldptr)) call med_fld_GetFldInfo(fldptr, stdname=fldname) if (trim(fldname) .ne. trim(is_local%wrap%flds_scalar_name)) then - n = n+1 - fldnames_temp(n) = fldname - endif + if (fldbun_fldchk(is_local%wrap%FBImp(complnd,complnd), trim(fldname), rc=rc) .and. & + fldbun_fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc) ) then + n = n+1 + fldnames_temp(n) = fldname + endif + end if fldptr => fldptr%next enddo allocate(lnd2rof_flds(n)) - lnd2rof_flds = fldnames_temp(1:n) + lnd2rof_flds(1:n) = fldnames_temp(1:n) deallocate(fldnames_temp) + do n = 1,size(lnd2rof_flds) + write(6,*)'DEBUG: n,lnd2rof_fld = ',n,trim(lnd2rof_flds(n)) + end do ! Get lnd and rof meshes call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) @@ -157,7 +163,6 @@ subroutine med_phases_prep_rof_init(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Create accumulation field on lnd grid if (lrank == 2) then lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) @@ -166,24 +171,19 @@ subroutine med_phases_prep_rof_init(gcomp, rc) lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - - ! Add field to accumulation field bundle on lnd grid call ESMF_FieldBundleAdd(FBlndAccum2rof_l, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_l', & ESMF_LOGMSG_INFO) - ! Create accumulation field on rof grid - first determine rank and ubound if rank is 2 if (lrank == 2) then lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT) + lfield = ESMF_FieldCreate(mesh_r, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - - ! Add field to accumulation field bundle on rof grid call ESMF_FieldBundleAdd(FBlndAccum2rof_r, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_r', & @@ -271,7 +271,6 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! determine rank of field if (lrank == 2) then call field_getdata2d(lfield, dataptr2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -310,7 +309,6 @@ subroutine med_phases_prep_rof(gcomp, rc) ! Prepare the ROF export Fields from the mediator !------------------------------------ - use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet @@ -326,13 +324,13 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n - integer :: lrank + integer :: n,ns,nf integer :: count logical :: exists - real(r8), pointer :: dataptr(:) - real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) + integer :: lrank + real(r8), pointer :: dataptr_in(:) + real(r8), pointer :: dataptr_out(:) + real(r8), pointer :: dataptr2d_out(:,:) type(ESMF_Field) :: lfield type(med_fldList_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' @@ -373,22 +371,21 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! determine rank of field if (lrank == 2) then - call field_getdata2d(lfield, dataptr2d, rc=rc) + call field_getdata2d(lfield, dataptr2d_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (count == 0) then - dataptr2d(:,:) = czero + dataptr2d_out(:,:) = czero else - dataptr2d(:,:) = dataptr2d(:,:) / real(count, r8) + dataptr2d_out(:,:) = dataptr2d_out(:,:) / real(count, r8) end if else - call field_getdata1d(lfield, dataptr1d, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (count == 0) then - dataptr1d(:) = czero + dataptr_out(:) = czero else - dataptr1d(:) = dataptr1d(:) / real(count, r8) + dataptr_out(:) = dataptr_out(:) / real(count, r8) end if end if end if @@ -492,18 +489,9 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + call field_getdata1d(lfield, dataptr_out, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! determine rank of field - if (lrank == 2) then - call field_getdata2d(lfield, dataptr2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr2d(:,:) = czero - else - call field_getdata1d(lfield, dataptr1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr1d(:) = czero - end if + dataptr_out(:) = czero end if end do From e3994d4eb979545b709e4e4e8277f9966c1d96b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 6 Nov 2024 11:28:21 +0100 Subject: [PATCH 031/135] new lnd2med aux files --- cime_config/namelist_definition_drv.xml | 69 ++++++++++++++++++++++++- mediator/med_phases_prep_rof_mod.F90 | 3 -- 2 files changed, 67 insertions(+), 5 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 80a599314..ed0036e8b 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1795,6 +1795,71 @@ + + + logical + aux_hist + MED_attributes + Auxiliary mediator l2x fields every lnd coupling interval + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator lnd2med output every lnd coupling interval + + 'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub' + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 365 + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + lnd.ncpl.inst + + + @@ -2326,7 +2391,7 @@ $WAV2OCN_SMAPNAME - + @@ -3729,7 +3794,7 @@ components that need to look at the same data. - Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in,Buildconf/dlndconf/drv_flds_in diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index a8a7525f8..9947c198e 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -136,9 +136,6 @@ subroutine med_phases_prep_rof_init(gcomp, rc) allocate(lnd2rof_flds(n)) lnd2rof_flds(1:n) = fldnames_temp(1:n) deallocate(fldnames_temp) - do n = 1,size(lnd2rof_flds) - write(6,*)'DEBUG: n,lnd2rof_fld = ',n,trim(lnd2rof_flds(n)) - end do ! Get lnd and rof meshes call fldbun_getmesh(is_local%wrap%FBImp(complnd,complnd), mesh_l, rc) From ab0854bd9c04b99b3767c2fd9f07a305f5180b78 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 21 Nov 2024 12:47:19 +0100 Subject: [PATCH 032/135] fixes for more than 1 additional liquid tracer --- mediator/med_phases_post_rof_mod.F90 | 54 +++++++++++++++++++++++----- mediator/med_phases_prep_rof_mod.F90 | 12 +++++-- 2 files changed, 55 insertions(+), 11 deletions(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 036eeca30..d1a7076c9 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -8,7 +8,7 @@ module med_phases_post_rof_mod use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_Mesh, ESMF_MESHLOC_ELEMENT, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_Field, ESMF_FieldCreate + use ESMF , only : ESMF_Field, ESMF_FieldCreate, ESMF_FieldGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleCreate use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldBundleAdd use ESMF , only : ESMF_VM, ESMF_VMAllreduce, ESMF_REDUCE_SUM @@ -19,6 +19,7 @@ module med_phases_post_rof_mod use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed + use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh use perf_mod , only : t_startf, t_stopf @@ -47,7 +48,7 @@ module med_phases_post_rof_mod character(len=13), parameter :: fields_to_remove_negative_runoff_glc(2) = & ['Forr_rofl_glc', & 'Forr_rofi_glc'] - + character(*) , parameter :: u_FILE_u = & __FILE__ @@ -119,7 +120,11 @@ subroutine med_phases_post_rof_init(gcomp, rc) call t_stopf('MED:'//subname) end subroutine med_phases_post_rof_init + !================================================================================================ + subroutine med_phases_post_rof(gcomp, rc) + !--------------------------------------------------------------- + ! Post runoff phase ! input/output variables type(ESMF_GridComp) :: gcomp @@ -128,10 +133,14 @@ subroutine med_phases_post_rof(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Clock) :: dClock + type(ESMF_field) :: lfield real(r8), pointer :: data_orig(:) real(r8), pointer :: data_copy(:) + real(r8), pointer :: data_orig2d(:,:) + real(r8), pointer :: data_copy2d(:,:) integer :: n logical :: exists + integer :: ungriddedUBound(1) character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -147,11 +156,23 @@ subroutine med_phases_post_rof(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, num_rof_fields - call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), rof_field_names(n), field=lfield, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(FBrof_r, trim(rof_field_names(n)), data_copy, rc=rc) + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - data_copy(:) = data_orig(:) + if (ungriddedUBound(1) > 0) then + call fldbun_getdata2d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata2d(FBrof_r, trim(rof_field_names(n)), data_copy2d, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + data_copy2d(:,:) = data_orig2d(:,:) + else + call fldbun_getdata1d(is_local%wrap%FBImp(comprof,comprof), trim(rof_field_names(n)), data_orig, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call fldbun_getdata1d(FBrof_r, trim(rof_field_names(n)), data_copy, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + data_copy(:) = data_orig(:) + end if end do if (remove_negative_runoff_lnd) then @@ -230,6 +251,8 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof + !================================================================================================ + subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) !--------------------------------------------------------------- ! Create FBrof_r @@ -240,9 +263,10 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n - type(ESMF_Mesh) :: mesh - type(ESMF_Field) :: field + integer :: n + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: field + integer :: ungriddedUBound(1) integer, parameter :: dbug_threshold = 20 ! threshold for writing debug information in this subroutine character(len=*), parameter :: subname='(med_phases_post_rof_mod: med_phases_post_rof_create_rof_field_bundle)' !--------------------------------------- @@ -272,8 +296,18 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) FBrof_r = ESMF_FieldBundleCreate(name='FBrof_r', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1, num_rof_fields - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + call ESMF_FieldBundleGet(is_local%wrap%FBImp(comprof,comprof), rof_field_names(n), field=field, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, ungriddedUBound=ungriddedUBound, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ungriddedUBound(1) > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if call ESMF_FieldBundleAdd(FBrof_r, (/field/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -285,6 +319,8 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) end subroutine med_phases_post_rof_create_rof_field_bundle + !================================================================================================ + subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) !--------------------------------------------------------------- ! For one runoff field, remove negative runoff by downweighting all positive runoff to diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 9947c198e..152287b78 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -486,9 +486,17 @@ subroutine med_phases_prep_rof(gcomp, rc) if (exists) then call ESMF_FieldBundleGet(FBlndAccum2rof_l, fieldName=trim(lnd2rof_flds(n)), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getdata1d(lfield, dataptr_out, rc=rc) + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - dataptr_out(:) = czero + if (lrank == 2) then + call field_getdata2d(lfield, dataptr2d_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr2d_out(:,:) = czero + else + call field_getdata1d(lfield, dataptr_out, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + dataptr_out(:) = czero + end if end if end do From dd6f5489406c938338dcb1175ba21363dcd0cc34 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 24 Nov 2024 22:41:18 +0100 Subject: [PATCH 033/135] backed out two changes temporarily until new esmf6.0.1 library is built on betzy --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_aofluxes_mod.F90 | 39 ++++++++++--------------- 2 files changed, 16 insertions(+), 25 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0226bf83c..fb9b7438c 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -925,7 +925,7 @@ default: ogrid - xgrid + ogrid ogrid diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 6cf7280e7..b910c1a68 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -780,7 +780,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount - integer :: srcTermProcessing_Value ! srcTermProcessing is declared inout and must have variable not constant + integer :: stp ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -788,8 +788,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) rc = ESMF_SUCCESS - srcTermProcessing_Value = 0 - ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -879,26 +877,23 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) dataptr(:) = 1.0_r8 ! create agrid->xgrid route handles - call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then + stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! create xgrid->zgrid route handle - call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! destroy temporary field @@ -916,14 +911,12 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_r8 - call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, & - srcTermProcessing=srcTermProcessing_Value, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, & - ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) + ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldDestroy(field_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1644,13 +1637,7 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! The following conditional captures the cases where aoflux_in%psfc is needed in calls - ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode=='cesm' is equivalent to - ! the CESMCOUPLED CPP token, and coupling_mode(1:3)=='ufs' is roughly equivalent to - ! the UFS_AOFLUX CPP token (noting that we should only be in this subroutine if using - ! one of the aoflux variants of the ufs coupling_mode). - if ((trim(coupling_mode) == 'cesm') .or. & - (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp')) then + if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1659,6 +1646,10 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'ufs.frac.aoflux') then + call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if if (flds_wiso) then From f8fca11d7a19e261f01cc920d84cd5a79af46462 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 26 Nov 2024 14:35:56 +0100 Subject: [PATCH 034/135] updated to exactly match cmeps1.0.24 - required update of esmf to esmf8.6.0 --- cime_config/namelist_definition_drv.xml | 4 +-- mediator/med_phases_aofluxes_mod.F90 | 39 +++++++++++++++---------- 2 files changed, 26 insertions(+), 17 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index fb9b7438c..be078a466 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -925,7 +925,7 @@ default: ogrid - ogrid + xgrid ogrid @@ -2329,7 +2329,7 @@ $WAV2OCN_SMAPNAME - + diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b910c1a68..6cf7280e7 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -780,7 +780,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount - integer :: stp ! srcTermProcessing is declared inout and must have variable not constant + integer :: srcTermProcessing_Value ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -788,6 +788,8 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) rc = ESMF_SUCCESS + srcTermProcessing_Value = 0 + ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) @@ -877,23 +879,26 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) dataptr(:) = 1.0_r8 ! create agrid->xgrid route handles - call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & - regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then - stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! create xgrid->zgrid route handle - call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_a, routehandle=rh_xgrid2agrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! destroy temporary field @@ -911,12 +916,14 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldGet(field_o, farrayptr=dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_r8 - call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, rc=rc) + call ESMF_FieldRegridStore(xgrid, field_x, field_o, routehandle=rh_xgrid2ogrid, & + srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! call ESMF_FieldRegridStore(xgrid, field_o, field_x, routehandle=rh_ogrid2xgrid_2ndord, & - ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) + ! regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldDestroy(field_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1637,7 +1644,13 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then + ! The following conditional captures the cases where aoflux_in%psfc is needed in calls + ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode=='cesm' is equivalent to + ! the CESMCOUPLED CPP token, and coupling_mode(1:3)=='ufs' is roughly equivalent to + ! the UFS_AOFLUX CPP token (noting that we should only be in this subroutine if using + ! one of the aoflux variants of the ufs coupling_mode). + if ((trim(coupling_mode) == 'cesm') .or. & + (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp')) then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -1646,10 +1659,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'ufs.frac.aoflux') then - call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if end if if (flds_wiso) then From bf60775dd744cbc1c755d05fba1d2c58598690b8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 28 Nov 2024 11:07:01 +0100 Subject: [PATCH 035/135] update to have ogrid be the default since xgrid does not work for ne30pg3_tn14 --- cime_config/namelist_definition_drv.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index be078a466..fb9b7438c 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -925,7 +925,7 @@ default: ogrid - xgrid + ogrid ogrid @@ -2329,7 +2329,7 @@ $WAV2OCN_SMAPNAME - + From d4334dc0dde610a8b276743dad63aa9ea39cb77e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 2 Dec 2024 11:49:05 +0100 Subject: [PATCH 036/135] changes to get data2glc working correctly --- mediator/med_phases_history_mod.F90 | 79 +++++++++++----- mediator/med_phases_post_ocn_mod.F90 | 1 - mediator/med_phases_prep_glc_mod.F90 | 136 ++++++++++++++++++--------- 3 files changed, 146 insertions(+), 70 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 6859a6c9a..a4a7e98e1 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -19,7 +19,7 @@ module med_phases_history_mod use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : ncomps, compname + use med_internalstate_mod , only : ncomps, compname, compocn, complnd use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -35,9 +35,13 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of + ! implnd->glc (on land grid), + ! impocn->glc (on ocn grid) and + ! inst only, average (normally yearly) of + ! export->glc (on glc grid) ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component @@ -524,20 +528,21 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) + subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd, compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod , only : compglc + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd - integer , intent(out) :: rc - type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle + integer , optional , intent(in) :: comp_import ! either land or ocean component id + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array + integer , intent(out) :: rc ! local variables type(file_desc_t) :: io_file @@ -609,15 +614,31 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - ! Create history file + if (present(comp_import)) then + if (.not. present(fldbun_import)) then + call ESMF_LogWrite(subname//'if comp_import is present, then fldbun_import must be present', ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + if (comp_import == complnd) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' + else if (comp_import == compocn) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' + end if + else + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' + end if + + ! Open output file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write data to history file + ! Write data to file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -630,18 +651,26 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & - is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & - nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(fldbun_glc)) then - do n = 1,size(fldbun_glc) - call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + if (present(fldbun_import)) then + ! import field bundle + call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & + is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & + nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (present(fldbun_export)) then + ! export field bundle + do n = 1,size(fldbun_export) + call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + else + call ESMF_LogWrite(subname//'either fldbun_import or fldbun_export must be present as arguments') + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if end if end do ! end of loop over m @@ -650,7 +679,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_lnd2glc + end subroutine med_phases_history_write_data2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index b253de664..bfc234507 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -83,7 +83,6 @@ subroutine med_phases_post_ocn(gcomp, rc) ! Accumulate ocn input for glc if there is ocn->glc coupling if (is_local%wrap%ocn2glc_coupling) then - call ESMF_LogWrite(subname//' DEBUG: calling med_phases_prep_glc_accum_ocn', ESMF_LOGMSG_INFO) call med_phases_prep_glc_accum_ocn(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 4eff5966f..b95035f7d 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -109,6 +109,8 @@ module med_phases_prep_glc_mod type(ESMF_DynamicMask) :: dynamicOcnMask integer, parameter :: num_ocndepths = 30 + logical :: write_histaux_l2x1yrg + type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & __FILE__ @@ -136,6 +138,8 @@ subroutine med_phases_prep_glc_init(gcomp, rc) type(ESMF_Field) :: lfield character(len=CS) :: glc_renormalize_smb integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds + character(len=CS) :: cvalue + logical :: isPresent, isSet character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -302,6 +306,16 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if end do end if + + ! Determine if auxiliary files to be written + write_histaux_l2x1yrg = .false. + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if ! ------------------------------- @@ -479,7 +493,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Prepare the GLC export Fields from the mediator !--------------------------------------- - use med_phases_history_mod, only : med_phases_history_write_lnd2glc + use med_phases_history_mod, only : med_phases_history_write_data2glc ! input/output variables type(ESMF_GridComp) :: gcomp @@ -498,13 +512,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm - integer :: n, ns + integer :: n, ns, i, nf real(r8), pointer :: data2d(:,:) real(r8), pointer :: data2d_import(:,:) character(len=CS) :: cvalue logical :: do_avg logical :: isPresent, isSet - logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -601,9 +614,17 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) end if + ! ---------------------------------------------- ! Average and map data from land (and possibly ocean) + ! ---------------------------------------------- + if (do_avg) then - ! Always average import from accumulated land import data + + ! ---------------------------------------------- + ! land accumulation and mapping if appropriate + ! ---------------------------------------------- + + ! Average import from accumulated lnd import data do n = 1, size(fldnames_fr_lnd) if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) @@ -621,14 +642,38 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end do - if (is_local%wrap%ocn2glc_coupling) then - ! Average import from accumulated ocn import data - do n = 1, size(fldnames_fr_ocn) + ! Write import auxiliary file for lnd if appropriate + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBlndAccum2glc_l, comp_import=complnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (is_local%wrap%lnd2glc_coupling) then + ! Map accumulated field bundle from land grid (with + ! elevation classes) to glc grid (without elevation classes) + ! and set FBExp(compglc(ns)) data + ! Zero land accumulator and accumulated field bundles on land grid + call med_phases_prep_glc_map_lnd2glc(gcomp, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! ---------------------------------------------- + ! ocean accumulation and mapping if appropriate + ! ---------------------------------------------- + + ! Average import from accumulated ocn import data + do n = 1, size(fldnames_fr_ocn) + if (fldchk(FBocnAccum2glc_o, fldnames_fr_ocn(n), rc=rc)) then call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ocnAccum2glc_cnt > 0) then ! If accumulation count is greater than 0, do the averaging data2d(:,:) = data2d(:,:) / real(ocnAccum2glc_cnt) + do nf = 1,size(data2d,dim=2) + do i = 1,size(data2d,dim=1) + if (data2d(i,n) > .9*1.e30) data2d(i,n) = 1.e30 + end do + end do else ! If accumulation count is 0, then simply set the averaged field bundle values from the ocn ! to the import field bundle values @@ -636,14 +681,22 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return data2d(:,:) = data2d_import(:,:) end if - end do - if (dbug_flag > 1) then - call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return end if + end do + if (dbug_flag > 1) then + call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Write import auxiliary file for ocn if appropriate + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBocnAccum2glc_o, comp_import=compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - ! Map accumulated ocean field from ocean mesh to land mesh and set FBExp(compglc(ns)) data - ! Zero land accumulator and accumulated field bundles on ocean grid + if (is_local%wrap%ocn2glc_coupling) then + ! Map accumulated ocean field from ocean mesh to glc mesh(es) and set FBExp(compglc(ns)) data + ! Zero ocean accumulator and accumulated field bundles on ocean grid do n = 1,size(fldnames_fr_ocn) call ESMF_FieldBundleGet(FBocnAccum2glc_o, fldnames_fr_ocn(n), field=lfield_src, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return @@ -661,43 +714,38 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) where (data2d == 0._r8) data2d = shr_const_spval end do end do - ocnAccum2glc_cnt = 0 - call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if + end if ! end of if (is_local%wrap%ocn2glc_coupling) - ! Determine if auxiliary file will be written - write_histaux_l2x1yrg = .false. - if (lndAccum2glc_cnt > 0) then - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) + if (dbug_flag > 1) then + do ns = 1,is_local%wrap%num_icesheets + call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end do + endif + + ! ---------------------------------------------- + ! Write auxiliary history file if will export to glc + ! ---------------------------------------------- + + if (is_local%wrap%lnd2glc_coupling .and. write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_export=is_local%wrap%FBExp(compglc(:)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - end if end if - ! Write auxiliary history file if flag is set and accumulation is being done - if (is_local%wrap%lnd2glc_coupling) then - ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) - ! and set FBExp(compglc(ns)) data - ! Zero land accumulator and accumulated field bundles on land grid - call med_phases_prep_glc_map_lnd2glc(gcomp, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return + ! ---------------------------------------------- + ! Reset accumulators + ! ---------------------------------------------- - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, & - fldbun_glc=is_local%wrap%FBExp(compglc(:)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (do_avg) then + if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then + lndAccum2glc_cnt = 0 + call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return end if - - lndAccum2glc_cnt = 0 - call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - else - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fldchk(FBocnAccum2glc_o, fldnames_fr_ocn(n), rc=rc)) then + ocnAccum2glc_cnt = 0 + call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return end if end if From b44e4ee26b60f8c89d5018633905aa5f737488e3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 3 Dec 2024 21:19:42 +0100 Subject: [PATCH 037/135] fixed problem in med_phases_prep_glc_mod for days greater than the first day --- mediator/med_phases_prep_glc_mod.F90 | 162 +++++++++++---------------- 1 file changed, 63 insertions(+), 99 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index b95035f7d..331a48a96 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -109,8 +109,6 @@ module med_phases_prep_glc_mod type(ESMF_DynamicMask) :: dynamicOcnMask integer, parameter :: num_ocndepths = 30 - logical :: write_histaux_l2x1yrg - type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & __FILE__ @@ -138,8 +136,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) type(ESMF_Field) :: lfield character(len=CS) :: glc_renormalize_smb integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds - character(len=CS) :: cvalue - logical :: isPresent, isSet character(len=*),parameter :: subname=' (med_phases_prep_glc_init) ' !--------------------------------------- @@ -306,16 +302,6 @@ subroutine med_phases_prep_glc_init(gcomp, rc) end if end do end if - - ! Determine if auxiliary files to be written - write_histaux_l2x1yrg = .false. - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - end if - end if ! ------------------------------- @@ -512,12 +498,13 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm - integer :: n, ns, i, nf + integer :: n, ns real(r8), pointer :: data2d(:,:) real(r8), pointer :: data2d_import(:,:) character(len=CS) :: cvalue logical :: do_avg logical :: isPresent, isSet + logical :: write_histaux_l2x1yrg character(len=*) , parameter :: subname=' (med_phases_prep_glc) ' !--------------------------------------- @@ -618,13 +605,20 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Average and map data from land (and possibly ocean) ! ---------------------------------------------- - if (do_avg) then + ! Determine if auxiliary file will be written + write_histaux_l2x1yrg = .false. + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if - ! ---------------------------------------------- - ! land accumulation and mapping if appropriate - ! ---------------------------------------------- + if (do_avg) then - ! Average import from accumulated lnd import data + ! Always average import from accumulated land import data do n = 1, size(fldnames_fr_lnd) if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) @@ -642,38 +636,14 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end do - ! Write import auxiliary file for lnd if appropriate - if (write_histaux_l2x1yrg) then - call med_phases_history_write_data2glc(gcomp, fldbun_import=FBlndAccum2glc_l, comp_import=complnd, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - if (is_local%wrap%lnd2glc_coupling) then - ! Map accumulated field bundle from land grid (with - ! elevation classes) to glc grid (without elevation classes) - ! and set FBExp(compglc(ns)) data - ! Zero land accumulator and accumulated field bundles on land grid - call med_phases_prep_glc_map_lnd2glc(gcomp, rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! ---------------------------------------------- - ! ocean accumulation and mapping if appropriate - ! ---------------------------------------------- - - ! Average import from accumulated ocn import data - do n = 1, size(fldnames_fr_ocn) - if (fldchk(FBocnAccum2glc_o, fldnames_fr_ocn(n), rc=rc)) then + if (is_local%wrap%ocn2glc_coupling) then + ! Average import from accumulated ocn import data + do n = 1, size(fldnames_fr_ocn) call fldbun_getdata2d(FBocnAccum2glc_o, fldnames_fr_ocn(n), data2d, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (ocnAccum2glc_cnt > 0) then ! If accumulation count is greater than 0, do the averaging data2d(:,:) = data2d(:,:) / real(ocnAccum2glc_cnt) - do nf = 1,size(data2d,dim=2) - do i = 1,size(data2d,dim=1) - if (data2d(i,n) > .9*1.e30) data2d(i,n) = 1.e30 - end do - end do else ! If accumulation count is 0, then simply set the averaged field bundle values from the ocn ! to the import field bundle values @@ -681,22 +651,14 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return data2d(:,:) = data2d_import(:,:) end if + end do + if (dbug_flag > 1) then + call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return end if - end do - if (dbug_flag > 1) then - call fldbun_diagnose(FBocnAccum2glc_o, string=trim(subname)//' FBocnAccum for after avg for field bundle ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Write import auxiliary file for ocn if appropriate - if (write_histaux_l2x1yrg) then - call med_phases_history_write_data2glc(gcomp, fldbun_import=FBocnAccum2glc_o, comp_import=compocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - if (is_local%wrap%ocn2glc_coupling) then - ! Map accumulated ocean field from ocean mesh to glc mesh(es) and set FBExp(compglc(ns)) data - ! Zero ocean accumulator and accumulated field bundles on ocean grid + ! Map accumulated ocean field from ocean mesh to land mesh and set FBExp(compglc(ns)) data + ! Zero land accumulator and accumulated field bundles on ocean grid do n = 1,size(fldnames_fr_ocn) call ESMF_FieldBundleGet(FBocnAccum2glc_o, fldnames_fr_ocn(n), field=lfield_src, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return @@ -714,54 +676,56 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) where (data2d == 0._r8) data2d = shr_const_spval end do end do - end if ! end of if (is_local%wrap%ocn2glc_coupling) - if (dbug_flag > 1) then - do ns = 1,is_local%wrap%num_icesheets - call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - endif - - ! ---------------------------------------------- - ! Write auxiliary history file if will export to glc - ! ---------------------------------------------- + ! Write import auxiliary file for lnd if appropriate + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBocnAccum2glc_o, comp_import=compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if - if (is_local%wrap%lnd2glc_coupling .and. write_histaux_l2x1yrg) then - call med_phases_history_write_data2glc(gcomp, fldbun_export=is_local%wrap%FBExp(compglc(:)), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ocnAccum2glc_cnt = 0 + call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return end if - ! ---------------------------------------------- - ! Reset accumulators - ! ---------------------------------------------- + ! Write auxiliary history file if flag is set and accumulation is being done + if (is_local%wrap%lnd2glc_coupling) then + ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) + ! and set FBExp(compglc(ns)) data + ! Zero land accumulator and accumulated field bundles on land grid + call med_phases_prep_glc_map_lnd2glc(gcomp, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return - if (do_avg) then - if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then - lndAccum2glc_cnt = 0 - call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end if - if (fldchk(FBocnAccum2glc_o, fldnames_fr_ocn(n), rc=rc)) then - ocnAccum2glc_cnt = 0 - call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_export=is_local%wrap%FBExp(compglc(:)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if + + if (dbug_flag > 1) then + do ns = 1,is_local%wrap%num_icesheets + call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end do + endif + end if + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBlndAccum2glc_l, comp_import=complnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (dbug_flag > 1) then - do ns = 1,is_local%wrap%num_icesheets - call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - endif - end if + lndAccum2glc_cnt = 0 + call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + end if ! end of do_avg if-block ! Check for nans in fields export to glc - do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + if (is_local%wrap%lnd2glc_coupling) then + do ns = 1,is_local%wrap%num_icesheets + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) From c3be96566a45f31eee5f0af9f2d398c491e6675b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 8 Dec 2024 22:11:18 +0100 Subject: [PATCH 038/135] new docn for multilev --- cime_config/runseq/runseq_TG.py | 11 +++++++++-- mediator/med_phases_prep_glc_mod.F90 | 2 +- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/cime_config/runseq/runseq_TG.py b/cime_config/runseq/runseq_TG.py index acf56a87b..2410f870b 100644 --- a/cime_config/runseq/runseq_TG.py +++ b/cime_config/runseq/runseq_TG.py @@ -15,8 +15,9 @@ def gen_runseq(case, coupling_times): - rundir = case.get_value("RUNDIR") - caseroot = case.get_value("CASEROOT") + rundir = case.get_value("RUNDIR") + caseroot = case.get_value("CASEROOT") + comp_ocn = case.get_value("COMP_OCN") driver_config = DriverConfig(case, coupling_times) run_glc, med_to_glc, glc_cpl_time = driver_config['glc'] @@ -32,9 +33,15 @@ def gen_runseq(case, coupling_times): runseq.add_action ("LND" , run_lnd) runseq.add_action ("LND -> MED :remapMethod=redist" , run_lnd) runseq.add_action ("MED med_phases_post_lnd" , run_lnd) + if (comp_ocn == 'docn'): + runseq.add_action ("OCN" , run_lnd) + runseq.add_action ("OCN -> MED :remapMethod=redist" , run_lnd) + runseq.add_action ("MED med_phases_post_ocn" , run_lnd) runseq.add_action ("MED med_phases_prep_glc" , med_to_glc) runseq.add_action ("MED -> GLC :remapMethod=redist" , med_to_glc) runseq.add_action ("GLC" , run_glc) + + # Need to do GLC -> MED even if not running GLC; otherwise, we get a # failure in InitializeRealize ("Object being used before creation") runseq.add_action ("GLC -> MED :remapMethod=redist" , med_to_glc) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 331a48a96..1707e35d7 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -331,7 +331,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! create route handle if it has not been created do ns = 1,is_local%wrap%num_icesheets if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compglc(ns),:),mapbilnr,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" mapbilnr is not created for ocn->glc mapping", & + call ESMF_LogWrite(trim(subname)//" error: mapbilnr is not created for ocn->glc mapping", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return From fb2bb20fc75faa241094af6cf9096c69991a0df5 Mon Sep 17 00:00:00 2001 From: jmaerz <92309038+jmaerz@users.noreply.github.com> Date: Fri, 7 Mar 2025 11:48:24 +0100 Subject: [PATCH 039/135] Adjust eps_imesh for tnx2 grid in namelist to omit crash at mesh check issue #626 --- cime_config/namelist_definition_drv.xml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 80a599314..ed785fd2f 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3927,6 +3927,18 @@ $ICE_DOMAIN_MESH + + real + mapping + ICE_attributes + + Maximum allowed mesh error + + + 0.01 + 0.15 + + From 975bba5e63a326f1c17e6d2792b4e78cc74aab03 Mon Sep 17 00:00:00 2001 From: jmaerz <92309038+jmaerz@users.noreply.github.com> Date: Fri, 7 Mar 2025 15:29:56 +0100 Subject: [PATCH 040/135] adopt default value according to ice_mesh_mod.F90 --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ed785fd2f..bb1ebe9a0 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -3935,7 +3935,7 @@ Maximum allowed mesh error - 0.01 + 0.1 0.15 From 3ee4735502d7561a1a79461beda964c33d2da16e Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Wed, 19 Mar 2025 16:35:03 +0100 Subject: [PATCH 041/135] Make datm timesteps smaller for ww3 --- cime_config/config_component_cesm.xml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b801f156e..cfa469ead 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -287,6 +287,12 @@ 24 48 + + + + 72 + 72 + run_coupling env_run.xml From 5d4e72916e64ad6beaba0bdf501be9e59d1740d6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 10 Apr 2025 17:49:43 +0200 Subject: [PATCH 042/135] renamed shr_lnd2rof_tracers.F90 --- .../{shr_lnd2rof_tracers.F90 => shr_lnd2rof_tracers_mod.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename cesm/nuopc_cap_share/{shr_lnd2rof_tracers.F90 => shr_lnd2rof_tracers_mod.F90} (100%) diff --git a/cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 b/cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 similarity index 100% rename from cesm/nuopc_cap_share/shr_lnd2rof_tracers.F90 rename to cesm/nuopc_cap_share/shr_lnd2rof_tracers_mod.F90 From 062b0c05e36f1aaf1280c61c1c7e72886df24ca8 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 10 Apr 2025 21:05:57 +0200 Subject: [PATCH 043/135] some merge updates --- cime_config/namelist_definition_drv.xml | 2 +- mediator/med_phases_history_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 512ab68dc..5db06e8b9 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -913,7 +913,7 @@ default: xgrid for fully coupled cases, ogrid for datm - ogrid + xgrid ogrid diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index deabfdf98..ffbc70ebd 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -562,7 +562,7 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' !--------------------------------------- rc = ESMF_SUCCESS From 93502613a03bb2c54c73ed0999e6e562cc117021 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 11 Apr 2025 17:46:53 +0200 Subject: [PATCH 044/135] added new logic to set set_histaux_l2x1yrg to .true. if compset includes blom and clm --- cime_config/buildnml | 4 +++- cime_config/namelist_definition_drv.xml | 3 ++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 7ffc28f82..3c08a2fe9 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -56,9 +56,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): for val in ("HIST", "REST", "STOP"): config[val.lower()+"_option"] = case.get_value(val+"_OPTION") - config["comp_ocn"] = case.get_value("COMP_OCN") + config["set_histaux_l2x1yrg"] = ( + ".true." if case.get_value("COMP_OCN") == 'blom' and case.get_value("COMP_LND") == 'clm' else ".false." + ) atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5db06e8b9..1e4bdac8a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1796,7 +1796,8 @@ ALLCOMP_attributes Auxiliary mediator lnd2med fields every year - .false. + .true. + .false. From d1725ae6f9b17ab5d689b4cd45eb9a8b52abdfb3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 11 Apr 2025 22:10:55 +0200 Subject: [PATCH 045/135] fixed compile problem --- mediator/med_phases_history_mod.F90 | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index ffbc70ebd..3cd0b4fb2 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,7 +13,7 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -616,11 +616,8 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, if (present(comp_import)) then if (.not. present(fldbun_import)) then - call ESMF_LogWrite(subname//'if comp_import is present, then fldbun_import must be present', ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) + return end if if (comp_import == complnd) then write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' @@ -665,11 +662,8 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, if (ChkErr(rc,__LINE__,u_FILE_u)) return end do else - call ESMF_LogWrite(subname//'either fldbun_import or fldbun_export must be present as arguments') - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) + return end if end do ! end of loop over m From f42ffeffb95c226a5c4e93d687f6e68bf31e6965 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 16 Apr 2025 12:01:14 +0200 Subject: [PATCH 046/135] fixed logic for ocn2glc_coupling --- cime_config/buildnml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 3c08a2fe9..ab6adbe5d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -152,6 +152,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # ---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) + # ---------------------------------------------------- + # Error checks + # ---------------------------------------------------- + ocn2glc_coupling = nmlgen.get_value("ocn2glc_coupling") + if "ocn2glc_coupling" == ".false.": + expect(case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET"), + "ocn2glc_coupling is only allowed currently if the ocean component is BLOM or if DOCN%MULTILEV is in the compset") + # -------------------------------- # Overwrite: set brnch_retain_casename # -------------------------------- From 133bd174684d7a00993ecdafb6e60661fcb40c0b Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Sat, 19 Apr 2025 13:12:20 +0200 Subject: [PATCH 047/135] Fix ERS tests --- mediator/med_phases_restart_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index ebf3727d5..130c9c4a6 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -423,7 +423,7 @@ subroutine med_phases_restart_write(gcomp, rc) nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & - nt=1, pre='ocnImpAccum2glc_o', rc=rc) + nt=1, pre='ocnImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From cbf5e5e45399d3e5a1a45fc0d036e20baa2b3fef Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Sat, 19 Apr 2025 13:12:49 +0200 Subject: [PATCH 048/135] add defaults for multilev ocn2glc --- cime_config/buildnml | 8 +++++++- cime_config/namelist_definition_drv.xml | 3 ++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index ab6adbe5d..c1be038c6 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -44,6 +44,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["MPILIB"] = case.get_value("MPILIB") config["OS"] = case.get_value("OS") config["TESTCASE"] = case.get_value("TESTCASE") + config["ocn_multilev"] = ".false." + config["set_histaux_l2x1yrg"] = ".false." if not config["TESTCASE"]: config["TESTCASE"] = "UNSET" config["glc_nec"] = ( @@ -61,6 +63,9 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["set_histaux_l2x1yrg"] = ( ".true." if case.get_value("COMP_OCN") == 'blom' and case.get_value("COMP_LND") == 'clm' else ".false." ) + config["ocn_multilev"] = ( + ".true." if case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET") else ".false." + ) atm_grid = case.get_value("ATM_GRID") lnd_grid = case.get_value("LND_GRID") @@ -155,8 +160,9 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # ---------------------------------------------------- # Error checks # ---------------------------------------------------- + # double check if ocn2glc_coupling is set correctly ocn2glc_coupling = nmlgen.get_value("ocn2glc_coupling") - if "ocn2glc_coupling" == ".false.": + if "ocn2glc_coupling" == ".true.": expect(case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET"), "ocn2glc_coupling is only allowed currently if the ocean component is BLOM or if DOCN%MULTILEV is in the compset") diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 1e4bdac8a..87eb73f95 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -606,7 +606,8 @@ .true. if ocean sends fields at multiple ocean levels to the land-ice component - .false. + .false. + .true. From 5ad5ec2ac449c13ad74670b7b6f14564039ff4d4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 23 Apr 2025 23:15:46 +0200 Subject: [PATCH 049/135] buildnml now reads drv_flds_in after creation and determine if lnd (clm or dlnd) sends extra non-water tracers to mosart --- cime_config/buildnml | 8 ++++++++ cime_config/namelist_definition_drv.xml | 2 +- cime_config/namelist_definition_drv_flds.xml | 4 ++-- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 7ffc28f82..51d794e0d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -554,6 +554,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") nmlgen.write_output_file(drv_flds_in) + # now read drv_flds_in and determine if lnd sends extra + # non-water tracers to runoff component + with open(drv_flds_in, "r", encoding="utf-8") as namelist_file: + for line in namelist_file.readlines(): + if 'lnd2rof_tracers' in line and 'lnd2rof_tracers_inparm' not in line: + user_nl_cpl = os.path.join(caseroot, "user_nl_cpl") + with open(user_nl_cpl, 'a') as user_file: + user_file.write("histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") ############################################################################### def _create_runseq(case, coupling_times, valid_comps): diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f344e59df..d9d4360ad 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1848,7 +1848,7 @@ MED_attributes Auxiliary name identifier in history name - lnd.ncpl.inst + lnd2rof.24hr.avg diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index cf5820d04..e78f682eb 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -123,7 +123,7 @@ Fire_emissions fire_emis_nl - If ture fire emissions are input into atmosphere as elevated forcings. + If true, fire emissions are input into atmosphere as elevated forcings. Otherwise they are treated as surface emissions. @@ -150,7 +150,7 @@ lnd2rof_tracers lnd2rof_tracers_inparm - Liquid lnd2rof tracers (other than water) + Colon deliminted string of Liquid non-water tracers sent from land to river From 19122daae5fb0b3d233d8e3f740e29a1251125e3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 24 Apr 2025 11:58:03 +0200 Subject: [PATCH 050/135] fixed output of optional line to user_nl_cpl --- cime_config/buildnml | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 766be6daf..545f14344 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -572,12 +572,24 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # now read drv_flds_in and determine if lnd sends extra # non-water tracers to runoff component + add_tracer_field = False with open(drv_flds_in, "r", encoding="utf-8") as namelist_file: for line in namelist_file.readlines(): if 'lnd2rof_tracers' in line and 'lnd2rof_tracers_inparm' not in line: - user_nl_cpl = os.path.join(caseroot, "user_nl_cpl") - with open(user_nl_cpl, 'a') as user_file: - user_file.write("histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") + add_tracer_field = True + + if add_tracer_field: + user_nl_cpl = os.path.join(caseroot, "user_nl_cpl") + append_line = True + with open(user_nl_cpl) as user_file: + for line in user_file.readlines(): + if 'Flrl_rofsur_nonh2o' in line: + append_line = False + if append_line: + print("NOTE: Adding the following line to user_nl_cpl") + print( "histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") + with open(user_nl_cpl, 'a') as user_file: + user_file.write("histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") ############################################################################### def _create_runseq(case, coupling_times, valid_comps): From 215bbd0114b7cbb34143de2ad1093f685775f20a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 27 Apr 2025 21:29:18 +0200 Subject: [PATCH 051/135] fixed problem in namelist generation --- cime_config/buildnml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 545f14344..16dc6ac8b 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -578,6 +578,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if 'lnd2rof_tracers' in line and 'lnd2rof_tracers_inparm' not in line: add_tracer_field = True + append_line = False if add_tracer_field: user_nl_cpl = os.path.join(caseroot, "user_nl_cpl") append_line = True From e6b06224400b4a76628076ed283bdb02a965a221 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 13 May 2025 08:59:24 +0200 Subject: [PATCH 052/135] fixes to get DLND%RCPL mode working with mosart --- mediator/med.F90 | 10 +++++----- mediator/med_internalstate_mod.F90 | 4 ++-- mediator/med_phases_prep_rof_mod.F90 | 9 +++++---- 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index e48057b02..075bb6d04 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -52,7 +52,7 @@ module MED use esmFldsExchange_hafs_mod , only : esmFldsExchange_hafs use med_phases_profile_mod , only : med_phases_profile_finalize use shr_log_mod , only : shr_log_error - + implicit none private @@ -1348,7 +1348,7 @@ subroutine realizeConnectedGrid(State,string,rc) call shr_log_error(trim(subname)//": ERROR fieldStatus not supported ", rc=rc) return - + endif ! fieldStatus enddo ! nflds @@ -1917,7 +1917,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! Initialize rof module field bundles here if appropriate !--------------------------------------- - if (is_local%wrap%med_coupling_active(comprof,complnd)) then + if (is_local%wrap%med_coupling_active(complnd,comprof)) then call med_phases_prep_rof_init(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -2266,9 +2266,9 @@ subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_ClockGetAlarmList use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet use NUOPC_Mediator , only : NUOPC_MediatorGet - ! NUOPC_shr_methods is now in cesm_share and cdeps + ! NUOPC_shr_methods is now in cesm_share and cdeps use nuopc_shr_methods, only : AlarmInit - + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 6f7c49f73..d2171b068 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -579,7 +579,7 @@ subroutine med_internalstate_coupling(gcomp, rc) if (maintask) then write(logunit,*) ' ' write(logunit,'(A)') trim(subname)//' Allowed coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + write(logunit,'(2x,A12,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) do n1 = 1,ncomps write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & (med_coupling_allowed(n1,n2),n2=1,ncomps) @@ -591,7 +591,7 @@ subroutine med_internalstate_coupling(gcomp, rc) write(logunit,*) ' ' write(logunit,'(A)') subname//' Active coupling flags' - write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) + write(logunit,'(2x,A12,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) do n1 = 1,ncomps write(msgString,'(2x,a1,A,5x,20(L5))') '|',trim(compname(n1)), & (is_local%wrap%med_coupling_active(n1,n2),n2=1,ncomps) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index d6a242950..696cd76e6 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -28,7 +28,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error - + implicit none private @@ -198,7 +198,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) lndAccum2rof_cnt = 0 fldList => med_fldList_GetFldListFr(complnd) - ! Create packed mapping from rof->lnd + ! Create packed mapping from lnd to rof call med_map_packed_field_create(destcomp=comprof, & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -413,13 +413,14 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate - if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then + if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field)) .and. & + is_local%wrap%med_coupling_active(comprof,complnd)) then call med_phases_prep_rof_irrig( gcomp, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! This will ensure that no irrig is sent from the land call fldbun_getdata1d(FBlndAccum2rof_r, irrig_flux_field, dataptr_out, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr_out(:) = czero end if From a855ba46af04c2cd510d45b74f4846d99211b4a1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 29 May 2025 18:33:58 +0200 Subject: [PATCH 053/135] changes required for BLOM --- cime_config/config_component_cesm.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfa469ead..ce5e7028b 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -286,6 +286,7 @@ 24 + 18 48 @@ -333,6 +334,7 @@ 24 24 + 18 1 24 @@ -424,6 +426,8 @@ TRUE TRUE TRUE + FALSE + FALSE TRUE FALSE From b4b21b6beec710a18f52e3f94170e40061739261 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 31 May 2025 15:54:05 +0200 Subject: [PATCH 054/135] fixes for ocn_flux_shemes 1 and 2 to work --- cesm/flux_atmocn/shr_flux_mod.F90 | 32 ++++++++++++++++++------- cime_config/namelist_definition_drv.xml | 15 ++---------- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index c40c4d732..e53500bec 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -142,10 +142,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & evap ,evap_16O, evap_HDO, evap_18O, & & taux ,tauy ,tref ,qref , & & ocn_surface_flux_scheme, & - & add_gusts, & - & duu10n, & + & add_gusts, & + & duu10n, & & ugust_out, & - & u10res, & + & u10res, & & ustar_sv ,re_sv ,ssq_sv, & & missval) @@ -267,7 +267,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. real(R8) :: gprec ! convective rainfall argument for ugust qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) @@ -346,10 +346,10 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (mask(n) /= 0) then !--- compute some needed quantities --- - if (add_gusts) then + if (add_gusts) then vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) - else + else vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) ugust_out(n) = 0.0_r8 end if @@ -496,7 +496,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 ugust_out(n) = spval ! gustiness addition (m/s) - u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval @@ -576,6 +576,9 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & if (present(re_sv )) re_sv(n) = re if (present(ssq_sv )) ssq_sv(n) = ssq + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else !------------------------------------------------------------ ! no valid data here -- out of domain @@ -593,6 +596,9 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n (n) = spval ! 10m wind speed squared (m/s)^2 + u10res (n) = spval + ugust_out(n) = spval + if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval if (present(ssq_sv )) ssq_sv (n) = spval @@ -611,7 +617,15 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & taux, tauy, tref, qref, & duu10n, ustar_sv, re_sv, ssq_sv, & missval) - + do n=1,nMax + if (mask(n) /= 0) then + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else + u10res (n) = spval + ugust_out(n) = spval + end if + end do else call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") @@ -1051,7 +1065,6 @@ SUBROUTINE flux_atmOcn_UA(logunit, & if (present(ssq_sv )) ssq_sv(n) = ssq if (present(re_sv )) re_sv(n) = re - else !------------------------------------------------------------ @@ -1069,6 +1082,7 @@ SUBROUTINE flux_atmOcn_UA(logunit, & tref (n) = spval ! 2m reference height temperature (K) qref (n) = spval ! 2m reference height humidity (kg/kg) duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ! Optional diagnostics too: if (present(ustar_sv)) ustar_sv(n) = spval if (present(re_sv )) re_sv (n) = spval diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 87eb73f95..8281d4b70 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -932,24 +932,13 @@ 0 - - real - control - MED_attributes - - wind gustiness factor - - - 0.0D0 - - - logical control MED_attributes - add a wind gustiness factor + Add a wind gustiness factor. This should be false for + ocn_surface_flux_scheme settings of 1 or 2. .true. From a5301755969d19c7bb2f9a46fa66384cd7c3d301 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 31 May 2025 18:33:15 +0200 Subject: [PATCH 055/135] fix CPL_ALBAV to be TRUE for BLOM with CORE forcing --- cime_config/config_component_cesm.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index ce5e7028b..fc399cfcd 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -425,9 +425,9 @@ TRUE TRUE - TRUE - FALSE - FALSE + FALSE + TRUE + TRUE TRUE FALSE From 63d8b55d5fd0d7aca708ce6ab60c64070c1b5dc9 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 1 Jun 2025 13:36:21 +0200 Subject: [PATCH 056/135] fixed regular expression for tnx2 matching --- cime_config/config_component_cesm.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index fc399cfcd..9287146a6 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -286,7 +286,7 @@ 24 - 18 + 18 48 @@ -334,7 +334,7 @@ 24 24 - 18 + 18 1 24 From d4b7a35262a017dac401e632d28507a37bbb8868 Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Mon, 9 Jun 2025 17:18:47 +0200 Subject: [PATCH 057/135] fix accum call on initialization --- mediator/med_phases_post_ocn_mod.F90 | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index bfc234507..b6e5d4a46 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -82,10 +82,14 @@ subroutine med_phases_post_ocn(gcomp, rc) end if ! Accumulate ocn input for glc if there is ocn->glc coupling - if (is_local%wrap%ocn2glc_coupling) then - call med_phases_prep_glc_accum_ocn(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + ! Do this ONLY when the driver clock is created, + ! same as in med_prep_phases_post_lnd + if (ESMF_ClockIsCreated(dclock)) then + if (is_local%wrap%ocn2glc_coupling) then + call med_phases_prep_glc_accum_ocn(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + endif ! Write ocn inst, avg or aux if requested in mediator attributes call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) From a9e46c83184ba7c27590c87ace45f2254084afad Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Tue, 10 Jun 2025 09:55:04 +0200 Subject: [PATCH 058/135] update comment --- mediator/med_phases_post_ocn_mod.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index b6e5d4a46..5913e7258 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -84,6 +84,9 @@ subroutine med_phases_post_ocn(gcomp, rc) ! Accumulate ocn input for glc if there is ocn->glc coupling ! Do this ONLY when the driver clock is created, ! same as in med_prep_phases_post_lnd + ! If driver clock is created + ! then we are in the run phase + ! otherwise are in the initialization phase if (ESMF_ClockIsCreated(dclock)) then if (is_local%wrap%ocn2glc_coupling) then call med_phases_prep_glc_accum_ocn(gcomp, rc) From 868c4e50f03c048eef05fc68d0eaa7d4a83997d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=98yvind=20Seland?= Date: Sat, 14 Jun 2025 19:21:06 +0200 Subject: [PATCH 059/135] Added options for enthalpy correction programmed by indicate Peter Lauritzen (NCAR) and Thomas Toniazzo (Bjerknes Centre / NORCE) --- mediator/esmFldsExchange_cesm_mod.F90 | 62 ++++++++- mediator/fd_cesm.yaml | 30 ++++- mediator/med_diag_mod.F90 | 33 ++++- mediator/med_phases_prep_atm_mod.F90 | 64 ++++++++- mediator/med_phases_prep_ocn_mod.F90 | 183 +++++++++++++++++++++----- 5 files changed, 329 insertions(+), 43 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index b3b305668..8254d7631 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1312,9 +1312,29 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if +! logic below weird because of absurdity of global-mean ocean-points-only material enthalpy flux + if (phase == 'advertise') then + call addfld_to(compatm, 'Faxx_goef') + else ! fill with sensible heat here, will be overwritten (globally) in med_phases_prep_atm + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then + call addmrg_to(compatm , 'Faxx_goef', & + mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then + call addmrg_to(compatm , 'Faxx_goef', & + mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then + call addmrg_to(compatm , 'Faxx_goef', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end if if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_evap') + call addfld_to(compatm, 'Faox_evap') !+tht call addfld_from(complnd, 'Fall_evap') call addfld_from(compice, 'Faii_evap') call addfld_aoflux( 'Faox_evap') @@ -1336,6 +1356,9 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') +!+tht unmerged aoflux-only for correct hevap to ocean in cam_out + call addmrg_to(compatm, 'Faox_evap', mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy') +!-tht end if end if end if @@ -1892,6 +1915,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if +!+tht --------------------------------------------------------------------- + ! to ocn: downward material enthalpy flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat') + call addfld_to (compocn, 'Faxa_hmat_oa') ! handled in prep_ocn + call addfld_from(compatm, 'Faxa_hlat') + call addfld_to (compocn, 'Faxa_hlat') + call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn + else + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hmat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hmat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hmat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hmat', mrg_from=compatm ,mrg_fld='Faxa_hmat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hlat', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hlat', rc=rc)) then + call addmap_from(compatm, 'Faxa_hlat', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to (compocn, 'Faxa_hlat', mrg_from=compatm ,mrg_fld='Faxa_hlat' & + , mrg_type='copy_with_weights', mrg_fracname='ofrac') + end if + !if (fldchk(is_local%wrap%FBExp(compatm),'Faxx_hrof', rc=rc)) & + ! call addmap_from(compocn, 'Faxx_hrof', compatm, mapconsf, 'one', atm2ocn_map) + end if +!-tht ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- @@ -1932,15 +1982,15 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! import sw from atm by bands - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & + if ((fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet' , rc=rc)) .or. & - (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet', rc=rc)) .or. & + (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then call addmap_from(compatm, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_map) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index e41c61dff..0ea8956d3 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -296,8 +296,26 @@ alias: mean_down_lw_flx canonical_units: W m-2 description: atm import to med - mean downward SW heat flux + mean downward LW heat flux + #+tht + - standard_name: Faxa_hmat + alias: mean_down_hmat + canonical_units: W m-2 + description: atm import to med + mean downward material enthalpy flux + # + - standard_name: Faxa_hlat + alias: mean_down_hlat + canonical_units: W m-2 + description: atm import to med + variable latent heat part of mat.enth.flx # + - standard_name: Faxa_hmat_oa + alias: mean_down_hmat_oa + canonical_units: W m-2 + description: med export to ocn + mean downw. mat. enth. flux, ocean average + #-tht - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy @@ -519,6 +537,11 @@ canonical_units: W m-2 description: atm export from med - merged sensible heat flux # + - standard_name: Faxx_goef + alias: wrong_fixer_busts_energy + canonical_units: W m-2 + description: atm export from med - wrong atm fixer for ocn mat.enthalpy + # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 @@ -1012,6 +1035,11 @@ alias: heat_content_cond canonical_units: W m-2 description: med export to ocn heat content of condensation + #+tht + - standard_name: Faxx_hrof + alias: heat_content_rof + canonical_units: W m-2 + description: med export to atm gl.avg. of mat.enthalpy of runoff # - standard_name: Foxx_hrofl alias: heat_content_rofl diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index df0d4e351..b8675eb27 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -33,7 +33,7 @@ module med_diag_mod use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error - + implicit none private @@ -143,6 +143,10 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible +!+tht + integer :: f_heat_goef = unset_index ! heat : bad global ocean enthalpy fixer + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux +!-tht integer :: f_heat_rain = unset_index ! heat : heat content of rain integer :: f_heat_snow = unset_index ! heat : heat content of snow integer :: f_heat_evap = unset_index ! heat : heat content of evaporation @@ -325,14 +329,23 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible +!+tht N.B. HMAT from atmo, GOEF from med; they shouldn't be both /=0. + call add_to_budget_diag(budget_diags%fields, f_heat_goef ,'goef' ) ! field heat : bad gl. ocn enth. fixer + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux +!-tht if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_sen ! field last index for heat +!+tht + !f_heat_end = f_heat_sen ! field last index for heat + f_heat_end = f_heat_hmat ! field last index for heat +!-tht else if (trim(budget_table_version) == 'v1') then call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation +!tht: N.B. if hmat/=0, all other terms here must be zero. + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) !+tht: f.heat : surf. mat. enthalpy flux call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff f_heat_beg = f_heat_frz ! field first index for heat @@ -516,6 +529,7 @@ subroutine med_diag_zero_mode(mode, rc) call shr_log_error(trim(subname)//' mode '//trim(mode)//& ' not recognized', & line=__LINE__, file=u_FILE_u, rc=rc) + return endif end subroutine med_diag_zero_mode @@ -761,6 +775,15 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return +!+tht + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_goef', f_heat_goef, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !not sure about this + !call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxa_hmat', f_heat_hmat, & + ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return +!-tht call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1584,6 +1607,8 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if +!tht: some logic and code is required here to set correct ocn budget using surface material enthalpy +! fluxes computed in atmosphere and passed to med (Faxa_hmat) or its global-ocean average (Faxa_hmat_oa) call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) @@ -1596,6 +1621,10 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + !I'm putting a placeholder here as a reminder -- for now as don't know how it's/should be used this is c'd out + !call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hmat', f_heat_hmat, ic, areas, ofrac, budget_local, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return +!-tht budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index bcdf2ea42..30d6b40a3 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -29,8 +29,10 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm public :: med_phases_prep_atm_enthalpy_correction + public :: med_phases_prep_atm_enthalpy_runoff real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8), public :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off from med_phases_prep_ocn character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) @@ -230,14 +232,30 @@ subroutine med_phases_prep_atm(gcomp, rc) end if end do - ! Add enthalpy correction to sensible heat if appropriate - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) +!+tht: Adding enthalpy correction to sensible heat is never appropriate + !if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! do n = 1,size(dataptr1) + ! dataptr1(n) = dataptr1(n) + global_htot_corr(1) + ! end do + !end if + ! instead, pass extra coupling fiels to atmosphere and decide there to use it (NCAR code) or not (best) + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_goef', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) - dataptr1(n) = dataptr1(n) + global_htot_corr(1) + dataptr1(n) = global_htot_corr(1) end do end if + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_hrof', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(dataptr1) + dataptr1(n) = global_hrof_corr(1) + end do + end if +!-tht ! Check for nans in fields export to atm call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) @@ -273,6 +291,7 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) type(InternalState) :: is_local integer :: n real(r8) :: local_htot_corr(1) + real(r8) :: local_hrof_corr(1) type(ESMF_VM) :: vm !--------------------------------------- @@ -295,4 +314,41 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) end subroutine med_phases_prep_atm_enthalpy_correction + !----------------------------------------------------------------------------- + subroutine med_phases_prep_atm_enthalpy_runoff (gcomp, hcorr, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_hrof_corr(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Determine sum of enthalpy correction for each hcorr index locally + local_hrof_corr(1) = 0._r8 + do n = 1,size(hcorr) + local_hrof_corr(1) = local_hrof_corr(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_hrof_corr, recvdata=global_hrof_corr, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine med_phases_prep_atm_enthalpy_runoff + end module med_phases_prep_atm_mod diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e30c4ada5..b6736b5a2 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -33,6 +33,9 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom + !+tht ocean surface enthalpy flux correction + real(r8), public :: ocean_htot_corr(1)=0._r8, ocean_atot_corr(1)=0._r8, oa_htot(1)=0._r8 + character(*), parameter :: u_FILE_u = & __FILE__ @@ -78,8 +81,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_constants_mod , only : shr_const_cpsw, shr_const_cpfw, shr_const_cpice, shr_const_tkfrz, shr_const_pi use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_runoff ! input/output variables type(ESMF_GridComp) :: gcomp @@ -98,8 +102,19 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofi(:), hrofi(:) real(r8), pointer :: rofl_glc(:), hrofl_glc(:) real(r8), pointer :: rofi_glc(:), hrofi_glc(:) + real(r8), allocatable :: hcorr(:), hrof(:) +!+tht real(r8), pointer :: areas(:) - real(r8), allocatable :: hcorr(:) + real(R8), pointer :: dataptr(:) + real(R8), pointer :: Faxa_hmat (:) + real(R8), pointer :: Faxa_hlat (:) +! if SEPARATE_VARLAT is T then +! do gl.oc.avg for hmat_oa only for the net-mass part, +! and pass in hmat only local variable latent heat correction part + !logical, parameter :: separate_varlat=.true. + logical, parameter :: separate_varlat=.false. ! set to F to regress to 20250609 + real(r8), allocatable :: acorr(:) +!-tht type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -160,62 +175,54 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc)) then - + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & + ) then call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(tocn) ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw @@ -227,12 +234,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw hrofi_glc(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi_glc(n) * shr_const_cpsw end do - ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only ! need to calculate this if data is sent back to the atm - - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then !+tht goef allocate(hcorr(size(tocn))) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas @@ -244,9 +249,98 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) end if - end if +!+tht + if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) & + .and.FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas + allocate(hcorr(size(tocn))) + allocate(acorr(size(tocn))) + allocate(hrof (size(tocn))) +if(separate_varlat) then + if(FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) & + ) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofi' , rofi ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofl_glc', rofl_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofi_glc', rofi_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl (n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi (n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + do n = 1,size(tocn) +!hrof(n)=0._r8 ! sanity check (regression to blomfx02, no run-off contributions -> OK) + hcorr(n) = areas(n) *(Faxa_hmat(n)-Faxa_hlat(n)+hrof(n)) + acorr(n) = areas(n) + end do + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then !+tht goef + hrof(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hrof) + end if +else + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do +endif + call med_oa_integral(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ocean_htot_corr(1)=oa_htot(1) + oa_htot(1)=0._r8 + call med_oa_integral(gcomp, acorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ocean_atot_corr(1)=oa_htot(1) + !oa_hrof(1)=0._r8 + !call med_oa_integral(gcomp, hrof , rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !ocean_hrof_corr(1)=oa_hrof(1) + !deallocate(hrof ) + deallocate(hcorr) + deallocate(acorr) + call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) + if(ocean_atot_corr(1).gt.0._r8) & + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) +!print*,'global ocn htflx corr:',dataptr(1) +!!!!!!! if(FB_fldchk(is_local%wrap%FBExp(compatm),'Foxx_ihrof',rc=rc) & +!!!!!!! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Foxx_hrof' , dataptr, rc=rc) +!!!!!!! dataptr(:) = ocean_rof_corr(1)/(4._r8*shr_const_pi) +!!!!!!!print*,'glob.avg. hrof to atm:',dataptr(1) +! hack: replace full mat.enth.flux with variable lat.heats part only in pointer to ocean export +! might add another coupling field later but may not be strictly necessary +if(separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n)=Faxa_hlat(n) + end do +else + do n = 1,size(tocn) + Faxa_hmat(n)=0._r8 ! avoid applying twice in BLOM + end do +endif + endif +!-tht + ! custom merges to ocean call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -657,4 +751,33 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom + subroutine med_oa_integral (gcomp, hcorr, rc) + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: hcorr(:) + integer , intent(out) :: rc + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_htot(1) + type(ESMF_VM) :: vm + !--------------------------------------- + rc = ESMF_SUCCESS + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + ! sum contributions to integral + local_htot(1) = 0._r8 + do n = 1,size(hcorr) + local_htot(1) = local_htot(1) + hcorr(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_htot, recvdata=oa_htot, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_oa_integral + end module med_phases_prep_ocn_mod From ae2d923dc5397a61a921fea8dd8d9dd01f614f93 Mon Sep 17 00:00:00 2001 From: Marit Sandstad Date: Mon, 11 Aug 2025 09:32:09 +0200 Subject: [PATCH 060/135] Adding Alok's fixed file for the fco2 land flux mediation --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 0b16c8b4d..d703fe87f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1690,8 +1690,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(complnd, 'Fall_fco2_lnd') call addfld_to(compatm, 'Fall_fco2_lnd') else - if ( fldchk(is_local%wrap%FBImp(compocn,compocn), 'Faoo_co2_lnd', rc=rc) .and. & - fldchk(is_local%wrap%FBexp(compatm) , 'Faoo_co2_lnd', rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_fco2_lnd', rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Fall_fco2_lnd', rc=rc)) then call addmap_from(complnd, 'Fall_fco2_lnd', compatm, mapconsf, 'one', lnd2atm_map) call addmrg_to(compatm, 'Fall_fco2_lnd', & mrg_from=complnd, mrg_fld='Fall_fco2_lnd', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2atm_flux) From 5970f6583b44fe6bc5b199d1782bbebb49c6fa14 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 17 Aug 2025 21:26:32 +0200 Subject: [PATCH 061/135] refactor of enthalpy from cam --- cime_config/namelist_definition_drv.xml | 34 +++- mediator/esmFldsExchange_cesm_mod.F90 | 34 +--- mediator/fd_cesm.yaml | 11 +- mediator/med_diag_mod.F90 | 73 +++---- mediator/med_phases_prep_atm_mod.F90 | 25 +-- mediator/med_phases_prep_ocn_mod.F90 | 259 +++++++++++++++--------- 6 files changed, 243 insertions(+), 193 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b980a2f47..0883f524a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -663,6 +663,37 @@ + + + + + + logical + control + ALLCOMP_attributes + + if true, the mediator computes enthalpy associated with rain, + snow, etc to send to ocn (in this case MOM6) + + + .false. + .true. + + + + + logical + control + ALLCOMP_attributes + + if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + + + .true. + .true. + + + @@ -962,12 +993,13 @@ char budget MED_attributes - v0,v1 + v0,v1,v2 currently v0 refers to budgets using POP and v1 refers to budgets using MOM6 v0 + v2 v1 v0 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9ee6eadd6..15b1c3c9b 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1312,32 +1312,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if -! logic below weird because of absurdity of global-mean ocean-points-only material enthalpy flux - if (phase == 'advertise') then - call addfld_to(compatm, 'Faxx_goef') - else ! fill with sensible heat here, will be overwritten (globally) in med_phases_prep_atm - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_sen', rc=rc)) then - if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_sen', rc=rc)) then - call addmrg_to(compatm , 'Faxx_goef', & - mrg_from=complnd, mrg_fld='Fall_sen', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_sen', rc=rc)) then - call addmrg_to(compatm , 'Faxx_goef', & - mrg_from=compice, mrg_fld='Faii_sen', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then - call addmrg_to(compatm , 'Faxx_goef', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_evap') - call addfld_to(compatm, 'Faox_evap') !+tht + call addfld_to(compatm, 'Faox_evap') call addfld_from(complnd, 'Fall_evap') call addfld_from(compice, 'Faii_evap') - call addfld_aoflux( 'Faox_evap') + call addfld_aoflux('Faox_evap') else if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then @@ -1356,9 +1337,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if call addmrg_to(compatm , 'Faxx_evap', & mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') -!+tht unmerged aoflux-only for correct hevap to ocean in cam_out + ! unmerged aoflux-only for correct hevap to ocean in cam_out call addmrg_to(compatm, 'Faox_evap', mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy') -!-tht end if end if end if @@ -1915,8 +1895,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_swdn', mrg_type='copy') end if end if -!+tht --------------------------------------------------------------------- - ! to ocn: downward material enthalpy flux + !---------------------------------------------------------------------- + ! to ocn: downward material enthalpy flux from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(compatm, 'Faxa_hmat') @@ -1924,7 +1904,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_to (compocn, 'Faxa_hmat_oa') ! handled in prep_ocn call addfld_from(compatm, 'Faxa_hlat') call addfld_to (compocn, 'Faxa_hlat') - call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn + call addfld_to (compatm, 'Faxx_hrof') ! enthalpy of runoff, computed in med_phases_prep_ocn else if (fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_hmat', rc=rc) .and. & fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_hmat', rc=rc)) then @@ -1941,7 +1921,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !if (fldchk(is_local%wrap%FBExp(compatm),'Faxx_hrof', rc=rc)) & ! call addmap_from(compocn, 'Faxx_hrof', compatm, mapconsf, 'one', atm2ocn_map) end if -!-tht + ! --------------------------------------------------------------------- ! to ocn: net shortwave radiation from med ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 8ed04fb44..9eff5c91e 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -301,7 +301,7 @@ canonical_units: W m-2 description: atm import to med mean downward LW heat flux - #+tht + # - standard_name: Faxa_hmat alias: mean_down_hmat canonical_units: W m-2 @@ -319,7 +319,7 @@ canonical_units: W m-2 description: med export to ocn mean downw. mat. enth. flux, ocean average - #-tht + # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy @@ -541,11 +541,6 @@ canonical_units: W m-2 description: atm export from med - merged sensible heat flux # - - standard_name: Faxx_goef - alias: wrong_fixer_busts_energy - canonical_units: W m-2 - description: atm export from med - wrong atm fixer for ocn mat.enthalpy - # - standard_name: Faxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 @@ -1039,7 +1034,7 @@ alias: heat_content_cond canonical_units: W m-2 description: med export to ocn heat content of condensation - #+tht + # - standard_name: Faxx_hrof alias: heat_content_rof canonical_units: W m-2 diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b8675eb27..16ba6b755 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -143,10 +143,7 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible -!+tht - integer :: f_heat_goef = unset_index ! heat : bad global ocean enthalpy fixer integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux -!-tht integer :: f_heat_rain = unset_index ! heat : heat content of rain integer :: f_heat_snow = unset_index ! heat : heat content of snow integer :: f_heat_evap = unset_index ! heat : heat content of evaporation @@ -329,27 +326,22 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible -!+tht N.B. HMAT from atmo, GOEF from med; they shouldn't be both /=0. - call add_to_budget_diag(budget_diags%fields, f_heat_goef ,'goef' ) ! field heat : bad gl. ocn enth. fixer - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux -!-tht if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat -!+tht - !f_heat_end = f_heat_sen ! field last index for heat - f_heat_end = f_heat_hmat ! field last index for heat -!-tht + f_heat_end = f_heat_sen ! field last index for heat else if (trim(budget_table_version) == 'v1') then call add_to_budget_diag(budget_diags%fields, f_heat_rain ,'hrain' ) ! field heat : enthalpy of rain call add_to_budget_diag(budget_diags%fields, f_heat_snow ,'hsnow' ) ! field heat : enthalpy of snow call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation -!tht: N.B. if hmat/=0, all other terms here must be zero. - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) !+tht: f.heat : surf. mat. enthalpy flux call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_rofi ! field last index for heat + else if (trim(budget_table_version) == 'v2') then + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux + f_heat_beg = f_heat_frz ! field first index for heat + f_heat_end = f_heat_hmat ! field last index for heat end if ! ----------------------------------------- @@ -732,6 +724,11 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if if (flds_wiso) then call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & @@ -775,15 +772,6 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return -!+tht - call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_goef', f_heat_goef, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !not sure about this - !call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxa_hmat', f_heat_hmat, & - ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return -!-tht call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1607,24 +1595,29 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if -!tht: some logic and code is required here to set correct ocn budget using surface material enthalpy -! fluxes computed in atmosphere and passed to med (Faxa_hmat) or its global-ocean average (Faxa_hmat_oa) - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !I'm putting a placeholder here as a reminder -- for now as don't know how it's/should be used this is c'd out - !call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_hmat', f_heat_hmat, ic, areas, ofrac, budget_local, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return -!-tht + if (trim(budget_table_version) == 'v1') then + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) + + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (trim(budget_table_version) == 'v2') then + ! f_heat_hmat to ocean is sum of contribution from two terms + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 30d6b40a3..28363b86a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -31,8 +31,8 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm_enthalpy_correction public :: med_phases_prep_atm_enthalpy_runoff - real(r8), public :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn - real(r8), public :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off from med_phases_prep_ocn + real(r8) :: global_htot_corr(1) = 0._r8 ! enthalpy correction from med_phases_prep_ocn + real(r8) :: global_hrof_corr(1) = 0._r8 ! enthalpy of run-off from med_phases_prep_ocn character(len=13) :: fldnames_from_ocn(5) = (/'Faoo_fbrf_ocn','Faoo_fdms_ocn','Faoo_fco2_ocn',& 'Faoo_fn2o_ocn','Faoo_fnh3_ocn'/) @@ -232,20 +232,14 @@ subroutine med_phases_prep_atm(gcomp, rc) end if end do -!+tht: Adding enthalpy correction to sensible heat is never appropriate - !if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - ! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! do n = 1,size(dataptr1) - ! dataptr1(n) = dataptr1(n) + global_htot_corr(1) - ! end do - !end if - ! instead, pass extra coupling fiels to atmosphere and decide there to use it (NCAR code) or not (best) - if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then - call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_goef', dataptr1, rc=rc) + ! Only do the following correction if the mediator is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. + if ( FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_sen' , rc=rc) .and. & + .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc)) then + call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_sen', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) - dataptr1(n) = global_htot_corr(1) + dataptr1(n) = dataptr1(n) + global_htot_corr(1) end do end if if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then @@ -255,7 +249,6 @@ subroutine med_phases_prep_atm(gcomp, rc) dataptr1(n) = global_hrof_corr(1) end do end if -!-tht ! Check for nans in fields export to atm call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) @@ -315,7 +308,7 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) end subroutine med_phases_prep_atm_enthalpy_correction !----------------------------------------------------------------------------- - subroutine med_phases_prep_atm_enthalpy_runoff (gcomp, hcorr, rc) + subroutine med_phases_prep_atm_enthalpy_runoff(gcomp, hcorr, rc) use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b6736b5a2..d7e7a1453 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -4,6 +4,7 @@ module med_phases_prep_ocn_mod ! Mediator phases for preparing ocn export from mediator !----------------------------------------------------------------------------- + use shr_log_mod , only : shr_log_error use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -33,8 +34,8 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom - !+tht ocean surface enthalpy flux correction - real(r8), public :: ocean_htot_corr(1)=0._r8, ocean_atot_corr(1)=0._r8, oa_htot(1)=0._r8 + logical :: med_computes_enthalpy_flux + logical :: atm_computes_enthalpy_flux character(*), parameter :: u_FILE_u = & __FILE__ @@ -45,6 +46,7 @@ module med_phases_prep_ocn_mod subroutine med_phases_prep_ocn_init(gcomp, rc) + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_methods_mod , only : FB_Init => med_methods_FB_init @@ -54,6 +56,8 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local + character(len=CL) :: cvalue + logical :: isPresent, IsSet character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- @@ -74,6 +78,24 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="med_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) med_computes_enthalpy_flux + else + med_computes_enthalpy_flux = .false. + end if + + call NUOPC_CompAttributeGet(gcomp, name="atm_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) atm_computes_enthalpy_flux + else + atm_computes_enthalpy_flux = .false. + end if + end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- @@ -103,18 +125,20 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), pointer :: rofl_glc(:), hrofl_glc(:) real(r8), pointer :: rofi_glc(:), hrofi_glc(:) real(r8), allocatable :: hcorr(:), hrof(:) -!+tht real(r8), pointer :: areas(:) - real(R8), pointer :: dataptr(:) - real(R8), pointer :: Faxa_hmat (:) - real(R8), pointer :: Faxa_hlat (:) -! if SEPARATE_VARLAT is T then -! do gl.oc.avg for hmat_oa only for the net-mass part, -! and pass in hmat only local variable latent heat correction part - !logical, parameter :: separate_varlat=.true. - logical, parameter :: separate_varlat=.false. ! set to F to regress to 20250609 + real(r8), pointer :: dataptr(:) + real(r8), pointer :: Faxa_hmat (:) + real(r8), pointer :: Faxa_hlat (:) + real(r8), allocatable :: hrof2atm(:) + real(r8) :: ocean_htot_corr(1) + real(r8) :: ocean_atot_corr(1) + + ! if separate_varlat is true then do global ocean average for + ! hmat_oa only for the net-mass part, and pass in hmat only local + ! variable latent heat correction part + logical, parameter :: separate_varlat=.true. real(r8), allocatable :: acorr(:) -!-tht + type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' !--------------------------------------- @@ -191,6 +215,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & ) then + ! Error check + if ( .not. med_computes_enthalpy_flux) then + call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true, aborting ', rc=rc) + end if call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) @@ -234,10 +262,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw hrofi_glc(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi_glc(n) * shr_const_cpsw end do - ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm - ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only - ! need to calculate this if data is sent back to the atm - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_goef', rc=rc)) then !+tht goef + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm allocate(hcorr(size(tocn))) glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) areas => is_local%wrap%mesh_info(compocn)%areas @@ -249,97 +277,119 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) end if - end if + end if ! condition for using global energy fixer -!+tht - if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) & - .and.FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + ! Newer enthalpy terms from atm + if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + if ( .not. atm_computes_enthalpy_flux) then + call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true, aborting ', rc=rc) + end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas + + ! if separate_varlat is true then do global ocean average only for the + ! net-mass part, and pass in as hmat only the local variable latent heat correction part + if (separate_varlat) then + !----------------------- + ! Determine enthalpy due to ocean river input + !----------------------- + allocate(hrof (size(tocn))) + if ( FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) ) then + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofi' , rofi ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofl_glc', rofl_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofi_glc', rofi_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi(n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + + ! send back to atm if requested by atm + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + allocate(hrof2atm(size(tocn))) + hrof2atm(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + + ! determine module variable global_hrof_corr in med_phases_prep_atm_mod + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof2atm, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + !----------------------- + ! Compute Faxa_hmat_oa + !----------------------- + + ! Determine hcorr and acorr allocate(hcorr(size(tocn))) allocate(acorr(size(tocn))) - allocate(hrof (size(tocn))) -if(separate_varlat) then - if(FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) & - ) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofi' , rofi ,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofl_glc', rofl_glc,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofi_glc', rofi_glc,rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(tocn) - hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl (n) & - + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi (n) & - + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & - + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) - enddo + if (separate_varlat) then + do n = 1,size(tocn) + hcorr(n) = areas(n) *(Faxa_hmat(n) - Faxa_hlat(n) + hrof(n)) + acorr(n) = areas(n) + end do else - do n = 1,size(tocn) - hrof(n) = 0._r8 - enddo + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do endif - do n = 1,size(tocn) -!hrof(n)=0._r8 ! sanity check (regression to blomfx02, no run-off contributions -> OK) - hcorr(n) = areas(n) *(Faxa_hmat(n)-Faxa_hlat(n)+hrof(n)) - acorr(n) = areas(n) - end do - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then !+tht goef - hrof(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) - call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(hrof) - end if -else - do n = 1,size(tocn) - hcorr(n) = areas(n) * Faxa_hmat(n) - acorr(n) = areas(n) - end do -endif - call med_oa_integral(gcomp, hcorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ocean_htot_corr(1)=oa_htot(1) - oa_htot(1)=0._r8 - call med_oa_integral(gcomp, acorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ocean_atot_corr(1)=oa_htot(1) - !oa_hrof(1)=0._r8 - !call med_oa_integral(gcomp, hrof , rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !ocean_hrof_corr(1)=oa_hrof(1) - !deallocate(hrof ) + deallocate(hrof) + + ! Compute global integral of hcorr - ocean_oa_htot + call med_oa_integral(gcomp, hcorr, ocean_htot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(hcorr) + + ! Compute global integral of acorr - ocean_atot_corr + call med_oa_integral(gcomp, acorr, ocean_atot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(acorr) + + ! Set value of Faxa_hmat_oa to ratio of ocean_htot_corr and ocean_atot_corr call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) - if(ocean_atot_corr(1).gt.0._r8) & - dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) -!print*,'global ocn htflx corr:',dataptr(1) -!!!!!!! if(FB_fldchk(is_local%wrap%FBExp(compatm),'Foxx_ihrof',rc=rc) & -!!!!!!! call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Foxx_hrof' , dataptr, rc=rc) -!!!!!!! dataptr(:) = ocean_rof_corr(1)/(4._r8*shr_const_pi) -!!!!!!!print*,'glob.avg. hrof to atm:',dataptr(1) -! hack: replace full mat.enth.flux with variable lat.heats part only in pointer to ocean export -! might add another coupling field later but may not be strictly necessary -if(separate_varlat) then - do n = 1,size(tocn) - Faxa_hmat(n)=Faxa_hlat(n) - end do -else - do n = 1,size(tocn) - Faxa_hmat(n)=0._r8 ! avoid applying twice in BLOM - end do -endif + if (ocean_atot_corr(1) > 0._r8) then + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) + end if + + !----------------------- + ! replace full material enthalpy flux with variable latent + ! heats part only in pointer to ocean export + !----------------------- + + ! might add another coupling field later but may not be strictly necessary + if (separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n) = Faxa_hlat(n) + end do + else + do n = 1,size(tocn) + Faxa_hmat(n) = 0._r8 ! avoid applying twice for some ocean components such as BLOM + end do + endif + endif -!-tht ! custom merges to ocean call med_phases_prep_ocn_custom(gcomp, rc) @@ -751,31 +801,38 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom - subroutine med_oa_integral (gcomp, hcorr, rc) - use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS - use ESMF , only : ESMF_VM + !----------------------------------------------------------------------------- + subroutine med_oa_integral (gcomp, local_array, global_integral, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp - real(r8) , intent(in) :: hcorr(:) + real(r8) , intent(in) :: local_array(:) + real(r8) , intent(out) :: global_integral(1) integer , intent(out) :: rc + ! local variables type(InternalState) :: is_local integer :: n - real(r8) :: local_htot(1) + real(r8) :: local_sum(1) type(ESMF_VM) :: vm !--------------------------------------- + rc = ESMF_SUCCESS + nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! sum contributions to integral - local_htot(1) = 0._r8 - do n = 1,size(hcorr) - local_htot(1) = local_htot(1) + hcorr(n) + local_sum(1) = 0._r8 + do n = 1,size(local_array) + local_sum(1) = local_sum(1) + local_array(n) end do call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_htot, recvdata=oa_htot, count=1, & + call ESMF_VMAllreduce(vm, senddata=local_sum, recvdata=global_integral, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_oa_integral From d427817f29bfdb9227e6829e7e42cd8504638949 Mon Sep 17 00:00:00 2001 From: Tomas Torsvik Date: Mon, 18 Aug 2025 10:14:57 +0200 Subject: [PATCH 062/135] Enable COARE for fully coupled NorESM compsets --- cime_config/namelist_definition_drv.xml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index b980a2f47..226b555b5 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -927,9 +927,13 @@ MED_attributes atm/ocn flux calculation scheme + 0 : LARGE algorithm + 1 : COARE algorithm + 2 : UA algorithm 0 + 1 From c8aed5e7f8c716e496a38410c7dc0c2eb37427fd Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Wed, 27 Aug 2025 17:12:12 +0200 Subject: [PATCH 063/135] make rof and ocn coupling periods align for 2 deg --- cime_config/config_component_cesm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 9287146a6..b03861e29 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -335,6 +335,7 @@ 24 24 18 + 24 1 24 From fe2fe6f471875f7a2af9f7bb1971d844d305f31c Mon Sep 17 00:00:00 2001 From: mvdebolskiy Date: Thu, 28 Aug 2025 19:27:56 +0200 Subject: [PATCH 064/135] add comment --- cime_config/config_component_cesm.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b03861e29..845466595 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -335,6 +335,7 @@ 24 24 18 + 24 1 24 From 84c3eb390e6e48082faee5ceeed99e19024ee5d6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 1 Sep 2025 16:23:33 +0200 Subject: [PATCH 065/135] fixed budget calculations --- mediator/med_diag_mod.F90 | 41 ++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 16ba6b755..f924a9c62 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -143,13 +143,14 @@ module med_diag_mod integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff integer :: f_heat_sen = unset_index ! heat : sensible - integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux integer :: f_heat_rain = unset_index ! heat : heat content of rain integer :: f_heat_snow = unset_index ! heat : heat content of snow integer :: f_heat_evap = unset_index ! heat : heat content of evaporation integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff + integer :: f_heat_rofa = unset_index ! heat : total heat content of runoff to atm (v2) + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux (v2) integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -339,6 +340,7 @@ subroutine med_diag_init(gcomp, rc) f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_rofi ! field last index for heat else if (trim(budget_table_version) == 'v2') then + call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_hmat ! field last index for heat @@ -724,6 +726,7 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) @@ -764,18 +767,24 @@ subroutine med_phases_diag_atm(gcomp, rc) end do call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lwup', f_heat_lwup, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_lat', f_heat_latvap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_sen', f_heat_sen, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_evap', f_watr_evap, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(budget_table_version) == 'v2') then + call diag_atm_send(is_local%wrap%FBExp(compatm), 'Faxx_hrof', f_heat_rofa, & + areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, component_contribution=.false., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + ! water isotopes if (flds_wiso) then call diag_atm_wiso_send(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & @@ -823,7 +832,8 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra end if end subroutine diag_atm_recv - subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, rc) + subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifrac, budget, & + component_contribution, rc) ! input/output variables type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname @@ -835,6 +845,7 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra real(r8) , intent(in) :: ofrac(:) real(r8) , intent(in) :: ifrac(:) real(r8) , intent(inout) :: budget(:,:,:) + logical , intent(in) :: component_contribution integer , intent(out) :: rc ! local variables integer :: n, ip @@ -847,14 +858,18 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra ip = period_inst do n = 1,size(data) budget(nf,c_atm_send,ip) = budget(nf,c_atm_send,ip) - areas(n)*data(n)*afrac(n) - budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) - budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) - if (lats(n) > 0.0_r8) then - budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) - else - budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) - end if end do + if (component_contribution) then + do n = 1,size(data) + budget(nf,c_lnd_asend,ip) = budget(nf,c_lnd_asend,ip) + areas(n)*data(n)*lfrac(n) + budget(nf,c_ocn_asend,ip) = budget(nf,c_ocn_asend,ip) + areas(n)*data(n)*ofrac(n) + if (lats(n) > 0.0_r8) then + budget(nf,c_inh_asend,ip) = budget(nf,c_inh_asend,ip) + areas(n)*data(n)*ifrac(n) + else + budget(nf,c_ish_asend,ip) = budget(nf,c_ish_asend,ip) + areas(n)*data(n)*ifrac(n) + end if + end do + end if end if end subroutine diag_atm_send From 6efc9956307d17797a4c6e33d896e2df701653cf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Sep 2025 14:40:18 +0200 Subject: [PATCH 066/135] scaling of hmat by ofrac in med_diag_mod.F90 --- mediator/med_diag_mod.F90 | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index f924a9c62..b97feaaa6 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -341,7 +341,7 @@ subroutine med_diag_init(gcomp, rc) f_heat_end = f_heat_rofi ! field last index for heat else if (trim(budget_table_version) == 'v2') then call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm - call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surf. mat. enthalpy flux + call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surface material enthalpy flux f_heat_beg = f_heat_frz ! field first index for heat f_heat_end = f_heat_hmat ! field last index for heat end if @@ -660,6 +660,7 @@ subroutine med_phases_diag_atm(gcomp, rc) real(r8), pointer :: ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) + real(r8), pointer :: data(:) character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -728,9 +729,17 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(budget_table_version) == 'v2') then - call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + ! call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & + ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + nf = f_heat_hmat + do n = 1,size(data) + !budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*(ofrac(n)+ifrac(n)) + budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*ofrac(n) + end do end if if (flds_wiso) then From a6bc075dcef09b61b3c9301ede070657eefd3da7 Mon Sep 17 00:00:00 2001 From: Mats Bentsen Date: Thu, 18 Sep 2025 07:02:54 +0200 Subject: [PATCH 067/135] Add Taylor et al. (1996) ocean albedo scheme as an option (idea and original implementation by Thomas Toniazzo). --- cime_config/namelist_definition_drv.xml | 14 ++++++++ mediator/med_phases_ocnalb_mod.F90 | 45 ++++++++++++++++++++----- 2 files changed, 50 insertions(+), 9 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 226b555b5..6c7a903c2 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -904,6 +904,20 @@ + + integer + control + MED_attributes + + Ocean albedo scheme + 0 : Briegleb et al. (1986) + 1 : Taylor et al. (1996) + + + 0 + + + char mapping diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 0a09c76aa..4e61c00e7 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -57,12 +57,14 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' ! used, reused in module - logical :: flux_albav ! use average dif and dir albedos - logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) - logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir - real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir - real(R8) :: albdif ! 60 deg reference albedo, diffuse - real(R8) :: albdir ! 60 deg reference albedo, direct + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + logical :: use_briegleb ! use Briegleb et al. (1986) ocean albedo scheme + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct + integer :: ocean_albedo_scheme ! 0: Briegleb et al. (1986); 1: Taylor et al. (1996) !=============================================================================== contains !=============================================================================== @@ -231,6 +233,14 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) if (.not. isPresent ) then use_nextswcday = .false. endif + ! Determine ocean albedo scheme + call NUOPC_CompAttributeGet(gcomp, name='ocean_albedo_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) ocean_albedo_scheme + else + ocean_albedo_scheme = 0 + end if if (flux_albav) then write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir @@ -243,6 +253,17 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) end if write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + write(msg,'(A,l1)') trim(subname)//': ocean_albedo_scheme setting is ',ocean_albedo_scheme + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (ocean_albedo_scheme == 0) then + use_briegleb = .true. + elseif (ocean_albedo_scheme == 1 ) then + use_briegleb = .false. + else + call ESMF_LogWrite( subname//' ERROR: unknown ocean_albedo_scheme', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -449,9 +470,15 @@ subroutine med_phases_ocnalb_run(gcomp, rc) rlon = const_deg2rad * ocnalb%lons(n) cosz = shr_orb_cosz( nextsw_cday, rlat, rlon, delta ) if (cosz > 0.0_r8) then !--- sun hit -- - ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & - (.150_r8*(cosz - 0.100_r8 ) * & - (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + if (use_briegleb) then + ! Briegleb et al. (1986) scheme + ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & + (.150_r8*(cosz - 0.100_r8 ) * & + (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + else + ! Taylor et al. (1996) scheme + ocnalb%anidr(n) = 0.037_r8/(1.1_r8*cosz**1.4_r8 + 0.15_r8) + endif if (use_min_albedo) then ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if From 5e9d20bb46b69c4fe450ff8d5ff8fbe3bfbdb03f Mon Sep 17 00:00:00 2001 From: Mats Bentsen Date: Thu, 18 Sep 2025 16:25:10 +0200 Subject: [PATCH 068/135] Write log messages to mediator log file and correct error check. --- mediator/med_phases_ocnalb_mod.F90 | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 4e61c00e7..8590a2c7f 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -77,7 +77,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LogWrite, ESMF_LogSetError, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet @@ -242,26 +242,25 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ocean_albedo_scheme = 0 end if - if (flux_albav) then - write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - else - if (use_min_albedo) then - write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (maintask) then + if (flux_albav) then + write(logunit,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + else + if (use_min_albedo) then + write(logunit,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + end if end if + write(logunit,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(logunit,'(A,i1)') trim(subname)//': ocean_albedo_scheme setting is ',ocean_albedo_scheme end if - write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) - write(msg,'(A,l1)') trim(subname)//': ocean_albedo_scheme setting is ',ocean_albedo_scheme - call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (ocean_albedo_scheme == 0) then use_briegleb = .true. elseif (ocean_albedo_scheme == 1 ) then use_briegleb = .false. else - call ESMF_LogWrite( subname//' ERROR: unknown ocean_albedo_scheme', ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE + call ESMF_LogSetError(ESMF_FAILURE, & + msg=trim(subname)//": ERROR: unknown ocean_albedo_scheme", & + line=__LINE__, file=__FILE__, rcToReturn=rc) return end if From 4bdf713e9869669d1472784d8f79f1efa5b0d992 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 11:35:12 +0200 Subject: [PATCH 069/135] fixed budget tables for budget_table_version=v2 --- cime_config/namelist_definition_drv.xml | 1 - mediator/med_diag_mod.F90 | 14 +++++++------- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 3450623b4..73f52730a 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1005,7 +1005,6 @@ v0 v2 v1 - v0 diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index b97feaaa6..600b7a5c0 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -351,19 +351,19 @@ subroutine med_diag_init(gcomp, rc) ! ----------------------------------------- ! Note that this order is important here to determine f_watr_beg and f_watr_end - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 call add_to_budget_diag(budget_diags%fields, f_watr_frz ,'wfreeze' ) ! field water: freezing end if call add_to_budget_diag(budget_diags%fields, f_watr_melt ,'wmelt' ) ! field water: melting call add_to_budget_diag(budget_diags%fields, f_watr_rain ,'wrain' ) ! field water: precip, liquid call add_to_budget_diag(budget_diags%fields, f_watr_snow ,'wsnow' ) ! field water: precip, frozen call add_to_budget_diag(budget_diags%fields, f_watr_evap ,'wevap' ) ! field water: evaporation - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'weqsaltf' ) ! field water: water equivalent of salt flux endif call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water @@ -1527,7 +1527,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBImp(compatm,compocn), 'Faxa_lwdn', f_heat_lwdn, ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else ! POP + else ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup' , f_heat_lwup , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_lwdn' , f_heat_lwdn , ic, areas, sfrac, budget_local, rc=rc) @@ -1539,7 +1539,7 @@ subroutine med_phases_diag_ocn( gcomp, rc) call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', f_watr_evap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! POP + if (fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lat', rc=rc)) then ! BLOM call diag_ocn(is_local%wrap%FBMed_aoflux_o, 'Faox_lat' , f_heat_latvap , ic, areas, ofrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else ! MOM6 @@ -1982,13 +1982,13 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) ic = c_inh_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if ic = c_ish_send budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice - if (trim(budget_table_version) == 'v0') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if From af2c14cee424d061350db0fcc43d60d83366cf98 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 13:28:09 +0200 Subject: [PATCH 070/135] added new v2 logicals that were missing --- mediator/med_diag_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 600b7a5c0..27e88ef4b 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -363,7 +363,7 @@ subroutine med_diag_init(gcomp, rc) endif call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff - if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then + if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index d7e7a1453..26be36bf2 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -217,7 +217,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ) then ! Error check if ( .not. med_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true, aborting ', rc=rc) + call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true', rc=rc) + return end if call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -283,7 +284,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then if ( .not. atm_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true, aborting ', rc=rc) + call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true', rc=rc) + return end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From dd3e7694c4b57c97e357307dc597bfbe6dd85eca Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 4 Oct 2025 16:23:38 +0200 Subject: [PATCH 071/135] changed default to false for atm_computes_enthalpy --- cime_config/buildnml | 7 +++++++ cime_config/namelist_definition_drv.xml | 9 +++------ 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 16dc6ac8b..960d2fd3d 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -261,6 +261,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): run_startdate = "".join(str(x) for x in case.get_value("RUN_STARTDATE").split("-")) nmlgen.set_value("start_ymd", value=run_startdate) + # -------------------------------- + # Overwrite: budget_table_version if atm computes enthalpy + # -------------------------------- + atm_computes_enthalpy_flux = nmlgen.get_value("atm_computes_enthalpy_flux") + if atm_computes_enthalpy_flux: + nmlgen.set_value("budget_table_version", value="v2") + # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 # -------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 73f52730a..f88acbaac 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -689,8 +689,7 @@ if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) - .true. - .true. + .false. @@ -999,11 +998,10 @@ MED_attributes v0,v1,v2 - currently v0 refers to budgets using POP and v1 refers to budgets using MOM6 + currently v0 refers to budgets using BLOM and v1 refers to budgets using MOM6 v0 - v2 v1 @@ -2479,10 +2477,9 @@ expdef ALLCOMP_attributes - index of scalar containing epbal precipitation factor from ocn (only for POP) + index of scalar containing epbal precipitation factor from ocn (only for BLOM) - 4 4 0 From f2ba901b616839d4315b01d3ce26dfd4be3a2d1e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 5 Oct 2025 19:09:57 +0200 Subject: [PATCH 072/135] added comment --- mediator/med_phases_prep_atm_mod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 28363b86a..eea9be483 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -242,6 +242,8 @@ subroutine med_phases_prep_atm(gcomp, rc) dataptr1(n) = dataptr1(n) + global_htot_corr(1) end do end if + ! Only do the following if the atmosphere is computing the enthalpy to be sent to the ocean + ! from rain, snow, etc. if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then call FB_getfldptr(is_local%wrap%FBExp(compatm), 'Faxx_hrof', dataptr1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 6c90dd39b76846d245f37c148c57af0355a36150 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 10 Oct 2025 10:35:46 +0200 Subject: [PATCH 073/135] changed config variable to enable from cam versus computation in mediator --- cime_config/buildnml | 4 +-- cime_config/namelist_definition_drv.xml | 28 ++++++------------- mediator/med_diag_mod.F90 | 7 +---- mediator/med_phases_prep_ocn_mod.F90 | 37 ++++++++++--------------- 4 files changed, 27 insertions(+), 49 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 960d2fd3d..44c87d554 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -264,8 +264,8 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # -------------------------------- # Overwrite: budget_table_version if atm computes enthalpy # -------------------------------- - atm_computes_enthalpy_flux = nmlgen.get_value("atm_computes_enthalpy_flux") - if atm_computes_enthalpy_flux: + component_computes_enthalpy_flux = nmlgen.get_value("component_computes_enthalpy_flux") + if 'atm' in component_computes_enthalpy_flux: nmlgen.set_value("budget_table_version", value="v2") # -------------------------------- diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ec5a98751..7bbf0e9f4 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -664,32 +664,22 @@ - + - - logical - control - ALLCOMP_attributes - - if true, the mediator computes enthalpy associated with rain, - snow, etc to send to ocn (in this case MOM6) - - - .false. - .true. - - - - - logical + + char control ALLCOMP_attributes + none,atm,med - if true, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + if none, no enthaply flux is computed to send to the ocean, + if atm, the atm (in this case cam) computes enthalpy to send to the ocn (in this case BLOM) + if med, the mediator computes computes enthalpy to send to the ocn (in this case MOM6) - .false. + none + med diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 27e88ef4b..8902901db 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -720,7 +720,7 @@ subroutine med_phases_diag_atm(gcomp, rc) call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', f_watr_rain, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Note that passing f_watr_rain twice will just add up contributions from Faxa_snowc and Faxa_snowl + ! Note that passing f_watr_snow twice will just add up contributions from Faxa_snowc and Faxa_snowl call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', f_watr_snow, & areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -729,15 +729,10 @@ subroutine med_phases_diag_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(budget_table_version) == 'v2') then - ! call diag_atm_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', f_heat_hmat, & - ! areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Faxa_hmat', data, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return nf = f_heat_hmat do n = 1,size(data) - !budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*(ofrac(n)+ifrac(n)) budget_local(nf,c_atm_recv,ip) = budget_local(nf,c_atm_recv,ip) - areas(n)*data(n)*ofrac(n) end do end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 26be36bf2..b4e6fc308 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -34,8 +34,7 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom - logical :: med_computes_enthalpy_flux - logical :: atm_computes_enthalpy_flux + character(len=CS) :: component_computes_enthalpy_flux character(*), parameter :: u_FILE_u = & __FILE__ @@ -78,22 +77,13 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp, name="med_computes_enthalpy_flux", value=cvalue, & + call NUOPC_CompAttributeGet(gcomp, name="component_computes_enthalpy_flux", value=cvalue, & isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - read(cvalue,*) med_computes_enthalpy_flux + component_computes_enthalpy_flux = trim(cvalue) else - med_computes_enthalpy_flux = .false. - end if - - call NUOPC_CompAttributeGet(gcomp, name="atm_computes_enthalpy_flux", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) atm_computes_enthalpy_flux - else - atm_computes_enthalpy_flux = .false. + component_computes_enthalpy_flux = 'none' end if end subroutine med_phases_prep_ocn_init @@ -194,7 +184,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- custom calculations + !--- custom calculation - enthalpy flux computed in mediator !--------------------------------------- ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so @@ -216,8 +206,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & ) then ! Error check - if ( .not. med_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: med_computes_enthalpy_flux must be true', rc=rc) + if (trim(component_computes_enthalpy_flux) /= 'med') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) return end if call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) @@ -280,11 +270,13 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if end if ! condition for using global energy fixer - ! Newer enthalpy terms from atm + !--------------------------------------- + !--- custom calculation - enthalpy flux obtained from atm + !--------------------------------------- if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then - if ( .not. atm_computes_enthalpy_flux) then - call shr_log_error(trim(subname)//' ERROR: atm_computes_enthalpy_flux must be true', rc=rc) + if (trim(component_computes_enthalpy_flux) /= 'atm') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to atm', rc=rc) return end if call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) @@ -342,7 +334,6 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) !----------------------- ! Compute Faxa_hmat_oa !----------------------- - ! Determine hcorr and acorr allocate(hcorr(size(tocn))) allocate(acorr(size(tocn))) @@ -393,7 +384,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) endif - ! custom merges to ocean + !--------------------------------------- + !--- custom merges to ocean + !--------------------------------------- call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From d60646c55c1c19cee5bb6067250e070397793c4a Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 13 Oct 2025 17:20:54 +0200 Subject: [PATCH 074/135] new modules for different atmocn flux schemes --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 443 ++++ cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 735 ++++++ cesm/flux_atmocn/flux_atmocn_Large.F90 | 367 +++ cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 551 +++++ cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 96 + cesm/flux_atmocn/shr_flux_mod.F90 | 2327 +----------------- mediator/med_phases_aofluxes_mod.F90 | 4 +- 7 files changed, 2214 insertions(+), 2309 deletions(-) create mode 100644 cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_Large.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_UA_mod.F90 create mode 100644 cesm/flux_atmocn/flux_atmocn_driver_mod.F90 diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 new file mode 100644 index 000000000..af0b13eb2 --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -0,0 +1,443 @@ +module flux_atmocn_COARE_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes using COARE v3.0 parametrisation + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! !REVISION HISTORY: + ! 2013-Nov-22: Thomas Toniazzo's adaptation of Chris Fairall's code, + ! downloaded from + ! ftp://ftp1.esrl.noaa.gov/users/cfairall/wcrp_wgsf/computer_programs/cor3_0/ + ! * no wave, standard coare 2.6 charnock + ! * skin parametrisation also off (would require radiative fluxes and + ! rainrate in input) + ! * added diagnostics, comments and references + !------------------------------------------------------------------------------- + + use shr_flux_mod, only : td0, maxscl, alpha + use shr_flux_mod, only : use_coldair_outbreak_mod + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + + implicit none + private + + public :: flux_atmOcn_COARE + public :: cor30a + + integer, parameter :: debug = 0 ! internal debug level + +contains + + subroutine flux_atmOcn_COARE( & + logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv, & + missval) + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + integer(IN),intent(in) :: nMax ! data vector length + integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + real(R8),intent(in) ,optional :: missval ! masked value + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: Tk ! dummy arg ~ temperature (K) + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + !--- functions --- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_COARE) ' + character(*),parameter :: F00 = "('(flux_atmOcn_COARE) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + u10n = spval + rh = spval + hol=spval + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + DO n=1,nMax + if (mask(n) /= 0) then + + !--- compute some needed quantities --- + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),ts(n),ssq & ! in surf params + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + lwup(n) = -shr_const_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !---water isotope flux --- + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n), & + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv(n) = re + if (present(ssq_sv )) ssq_sv(n) = ssq + + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + + else + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n (n) = spval ! 10m wind speed squared (m/s)^2 + + u10res (n) = spval + ugust_out(n) = spval + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + endif + enddo + + end subroutine flux_atmOcn_COARE + + !================================================================= + + subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params + uss,vss,tss,qss, & ! in surf params + zbl,zbu,zbt,zrfu,zrfq,zrft, & ! in heights + tau,hsb,hlb, & ! out: fluxes + zo,zot,zoq,L,usr,tsr,qsr, & ! out: ss scales + Cd,Ch,Ce, & ! out: exch. coeffs + trf,qrf,urf,vrf) ! out: reference-height params + + ! Arguments + real(R8),intent(in) :: ubt,vbt,tbt,qbt,rbt,uss,vss,tss,qss + real(R8),intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft + real(R8),intent(out):: tau,hsb,hlb,zo,zot,zoq,L,usr,tsr,qsr,Cd,Ch,Ce, & + trf,qrf,urf,vrf + + ! Local variables + real(R8):: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars + + real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params + real(R8):: le,rhoa,cpv ! derived phys. params + real(R8):: t,visa,du,dq,dt ! params of problem + + real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars + real(R8):: zet,rr,bf,ug,ut ! loop iter vars + real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars + + integer(IN):: i,nits ! iter loop counters + + integer(IN):: jcool ! aux. cool-skin vars + real(R8) :: dter,wetc,dqer + !---------------------------------------------------------------- + + ua = ubt !wind components (m/s) at height zu (m) + va = vbt + ta = tbt !bulk air temperature (K), height zt + Q = qbt !bulk air spec hum (kg/kg), height zq + rb = rbt !air density + us = uss !surface current components (m/s) + vs = vss + ts = tss !bulk water temperature (K) if jcool= 1, interface water T if jcool= 0 + qs = qss !bulk water spec hum (kg/kg) if jcool= 1 etc + zi = zbl !PBL depth (m) + zu = zbu !wind speed measurement height (m) + zt = zbt !air T measurement height (m) + zq = zbt !air q measurement height (m) + zru = zrfu !reference height for st.diagn.U + zrq = zrfq !reference height for st.diagn.T,q + zrt = zrft !reference height for st.diagn.T,q + + !**** constants + Beta= 1.2_R8 + von = 0.4_R8 + pi = 3.141593_R8 + grav= SHR_CONST_G + Rgas= SHR_CONST_RGAS + cpa = SHR_CONST_CPDAIR + + !*** physical parameters + Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) + ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code + cpv = cpa*(1.0_R8+0.84_R8*Q) + ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure + rhoa= rb + + ! parametrisation for air kinematic viscosity (Andreas 1989,p.31) + t = ta-273.16_R8 + visa= 1.326e-5_R8*(1.0_R8+6.542e-3_R8*t+8.301e-6_R8*t*t-4.84e-9_R8*t*t*t) + + du = sqrt((ua-us)**2+(va-vs)**2) + dt = ts-ta -.0098_R8*zt + dq = Qs-Q + + !*** don't use cool-skin params for now, but assign values to Ter and Qer + jcool=0_IN + dter=0.3_R8 + wetc=0.622_R8*Le*Qs/(Rgas*ts**2) + dqer=wetc*dter + + !***************** Begin bulk-model calculations *************** + + !*************** first guess + ug=0.5_R8 + + ut = sqrt(du*du+ug*ug) + u10 = ut*log(10.0_R8/1.0e-4_R8)/log(zu/1.0e-4_R8) + usr = .035_R8*u10 + zo10 = 0.011_R8*usr*usr/grav+0.11_R8*visa/usr + Cd10 = (von/log(10.0_R8/zo10))**2 + Ch10 = 0.00115_R8 + Ct10 = Ch10/sqrt(Cd10) + zot10= 10.0_R8/exp(von/Ct10) + Cd =(von/log(zu/zo10))**2 + Ct = von/log(zt/zot10) + CC = von*Ct/Cd + + ! Bulk Richardson number + Ribu=-grav*zu/ta*((dt-dter*jcool)+.61_R8*ta*dq)/ut**2 + + ! initial guess for stability parameter... + if (Ribu .LT. 0.0_R8) then + ! pbl-height dependent + zetu=CC*Ribu/( 1.0_R8 - (.004_R8*Beta**3*zi/zu) * Ribu ) + else + zetu=CC*Ribu*(1.0_R8 + 27.0_R8/9.0_R8*Ribu/CC) + endif + + ! ...and MO length + L10=zu/zetu + + if (zetu .GT. 50.0_R8) then + nits=1_IN + else + nits=3_IN + endif + + usr = ut*von/(log(zu/zo10)-psiuo(zu/L10)) + tsr = (dt-dter*jcool)*von/(log(zt/zot10)-psit_30(zt/L10)) + qsr = (dq-dqer*jcool)*von/(log(zq/zot10)-psit_30(zq/L10)) + + ! parametrisation for Charney parameter (section 3c of Fairall et al. 2003) + charn=0.011_R8 + if (ut .GT. 10.0_R8) then + charn=0.011_R8+(ut-10.0_R8)/(18.0_R8-10.0_R8)*(0.018_R8-0.011_R8) + endif + if (ut .GT. 18.0_R8) then + charn=0.018_R8 + endif + !*************** end first guess ************ + + !*************** iteration loop ************ + do i=1, nits + + ! stability parameter + zet=-von*grav*zu/ta*(tsr*(1.0_R8+0.61_R8*Q)+.61_R8*ta*qsr)/(usr*usr)/(1.0_R8+0.61_R8*Q) + + ! momentum roughness length... + zo = charn*usr*usr/grav+0.11_R8*visa/usr + + ! ...& MO length + L = zu/zet + + ! tracer roughness length + rr = zo*usr/visa + zoq= min(1.15e-4_R8,5.5e-5_R8/rr**.6_R8) + zot= zoq ! N.B. same for vapour and heat + + ! new surface-layer scales + usr = ut *von/(log(zu/zo )-psiuo(zu/L)) + tsr = (dt-dter*jcool)*von/(log(zt/zot)-psit_30(zt/L)) + qsr = (dq-dqer*jcool)*von/(log(zq/zoq)-psit_30(zq/L)) + + ! gustiness parametrisation + Bf=-grav/ta*usr*(tsr+.61_R8*ta*qsr) + if (Bf .GT. 0.0_R8) then + ug=Beta*(Bf*zi)**.333_R8 + else + ug=.2_R8 + endif + ut=sqrt(du*du+ug*ug) + + enddo + !*************** end loop ************ + + !******** fluxes @ measurement heights zu,zt,zq ******** + tau= rhoa*usr*usr*du/ut !stress magnitude + hsb=-rhoa*cpa*usr*tsr !heat downwards + hlb=-rhoa*Le*usr*qsr !wv downwards + + !****** transfer coeffs relative to ut @meas. hts ****** + Cd= tau/rhoa/ut/max(.1_R8,du) + if (tsr.ne.0._r8) then + Ch= usr/ut*tsr/(dt-dter*jcool) + else + Ch= usr/ut* von/(log(zt/zot)-psit_30(zt/L)) + endif + if (qsr.ne.0.0_R8) then + Ce= usr/ut*qsr/(dq-dqer*jcool) + else + Ce= usr/ut* von/(log(zq/zoq)-psit_30(zq/L)) + endif + + !********** 10-m neutral coeff relative to ut ********* + Cdn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zo) + Chn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zot) + Cen_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zoq) + + !********** reference-height values for u,q,T ********* + urf=us+(ua-us)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) + vrf=vs+(va-vs)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) + qrf=qs-dq*(log(zrq/zoq)-psit_30(zrq/L))/(log(zq/zoq)-psit_30(zq/L)) + trf=ts-dt*(log(zrt/zot)-psit_30(zrt/L))/(log(zt/zot)-psit_30(zt/L)) + trf=trf+.0098_R8*zrt + + end subroutine cor30a + +end module flux_atmocn_COARE_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 new file mode 100644 index 000000000..90f141b8d --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -0,0 +1,735 @@ +module flux_atmocn_diurnal_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! ASSUMPTIONS: + ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 + ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable + ! ctn = .0180 sqrt(cdn), stable + ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) + ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) + !------------------------------------------------------------------------------- + + use shr_flux_mod, only : td0, maxscl, alpha, debug + use shr_flux_mod, only : zvir, cpair, cpvir, karman + use shr_flux_mod, only : latvap, stebol, use_coldair_outbreak_mod + use atmocn_flux_COARE_mod, only : cor30a + use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. + + implicit none + public + + private :: cuberoot + + integer, private :: flux_con_max_iter = 2 + +contains + + subroutine flux_atmOcn_diurnal & + (logunit, ocn_surface_flux_scheme, & + nMax ,zbot ,ubot ,vbot ,thbot , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot ,us ,vs , & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O ,rhdo ,r18O ,evap ,evap_16O, & + evap_HDO ,evap_18O, & + taux ,tauy ,tref ,qref , & + uGust, lwdn , swdn , swup, prec , & + swpen, ocnsal, ocn_prognostic, & + latt, long , warm , salt , speed, regime, & + warmMax, windMax, qSolAvg, windAvg, & + warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & + tBulk, tSkin, tSkin_day, tSkin_night, & + cSkin, cSkin_night, secs ,dt, & + duu10n, ustar_sv ,re_sv ,ssq_sv, & + missval, cold_start ) + + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + integer(IN) ,intent(in) :: ocn_surface_flux_scheme + integer(IN),intent(in) :: nMax ! data vector length + integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) + + !--- new arguments ------------------------------- + real(R8),intent(inout) :: swpen (nMax) ! NEW + real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) + logical ,intent(in) :: ocn_prognostic ! NEW + real(R8),intent(in) :: uGust (nMax) ! NEW not used + real(R8),intent(in) :: lwdn (nMax) ! NEW + real(R8),intent(in) :: swdn (nMax) ! NEW + real(R8),intent(in) :: swup (nMax) ! NEW + real(R8),intent(in) :: prec (nMax) ! NEW + real(R8),intent(in) :: latt (nMax) ! NEW + real(R8),intent(in) :: long (nMax) ! NEW + real(R8),intent(inout) :: warm (nMax) ! NEW + real(R8),intent(inout) :: salt (nMax) ! NEW + real(R8),intent(inout) :: speed (nMax) ! NEW + real(R8),intent(inout) :: regime(nMax) ! NEW + real(R8),intent(out) :: warmMax(nMax) ! NEW + real(R8),intent(out) :: windMax(nMax) ! NEW + real(R8),intent(inout) :: qSolAvg(nMax) ! NEW + real(R8),intent(inout) :: windAvg(nMax) ! NEW + real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW + real(R8),intent(inout) :: windMaxInc(nMax) ! NEW + real(R8),intent(inout) :: qSolInc(nMax) ! NEW + real(R8),intent(inout) :: windInc(nMax) ! NEW + real(R8),intent(inout) :: nInc(nMax) ! NEW + + real(R8),intent(out) :: tBulk (nMax) ! NEW + real(R8),intent(out) :: tSkin (nMax) ! NEW + real(R8),intent(out) :: tSkin_day (nMax) ! NEW + real(R8),intent(out) :: tSkin_night (nMax) ! NEW + real(R8),intent(out) :: cSkin (nMax) ! NEW + real(R8),intent(out) :: cSkin_night (nMax) ! NEW + integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer(IN),intent(in) :: dt ! NEW + logical ,intent(in) :: cold_start ! cold start flag + real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + real(R8),intent(in) ,optional :: missval ! masked value + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + real(R8),parameter :: lambdaC = 6.0_R8 + real(R8),parameter :: lambdaL = 0.0_R8 + real(R8),parameter :: doLMax = 1.0_R8 + real(R8),parameter :: pwr = 0.2_R8 + real(R8),parameter :: Rizero = 1.0_R8 + real(R8),parameter :: NUzero = 40.0e-4_R8 + real(R8),parameter :: Prandtl = 1.0_R8 + real(R8),parameter :: kappa0 = 0.2e-4_R8 + + real(R8),parameter :: F0 = 0.5_R8 + real(R8),parameter :: F1 = 0.15_R8 + real(R8),parameter :: R1 = 10.0_R8 + + real(R8),parameter :: Ricr = 0.30_R8 + real(R8),parameter :: tiny = 1.0e-12_R8 + real(R8),parameter :: tiny2 = 1.0e-6_R8 + real(R8),parameter :: pi = SHR_CONST_PI + + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter ! iteration loop index + integer(IN) :: lsecs ! local seconds elapsed + integer(IN) :: lonsecs ! incrememnt due to lon offset + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: ustar_prev ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: DTiter ! + real(R8) :: DSiter ! + real(R8) :: DViter ! + + real(R8) :: Dcool ! + real(R8) :: Qdel ! net cool skin heating + real(R8) :: Hd ! net heating above -z=d + real(R8) :: Hb ! net kinematic heating above -z = delta + real(R8) :: lambdaV ! + real(R8) :: Fd ! net fresh water forcing above -z=d + real(R8) :: ustarw ! surface wind forcing of layer above -z=d + + real(R8) :: Qsol ! solar heat flux (W/m2) + real(R8) :: Qnsol ! non-solar heat flux (W/m2) + + real(R8) :: SSS ! sea surface salinity + real(R8) :: alphaT ! + real(R8) :: betaS ! + + real(R8) :: doL ! ocean forcing stablity parameter + real(R8) :: Rid ! Richardson number at depth d + real(R8) :: Ribulk ! Bulk Richardson number at depth d + real(R8) :: FofRi ! Richardon number dependent diffusivity + real(R8) :: Smult ! multiplicative term based on regime + real(R8) :: Sfact ! multiplicative term based on regime + real(R8) :: Kdiff ! diffusive term based on regime + real(R8) :: Kvisc ! viscosity term based on regime + real(R8) :: rhocn ! + real(R8) :: rcpocn ! + real(R8) :: Nreset ! value for multiplicative reset factor + logical :: lmidnight + logical :: ltwopm + logical :: ltwoam + logical :: lfullday + integer :: nsum + real(R8) :: pexp ! eqn 19 + real(R8) :: AMP ! eqn 18 + real(R8) :: dif3 + real(R8) :: phid + real(R8) :: spval + + !!++ COARE only + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: molvisc ! molecular viscosity + real(R8) :: molPr ! molecular Prandtl number + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) + molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' + character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + spval = shr_const_spval + rh = spval + dviter = spval + dtiter = spval + dsiter = spval + al2 = log(zref/ztref) + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + ! equations 18 and 19 + AMP = 1.0_R8/F0-1.0_R8 + pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) + + if (.not. ocn_prognostic) then + ! Set swpen and ocean salinity from following analytic expressions + swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 + else + ! use swpen and ocnsal from input argument + endif + + if (cold_start) then + write(logunit,F00) "Initialize diurnal cycle fields" + warm (:) = 0.0_R8 + salt (:) = 0.0_R8 + speed (:) = 0.0_R8 + regime (:) = 0.0_R8 + qSolAvg (:) = 0.0_R8 + windAvg (:) = 0.0_R8 + warmMax (:) = 0.0_R8 + windMax (:) = 0.0_R8 + warmMaxInc (:) = 0.0_R8 + windMaxInc (:) = 0.0_R8 + qSolInc (:) = 0.0_R8 + windInc (:) = 0.0_R8 + nInc (:) = 0.0_R8 + tSkin_day (:) = ts(:) + tSkin_night(:) = ts(:) + cSkin_night(:) = 0.0_R8 + endif + u10n = 0.0_r8 + stable = 0.0_r8 + DO n=1,nMax + + if (mask(n) /= 0) then + + !--- compute some initial and useful flux quantities --- + + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + alz = log(zbot(n)/zref) + hol = 0.0 + psimh = 0.0 + psixh = 0.0 + rdn = sqrt(cdn(vmag)) + + tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm + tSkin(n) = tBulk(n) + Qsol = swdn(n) + swup(n) + SSS = 1000.0_R8*ocnsal(n)+salt(n) + lambdaV = lambdaC + + alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) + betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) + rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) + rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) + + Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & + ( pwr*MAX(tiny,speed(n)) )**2 + + Ribulk = 0.0 + + !---------------------------------------------------------- + ! convert elapsed time from GMT to local & + ! check elapsed time. reset warm if near lsecs = reset_sec + !---------------------------------------------------------- + Nreset = 1.0_R8 + + lonsecs = ceiling(long(n)/360.0_R8*86400.0) + lsecs = mod(secs + lonsecs,86400) + + lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight + ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm + ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am + lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) + nsum = nint(nInc(n)) + + if ( lmidnight ) then + Regime(n) = 1.0_R8 ! RESET DIURNAL + warm(n) = 0.0_R8 + salt(n) = 0.0_R8 + speed(n) = 0.0_R8 + endif + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default E3SMv1 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + stable = 0.5_R8 + sign(0.5_R8 , delt) + + + !--- shift wind speed using old coefficient and stability function + + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- initial neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- initial ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + + call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") + + ENDIF + + ustar_prev = ustar * 2.0_R8 + iter = 0 + ! --- iterate --- + ! Originally this code did three iterations while the non-diurnal version did two + ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults + ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !------------------------------------------------------------ + ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar + ! and on Rid in the DIURNAL CYCLE + !------------------------------------------------------------ + Smult = 0.0_R8 + Sfact = 0.0_R8 + Kdiff = 0.0_R8 + Kvisc = 0.0_R8 + dif3 = 0.0_R8 + + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + + !--- COOL SKIN EFFECT --- + Dcool = lambdaV*molvisc(tBulk(n)) / ustarw + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) + Hb = min(Hb , 0.0_R8) + + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + lambdaV = 6.5_R8 + cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) + + !--- REGIME --- + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 + Rid = MAX(0.0_R8,Rid) + Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) + Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + + if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then + phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + dif3 = (kappa0 + NUzero *FofRi) + + if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then + regime(n) = 2.0_R8 + Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid + Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & + dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) + Kdiff = Kvisc + else + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + endif + else + if (regime(n).eq.1.0_R8) then + Smult = 0.0_R8 + else + if (Ribulk .gt. Ricr) then + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + else + regime(n) = 4.0_R8 + Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) + Kvisc = Kdiff + endif + endif + + endif + + !--- IMPLICIT INTEGRATION --- + + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = MAX( 0.0_R8, DTiter) + DViter = MAX( 0.0_R8, DViter) + + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 + Ribulk = Rid * pwr + Ribulk = 0.0_R8 + tBulk(n) = ts(n) + DTiter + tSkin(n) = tBulk(n) + cskin(n) + + !--need to update ssq,delt,delq as function of tBulk ---- + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + + !--- UPDATE FLUX ITERATION --- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + + !--- compute stability & evaluate all stability functions --- + hol = shr_const_karman*shr_const_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient and stability function --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) + + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- heat flux --- + + sen (n) = hsb + lat (n) = hlb + + else ! N.B.: NO ocn_surface_flux_scheme=2 option + call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") + endif + + ENDDO ! end iteration loop + if (iter < 1) then + call shr_sys_abort('No iterations performed ') + end if + + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- LW radiation --- + lwup(n) = -shr_const_stebol * Tskin(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !---water isotope flux --- + !!ZZZ bugfix to be done + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnostics: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm + + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + u10n = sqrt(duu10n(n)) + endif + + !------------------------------------------------------------ + ! update new prognostic variables + !------------------------------------------------------------ + + warm (n) = DTiter + salt (n) = DSiter + speed (n) = DViter + + if (ltwopm) then + tSkin_day(n) = tSkin(n) + warmmax(n) = max(DTiter,0.0_R8) + endif + + if (ltwoam) then + tSkin_night(n) = tSkin(n) + cSkin_night(n) = cSkin(n) + endif + + if ((lmidnight).and.(lfullday)) then + qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) + windAvg(n) = windInc(n)/real(nsum+1,R8) + ! warmMax(n) = max(DTiter,warmMaxInc(n)) + windMax(n) = max(u10n,windMaxInc(n)) + + nsum = 0 + + qSolInc(n) = Qsol + windInc(n) = u10n + + ! warmMaxInc(n) = 0.0_R8 + windMaxInc(n) = 0.0_R8 + endif + + nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum + + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv (n) = re + if (present(ssq_sv )) ssq_sv (n) = ssq + + else ! mask = 0 + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval + nInc (n) = 0.0_R8 + + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif ! mask + + endif ! flux diurnal logic + + enddo ! end n loop + + end subroutine flux_atmOcn_diurnal + + ! =================================================================== + + real(R8) elemental function cuberoot(a) + real(R8), intent(in) :: a + real(R8), parameter :: one_third = 1._R8/3._R8 + cuberoot = sign(abs(a)**one_third, a) + end function cuberoot + + +end module flux_atmocn_diurnal_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 new file mode 100644 index 000000000..1950b23db --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -0,0 +1,367 @@ +module flux_atmOcn_large_mod + + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes using Large and Pond + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! ASSUMPTIONS: + ! Large: + ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 + ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable + ! ctn = .0180 sqrt(cdn), stable + ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) + ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) + !------------------------------------------------------------------------------- + + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + use shr_flux_mod, only: loc_cpair, loc_cpvir, loc_karman, loc_g, loc_zvir + use shr_flux_mod, only: loc_latvap, loc_stebol, use_coldair_outbreak_mod + use shr_flux_mod, only: flux_con_tol, flux_con_max_iter + use shr_flux_mod, only: alpha, maxscl, tc0 + + implicit none + public + +contains + + subroutine flux_atmOcn_large( & + logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv, & + missval) + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + integer(IN),intent(in) :: nMax ! data vector length + integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical ,intent(in) :: add_gusts + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + real(R8),intent(in) ,optional :: missval ! masked value + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + !!++ Large only + !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD + !real(R8),parameter :: chxcds = 0.018_R8 ! ratio Ch(heat)/CD for stable case + !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(r8) :: ustar_prev + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: spval ! local missing value + real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) + + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + + !Large only (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) + real(R8) :: cdn ! function: neutral drag coeff at 10m + + ! Large only (stability functions) + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + + ! Convective gustiness appropriate for input precipitation. + ! Following Regelsperger et al. (2000, J. Clim) + ! Ug = log(1.0+6.69R-0.476R^2) + ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) + ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) + + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn) ' + character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + u10n = spval + rh = spval + psixh = spval + hol=spval + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + + al2 = log(zref/ztref) + DO n=1,nMax + if (mask(n) /= 0) then + + !--- compute some needed quantities --- + if (add_gusts) then + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) + ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) + else + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + ugust_out(n) = 0.0_r8 + end if + wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + ! if add_gusts wind0 and vmag are different, both need this factor. + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(wind0))),maxscl) + wind0=wind0*vscl + endif + endif + + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - ts(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + alz = log(zbot(n)/zref) + cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) + !------------------------------------------------------------ + ! first estimate of Z/L and ustar, tstar and qstar + !------------------------------------------------------------ + !--- neutral coefficients, z/L = 0.0 --- + stable = 0.5_R8 + sign(0.5_R8 , delt) + rdn = sqrt(cdn(vmag)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + !(1.0_R8-stable) * chxcdu + stable * chxcds + ren = 0.0346_R8 !cexcd + + !--- ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + ustar_prev = ustar*2.0_R8 + iter = 0 + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter < flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !--- compute stability & evaluate all stability functions --- + hol = loc_karman*loc_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/loc_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient --- + rd = rdn / (1.0_R8 + max(rdn/loc_karman*(alz-psimh), -0.5_r8)) + u10n = vmag * rd / rdn + + !--- update transfer coeffs at 10m and neutral stability --- + rdn = sqrt(cdn(u10n)) + ren = 0.0346_R8 !cexcd + rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 + !(1.0_R8-stable) * chxcdu + stable * chxcds + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/loc_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/loc_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/loc_karman*(alz-psixh)) + + !--- update ustar, tstar, qstar using updated, shifted coeffs -- + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + enddo + if (iter < 1) then + write(logunit,*) ustar,ustar_prev,flux_con_tol,flux_con_max_iter + call shr_sys_abort('No iterations performed in flux_atmocn_mod') + end if + !------------------------------------------------------------ + ! compute the fluxes + !------------------------------------------------------------ + + tau = rbot(n) * ustar * ustar + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- heat flux --- + sen (n) = cp * tau * tstar / ustar + lat (n) = loc_latvap * tau * qstar / ustar + lwup(n) = -loc_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/loc_latvap + + !---water isotope flux --- + + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/loc_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/loc_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + u10res(n) = u10n * (wind0/vmag) ! resolved 10m wind + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv(n) = re + if (present(ssq_sv )) ssq_sv(n) = ssq + + else + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval !water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + ugust_out(n) = spval ! gustiness addition (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + endif + enddo + + + end subroutine flux_atmOcn + +end module flux_atmOcn_large_mod diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 new file mode 100644 index 000000000..db15e5e35 --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -0,0 +1,551 @@ +module flux_atmocn_UA_mod + + !=============================================================================== + ! !DESCRIPTION: + ! + ! Internal atm/ocn flux calculation + ! using University of Arizona method. + ! + ! Reference: + ! Zeng, X., M. Zhao, and R.E. Dickinson, 1998: Intercomparison of Bulk + ! Aerodynamic Algorithms for the Computation of Sea Surface Fluxes + ! Using TOGA COARE and TAO Data. J. Climate, 11, 2628–2644, + ! https://doi.org/10.1175/1520-0442(1998)011<2628%3AIOBAAF>2.0.CO%3B2 + ! + ! Equation numbers are from this paper. + ! + ! !REVISION HISTORY: + ! 2017-Aug-28 - J. Reeves Eyre - code re-written for E3SM + ! 2018-Oct-30 - J. Reeves Eyre - bug fix and add convective gustiness. + ! 2019-May-08 - J. Reeves Eyre - remove convective gustiness + ! and add cold air outbreak modification. + !=============================================================================== + + implicit none + public + + ! private member functions: + private :: psi_ua + private :: qsat_ua + private :: rough_ua + +contains + + subroutine flux_atmOcn_UA( & + logunit, & + nMax ,zbot ,ubot ,vbot ,thbot , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot , pslv ,us , vs , & + ts ,mask ,sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + duu10n, ustar_sv ,re_sv ,ssq_sv, & + missval) + + ! uses: + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + real(R8),intent(in) ,optional :: missval ! masked value + + !--- local constants -------------------------------- + real(R8),parameter :: zetam = -1.574_R8 ! Very unstable zeta cutoff for momentum (-) + real(R8),parameter :: zetat = -0.465_R8 ! Very unstable zeta cutoff for T/q (-) + real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + real(R8),parameter :: beta = 1.0_R8 ! constant used in W* calculation (-) + real(R8),parameter :: zpbl = 1000.0_R8 ! PBL height used in W* calculation (m) + real(R8),parameter :: gamma = 0.0098_R8 ! Dry adiabatic lapse rate (K/m) + real(R8),parameter :: onethird = 1.0_R8/3.0_R8 ! Used repeatedly. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: i ! iteration loop index + real(R8) :: vmag_abs ! surface wind magnitude (m s-1) + real(R8) :: vmag_rel ! surface wind magnitude relative to + ! surface current (m s-1) + real(R8) :: vmag ! surface wind magnitude with large + ! eddy correction and minimum value (m s-1) + ! (This can change on each iteration.) + real(R8) :: thv ! virtual temperature (K) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delth ! potential T difference (K) + real(R8) :: delthv ! virtual potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: ustar ! friction velocity (m s-1) + real(R8) :: qstar ! humidity scaling parameter (kg/kg) + real(R8) :: tstar ! temperature scaling parameter (K) + real(R8) :: thvstar ! virtual temperature scaling parameter (K) + real(R8) :: wstar ! convective velocity scale (m s-1) + real(R8) :: zeta ! dimensionless height (z / Obukhov length) + real(R8) :: obu ! Obukhov length (m) + real(R8) :: tau ! magnitude of wind stress (N m-2) + real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) + real(R8) :: xlv ! Latent heat of vaporization (J kg-1) + real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) + real(R8) :: tbot_oC ! Temperature used in visa (deg C) + real(R8) :: rb ! Bulk Richardson number (-) + real(R8) :: zo ! Roughness length for momentum (m) + real(R8) :: zoq ! Roughness length for moisture (m) + real(R8) :: zot ! Roughness length for heat (m) + real(R8) :: u10 ! 10-metre wind speed (m s-1) + real(R8) :: re ! Moisture exchange coefficient for compatibility + ! with default algorithm. + real(R8) :: spval ! local missing value + real(R8) :: loc_epsilon ! Ratio of gas constants (-) + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn) ' + character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + + !----- + ! Straight from original subroutine. + if (debug > 0) write(logunit,F00) "enter" + + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + !----- + + ! Evaluate loc_epsilon. + loc_epsilon = 1.0_R8 / (1.0_R8 + loc_zvir) + + !--- for cold air outbreak calc -------------------------------- + tdiff = tbot - ts + + ! Loop over grid points. + do n=1,nMax + + if (mask(n) /= 0) then + + !-----Calculate some required near surface variables.--------- + vmag_abs = sqrt( ubot(n)**2 + vbot(n)**2 ) + vmag_rel = sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 ) + + ! For Cold Air Outbreak Modification (based on Mahrt & Sun 1995,MWR): + if (use_coldair_outbreak_mod) then + ! Increase windspeed for negative tbot-ts + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag_rel))),maxscl) + vmag_rel=vmag_rel*vscl + endif + endif + + delth = thbot(n) - ts(n) ! Pot. temp. difference with surface (K) + ! Note this is equivalent to Zeng et al + ! (1998) version = delt + 0.0098*zbot + thv = thbot(n)*(1.0_R8+0.61_R8*qbot(n)) ! Virtual potential temperature (K) + ! EQN (17): + !ssq = 0.98_R8 * qsat_ua(ts(n),ps, & ! Surface specific humidity (kg kg-1) + ! loc_epsilon) + ssq = 0.98_R8 * qsat_ua(ts(n),pslv(n), & ! Surface specific humidity (kg kg-1) + loc_epsilon) + delq = qbot(n) - ssq ! Difference to surface (kg kg-1) + delthv = delth*(1.0_R8+0.61_R8*qbot(n)) + & ! Difference of virtual potential + & 0.61_R8*thbot(n)*delq ! temperature with surface (K) + + xlv = 1.0e+6_R8 * & ! Latent heat of vaporization (J kg-1) + & (2.501_R8 - 0.00237_R8 * (ts(n) - loc_tkfrz)) + tbot_oC = tbot(n) - loc_tkfrz + visa = 1.326e-5_R8 * (1.0_R8 + & ! Kinematic viscosity of dry + & 6.542e-3_R8*tbot_oC + & ! air (m2 s-1) from Andreas (1989) + & 8.301e-6_R8*tbot_oC*tbot_oC - & ! CRREL Rep. 89-11 + & 4.84e-9_R8*tbot_oC*tbot_oC*tbot_oC) + cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) ! specific heat of moist air (J kg-1 K-1) + + !-----Initial values of u* and convective velocity.----------- + ustar = 0.06_R8 + wstar = 0.5_R8 + ! Update wind speed if unstable regime. + if (delthv.lt.0.0_R8) then + ! EQN (19) + vmag = sqrt( vmag_rel**2 + beta*beta*wstar*wstar ) + else + ! EQN (18) + vmag = max(umin,vmag_rel) + endif + + !-----Iterate to compute new u* and z0.----------------------- + do i = 1,5 + ! EQN (24) + zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar + ! EQN (9) assuming neutral + ustar = loc_karman*vmag/log(zbot(n)/zo) + enddo + + !-----Assess stability.--------------------------------------- + rb = loc_g*zbot(n)*delthv / (thv*vmag*vmag) ! bulk Richardson number + + if(rb.ge.0.0_R8) then + ! Neutral or stable: EQNs (4), (9), (13) and definition of rb. + zeta = rb*log(zbot(n)/zo) / & + & (1.0_R8 - 5.0_R8*min(rb,0.19_R8)) + else + ! Unstable: EQNs (4), (8), (12) and definition of rb. + zeta = rb*log(zbot(n)/zo) + endif + + obu = zbot(n)/zeta ! Obukhov length + obu = sign(max(zbot(n)/10.0_R8, abs(obu)), obu) + + !-----Main iterations (2-10 iterations would be fine).------- + do i=1,10 + + ! Update roughness lengths. + call rough_ua(zo,zot,zoq,ustar,visa) + + ! Wind variables. + zeta = zbot(n) / obu + if (zeta.lt.zetam) then + ! Very unstable regime + ! EQN (7) with extra z0 term. + ustar = loc_karman * vmag / (log(zetam*obu/zo) - & + & psi_ua(1_IN, zetam) + & + & psi_ua(1_IN, zo/obu) + & + & 1.14_R8 * ((-zeta)**onethird - (-zetam)**onethird) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (8) with extra z0 term. + ustar = loc_karman * vmag / (log(zbot(n)/zo) - & + & psi_ua(1_IN,zeta) + psi_ua(1_IN,zo/obu) ) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (9) with extra z0 term. + ustar = loc_karman * vmag / (log(zbot(n)/zo) + & + & 5.0_R8*zeta - 5.0_R8*zo/obu) + else + ! Very stable regime + ! EQN (10) with extra z0 term. + ustar = loc_karman * vmag / (log(obu/zo) + 5.0_R8 - & + & 5.0_R8*zo/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + + ! Temperature variables. + if(zeta.lt.zetat) then + ! Very unstable regime + ! EQN (11) with extra z0 term. + tstar = loc_karman * delth / (log(zetat*obu/zot) - & + & psi_ua(2_IN, zetat) + & + & psi_ua(2_IN, zot/obu) + & + & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (12) with extra z0 term. + tstar = loc_karman * delth / & + & (log(zbot(n)/zot) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zot/obu)) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (13) with extra z0 term. + tstar = loc_karman * delth / (log(zbot(n)/zot) + & + & 5.0_R8*zeta - 5.0_R8*zot/obu) + else + ! Very stable regime + ! EQN (14) with extra z0 term. + tstar = loc_karman * delth / (log(obu/zot) + & + & 5.0_R8 - 5.0_R8*zot/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + + ! Humidity variables. + ! This is done with re to give variable to save out like + ! in old algorithm. + if (zeta.lt.zetat) then + ! Very unstable regime + ! EQN (11) with extra z0 term. + re = loc_karman / (log(zetat*obu/zoq) - psi_ua(2_IN,zetat) + & + & psi_ua(2_IN,zoq/obu) + & + & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) + else if (zeta.lt.0.0_R8) then + ! Unstable regime + ! EQN (12) with extra z0 term. + re = loc_karman / & + & (log(zbot(n)/zoq) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zoq/obu)) + else if (zeta.le.1.0_R8) then + ! Stable regime + ! EQN (13) with extra z0 term. + re = loc_karman / & + & (log(zbot(n)/zoq) + 5.0_R8*zeta - 5.0_R8*zoq/obu) + else + ! Very stable regime + ! EQN (14) with extra z0 term. + re = loc_karman / & + & (log(obu/zoq) + 5.0_R8 - 5.0_R8*zoq/obu + & + & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) + endif + qstar = re * delq + + ! Update Obukhov length. + thvstar = tstar*(1.0_R8 + 0.61_R8*qbot(n)) + 0.61_R8*thbot(n)*qstar + ! EQN (4) + obu = ustar*ustar * thv / (loc_karman*loc_g*thvstar) + obu = sign( max(zbot(n)/10.0_R8, abs(obu)) ,obu) + + ! Update wind speed if in unstable regime. + if (delthv.lt.0.0_R8) then + ! EQN (20) + wstar = beta * (-loc_g*ustar*thvstar*zpbl/thv)**onethird + ! EQN (19) + vmag = sqrt(vmag_rel**2 + wstar*wstar) + else + ! EQN (18) + vmag = max(umin,vmag_rel) + endif + + enddo ! End of iterations for ustar, tstar, qstar etc. + + + !-----Calculate fluxes and wind stress.--------------------- + + !--- momentum flux --- + ! This should ensure zero wind stress when (relative) wind speed is zero, + ! components are consistent with total, and we don't ever divide by zero. + ! EQN (21) + tau = rbot(n) * ustar * ustar + taux(n) = tau * (ubot(n)-us(n)) / max(umin, vmag_rel) + tauy(n) = tau * (vbot(n)-vs(n)) / max(umin, vmag_rel) + + !--- heat flux --- + ! EQNs (22) and (23) + sen (n) = cp * rbot(n) * tstar * ustar + lat (n) = xlv * rbot(n) * qstar * ustar + lwup(n) = -loc_stebol * ts(n)**4 + + !--- water flux --- + evap(n) = lat(n)/xlv + + !---water isotope flux --- + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + zeta = zbot(n) / obu + if (zeta.lt.zetat) then + if (zeta.lt.zetam) then + ! Very unstable regime for U. + ! EQN (7) + u10 = vmag_abs + (ustar/loc_karman) * & + & 1.14_R8 * ((-zref/obu)**onethird - (-zeta)**onethird) + else + ! Unstable regime for U. + ! EQN (8) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) + endif + ! Very unstable regime for T and q. + ! EQN (11) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) + + else if (zeta.lt.0.0_R8) then + ! Unstable regime. + ! EQN (8) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) + ! EQN (12) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) + else if (zeta.le.1.0_R8) then + ! Stable regime. + ! EQN (9) + u10 = vmag_abs + (ustar/loc_karman) * & + & (log(zref/zbot(n)) + 5.0_R8*zref/obu - 5.0_R8*zeta) + ! EQN (13) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) + else + ! Very stable regime. + ! EQN (10) + u10 = vmag_abs + (ustar/loc_karman) * & + & (5.0_R8*log(zref/zbot(n)) + zref/obu - zeta) + ! EQN (14) + tref(n) = thbot(n) + (tstar/loc_karman) * & + & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) + qref(n) = qbot(n) + (qstar/loc_karman) * & + & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) + + endif + + tref(n) = tref(n) - gamma*ztref ! pot. temp to temp correction + duu10n(n) = u10*u10 ! 10m wind speed squared + + !------------------------------------------------------------ + ! optional diagnostics, needed for water tracer fluxes (dcn) + !------------------------------------------------------------ + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(ssq_sv )) ssq_sv(n) = ssq + if (present(re_sv )) re_sv(n) = re + + else + + !------------------------------------------------------------ + ! no valid data here -- out of ocean domain + !------------------------------------------------------------ + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval !water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + ! Optional diagnostics too: + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif + + enddo ! loop over grid points + + end subroutine flux_atmOcn_UA + + + !=============================================================================== + + real(R8) function psi_ua(k,zeta) + + ! Stability function for rb < 0 + + !-----Input variables.---------- + integer(IN), intent(in) :: k ! Indicates whether this is for momentum (k=1) + ! or for heat/moisture (k=2) + real(R8), intent(in) :: zeta ! Dimensionless height (=z/L) + + !-----Local variables.---------- + real(R8) :: chik ! Function of zeta. + + ! EQN (16) + chik = (1.0_R8 - 16.0_R8*zeta)**0.25_R8 + + if(k.eq.1) then + ! EQN (15) for momentum + psi_ua = 2.0_R8 * log((1.0_R8 + chik)*0.5_R8) + & + & log((1.0_R8 + chik*chik)*0.5_R8) - & + & 2.0_R8 * atan(chik) + 2.0_R8 * atan(1.0_R8) + else + ! EQN (15) for heat/moisture + psi_ua = 2.0_R8 * log((1.0_R8 + chik*chik)*0.5_R8) + endif + + end function psi_ua + + !=============================================================================== + + real(R8) function qsat_ua(t,p,loc_epsilon) + + ! Uses Tetens' formula for saturation vapor pressure from + ! Buck(1981) JAM 20, 1527-1532 + + !-----Input variables.---------- + real(R8), intent(in) :: t ! temperature (K) + real(R8), intent(in) :: p ! pressure (Pa) + real(R8), intent(in) :: loc_epsilon ! Ratio of gas constants (-) + + !-----Local variables.---------- + real(R8) :: esat ! saturated vapor pressure (hPa) + + ! Calculate saturated vapor pressure in hPa. + esat = (1.0007_R8 + 0.00000346_R8 * (p/100.0_R8)) * 6.1121_R8 * & + & exp(17.502_R8 * (t - loc_tkfrz) / (240.97_R8 + (t - loc_tkfrz))) + + ! Convert to specific humidity (kg kg-1). + qsat_ua = loc_epsilon * esat / ((p/100.0_R8) - (1.0_R8 - loc_epsilon)*esat) + + end function qsat_ua + + !=============================================================================== + + subroutine rough_ua(zo,zot,zoq,ustar,visa) + + ! Calculate roughness lengths: zo, zot, zoq. + + !-----Input variables.---------- + real(R8), intent(in) :: ustar ! friction velocity (m s-1) + real(R8), intent(in) :: visa ! kinematic viscosity of dry air (m2 s-1) + + !-----Output variables.--------- + real(R8), intent(out) :: zo ! roughness length for momentum (m) + real(R8), intent(out) :: zot ! roughness length for heat (m) + real(R8), intent(out) :: zoq ! roughness length for water vapor (m) + + !-----Local variables.---------- + real(R8) :: re_rough ! Rougness Reynold's number (-) + real(R8) :: xq ! Logarithm of roughness length ratios (moisture) + real(R8) :: xt ! Logarithm of roughness length ratios (heat) + + zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar ! EQN (24) + re_rough = ustar*zo/visa ! By definition. + xq = 2.67_R8*re_rough**0.25_R8 - 2.57_R8 ! EQN (25) + xt = xq ! EQN (26) + zoq = zo/exp(xq) ! By definition of xq + zot = zo/exp(xt) ! By definition of xt + + end subroutine rough_ua + +end module flux_atmocn_UA_mod diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 new file mode 100644 index 000000000..b2dad4dcd --- /dev/null +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -0,0 +1,96 @@ +module flux_atmocn_driver_mod.F90 + +contains + + subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + & tbot ,us ,vs, pslv, & + & ts ,mask , seq_flux_atmocn_minwind, & + & sen ,lat ,lwup , & + & r16O, rhdo, r18O, & + & evap ,evap_16O, evap_HDO, evap_18O, & + & taux ,tauy ,tref ,qref , & + & ocn_surface_flux_scheme, & + & add_gusts, & + & duu10n, & + & ugust_out, & + & u10res, & + & ustar_sv ,re_sv ,ssq_sv, & + & missval) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !! = 2 : UA algorithm (separate subroutine) + !!................................................................. + + ! Default flux scheme. + if (ocn_surface_flux_scheme == 0) then + + call flux_atmOcn_large(& + logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv, & + missval) + + else if (ocn_surface_flux_scheme == 1) then + + call flux_atmOcn_COARE(& + logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv, & + missval) + + else if (ocn_surface_flux_scheme == 2) then + + call flux_atmOcn_UA(& + logunit, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv, & + missval) + + do n=1,nMax + if (mask(n) /= 0) then + u10res(n) = sqrt(duu10n(n)) + ugust_out(n) = 0._r8 + else + u10res (n) = spval + ugust_out(n) = spval + end if + end do + + end if + + end subroutine flux_atmOcn_driver + +end module flux_atmocn_driver_mod diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index e53500bec..9488a59e6 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -4,52 +4,25 @@ module shr_flux_mod ! !USES: - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g ! shared constants use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas - use shr_sys_mod, only : shr_sys_abort ! shared system routines - implicit none - - private ! default private - - ! !PUBLIC TYPES: + use shr_sys_mod, only : shr_sys_abort ! shared system routines - ! none - - ! !PUBLIC MEMBER FUNCTIONS: + implicit none + public - public :: flux_atmOcn ! computes atm/ocn fluxes - public :: flux_atmOcn_diurnal ! computes atm/ocn fluxes with diurnal cycle - public :: flux_atmOcn_UA ! computes atm/ocn fluxes using University of Ariz algorithm (Zeng et al., 1998) - public :: flux_MOstability ! boundary layer stability scales/functions public :: shr_flux_adjust_constants ! adjust constant values used in flux calculations. (used by CAM as well) - ! !PRIVATE MEMBER FUNCTIONS: - private :: psi_ua - private :: qsat_ua - private :: rough_ua - private :: cuberoot - private :: cor30a - private :: psiuo - private :: psit_30 - - ! !PUBLIC DATA MEMBERS: - - integer(IN),parameter,public :: shr_flux_MOwScales = 1 ! w scales option - integer(IN),parameter,public :: shr_flux_MOfunctions = 2 ! functions option - real (R8),parameter,public :: shr_flux_MOgammaM = 3.59_R8 - real (R8),parameter,public :: shr_flux_MOgammaS = 7.86_R8 - - !--- rename kinds for local readability only --- - - integer,parameter :: debug = 0 ! internal debug level + integer, parameter :: debug = 0 ! internal debug level ! The follow variables are not declared as parameters so that they can be ! adjusted to support aquaplanet and potentially other simple model modes. ! The flux_adjust_constants subroutine is called to set the desired ! values. The default values are from shr_const_mod. Currently they are ! only used by the flux_atmocn routine. + real(R8) :: loc_zvir = shr_const_zvir real(R8) :: loc_cpdair = shr_const_cpdair real(R8) :: loc_cpvir = shr_const_cpvir @@ -63,16 +36,14 @@ module shr_flux_mod ! These control convergence of the iterative flux calculation ! (For Large and Pond scheme only; not UA or COARE). real(r8) :: flux_con_tol = 0.0_R8 - integer(IN) :: flux_con_max_iter = 2 + integer :: flux_con_max_iter = 2 !--- cold air outbreak parameters (Mahrt & Sun 1995,MWR) ------------- logical :: use_coldair_outbreak_mod = .false. + real(R8),parameter :: alpha = 1.4_R8 real(R8),parameter :: maxscl =2._R8 ! maximum wind scaling for flux - real(R8),parameter :: td0 = -10._R8 ! start t-ts for scaling - - character(len=*), parameter :: sourcefile = & - __FILE__ + real(R8),parameter :: td0 = -10._R8 ! start t-ts for scaling !=============================================================================== contains @@ -81,22 +52,21 @@ module shr_flux_mod subroutine shr_flux_adjust_constants( & zvir, cpair, cpvir, karman, gravit, & latvap, latice, stebol, flux_convergence_tolerance, & - flux_convergence_max_iteration, & coldair_outbreak_mod) ! Adjust local constants. Used to support simple models. - real(R8), optional, intent(in) :: zvir - real(R8), optional, intent(in) :: cpair - real(R8), optional, intent(in) :: cpvir - real(R8), optional, intent(in) :: karman - real(R8), optional, intent(in) :: gravit - real(R8), optional, intent(in) :: latvap - real(R8), optional, intent(in) :: latice - real(R8), optional, intent(in) :: stebol - real(r8), optional, intent(in) :: flux_convergence_tolerance - integer(in), optional, intent(in) :: flux_convergence_max_iteration - logical, optional, intent(in) :: coldair_outbreak_mod + real(R8) , optional, intent(in) :: zvir + real(R8) , optional, intent(in) :: cpair + real(R8) , optional, intent(in) :: cpvir + real(R8) , optional, intent(in) :: karman + real(R8) , optional, intent(in) :: gravit + real(R8) , optional, intent(in) :: latvap + real(R8) , optional, intent(in) :: latice + real(R8) , optional, intent(in) :: stebol + real(r8) , optional, intent(in) :: flux_convergence_tolerance + integer(in) , optional, intent(in) :: flux_convergence_max_iteration + logical , optional, intent(in) :: coldair_outbreak_mod !---------------------------------------------------------------------------- if (present(zvir)) loc_zvir = zvir @@ -113,2261 +83,4 @@ subroutine shr_flux_adjust_constants( & end subroutine shr_flux_adjust_constants - !=============================================================================== - ! !IROUTINE: flux_atmOcn -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! - ! !REVISION HISTORY: - ! 2002-Jun-10 - B. Kauffman - code migrated from cpl5 to cpl6 - ! 2003-Apr-02 - B. Kauffman - taux & tauy now utilize ocn velocity - ! 2003-Apr-02 - B. Kauffman - tref,qref,duu10n mods as per Bill Large - ! 2006-Nov-07 - B. Kauffman - code migrated from cpl6 to share - ! - ! 2011-Mar-13 - J. Nusbaumer - Water Isotope ocean flux added. - - ! 2019-May-16 - Jack Reeves Eyre (UA) and Kai Zhang (PNNL) - - ! Added COARE/Fairall surface flux scheme option - ! (ocn_surface_flux_scheme .eq. 1) based on code from - ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” - !=============================================================================== - SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - & tbot ,us ,vs, pslv, & - & ts ,mask , seq_flux_atmocn_minwind, & - & sen ,lat ,lwup , & - & r16O, rhdo, r18O, & - & evap ,evap_16O, evap_HDO, evap_18O, & - & taux ,tauy ,tref ,qref , & - & ocn_surface_flux_scheme, & - & add_gusts, & - & duu10n, & - & ugust_out, & - & u10res, & - & ustar_sv ,re_sv ,ssq_sv, & - & missval) - - ! !USES: - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - integer(IN),intent(in) :: ocn_surface_flux_scheme - logical ,intent(in) :: add_gusts - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) - real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - !!++ Large only - !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD - !real(R8),parameter :: chxcds = 0.018_R8 ! ratio Ch(heat)/CD for stable case - !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(r8) :: ustar_prev - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - !!++ Large only - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: spval ! local missing value - real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - !!++ Large only (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) - real(R8) :: cdn ! function: neutral drag coeff at 10m - !!++ Large only (stability functions) - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. - real(R8) :: gprec ! convective rainfall argument for ugust - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - - ! Large and Yeager 2009 - cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & - 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 - ! Capped Large and Pond by wind - ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) - ! Capped Large and Pond by Cd - ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) - ! Large and Pond - ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - - ! Convective gustiness appropriate for input precipitation. - ! Following Regelsperger et al. (2000, J. Clim) - ! Ug = log(1.0+6.69R-0.476R^2) - ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) - ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) - - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn) ' - character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" - - !------------------------------------------------------------------------------- - ! PURPOSE: - ! computes atm/ocn surface fluxes - ! - ! NOTES: - ! o all fluxes are positive downward - ! o net heat flux = net sw + lw up + lw down + sen + lat - ! o here, tstar = /U*, and qstar = /U*. - ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) - ! - ! ASSUMPTIONS: - ! Large: - ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 - ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable - ! ctn = .0180 sqrt(cdn), stable - ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) - ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) - ! COARE: - ! o use COAREv3.0 function (tht 22/11/2013) - !------------------------------------------------------------------------------- - - if (debug > 0) write(logunit,F00) "enter" - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - u10n = spval - rh = spval - psixh = spval - hol=spval - - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !! = 2 : UA algorithm (separate subroutine) - !!................................................................. - - ! Default flux scheme. - if (ocn_surface_flux_scheme .eq. 0) then - - al2 = log(zref/ztref) - DO n=1,nMax - if (mask(n) /= 0) then - - !--- compute some needed quantities --- - if (add_gusts) then - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) - ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) - else - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - ugust_out(n) = 0.0_r8 - end if - wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - ! if add_gusts wind0 and vmag are different, both need this factor. - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(wind0))),maxscl) - wind0=wind0*vscl - endif - endif - - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - ts(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - alz = log(zbot(n)/zref) - cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) - - !------------------------------------------------------------ - ! first estimate of Z/L and ustar, tstar and qstar - !------------------------------------------------------------ - !--- neutral coefficients, z/L = 0.0 --- - stable = 0.5_R8 + sign(0.5_R8 , delt) - rdn = sqrt(cdn(vmag)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - !(1.0_R8-stable) * chxcdu + stable * chxcds - ren = 0.0346_R8 !cexcd - - !--- ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - ustar_prev = ustar*2.0_R8 - iter = 0 - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter < flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !--- compute stability & evaluate all stability functions --- - hol = loc_karman*loc_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/loc_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient --- - rd = rdn / (1.0_R8 + max(rdn/loc_karman*(alz-psimh), -0.5_r8)) - u10n = vmag * rd / rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 !cexcd - rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 - !(1.0_R8-stable) * chxcdu + stable * chxcds - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/loc_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/loc_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/loc_karman*(alz-psixh)) - - !--- update ustar, tstar, qstar using updated, shifted coeffs -- - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - enddo - if (iter < 1) then - write(logunit,*) ustar,ustar_prev,flux_con_tol,flux_con_max_iter - call shr_sys_abort('No iterations performed in flux_atmocn_mod') - end if - !------------------------------------------------------------ - ! compute the fluxes - !------------------------------------------------------------ - - tau = rbot(n) * ustar * ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- heat flux --- - sen (n) = cp * tau * tstar / ustar - lat (n) = loc_latvap * tau * qstar / ustar - lwup(n) = -loc_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/loc_latvap - - !---water isotope flux --- - - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/loc_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/loc_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - u10res(n) = u10n * (wind0/vmag) ! resolved 10m wind - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re - if (present(ssq_sv )) ssq_sv(n) = ssq - - else - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - ugust_out(n) = spval ! gustiness addition (m/s) - u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - endif - ENDDO - - else if (ocn_surface_flux_scheme .eq. 1) then - !!................................. - !! use COARE algorithm - !!................................. - - - DO n=1,nMax - if (mask(n) /= 0) then - - !--- compute some needed quantities --- - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),ts(n),ssq & ! in surf params - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- heat flux --- - sen (n) = hsb - lat (n) = hlb - lwup(n) = -shr_const_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re - if (present(ssq_sv )) ssq_sv(n) = ssq - - u10res(n) = sqrt(duu10n(n)) - ugust_out(n) = 0._r8 - - else - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n (n) = spval ! 10m wind speed squared (m/s)^2 - - u10res (n) = spval - ugust_out(n) = spval - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - endif - ENDDO - - else if (ocn_surface_flux_scheme .eq. 2) then - - call flux_atmOcn_UA(logunit,& - nMax, zbot, ubot, vbot, thbot, & - qbot, s16O, sHDO, s18O, rbot, & - tbot, pslv, us, vs, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & - taux, tauy, tref, qref, & - duu10n, ustar_sv, re_sv, ssq_sv, & - missval) - do n=1,nMax - if (mask(n) /= 0) then - u10res(n) = sqrt(duu10n(n)) - ugust_out(n) = 0._r8 - else - u10res (n) = spval - ugust_out(n) = spval - end if - end do - else - - call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") - - endif !! ocn_surface_flux_scheme - - END subroutine flux_atmOcn - - !=============================================================================== - ! !IROUTINE: flux_atmOcn_UA -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! using University of Arizona method. - ! - ! Reference: - ! Zeng, X., M. Zhao, and R.E. Dickinson, 1998: Intercomparison of Bulk - ! Aerodynamic Algorithms for the Computation of Sea Surface Fluxes - ! Using TOGA COARE and TAO Data. J. Climate, 11, 2628–2644, - ! https://doi.org/10.1175/1520-0442(1998)011<2628%3AIOBAAF>2.0.CO%3B2 - ! - ! Equation numbers are from this paper. - ! - ! !REVISION HISTORY: - ! 2017-Aug-28 - J. Reeves Eyre - code re-written for E3SM - ! 2018-Oct-30 - J. Reeves Eyre - bug fix and add - ! convective gustiness. - ! 2019-May-08 - J. Reeves Eyre - remove convective gustiness - ! and add cold air outbreak modification. - !=============================================================================== - SUBROUTINE flux_atmOcn_UA(logunit, & - & nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot , & - & tbot , pslv ,us , vs , & - & ts ,mask ,sen ,lat ,lwup , & - & r16O, rhdo, r18O, & - & evap ,evap_16O, evap_HDO, evap_18O, & - & taux ,tauy ,tref ,qref , & - & duu10n, ustar_sv ,re_sv ,ssq_sv, & - & missval) - - - ! !USES: - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer ,intent(in) :: nMax ! data vector length - integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- local constants -------------------------------- - real(R8),parameter :: zetam = -1.574_R8 ! Very unstable zeta cutoff for momentum (-) - real(R8),parameter :: zetat = -0.465_R8 ! Very unstable zeta cutoff for T/q (-) - real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - real(R8),parameter :: beta = 1.0_R8 ! constant used in W* calculation (-) - real(R8),parameter :: zpbl = 1000.0_R8 ! PBL height used in W* calculation (m) - real(R8),parameter :: gamma = 0.0098_R8 ! Dry adiabatic lapse rate (K/m) - real(R8),parameter :: onethird = 1.0_R8/3.0_R8 ! Used repeatedly. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: i ! iteration loop index - real(R8) :: vmag_abs ! surface wind magnitude (m s-1) - real(R8) :: vmag_rel ! surface wind magnitude relative to - ! surface current (m s-1) - real(R8) :: vmag ! surface wind magnitude with large - ! eddy correction and minimum value (m s-1) - ! (This can change on each iteration.) - real(R8) :: thv ! virtual temperature (K) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delth ! potential T difference (K) - real(R8) :: delthv ! virtual potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: ustar ! friction velocity (m s-1) - real(R8) :: qstar ! humidity scaling parameter (kg/kg) - real(R8) :: tstar ! temperature scaling parameter (K) - real(R8) :: thvstar ! virtual temperature scaling parameter (K) - real(R8) :: wstar ! convective velocity scale (m s-1) - real(R8) :: zeta ! dimensionless height (z / Obukhov length) - real(R8) :: obu ! Obukhov length (m) - real(R8) :: tau ! magnitude of wind stress (N m-2) - real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) - real(R8) :: xlv ! Latent heat of vaporization (J kg-1) - real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) - real(R8) :: tbot_oC ! Temperature used in visa (deg C) - real(R8) :: rb ! Bulk Richardson number (-) - real(R8) :: zo ! Roughness length for momentum (m) - real(R8) :: zoq ! Roughness length for moisture (m) - real(R8) :: zot ! Roughness length for heat (m) - real(R8) :: u10 ! 10-metre wind speed (m s-1) - real(R8) :: re ! Moisture exchange coefficient for compatibility - ! with default algorithm. - real(R8) :: spval ! local missing value - real(R8) :: loc_epsilon ! Ratio of gas constants (-) - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn) ' - character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" - - !----- - ! Straight from original subroutine. - if (debug > 0) write(logunit,F00) "enter" - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - !----- - - ! Evaluate loc_epsilon. - loc_epsilon = 1.0_R8 / (1.0_R8 + loc_zvir) - - !--- for cold air outbreak calc -------------------------------- - tdiff = tbot - ts - - ! Loop over grid points. - DO n=1,nMax - if (mask(n) /= 0) then - - !-----Calculate some required near surface variables.--------- - vmag_abs = sqrt( ubot(n)**2 + vbot(n)**2 ) - vmag_rel = sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 ) - - ! For Cold Air Outbreak Modification (based on Mahrt & Sun 1995,MWR): - if (use_coldair_outbreak_mod) then - ! Increase windspeed for negative tbot-ts - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag_rel))),maxscl) - vmag_rel=vmag_rel*vscl - endif - endif - - delth = thbot(n) - ts(n) ! Pot. temp. difference with surface (K) - ! Note this is equivalent to Zeng et al - ! (1998) version = delt + 0.0098*zbot - thv = thbot(n)*(1.0_R8+0.61_R8*qbot(n)) ! Virtual potential temperature (K) - ! EQN (17): - !ssq = 0.98_R8 * qsat_ua(ts(n),ps, & ! Surface specific humidity (kg kg-1) - ! loc_epsilon) - ssq = 0.98_R8 * qsat_ua(ts(n),pslv(n), & ! Surface specific humidity (kg kg-1) - loc_epsilon) - delq = qbot(n) - ssq ! Difference to surface (kg kg-1) - delthv = delth*(1.0_R8+0.61_R8*qbot(n)) + & ! Difference of virtual potential - & 0.61_R8*thbot(n)*delq ! temperature with surface (K) - - xlv = 1.0e+6_R8 * & ! Latent heat of vaporization (J kg-1) - & (2.501_R8 - 0.00237_R8 * (ts(n) - loc_tkfrz)) - tbot_oC = tbot(n) - loc_tkfrz - visa = 1.326e-5_R8 * (1.0_R8 + & ! Kinematic viscosity of dry - & 6.542e-3_R8*tbot_oC + & ! air (m2 s-1) from Andreas (1989) - & 8.301e-6_R8*tbot_oC*tbot_oC - & ! CRREL Rep. 89-11 - & 4.84e-9_R8*tbot_oC*tbot_oC*tbot_oC) - cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) ! specific heat of moist air (J kg-1 K-1) - - !-----Initial values of u* and convective velocity.----------- - ustar = 0.06_R8 - wstar = 0.5_R8 - ! Update wind speed if unstable regime. - if (delthv.lt.0.0_R8) then - ! EQN (19) - vmag = sqrt( vmag_rel**2 + beta*beta*wstar*wstar ) - else - ! EQN (18) - vmag = max(umin,vmag_rel) - endif - - !-----Iterate to compute new u* and z0.----------------------- - do i = 1,5 - ! EQN (24) - zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar - ! EQN (9) assuming neutral - ustar = loc_karman*vmag/log(zbot(n)/zo) - enddo - - !-----Assess stability.--------------------------------------- - rb = loc_g*zbot(n)*delthv / (thv*vmag*vmag) ! bulk Richardson number - - if(rb.ge.0.0_R8) then - ! Neutral or stable: EQNs (4), (9), (13) and definition of rb. - zeta = rb*log(zbot(n)/zo) / & - & (1.0_R8 - 5.0_R8*min(rb,0.19_R8)) - else - ! Unstable: EQNs (4), (8), (12) and definition of rb. - zeta = rb*log(zbot(n)/zo) - endif - - obu = zbot(n)/zeta ! Obukhov length - obu = sign(max(zbot(n)/10.0_R8, abs(obu)), obu) - - !-----Main iterations (2-10 iterations would be fine).------- - do i=1,10 - - ! Update roughness lengths. - call rough_ua(zo,zot,zoq,ustar,visa) - - ! Wind variables. - zeta = zbot(n) / obu - if (zeta.lt.zetam) then - ! Very unstable regime - ! EQN (7) with extra z0 term. - ustar = loc_karman * vmag / (log(zetam*obu/zo) - & - & psi_ua(1_IN, zetam) + & - & psi_ua(1_IN, zo/obu) + & - & 1.14_R8 * ((-zeta)**onethird - (-zetam)**onethird) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (8) with extra z0 term. - ustar = loc_karman * vmag / (log(zbot(n)/zo) - & - & psi_ua(1_IN,zeta) + psi_ua(1_IN,zo/obu) ) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (9) with extra z0 term. - ustar = loc_karman * vmag / (log(zbot(n)/zo) + & - & 5.0_R8*zeta - 5.0_R8*zo/obu) - else - ! Very stable regime - ! EQN (10) with extra z0 term. - ustar = loc_karman * vmag / (log(obu/zo) + 5.0_R8 - & - & 5.0_R8*zo/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - - ! Temperature variables. - if(zeta.lt.zetat) then - ! Very unstable regime - ! EQN (11) with extra z0 term. - tstar = loc_karman * delth / (log(zetat*obu/zot) - & - & psi_ua(2_IN, zetat) + & - & psi_ua(2_IN, zot/obu) + & - & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (12) with extra z0 term. - tstar = loc_karman * delth / & - & (log(zbot(n)/zot) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zot/obu)) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (13) with extra z0 term. - tstar = loc_karman * delth / (log(zbot(n)/zot) + & - & 5.0_R8*zeta - 5.0_R8*zot/obu) - else - ! Very stable regime - ! EQN (14) with extra z0 term. - tstar = loc_karman * delth / (log(obu/zot) + & - & 5.0_R8 - 5.0_R8*zot/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - - ! Humidity variables. - ! This is done with re to give variable to save out like - ! in old algorithm. - if (zeta.lt.zetat) then - ! Very unstable regime - ! EQN (11) with extra z0 term. - re = loc_karman / (log(zetat*obu/zoq) - psi_ua(2_IN,zetat) + & - & psi_ua(2_IN,zoq/obu) + & - & 0.8_R8*((-zetat)**(-onethird) - (-zeta)**(-onethird)) ) - else if (zeta.lt.0.0_R8) then - ! Unstable regime - ! EQN (12) with extra z0 term. - re = loc_karman / & - & (log(zbot(n)/zoq) - psi_ua(2_IN,zeta) + psi_ua(2_IN,zoq/obu)) - else if (zeta.le.1.0_R8) then - ! Stable regime - ! EQN (13) with extra z0 term. - re = loc_karman / & - & (log(zbot(n)/zoq) + 5.0_R8*zeta - 5.0_R8*zoq/obu) - else - ! Very stable regime - ! EQN (14) with extra z0 term. - re = loc_karman / & - & (log(obu/zoq) + 5.0_R8 - 5.0_R8*zoq/obu + & - & (5.0_R8*log(zeta) + zeta - 1.0_R8) ) - endif - qstar = re * delq - - ! Update Obukhov length. - thvstar = tstar*(1.0_R8 + 0.61_R8*qbot(n)) + 0.61_R8*thbot(n)*qstar - ! EQN (4) - obu = ustar*ustar * thv / (loc_karman*loc_g*thvstar) - obu = sign( max(zbot(n)/10.0_R8, abs(obu)) ,obu) - - ! Update wind speed if in unstable regime. - if (delthv.lt.0.0_R8) then - ! EQN (20) - wstar = beta * (-loc_g*ustar*thvstar*zpbl/thv)**onethird - ! EQN (19) - vmag = sqrt(vmag_rel**2 + wstar*wstar) - else - ! EQN (18) - vmag = max(umin,vmag_rel) - endif - - enddo ! End of iterations for ustar, tstar, qstar etc. - - - !-----Calculate fluxes and wind stress.--------------------- - - !--- momentum flux --- - ! This should ensure zero wind stress when (relative) wind speed is zero, - ! components are consistent with total, and we don't ever divide by zero. - ! EQN (21) - tau = rbot(n) * ustar * ustar - taux(n) = tau * (ubot(n)-us(n)) / max(umin, vmag_rel) - tauy(n) = tau * (vbot(n)-vs(n)) / max(umin, vmag_rel) - - !--- heat flux --- - ! EQNs (22) and (23) - sen (n) = cp * rbot(n) * tstar * ustar - lat (n) = xlv * rbot(n) * qstar * ustar - lwup(n) = -loc_stebol * ts(n)**4 - - !--- water flux --- - evap(n) = lat(n)/xlv - - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - zeta = zbot(n) / obu - if (zeta.lt.zetat) then - if (zeta.lt.zetam) then - ! Very unstable regime for U. - ! EQN (7) - u10 = vmag_abs + (ustar/loc_karman) * & - & 1.14_R8 * ((-zref/obu)**onethird - (-zeta)**onethird) - else - ! Unstable regime for U. - ! EQN (8) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) - endif - ! Very unstable regime for T and q. - ! EQN (11) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & 0.8_R8 * ((-zeta)**(-onethird) - (-ztref/obu)**(-onethird)) - - else if (zeta.lt.0.0_R8) then - ! Unstable regime. - ! EQN (8) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) - (psi_ua(1_IN,zref/obu) - psi_ua(1_IN,zeta)) ) - ! EQN (12) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (log(ztref/zbot(n)) - (psi_ua(2_IN,ztref/obu) - psi_ua(2_IN,zeta)) ) - else if (zeta.le.1.0_R8) then - ! Stable regime. - ! EQN (9) - u10 = vmag_abs + (ustar/loc_karman) * & - & (log(zref/zbot(n)) + 5.0_R8*zref/obu - 5.0_R8*zeta) - ! EQN (13) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (log(ztref/zbot(n)) + 5.0_R8*ztref/obu - 5.0_R8*zeta) - else - ! Very stable regime. - ! EQN (10) - u10 = vmag_abs + (ustar/loc_karman) * & - & (5.0_R8*log(zref/zbot(n)) + zref/obu - zeta) - ! EQN (14) - tref(n) = thbot(n) + (tstar/loc_karman) * & - & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) - qref(n) = qbot(n) + (qstar/loc_karman) * & - & (5.0_R8*log(ztref/zbot(n)) + ztref/obu - zeta) - - endif - - tref(n) = tref(n) - gamma*ztref ! pot. temp to temp correction - duu10n(n) = u10*u10 ! 10m wind speed squared - - !------------------------------------------------------------ - ! optional diagnostics, needed for water tracer fluxes (dcn) - !------------------------------------------------------------ - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(ssq_sv )) ssq_sv(n) = ssq - if (present(re_sv )) re_sv(n) = re - - else - - !------------------------------------------------------------ - ! no valid data here -- out of ocean domain - !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - ! Optional diagnostics too: - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif - - ENDDO ! loop over grid points - - END subroutine flux_atmOcn_UA - - !=============================================================================== - ! Functions/subroutines used by UA surface flux scheme. - !=============================================================================== - - ! Stability function for rb < 0 - - real(R8) function psi_ua(k,zeta) - - implicit none - - !-----Input variables.---------- - integer(IN), intent(in) :: k ! Indicates whether this is for momentum (k=1) - ! or for heat/moisture (k=2) - real(R8), intent(in) :: zeta ! Dimensionless height (=z/L) - - !-----Local variables.---------- - real(R8) :: chik ! Function of zeta. - - ! EQN (16) - chik = (1.0_R8 - 16.0_R8*zeta)**0.25_R8 - - if(k.eq.1) then - ! EQN (15) for momentum - psi_ua = 2.0_R8 * log((1.0_R8 + chik)*0.5_R8) + & - & log((1.0_R8 + chik*chik)*0.5_R8) - & - & 2.0_R8 * atan(chik) + 2.0_R8 * atan(1.0_R8) - else - ! EQN (15) for heat/moisture - psi_ua = 2.0_R8 * log((1.0_R8 + chik*chik)*0.5_R8) - endif - - end function psi_ua - - !=============================================================================== - ! Uses Tetens' formula for saturation vapor pressure from - ! Buck(1981) JAM 20, 1527-1532 - - real(R8) function qsat_ua(t,p,loc_epsilon) - - implicit none - - !-----Input variables.---------- - real(R8), intent(in) :: t ! temperature (K) - real(R8), intent(in) :: p ! pressure (Pa) - real(R8), intent(in) :: loc_epsilon ! Ratio of gas constants (-) - - !-----Local variables.---------- - real(R8) :: esat ! saturated vapor pressure (hPa) - - ! Calculate saturated vapor pressure in hPa. - esat = (1.0007_R8 + 0.00000346_R8 * (p/100.0_R8)) * 6.1121_R8 * & - & exp(17.502_R8 * (t - loc_tkfrz) / (240.97_R8 + (t - loc_tkfrz))) - - ! Convert to specific humidity (kg kg-1). - qsat_ua = loc_epsilon * esat / ((p/100.0_R8) - (1.0_R8 - loc_epsilon)*esat) - - end function qsat_ua - - !=============================================================================== - ! Calculate roughness lengths: zo, zot, zoq. - - subroutine rough_ua(zo,zot,zoq,ustar,visa) - - implicit none - - !-----Input variables.---------- - real(R8), intent(in) :: ustar ! friction velocity (m s-1) - real(R8), intent(in) :: visa ! kinematic viscosity of dry air (m2 s-1) - - !-----Output variables.--------- - real(R8), intent(out) :: zo ! roughness length for momentum (m) - real(R8), intent(out) :: zot ! roughness length for heat (m) - real(R8), intent(out) :: zoq ! roughness length for water vapor (m) - - !-----Local variables.---------- - real(R8) :: re_rough ! Rougness Reynold's number (-) - real(R8) :: xq ! Logarithm of roughness length ratios (moisture) - real(R8) :: xt ! Logarithm of roughness length ratios (heat) - - zo = 0.013_R8*ustar*ustar/loc_g + 0.11_R8*visa/ustar ! EQN (24) - re_rough = ustar*zo/visa ! By definition. - xq = 2.67_R8*re_rough**0.25_R8 - 2.57_R8 ! EQN (25) - xt = xq ! EQN (26) - zoq = zo/exp(xq) ! By definition of xq - zot = zo/exp(xt) ! By definition of xt - - end subroutine rough_ua - - real(R8) elemental function cuberoot(a) - real(R8), intent(in) :: a - real(R8), parameter :: one_third = 1._R8/3._R8 - cuberoot = sign(abs(a)**one_third, a) - end function cuberoot - - !=============================================================================== - ! !IROUTINE: flux_atmOcn_diurnal -- internal atm/ocn flux calculation - ! - ! !DESCRIPTION: - ! - ! Internal atm/ocn flux calculation - ! - ! !REVISION HISTORY: - ! 2002-Jun-10 - B. Kauffman - code migrated from cpl5 to cpl6 - ! 2003-Apr-02 - B. Kauffman - taux & tauy now utilize ocn velocity - ! 2003-Apr-02 - B. Kauffman - tref,qref,duu10n mods as per Bill Large - ! 2006-Nov-07 - B. Kauffman - code migrated from cpl6 to share - !=============================================================================== - SUBROUTINE flux_atmOcn_diurnal & - (logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,us ,vs , & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O ,rhdo ,r18O ,evap ,evap_16O, & - evap_HDO ,evap_18O, & - taux ,tauy ,tref ,qref , & - uGust, lwdn , swdn , swup, prec , & - swpen, ocnsal, ocn_prognostic, flux_diurnal, & - ocn_surface_flux_scheme, & - latt, long , warm , salt , speed, regime, & - warmMax, windMax, qSolAvg, windAvg, & - warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & - tBulk, tSkin, tSkin_day, tSkin_night, & - cSkin, cSkin_night, secs ,dt, & - duu10n, ustar_sv ,re_sv ,ssq_sv, & - missval, cold_start ) - ! !USES: - - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - - !--- new arguments ------------------------------- - real(R8),intent(inout) :: swpen (nMax) ! NEW - real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) - logical ,intent(in) :: ocn_prognostic ! NEW - logical ,intent(in) :: flux_diurnal ! NEW logical for diurnal on/off - integer(IN) ,intent(in) :: ocn_surface_flux_scheme - - real(R8),intent(in) :: uGust (nMax) ! NEW not used - real(R8),intent(in) :: lwdn (nMax) ! NEW - real(R8),intent(in) :: swdn (nMax) ! NEW - real(R8),intent(in) :: swup (nMax) ! NEW - real(R8),intent(in) :: prec (nMax) ! NEW - real(R8),intent(in) :: latt (nMax) ! NEW - real(R8),intent(in) :: long (nMax) ! NEW - real(R8),intent(inout) :: warm (nMax) ! NEW - real(R8),intent(inout) :: salt (nMax) ! NEW - real(R8),intent(inout) :: speed (nMax) ! NEW - real(R8),intent(inout) :: regime(nMax) ! NEW - real(R8),intent(out) :: warmMax(nMax) ! NEW - real(R8),intent(out) :: windMax(nMax) ! NEW - real(R8),intent(inout) :: qSolAvg(nMax) ! NEW - real(R8),intent(inout) :: windAvg(nMax) ! NEW - real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW - real(R8),intent(inout) :: windMaxInc(nMax) ! NEW - real(R8),intent(inout) :: qSolInc(nMax) ! NEW - real(R8),intent(inout) :: windInc(nMax) ! NEW - real(R8),intent(inout) :: nInc(nMax) ! NEW - - real(R8),intent(out) :: tBulk (nMax) ! NEW - real(R8),intent(out) :: tSkin (nMax) ! NEW - real(R8),intent(out) :: tSkin_day (nMax) ! NEW - real(R8),intent(out) :: tSkin_night (nMax) ! NEW - real(R8),intent(out) :: cSkin (nMax) ! NEW - real(R8),intent(out) :: cSkin_night (nMax) ! NEW - integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer(IN),intent(in) :: dt ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - real(R8),intent(in) ,optional :: missval ! masked value - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - real(R8),parameter :: lambdaC = 6.0_R8 - real(R8),parameter :: lambdaL = 0.0_R8 - real(R8),parameter :: doLMax = 1.0_R8 - real(R8),parameter :: pwr = 0.2_R8 - real(R8),parameter :: Rizero = 1.0_R8 - real(R8),parameter :: NUzero = 40.0e-4_R8 - real(R8),parameter :: Prandtl = 1.0_R8 - real(R8),parameter :: kappa0 = 0.2e-4_R8 - - real(R8),parameter :: F0 = 0.5_R8 - real(R8),parameter :: F1 = 0.15_R8 - real(R8),parameter :: R1 = 10.0_R8 - - real(R8),parameter :: Ricr = 0.30_R8 - real(R8),parameter :: tiny = 1.0e-12_R8 - real(R8),parameter :: tiny2 = 1.0e-6_R8 - real(R8),parameter :: pi = SHR_CONST_PI - - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter ! iteration loop index - integer(IN) :: lsecs ! local seconds elapsed - integer(IN) :: lonsecs ! incrememnt due to lon offset - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: ustar_prev ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: DTiter ! - real(R8) :: DSiter ! - real(R8) :: DViter ! - - real(R8) :: Dcool ! - real(R8) :: Qdel ! net cool skin heating - real(R8) :: Hd ! net heating above -z=d - real(R8) :: Hb ! net kinematic heating above -z = delta - real(R8) :: lambdaV ! - real(R8) :: Fd ! net fresh water forcing above -z=d - real(R8) :: ustarw ! surface wind forcing of layer above -z=d - - real(R8) :: Qsol ! solar heat flux (W/m2) - real(R8) :: Qnsol ! non-solar heat flux (W/m2) - - real(R8) :: SSS ! sea surface salinity - real(R8) :: alphaT ! - real(R8) :: betaS ! - - real(R8) :: doL ! ocean forcing stablity parameter - real(R8) :: Rid ! Richardson number at depth d - real(R8) :: Ribulk ! Bulk Richardson number at depth d - real(R8) :: FofRi ! Richardon number dependent diffusivity - real(R8) :: Smult ! multiplicative term based on regime - real(R8) :: Sfact ! multiplicative term based on regime - real(R8) :: Kdiff ! diffusive term based on regime - real(R8) :: Kvisc ! viscosity term based on regime - real(R8) :: rhocn ! - real(R8) :: rcpocn ! - real(R8) :: Nreset ! value for multiplicative reset factor - logical :: lmidnight - logical :: ltwopm - logical :: ltwoam - logical :: lfullday - integer :: nsum - real(R8) :: pexp ! eqn 19 - real(R8) :: AMP ! eqn 18 - real(R8) :: dif3 - real(R8) :: phid - real(R8) :: spval - - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: molvisc ! molecular viscosity - real(R8) :: molPr ! molecular Prandtl number - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) - molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' - character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" - - !------------------------------------------------------------------------------- - ! PURPOSE: - ! computes atm/ocn surface fluxes - ! - ! NOTES: - ! o all fluxes are positive downward - ! o net heat flux = net sw + lw up + lw down + sen + lat - ! o here, tstar = /U*, and qstar = /U*. - ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) - ! - ! ASSUMPTIONS: - ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 - ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable - ! ctn = .0180 sqrt(cdn), stable - ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) - ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) - !------------------------------------------------------------------------------- - - if (debug > 0) write(logunit,F00) "enter" - - ! this is especially for flux_diurnal calculations - if (.not. flux_diurnal) then - write(logunit,F00) "ERROR: flux_diurnal must be true" - call shr_sys_abort(subName//"flux diurnal must be true") - endif - spval = shr_const_spval - rh = spval - dviter = spval - dtiter = spval - dsiter = spval - al2 = log(zref/ztref) - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - ! equations 18 and 19 - AMP = 1.0_R8/F0-1.0_R8 - pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) - - if (.not. ocn_prognostic) then - ! Set swpen and ocean salinity from following analytic expressions - swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 - else - ! use swpen and ocnsal from input argument - endif - - if (cold_start) then - write(logunit,F00) "Initialize diurnal cycle fields" - warm (:) = 0.0_R8 - salt (:) = 0.0_R8 - speed (:) = 0.0_R8 - regime (:) = 0.0_R8 - qSolAvg (:) = 0.0_R8 - windAvg (:) = 0.0_R8 - warmMax (:) = 0.0_R8 - windMax (:) = 0.0_R8 - warmMaxInc (:) = 0.0_R8 - windMaxInc (:) = 0.0_R8 - qSolInc (:) = 0.0_R8 - windInc (:) = 0.0_R8 - nInc (:) = 0.0_R8 - tSkin_day (:) = ts(:) - tSkin_night(:) = ts(:) - cSkin_night(:) = 0.0_R8 - endif - u10n = 0.0_r8 - stable = 0.0_r8 - DO n=1,nMax - - if (mask(n) /= 0) then - - !--- compute some initial and useful flux quantities --- - - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - alz = log(zbot(n)/zref) - hol = 0.0 - psimh = 0.0 - psixh = 0.0 - rdn = sqrt(cdn(vmag)) - - tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm - tSkin(n) = tBulk(n) - Qsol = swdn(n) + swup(n) - SSS = 1000.0_R8*ocnsal(n)+salt(n) - lambdaV = lambdaC - - alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) - betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) - rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) - rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) - - Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & - ( pwr*MAX(tiny,speed(n)) )**2 - - Ribulk = 0.0 - - !---------------------------------------------------------- - ! convert elapsed time from GMT to local & - ! check elapsed time. reset warm if near lsecs = reset_sec - !---------------------------------------------------------- - Nreset = 1.0_R8 - - lonsecs = ceiling(long(n)/360.0_R8*86400.0) - lsecs = mod(secs + lonsecs,86400) - - lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight - ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm - ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am - lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) - nsum = nint(nInc(n)) - - if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL - warm(n) = 0.0_R8 - salt(n) = 0.0_R8 - speed(n) = 0.0_R8 - endif - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default E3SMv1 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) - - - !--- shift wind speed using old coefficient and stability function - - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- initial neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- initial ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. - - call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - ENDIF - - ustar_prev = ustar * 2.0_R8 - iter = 0 - ! --- iterate --- - ! Originally this code did three iterations while the non-diurnal version did two - ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults - ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !------------------------------------------------------------ - ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar - ! and on Rid in the DIURNAL CYCLE - !------------------------------------------------------------ - Smult = 0.0_R8 - Sfact = 0.0_R8 - Kdiff = 0.0_R8 - Kvisc = 0.0_R8 - dif3 = 0.0_R8 - - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn - - !--- COOL SKIN EFFECT --- - Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) - Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) - Hb = min(Hb , 0.0_R8) - - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) - lambdaV = 6.5_R8 - cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) - - !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 - Rid = MAX(0.0_R8,Rid) - Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) - Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - - if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then - phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - dif3 = (kappa0 + NUzero *FofRi) - - if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then - regime(n) = 2.0_R8 - Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid - Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & - dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) - Kdiff = Kvisc - else - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - endif - else - if (regime(n).eq.1.0_R8) then - Smult = 0.0_R8 - else - if (Ribulk .gt. Ricr) then - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - else - regime(n) = 4.0_R8 - Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) - Kvisc = Kdiff - endif - endif - - endif - - !--- IMPLICIT INTEGRATION --- - - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) - DTiter = MAX( 0.0_R8, DTiter) - DViter = MAX( 0.0_R8, DViter) - - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 - Ribulk = Rid * pwr - Ribulk = 0.0_R8 - tBulk(n) = ts(n) + DTiter - tSkin(n) = tBulk(n) + cskin(n) - - !--need to update ssq,delt,delq as function of tBulk ---- - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - - !--- UPDATE FLUX ITERATION --- - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient and stability function --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- heat flux --- - - sen (n) = hsb - lat (n) = hlb - - else ! N.B.: NO ocn_surface_flux_scheme=2 option - call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif - - ENDDO ! end iteration loop - if (iter < 1) then - call shr_sys_abort('No iterations performed ') - end if - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - - ! Now calculated further up in subroutine. - !tau = rbot(n) * ustar * ustar - !sen (n) = cp * tau * tstar / ustar - !lat (n) = shr_const_latvap * tau * qstar / ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- LW radiation --- - lwup(n) = -shr_const_stebol * Tskin(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - !!ZZZ bugfix to be done - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnostics: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm - - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - u10n = sqrt(duu10n(n)) - endif - - if (flux_diurnal) then - - !------------------------------------------------------------ - ! update new prognostic variables - !------------------------------------------------------------ - - warm (n) = DTiter - salt (n) = DSiter - speed (n) = DViter - - if (ltwopm) then - tSkin_day(n) = tSkin(n) - warmmax(n) = max(DTiter,0.0_R8) - endif - - if (ltwoam) then - tSkin_night(n) = tSkin(n) - cSkin_night(n) = cSkin(n) - endif - - if ((lmidnight).and.(lfullday)) then - qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) - windAvg(n) = windInc(n)/real(nsum+1,R8) - ! warmMax(n) = max(DTiter,warmMaxInc(n)) - windMax(n) = max(u10n,windMaxInc(n)) - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - - ! tSkin_night(n) = tSkin(n) - ! cSkin_night(n) = cSkin(n) - - else - - if ((lmidnight).and.(.not.(lfullday))) then - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - - else - - nsum = nsum + 1 - - ! warmMaxInc (n) = max(DTiter,warmMaxInc(n)) - windMaxInc (n) = max(u10n, windMaxInc(n)) - ! windMaxInc (n) = max(Qsol, windMaxInc(n)) - qSolInc (n) = qSolInc(n)+Qsol - windInc (n) = windInc(n)+u10n - - endif - endif - - nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum - - - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv (n) = re - if (present(ssq_sv )) ssq_sv (n) = ssq - - else ! mask = 0 - - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - warm (n) = spval ! NEW - salt (n) = spval ! NEW - speed (n) = spval ! NEW - regime (n) = spval ! NEW - tBulk (n) = spval ! NEW - tSkin (n) = spval ! NEW - tSkin_night(n) = spval ! NEW - tSkin_day (n) = spval ! NEW - cSkin (n) = spval ! NEW - cSkin_night(n) = spval ! NEW - warmMax (n) = spval ! NEW - windMax (n) = spval ! NEW - qSolAvg (n) = spval ! NEW - windAvg (n) = spval ! NEW - warmMaxInc (n) = spval ! NEW - windMaxInc (n) = spval ! NEW - qSolInc (n) = spval ! NEW - windInc (n) = spval ! NEW - nInc (n) = 0.0_R8 ! NEW - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif ! mask - - endif ! flux diurnal logic - - ENDDO ! end n loop - - END subroutine flux_atmOcn_diurnal - - !=============================================================================== - ! !IROUTINE: shr_flux_MOstability -- Monin-Obukhov BL stability functions - ! - ! !DESCRIPTION: - ! - ! Monin-Obukhov boundary layer stability functions, two options: - ! turbulent velocity scales or gradient and integral functions - ! via option = shr_flux_MOwScales or shr_flux_MOfunctions - ! - ! !REVISION HISTORY: - ! 2007-Sep-19 - B. Kauffman, Bill Large - first version - !=============================================================================== - subroutine flux_MOstability(logunit,option,arg1,arg2,arg3,arg4,arg5) - - ! !USES: - - implicit none - - ! !INPUT/OUTPUT PARAMETERS: - integer ,intent(in) :: logunit - integer ,intent(in) :: option ! shr_flux_MOwScales or MOfunctions - real(R8) ,intent(in) :: arg1 ! scales: uStar (in) funct: zeta (in) - real(R8) ,intent(inout) :: arg2 ! scales: zkB (in) funct: phim (out) - real(R8) ,intent(out) :: arg3 ! scales: phim (out) funct: phis (out) - real(R8) ,intent(out) :: arg4 ! scales: phis (out) funct: psim (out) - real(R8) ,intent(out),optional :: arg5 ! scales: (unused) funct: psis (out) - - !----- local variables ----- - real(R8) :: zeta ! z/L - real(R8) :: uStar ! friction velocity - real(R8) :: zkB ! (height)*(von Karman)*(surface bouyancy flux) - real(R8) :: phim ! momentum gradient function or scale - real(R8) :: phis ! temperature gradient function or scale - real(R8) :: psim ! momentum integral function or scale - real(R8) :: psis ! temperature integral function or scale - real(R8) :: temp ! temporary-variable/partial calculation - - !----- local variables, stable case ----- - real(R8),parameter :: uStarMin = 0.001_R8 ! lower bound on uStar - real(R8),parameter :: a = 1.000_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: b = 0.667_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: c = 5.000_R8 ! constant from Holtslag & de Bruin, equation 12 - real(R8),parameter :: d = 0.350_R8 ! constant from Holtslag & de Bruin, equation 12 - - !----- local variables, unstable case ----- - real(R8),parameter :: a2 = 3.0_R8 ! constant from Wilson, equation 10 - - !----- formats ----- - character(*),parameter :: subName = '(shr_flux_MOstability) ' - character(*),parameter :: F00 = "('(shr_flux_MOstability) ',4a)" - character(*),parameter :: F01 = "('(shr_flux_MOstability) ',a,i5)" - - !------------------------------------------------------------------------------- - ! Notes:: - ! o this could be two routines, but are one to help keep them aligned - ! o the stable calculation is taken from... - ! A.A.M. HoltSlag and H.A.R. de Bruin, 1988: - ! "Applied Modeling of the Nighttime Surface Energy Balance over Land", - ! Journal of Applied Meteorology, Vol. 27, No. 6, June 1988, 659-704 - ! o the unstable calculation is taken from... - ! D. Keith Wilson, 2001: "An Alternative Function for the Wind and - ! Temperature Gradients in Unstable Surface Layers", - ! Boundary-Layer Meteorology, 99 (2001), 151-158 - !------------------------------------------------------------------------------- - - !----- check for consistancy between option and arguments ------------------ - if (debug > 1) then - if (debug > 2) write(logunit,F01) "enter, option = ",option - if ( option == shr_flux_MOwScales .and. present(arg5) ) then - write(logunit,F01) "ERROR: option1 must have four arguments" - call shr_sys_abort(subName//"option inconsistant with arguments") - else if ( option == shr_flux_MOfunctions .and. .not. present(arg5) ) then - write(logunit,F01) "ERROR: option2 must have five arguments" - call shr_sys_abort(subName//"option inconsistant with arguments") - else - write(logunit,F01) "invalid option = ",option - call shr_sys_abort(subName//"invalid option") - end if - end if - - !------ velocity scales option ---------------------------------------------- - if (option == shr_flux_MOwScales) then - - !--- input --- - uStar = arg1 - zkB = arg2 - - if (zkB >= 0.0_R8) then ! ----- stable ----- - zeta = zkB/(max(uStar,uStarMin)**3) - temp = exp(-d*zeta) - phim = uStar/(1.0_R8 + zeta*(a + b*(1.0_R8 + c - d*zeta)*temp)) - phis = phim - else ! ----- unstable ----- - temp = (zkB*zkB)**(1.0_R8/a2) ! note: zkB < 0, zkB*zkB > 0 - phim = sqrt(uStar**2 + shr_flux_MOgammaM*temp) - phis = sqrt(uStar**2 + shr_flux_MOgammaS*temp) - end if - - !--- output --- - arg3 = phim - arg4 = phis - ! arg5 = - - !------ stability function option ------------------------------------------- - else if (option == shr_flux_MOfunctions) then - - !--- input --- - zeta = arg1 - - if (zeta >= 0.0_R8) then ! ----- stable ----- - temp = exp(-d*zeta) - phim = 1.0_R8 + zeta*(a + b*(1.0_R8 + c - d*zeta)*temp) - phis = phim - psim = -a*zeta - b*(zeta - c/d)*temp - b*c/d - psis = psim - else ! ----- unstable ---- - temp = (zeta*zeta)**(1.0_R8/a2) ! note: zeta < 0, zeta*zeta > 0 - phim = 1.0_R8/sqrt(1.0_R8 + shr_flux_MOgammaM*temp) - phis = 1.0_R8/sqrt(1.0_R8 + shr_flux_MOgammaS*temp) - psim = a2*log(0.5_R8 + 0.5_R8/phim) - psis = a2*log(0.5_R8 + 0.5_R8/phis) - end if - - !--- output --- - arg2 = phim - arg3 = phis - arg4 = psim - arg5 = psis - !---------------------------------------------------------------------------- - else - write(logunit,F01) "invalid option = ",option - call shr_sys_abort(subName//"invalid option") - endif - - end subroutine flux_MOstability - - !=============================================================================== - ! !DESCRIPTION: - ! - ! COARE v3.0 parametrisation - ! - ! !REVISION HISTORY: - ! 2013-Nov-22: Thomas Toniazzo's adaptation of Chris Fairall's code, - ! downloaded from - ! ftp://ftp1.esrl.noaa.gov/users/cfairall/wcrp_wgsf/computer_programs/cor3_0/ - ! * no wave, standard coare 2.6 charnock - ! * skin parametrisation also off (would require radiative fluxes and - ! rainrate in input) - ! * added diagnostics, comments and references - !=============================================================================== - subroutine cor30a(ubt,vbt,tbt,qbt,rbt & ! in atm params - & ,uss,vss,tss,qss & ! in surf params - & ,zbl,zbu,zbt,zrfu,zrfq,zrft & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,L,usr,tsr,qsr & ! out: ss scales - & ,Cd,Ch,Ce & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! !USES: - - IMPLICIT NONE - - ! !INPUT/OUTPUT PARAMETERS: - - real(R8),intent(in) :: ubt,vbt,tbt,qbt,rbt,uss,vss,tss,qss - real(R8),intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft - real(R8),intent(out):: tau,hsb,hlb,zo,zot,zoq,L,usr,tsr,qsr,Cd,Ch,Ce & - & ,trf,qrf,urf,vrf - - real(R8) ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars - - real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params - real(R8):: le,rhoa,cpv ! derived phys. params - real(R8):: t,visa,du,dq,dt ! params of problem - - real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars - real(R8):: zet,rr,bf,ug,ut ! loop iter vars - real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars - - integer(IN):: i,nits ! iter loop counters - - integer(IN):: jcool ! aux. cool-skin vars - real(R8):: dter,wetc,dqer - - ua=ubt !wind components (m/s) at height zu (m) - va=vbt - ta=tbt !bulk air temperature (K), height zt - Q =qbt !bulk air spec hum (kg/kg), height zq - rb=rbt ! air density - us=uss !surface current components (m/s) - vs=vss - ts=tss !bulk water temperature (K) if jcool=1, interface water T if jcool=0 - qs=qss !bulk water spec hum (kg/kg) if jcool=1 etc - zi=zbl !PBL depth (m) - zu=zbu !wind speed measurement height (m) - zt=zbt !air T measurement height (m) - zq=zbt !air q measurement height (m) - zru=zrfu ! reference height for st.diagn.U - zrq=zrfq ! reference height for st.diagn.T,q - zrt=zrft ! reference height for st.diagn.T,q - - !**** constants - Beta= 1.2_R8 - von = 0.4_R8 - pi = 3.141593_R8 - grav= SHR_CONST_G - Rgas= SHR_CONST_RGAS - cpa = SHR_CONST_CPDAIR - - !*** physical parameters - Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) - ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code - cpv = cpa*(1.0_R8+0.84_R8*Q) - ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure - rhoa= rb - - ! parametrisation for air kinematic viscosity (Andreas 1989,p.31) - t = ta-273.16_R8 - visa= 1.326e-5_R8*(1.0_R8+6.542e-3_R8*t+8.301e-6_R8*t*t-4.84e-9_R8*t*t*t) - - du = sqrt((ua-us)**2+(va-vs)**2) - dt = ts-ta -.0098_R8*zt - dq = Qs-Q - - !*** don't use cool-skin params for now, but assign values to Ter and Qer - jcool=0_IN - dter=0.3_R8 - wetc=0.622_R8*Le*Qs/(Rgas*ts**2) - dqer=wetc*dter - - !***************** Begin bulk-model calculations *************** - - !*************** first guess - ug=0.5_R8 - - ut = sqrt(du*du+ug*ug) - u10 = ut*log(10.0_R8/1.0e-4_R8)/log(zu/1.0e-4_R8) - usr = .035_R8*u10 - zo10 = 0.011_R8*usr*usr/grav+0.11_R8*visa/usr - Cd10 = (von/log(10.0_R8/zo10))**2 - Ch10 = 0.00115_R8 - Ct10 = Ch10/sqrt(Cd10) - zot10= 10.0_R8/exp(von/Ct10) - Cd =(von/log(zu/zo10))**2 - Ct = von/log(zt/zot10) - CC = von*Ct/Cd - - ! Bulk Richardson number - Ribu=-grav*zu/ta*((dt-dter*jcool)+.61_R8*ta*dq)/ut**2 - ! initial guess for stability parameter... - if (Ribu .LT. 0.0_R8) then - ! pbl-height dependent - zetu=CC*Ribu/( 1.0_R8 - (.004_R8*Beta**3*zi/zu) * Ribu ) - else - zetu=CC*Ribu*(1.0_R8 + 27.0_R8/9.0_R8*Ribu/CC) - endif - ! ...and MO length - L10=zu/zetu - - if (zetu .GT. 50.0_R8) then - nits=1_IN - else - nits=3_IN - endif - - usr = ut*von/(log(zu/zo10)-psiuo(zu/L10)) - tsr = (dt-dter*jcool)*von/(log(zt/zot10)-psit_30(zt/L10)) - qsr = (dq-dqer*jcool)*von/(log(zq/zot10)-psit_30(zq/L10)) - - ! parametrisation for Charney parameter (section 3c of Fairall et al. 2003) - charn=0.011_R8 - if (ut .GT. 10.0_R8) then - charn=0.011_R8+(ut-10.0_R8)/(18.0_R8-10.0_R8)*(0.018_R8-0.011_R8) - endif - if (ut .GT. 18.0_R8) then - charn=0.018_R8 - endif - - !*************** iteration loop ************ - do i=1, nits - - ! stability parameter - zet=-von*grav*zu/ta*(tsr*(1.0_R8+0.61_R8*Q)+.61_R8*ta*qsr)/(usr*usr)/(1.0_R8+0.61_R8*Q) - - ! momentum roughness length... - zo = charn*usr*usr/grav+0.11_R8*visa/usr - ! ...& MO length - L = zu/zet - - ! tracer roughness length - rr = zo*usr/visa - zoq= min(1.15e-4_R8,5.5e-5_R8/rr**.6_R8) - zot= zoq ! N.B. same for vapour and heat - - ! new surface-layer scales - usr = ut *von/(log(zu/zo )-psiuo(zu/L)) - tsr = (dt-dter*jcool)*von/(log(zt/zot)-psit_30(zt/L)) - qsr = (dq-dqer*jcool)*von/(log(zq/zoq)-psit_30(zq/L)) - - ! gustiness parametrisation - Bf=-grav/ta*usr*(tsr+.61_R8*ta*qsr) - if (Bf .GT. 0.0_R8) then - ug=Beta*(Bf*zi)**.333_R8 - else - ug=.2_R8 - endif - ut=sqrt(du*du+ug*ug) - - enddo - !*************** end loop ************ - - !******** fluxes @ measurement heights zu,zt,zq ******** - tau= rhoa*usr*usr*du/ut !stress magnitude - hsb=-rhoa*cpa*usr*tsr !heat downwards - hlb=-rhoa*Le*usr*qsr !wv downwards - - !****** transfer coeffs relative to ut @meas. hts ****** - Cd= tau/rhoa/ut/max(.1_R8,du) - if (tsr.ne.0._r8) then - Ch= usr/ut*tsr/(dt-dter*jcool) - else - Ch= usr/ut* von/(log(zt/zot)-psit_30(zt/L)) - endif - if (qsr.ne.0.0_R8) then - Ce= usr/ut*qsr/(dq-dqer*jcool) - else - Ce= usr/ut* von/(log(zq/zoq)-psit_30(zq/L)) - endif - - !********** 10-m neutral coeff relative to ut ********* - Cdn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zo) - Chn_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zot) - Cen_10=von*von/log(10.0_R8/zo)/log(10.0_R8/zoq) - - !********** reference-height values for u,q,T ********* - urf=us+(ua-us)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) - vrf=vs+(va-vs)*(log(zru/zo)-psiuo(zru/L))/(log(zu/zo)-psiuo(zu/L)) - qrf=qs-dq*(log(zrq/zoq)-psit_30(zrq/L))/(log(zq/zoq)-psit_30(zq/L)) - trf=ts-dt*(log(zrt/zot)-psit_30(zrt/L))/(log(zt/zot)-psit_30(zt/L)) - trf=trf+.0098_R8*zrt - - end subroutine cor30a - - !=============================================================================== - ! !IROUTINE: PSIUo - ! - ! !DESCRIPTION: - ! - ! momentum stability functions adopted in COARE v3.0 parametrisation. - ! Chris Fairall's code (see cor30a) - ! - ! !REVISION HISTORY: - ! 22/11/2013: Thomas Toniazzo: comments added - !=============================================================================== - - real (R8) function psiuo(zet) - ! !INPUT/OUTPUT PARAMETERS: - real(R8),intent(in) :: zet - real(R8) ::c,x,psik,psic,f - !----------------------------------------------------------------- - ! N.B.: z0/L always neglected compared to z/L and to 1 - !----------------------------------------------------------------- - if(zet>0.0_R8)then - ! Beljaars & Holtslag (1991) - c=min(50._R8,.35_R8*zet) - psiuo=-((1.0_R8+1.0_R8*zet)**1.0_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) - else - ! Dyer & Hicks (1974) for weak instability - x=(1.0_R8-15.0_R8*zet)**.25_R8 ! 15 instead of 16 - psik=2.0_R8*log((1.0_R8+x)/2.0_R8)+log((1.0_R8+x*x)/2.0_R8)-2.0_R8*atan(x)+2.0_R8*atan(1.0_R8) - ! Fairall et al. (1996) for strong instability (Eq.(13)) - x=(1.0_R8-10.15_R8*zet)**.3333_R8 - psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & - & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) - f=zet*zet/(1.0_R8+zet*zet) - psiuo=(1.0_R8-f)*psik+f*psic - endif - END FUNCTION psiuo - - !=============================================================================== - ! !IROUTINE: PSIT_30 - ! - ! !DESCRIPTION: - ! - ! momentum stability functions adopted in COARE v3.0 parametrisation. - ! Chris Fairall's code (see cor30a) - ! - ! !REVISION HISTORY: - ! 22/11/2013: Thomas Toniazzo: comments added - !=============================================================================== - real (R8) function psit_30(zet) - ! !INPUT/OUTPUT PARAMETERS: - real(R8),intent(in) :: zet - ! !EOP - real(R8) ::c,x,psik,psic,f - !----------------------------------------------------------------- - ! N.B.: z0/L always neglected compared to z/L and to 1 - !----------------------------------------------------------------- - if(zet>0.0_R8)then - ! Beljaars & Holtslag (1991) - c=min(50._R8,.35_R8*zet) - psit_30=-((1.0_R8+2.0_R8/3.0_R8*zet)**1.5_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) - else - ! Dyer & Hicks (1974) for weak instability - x=(1.0_R8-15.0_R8*zet)**.5_R8 ! 15 instead of 16 - psik=2.0_R8*log((1.0_R8+x)/2.0_R8) - ! Fairall et al. (1996) for strong instability - x=(1.0_R8-(34.15_R8*zet))**.3333_R8 - psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & - & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) - f=zet*zet/(1.0_R8+zet*zet) - psit_30=(1.0_R8-f)*psik+f*psic - endif - end FUNCTION psit_30 - end module shr_flux_mod diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3618c1ba..cf8f3d6bf 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -972,7 +972,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED - use shr_flux_mod , only : flux_atmocn + use shr_flux_mod , only : flux_atmocn_driver #else use flux_atmocn_mod, only : flux_atmocn #endif @@ -1068,7 +1068,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) !---------------------------------- #ifdef CESMCOUPLED - call flux_atmocn (logunit=logunit, & + call flux_atmocn_driver (logunit=logunit, & nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & rainc=aoflux_in%rainc, & From ce9bfd24c8857adf258edeb9c8f00be91cb1692b Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 15 Oct 2025 10:11:51 +0200 Subject: [PATCH 075/135] fixed issue from PR review --- cime_config/buildnml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 44c87d554..a82d2193a 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -267,6 +267,17 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): component_computes_enthalpy_flux = nmlgen.get_value("component_computes_enthalpy_flux") if 'atm' in component_computes_enthalpy_flux: nmlgen.set_value("budget_table_version", value="v2") + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") == "mom6", + "Only CAM and BLOM are currently allowed if cam computes enthalpy flux" + ) + elif component_computes_enthalpy_flux == "med": + expect( + case.get_value("COMP_ATM") != "cam" and + case.get_value("COMP_OCN") != "mom6", + "Only CAM and MOM6 are currently allowed if medediator computes enthalpy flux" + ) # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 From 561efe78192218f109f48ef90ae2c6aeeceabd23 Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 15 Oct 2025 10:56:07 +0200 Subject: [PATCH 076/135] fixed problem in how ocn2glc coupling was handled --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index a82d2193a..617a0e6e8 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -162,7 +162,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # ---------------------------------------------------- # double check if ocn2glc_coupling is set correctly ocn2glc_coupling = nmlgen.get_value("ocn2glc_coupling") - if "ocn2glc_coupling" == ".true.": + if ocn2glc_coupling == ".true.": expect(case.get_value("COMP_OCN") == 'blom' or 'DOCN%MULTILEV' in case.get_value("COMPSET"), "ocn2glc_coupling is only allowed currently if the ocean component is BLOM or if DOCN%MULTILEV is in the compset") From 202528f7ecba24e1ad6265c963247c650a9a555f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 15 Oct 2025 18:15:46 +0200 Subject: [PATCH 077/135] addressed more issues in the PR --- mediator/med_phases_prep_atm_mod.F90 | 12 +++++++++-- mediator/med_phases_prep_ocn_mod.F90 | 32 ++++++++++++++-------------- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index eea9be483..0f031831a 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -273,6 +273,8 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) ! 'Foxx_evap','Foxx_hevap','Foxx_hcond','Foxx_rofl', ! 'Foxx_hrofl','Foxx_rofi','Foxx_hrofi','Foxx_rofl_glc', ! 'Foxx_hrofl_glc','Foxx_rofi_glc','Foxx_hrofi_glc' + ! The result is added as a correction to the sensible heat flux sent back to the atm + ! in subroutine med_phases_prep_atm use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM use ESMF , only : ESMF_VM @@ -312,8 +314,14 @@ end subroutine med_phases_prep_atm_enthalpy_correction !----------------------------------------------------------------------------- subroutine med_phases_prep_atm_enthalpy_runoff(gcomp, hcorr, rc) - use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM - use ESMF , only : ESMF_VM + use ESMF , only : ESMF_VMAllreduce, ESMF_GridCompGet, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VM + + ! Enthalpy of runoff calculated called by med_phases_prep_ocn_accum in + ! med_phases_prep_ocn_mod + ! Note that this is only called if the following fields are in FBExp(compocn) + ! - Faxa_hmat, Faxa_hlat + ! The result (Faxx_hrof) is sent back to the atm in subroutine med_phases_prep_atm ! input/output variables type(ESMF_GridComp) , intent(in) :: gcomp diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b4e6fc308..1e028f877 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -189,22 +189,22 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so ! enthalpy from meltw **is not** included below - if(FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & - ) then + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & + ) then ! Error check if (trim(component_computes_enthalpy_flux) /= 'med') then call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) From ccbd55b5007e3f9a4248bf60c1e8002a3467ac0f Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 09:18:36 +0200 Subject: [PATCH 078/135] more updates --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 48 +++---- cesm/flux_atmocn/flux_atmocn_Large.F90 | 48 +++---- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 46 +++---- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 134 +++++++++++++------- 4 files changed, 166 insertions(+), 110 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index af0b13eb2..f4ef54f7a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -22,15 +22,15 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : use_coldair_outbreak_mod - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none private - public :: flux_atmOcn_COARE - public :: cor30a + public :: flux_atmOcn_COARE + private :: cor30a - integer, parameter :: debug = 0 ! internal debug level + integer :: debug = 0 ! internal debug level contains @@ -165,27 +165,27 @@ subroutine flux_atmOcn_COARE( & endif ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),ts(n),ssq & ! in surf params - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params + us(n),vs(n),ts(n),ssq, & ! in surf params + zpbl,zbot(n),zbot(n),zref,ztref,ztref, & ! in heights + tau,hsb,hlb, & ! out: fluxes + zo,zot,zoq,hol,ustar,tstar,qstar, & ! out: ss scales + rd,rh,re, & ! out: exch. coeffs + trf,qrf,urf,vrf) ! out: reference-height params ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) + hol = zbot(n)/hol + rd = sqrt(rd) + rh = sqrt(rh) + re = sqrt(re) !--- momentum flux --- taux(n) = tau * (ubot(n)-us(n)) / vmag tauy(n) = tau * (vbot(n)-vs(n)) / vmag !--- heat flux --- - sen (n) = hsb - lat (n) = hlb + sen (n) = hsb + lat (n) = hlb lwup(n) = -shr_const_stebol * ts(n)**4 !--- water flux --- @@ -210,13 +210,14 @@ subroutine flux_atmOcn_COARE( & ! optional diagnostics, needed for water tracer fluxes (dcn) !------------------------------------------------------------ if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv(n) = re + if (present(re_sv )) re_sv(n) = re if (present(ssq_sv )) ssq_sv(n) = ssq u10res(n) = sqrt(duu10n(n)) ugust_out(n) = 0._r8 else + !------------------------------------------------------------ ! no valid data here -- out of domain !------------------------------------------------------------ @@ -255,10 +256,13 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params trf,qrf,urf,vrf) ! out: reference-height params ! Arguments - real(R8),intent(in) :: ubt,vbt,tbt,qbt,rbt,uss,vss,tss,qss - real(R8),intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft - real(R8),intent(out):: tau,hsb,hlb,zo,zot,zoq,L,usr,tsr,qsr,Cd,Ch,Ce, & - trf,qrf,urf,vrf + real(R8), intent(in) :: ubt,vbt,tbt,qbt,rbt + real(R8), intent(in) :: uss,vss,tss,qss + real(R8), intent(in) :: zbl,zbu,zbt,zrfu,zrfq,zrft + real(R8), intent(out) :: tau,hsb,hlb + real(R8), intent(out) :: zo,zot,zoq,L,usr,tsr,qsr + real(R8), intent(out) :: Cd,Ch,Ce + real(R8), intent(out) :: trf,qrf,urf,vrf ! Local variables real(R8):: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 1950b23db..45239f291 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -28,6 +28,8 @@ module flux_atmOcn_large_mod implicit none public + integer, private :: debug = 0 + contains subroutine flux_atmOcn_large( & @@ -72,36 +74,33 @@ subroutine flux_atmOcn_large( & real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) - real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value + real(R8),intent(in) ,optional :: missval ! masked value !--- local constants -------------------------------- real(R8),parameter :: zref = 10.0_R8 ! reference height (m) real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - !!++ Large only + !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD !real(R8),parameter :: chxcds = 0.018_R8 ! ratio Ch(heat)/CD for stable case !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. !--- local variables -------------------------------- integer(IN) :: n ! vector loop index @@ -136,11 +135,10 @@ subroutine flux_atmOcn_large( & real(R8) :: spval ! local missing value real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) - !--- local functions -------------------------------- real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - !Large only (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) + ! (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) real(R8) :: cdn ! function: neutral drag coeff at 10m ! Large only (stability functions) @@ -154,14 +152,16 @@ subroutine flux_atmOcn_large( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. - real(R8) :: gprec ! convective rainfall argument for ugust + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust + ! ------------------------------------------------------------------------- qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) ! Capped Large and Pond by Cd @@ -182,6 +182,7 @@ subroutine flux_atmOcn_large( & !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + ! -------------------------------------------------------------------------- if (debug > 0) write(logunit,F00) "enter" @@ -198,14 +199,15 @@ subroutine flux_atmOcn_large( & !--- for cold air outbreak calc -------------------------------- tdiff= tbot - ts - al2 = log(zref/ztref) + DO n=1,nMax if (mask(n) /= 0) then !--- compute some needed quantities --- if (add_gusts) then - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) + vmag = max(seq_flux_atmocn_minwind, & + sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) else vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) @@ -232,9 +234,11 @@ subroutine flux_atmOcn_large( & delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) cp = loc_cpdair*(1.0_R8 + loc_cpvir*ssq) + !------------------------------------------------------------ ! first estimate of Z/L and ustar, tstar and qstar !------------------------------------------------------------ + !--- neutral coefficients, z/L = 0.0 --- stable = 0.5_R8 + sign(0.5_R8 , delt) rdn = sqrt(cdn(vmag)) diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index db15e5e35..cd2c53cee 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -22,25 +22,28 @@ module flux_atmocn_UA_mod !=============================================================================== implicit none - public + private + + public :: flux_atmOcn_UA ! private member functions: private :: psi_ua private :: qsat_ua private :: rough_ua + integer, private :: debug = 0 + contains - subroutine flux_atmOcn_UA( & - logunit, & - nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot , pslv ,us , vs , & - ts ,mask ,sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - duu10n, ustar_sv ,re_sv ,ssq_sv, & + subroutine flux_atmOcn_UA( & + logunit, nMax, zbot, ubot, vbot, thbot, & + qbot, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv, re_sv, ssq_sv, & missval) ! uses: @@ -69,18 +72,18 @@ subroutine flux_atmOcn_UA( & real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) @@ -103,8 +106,7 @@ subroutine flux_atmOcn_UA( & integer(IN) :: n ! vector loop index integer(IN) :: i ! iteration loop index real(R8) :: vmag_abs ! surface wind magnitude (m s-1) - real(R8) :: vmag_rel ! surface wind magnitude relative to - ! surface current (m s-1) + real(R8) :: vmag_rel ! surface wind magnitude relative to surface current (m s-1) real(R8) :: vmag ! surface wind magnitude with large ! eddy correction and minimum value (m s-1) ! (This can change on each iteration.) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index b2dad4dcd..b5756691c 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -1,5 +1,8 @@ module flux_atmocn_driver_mod.F90 + implicit none + public + contains subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & @@ -18,66 +21,109 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & & ustar_sv ,re_sv ,ssq_sv, & & missval) + !--- input arguments -------------------------------- + integer , intent(in) :: logunit + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical , intent(in) :: add_gusts + real(R8) , intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) , intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) , intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) , intent(in) :: tbot (nMax) ! atm T (K) + real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) , intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) , intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) , intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) , intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + integer , intent(in) :: ocn_surface_flux_scheme + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + real(R8),intent(out),optional :: z0(nMax) ! roughness length + real(R8),intent(in) ,optional :: missval ! masked value + !-------------------------------------------------------------------------------- + !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! ocn_surface_flux_scheme = 0 : Large and Pond !! = 1 : COARE algorithm - !! = 2 : UA algorithm (separate subroutine) + !! = 2 : UA algorithm !!................................................................. ! Default flux scheme. if (ocn_surface_flux_scheme == 0) then - call flux_atmOcn_large(& + call flux_atmOcn_Large( & logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv, & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & missval) else if (ocn_surface_flux_scheme == 1) then - call flux_atmOcn_COARE(& + call flux_atmOcn_COARE( & logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv, & - missval) + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + duu10n, & + ugust_out, & + u10res, & + ustar_sv=ustar_sv ,re_sv=re_sv ,ssq_sv=ssq_sv, & + missval=missval) else if (ocn_surface_flux_scheme == 2) then - call flux_atmOcn_UA(& - logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv, & - missval) + call flux_atmOcn_UA( & + logunit, nMax, zbot, ubot, vbot, thbot, & + qbot, rainc, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & + missval=missval) do n=1,nMax if (mask(n) /= 0) then From 334a26c6fe5f35064547d8e64a44404eb5450400 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 10:31:28 +0200 Subject: [PATCH 079/135] fixed compile problems --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 3 +- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 41 ++++++++++---------- cesm/flux_atmocn/flux_atmocn_Large.F90 | 7 ++-- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 7 +++- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 18 +++++++-- 5 files changed, 48 insertions(+), 28 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index f4ef54f7a..e19f62ce2 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -20,6 +20,7 @@ module flux_atmocn_COARE_mod ! * added diagnostics, comments and references !------------------------------------------------------------------------------- + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : use_coldair_outbreak_mod use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. @@ -29,7 +30,7 @@ module flux_atmocn_COARE_mod public :: flux_atmOcn_COARE private :: cor30a - + integer :: debug = 0 ! internal debug level contains diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 90f141b8d..1cdd7589c 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -18,12 +18,13 @@ module flux_atmocn_diurnal_mod ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) !------------------------------------------------------------------------------- + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_flux_mod, only : td0, maxscl, alpha, debug use shr_flux_mod, only : zvir, cpair, cpvir, karman use shr_flux_mod, only : latvap, stebol, use_coldair_outbreak_mod use atmocn_flux_COARE_mod, only : cor30a use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. - + implicit none public @@ -31,7 +32,7 @@ module flux_atmocn_diurnal_mod integer, private :: flux_con_max_iter = 2 -contains +contains subroutine flux_atmOcn_diurnal & (logunit, ocn_surface_flux_scheme, & @@ -678,24 +679,24 @@ subroutine flux_atmOcn_diurnal & !------------------------------------------------------------ ! no valid data here -- out of domain !------------------------------------------------------------ - warm (n) = spval - salt (n) = spval - speed (n) = spval - regime (n) = spval - tBulk (n) = spval - tSkin (n) = spval - tSkin_night(n) = spval - tSkin_day (n) = spval - cSkin (n) = spval - cSkin_night(n) = spval - warmMax (n) = spval - windMax (n) = spval - qSolAvg (n) = spval - windAvg (n) = spval - warmMaxInc (n) = spval - windMaxInc (n) = spval - qSolInc (n) = spval - windInc (n) = spval + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval nInc (n) = 0.0_R8 sen (n) = spval ! sensible heat flux (W/m^2) diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 45239f291..ed218fee4 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -2,7 +2,7 @@ module flux_atmOcn_large_mod !------------------------------------------------------------------------------- ! PURPOSE: - ! computes atm/ocn surface fluxes using Large and Pond + ! computes atm/ocn surface fluxes using Large and Pond ! ! NOTES: ! o all fluxes are positive downward @@ -18,12 +18,13 @@ module flux_atmOcn_large_mod ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) !------------------------------------------------------------------------------- - - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + + use shr_kind_mod, only: R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_flux_mod, only: loc_cpair, loc_cpvir, loc_karman, loc_g, loc_zvir use shr_flux_mod, only: loc_latvap, loc_stebol, use_coldair_outbreak_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, tc0 + use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none public diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index cd2c53cee..e7f9aac29 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -21,6 +21,11 @@ module flux_atmocn_UA_mod ! and add cold air outbreak modification. !=============================================================================== + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : td0, maxscl, alpha + use shr_flux_mod, only : use_coldair_outbreak_mod + use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. + implicit none private @@ -345,7 +350,7 @@ subroutine flux_atmOcn_UA( & !-----Calculate fluxes and wind stress.--------------------- - + !--- momentum flux --- ! This should ensure zero wind stress when (relative) wind speed is zero, ! components are consistent with total, and we don't ever divide by zero. diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index b5756691c..4528e1e09 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -1,4 +1,6 @@ -module flux_atmocn_driver_mod.F90 +module flux_atmocn_driver_mod + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds implicit none public @@ -68,6 +70,10 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) real(R8),intent(out),optional :: z0(nMax) ! roughness length real(R8),intent(in) ,optional :: missval ! masked value + + !--- local variables -------------------------------- + integer :: n + real(R8) :: spval ! local missing value !-------------------------------------------------------------------------------- !!................................................................. @@ -93,7 +99,7 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & ugust_out, & u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & - missval) + missval=missval) else if (ocn_surface_flux_scheme == 1) then @@ -125,7 +131,13 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & missval=missval) - do n=1,nMax + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + + do n = 1,nMax if (mask(n) /= 0) then u10res(n) = sqrt(duu10n(n)) ugust_out(n) = 0._r8 From 3e2b114ba9e83d090758b739fcb2b8b4f89b1524 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 11:43:01 +0200 Subject: [PATCH 080/135] fixed compiler problems --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 82 +++---- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 12 +- cesm/flux_atmocn/flux_atmocn_Large.F90 | 244 +++++++++---------- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 132 +++++----- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 91 +++---- 5 files changed, 269 insertions(+), 292 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index e19f62ce2..6b2ed14e2 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -35,44 +35,44 @@ module flux_atmocn_COARE_mod contains - subroutine flux_atmOcn_COARE( & - logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv, & - missval) + subroutine flux_atmOcn_COARE( & + logunit, spval, nMax ,zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + duu10n, & + ugust_out, & + u10res, & + ustar_sv ,re_sv ,ssq_sv) !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + integer , intent(in) :: logunit + real(R8) , intent(in) :: spval + integer , intent(in) :: nMax ! data vector length + integer , intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) , intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) , intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) , intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) , intent(in) :: tbot (nMax) ! atm T (K) + real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) , intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) , intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) , intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) , intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) !--- output arguments ------------------------------- real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) @@ -94,8 +94,6 @@ subroutine flux_atmOcn_COARE( & real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - real(R8),intent(in) ,optional :: missval ! masked value - !--- local constants -------------------------------- real(R8),parameter :: zref = 10.0_R8 ! reference height (m) real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) @@ -136,14 +134,8 @@ subroutine flux_atmOcn_COARE( & if (debug > 0) write(logunit,F00) "enter" - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - u10n = spval rh = spval - hol=spval + hol= spval !--- for cold air outbreak calc -------------------------------- tdiff= tbot - ts diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 1cdd7589c..c243efbb4 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -34,8 +34,8 @@ module flux_atmocn_diurnal_mod contains - subroutine flux_atmOcn_diurnal & - (logunit, ocn_surface_flux_scheme, & + subroutine flux_atmOcn_diurnal( & + logunit, spval, ocn_surface_flux_scheme, & nMax ,zbot ,ubot ,vbot ,thbot , & qbot ,s16O ,sHDO ,s18O ,rbot , & tbot ,us ,vs , & @@ -52,11 +52,12 @@ subroutine flux_atmOcn_diurnal & tBulk, tSkin, tSkin_day, tSkin_night, & cSkin, cSkin_night, secs ,dt, & duu10n, ustar_sv ,re_sv ,ssq_sv, & - missval, cold_start ) + cold_start) !--- input arguments -------------------------------- integer ,intent(in) :: logunit + real(r8) ,intent(in) :: spval integer(IN) ,intent(in) :: ocn_surface_flux_scheme integer(IN),intent(in) :: nMax ! data vector length integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain @@ -113,8 +114,6 @@ subroutine flux_atmOcn_diurnal & logical ,intent(in) :: cold_start ! cold start flag real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - real(R8),intent(in) ,optional :: missval ! masked value - !--- output arguments ------------------------------- real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) @@ -230,7 +229,6 @@ subroutine flux_atmOcn_diurnal & real(R8) :: AMP ! eqn 18 real(R8) :: dif3 real(R8) :: phid - real(R8) :: spval !!++ COARE only real(R8) :: zo,zot,zoq ! roughness lengths @@ -265,12 +263,12 @@ subroutine flux_atmOcn_diurnal & if (debug > 0) write(logunit,F00) "enter" - spval = shr_const_spval rh = spval dviter = spval dtiter = spval dsiter = spval al2 = log(zref/ztref) + !--- for cold air outbreak calc -------------------------------- tdiff= tbot - ts diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index ed218fee4..82dd00c1b 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -33,70 +33,70 @@ module flux_atmOcn_large_mod contains - subroutine flux_atmOcn_large( & - logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv, & - missval) + subroutine flux_atmOcn_large( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + ustar_sv, re_sv, ssq_sv) !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - logical ,intent(in) :: add_gusts - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + integer ,intent(in) :: logunit + real(R8) ,intent(in) :: spval ! local missing value + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + logical ,intent(in) :: add_gusts + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) + real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) - real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8),intent(out) :: ugust_out(nMax) ! diag: gustiness addition to U10 (m/s) + real(R8),intent(out) :: u10res(nMax) ! diag: gustiness addition to U10 (m/s) real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - real(R8),intent(in) ,optional :: missval ! masked value + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) !real(R8),parameter :: cexcd = 0.0346_R8 ! ratio Ch(water)/CD @@ -104,57 +104,56 @@ subroutine flux_atmOcn_large( & !real(R8),parameter :: chxcdu = 0.0327_R8 ! ratio Ch(heat)/CD for unstable case !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(r8) :: ustar_prev - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: spval ! local missing value - real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) + integer :: n ! vector loop index + integer :: iter + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(r8) :: ustar_prev + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: wind0 ! resolved large-scale 10m wind (no gust added) !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) ! (formula v*=[c4/U10+c5+c6*U10]*U10 in Large et al. 1994) - real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: cdn ! function: neutral drag coeff at 10m ! Large only (stability functions) - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl - real(R8) :: ugust ! function: gustiness as a function of convective rainfall. - real(R8) :: gprec ! convective rainfall argument for ugust + real(R8) :: ugust ! function: gustiness as a function of convective rainfall. + real(R8) :: gprec ! convective rainfall argument for ugust ! ------------------------------------------------------------------------- qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) @@ -179,7 +178,6 @@ subroutine flux_atmOcn_large( & ! Coefficients X by 8640 for mm/s (from cam) -> cm/day (for above forumla) ugust(gprec) = log(1._R8+57801.6_r8*gprec-3.55332096e7_r8*(gprec**2)) - !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" @@ -187,15 +185,10 @@ subroutine flux_atmOcn_large( & if (debug > 0) write(logunit,F00) "enter" - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - u10n = spval - rh = spval + u10n = spval + rh = spval psixh = spval - hol=spval + hol = spval !--- for cold air outbreak calc -------------------------------- tdiff= tbot - ts @@ -207,11 +200,11 @@ subroutine flux_atmOcn_large( & !--- compute some needed quantities --- if (add_gusts) then - vmag = max(seq_flux_atmocn_minwind, & - sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) + vmag = max(seq_flux_atmocn_minwind, & + sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2 + (1.0_R8*ugust(min(rainc(n),6.94444e-4_r8))**2)) ) ugust_out(n) = ugust(min(rainc(n),6.94444e-4_r8)) else - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) ugust_out(n) = 0.0_r8 end if wind0 = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) @@ -309,7 +302,6 @@ subroutine flux_atmOcn_large( & evap(n) = lat(n)/loc_latvap !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & qbot(n),evap(n)) call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& @@ -345,24 +337,24 @@ subroutine flux_atmOcn_large( & ! no valid data here -- out of domain !------------------------------------------------------------ - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 ugust_out(n) = spval ! gustiness addition (m/s) - u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) + u10res(n) = spval ! 10m resolved wind (no gusts) (m/s) if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval endif enddo diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index e7f9aac29..1e1c7f1e6 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -40,67 +40,63 @@ module flux_atmocn_UA_mod contains - subroutine flux_atmOcn_UA( & - logunit, nMax, zbot, ubot, vbot, thbot, & - qbot, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & - taux, tauy, tref, qref, & - duu10n, ustar_sv, re_sv, ssq_sv, & - missval) - - ! uses: - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. + subroutine flux_atmOcn_UA( & + logunit, nMax, spval, & + zbot, ubot, vbot, thbot, & + qbot, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv, re_sv, ssq_sv) !--- input arguments -------------------------------- integer ,intent(in) :: logunit + real(R8) ,intent(in) :: spval integer ,intent(in) :: nMax ! data vector length integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind (m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) - real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) + real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - real(R8),intent(in) ,optional :: missval ! masked value + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) !--- local constants -------------------------------- real(R8),parameter :: zetam = -1.574_R8 ! Very unstable zeta cutoff for momentum (-) real(R8),parameter :: zetat = -0.465_R8 ! Very unstable zeta cutoff for T/q (-) - real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: umin = 0.1_R8 ! minimum wind speed (m/s) + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) real(R8),parameter :: beta = 1.0_R8 ! constant used in W* calculation (-) real(R8),parameter :: zpbl = 1000.0_R8 ! PBL height used in W* calculation (m) @@ -108,39 +104,36 @@ subroutine flux_atmOcn_UA( & real(R8),parameter :: onethird = 1.0_R8/3.0_R8 ! Used repeatedly. !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: i ! iteration loop index - real(R8) :: vmag_abs ! surface wind magnitude (m s-1) - real(R8) :: vmag_rel ! surface wind magnitude relative to surface current (m s-1) - real(R8) :: vmag ! surface wind magnitude with large - ! eddy correction and minimum value (m s-1) - ! (This can change on each iteration.) - real(R8) :: thv ! virtual temperature (K) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delth ! potential T difference (K) - real(R8) :: delthv ! virtual potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: ustar ! friction velocity (m s-1) - real(R8) :: qstar ! humidity scaling parameter (kg/kg) - real(R8) :: tstar ! temperature scaling parameter (K) - real(R8) :: thvstar ! virtual temperature scaling parameter (K) - real(R8) :: wstar ! convective velocity scale (m s-1) - real(R8) :: zeta ! dimensionless height (z / Obukhov length) - real(R8) :: obu ! Obukhov length (m) - real(R8) :: tau ! magnitude of wind stress (N m-2) - real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) - real(R8) :: xlv ! Latent heat of vaporization (J kg-1) - real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) - real(R8) :: tbot_oC ! Temperature used in visa (deg C) - real(R8) :: rb ! Bulk Richardson number (-) - real(R8) :: zo ! Roughness length for momentum (m) - real(R8) :: zoq ! Roughness length for moisture (m) - real(R8) :: zot ! Roughness length for heat (m) - real(R8) :: u10 ! 10-metre wind speed (m s-1) - real(R8) :: re ! Moisture exchange coefficient for compatibility - ! with default algorithm. - real(R8) :: spval ! local missing value - real(R8) :: loc_epsilon ! Ratio of gas constants (-) + integer :: n ! vector loop index + integer :: i ! iteration loop index + real(R8) :: vmag_abs ! surface wind magnitude (m s-1) + real(R8) :: vmag_rel ! surface wind magnitude relative to surface current (m s-1) + real(R8) :: vmag ! surface wind magnitude with large eddy correction and minimum value (m s-1) + ! (This can change on each iteration.) + real(R8) :: thv ! virtual temperature (K) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delth ! potential T difference (K) + real(R8) :: delthv ! virtual potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: ustar ! friction velocity (m s-1) + real(R8) :: qstar ! humidity scaling parameter (kg/kg) + real(R8) :: tstar ! temperature scaling parameter (K) + real(R8) :: thvstar ! virtual temperature scaling parameter (K) + real(R8) :: wstar ! convective velocity scale (m s-1) + real(R8) :: zeta ! dimensionless height (z / Obukhov length) + real(R8) :: obu ! Obukhov length (m) + real(R8) :: tau ! magnitude of wind stress (N m-2) + real(R8) :: cp ! specific heat of moist air (J kg-1 K-1) + real(R8) :: xlv ! Latent heat of vaporization (J kg-1) + real(R8) :: visa ! Kinematic viscosity of dry air (m2 s-1) + real(R8) :: tbot_oC ! Temperature used in visa (deg C) + real(R8) :: rb ! Bulk Richardson number (-) + real(R8) :: zo ! Roughness length for momentum (m) + real(R8) :: zoq ! Roughness length for moisture (m) + real(R8) :: zot ! Roughness length for heat (m) + real(R8) :: u10 ! 10-metre wind speed (m s-1) + real(R8) :: re ! Moisture exchange coefficient for compatibility with default algorithm. + real(R8) :: loc_epsilon ! Ratio of gas constants (-) !--- for cold air outbreak calc -------------------------------- real(R8) :: tdiff(nMax) ! tbot - ts @@ -149,6 +142,7 @@ subroutine flux_atmOcn_UA( & !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn) ' character(*),parameter :: F00 = "('(flux_atmOcn) ',4a)" + !--------------------------------------------------------------------------- !----- ! Straight from original subroutine. diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 4528e1e09..e1a8054d1 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -82,60 +82,61 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & !! = 2 : UA algorithm !!................................................................. + if (present(missval)) then + spval = missval + else + spval = shr_const_spval + endif + ! Default flux scheme. if (ocn_surface_flux_scheme == 0) then - call flux_atmOcn_Large( & - logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & - missval=missval) + call flux_atmOcn_Large( & + logunit, spval, nMax , & + zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + add_gusts, & + duu10n, & + ugust_out, & + u10res, & + spval, & + ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == 1) then - call flux_atmOcn_COARE( & - logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - duu10n, & - ugust_out, & - u10res, & - ustar_sv=ustar_sv ,re_sv=re_sv ,ssq_sv=ssq_sv, & - missval=missval) + call flux_atmOcn_COARE( & + logunit, spval, nMax , & + zbot ,ubot ,vbot ,thbot , & + qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & + tbot ,us ,vs, pslv, & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O, rhdo, r18O, & + evap ,evap_16O, evap_HDO, evap_18O, & + taux ,tauy ,tref ,qref , & + duu10n, & + ugust_out, & + u10res, & + ustar_sv=ustar_sv ,re_sv=re_sv ,ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == 2) then - call flux_atmOcn_UA( & - logunit, nMax, zbot, ubot, vbot, thbot, & - qbot, rainc, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & - taux, tauy, tref, qref, & - duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv, & - missval=missval) - - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif + call flux_atmOcn_UA( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, s16O, sHDO, s18O, rbot, & + tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) do n = 1,nMax if (mask(n) /= 0) then From f322cd01fd94d5edd85c31387f2bc3beea160842 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 11:55:39 +0200 Subject: [PATCH 081/135] fixed typos --- cime_config/buildnml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 617a0e6e8..e39153803 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -270,13 +270,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): expect( case.get_value("COMP_ATM") != "cam" and case.get_value("COMP_OCN") == "mom6", - "Only CAM and BLOM are currently allowed if cam computes enthalpy flux" + "Only CAM and BLOM are currently allowed if cam computes enthalpy fluxes" ) elif component_computes_enthalpy_flux == "med": expect( case.get_value("COMP_ATM") != "cam" and case.get_value("COMP_OCN") != "mom6", - "Only CAM and MOM6 are currently allowed if medediator computes enthalpy flux" + "Only CAM and MOM6 are currently allowed if mediator computes enthalpy fluxes" ) # -------------------------------- From 749e5a8296d9fc67a5b8f42d7d3f4cd90da1c198 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 12:05:30 +0200 Subject: [PATCH 082/135] fix compiler issues --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 6 +++++- cesm/flux_atmocn/shr_flux_mod.F90 | 6 ++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index e1a8054d1..e3d4e9430 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -1,6 +1,10 @@ module flux_atmocn_driver_mod - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_const_mod, only : shr_const_spval + use flux_atmocn_Large_mod, only : flux_atmocn_Large + use flux_atmocn_COARE_mod, only : flux_atmocn_COARE + use flux_atmocn_UA_mod, only : flux_atmocn_UA implicit none public diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9488a59e6..d1cf04cb5 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -1,12 +1,10 @@ module shr_flux_mod - ! atm/ocn/flux calculations - - ! !USES: + ! constants for atm/ocn/flux calculations use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g ! shared constants - use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz, shr_const_pi, shr_const_spval + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort ! shared system routines From 3ba77581c8f081c920bfb22a5928700ed6e20ddd Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 12:21:29 +0200 Subject: [PATCH 083/135] fixed compile problem --- cesm/flux_atmocn/shr_flux_mod.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index d1cf04cb5..27e905e9e 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -49,7 +49,9 @@ module shr_flux_mod subroutine shr_flux_adjust_constants( & zvir, cpair, cpvir, karman, gravit, & - latvap, latice, stebol, flux_convergence_tolerance, & + latvap, latice, stebol, & + flux_convergence_tolerance, & + flux_convergence_max_iteration, & coldair_outbreak_mod) ! Adjust local constants. Used to support simple models. From 2e21ce05ce2567e57f2c39a984b4f1a43d6be584 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 13:29:23 +0200 Subject: [PATCH 084/135] more compile issues --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 4 ++-- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 4 ++++ cesm/flux_atmocn/flux_atmocn_Large.F90 | 3 +-- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 6b2ed14e2..7e21ef012 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -28,8 +28,8 @@ module flux_atmocn_COARE_mod implicit none private - public :: flux_atmOcn_COARE - private :: cor30a + public :: flux_atmOcn_COARE + public :: cor30a integer :: debug = 0 ! internal debug level diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index c243efbb4..51274e593 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -22,6 +22,10 @@ module flux_atmocn_diurnal_mod use shr_flux_mod, only : td0, maxscl, alpha, debug use shr_flux_mod, only : zvir, cpair, cpvir, karman use shr_flux_mod, only : latvap, stebol, use_coldair_outbreak_mod + use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz + use shr_const_mod, only : shr_const_pi, shr_const_spval + use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use atmocn_flux_COARE_mod, only : cor30a use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 82dd00c1b..05f40b044 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -358,7 +358,6 @@ subroutine flux_atmOcn_large( & endif enddo - - end subroutine flux_atmOcn + end subroutine flux_atmOcn_large end module flux_atmOcn_large_mod From 962d043f857de0d70c607f1c2e69f3c18c198cc5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 14:12:38 +0200 Subject: [PATCH 085/135] fixed more compile problems --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 73 + cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 1459 +++++++++--------- cesm/flux_atmocn/flux_atmocn_Large.F90 | 9 +- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 14 +- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 9 +- 5 files changed, 811 insertions(+), 753 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 7e21ef012..c51ceb58f 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -21,6 +21,8 @@ module flux_atmocn_COARE_mod !------------------------------------------------------------------------------- use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_const_mod, only : shr_const_stebol, shr_const_latvap, shr_const_g + use shr_const_mod, only : shr_const_rgas, shr_const_cpdair use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : use_coldair_outbreak_mod use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. @@ -31,6 +33,9 @@ module flux_atmocn_COARE_mod public :: flux_atmOcn_COARE public :: cor30a + private :: psiuo + private :: psit_30 + integer :: debug = 0 ! internal debug level contains @@ -115,6 +120,7 @@ subroutine flux_atmOcn_COARE( & real(R8) :: hol ! H (at zbot) over L real(R8) :: zo,zot,zoq ! roughness lengths real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: tau ! stress at zbot real(R8) :: trf,qrf,urf,vrf ! reference-height quantities !--- local functions -------------------------------- @@ -437,4 +443,71 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params end subroutine cor30a + !=============================================================================== + + real (R8) function psiuo(zet) + !====================================================================== + ! momentum stability functions adopted in COARE v3.0 parametrisation. + ! Chris Fairall's code (see cor30a) + ! + ! !REVISION HISTORY: + ! 22/11/2013: Thomas Toniazzo: comments added + !====================================================================== + + ! !INPUT/OUTPUT PARAMETERS: + real(R8),intent(in) :: zet + real(R8) ::c,x,psik,psic,f + !----------------------------------------------------------------- + ! N.B.: z0/L always neglected compared to z/L and to 1 + !----------------------------------------------------------------- + if(zet>0.0_R8)then + ! Beljaars & Holtslag (1991) + c=min(50._R8,.35_R8*zet) + psiuo=-((1.0_R8+1.0_R8*zet)**1.0_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) + else + ! Dyer & Hicks (1974) for weak instability + x=(1.0_R8-15.0_R8*zet)**.25_R8 ! 15 instead of 16 + psik=2.0_R8*log((1.0_R8+x)/2.0_R8)+log((1.0_R8+x*x)/2.0_R8)-2.0_R8*atan(x)+2.0_R8*atan(1.0_R8) + ! Fairall et al. (1996) for strong instability (Eq.(13)) + x=(1.0_R8-10.15_R8*zet)**.3333_R8 + psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & + & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) + f=zet*zet/(1.0_R8+zet*zet) + psiuo=(1.0_R8-f)*psik+f*psic + endif + END FUNCTION psiuo + + real (R8) function psit_30(zet) + !=============================================================================== + ! momentum stability functions adopted in COARE v3.0 parametrisation. + ! Chris Fairall's code (see cor30a) + ! + ! !REVISION HISTORY: + ! 22/11/2013: Thomas Toniazzo: comments added + !=============================================================================== + + ! !INPUT/OUTPUT PARAMETERS: + real(R8),intent(in) :: zet + ! !EOP + real(R8) ::c,x,psik,psic,f + !----------------------------------------------------------------- + ! N.B.: z0/L always neglected compared to z/L and to 1 + !----------------------------------------------------------------- + if(zet>0.0_R8)then + ! Beljaars & Holtslag (1991) + c=min(50._R8,.35_R8*zet) + psit_30=-((1.0_R8+2.0_R8/3.0_R8*zet)**1.5_R8+.667_R8*(zet-14.28_R8)/exp(c)+8.525_R8) + else + ! Dyer & Hicks (1974) for weak instability + x=(1.0_R8-15.0_R8*zet)**.5_R8 ! 15 instead of 16 + psik=2.0_R8*log((1.0_R8+x)/2.0_R8) + ! Fairall et al. (1996) for strong instability + x=(1.0_R8-(34.15_R8*zet))**.3333_R8 + psic= 1.5_R8*log((1.0_R8+x+x*x)/3.0_R8)-sqrt(3.0_R8)*atan((1.0_R8+2.0_R8*x)/sqrt(3.0_R8)) & + & +4.0_R8*atan(1.0_R8)/sqrt(3.0_R8) + f=zet*zet/(1.0_R8+zet*zet) + psit_30=(1.0_R8-f)*psik+f*psic + endif + end FUNCTION psit_30 + end module flux_atmocn_COARE_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 51274e593..7dbf99601 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -1,738 +1,737 @@ module flux_atmocn_diurnal_mod - !------------------------------------------------------------------------------- - ! PURPOSE: - ! computes atm/ocn surface fluxes - ! - ! NOTES: - ! o all fluxes are positive downward - ! o net heat flux = net sw + lw up + lw down + sen + lat - ! o here, tstar = /U*, and qstar = /U*. - ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) - ! - ! ASSUMPTIONS: - ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 - ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable - ! ctn = .0180 sqrt(cdn), stable - ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) - ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) - !------------------------------------------------------------------------------- - - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds - use shr_flux_mod, only : td0, maxscl, alpha, debug - use shr_flux_mod, only : zvir, cpair, cpvir, karman - use shr_flux_mod, only : latvap, stebol, use_coldair_outbreak_mod - use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_cpvir, shr_const_karman, shr_const_g - use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz - use shr_const_mod, only : shr_const_pi, shr_const_spval - use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas - use atmocn_flux_COARE_mod, only : cor30a - use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. - - implicit none - public - - private :: cuberoot - - integer, private :: flux_con_max_iter = 2 + !------------------------------------------------------------------------------- + ! PURPOSE: + ! computes atm/ocn surface fluxes + ! + ! NOTES: + ! o all fluxes are positive downward + ! o net heat flux = net sw + lw up + lw down + sen + lat + ! o here, tstar = /U*, and qstar = /U*. + ! o wind speeds should all be above a minimum speed (eg. 1.0 m/s) + ! + ! ASSUMPTIONS: + ! o Neutral 10m drag coeff: cdn = .0027/U10 + .000142 + .0000764 U10 + ! o Neutral 10m stanton number: ctn = .0327 sqrt(cdn), unstable + ! ctn = .0180 sqrt(cdn), stable + ! o Neutral 10m dalton number: cen = .0346 sqrt(cdn) + ! o The saturation humidity of air at T(K): qsat(T) (kg/m^3) + !------------------------------------------------------------------------------- + + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod + use shr_const_mod, only : shr_const_zvir, shr_const_cpdair, shr_const_karman, shr_const_g + use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz + use shr_const_mod, only : shr_const_pi, shr_const_spval, shr_const_cpvir + use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas + use flux_atmocn_COARE_mod, only : cor30a + use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. + + implicit none + private + + public :: flux_atmOcn_Diurnal + + private :: cuberoot + + integer :: flux_con_max_iter = 2 + real(r8) :: flux_con_tol = 0.0_R8 + integer :: debug = 0 contains - subroutine flux_atmOcn_diurnal( & - logunit, spval, ocn_surface_flux_scheme, & - nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,us ,vs , & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O ,rhdo ,r18O ,evap ,evap_16O, & - evap_HDO ,evap_18O, & - taux ,tauy ,tref ,qref , & - uGust, lwdn , swdn , swup, prec , & - swpen, ocnsal, ocn_prognostic, & - latt, long , warm , salt , speed, regime, & - warmMax, windMax, qSolAvg, windAvg, & - warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & - tBulk, tSkin, tSkin_day, tSkin_night, & - cSkin, cSkin_night, secs ,dt, & - duu10n, ustar_sv ,re_sv ,ssq_sv, & - cold_start) - - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - real(r8) ,intent(in) :: spval - integer(IN) ,intent(in) :: ocn_surface_flux_scheme - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) - - !--- new arguments ------------------------------- - real(R8),intent(inout) :: swpen (nMax) ! NEW - real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) - logical ,intent(in) :: ocn_prognostic ! NEW - real(R8),intent(in) :: uGust (nMax) ! NEW not used - real(R8),intent(in) :: lwdn (nMax) ! NEW - real(R8),intent(in) :: swdn (nMax) ! NEW - real(R8),intent(in) :: swup (nMax) ! NEW - real(R8),intent(in) :: prec (nMax) ! NEW - real(R8),intent(in) :: latt (nMax) ! NEW - real(R8),intent(in) :: long (nMax) ! NEW - real(R8),intent(inout) :: warm (nMax) ! NEW - real(R8),intent(inout) :: salt (nMax) ! NEW - real(R8),intent(inout) :: speed (nMax) ! NEW - real(R8),intent(inout) :: regime(nMax) ! NEW - real(R8),intent(out) :: warmMax(nMax) ! NEW - real(R8),intent(out) :: windMax(nMax) ! NEW - real(R8),intent(inout) :: qSolAvg(nMax) ! NEW - real(R8),intent(inout) :: windAvg(nMax) ! NEW - real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW - real(R8),intent(inout) :: windMaxInc(nMax) ! NEW - real(R8),intent(inout) :: qSolInc(nMax) ! NEW - real(R8),intent(inout) :: windInc(nMax) ! NEW - real(R8),intent(inout) :: nInc(nMax) ! NEW - - real(R8),intent(out) :: tBulk (nMax) ! NEW - real(R8),intent(out) :: tSkin (nMax) ! NEW - real(R8),intent(out) :: tSkin_day (nMax) ! NEW - real(R8),intent(out) :: tSkin_night (nMax) ! NEW - real(R8),intent(out) :: cSkin (nMax) ! NEW - real(R8),intent(out) :: cSkin_night (nMax) ! NEW - integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer(IN),intent(in) :: dt ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - real(R8),parameter :: lambdaC = 6.0_R8 - real(R8),parameter :: lambdaL = 0.0_R8 - real(R8),parameter :: doLMax = 1.0_R8 - real(R8),parameter :: pwr = 0.2_R8 - real(R8),parameter :: Rizero = 1.0_R8 - real(R8),parameter :: NUzero = 40.0e-4_R8 - real(R8),parameter :: Prandtl = 1.0_R8 - real(R8),parameter :: kappa0 = 0.2e-4_R8 - - real(R8),parameter :: F0 = 0.5_R8 - real(R8),parameter :: F1 = 0.15_R8 - real(R8),parameter :: R1 = 10.0_R8 - - real(R8),parameter :: Ricr = 0.30_R8 - real(R8),parameter :: tiny = 1.0e-12_R8 - real(R8),parameter :: tiny2 = 1.0e-6_R8 - real(R8),parameter :: pi = SHR_CONST_PI - - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter ! iteration loop index - integer(IN) :: lsecs ! local seconds elapsed - integer(IN) :: lonsecs ! incrememnt due to lon offset - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: ustar_prev ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: DTiter ! - real(R8) :: DSiter ! - real(R8) :: DViter ! - - real(R8) :: Dcool ! - real(R8) :: Qdel ! net cool skin heating - real(R8) :: Hd ! net heating above -z=d - real(R8) :: Hb ! net kinematic heating above -z = delta - real(R8) :: lambdaV ! - real(R8) :: Fd ! net fresh water forcing above -z=d - real(R8) :: ustarw ! surface wind forcing of layer above -z=d - - real(R8) :: Qsol ! solar heat flux (W/m2) - real(R8) :: Qnsol ! non-solar heat flux (W/m2) - - real(R8) :: SSS ! sea surface salinity - real(R8) :: alphaT ! - real(R8) :: betaS ! - - real(R8) :: doL ! ocean forcing stablity parameter - real(R8) :: Rid ! Richardson number at depth d - real(R8) :: Ribulk ! Bulk Richardson number at depth d - real(R8) :: FofRi ! Richardon number dependent diffusivity - real(R8) :: Smult ! multiplicative term based on regime - real(R8) :: Sfact ! multiplicative term based on regime - real(R8) :: Kdiff ! diffusive term based on regime - real(R8) :: Kvisc ! viscosity term based on regime - real(R8) :: rhocn ! - real(R8) :: rcpocn ! - real(R8) :: Nreset ! value for multiplicative reset factor - logical :: lmidnight - logical :: ltwopm - logical :: ltwoam - logical :: lfullday - integer :: nsum - real(R8) :: pexp ! eqn 19 - real(R8) :: AMP ! eqn 18 - real(R8) :: dif3 - real(R8) :: phid - - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: molvisc ! molecular viscosity - real(R8) :: molPr ! molecular Prandtl number - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) - molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' - character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" - - if (debug > 0) write(logunit,F00) "enter" - - rh = spval - dviter = spval - dtiter = spval - dsiter = spval - al2 = log(zref/ztref) - - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - ! equations 18 and 19 - AMP = 1.0_R8/F0-1.0_R8 - pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) - - if (.not. ocn_prognostic) then - ! Set swpen and ocean salinity from following analytic expressions - swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 - else - ! use swpen and ocnsal from input argument - endif - - if (cold_start) then - write(logunit,F00) "Initialize diurnal cycle fields" - warm (:) = 0.0_R8 - salt (:) = 0.0_R8 - speed (:) = 0.0_R8 - regime (:) = 0.0_R8 - qSolAvg (:) = 0.0_R8 - windAvg (:) = 0.0_R8 - warmMax (:) = 0.0_R8 - windMax (:) = 0.0_R8 - warmMaxInc (:) = 0.0_R8 - windMaxInc (:) = 0.0_R8 - qSolInc (:) = 0.0_R8 - windInc (:) = 0.0_R8 - nInc (:) = 0.0_R8 - tSkin_day (:) = ts(:) - tSkin_night(:) = ts(:) - cSkin_night(:) = 0.0_R8 - endif - u10n = 0.0_r8 - stable = 0.0_r8 - DO n=1,nMax - - if (mask(n) /= 0) then - - !--- compute some initial and useful flux quantities --- - - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - alz = log(zbot(n)/zref) - hol = 0.0 - psimh = 0.0 - psixh = 0.0 - rdn = sqrt(cdn(vmag)) - - tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm - tSkin(n) = tBulk(n) - Qsol = swdn(n) + swup(n) - SSS = 1000.0_R8*ocnsal(n)+salt(n) - lambdaV = lambdaC - - alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) - betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) - rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) - rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) - - Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & - ( pwr*MAX(tiny,speed(n)) )**2 - - Ribulk = 0.0 - - !---------------------------------------------------------- - ! convert elapsed time from GMT to local & - ! check elapsed time. reset warm if near lsecs = reset_sec - !---------------------------------------------------------- - Nreset = 1.0_R8 - - lonsecs = ceiling(long(n)/360.0_R8*86400.0) - lsecs = mod(secs + lonsecs,86400) - - lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight - ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm - ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am - lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) - nsum = nint(nInc(n)) - - if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL - warm(n) = 0.0_R8 - salt(n) = 0.0_R8 - speed(n) = 0.0_R8 - endif - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default E3SMv1 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) - - - !--- shift wind speed using old coefficient and stability function - - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- initial neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- initial ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. - - call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - - ENDIF - - ustar_prev = ustar * 2.0_R8 - iter = 0 - ! --- iterate --- - ! Originally this code did three iterations while the non-diurnal version did two - ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults - ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !------------------------------------------------------------ - ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar - ! and on Rid in the DIURNAL CYCLE - !------------------------------------------------------------ - Smult = 0.0_R8 - Sfact = 0.0_R8 - Kdiff = 0.0_R8 - Kvisc = 0.0_R8 - dif3 = 0.0_R8 - - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn - - !--- COOL SKIN EFFECT --- - Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) - Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) - Hb = min(Hb , 0.0_R8) - - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) - lambdaV = 6.5_R8 - cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) - - !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 - Rid = MAX(0.0_R8,Rid) - Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) - Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - - if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then - phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - dif3 = (kappa0 + NUzero *FofRi) - - if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then - regime(n) = 2.0_R8 - Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid - Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & - dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) - Kdiff = Kvisc - else - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - endif - else - if (regime(n).eq.1.0_R8) then - Smult = 0.0_R8 - else - if (Ribulk .gt. Ricr) then - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - else - regime(n) = 4.0_R8 - Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) - Kvisc = Kdiff - endif - endif - - endif - - !--- IMPLICIT INTEGRATION --- - - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) - DTiter = MAX( 0.0_R8, DTiter) - DViter = MAX( 0.0_R8, DViter) - - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 - Ribulk = Rid * pwr - Ribulk = 0.0_R8 - tBulk(n) = ts(n) + DTiter - tSkin(n) = tBulk(n) + cskin(n) - - !--need to update ssq,delt,delq as function of tBulk ---- - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - - !--- UPDATE FLUX ITERATION --- - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient and stability function --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- heat flux --- - - sen (n) = hsb - lat (n) = hlb - - else ! N.B.: NO ocn_surface_flux_scheme=2 option - call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif - - ENDDO ! end iteration loop - if (iter < 1) then - call shr_sys_abort('No iterations performed ') - end if - - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- LW radiation --- - lwup(n) = -shr_const_stebol * Tskin(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - !!ZZZ bugfix to be done - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnostics: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm - - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - u10n = sqrt(duu10n(n)) - endif - - !------------------------------------------------------------ - ! update new prognostic variables - !------------------------------------------------------------ - - warm (n) = DTiter - salt (n) = DSiter - speed (n) = DViter - - if (ltwopm) then - tSkin_day(n) = tSkin(n) - warmmax(n) = max(DTiter,0.0_R8) - endif - - if (ltwoam) then - tSkin_night(n) = tSkin(n) - cSkin_night(n) = cSkin(n) - endif - - if ((lmidnight).and.(lfullday)) then - qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) - windAvg(n) = windInc(n)/real(nsum+1,R8) - ! warmMax(n) = max(DTiter,warmMaxInc(n)) - windMax(n) = max(u10n,windMaxInc(n)) - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - endif - - nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum - - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv (n) = re - if (present(ssq_sv )) ssq_sv (n) = ssq - - else ! mask = 0 - - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - warm (n) = spval - salt (n) = spval - speed (n) = spval - regime (n) = spval - tBulk (n) = spval - tSkin (n) = spval - tSkin_night(n) = spval - tSkin_day (n) = spval - cSkin (n) = spval - cSkin_night(n) = spval - warmMax (n) = spval - windMax (n) = spval - qSolAvg (n) = spval - windAvg (n) = spval - warmMaxInc (n) = spval - windMaxInc (n) = spval - qSolInc (n) = spval - windInc (n) = spval - nInc (n) = 0.0_R8 - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif ! mask - - endif ! flux diurnal logic - - enddo ! end n loop - - end subroutine flux_atmOcn_diurnal - - ! =================================================================== - - real(R8) elemental function cuberoot(a) - real(R8), intent(in) :: a - real(R8), parameter :: one_third = 1._R8/3._R8 - cuberoot = sign(abs(a)**one_third, a) - end function cuberoot + subroutine flux_atmOcn_diurnal( & + logunit, spval, ocn_surface_flux_scheme, & + nMax ,zbot ,ubot ,vbot ,thbot , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot ,us ,vs , & + ts ,mask , seq_flux_atmocn_minwind, & + sen ,lat ,lwup , & + r16O ,rhdo ,r18O ,evap ,evap_16O, & + evap_HDO ,evap_18O, & + taux ,tauy ,tref ,qref , & + uGust, lwdn , swdn , swup, prec , & + swpen, ocnsal, ocn_prognostic, & + latt, long , warm , salt , speed, regime, & + warmMax, windMax, qSolAvg, windAvg, & + warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & + tBulk, tSkin, tSkin_day, tSkin_night, & + cSkin, cSkin_night, secs ,dt, & + duu10n, ustar_sv ,re_sv ,ssq_sv, & + cold_start) + + + !--- input arguments -------------------------------- + integer ,intent(in) :: logunit + real(r8) ,intent(in) :: spval + integer(IN) ,intent(in) :: ocn_surface_flux_scheme + integer(IN),intent(in) :: nMax ! data vector length + integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) + real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) + real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) + real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) + real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd + real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd + real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd + real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) + + !--- new arguments ------------------------------- + real(R8),intent(inout) :: swpen (nMax) ! NEW + real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) + logical ,intent(in) :: ocn_prognostic ! NEW + real(R8),intent(in) :: uGust (nMax) ! NEW not used + real(R8),intent(in) :: lwdn (nMax) ! NEW + real(R8),intent(in) :: swdn (nMax) ! NEW + real(R8),intent(in) :: swup (nMax) ! NEW + real(R8),intent(in) :: prec (nMax) ! NEW + real(R8),intent(in) :: latt (nMax) ! NEW + real(R8),intent(in) :: long (nMax) ! NEW + real(R8),intent(inout) :: warm (nMax) ! NEW + real(R8),intent(inout) :: salt (nMax) ! NEW + real(R8),intent(inout) :: speed (nMax) ! NEW + real(R8),intent(inout) :: regime(nMax) ! NEW + real(R8),intent(out) :: warmMax(nMax) ! NEW + real(R8),intent(out) :: windMax(nMax) ! NEW + real(R8),intent(inout) :: qSolAvg(nMax) ! NEW + real(R8),intent(inout) :: windAvg(nMax) ! NEW + real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW + real(R8),intent(inout) :: windMaxInc(nMax) ! NEW + real(R8),intent(inout) :: qSolInc(nMax) ! NEW + real(R8),intent(inout) :: windInc(nMax) ! NEW + real(R8),intent(inout) :: nInc(nMax) ! NEW + + real(R8),intent(out) :: tBulk (nMax) ! NEW + real(R8),intent(out) :: tSkin (nMax) ! NEW + real(R8),intent(out) :: tSkin_day (nMax) ! NEW + real(R8),intent(out) :: tSkin_night (nMax) ! NEW + real(R8),intent(out) :: cSkin (nMax) ! NEW + real(R8),intent(out) :: cSkin_night (nMax) ! NEW + integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer(IN),intent(in) :: dt ! NEW + logical ,intent(in) :: cold_start ! cold start flag + real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + + !--- output arguments ------------------------------- + real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) + real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + + real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + real(R8),parameter :: lambdaC = 6.0_R8 + real(R8),parameter :: lambdaL = 0.0_R8 + real(R8),parameter :: doLMax = 1.0_R8 + real(R8),parameter :: pwr = 0.2_R8 + real(R8),parameter :: Rizero = 1.0_R8 + real(R8),parameter :: NUzero = 40.0e-4_R8 + real(R8),parameter :: Prandtl = 1.0_R8 + real(R8),parameter :: kappa0 = 0.2e-4_R8 + + real(R8),parameter :: F0 = 0.5_R8 + real(R8),parameter :: F1 = 0.15_R8 + real(R8),parameter :: R1 = 10.0_R8 + + real(R8),parameter :: Ricr = 0.30_R8 + real(R8),parameter :: tiny = 1.0e-12_R8 + real(R8),parameter :: tiny2 = 1.0e-6_R8 + real(R8),parameter :: pi = SHR_CONST_PI + + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter ! iteration loop index + integer(IN) :: lsecs ! local seconds elapsed + integer(IN) :: lonsecs ! incrememnt due to lon offset + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: ustar_prev ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: DTiter ! + real(R8) :: DSiter ! + real(R8) :: DViter ! + + real(R8) :: Dcool ! + real(R8) :: Qdel ! net cool skin heating + real(R8) :: Hd ! net heating above -z=d + real(R8) :: Hb ! net kinematic heating above -z = delta + real(R8) :: lambdaV ! + real(R8) :: Fd ! net fresh water forcing above -z=d + real(R8) :: ustarw ! surface wind forcing of layer above -z=d + + real(R8) :: Qsol ! solar heat flux (W/m2) + real(R8) :: Qnsol ! non-solar heat flux (W/m2) + + real(R8) :: SSS ! sea surface salinity + real(R8) :: alphaT ! + real(R8) :: betaS ! + + real(R8) :: doL ! ocean forcing stablity parameter + real(R8) :: Rid ! Richardson number at depth d + real(R8) :: Ribulk ! Bulk Richardson number at depth d + real(R8) :: FofRi ! Richardon number dependent diffusivity + real(R8) :: Smult ! multiplicative term based on regime + real(R8) :: Sfact ! multiplicative term based on regime + real(R8) :: Kdiff ! diffusive term based on regime + real(R8) :: Kvisc ! viscosity term based on regime + real(R8) :: rhocn ! + real(R8) :: rcpocn ! + real(R8) :: Nreset ! value for multiplicative reset factor + logical :: lmidnight + logical :: ltwopm + logical :: ltwoam + logical :: lfullday + integer :: nsum + real(R8) :: pexp ! eqn 19 + real(R8) :: AMP ! eqn 18 + real(R8) :: dif3 + real(R8) :: phid + + !!++ COARE only + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: molvisc ! molecular viscosity + real(R8) :: molPr ! molecular Prandtl number + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) + molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' + character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + rh = spval + dviter = spval + dtiter = spval + dsiter = spval + al2 = log(zref/ztref) + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + ! equations 18 and 19 + AMP = 1.0_R8/F0-1.0_R8 + pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) + + if (.not. ocn_prognostic) then + ! Set swpen and ocean salinity from following analytic expressions + swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 + else + ! use swpen and ocnsal from input argument + endif + + if (cold_start) then + write(logunit,F00) "Initialize diurnal cycle fields" + warm (:) = 0.0_R8 + salt (:) = 0.0_R8 + speed (:) = 0.0_R8 + regime (:) = 0.0_R8 + qSolAvg (:) = 0.0_R8 + windAvg (:) = 0.0_R8 + warmMax (:) = 0.0_R8 + windMax (:) = 0.0_R8 + warmMaxInc (:) = 0.0_R8 + windMaxInc (:) = 0.0_R8 + qSolInc (:) = 0.0_R8 + windInc (:) = 0.0_R8 + nInc (:) = 0.0_R8 + tSkin_day (:) = ts(:) + tSkin_night(:) = ts(:) + cSkin_night(:) = 0.0_R8 + endif + u10n = 0.0_r8 + stable = 0.0_r8 + DO n=1,nMax + + if (mask(n) /= 0) then + + !--- compute some initial and useful flux quantities --- + + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + alz = log(zbot(n)/zref) + hol = 0.0 + psimh = 0.0 + psixh = 0.0 + rdn = sqrt(cdn(vmag)) + + tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm + tSkin(n) = tBulk(n) + Qsol = swdn(n) + swup(n) + SSS = 1000.0_R8*ocnsal(n)+salt(n) + lambdaV = lambdaC + + alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) + betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) + rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) + rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) + + Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & + ( pwr*MAX(tiny,speed(n)) )**2 + + Ribulk = 0.0 + + !---------------------------------------------------------- + ! convert elapsed time from GMT to local & + ! check elapsed time. reset warm if near lsecs = reset_sec + !---------------------------------------------------------- + Nreset = 1.0_R8 + + lonsecs = ceiling(long(n)/360.0_R8*86400.0) + lsecs = mod(secs + lonsecs,86400) + + lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight + ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm + ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am + lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) + nsum = nint(nInc(n)) + + if ( lmidnight ) then + Regime(n) = 1.0_R8 ! RESET DIURNAL + warm(n) = 0.0_R8 + salt(n) = 0.0_R8 + speed(n) = 0.0_R8 + endif + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default E3SMv1 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + stable = 0.5_R8 + sign(0.5_R8 , delt) + + + !--- shift wind speed using old coefficient and stability function + + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- initial neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- initial ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + + call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") + + ENDIF + + ustar_prev = ustar * 2.0_R8 + iter = 0 + ! --- iterate --- + ! Originally this code did three iterations while the non-diurnal version did two + ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults + ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !------------------------------------------------------------ + ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar + ! and on Rid in the DIURNAL CYCLE + !------------------------------------------------------------ + Smult = 0.0_R8 + Sfact = 0.0_R8 + Kdiff = 0.0_R8 + Kvisc = 0.0_R8 + dif3 = 0.0_R8 + + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + + !--- COOL SKIN EFFECT --- + Dcool = lambdaV*molvisc(tBulk(n)) / ustarw + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) + Hb = min(Hb , 0.0_R8) + + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + lambdaV = 6.5_R8 + cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) + + !--- REGIME --- + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 + Rid = MAX(0.0_R8,Rid) + Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) + Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + + if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then + phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + dif3 = (kappa0 + NUzero *FofRi) + + if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then + regime(n) = 2.0_R8 + Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid + Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & + dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) + Kdiff = Kvisc + else + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + endif + else + if (regime(n).eq.1.0_R8) then + Smult = 0.0_R8 + else + if (Ribulk .gt. Ricr) then + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + else + regime(n) = 4.0_R8 + Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) + Kvisc = Kdiff + endif + endif + + endif + + !--- IMPLICIT INTEGRATION --- + + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = MAX( 0.0_R8, DTiter) + DViter = MAX( 0.0_R8, DViter) + + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 + Ribulk = Rid * pwr + Ribulk = 0.0_R8 + tBulk(n) = ts(n) + DTiter + tSkin(n) = tBulk(n) + cskin(n) + + !--need to update ssq,delt,delq as function of tBulk ---- + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + + !--- UPDATE FLUX ITERATION --- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + + !--- compute stability & evaluate all stability functions --- + hol = shr_const_karman*shr_const_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient and stability function --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) + + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + + else ! N.B.: NO ocn_surface_flux_scheme=2 option + call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") + endif + + enddo ! end iteration loop + if (iter < 1) then + call shr_sys_abort('No iterations performed ') + end if + + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- LW radiation --- + lwup(n) = -shr_const_stebol * Tskin(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !---water isotope flux --- + !!ZZZ bugfix to be done + call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& + qbot(n),evap(n)) + call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& + qbot(n),evap(n)) + call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& + qbot(n),evap(n)) + + !------------------------------------------------------------ + ! compute diagnostics: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm + + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + u10n = sqrt(duu10n(n)) + endif + + !------------------------------------------------------------ + ! update new prognostic variables + !------------------------------------------------------------ + + warm (n) = DTiter + salt (n) = DSiter + speed (n) = DViter + + if (ltwopm) then + tSkin_day(n) = tSkin(n) + warmmax(n) = max(DTiter,0.0_R8) + endif + + if (ltwoam) then + tSkin_night(n) = tSkin(n) + cSkin_night(n) = cSkin(n) + endif + + if ((lmidnight).and.(lfullday)) then + qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) + windAvg(n) = windInc(n)/real(nsum+1,R8) + ! warmMax(n) = max(DTiter,warmMaxInc(n)) + windMax(n) = max(u10n,windMaxInc(n)) + + nsum = 0 + + qSolInc(n) = Qsol + windInc(n) = u10n + + ! warmMaxInc(n) = 0.0_R8 + windMaxInc(n) = 0.0_R8 + endif + + nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum + + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv (n) = re + if (present(ssq_sv )) ssq_sv (n) = ssq + + else ! mask = 0 + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval + nInc (n) = 0.0_R8 + + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) + evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) + evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif ! mask + end DO ! loop over n + + end subroutine flux_atmOcn_diurnal + + ! =================================================================== + + real(R8) elemental function cuberoot(a) + real(R8), intent(in) :: a + real(R8), parameter :: one_third = 1._R8/3._R8 + cuberoot = sign(abs(a)**one_third, a) + end function cuberoot end module flux_atmocn_diurnal_mod diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 05f40b044..8c3ee5413 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -20,10 +20,10 @@ module flux_atmOcn_large_mod !------------------------------------------------------------------------------- use shr_kind_mod, only: R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds - use shr_flux_mod, only: loc_cpair, loc_cpvir, loc_karman, loc_g, loc_zvir + use shr_flux_mod, only: loc_cpdair, loc_cpvir, loc_karman, loc_g, loc_zvir use shr_flux_mod, only: loc_latvap, loc_stebol, use_coldair_outbreak_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter - use shr_flux_mod, only: alpha, maxscl, tc0 + use shr_flux_mod, only: alpha, maxscl, td0 use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none @@ -43,10 +43,7 @@ subroutine flux_atmOcn_large( & r16O, rhdo, r18O, & evap, evap_16O, evap_HDO, evap_18O, & taux, tauy, tref, qref, & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & + add_gusts, duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) !--- input arguments -------------------------------- diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index 1e1c7f1e6..ee9f4c57f 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -23,7 +23,8 @@ module flux_atmocn_UA_mod use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_flux_mod, only : td0, maxscl, alpha - use shr_flux_mod, only : use_coldair_outbreak_mod + use shr_flux_mod, only : loc_zvir, loc_tkfrz, loc_cpdair, loc_cpvir, loc_g + use shr_flux_mod, only : use_coldair_outbreak_mod, loc_karman, loc_stebol use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none @@ -41,7 +42,7 @@ module flux_atmocn_UA_mod contains subroutine flux_atmOcn_UA( & - logunit, nMax, spval, & + logunit, spval, nMax, & zbot, ubot, vbot, thbot, & qbot, s16O, sHDO, s18O, rbot, & tbot, us, vs, pslv, & @@ -53,7 +54,7 @@ subroutine flux_atmOcn_UA( & !--- input arguments -------------------------------- integer ,intent(in) :: logunit - real(R8) ,intent(in) :: spval + real(R8) ,intent(in) :: spval integer ,intent(in) :: nMax ! data vector length integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain real(R8) ,intent(in) :: zbot (nMax) ! atm level height (m) @@ -148,13 +149,6 @@ subroutine flux_atmOcn_UA( & ! Straight from original subroutine. if (debug > 0) write(logunit,F00) "enter" - if (present(missval)) then - spval = missval - else - spval = shr_const_spval - endif - !----- - ! Evaluate loc_epsilon. loc_epsilon = 1.0_R8 / (1.0_R8 + loc_zvir) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index e3d4e9430..fcd7fbf37 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -72,7 +72,6 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - real(R8),intent(out),optional :: z0(nMax) ! roughness length real(R8),intent(in) ,optional :: missval ! masked value !--- local variables -------------------------------- @@ -105,11 +104,7 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & r16O, rhdo, r18O, & evap ,evap_16O, evap_HDO, evap_18O, & taux ,tauy ,tref ,qref , & - add_gusts, & - duu10n, & - ugust_out, & - u10res, & - spval, & + add_gusts, duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == 1) then @@ -134,7 +129,7 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & call flux_atmOcn_UA( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, rainc, s16O, sHDO, s18O, rbot, & + qbot, s16O, sHDO, s18O, rbot, & tbot, us, vs, pslv, & ts, mask, sen, lat, lwup, & r16O, rhdo, r18O, & From 8d26434fee91b9730660b661cc33fa4381fff4c4 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 19:41:19 +0200 Subject: [PATCH 086/135] compile with intel is now successful --- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 1 + cesm/flux_atmocn/flux_atmocn_Large.F90 | 1 + mediator/med_phases_aofluxes_mod.F90 | 2 +- 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 7dbf99601..edb2b8127 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -24,6 +24,7 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_latvap, shr_const_latice, shr_const_stebol, shr_const_tkfrz use shr_const_mod, only : shr_const_pi, shr_const_spval, shr_const_cpvir use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas + use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 8c3ee5413..c3403d564 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -24,6 +24,7 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: loc_latvap, loc_stebol, use_coldair_outbreak_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 + use shr_sys_mod, only: shr_sys_abort use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index cf8f3d6bf..a16240627 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -972,7 +972,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED - use shr_flux_mod , only : flux_atmocn_driver + use flux_atmocn_driver_mod, only : flux_atmocn_driver #else use flux_atmocn_mod, only : flux_atmocn #endif From 26643a91e94aa63b9e24c4c21f8581e276c15a36 Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 21:14:34 +0200 Subject: [PATCH 087/135] removed all references to water isotopes - since this will be heavily refactored in upcoming work --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 56 +- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 1337 +++++++++--------- cesm/flux_atmocn/flux_atmocn_Large.F90 | 25 +- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 25 +- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 84 +- cime_config/buildnml | 1 - cime_config/config_component_cesm.xml | 13 - cime_config/namelist_definition_drv.xml | 3 +- doc/source/addendum/fieldnames.rst | 3 - mediator/esmFldsExchange_cesm_mod.F90 | 299 ---- mediator/fd_cesm.yaml | 140 -- mediator/med_diag_mod.F90 | 618 -------- mediator/med_phases_aofluxes_mod.F90 | 85 +- mediator/med_phases_post_rof_mod.F90 | 15 - 14 files changed, 718 insertions(+), 1986 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index c51ceb58f..4b0efdf2f 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -25,7 +25,6 @@ module flux_atmocn_COARE_mod use shr_const_mod, only : shr_const_rgas, shr_const_cpdair use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : use_coldair_outbreak_mod - use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none private @@ -40,19 +39,14 @@ module flux_atmocn_COARE_mod contains - subroutine flux_atmOcn_COARE( & - logunit, spval, nMax ,zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - duu10n, & - ugust_out, & - u10res, & - ustar_sv ,re_sv ,ssq_sv) + subroutine flux_atmOcn_COARE( & + logunit, spval, nMax, zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, tbot ,us ,vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux ,tauy, tref, qref, & + duu10n, ugust_out, u10res, & + ustar_sv, re_sv, ssq_sv) !--- input arguments -------------------------------- integer , intent(in) :: logunit @@ -65,12 +59,6 @@ subroutine flux_atmOcn_COARE( & real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) , intent(in) :: tbot (nMax) ! atm T (K) real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) @@ -84,9 +72,6 @@ subroutine flux_atmOcn_COARE( & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -190,14 +175,6 @@ subroutine flux_atmOcn_COARE( & !--- water flux --- evap(n) = lat(n)/shr_const_latvap - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared !------------------------------------------------------------ @@ -224,9 +201,6 @@ subroutine flux_atmOcn_COARE( & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) @@ -307,18 +281,20 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params !*** physical parameters Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) - ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code + + ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code cpv = cpa*(1.0_R8+0.84_R8*Q) - ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure + + ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure rhoa= rb ! parametrisation for air kinematic viscosity (Andreas 1989,p.31) - t = ta-273.16_R8 + t = ta-273.16_R8 visa= 1.326e-5_R8*(1.0_R8+6.542e-3_R8*t+8.301e-6_R8*t*t-4.84e-9_R8*t*t*t) - du = sqrt((ua-us)**2+(va-vs)**2) - dt = ts-ta -.0098_R8*zt - dq = Qs-Q + du = sqrt((ua-us)**2+(va-vs)**2) + dt = ts-ta -.0098_R8*zt + dq = Qs-Q !*** don't use cool-skin params for now, but assign values to Ter and Qer jcool=0_IN diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index edb2b8127..9a2beef71 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -26,7 +26,6 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a - use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none private @@ -41,690 +40,658 @@ module flux_atmocn_diurnal_mod contains - subroutine flux_atmOcn_diurnal( & - logunit, spval, ocn_surface_flux_scheme, & - nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,us ,vs , & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O ,rhdo ,r18O ,evap ,evap_16O, & - evap_HDO ,evap_18O, & - taux ,tauy ,tref ,qref , & - uGust, lwdn , swdn , swup, prec , & - swpen, ocnsal, ocn_prognostic, & - latt, long , warm , salt , speed, regime, & - warmMax, windMax, qSolAvg, windAvg, & - warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & - tBulk, tSkin, tSkin_day, tSkin_night, & - cSkin, cSkin_night, secs ,dt, & - duu10n, ustar_sv ,re_sv ,ssq_sv, & - cold_start) - - - !--- input arguments -------------------------------- - integer ,intent(in) :: logunit - real(r8) ,intent(in) :: spval - integer(IN) ,intent(in) :: ocn_surface_flux_scheme - integer(IN),intent(in) :: nMax ! data vector length - integer(IN),intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain - real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) - real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) - real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) - real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) - real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc.(kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc.(kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc.(kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd - real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) - real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) - real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) - real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) - real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) - - !--- new arguments ------------------------------- - real(R8),intent(inout) :: swpen (nMax) ! NEW - real(R8),intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) - logical ,intent(in) :: ocn_prognostic ! NEW - real(R8),intent(in) :: uGust (nMax) ! NEW not used - real(R8),intent(in) :: lwdn (nMax) ! NEW - real(R8),intent(in) :: swdn (nMax) ! NEW - real(R8),intent(in) :: swup (nMax) ! NEW - real(R8),intent(in) :: prec (nMax) ! NEW - real(R8),intent(in) :: latt (nMax) ! NEW - real(R8),intent(in) :: long (nMax) ! NEW - real(R8),intent(inout) :: warm (nMax) ! NEW - real(R8),intent(inout) :: salt (nMax) ! NEW - real(R8),intent(inout) :: speed (nMax) ! NEW - real(R8),intent(inout) :: regime(nMax) ! NEW - real(R8),intent(out) :: warmMax(nMax) ! NEW - real(R8),intent(out) :: windMax(nMax) ! NEW - real(R8),intent(inout) :: qSolAvg(nMax) ! NEW - real(R8),intent(inout) :: windAvg(nMax) ! NEW - real(R8),intent(inout) :: warmMaxInc(nMax) ! NEW - real(R8),intent(inout) :: windMaxInc(nMax) ! NEW - real(R8),intent(inout) :: qSolInc(nMax) ! NEW - real(R8),intent(inout) :: windInc(nMax) ! NEW - real(R8),intent(inout) :: nInc(nMax) ! NEW - - real(R8),intent(out) :: tBulk (nMax) ! NEW - real(R8),intent(out) :: tSkin (nMax) ! NEW - real(R8),intent(out) :: tSkin_day (nMax) ! NEW - real(R8),intent(out) :: tSkin_night (nMax) ! NEW - real(R8),intent(out) :: cSkin (nMax) ! NEW - real(R8),intent(out) :: cSkin_night (nMax) ! NEW - integer(IN),intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer(IN),intent(in) :: dt ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8),intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) - - !--- output arguments ------------------------------- - real(R8),intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) - real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) - real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) - real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) - real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) - real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) - real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 - - real(R8),intent(out),optional :: ustar_sv(nMax) ! diag: ustar - real(R8),intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) - real(R8),intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) - - - !--- local constants -------------------------------- - real(R8),parameter :: zref = 10.0_R8 ! reference height (m) - real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) - - real(R8),parameter :: lambdaC = 6.0_R8 - real(R8),parameter :: lambdaL = 0.0_R8 - real(R8),parameter :: doLMax = 1.0_R8 - real(R8),parameter :: pwr = 0.2_R8 - real(R8),parameter :: Rizero = 1.0_R8 - real(R8),parameter :: NUzero = 40.0e-4_R8 - real(R8),parameter :: Prandtl = 1.0_R8 - real(R8),parameter :: kappa0 = 0.2e-4_R8 - - real(R8),parameter :: F0 = 0.5_R8 - real(R8),parameter :: F1 = 0.15_R8 - real(R8),parameter :: R1 = 10.0_R8 - - real(R8),parameter :: Ricr = 0.30_R8 - real(R8),parameter :: tiny = 1.0e-12_R8 - real(R8),parameter :: tiny2 = 1.0e-6_R8 - real(R8),parameter :: pi = SHR_CONST_PI - - !!++ COARE only - real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. - - !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index - integer(IN) :: iter ! iteration loop index - integer(IN) :: lsecs ! local seconds elapsed - integer(IN) :: lonsecs ! incrememnt due to lon offset - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: ssq ! sea surface humidity (kg/kg) - real(R8) :: delt ! potential T difference (K) - real(R8) :: delq ! humidity difference (kg/kg) - real(R8) :: stable ! stability factor - real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) - real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) - real(R8) :: ren ! sqrt of neutral exchange coeff (water) - real(R8) :: rd ! sqrt of exchange coefficient (momentum) - real(R8) :: rh ! sqrt of exchange coefficient (heat) - real(R8) :: re ! sqrt of exchange coefficient (water) - real(R8) :: ustar ! ustar - real(R8) :: ustar_prev ! ustar - real(R8) :: qstar ! qstar - real(R8) :: tstar ! tstar - real(R8) :: hol ! H (at zbot) over L - real(R8) :: xsq ! ? - real(R8) :: xqq ! ? - real(R8) :: psimh ! stability function at zbot (momentum) - real(R8) :: psixh ! stability function at zbot (heat and water) - real(R8) :: psix2 ! stability function at ztref reference height - real(R8) :: alz ! ln(zbot/zref) - real(R8) :: al2 ! ln(zref/ztref) - real(R8) :: u10n ! 10m neutral wind - real(R8) :: tau ! stress at zbot - real(R8) :: cp ! specific heat of moist air - real(R8) :: fac ! vertical interpolation factor - real(R8) :: DTiter ! - real(R8) :: DSiter ! - real(R8) :: DViter ! - - real(R8) :: Dcool ! - real(R8) :: Qdel ! net cool skin heating - real(R8) :: Hd ! net heating above -z=d - real(R8) :: Hb ! net kinematic heating above -z = delta - real(R8) :: lambdaV ! - real(R8) :: Fd ! net fresh water forcing above -z=d - real(R8) :: ustarw ! surface wind forcing of layer above -z=d - - real(R8) :: Qsol ! solar heat flux (W/m2) - real(R8) :: Qnsol ! non-solar heat flux (W/m2) - - real(R8) :: SSS ! sea surface salinity - real(R8) :: alphaT ! - real(R8) :: betaS ! - - real(R8) :: doL ! ocean forcing stablity parameter - real(R8) :: Rid ! Richardson number at depth d - real(R8) :: Ribulk ! Bulk Richardson number at depth d - real(R8) :: FofRi ! Richardon number dependent diffusivity - real(R8) :: Smult ! multiplicative term based on regime - real(R8) :: Sfact ! multiplicative term based on regime - real(R8) :: Kdiff ! diffusive term based on regime - real(R8) :: Kvisc ! viscosity term based on regime - real(R8) :: rhocn ! - real(R8) :: rcpocn ! - real(R8) :: Nreset ! value for multiplicative reset factor - logical :: lmidnight - logical :: ltwopm - logical :: ltwoam - logical :: lfullday - integer :: nsum - real(R8) :: pexp ! eqn 19 - real(R8) :: AMP ! eqn 18 - real(R8) :: dif3 - real(R8) :: phid - - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities - - !--- local functions -------------------------------- - real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) - real(R8) :: cdn ! function: neutral drag coeff at 10m - real(R8) :: psimhu ! function: unstable part of psimh - real(R8) :: psixhu ! function: unstable part of psimx - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: molvisc ! molecular viscosity - real(R8) :: molPr ! molecular Prandtl number - - !--- for cold air outbreak calc -------------------------------- - real(R8) :: tdiff(nMax) ! tbot - ts - real(R8) :: vscl - - qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps - psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 - psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) - molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) - molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' - character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" - - if (debug > 0) write(logunit,F00) "enter" - - rh = spval - dviter = spval - dtiter = spval - dsiter = spval - al2 = log(zref/ztref) - - !--- for cold air outbreak calc -------------------------------- - tdiff= tbot - ts - - ! equations 18 and 19 - AMP = 1.0_R8/F0-1.0_R8 - pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) - - if (.not. ocn_prognostic) then - ! Set swpen and ocean salinity from following analytic expressions - swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 - else - ! use swpen and ocnsal from input argument - endif - - if (cold_start) then - write(logunit,F00) "Initialize diurnal cycle fields" - warm (:) = 0.0_R8 - salt (:) = 0.0_R8 - speed (:) = 0.0_R8 - regime (:) = 0.0_R8 - qSolAvg (:) = 0.0_R8 - windAvg (:) = 0.0_R8 - warmMax (:) = 0.0_R8 - windMax (:) = 0.0_R8 - warmMaxInc (:) = 0.0_R8 - windMaxInc (:) = 0.0_R8 - qSolInc (:) = 0.0_R8 - windInc (:) = 0.0_R8 - nInc (:) = 0.0_R8 - tSkin_day (:) = ts(:) - tSkin_night(:) = ts(:) - cSkin_night(:) = 0.0_R8 - endif - u10n = 0.0_r8 - stable = 0.0_r8 - DO n=1,nMax - - if (mask(n) /= 0) then - - !--- compute some initial and useful flux quantities --- - - vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - if (use_coldair_outbreak_mod) then - ! Cold Air Outbreak Modification: - ! Increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - - if (tdiff(n).lt.td0) then - vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) - vmag=vmag*vscl - endif - endif - alz = log(zbot(n)/zref) - hol = 0.0 - psimh = 0.0 - psixh = 0.0 - rdn = sqrt(cdn(vmag)) - - tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm - tSkin(n) = tBulk(n) - Qsol = swdn(n) + swup(n) - SSS = 1000.0_R8*ocnsal(n)+salt(n) - lambdaV = lambdaC - - alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) - betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) - rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) - rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) - - Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & - ( pwr*MAX(tiny,speed(n)) )**2 - - Ribulk = 0.0 - - !---------------------------------------------------------- - ! convert elapsed time from GMT to local & - ! check elapsed time. reset warm if near lsecs = reset_sec - !---------------------------------------------------------- - Nreset = 1.0_R8 - - lonsecs = ceiling(long(n)/360.0_R8*86400.0) - lsecs = mod(secs + lonsecs,86400) - - lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight - ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm - ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am - lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) - nsum = nint(nInc(n)) - - if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL - warm(n) = 0.0_R8 - salt(n) = 0.0_R8 - speed(n) = 0.0_R8 - endif - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default E3SMv1 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) - - - !--- shift wind speed using old coefficient and stability function - - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- initial neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- initial ustar, tstar, qstar --- - ustar = rdn * vmag - tstar = rhn * delt - qstar = ren * delq - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. - - call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - - ENDIF - - ustar_prev = ustar * 2.0_R8 - iter = 0 - ! --- iterate --- - ! Originally this code did three iterations while the non-diurnal version did two - ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults - ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) - iter = iter + 1 - ustar_prev = ustar - !------------------------------------------------------------ - ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar - ! and on Rid in the DIURNAL CYCLE - !------------------------------------------------------------ - Smult = 0.0_R8 - Sfact = 0.0_R8 - Kdiff = 0.0_R8 - Kvisc = 0.0_R8 - dif3 = 0.0_R8 - - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn - - !--- COOL SKIN EFFECT --- - Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) - Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) - Hb = min(Hb , 0.0_R8) - - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) - lambdaV = 6.5_R8 - cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) - - !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 - Rid = MAX(0.0_R8,Rid) - Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) - Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - - if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then - phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) - FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) - dif3 = (kappa0 + NUzero *FofRi) - - if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then - regime(n) = 2.0_R8 - Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid - Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & - dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) - Kdiff = Kvisc - else - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - endif - else - if (regime(n).eq.1.0_R8) then - Smult = 0.0_R8 - else - if (Ribulk .gt. Ricr) then - regime(n) = 3.0_R8 - Kdiff = kappa0 + NUzero * FofRi - Kvisc = Prandtl* kappa0 + NUzero * FofRi - else - regime(n) = 4.0_R8 - Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) - Kvisc = Kdiff - endif - endif - - endif - - !--- IMPLICIT INTEGRATION --- - - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) - DTiter = MAX( 0.0_R8, DTiter) - DViter = MAX( 0.0_R8, DViter) - - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 - Ribulk = Rid * pwr - Ribulk = 0.0_R8 - tBulk(n) = ts(n) + DTiter - tSkin(n) = tBulk(n) + cskin(n) - - !--need to update ssq,delt,delq as function of tBulk ---- - - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - - !--- UPDATE FLUX ITERATION --- - - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Default CESM1.2 - !! = 1 : COARE algorithm - !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - - !--- compute stability & evaluate all stability functions --- - hol = shr_const_karman*shr_const_g*zbot(n)* & - (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 - hol = sign( min(abs(hol),10.0_R8), hol ) - stable = 0.5_R8 + sign(0.5_R8 , hol) - xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) - xqq = sqrt(xsq) - psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) - psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - - !--- shift wind speed using old coefficient and stability function --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update neutral transfer coeffs at 10m - rdn = sqrt(cdn(u10n)) - rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 - ren = 0.0346_R8 - - !--- shift all coeffs to measurement height and stability --- - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) - rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) - re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) - - ustar = rd * vmag - tstar = rh * delt - qstar = re * delq - - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params - - ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) - - !--- heat flux --- - sen (n) = hsb - lat (n) = hlb - - else ! N.B.: NO ocn_surface_flux_scheme=2 option - call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif - - enddo ! end iteration loop - if (iter < 1) then - call shr_sys_abort('No iterations performed ') - end if - - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag - tauy(n) = tau * (vbot(n)-vs(n)) / vmag - - !--- LW radiation --- - lwup(n) = -shr_const_stebol * Tskin(n)**4 - - !--- water flux --- - evap(n) = lat(n)/shr_const_latvap - - !---water isotope flux --- - !!ZZZ bugfix to be done - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq, evap_16O(n),& - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n),& - qbot(n),evap(n)) - - !------------------------------------------------------------ - ! compute diagnostics: 2m ref T & Q, 10m wind speed squared - !------------------------------------------------------------ - - if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm - - hol = hol*ztref/zbot(n) - xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) - xqq = sqrt(xsq) - psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) - fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) - tref(n) = thbot(n) - delt*fac - tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction - fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) - qref(n) = qbot(n) - delq*fac - - duu10n(n) = u10n*u10n ! 10m wind speed squared - - else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - - tref(n) = trf - qref(n) = qrf - duu10n(n) = urf**2+vrf**2 - u10n = sqrt(duu10n(n)) - endif - - !------------------------------------------------------------ - ! update new prognostic variables - !------------------------------------------------------------ - - warm (n) = DTiter - salt (n) = DSiter - speed (n) = DViter - - if (ltwopm) then - tSkin_day(n) = tSkin(n) - warmmax(n) = max(DTiter,0.0_R8) - endif - - if (ltwoam) then - tSkin_night(n) = tSkin(n) - cSkin_night(n) = cSkin(n) - endif - - if ((lmidnight).and.(lfullday)) then - qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) - windAvg(n) = windInc(n)/real(nsum+1,R8) - ! warmMax(n) = max(DTiter,warmMaxInc(n)) - windMax(n) = max(u10n,windMaxInc(n)) - - nsum = 0 - - qSolInc(n) = Qsol - windInc(n) = u10n - - ! warmMaxInc(n) = 0.0_R8 - windMaxInc(n) = 0.0_R8 - endif - - nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum - - if (present(ustar_sv)) ustar_sv(n) = ustar - if (present(re_sv )) re_sv (n) = re - if (present(ssq_sv )) ssq_sv (n) = ssq - - else ! mask = 0 - - !------------------------------------------------------------ - ! no valid data here -- out of domain - !------------------------------------------------------------ - warm (n) = spval - salt (n) = spval - speed (n) = spval - regime (n) = spval - tBulk (n) = spval - tSkin (n) = spval - tSkin_night(n) = spval - tSkin_day (n) = spval - cSkin (n) = spval - cSkin_night(n) = spval - warmMax (n) = spval - windMax (n) = spval - qSolAvg (n) = spval - windAvg (n) = spval - warmMaxInc (n) = spval - windMaxInc (n) = spval - qSolInc (n) = spval - windInc (n) = spval - nInc (n) = 0.0_R8 - - sen (n) = spval ! sensible heat flux (W/m^2) - lat (n) = spval ! latent heat flux (W/m^2) - lwup (n) = spval ! long-wave upward heat flux (W/m^2) - evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) - taux (n) = spval ! x surface stress (N) - tauy (n) = spval ! y surface stress (N) - tref (n) = spval ! 2m reference height temperature (K) - qref (n) = spval ! 2m reference height humidity (kg/kg) - duu10n(n) = spval ! 10m wind speed squared (m/s)^2 - - if (present(ustar_sv)) ustar_sv(n) = spval - if (present(re_sv )) re_sv (n) = spval - if (present(ssq_sv )) ssq_sv (n) = spval - - endif ! mask - end DO ! loop over n - - end subroutine flux_atmOcn_diurnal + subroutine flux_atmOcn_diurnal( & + logunit, spval, ocn_surface_flux_scheme, & + nMax, zbot, ubot, vbot, thbot, & + qbot, rbot, tbot, us, vs, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, & + evap, taux, tauy, tref, qref, & + uGust, lwdn, swdn, swup, prec, & + swpen, ocnsal, ocn_prognostic, & + latt, long, warm, salt, speed, regime, & + warmMax, windMax, qSolAvg, windAvg, & + warmMaxInc, windMaxInc, qSolInc, windInc, nInc, & + tBulk, tSkin, tSkin_day, tSkin_night, & + cSkin, cSkin_night, secs, dt, & + duu10n, ustar_sv, re_sv, ssq_sv, cold_start) + + ! Arguments + ! + integer ,intent(in) :: logunit + real(r8) ,intent(in) :: spval + integer ,intent(in) :: ocn_surface_flux_scheme + integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain + real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) + real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) + real(R8) ,intent(in) :: vbot (nMax) ! atm v wind(m/s) + real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) + real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity(kg/kg) + real(R8) ,intent(in) :: rbot (nMax) ! atm air density(kg/m^3) + real(R8) ,intent(in) :: tbot (nMax) ! atm T(K) + real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) + real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) + real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) + real(R8) ,intent(in) :: uGust (nMax) ! NEW not used + real(R8) ,intent(in) :: lwdn (nMax) ! NEW + real(R8) ,intent(in) :: swdn (nMax) ! NEW + real(R8) ,intent(in) :: swup (nMax) ! NEW + real(R8) ,intent(in) :: prec (nMax) ! NEW + real(R8) ,intent(in) :: latt (nMax) ! NEW + real(R8) ,intent(in) :: long (nMax) ! NEW + logical ,intent(in) :: ocn_prognostic ! NEW + integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer ,intent(in) :: dt ! NEW + real(R8) ,intent(inout) :: swpen (nMax) ! NEW + real(R8) ,intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) + real(R8) ,intent(inout) :: warm (nMax) ! NEW + real(R8) ,intent(inout) :: salt (nMax) ! NEW + real(R8) ,intent(inout) :: speed (nMax) ! NEW + real(R8) ,intent(inout) :: regime(nMax) ! NEW + real(R8) ,intent(out) :: warmMax(nMax) ! NEW + real(R8) ,intent(out) :: windMax(nMax) ! NEW + real(R8) ,intent(inout) :: qSolAvg(nMax) ! NEW + real(R8) ,intent(inout) :: windAvg(nMax) ! NEW + real(R8) ,intent(inout) :: warmMaxInc(nMax) ! NEW + real(R8) ,intent(inout) :: windMaxInc(nMax) ! NEW + real(R8) ,intent(inout) :: qSolInc(nMax) ! NEW + real(R8) ,intent(inout) :: windInc(nMax) ! NEW + real(R8) ,intent(inout) :: nInc(nMax) ! NEW + real(R8) ,intent(out) :: tBulk (nMax) ! NEW + real(R8) ,intent(out) :: tSkin (nMax) ! NEW + real(R8) ,intent(out) :: tSkin_day (nMax) ! NEW + real(R8) ,intent(out) :: tSkin_night (nMax) ! NEW + real(R8) ,intent(out) :: cSkin (nMax) ! NEW + real(R8) ,intent(out) :: cSkin_night (nMax) ! NEW + logical ,intent(in) :: cold_start ! cold start flag + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) + real(R8) ,intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) + real(R8) ,intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) + real(R8) ,intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) + real(R8) ,intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) + real(R8) ,intent(out) :: taux (nMax) ! surface stress, zonal (N) + real(R8) ,intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8) ,intent(out) :: tref (nMax) ! diag: 2m ref height T (K) + real(R8) ,intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) + real(R8) ,intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 + real(R8) ,intent(out),optional :: ustar_sv(nMax) ! diag: ustar + real(R8) ,intent(out),optional :: re_sv (nMax) ! diag: sqrt of exchange coefficient (water) + real(R8) ,intent(out),optional :: ssq_sv (nMax) ! diag: sea surface humidity (kg/kg) + + !--- local constants -------------------------------- + real(R8),parameter :: zref = 10.0_R8 ! reference height (m) + real(R8),parameter :: ztref = 2.0_R8 ! reference height for air T (m) + + real(R8),parameter :: lambdaC = 6.0_R8 + real(R8),parameter :: lambdaL = 0.0_R8 + real(R8),parameter :: doLMax = 1.0_R8 + real(R8),parameter :: pwr = 0.2_R8 + real(R8),parameter :: Rizero = 1.0_R8 + real(R8),parameter :: NUzero = 40.0e-4_R8 + real(R8),parameter :: Prandtl = 1.0_R8 + real(R8),parameter :: kappa0 = 0.2e-4_R8 + + real(R8),parameter :: F0 = 0.5_R8 + real(R8),parameter :: F1 = 0.15_R8 + real(R8),parameter :: R1 = 10.0_R8 + + real(R8),parameter :: Ricr = 0.30_R8 + real(R8),parameter :: tiny = 1.0e-12_R8 + real(R8),parameter :: tiny2 = 1.0e-6_R8 + real(R8),parameter :: pi = SHR_CONST_PI + + !!++ COARE only + real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. + + !--- local variables -------------------------------- + integer(IN) :: n ! vector loop index + integer(IN) :: iter ! iteration loop index + integer(IN) :: lsecs ! local seconds elapsed + integer(IN) :: lonsecs ! incrememnt due to lon offset + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: ssq ! sea surface humidity (kg/kg) + real(R8) :: delt ! potential T difference (K) + real(R8) :: delq ! humidity difference (kg/kg) + real(R8) :: stable ! stability factor + real(R8) :: rdn ! sqrt of neutral exchange coeff (momentum) + real(R8) :: rhn ! sqrt of neutral exchange coeff (heat) + real(R8) :: ren ! sqrt of neutral exchange coeff (water) + real(R8) :: rd ! sqrt of exchange coefficient (momentum) + real(R8) :: rh ! sqrt of exchange coefficient (heat) + real(R8) :: re ! sqrt of exchange coefficient (water) + real(R8) :: ustar ! ustar + real(R8) :: ustar_prev ! ustar + real(R8) :: qstar ! qstar + real(R8) :: tstar ! tstar + real(R8) :: hol ! H (at zbot) over L + real(R8) :: xsq ! ? + real(R8) :: xqq ! ? + real(R8) :: psimh ! stability function at zbot (momentum) + real(R8) :: psixh ! stability function at zbot (heat and water) + real(R8) :: psix2 ! stability function at ztref reference height + real(R8) :: alz ! ln(zbot/zref) + real(R8) :: al2 ! ln(zref/ztref) + real(R8) :: u10n ! 10m neutral wind + real(R8) :: tau ! stress at zbot + real(R8) :: cp ! specific heat of moist air + real(R8) :: fac ! vertical interpolation factor + real(R8) :: DTiter ! + real(R8) :: DSiter ! + real(R8) :: DViter ! + + real(R8) :: Dcool ! + real(R8) :: Qdel ! net cool skin heating + real(R8) :: Hd ! net heating above -z=d + real(R8) :: Hb ! net kinematic heating above -z = delta + real(R8) :: lambdaV ! + real(R8) :: Fd ! net fresh water forcing above -z=d + real(R8) :: ustarw ! surface wind forcing of layer above -z=d + + real(R8) :: Qsol ! solar heat flux (W/m2) + real(R8) :: Qnsol ! non-solar heat flux (W/m2) + + real(R8) :: SSS ! sea surface salinity + real(R8) :: alphaT ! + real(R8) :: betaS ! + + real(R8) :: doL ! ocean forcing stablity parameter + real(R8) :: Rid ! Richardson number at depth d + real(R8) :: Ribulk ! Bulk Richardson number at depth d + real(R8) :: FofRi ! Richardon number dependent diffusivity + real(R8) :: Smult ! multiplicative term based on regime + real(R8) :: Sfact ! multiplicative term based on regime + real(R8) :: Kdiff ! diffusive term based on regime + real(R8) :: Kvisc ! viscosity term based on regime + real(R8) :: rhocn ! + real(R8) :: rcpocn ! + real(R8) :: Nreset ! value for multiplicative reset factor + logical :: lmidnight + logical :: ltwopm + logical :: ltwoam + logical :: lfullday + integer :: nsum + real(R8) :: pexp ! eqn 19 + real(R8) :: AMP ! eqn 18 + real(R8) :: dif3 + real(R8) :: phid + + !!++ COARE only + real(R8) :: zo,zot,zoq ! roughness lengths + real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot + real(R8) :: trf,qrf,urf,vrf ! reference-height quantities + + !--- local functions -------------------------------- + real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) + real(R8) :: cdn ! function: neutral drag coeff at 10m + real(R8) :: psimhu ! function: unstable part of psimh + real(R8) :: psixhu ! function: unstable part of psimx + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: molvisc ! molecular viscosity + real(R8) :: molPr ! molecular Prandtl number + + !--- for cold air outbreak calc -------------------------------- + real(R8) :: tdiff(nMax) ! tbot - ts + real(R8) :: vscl + + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 + psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) + molvisc(Tk) = 1.623e-6_R8 * exp((-1.0_R8*(Tk-273.15_R8))/45.2_R8) + molPr(Tk) = 11.64_R8 * exp((-1.0_R8*(Tk-273.15_R8))/40.7_R8) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(flux_atmOcn_diurnal) ' + character(*),parameter :: F00 = "('(flux_atmOcn_diurnal) ',4a)" + + if (debug > 0) write(logunit,F00) "enter" + + rh = spval + dviter = spval + dtiter = spval + dsiter = spval + al2 = log(zref/ztref) + + !--- for cold air outbreak calc -------------------------------- + tdiff= tbot - ts + + ! equations 18 and 19 + AMP = 1.0_R8/F0-1.0_R8 + pexp = log( (1.0_R8/F1-F0) / (1.0_R8-F0) ) / log(R1) + + if (.not. ocn_prognostic) then + ! Set swpen and ocean salinity from following analytic expressions + swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 + else + ! use swpen and ocnsal from input argument + endif + + if (cold_start) then + write(logunit,F00) "Initialize diurnal cycle fields" + warm (:) = 0.0_R8 + salt (:) = 0.0_R8 + speed (:) = 0.0_R8 + regime (:) = 0.0_R8 + qSolAvg (:) = 0.0_R8 + windAvg (:) = 0.0_R8 + warmMax (:) = 0.0_R8 + windMax (:) = 0.0_R8 + warmMaxInc (:) = 0.0_R8 + windMaxInc (:) = 0.0_R8 + qSolInc (:) = 0.0_R8 + windInc (:) = 0.0_R8 + nInc (:) = 0.0_R8 + tSkin_day (:) = ts(:) + tSkin_night(:) = ts(:) + cSkin_night(:) = 0.0_R8 + endif + u10n = 0.0_r8 + stable = 0.0_r8 + DO n=1,nMax + + if (mask(n) /= 0) then + + !--- compute some initial and useful flux quantities --- + + vmag = max(seq_flux_atmocn_minwind, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + if (use_coldair_outbreak_mod) then + ! Cold Air Outbreak Modification: + ! Increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + + if (tdiff(n).lt.td0) then + vscl=min((1._R8+alpha*(abs(tdiff(n)-td0)**0.5_R8/abs(vmag))),maxscl) + vmag=vmag*vscl + endif + endif + alz = log(zbot(n)/zref) + hol = 0.0 + psimh = 0.0 + psixh = 0.0 + rdn = sqrt(cdn(vmag)) + + tBulk(n) = ts(n)+warm(n) ! first guess for tBulk from read in ts,warm + tSkin(n) = tBulk(n) + Qsol = swdn(n) + swup(n) + SSS = 1000.0_R8*ocnsal(n)+salt(n) + lambdaV = lambdaC + + alphaT = 0.000297_R8*(1.0_R8+0.0256_R8*(ts(n)-298.15_R8)+0.003_R8*(SSS - 35.0_R8)) + betaS = 0.000756_R8*(1.0_R8-0.0016_R8*(ts(n)-298.15_R8)) + rhocn = 1023.342_R8*(1.0_R8-0.000297_R8*(ts(n)-298.15_R8)+0.000756_R8 * (SSS - 35.0_R8)) + rcpocn = rhocn * 3990.0_R8*(1.0_R8-0.0012_R8*(SSS - 35.0_R8)) + + Rid = shr_const_g * (alphaT*warm(n) - betaS*salt(n)) *pwr*shr_const_zsrflyr / & + ( pwr*MAX(tiny,speed(n)) )**2 + + Ribulk = 0.0 + + !---------------------------------------------------------- + ! convert elapsed time from GMT to local & + ! check elapsed time. reset warm if near lsecs = reset_sec + !---------------------------------------------------------- + Nreset = 1.0_R8 + + lonsecs = ceiling(long(n)/360.0_R8*86400.0) + lsecs = mod(secs + lonsecs,86400) + + lmidnight = (lsecs >= 0 .and. lsecs < dt) ! 0 = midnight + ltwopm = (lsecs >= 48600 .and. lsecs < 48600+dt) ! 48600 = 1:30pm + ltwoam = (lsecs >= 5400 .and. lsecs < 5400 +dt) ! 5400 = 1:30am + lfullday = (lsecs > 86400-dt .and. lsecs <= 86400) + nsum = nint(nInc(n)) + + if ( lmidnight ) then + Regime(n) = 1.0_R8 ! RESET DIURNAL + warm(n) = 0.0_R8 + salt(n) = 0.0_R8 + speed(n) = 0.0_R8 + endif + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default E3SMv1 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + stable = 0.5_R8 + sign(0.5_R8 , delt) + + + !--- shift wind speed using old coefficient and stability function + + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- initial neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- initial ustar, tstar, qstar --- + ustar = rdn * vmag + tstar = rhn * delt + qstar = ren * delq + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + + call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") + + ENDIF + + ustar_prev = ustar * 2.0_R8 + iter = 0 + ! --- iterate --- + ! Originally this code did three iterations while the non-diurnal version did two + ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults + ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) + iter = iter + 1 + ustar_prev = ustar + !------------------------------------------------------------ + ! iterate to converge on FLUXES Z/L, ustar, tstar and qstar + ! and on Rid in the DIURNAL CYCLE + !------------------------------------------------------------ + Smult = 0.0_R8 + Sfact = 0.0_R8 + Kdiff = 0.0_R8 + Kvisc = 0.0_R8 + dif3 = 0.0_R8 + + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + + !--- COOL SKIN EFFECT --- + Dcool = lambdaV*molvisc(tBulk(n)) / ustarw + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) + Hb = min(Hb , 0.0_R8) + + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + lambdaV = 6.5_R8 + cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) + + !--- REGIME --- + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 + Rid = MAX(0.0_R8,Rid) + Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) + Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + + if ( (doL.gt.0.0_R8) .and. (Qsol.gt.0.0) ) then + phid = MIN(1.0_R8 + 5.0_R8 * doL, 5.0_R8 + doL) + FofRi = 1.0_R8/(1.0_R8 + AMP*(Rid/Rizero)**pexp) + dif3 = (kappa0 + NUzero *FofRi) + + if ((doL.le.lambdaL).and.(NINT(regime(n)).le.2)) then + regime(n) = 2.0_R8 + Kdiff = shr_const_karman * ustarw * shr_const_zsrflyr / phid + Kvisc = Kdiff * (1.0_R8 - doL/lambdaL)**2 + & + dif3 * (doL/lambdaL)**2 * (3.0_R8 - 2.0_R8 * doL/lambdaL) + Kdiff = Kvisc + else + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + endif + else + if (regime(n).eq.1.0_R8) then + Smult = 0.0_R8 + else + if (Ribulk .gt. Ricr) then + regime(n) = 3.0_R8 + Kdiff = kappa0 + NUzero * FofRi + Kvisc = Prandtl* kappa0 + NUzero * FofRi + else + regime(n) = 4.0_R8 + Kdiff = shr_const_karman*ustarw*shr_const_zsrflyr *cuberoot(1.0_R8-7.0_R8*doL) + Kvisc = Kdiff + endif + endif + + endif + + !--- IMPLICIT INTEGRATION --- + + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = MAX( 0.0_R8, DTiter) + DViter = MAX( 0.0_R8, DViter) + + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 + Ribulk = Rid * pwr + Ribulk = 0.0_R8 + tBulk(n) = ts(n) + DTiter + tSkin(n) = tBulk(n) + cskin(n) + + !--need to update ssq,delt,delq as function of tBulk ---- + + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + + !--- UPDATE FLUX ITERATION --- + + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Default CESM1.2 + !! = 1 : COARE algorithm + !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm + + !--- compute stability & evaluate all stability functions --- + hol = shr_const_karman*shr_const_g*zbot(n)* & + (tstar/thbot(n)+qstar/(1.0_R8/shr_const_zvir+qbot(n)))/ustar**2 + hol = sign( min(abs(hol),10.0_R8), hol ) + stable = 0.5_R8 + sign(0.5_R8 , hol) + xsq = max(sqrt(abs(1.0_R8 - 16.0_R8*hol)) , 1.0_R8) + xqq = sqrt(xsq) + psimh = -5.0_R8*hol*stable + (1.0_R8-stable)*psimhu(xqq) + psixh = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + + !--- shift wind speed using old coefficient and stability function --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update neutral transfer coeffs at 10m + rdn = sqrt(cdn(u10n)) + rhn = (1.0_R8-stable) * 0.0327_R8 + stable * 0.018_R8 + ren = 0.0346_R8 + + !--- shift all coeffs to measurement height and stability --- + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) + rh = rhn / (1.0_R8 + rhn/shr_const_karman*(alz-psixh)) + re = ren / (1.0_R8 + ren/shr_const_karman*(alz-psixh)) + + ustar = rd * vmag + tstar = rh * delt + qstar = re * delq + + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params + + ! for the sake of maintaining same defs + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) + + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb + + else ! N.B.: NO ocn_surface_flux_scheme=2 option + call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") + endif + + enddo ! end iteration loop + if (iter < 1) then + call shr_sys_abort('No iterations performed ') + end if + + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag + tauy(n) = tau * (vbot(n)-vs(n)) / vmag + + !--- LW radiation --- + lwup(n) = -shr_const_stebol * Tskin(n)**4 + + !--- water flux --- + evap(n) = lat(n)/shr_const_latvap + + !------------------------------------------------------------ + ! compute diagnostics: 2m ref T & Q, 10m wind speed squared + !------------------------------------------------------------ + + if (ocn_surface_flux_scheme .eq. 0) then ! use Large algorithm + + hol = hol*ztref/zbot(n) + xsq = max( 1.0_R8, sqrt(abs(1.0_R8-16.0_R8*hol)) ) + xqq = sqrt(xsq) + psix2 = -5.0_R8*hol*stable + (1.0_R8-stable)*psixhu(xqq) + fac = (rh/shr_const_karman) * (alz + al2 - psixh + psix2 ) + tref(n) = thbot(n) - delt*fac + tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction + fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) + qref(n) = qbot(n) - delq*fac + + duu10n(n) = u10n*u10n ! 10m wind speed squared + + else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm + + tref(n) = trf + qref(n) = qrf + duu10n(n) = urf**2+vrf**2 + u10n = sqrt(duu10n(n)) + endif + + !------------------------------------------------------------ + ! update new prognostic variables + !------------------------------------------------------------ + + warm (n) = DTiter + salt (n) = DSiter + speed (n) = DViter + + if (ltwopm) then + tSkin_day(n) = tSkin(n) + warmmax(n) = max(DTiter,0.0_R8) + endif + + if (ltwoam) then + tSkin_night(n) = tSkin(n) + cSkin_night(n) = cSkin(n) + endif + + if ((lmidnight).and.(lfullday)) then + qSolAvg(n) = qSolInc(n)/real(nsum+1,R8) + windAvg(n) = windInc(n)/real(nsum+1,R8) + ! warmMax(n) = max(DTiter,warmMaxInc(n)) + windMax(n) = max(u10n,windMaxInc(n)) + + nsum = 0 + + qSolInc(n) = Qsol + windInc(n) = u10n + + ! warmMaxInc(n) = 0.0_R8 + windMaxInc(n) = 0.0_R8 + endif + + nInc(n) = real(nsum,R8) ! set nInc to incremented or reset nsum + + if (present(ustar_sv)) ustar_sv(n) = ustar + if (present(re_sv )) re_sv (n) = re + if (present(ssq_sv )) ssq_sv (n) = ssq + + else ! mask = 0 + + !------------------------------------------------------------ + ! no valid data here -- out of domain + !------------------------------------------------------------ + warm (n) = spval + salt (n) = spval + speed (n) = spval + regime (n) = spval + tBulk (n) = spval + tSkin (n) = spval + tSkin_night(n) = spval + tSkin_day (n) = spval + cSkin (n) = spval + cSkin_night(n) = spval + warmMax (n) = spval + windMax (n) = spval + qSolAvg (n) = spval + windAvg (n) = spval + warmMaxInc (n) = spval + windMaxInc (n) = spval + qSolInc (n) = spval + windInc (n) = spval + nInc (n) = 0.0_R8 + sen (n) = spval ! sensible heat flux (W/m^2) + lat (n) = spval ! latent heat flux (W/m^2) + lwup (n) = spval ! long-wave upward heat flux (W/m^2) + evap (n) = spval ! evaporative water flux ((kg/s)/m^2) + taux (n) = spval ! x surface stress (N) + tauy (n) = spval ! y surface stress (N) + tref (n) = spval ! 2m reference height temperature (K) + qref (n) = spval ! 2m reference height humidity (kg/kg) + duu10n(n) = spval ! 10m wind speed squared (m/s)^2 + + if (present(ustar_sv)) ustar_sv(n) = spval + if (present(re_sv )) re_sv (n) = spval + if (present(ssq_sv )) ssq_sv (n) = spval + + endif ! mask + end DO ! loop over n + + end subroutine flux_atmOcn_diurnal ! =================================================================== diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index c3403d564..0c2b092de 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,7 +25,6 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort - use water_isotopes, only: wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none public @@ -37,12 +36,9 @@ module flux_atmOcn_large_mod subroutine flux_atmOcn_large( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, rainc, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & + qbot, rainc, tbot, us, vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & - sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & + sen, lat, lwup, evap, & taux, tauy, tref, qref, & add_gusts, duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) @@ -59,12 +55,6 @@ subroutine flux_atmOcn_large( & real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) ,intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) @@ -78,9 +68,6 @@ subroutine flux_atmOcn_large( & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -299,14 +286,6 @@ subroutine flux_atmOcn_large( & !--- water flux --- evap(n) = lat(n)/loc_latvap - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared !------------------------------------------------------------ diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index ee9f4c57f..d2f258f3d 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -25,7 +25,6 @@ module flux_atmocn_UA_mod use shr_flux_mod, only : td0, maxscl, alpha use shr_flux_mod, only : loc_zvir, loc_tkfrz, loc_cpdair, loc_cpvir, loc_g use shr_flux_mod, only : use_coldair_outbreak_mod, loc_karman, loc_stebol - use water_isotopes, only : wiso_flxoce !subroutine used to calculate water isotope fluxes. implicit none private @@ -44,11 +43,8 @@ module flux_atmocn_UA_mod subroutine flux_atmOcn_UA( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & + qbot, rbot, tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, evap, & taux, tauy, tref, qref, & duu10n, ustar_sv, re_sv, ssq_sv) @@ -62,12 +58,6 @@ subroutine flux_atmOcn_UA( & real(R8) ,intent(in) :: vbot (nMax) ! atm v wind (m/s) real(R8) ,intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) ,intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) - real(R8) ,intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) ,intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) ,intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) ,intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) ,intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) real(R8) ,intent(in) :: pslv (nMax) ! sea level pressure (Pa) @@ -80,9 +70,6 @@ subroutine flux_atmOcn_UA( & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) @@ -356,14 +343,6 @@ subroutine flux_atmOcn_UA( & !--- water flux --- evap(n) = lat(n)/xlv - !---water isotope flux --- - call wiso_flxoce(2,rbot(n),zbot(n),s16O(n),ts(n),r16O(n),ustar,re,ssq,evap_16O(n), & - qbot(n),evap(n)) - call wiso_flxoce(3,rbot(n),zbot(n),sHDO(n),ts(n),rHDO(n),ustar,re,ssq, evap_HDO(n),& - qbot(n),evap(n)) - call wiso_flxoce(4,rbot(n),zbot(n),s18O(n),ts(n),r18O(n),ustar,re,ssq, evap_18O(n), & - qbot(n),evap(n)) - !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared !------------------------------------------------------------ diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index fcd7fbf37..c4d52b266 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -11,21 +11,16 @@ module flux_atmocn_driver_mod contains - subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - & tbot ,us ,vs, pslv, & - & ts ,mask , seq_flux_atmocn_minwind, & - & sen ,lat ,lwup , & - & r16O, rhdo, r18O, & - & evap ,evap_16O, evap_HDO, evap_18O, & - & taux ,tauy ,tref ,qref , & - & ocn_surface_flux_scheme, & - & add_gusts, & - & duu10n, & - & ugust_out, & - & u10res, & - & ustar_sv ,re_sv ,ssq_sv, & - & missval) + subroutine flux_atmOcn_driver(logunit, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + ocn_surface_flux_scheme, & + add_gusts, duu10n, ugust_out, u10res, & + ustar_sv, re_sv, ssq_sv, missval) !--- input arguments -------------------------------- integer , intent(in) :: logunit @@ -94,47 +89,38 @@ subroutine flux_atmOcn_driver(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & ! Default flux scheme. if (ocn_surface_flux_scheme == 0) then - call flux_atmOcn_Large( & - logunit, spval, nMax , & - zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - add_gusts, duu10n, ugust_out, u10res, & + call flux_atmOcn_Large( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + add_gusts, duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == 1) then - call flux_atmOcn_COARE( & - logunit, spval, nMax , & - zbot ,ubot ,vbot ,thbot , & - qbot, rainc ,s16O ,sHDO ,s18O ,rbot, & - tbot ,us ,vs, pslv, & - ts ,mask , seq_flux_atmocn_minwind, & - sen ,lat ,lwup , & - r16O, rhdo, r18O, & - evap ,evap_16O, evap_HDO, evap_18O, & - taux ,tauy ,tref ,qref , & - duu10n, & - ugust_out, & - u10res, & - ustar_sv=ustar_sv ,re_sv=re_sv ,ssq_sv=ssq_sv) + call flux_atmOcn_COARE( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & + ts, mask, seq_flux_atmocn_minwind, & + sen, lat, lwup, evap, & + taux, tauy, tref, qref, & + duu10n, ugust_out, u10res, & + ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) else if (ocn_surface_flux_scheme == 2) then - call flux_atmOcn_UA( & - logunit, spval, nMax, & - zbot, ubot, vbot, thbot, & - qbot, s16O, sHDO, s18O, rbot, & - tbot, us, vs, pslv, & - ts, mask, sen, lat, lwup, & - r16O, rhdo, r18O, & - evap, evap_16O, evap_HDO, evap_18O, & - taux, tauy, tref, qref, & + call flux_atmOcn_UA( & + logunit, spval, nMax, & + zbot, ubot, vbot, thbot, & + qbot, rbot, tbot, us, vs, pslv, & + ts, mask, sen, lat, lwup, evap, & + taux, tauy, tref, qref, & duu10n, ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) do n = 1,nMax diff --git a/cime_config/buildnml b/cime_config/buildnml index 16dc6ac8b..0b8094e47 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -38,7 +38,6 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config["DRV_THREADING"] = case.get_value("DRV_THREADING") config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") - config["FLDS_WISO"] = case.get_value("FLDS_WISO") config["BUDGETS"] = case.get_value("BUDGETS") config["MACH"] = case.get_value("MACH") config["MPILIB"] = case.get_value("MPILIB") diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 845466595..751964602 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -566,19 +566,6 @@ - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - run_flags - env_run.xml - Turn on the passing of water isotope fields through the coupler - - integer 1,3,5,10,36 diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 6c7a903c2..c6baef6c3 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2579,7 +2579,6 @@ - logical flds @@ -2588,7 +2587,7 @@ Pass water isotopes between components - $FLDS_WISO + .false. diff --git a/doc/source/addendum/fieldnames.rst b/doc/source/addendum/fieldnames.rst index 471d52e7a..58b2713e0 100644 --- a/doc/source/addendum/fieldnames.rst +++ b/doc/source/addendum/fieldnames.rst @@ -34,7 +34,6 @@ The following state names are currently supported. Note that each application mi "Si_imask", "sea ice land mask" "Si_ifrac_n", "ice fraction by thickness category" "Si_qref", "reference height specific humidity" - "Si_qref_wiso", "reference specific water isotope humidity at 2 meters" "Si_t", "sea ice surface temperature" "Si_tref", "reference height temperature" "Si_u10", "10m wind speed" @@ -56,10 +55,8 @@ The following state names are currently supported. Note that each application mi "Sl_lfrac", "" "Sl_lfrin", "" "Sl_qref", "" - "Sl_qref_wiso", "" "Sl_ram1", "" "Sl_snowh", "" - "Sl_snowh_wiso", "" "Sl_t", "" "Sl_topo_elev", "" "Sl_topo", "" diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index d703fe87f..1b3b9bab0 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -95,7 +95,6 @@ module esmFldsExchange_cesm_mod logical :: flds_co2a ! Pass CO2 from ATM to surface components logical :: flds_co2b ! Pass CO2 from ATM to LND and back from LND to ATM logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM - logical :: flds_wiso ! Pass water isotop fields logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND logical :: add_gusts ! Whether to include fields related to the gustiness parameterization @@ -234,11 +233,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat - ! are water isotope exchanges enabled? - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flds_wiso - call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths @@ -259,7 +253,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c - write(logunit,'(a,l7)') trim(subname)//' flds_wiso = ',flds_wiso write(logunit,'(a,l7)') trim(subname)//' flds_i2o_per_cat = ',flds_i2o_per_cat write(logunit,'(a,l7)') trim(subname)//' flds_r2l_stream_channel_depths = ',flds_r2l_stream_channel_depths write(logunit,'(a,l7)') trim(subname)//' add_gusts = ', add_gusts @@ -312,9 +305,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') call addfld_from(compatm, 'Faxa_rainc') - if (flds_wiso) then - call addfld_from(compatm, 'Sa_shum_wiso') - end if else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then @@ -332,9 +322,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) - if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) - end if end if end if @@ -487,18 +474,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum_wiso') - call addfld_to(complnd, 'Sa_shum_wiso') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') - end if - end if - end if ! --------------------------------------------------------------------- ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- @@ -756,42 +731,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volr_wiso') - call addfld_to(complnd, 'Flrr_volr_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_volr_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volr_wiso', & - mrg_from=comprof, mrg_fld='Flrr_volr_wiso', mrg_type='copy') - end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volrmch_wiso') - call addfld_to(complnd, 'Flrr_volrmch_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_volrmch_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volrmch_wiso', & - mrg_from=comprof, mrg_fld='Flrr_volrmch_wiso', mrg_type='copy') - end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_flood_wiso') - call addfld_to(complnd, 'Flrr_flood_wiso') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood_wiso', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood_wiso', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_flood_wiso', & - mrg_from=comprof, mrg_fld='Flrr_flood_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to lnd: ice sheet grid coverage on global grid from glc ! to lnd: ice sheet mask where we are potentially sending non-zero fluxes from glc @@ -1052,35 +991,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref_wiso') - call addfld_from(compice , 'Si_qref_wiso') - call addfld_aoflux('So_qref_wiso') - call addfld_to(compatm , 'Sx_qref_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux( 'So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) ! map ocn->atm - end if - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged reference temperature at 2 meters ! to atm: merged 10m wind speed @@ -1168,34 +1078,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref_wiso') - call addfld_from(compice , 'Si_qref_wiso') - call addfld_aoflux('So_qref_wiso') - call addfld_to(compatm , 'Sx_qref_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref_wiso', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref_wiso', rc=rc)) then - call addmap_from(complnd , 'Sl_qref_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=complnd, mrg_fld='Sl_qref_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref_wiso', rc=rc)) then - call addmap_from(compice , 'Si_qref_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compice, mrg_fld='Si_qref_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_qref_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Sx_qref_wiso', & - mrg_from=compmed, mrg_fld='So_qref_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress ! to atm: merged meridional surface stress @@ -1203,7 +1085,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to atm: merged surface sensible heat flux ! to atm: merged surface upward longwave heat flux ! to atm: evaporation water flux from water - ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_taux') @@ -1367,35 +1248,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_to(compatm, 'Faxx_evap_wiso') - call addfld_from(complnd, 'Fall_evap_wiso') - call addfld_from(compice, 'Faii_evap_wiso') - call addfld_aoflux( 'Faox_evap_wiso') - else - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap_wiso', rc=rc)) then - if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap_wiso', rc=rc)) then - call addmap_from(complnd , 'Fall_evap_wiso', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=complnd, mrg_fld='Fall_evap_wiso', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', rc=rc)) then - call addmap_from(compice , 'Faii_evap_wiso', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=compice, mrg_fld='Faii_evap_wiso', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('Faox_evap_wiso', compatm, mapconsf, 'ofrac', ocn2atm_map) - end if - call addmrg_to(compatm , 'Faxx_evap_wiso', & - mrg_from=compmed, mrg_fld='Faox_evap_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - end if - ! --------------------------------------------------------------------- ! to atm: merged surface temperature and unmerged temperatures from ice and ocn ! --------------------------------------------------------------------- @@ -2014,38 +1866,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc_wiso') - call addfld_from(compatm, 'Faxa_rainl_wiso') - call addfld_to(compocn, 'Faxa_rain_wiso' ) - call addfld_from(compatm, 'Faxa_snowc_wiso') - call addfld_from(compatm, 'Faxa_snowl_wiso') - call addfld_from(compatm, 'Faxa_snow_wiso' ) - else - ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization - ! which by default is not actually used - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain_wiso' , rc=rc)) then - call addmap_from(compatm, 'Faxa_rainl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_rainc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_rain_wiso' , & - mrg_from=compatm, mrg_fld=trim('Faxa_rainc_wiso')//':'//trim('Faxa_rainl_wiso'), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowl_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_snowc_wiso', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_snow_wiso', & - mrg_from=compatm, mrg_fld=trim('Faxa_snowc_wiso')//':'//trim('Faxa_snowl_wiso'), & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- @@ -2082,18 +1902,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_aoflux( 'Faox_lat_wiso' ) - call addfld_to(compocn, 'Foxx_lat_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc)) then - call addmrg_to(compocn, 'Foxx_lat_wiso', & - mrg_from=compmed, mrg_fld='Faox_lat_wiso', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med ! --------------------------------------------------------------------- @@ -2286,19 +2094,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compice , 'Fioi_meltw_wiso') - call addfld_to(compocn , 'Fioi_meltw_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw_wiso', rc=rc)) then - call addmap_from(compice, 'Fioi_meltw_wiso', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Fioi_meltw_wiso', & - mrg_from=compice, mrg_fld='Fioi_meltw_wiso', mrg_type='copy_with_weights', mrg_fracname='ifrac') - end if - end if - end if ! --------------------------------------------------------------------- ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- @@ -2743,49 +2538,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc_wiso') - call addfld_from(compatm, 'Faxa_rainl_wiso') - call addfld_from(compatm, 'Faxa_rain_wiso' ) - call addfld_to(compice, 'Faxa_rain_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain_wiso', & - mrg_from=compatm, mrg_fld='Faxa_rain_wiso', mrg_type='copy') - end if - end if - - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_snowc_wiso') - call addfld_from(compatm, 'Faxa_snowl_wiso') - call addfld_from(compatm, 'Faxa_snow_wiso' ) - call addfld_to(compice, 'Faxa_snow_wiso' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow_wiso' , & - mrg_from=compatm, mrg_fld='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then - call addmap_from(compatm, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow_wiso', mrg_from=compatm, mrg_fld='Faxa_snow_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm ! --------------------------------------------------------------------- @@ -2885,7 +2637,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if ! --------------------------------------------------------------------- ! to ice: specific humidity at the lowest model level from atm - ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then call addfld_from(compatm, 'Sa_shum') @@ -2897,19 +2648,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') end if end if - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum_wiso') - call addfld_to(compice, 'Sa_shum_wiso') - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum_wiso', rc=rc)) then - call addmap_from(compatm, 'Sa_shum_wiso', compice, mapbilnr, 'one', atm2ice_map) - call addmrg_to(compice, 'Sa_shum_wiso', mrg_from=compatm, mrg_fld='Sa_shum_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- @@ -2997,22 +2735,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compice, 'Fioo_q', mrg_from=compocn, mrg_fld='Fioo_q', mrg_type='copy') end if end if - !----------------------------- - ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean - !----------------------------- - if (flds_wiso) then - if (phase == 'advertise') then - call addfld_from(compocn, 'So_roce_wiso') - call addfld_to(compice, 'So_roce_wiso') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then - call addmap_from(compocn, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') - call addmrg_to(compice, 'So_roce_wiso', mrg_from=compocn, mrg_fld='So_roce_wiso', mrg_type='copy') - end if - end if - end if - ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- @@ -3218,27 +2940,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end do - ! --------------------------------------------------------------------- - ! to rof: liquid and ice from glc water isoptopes - ! --------------------------------------------------------------------- - do ns = 1, is_local%wrap%num_icesheets - if (phase == 'advertise') then - call addfld_from(compglc(ns), 'Fgrg_rofl_wiso') - call addfld_from(compglc(ns), 'Fgrg_rofi_wiso') - call addfld_to(comprof, 'Fgrg_rofl_wiso') - call addfld_to(comprof, 'Fgrg_rofi_wiso') - else - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl_wiso' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofl_wiso', comprof, mapconsd, 'one' , 'unset') - ! TODO: implement custom merge - end if - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi_wiso' , rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofi_wiso', comprof, mapconsd, 'one', 'unset') - ! TODO: implement custom merge - end if - end if - end do - ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 93cad82d5..27d32407d 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -43,10 +43,6 @@ canonical_units: kg m-2 s-1 description: med export - atm/ocn evaporation water flux computed in medidator # - - standard_name: Faox_evap_wiso - canonical_units: kg m-2 s-1 - description: med export - atm/ocn evaporation water flux 16O, 18O, HDO computed in medidator - # - standard_name: Faox_lat alias: mean_laten_heat_flx_atm_into_ocn canonical_units: W m-2 @@ -90,10 +86,6 @@ canonical_units: kg m-2 s-1 description: lnd import to med # - - standard_name: Fall_evap_wiso - canonical_units: kg m-2 s-1 - description: lnd import to med - # - standard_name: Fall_fco2_lnd canonical_units: moles m-2 s-1 description: lnd import to med @@ -174,10 +166,6 @@ canonical_units: kg kg-1 description: lnd import to med # - - standard_name: Sl_qref_wiso - canonical_units: kg kg-1 - description: lnd import to med - # - standard_name: Sl_ram1 canonical_units: s/m description: lnd import to med @@ -186,10 +174,6 @@ canonical_units: m description: lnd import to med # - - standard_name: Sl_snowh_wiso - canonical_units: m - description: lnd import to med - # - standard_name: Sl_soilw canonical_units: m3/m3 description: lnd import to med @@ -306,61 +290,32 @@ canonical_units: kg(N)/m2/sec description: atm import to med - currently nhx and noy # - - standard_name: Faxa_prec_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rain alias: mean_prec_rate canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rain_wiso - alias: mean_prec_rate_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rainc canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rainc_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_rainl canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_rainl_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snow alias: mean_fprec_rate canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snow_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snowc canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snowc_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_snowl canonical_units: kg m-2 s-1 description: atm import to med # - - standard_name: Faxa_snowl_wiso - canonical_units: kg m-2 s-1 - description: atm import to med - # - standard_name: Faxa_swnet canonical_units: W m-2 description: atm import to med @@ -434,11 +389,6 @@ canonical_units: kg kg-1 description: atm import to med - bottom layer specific humidiaty # - - standard_name: Sa_shum_wiso - alias: inst_spec_humid_height_lowest_wiso - canonical_units: kg kg-1 - description: atm import to med - bottom layer specific humidity 16O, 18O, HDO - # - standard_name: Sa_tbot alias: inst_temp_height_lowest canonical_units: K @@ -505,10 +455,6 @@ canonical_units: kg m-2 s-1 description: atm export from meditor - merged water evaporation flux # - - standard_name: Faxx_evap_wiso - canonical_units: kg m-2 s-1 - description: atm export from med - merged water evaporation flux for 16O, 18O and HDO - # - standard_name: Faxx_lat alias: mean_laten_heat_flx canonical_units: W m-2 @@ -553,10 +499,6 @@ canonical_units: kg kg-1 description: atm export from med # - - standard_name: Sx_qref_wiso - canonical_units: kg kg-1 - description: atm export from med - # - standard_name: Sx_t alias: surface_temperature canonical_units: K @@ -593,26 +535,14 @@ canonical_units: kg m-2 s-1 description: glc import tomed - glacier frozen_runoff_flux_to_ocean # - - standard_name: Fgrg_rofi_wiso - canonical_units: kg m-2 s-1 - description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # - standard_name: Fgrg_rofl canonical_units: kg m-2 s-1 description: glc import to med - glacier liquid runoff flux to ocean # - - standard_name: Fgrg_rofl_wiso - canonical_units: kg m-2 s-1 - description: glc import to med - glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO - # - standard_name: Figg_rofi canonical_units: kg m-2 s-1 description: glc import to med - glc frozen runoff_iceberg flux to ice # - - standard_name: Figg_rofi_wiso - canonical_units: kg m-2 s-1 - description: glc import to med - glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO - # - standard_name: Flgg_hflx canonical_units: W m-2 description: glc import to med to med (no elevation classes) @@ -664,10 +594,6 @@ canonical_units: kg m-2 s-1 description: ice import to med # - - standard_name: Faii_evap_wiso - canonical_units: kg m-2 s-1 - description: ice import to med for 16O, 18O, HDO - # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice canonical_units: W m-2 @@ -714,24 +640,11 @@ canonical_units: W m-2 description: ice import to med to ocean - net heat flux to ocean # - - standard_name: Fioi_melth_wiso - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - isotope head flux to ocean for 16O, 18O, HDO - # - - standard_name: Fioi_melth_HDO - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - isotope head flux to ocean - # - standard_name: Fioi_meltw alias: mean_fresh_water_to_ocean_rate canonical_units: kg m-2 s-1 description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) # - - standard_name: Fioi_meltw_wiso - alias: mean_fresh_water_to_ocean_rate_wiso - canonical_units: kg m-2 s-1 - description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO - # - standard_name: Fioi_salt alias: mean_salt_rate canonical_units: kg m-2 s-1 @@ -811,10 +724,6 @@ canonical_units: kg kg-1 description: ice import to med # - - standard_name: Si_qref_wiso - canonical_units: kg kg-1 - description: ice import to med - # - standard_name: Si_t alias: sea_ice_surface_temperature canonical_units: K @@ -931,22 +840,10 @@ canonical_units: kg kg-1 description: ocn import to med # - - standard_name: So_qref_wiso - canonical_units: kg kg-1 - description: ocn import to med - # - standard_name: So_re canonical_units: 1 description: ocn import to med # - - standard_name: So_qref_wiso - canonical_units: kg kg-1 - description: ocn import to med - # - - standard_name: So_roce_wiso - canonical_units: unitless - description: ocn import to med - # - standard_name: So_s alias: s_surf canonical_units: g kg-1 @@ -1042,19 +939,10 @@ canonical_units: kg m-2 s-1 description: med export to ocn - specific humidity flux # - - standard_name: Foxx_evap_wiso - alias: mean_evap_rate_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - specific humidity flux 16O, 18O, HDO - # - standard_name: Foxx_lat canonical_units: W m-2 description: med export to ocn - latent heat flux into ocean # - - standard_name: Foxx_lat_wiso - canonical_units: W m-2 - description: med export to ocn - latent heat flux into ocean for 16O, 18O, HDO - # - standard_name: Foxx_lat canonical_units: W m-2 description: med export to ocn - latent heat flux into ocean for HDO @@ -1093,19 +981,11 @@ canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (frozen) # - - standard_name: Foxx_rofi_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - water flux due to runoff (frozen) for 16O, 18O, HDO - # - standard_name: Foxx_rofl alias: mean_runoff_rate canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (liquid) # - - standard_name: Foxx_rofl_wiso - canonical_units: kg m-2 s-1 - description: med export to ocn - water flux due to runoff (liquid) for 16O, 18O, HDO - # - standard_name: Foxx_swnet alias: mean_net_sw_flx canonical_units: W m-2 @@ -1166,26 +1046,14 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to flooding # - - standard_name: Flrr_flood_wiso - canonical_units: kg m-2 s-1 - description: river import to med - water flux due to flooding for 16O, 18O, HDO - # - standard_name: Flrr_volr canonical_units: m description: river import to med - river channel total water volume # - - standard_name: Flrr_volr_wiso - canonical_units: m - description: river import to med - river channel total water volume from 16O, 18O, HDO - # - standard_name: Flrr_volrmch canonical_units: m description: river import to med - river channel main channel water volume # - - standard_name: Flrr_volrmch_wiso - canonical_units: m - description: river import to med - river channel main channel water volume from 16O, 18O, HDO - # - standard_name: Sr_tdepth canonical_units: m description: river import to med - tributary channel water depth @@ -1202,10 +1070,6 @@ canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff originating from glc (frozen) # - - standard_name: Forr_rofi_wiso - canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO - # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 description: river import to med - liquid water flux due to runoff @@ -1222,10 +1086,6 @@ canonical_units: kg m-2 s-1 description: river import to med - non-water flux(es) due to runoff originating from lnd (liquid) # - - standard_name: Forr_rofl_wiso - canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (frozen) for 16O, 18O, HDO - # #----------------------------------- # section: wav import to med #----------------------------------- diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index df0d4e351..319b07255 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -158,27 +158,6 @@ module med_diag_mod integer :: f_watr_salt = unset_index ! water: water equivalent of salt flux integer :: f_watr_roff = unset_index ! water: runoff/flood integer :: f_watr_ioff = unset_index ! water: frozen runoff - integer :: f_watr_frz_16O = unset_index ! water isotope: freezing - integer :: f_watr_melt_16O = unset_index ! water isotope: melting - integer :: f_watr_rain_16O = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_16O = unset_index ! water isotope: prcip, frozen - integer :: f_watr_evap_16O = unset_index ! water isotope: evaporation - integer :: f_watr_roff_16O = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_16O = unset_index ! water isotope: frozen runoff - integer :: f_watr_frz_18O = unset_index ! water isotope: freezing - integer :: f_watr_melt_18O = unset_index ! water isotope: melting - integer :: f_watr_rain_18O = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_18O = unset_index ! water isotope: precip, frozen - integer :: f_watr_evap_18O = unset_index ! water isotope: evaporation - integer :: f_watr_roff_18O = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_18O = unset_index ! water isotope: frozen runoff - integer :: f_watr_frz_HDO = unset_index ! water isotope: freezing - integer :: f_watr_melt_HDO = unset_index ! water isotope: melting - integer :: f_watr_rain_HDO = unset_index ! water isotope: precip, liquid - integer :: f_watr_snow_HDO = unset_index ! water isotope: precip, frozen - integer :: f_watr_evap_HDO = unset_index ! water isotope: evaporation - integer :: f_watr_roff_HDO = unset_index ! water isotope: runoff/flood - integer :: f_watr_ioff_HDO = unset_index ! water isotope: frozen runoff integer :: f_heat_beg = unset_index ! 1st index for heat integer :: f_heat_end = unset_index ! Last index for heat @@ -187,25 +166,6 @@ module med_diag_mod integer :: f_salt_beg = unset_index ! 1st index for salt integer :: f_salt_end = unset_index ! Last index for salt - integer :: f_16O_beg = unset_index ! 1st index for 16O water isotope - integer :: f_16O_end = unset_index ! Last index for 16O water isotope - integer :: f_18O_beg = unset_index ! 1st index for 18O water isotope - integer :: f_18O_end = unset_index ! Last index for 18O water isotope - integer :: f_HDO_beg = unset_index ! 1st index for HDO water isotope - integer :: f_HDO_end = unset_index ! Last index for HDO water isotope - - ! --------------------------------- - ! water isotopes names and indices - ! --------------------------------- - - logical :: flds_wiso = .false.! If water isotope fields are active - - ! TODO: for now set to .false. - but this needs to be set in an initialization phase - - integer, parameter :: nisotopes = 3 - integer :: iso0(nisotopes) - integer :: isof(nisotopes) - character(len=5) :: isoname(nisotopes) - ! --------------------------------- ! P for period ! --------------------------------- @@ -363,43 +323,6 @@ subroutine med_diag_init(gcomp, rc) end if f_watr_end = f_watr_ioff ! field last index for water - if (flds_wiso) then - call add_to_budget_diag(budget_diags%fields, f_watr_frz_16O ,'wfreeze_16O' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_16O ,'wmelt_16O' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_16O ,'wrain_16O' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_16O ,'wsnow_16O' ) ! field water isotope: prcip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_16O ,'wevap_16O' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_16O ,'wrunoff_16O' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_16O ,'wfrzrof_16O' ) ! field water isotope: frozen runoff - f_16O_beg = f_watr_frz_16O ! field 1st index for 16O water isotope - f_16O_end = f_watr_ioff_16O ! field Last index for 16O water isotope - - call add_to_budget_diag(budget_diags%fields, f_watr_frz_18O ,'wfreeze_18O' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_18O ,'wmelt_18O' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_18O ,'wrain_18O' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_18O ,'wsnow_18O' ) ! field water isotope: precip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_18O ,'wevap_18O' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_18O ,'wrunoff_18O' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_18O ,'wfrzrof_18O' ) ! field water isotope: frozen runoff - f_18O_beg = f_watr_frz_18O ! field 1st index for 18O water isotope - f_18O_end = f_watr_ioff_18O ! field Last index for 18O water isotope - - call add_to_budget_diag(budget_diags%fields, f_watr_frz_HDO ,'wfreeze_HDO' ) ! field water isotope: freezing - call add_to_budget_diag(budget_diags%fields, f_watr_melt_HDO ,'wmelt_HDO' ) ! field water isotope: melting - call add_to_budget_diag(budget_diags%fields, f_watr_rain_HDO ,'wrain_HDO' ) ! field water isotope: precip, liquid - call add_to_budget_diag(budget_diags%fields, f_watr_snow_HDO ,'wsnow_HDO' ) ! field water isotope: precip, frozen - call add_to_budget_diag(budget_diags%fields, f_watr_evap_HDO ,'wevap_HDO' ) ! field water isotope: evaporation - call add_to_budget_diag(budget_diags%fields, f_watr_roff_HDO ,'wrunoff_HDO' ) ! field water isotope: runoff/flood - call add_to_budget_diag(budget_diags%fields, f_watr_ioff_HDO ,'wfrzrof_HDO' ) ! field water isotope: frozen runoff - f_HDO_beg = f_watr_frz_HDO ! field 1st index for HDO water isotope - f_HDO_end = f_watr_ioff_HDO ! field Last index for HDO water isotope - - ! water isotopes - iso0(:) = (/ f_16O_beg, f_18O_beg, f_hdO_beg /) - isof(:) = (/ f_16O_end, f_18O_end, f_hdO_end /) - isoname(:) = (/ 'H216O', 'H218O', ' HDO' /) - end if - ! ----------------------------------------- ! Salt fluxes budget terms (for v1 only) ! ----------------------------------------- @@ -719,15 +642,6 @@ subroutine med_phases_diag_atm(gcomp, rc) areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_atm_wiso_recv(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! heat implied by snow flux from atm to mediator budget_local(f_heat_latf,c_atm_recv ,ip) = -budget_local(f_watr_snow,c_atm_recv ,ip)*shr_const_latice budget_local(f_heat_latf,c_lnd_arecv,ip) = -budget_local(f_watr_snow,c_lnd_arecv,ip)*shr_const_latice @@ -765,14 +679,6 @@ subroutine med_phases_diag_atm(gcomp, rc) areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! water isotopes - if (flds_wiso) then - call diag_atm_wiso_send(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, & - areas, lats, afrac, lfrac, ofrac, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - deallocate(afrac) call t_stopf('MED:'//subname) end subroutine med_phases_diag_atm @@ -847,118 +753,6 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra end if end subroutine diag_atm_send - subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_recv,ip) = budget(nf_16O,c_atm_recv,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_arecv,ip) = budget(nf_16O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_arecv,ip) = budget(nf_16O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_arecv,ip) = budget(nf_16O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_arecv,ip) = budget(nf_16O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_recv,ip) = budget(nf_18O,c_atm_recv,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_arecv,ip) = budget(nf_18O,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_arecv,ip) = budget(nf_18O,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_arecv,ip) = budget(nf_18O,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_arecv,ip) = budget(nf_18O,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_recv,ip) = budget(nf_HDO,c_atm_recv,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_arecv,ip) = budget(nf_HDO,c_lnd_arecv,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_arecv,ip) = budget(nf_HDO,c_ocn_arecv,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_arecv,ip) = budget(nf_HDO,c_inh_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_arecv,ip) = budget(nf_HDO,c_ish_arecv,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_recv - - subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, & - afrac, lfrac, ofrac, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: afrac(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(in) :: ofrac(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1,size(data, dim=2) - budget(nf_16O,c_atm_send,ip) = budget(nf_16O,c_atm_send,ip) - areas(n)*afrac(n)*data(1,n) - budget(nf_16O,c_lnd_asend,ip) = budget(nf_16O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_16O,c_ocn_asend,ip) = budget(nf_16O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(1,n) - if (lats(n) > 0.0_r8) then - budget(nf_16O,c_inh_asend,ip) = budget(nf_16O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(1,n) - else - budget(nf_16O,c_ish_asend,ip) = budget(nf_16O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(1,n) - end if - - budget(nf_18O,c_atm_send,ip) = budget(nf_18O,c_atm_send,ip) - areas(n)*afrac(n)*data(2,n) - budget(nf_18O,c_lnd_asend,ip) = budget(nf_18O,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_18O,c_ocn_asend,ip) = budget(nf_18O,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(2,n) - if (lats(n) > 0.0_r8) then - budget(nf_18O,c_inh_asend,ip) = budget(nf_18O,c_inh_asend,ip) + areas(n)*ifrac(n)*data(2,n) - else - budget(nf_18O,c_ish_asend,ip) = budget(nf_18O,c_ish_asend,ip) + areas(n)*ifrac(n)*data(2,n) - end if - - budget(nf_HDO,c_atm_send,ip) = budget(nf_HDO,c_atm_send,ip) - areas(n)*afrac(n)*data(3,n) - budget(nf_HDO,c_lnd_asend,ip) = budget(nf_HDO,c_lnd_asend,ip) + areas(n)*lfrac(n)*data(3,n) - budget(nf_HDO,c_ocn_asend,ip) = budget(nf_HDO,c_ocn_asend,ip) + areas(n)*ofrac(n)*data(3,n) - if (lats(n) > 0.0_r8) then - budget(nf_HDO,c_inh_asend,ip) = budget(nf_HDO,c_inh_asend,ip) + areas(n)*ifrac(n)*data(3,n) - else - budget(nf_HDO,c_ish_asend,ip) = budget(nf_HDO,c_ish_asend,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_atm_wiso_send - !=============================================================================== subroutine med_phases_diag_lnd( gcomp, rc) @@ -1030,18 +824,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) areas, lfrac, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofl_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBImp(complnd,complnd), 'Flrl_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice !------------------------------- @@ -1067,23 +849,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) call diag_lnd(is_local%wrap%FBExp(complnd), 'Flrl_flood', f_watr_roff, ic, areas, lfrac, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_rainc_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_rainl_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_snowc_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Faxa_snowl_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, ic, areas, lfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_lnd_wiso(is_local%wrap%FBExp(complnd), 'Flrl_flood_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, lfrac, budget_local, minus=.true., rc=rc) - end if - budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) @@ -1120,43 +885,6 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) end if end subroutine diag_lnd - subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lfrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*lfrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*lfrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*lfrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*lfrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_lnd_wiso - !=============================================================================== subroutine med_phases_diag_rof( gcomp, rc) @@ -1209,18 +937,6 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (flds_wiso) then - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_flood_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_rofl_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Forr_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice !------------------------------- @@ -1249,15 +965,6 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (flds_wiso) then - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Flrl_rofl_wiso', & - f_watr_roff_16O, f_watr_roff_18O, f_watr_roff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_rof_wiso(is_local%wrap%FBExp(comprof), 'Flrl_rofi_wiso', & - f_watr_ioff_16O, f_watr_ioff_18O, f_watr_ioff_HDO, ic, areas, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) @@ -1294,43 +1001,6 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) end if end subroutine diag_rof - subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*data(3,n) - end if - end do - end if - end subroutine diag_rof_wiso - !=============================================================================== subroutine med_phases_diag_glc( gcomp, rc) @@ -1563,27 +1233,6 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (flds_wiso) then - call diag_ocn_wiso(is_local%wrap%FBMed_aoflux_o, 'Faox_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, ic, areas, ofrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_meltw_wiso', & - f_watr_melt_16O, f_watr_melt_HDO, f_watr_melt_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_rain_wiso' , & - f_watr_rain_16O, f_watr_rain_HDO, f_watr_rain_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Fioi_snow_wiso' , & - f_watr_snow_16O, f_watr_snow_HDO, f_watr_snow_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Foxx_rofl_wiso' , & - f_watr_roff_16O, f_watr_roff_HDO, f_watr_roff_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn_wiso(is_local%wrap%FBExp(compocn), 'Foxx_rofi_wiso' , & - f_watr_ioff_16O, f_watr_ioff_HDO, f_watr_ioff_HDO, ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) @@ -1636,36 +1285,6 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) end if end subroutine diag_ocn - subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - integer , intent(in) :: ic - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: frac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*frac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*frac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*frac(n)*data(3,n) - end do - end if - end subroutine diag_ocn_wiso - !=============================================================================== subroutine med_phases_diag_ice_ice2med( gcomp, rc) @@ -1763,15 +1382,6 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) areas, lats, ifrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Fioi_meltw_wiso', & - f_watr_melt_16O, f_watr_melt_18O, f_watr_melt_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_recv_wiso(is_local%wrap%FBImp(compice,compice), 'Faii_evap_wiso', & - f_watr_evap_16O, f_watr_evap_18O, f_watr_evap_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) end subroutine med_phases_diag_ice_ice2med @@ -1819,47 +1429,6 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca end if end subroutine diag_ice_recv - subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, minus, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - logical, optional , intent(in) :: minus - integer , intent(out) :: rc - ! local variables - integer :: n, ic, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_recv - else - ic = c_ish_recv - endif - if (present(minus)) then - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) - areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) - areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) - areas(n)*ifrac(n)*data(3,n) - else - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end if - end do - end if - end subroutine diag_ice_recv_wiso !=============================================================================== subroutine med_phases_diag_ice_med2ice( gcomp, rc) @@ -1946,15 +1515,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) budget_local(f_watr_frz ,ic,ip) = budget_local(f_heat_frz ,ic,ip)*HFLXtoWFLX end if - if (flds_wiso) then - call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_rain_wiso', & - f_watr_rain_16O, f_watr_rain_18O, f_watr_rain_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ice_send_wiso(is_local%wrap%FBExp(compice), 'Faxa_snow_wiso', & - f_watr_snow_16O, f_watr_snow_18O, f_watr_snow_HDO, areas, lats, ifrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) end subroutine med_phases_diag_ice_med2ice @@ -1988,41 +1548,6 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) end if end subroutine diag_ice_send - subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ifrac, budget, rc) - ! input/output variables - type(ESMF_FieldBundle) , intent(in) :: FB - character(len=*) , intent(in) :: fldname - integer , intent(in) :: nf_16O - integer , intent(in) :: nf_18O - integer , intent(in) :: nf_HDO - real(r8) , intent(in) :: areas(:) - real(r8) , intent(in) :: lats(:) - real(r8) , intent(in) :: ifrac(:) - real(r8) , intent(inout) :: budget(:,:,:) - integer , intent(out) :: rc - - ! local variables - integer :: n, ic, ip - real(r8), pointer :: data(:,:) - ! ------------------------------------------------------------------ - rc = ESMF_SUCCESS - if ( fldbun_fldchk(FB, trim(fldname), rc=rc)) then - call fldbun_getdata2d(FB, trim(fldname), data, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ip = period_inst - do n = 1, size(data, dim=2) - if (lats(n) > 0.0_r8) then - ic = c_inh_send - else - ic = c_ish_send - endif - budget(nf_16O,ic,ip) = budget(nf_16O,ic,ip) + areas(n)*ifrac(n)*data(1,n) - budget(nf_18O,ic,ip) = budget(nf_18O,ic,ip) + areas(n)*ifrac(n)*data(2,n) - budget(nf_HDO,ic,ip) = budget(nf_HDO,ic,ip) + areas(n)*ifrac(n)*data(3,n) - end do - end if - end subroutine diag_ice_send_wiso - !=============================================================================== subroutine med_phases_diag_print(gcomp, rc) @@ -2140,9 +1665,6 @@ subroutine med_phases_diag_print(gcomp, rc) ! budget normalizations (global area and 1e6 for water) datagpr = datagpr/(4.0_r8*shr_const_pi) datagpr(f_watr_beg:f_watr_end,:,:) = datagpr(f_watr_beg:f_watr_end,:,:) * 1.0e6_r8 - if ( flds_wiso ) then - datagpr(iso0(1):isof(nisotopes),:,:) = datagpr(iso0(1):isof(nisotopes),:,:) * 1.0e6_r8 - end if datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) ! Write diagnostic tables to logunit (maintask only) @@ -2292,38 +1814,6 @@ subroutine med_diag_print_atm(data, ip, date, tod) sum(data(f_watr_beg:f_watr_end,icn,ip)) + sum(data(f_watr_beg:f_watr_end,ics,ip)) + & sum(data(f_watr_beg:f_watr_end,ico,ip)) - if ( flds_wiso ) then - do is = 1, nisotopes - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//' '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(ica)%name,& - budget_diags%comps(icl)%name,& - budget_diags%comps(icn)%name,& - budget_diags%comps(ics)%name,& - budget_diags%comps(ico)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - data(nf,ica,ip), & - data(nf,icl,ip), & - data(nf,icn,ip), & - data(nf,ics,ip), & - data(nf,ico,ip), & - data(nf,ica,ip) + data(nf,icl,ip) + data(nf,icn,ip) + data(nf,ics,ip) + data(nf,ico,ip) - enddo - write(diagunit,FA1) ' *SUM*', & - sum(data(iso0(is):isof(is),ica,ip)), & - sum(data(iso0(is):isof(is),icl,ip)), & - sum(data(iso0(is):isof(is),icn,ip)), & - sum(data(iso0(is):isof(is),ics,ip)), & - sum(data(iso0(is):isof(is),ico,ip)), & - sum(data(iso0(is):isof(is),ica,ip)) + sum(data(iso0(is):isof(is),icl,ip)) + & - sum(data(iso0(is):isof(is),icn,ip)) + sum(data(iso0(is):isof(is),ics,ip)) + & - sum(data(iso0(is):isof(is),ico,ip)) - end do - end if - enddo end subroutine med_diag_print_atm @@ -2431,65 +1921,6 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) -sum(data(f_watr_beg:f_watr_end,icas,ip)), & -sum(data(f_watr_beg:f_watr_end,icar,ip)) + sum(data(f_watr_beg:f_watr_end,icxs,ip)) + & sum(data(f_watr_beg:f_watr_end,icxr,ip)) - sum(data(f_watr_beg:f_watr_end,icas,ip)) - - if ( flds_wiso ) then - do is = 1, nisotopes - - ! heat budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name), & - ': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(icar)%name,& - budget_diags%comps(icxs)%name,& - budget_diags%comps(icxr)%name,& - budget_diags%comps(icas)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - -data(nf,icar,ip), & - data(nf,icxs,ip), & - data(nf,icxr,ip), & - -data(nf,icas,ip), & - -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) - enddo - write(diagunit,FA1) ' *SUM*',& - -sum(data(iso0(is):isof(is),icar,ip)),& - sum(data(iso0(is):isof(is),icxs,ip)), & - sum(data(iso0(is):isof(is),icxr,ip)), & - -sum(data(iso0(is):isof(is),icas,ip)), & - -sum(data(iso0(is):isof(is),icar,ip)) + sum(data(iso0(is):isof(is),icxs,ip)) + & - sum(data(iso0(is):isof(is),icxr,ip)) - sum(data(iso0(is):isof(is),icas,ip)) - - ! water budgets atm<->lnd, atm<->ocn, atm<->ice_nh, atm<->ice_sh for water isotopes - - write(diagunit,*) ' ' - write(diagunit,FAH) subname,trim(str)//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ',& - trim(budget_diags%periods(ip)%name),& - ': date = ',date,tod - write(diagunit,FA0) & - budget_diags%comps(icar)%name,& - budget_diags%comps(icxs)%name,& - budget_diags%comps(icxr)%name,& - budget_diags%comps(icas)%name,' *SUM* ' - do nf = iso0(is), isof(is) - write(diagunit,FA1) budget_diags%fields(nf)%name,& - -data(nf,icar,ip), & - data(nf,icxs,ip), & - data(nf,icxr,ip), & - -data(nf,icas,ip), & - -data(nf,icar,ip) + data(nf,icxs,ip) + data(nf,icxr,ip) - data(nf,icas,ip) - enddo - write(diagunit,FA1) ' *SUM*', & - -sum(data(iso0(is):isof(is), icar, ip)), & - sum(data(iso0(is):isof(is), icxs, ip)), & - sum(data(iso0(is):isof(is), icxr, ip)), & - -sum(data(iso0(is):isof(is), icas, ip)), & - -sum(data(iso0(is):isof(is), icar, ip)) + sum(data(iso0(is):isof(is), icxs, ip)) + & - sum(data(iso0(is):isof(is), icxr, ip)) - sum(data(iso0(is):isof(is), icas, ip)) - end do - end if enddo end subroutine med_diag_print_lnd_ice_ocn @@ -2647,55 +2078,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot - ! write out net water water-isoptope budgets - - if ( flds_wiso ) then - - do is = 1, nisotopes - write(diagunit,*) ' ' - write(diagunit,FAH) subname,'NET '//isoname(is)//' WATER BUDGET (kg/m2s*1e6): period = ', & - trim(budget_diags%periods(ip)%name),': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' - do nf = iso0(is), isof(is) - net_water_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) - net_water_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) - net_water_rof = data(nf, c_rof_recv, ip) + data(nf, c_rof_send, ip) - net_water_ocn = data(nf, c_ocn_recv, ip) + data(nf, c_ocn_send, ip) - net_water_ice_nh = data(nf, c_inh_recv, ip) + data(nf, c_inh_send, ip) - net_water_ice_sh = data(nf, c_ish_recv, ip) + data(nf, c_ish_send, ip) - net_water_glc = data(nf, c_glc_recv, ip) + data(nf, c_glc_send, ip) - net_water_tot = net_water_atm + net_water_lnd + net_water_rof + net_water_ocn + & - net_water_ice_nh + net_water_ice_sh + net_water_glc - - write(diagunit,FA1r) budget_diags%fields(nf)%name,& - net_water_atm, net_water_lnd, net_water_rof, net_water_ocn, & - net_water_ice_nh, net_water_ice_sh, net_water_glc, net_water_tot - enddo - - sum_net_water_atm = sum(data(iso0(is):isof(is), c_atm_recv, ip)) + & - sum(data(iso0(is):isof(is), c_atm_send, ip)) - sum_net_water_lnd = sum(data(iso0(is):isof(is), c_lnd_recv, ip)) + & - sum(data(iso0(is):isof(is), c_lnd_send, ip)) - sum_net_water_rof = sum(data(iso0(is):isof(is), c_rof_recv, ip)) + & - sum(data(iso0(is):isof(is), c_rof_send, ip)) - sum_net_water_ocn = sum(data(iso0(is):isof(is), c_ocn_recv, ip)) + & - sum(data(iso0(is):isof(is), c_ocn_send, ip)) - sum_net_water_ice_nh = sum(data(iso0(is):isof(is), c_inh_recv, ip)) + & - sum(data(iso0(is):isof(is), c_inh_send, ip)) - sum_net_water_ice_sh = sum(data(iso0(is):isof(is), c_ish_recv, ip)) + & - sum(data(iso0(is):isof(is), c_ish_send, ip)) - sum_net_water_glc = sum(data(iso0(is):isof(is), c_glc_recv, ip)) + & - sum(data(iso0(is):isof(is), c_glc_send, ip)) - sum_net_water_tot = sum_net_water_atm + sum_net_water_lnd + sum_net_water_rof + & - sum_net_water_ocn + sum_net_water_ice_nh + sum_net_water_ice_sh + & - sum_net_water_glc - - write(diagunit,FA1r)' *SUM*',& - sum_net_water_atm, sum_net_water_lnd, sum_net_water_rof, sum_net_water_ocn, & - sum_net_water_ice_nh, sum_net_water_ice_sh, sum_net_water_glc, sum_net_water_tot - end do - end if - ! ----------------------------- ! write out net salt budgets ! ----------------------------- diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index a16240627..9417e2528 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -74,7 +74,6 @@ module med_phases_aofluxes_mod ! Private data !-------------------------------------------------------------------------- - logical :: flds_wiso ! use case logical :: compute_atm_dens logical :: compute_atm_thbot integer :: ocn_surface_flux_scheme ! use case @@ -107,9 +106,7 @@ module med_phases_aofluxes_mod real(R8) , pointer :: uocn (:) => null() ! ocn velocity, zonal real(R8) , pointer :: vocn (:) => null() ! ocn velocity, meridional real(R8) , pointer :: tocn (:) => null() ! ocean temperature - real(R8) , pointer :: roce_16O (:) => null() ! ocn H2O ratio - real(R8) , pointer :: roce_HDO (:) => null() ! ocn HDO ratio - real(R8) , pointer :: roce_18O (:) => null() ! ocn H218O ratio + ! input: atm real(R8) , pointer :: zbot (:) => null() ! atm level height real(R8) , pointer :: ubot (:) => null() ! atm velocity, zonal @@ -122,9 +119,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: psfc (:) => null() ! atm surface pressure real(R8) , pointer :: dens (:) => null() ! atm bottom density real(R8) , pointer :: tbot (:) => null() ! atm bottom surface T - real(R8) , pointer :: shum_16O (:) => null() ! atm H2O tracer - real(R8) , pointer :: shum_HDO (:) => null() ! atm HDO tracer - real(R8) , pointer :: shum_18O (:) => null() ! atm H218O tracer real(R8) , pointer :: lwdn (:) => null() ! atm downward longwave heat flux real(R8) , pointer :: rainc (:) => null() ! convective rain flux ! local size and computational mask and area: on aoflux grid @@ -139,9 +133,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: lat (:) => null() ! heat flux: latent real(R8) , pointer :: lwup (:) => null() ! lwup over ocean real(R8) , pointer :: evap (:) => null() ! water flux: evaporation - real(R8) , pointer :: evap_16O (:) => null() ! H2O flux: evaporation - real(R8) , pointer :: evap_HDO (:) => null() ! HDO flux: evaporation - real(R8) , pointer :: evap_18O (:) => null() ! H218O flux: evaporation real(R8) , pointer :: taux (:) => null() ! wind stress, zonal real(R8) , pointer :: tauy (:) => null() ! wind stress, meridional real(R8) , pointer :: tref (:) => null() ! diagnostic: 2m ref T @@ -386,13 +377,6 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ! Initialize module variables !---------------------------------- - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_wiso - else - flds_wiso = .false. - end if call NUOPC_CompAttributeGet(gcomp, name='ocn_surface_flux_scheme', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then @@ -637,13 +621,8 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) ! input fields from atm and ocn on atm grid ! ------------------------ - if (flds_wiso) then - allocate(fldnames_ocn_in(5)) - fldnames_ocn_in = (/'So_omask ','So_t ','So_u ','So_v ','So_roce_wiso' /) - else - allocate(fldnames_ocn_in(4)) - fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) - end if + allocate(fldnames_ocn_in(4)) + fldnames_ocn_in = (/'So_omask','So_t ','So_u ','So_v '/) call FB_init(FBocn_a, is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(compatm,compatm), fieldnamelist=fldnames_ocn_in, name='FBocn_a', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1070,22 +1049,15 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #ifdef CESMCOUPLED call flux_atmocn_driver (logunit=logunit, & nMax=aoflux_in%lsize, & - zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & - rainc=aoflux_in%rainc, & - s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & - tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & - mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & - sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, & - r16O=aoflux_in%roce_16O, rhdo=aoflux_in%roce_HDO, r18O=aoflux_in%roce_18O, & - evap=aoflux_out%evap, evap_16O=aoflux_out%evap_16O, evap_HDO=aoflux_out%evap_HDO, evap_18O=aoflux_out%evap_18O, & + zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, & + qbot=aoflux_in%shum, rainc=aoflux_in%rainc, rbot=aoflux_in%dens, & + tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, & + ts=aoflux_in%tocn, mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & + sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, evap=aoflux_out%evap, & taux=aoflux_out%taux, tauy=aoflux_out%tauy, tref=aoflux_out%tref, qref=aoflux_out%qref, & ocn_surface_flux_scheme=ocn_surface_flux_scheme, & - add_gusts=add_gusts, & - duu10n=aoflux_out%duu10n, & - ugust_out = aoflux_out%ugust_out, & - u10res = aoflux_out%u10res, & - ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, & - missval=0.0_r8) + add_gusts=add_gusts, duu10n=aoflux_out%duu10n, ugust_out = aoflux_out%ugust_out, u10res = aoflux_out%u10res, & + ustar_sv=aoflux_out%ustar, re_sv=aoflux_out%re, ssq_sv=aoflux_out%ssq, missval=0.0_r8) #else #ifdef UFS_AOFLUX @@ -1658,19 +1630,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if - if (flds_wiso) then - call fldbun_getfldptr(fldbun_a, 'Sa_shum_16O', aoflux_in%shum_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Sa_shum_18O', aoflux_in%shum_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_a, 'Sa_shum_HDO', aoflux_in%shum_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_in%shum_16O(lsize)); aoflux_in%shum_16O(:) = 0._R8 - allocate(aoflux_in%shum_18O(lsize)); aoflux_in%shum_18O(:) = 0._R8 - allocate(aoflux_in%shum_HDO(lsize)); aoflux_in%shum_HDO(:) = 0._R8 - end if - ! ------------------------ ! input fields from ocn on aoflux_grid ! ------------------------ @@ -1684,18 +1643,6 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return call fldbun_getfldptr(fldbun_o, 'So_v', aoflux_in%vocn, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call fldbun_getfldptr(fldbun_o, 'So_roce_16O', aoflux_in%roce_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_o, 'So_roce_18O', aoflux_in%roce_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun_o, 'So_roce_HDO', aoflux_in%roce_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_in%roce_16O(aoflux_in%lsize)); aoflux_in%roce_16O(:) = 0._R8 - allocate(aoflux_in%roce_18O(aoflux_in%lsize)); aoflux_in%roce_18O(:) = 0._R8 - allocate(aoflux_in%roce_HDO(aoflux_in%lsize)); aoflux_in%roce_HDO(:) = 0._R8 - end if end subroutine set_aoflux_in_pointers @@ -1741,18 +1688,6 @@ subroutine set_aoflux_out_pointers(fldbun, lsize, aoflux_out, xgrid, rc) call fldbun_getfldptr(fldbun, 'Faox_lwup', aoflux_out%lwup, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (flds_wiso) then - call fldbun_getfldptr(fldbun, 'Faox_evap_16O', aoflux_out%evap_16O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'Faox_evap_18O', aoflux_out%evap_18O, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getfldptr(fldbun, 'Faox_evap_HDO', aoflux_out%evap_HDO, xgrid=xgrid, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - allocate(aoflux_out%evap_16O(lsize)); aoflux_out%evap_16O(:) = 0._R8 - allocate(aoflux_out%evap_18O(lsize)); aoflux_out%evap_18O(:) = 0._R8 - allocate(aoflux_out%evap_HDO(lsize)); aoflux_out%evap_HDO(:) = 0._R8 - end if if (add_gusts) then call fldbun_getfldptr(fldbun, 'So_ugustOut', aoflux_out%ugust_out, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 002bbd279..7aa8bcb3e 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -65,7 +65,6 @@ subroutine med_phases_post_rof_init(gcomp, rc) ! local variables character(CL) :: cvalue logical :: isPresent, isSet - logical :: flds_wiso character(len=*), parameter :: subname='(med_phases_post_rof_init)' !--------------------------------------- @@ -96,20 +95,6 @@ subroutine med_phases_post_rof_init(gcomp, rc) remove_negative_runoff_glc = .false. end if - ! remove_negative_runoff isn't yet set up to handle isotope fields, so ensure that - ! this isn't set along with flds_wiso - call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) flds_wiso - else - flds_wiso = .false. - end if - if ((remove_negative_runoff_lnd .or. remove_negative_runoff_glc) .and. flds_wiso) then - call shr_log_error('remove_negative_runoff_lnd and remove_negative_runoff_glc must be set to false when flds_wiso is true', rc=rc) - return - end if - if (maintask) then write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_lnd = ', remove_negative_runoff_lnd write(logunit,'(a,l7)') trim(subname)//' remove_negative_runoff_glc = ', remove_negative_runoff_glc From 9b99cff3c393e7a214c29d300ab46a388959e85e Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 16 Oct 2025 21:25:22 +0200 Subject: [PATCH 088/135] formatting changes --- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 92 ++++++++++---------- 1 file changed, 44 insertions(+), 48 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 9a2beef71..f2b52bc50 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -265,7 +265,7 @@ subroutine flux_atmOcn_diurnal( & if (.not. ocn_prognostic) then ! Set swpen and ocean salinity from following analytic expressions swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 else ! use swpen and ocnsal from input argument @@ -347,27 +347,27 @@ subroutine flux_atmOcn_diurnal( & nsum = nint(nInc(n)) if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL + Regime(n) = 1.0_R8 ! RESET DIURNAL warm(n) = 0.0_R8 salt(n) = 0.0_R8 speed(n) = 0.0_R8 endif - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) !!................................................................. !! ocn_surface_flux_scheme = 0 : Default E3SMv1 !! = 1 : COARE algorithm !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) + stable = 0.5_R8 + sign(0.5_R8 , delt) !--- shift wind speed using old coefficient and stability function - rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) u10n = vmag * rd / rdn @@ -383,13 +383,13 @@ subroutine flux_atmOcn_diurnal( & else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params - & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) - & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights - & ,tau,hsb,hlb & ! out: fluxes - & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales - & ,rd,rh,re & ! out: exch. coeffs - & ,trf,qrf,urf,vrf) ! out: reference-height params + call cor30a(ubot(n), vbot(n), tbot(n), qbot(n), rbot(n), & ! in atm params + us(n), vs(n), tBulk(n), ssq, & ! in surf params (NB ts -> tBulk) + zpbl, zbot(n), zbot(n), zref, ztref, ztref, & ! in heights + tau, hsb, hlb, & ! out: fluxes + zo, zot, zoq, hol, ustar, tstar, qstar, & ! out: ss scales + rd, rh, re, & ! out: exch. coeffs + trf, qrf, urf, vrf) ! out: reference-height params ! for the sake of maintaining same defs hol=zbot(n)/hol @@ -397,18 +397,20 @@ subroutine flux_atmOcn_diurnal( & rh=sqrt(rh) re=sqrt(re) - ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + else ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - ENDIF + endif ustar_prev = ustar * 2.0_R8 iter = 0 + ! --- iterate --- ! Originally this code did three iterations while the non-diurnal version did two ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults ! will give the same answers in both cases. + do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) iter = iter + 1 ustar_prev = ustar @@ -422,27 +424,24 @@ subroutine flux_atmOcn_diurnal( & Kvisc = 0.0_R8 dif3 = 0.0_R8 - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & - rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn !--- COOL SKIN EFFECT --- Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * & - (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Qdel = Qnsol + Qsol * (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) Hb = min(Hb , 0.0_R8) - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) lambdaV = 6.5_R8 cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) !--- REGIME --- - doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & - (alphaT*Hd + betaS*Fd ) / ustarw**3 + doL = shr_const_zsrflyr * shr_const_karman*shr_const_g * (alphaT*Hd + betaS*Fd ) / ustarw**3 Rid = MAX(0.0_R8,Rid) Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 @@ -483,14 +482,13 @@ subroutine flux_atmOcn_diurnal( & !--- IMPLICIT INTEGRATION --- - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw))/(1.+ Sfact*Kvisc) DTiter = MAX( 0.0_R8, DTiter) DViter = MAX( 0.0_R8, DViter) - Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & - (pwr*MAX(tiny,DViter))**2 + Rid = (shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / (pwr*MAX(tiny,DViter))**2 Ribulk = Rid * pwr Ribulk = 0.0_R8 tBulk(n) = ts(n) + DTiter @@ -508,6 +506,7 @@ subroutine flux_atmOcn_diurnal( & !! ocn_surface_flux_scheme = 0 : Default CESM1.2 !! = 1 : COARE algorithm !!................................................................. + if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm !--- compute stability & evaluate all stability functions --- @@ -538,11 +537,10 @@ subroutine flux_atmOcn_diurnal( & tstar = rh * delt qstar = re * delq - !--- heat flux --- - - tau = rbot(n) * ustar * ustar - sen (n) = cp * tau * tstar / ustar - lat (n) = shr_const_latvap * tau * qstar / ustar + !--- heat fluxes --- + tau = rbot(n) * ustar * ustar + sen(n) = cp * tau * tstar / ustar + lat(n) = shr_const_latvap * tau * qstar / ustar else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm @@ -555,14 +553,14 @@ subroutine flux_atmOcn_diurnal( & & ,trf,qrf,urf,vrf) ! out: reference-height params ! for the sake of maintaining same defs - hol=zbot(n)/hol - rd=sqrt(rd) - rh=sqrt(rh) - re=sqrt(re) + hol = zbot(n)/hol + rd = sqrt(rd) + rh = sqrt(rh) + re = sqrt(re) - !--- heat flux --- - sen (n) = hsb - lat (n) = hlb + !--- heat fluxes --- + sen(n) = hsb + lat(n) = hlb else ! N.B.: NO ocn_surface_flux_scheme=2 option call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") @@ -573,8 +571,6 @@ subroutine flux_atmOcn_diurnal( & call shr_sys_abort('No iterations performed ') end if - !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- - !--- momentum flux --- taux(n) = tau * (ubot(n)-us(n)) / vmag tauy(n) = tau * (vbot(n)-vs(n)) / vmag @@ -600,7 +596,6 @@ subroutine flux_atmOcn_diurnal( & tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) qref(n) = qbot(n) - delq*fac - duu10n(n) = u10n*u10n ! 10m wind speed squared else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm @@ -609,6 +604,7 @@ subroutine flux_atmOcn_diurnal( & qref(n) = qrf duu10n(n) = urf**2+vrf**2 u10n = sqrt(duu10n(n)) + endif !------------------------------------------------------------ From d0b2fc913704bbabca6b13383929fc54d544340e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 16 Oct 2025 22:23:44 +0200 Subject: [PATCH 089/135] compile fixes for removing isotopes --- cesm/flux_atmocn/flux_atmocn_Large.F90 | 6 ++---- cesm/flux_atmocn/flux_atmocn_UA_mod.F90 | 3 --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 9 --------- 3 files changed, 2 insertions(+), 16 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index 0c2b092de..8bfedaa9b 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -36,7 +36,8 @@ module flux_atmOcn_large_mod subroutine flux_atmOcn_large( & logunit, spval, nMax, & zbot, ubot, vbot, thbot, & - qbot, rainc, tbot, us, vs, pslv, & + qbot, rainc, rbot, & + tbot, us, vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, evap, & taux, tauy, tref, qref, & @@ -318,9 +319,6 @@ subroutine flux_atmOcn_large( & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval ! water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval ! HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval ! H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) diff --git a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 index d2f258f3d..269d3ad98 100644 --- a/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_UA_mod.F90 @@ -419,9 +419,6 @@ subroutine flux_atmOcn_UA( & lat (n) = spval ! latent heat flux (W/m^2) lwup (n) = spval ! long-wave upward heat flux (W/m^2) evap (n) = spval ! evaporative water flux ((kg/s)/m^2) - evap_16O (n) = spval !water tracer flux (kg/s)/m^2) - evap_HDO (n) = spval !HDO tracer flux (kg/s)/m^2) - evap_18O (n) = spval !H218O tracer flux (kg/s)/m^2) taux (n) = spval ! x surface stress (N) tauy (n) = spval ! y surface stress (N) tref (n) = spval ! 2m reference height temperature (K) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index c4d52b266..ea9f494d9 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -33,12 +33,6 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8) , intent(in) :: thbot(nMax) ! atm potential T (K) real(R8) , intent(in) :: qbot (nMax) ! atm specific humidity (kg/kg) real(R8) , intent(in) :: rainc(nMax) ! atm precip for convective gustiness (kg/m^3) - RBN 24Nov2008/MDF 31Jan2022 - real(R8) , intent(in) :: s16O (nMax) ! atm H216O tracer conc. (kg/kg) - real(R8) , intent(in) :: sHDO (nMax) ! atm HDO tracer conc. (kg/kg) - real(R8) , intent(in) :: s18O (nMax) ! atm H218O tracer conc. (kg/kg) - real(R8) , intent(in) :: r16O (nMax) ! ocn H216O tracer ratio/Rstd - real(R8) , intent(in) :: rHDO (nMax) ! ocn HDO tracer ratio/Rstd - real(R8) , intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) , intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) , intent(in) :: tbot (nMax) ! atm T (K) real(R8) , intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) @@ -53,9 +47,6 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_16O (nMax) ! water flux: evap ((kg/s/m^2) - real(R8),intent(out) :: evap_HDO (nMax) ! water flux: evap ((kg/s)/m^2) - real(R8),intent(out) :: evap_18O (nMax) ! water flux: evap ((kg/s/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) From bbb1622f7b318cfbbf0baccd7d6d5e9536d0b8e5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 17 Oct 2025 11:47:52 +0200 Subject: [PATCH 090/135] some cleanup of routine --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 51 +++++++++----------- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 15 +++--- 2 files changed, 30 insertions(+), 36 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 4b0efdf2f..e98e79aea 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -20,11 +20,10 @@ module flux_atmocn_COARE_mod ! * added diagnostics, comments and references !------------------------------------------------------------------------------- - use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds - use shr_const_mod, only : shr_const_stebol, shr_const_latvap, shr_const_g - use shr_const_mod, only : shr_const_rgas, shr_const_cpdair - use shr_flux_mod, only : td0, maxscl, alpha - use shr_flux_mod, only : use_coldair_outbreak_mod + use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds + use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair + use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod + use shr_const_mod, only : shr_const_rgas implicit none private @@ -43,7 +42,7 @@ subroutine flux_atmOcn_COARE( & logunit, spval, nMax, zbot, ubot, vbot, thbot, & qbot, rainc, rbot, tbot ,us ,vs, pslv, & ts, mask, seq_flux_atmocn_minwind, & - sen, lat, lwup, evap, & + sen, lat, lwup, evap, & taux ,tauy, tref, qref, & duu10n, ugust_out, u10res, & ustar_sv, re_sv, ssq_sv) @@ -90,7 +89,7 @@ subroutine flux_atmOcn_COARE( & real(R8),parameter :: zpbl =700.0_R8 ! PBL depth [m] for gustiness parametriz. !--- local variables -------------------------------- - integer(IN) :: n ! vector loop index + integer :: n ! vector loop index real(R8) :: vmag ! surface wind magnitude (m/s) real(R8) :: ssq ! sea surface humidity (kg/kg) real(R8) :: delt ! potential T difference (K) @@ -170,10 +169,10 @@ subroutine flux_atmOcn_COARE( & !--- heat flux --- sen (n) = hsb lat (n) = hlb - lwup(n) = -shr_const_stebol * ts(n)**4 + lwup(n) = -loc_stebol * ts(n)**4 !--- water flux --- - evap(n) = lat(n)/shr_const_latvap + evap(n) = lat(n)/loc_latvap !------------------------------------------------------------ ! compute diagnositcs: 2m ref T & Q, 10m wind speed squared @@ -238,20 +237,16 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params real(R8), intent(out) :: trf,qrf,urf,vrf ! Local variables - real(R8):: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars - - real(R8):: cpa,rgas,grav,pi,von,beta ! phys. params - real(R8):: le,rhoa,cpv ! derived phys. params - real(R8):: t,visa,du,dq,dt ! params of problem - - real(R8):: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars - real(R8):: zet,rr,bf,ug,ut ! loop iter vars - real(R8):: cdn_10,chn_10,cen_10 ! aux. output vars - - integer(IN):: i,nits ! iter loop counters - - integer(IN):: jcool ! aux. cool-skin vars - real(R8) :: dter,wetc,dqer + real(R8) :: ua,va,ta,q,rb,us,vs,ts,qs,zi,zu,zt,zq,zru,zrq,zrt ! internal vars + real(R8) :: cpa,rgas,grav,pi,von,beta ! phys. params + real(R8) :: le,rhoa,cpv ! derived phys. params + real(R8) :: t,visa,du,dq,dt ! params of problem + real(R8) :: u10,zo10,zot10,cd10,ch10,ct10,ct,cc,ribu,zetu,l10,charn ! init vars + real(R8) :: zet,rr,bf,ug,ut ! loop iter vars + real(R8) :: cdn_10,chn_10,cen_10 ! aux. output vars + integer :: i,nits ! iter loop counters + integer :: jcool ! aux. cool-skin vars + real(R8) :: dter,wetc,dqer !---------------------------------------------------------------- ua = ubt !wind components (m/s) at height zu (m) @@ -275,14 +270,14 @@ subroutine cor30a(ubt,vbt,tbt,qbt,rbt, & ! in atm params Beta= 1.2_R8 von = 0.4_R8 pi = 3.141593_R8 - grav= SHR_CONST_G - Rgas= SHR_CONST_RGAS - cpa = SHR_CONST_CPDAIR + grav= loc_g + Rgas= shr_const_rgas + cpa = loc_cpdair !*** physical parameters - Le = SHR_CONST_LATVAP -.00237e6_R8*(ts-273.16_R8) + Le = loc_latvap -.00237e6_R8*(ts-273.16_R8) - ! cpv = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*Qs) ! form in NCAR code + ! cpv = loc_cpdair*(1.0_R8 + loc_cpvir*Qs) ! form in NCAR code cpv = cpa*(1.0_R8+0.84_R8*Q) ! rhoa= P/(Rgas*ta*(1+0.61*Q)) ! if input were pressure diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index f2b52bc50..4c39da8e0 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -47,7 +47,7 @@ subroutine flux_atmOcn_diurnal( & ts, mask, seq_flux_atmocn_minwind, & sen, lat, lwup, & evap, taux, tauy, tref, qref, & - uGust, lwdn, swdn, swup, prec, & + lwdn, swdn, swup, prec, & swpen, ocnsal, ocn_prognostic, & latt, long, warm, salt, speed, regime, & warmMax, windMax, qSolAvg, windAvg, & @@ -62,6 +62,9 @@ subroutine flux_atmOcn_diurnal( & real(r8) ,intent(in) :: spval integer ,intent(in) :: ocn_surface_flux_scheme integer ,intent(in) :: nMax ! data vector length + integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) + integer ,intent(in) :: dt ! NEW + logical ,intent(in) :: cold_start ! NEW cold start flag integer ,intent(in) :: mask (nMax) ! ocn domain mask 0 <=> out of domain real(R8) ,intent(in) :: zbot (nMax) ! atm level height(m) real(R8) ,intent(in) :: ubot (nMax) ! atm u wind(m/s) @@ -73,7 +76,7 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) real(R8) ,intent(in) :: ts (nMax) ! ocn temperature(K) - real(R8) ,intent(in) :: uGust (nMax) ! NEW not used + real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) real(R8) ,intent(in) :: lwdn (nMax) ! NEW real(R8) ,intent(in) :: swdn (nMax) ! NEW real(R8) ,intent(in) :: swup (nMax) ! NEW @@ -81,16 +84,12 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(in) :: latt (nMax) ! NEW real(R8) ,intent(in) :: long (nMax) ! NEW logical ,intent(in) :: ocn_prognostic ! NEW - integer ,intent(in) :: secs ! NEW elsapsed seconds in day (GMT) - integer ,intent(in) :: dt ! NEW real(R8) ,intent(inout) :: swpen (nMax) ! NEW real(R8) ,intent(inout) :: ocnsal(nMax) ! NEW (kg/kg) real(R8) ,intent(inout) :: warm (nMax) ! NEW real(R8) ,intent(inout) :: salt (nMax) ! NEW real(R8) ,intent(inout) :: speed (nMax) ! NEW real(R8) ,intent(inout) :: regime(nMax) ! NEW - real(R8) ,intent(out) :: warmMax(nMax) ! NEW - real(R8) ,intent(out) :: windMax(nMax) ! NEW real(R8) ,intent(inout) :: qSolAvg(nMax) ! NEW real(R8) ,intent(inout) :: windAvg(nMax) ! NEW real(R8) ,intent(inout) :: warmMaxInc(nMax) ! NEW @@ -98,14 +97,14 @@ subroutine flux_atmOcn_diurnal( & real(R8) ,intent(inout) :: qSolInc(nMax) ! NEW real(R8) ,intent(inout) :: windInc(nMax) ! NEW real(R8) ,intent(inout) :: nInc(nMax) ! NEW + real(R8) ,intent(out) :: warmMax(nMax) ! NEW + real(R8) ,intent(out) :: windMax(nMax) ! NEW real(R8) ,intent(out) :: tBulk (nMax) ! NEW real(R8) ,intent(out) :: tSkin (nMax) ! NEW real(R8) ,intent(out) :: tSkin_day (nMax) ! NEW real(R8) ,intent(out) :: tSkin_night (nMax) ! NEW real(R8) ,intent(out) :: cSkin (nMax) ! NEW real(R8) ,intent(out) :: cSkin_night (nMax) ! NEW - logical ,intent(in) :: cold_start ! cold start flag - real(R8) ,intent(in) :: seq_flux_atmocn_minwind ! minimum wind speed for atmocn (m/s) real(R8) ,intent(out) :: sen (nMax) ! heat flux: sensible (W/m^2) real(R8) ,intent(out) :: lat (nMax) ! heat flux: latent (W/m^2) real(R8) ,intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) From c86ae40585ea6d03807038dab7df3eefe535256f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 18 Oct 2025 14:34:43 +0200 Subject: [PATCH 091/135] addressed PR issue --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 28 ++++++++++++++------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index ea9f494d9..86ea6b2b9 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -2,6 +2,8 @@ module flux_atmocn_driver_mod use shr_kind_mod, only : R8=>SHR_KIND_R8, IN=>SHR_KIND_IN ! shared kinds use shr_const_mod, only : shr_const_spval + use shr_sys_mod, only : shr_sys_abort + use shr_strconvert_mod, only : toString use flux_atmocn_Large_mod, only : flux_atmocn_Large use flux_atmocn_COARE_mod, only : flux_atmocn_COARE use flux_atmocn_UA_mod, only : flux_atmocn_UA @@ -9,6 +11,10 @@ module flux_atmocn_driver_mod implicit none public + integer, private, parameter :: ocn_flux_scheme_large_and_pond = 0 + integer, private, parameter :: ocn_flux_scheme_coare = 1 + integer, private, parameter :: ocn_flux_scheme_ua = 2 + contains subroutine flux_atmOcn_driver(logunit, nMax, & @@ -65,20 +71,20 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8) :: spval ! local missing value !-------------------------------------------------------------------------------- - !!................................................................. - !! ocn_surface_flux_scheme = 0 : Large and Pond - !! = 1 : COARE algorithm - !! = 2 : UA algorithm - !!................................................................. - if (present(missval)) then spval = missval else spval = shr_const_spval endif + !!................................................................. + !! ocn_surface_flux_scheme = 0 : Large and Pond + !! = 1 : COARE algorithm + !! = 2 : UA algorithm + !!................................................................. + ! Default flux scheme. - if (ocn_surface_flux_scheme == 0) then + if (ocn_surface_flux_scheme == ocn_flux_scheme_large_and_pond) then call flux_atmOcn_Large( & logunit, spval, nMax, & @@ -91,7 +97,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & add_gusts, duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) - else if (ocn_surface_flux_scheme == 1) then + else if (ocn_surface_flux_scheme == ocn_flux_scheme_coare) then call flux_atmOcn_COARE( & logunit, spval, nMax, & @@ -104,7 +110,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & duu10n, ugust_out, u10res, & ustar_sv=ustar_sv, re_sv=re_sv, ssq_sv=ssq_sv) - else if (ocn_surface_flux_scheme == 2) then + else if (ocn_surface_flux_scheme == ocn_flux_scheme_ua) then call flux_atmOcn_UA( & logunit, spval, nMax, & @@ -124,6 +130,10 @@ subroutine flux_atmOcn_driver(logunit, nMax, & end if end do + else + + call shr_sys_abort("ocn_srfuace_flux_scheme = "// toString(ocn_surface_flux_scheme)//" is not supported") + end if end subroutine flux_atmOcn_driver From 11a214f57a95380e78093318913244ea780ed9b6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 11:55:39 +0200 Subject: [PATCH 092/135] update for consistency with escomp PR --- cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 | 104 +++++++++++-------- 1 file changed, 59 insertions(+), 45 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 index 4c39da8e0..ed0dd9a4a 100644 --- a/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Diurnal_mod.F90 @@ -26,6 +26,7 @@ module flux_atmocn_diurnal_mod use shr_const_mod, only : shr_const_ocn_ref_sal, shr_const_zsrflyr, shr_const_rgas use shr_sys_mod, only : shr_sys_abort use flux_atmocn_COARE_mod, only : cor30a + use shr_wv_sat_mod, only : shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -235,6 +236,7 @@ subroutine flux_atmOcn_diurnal( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + ! NOTE: this should use the shr_wv_sat_qsat_liquid if this routine is ever used in production qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 @@ -264,7 +266,7 @@ subroutine flux_atmOcn_diurnal( & if (.not. ocn_prognostic) then ! Set swpen and ocean salinity from following analytic expressions swpen(:) = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr)/1.0_R8)) + & - 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) ocnsal(:) = shr_const_ocn_ref_sal/1000.0_R8 else ! use swpen and ocnsal from input argument @@ -346,27 +348,31 @@ subroutine flux_atmOcn_diurnal( & nsum = nint(nInc(n)) if ( lmidnight ) then - Regime(n) = 1.0_R8 ! RESET DIURNAL + Regime(n) = 1.0_R8 ! RESET DIURNAL warm(n) = 0.0_R8 salt(n) = 0.0_R8 speed(n) = 0.0_R8 endif - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) - delt = thbot(n) - tBulk(n) ! pot temp diff (K) - delq = qbot(n) - ssq ! spec hum dif (kg/kg) - cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + + delt = thbot(n) - tBulk(n) ! pot temp diff (K) + delq = qbot(n) - ssq ! spec hum dif (kg/kg) + cp = shr_const_cpdair*(1.0_R8 + shr_const_cpvir*ssq) !!................................................................. !! ocn_surface_flux_scheme = 0 : Default E3SMv1 !! = 1 : COARE algorithm !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm - stable = 0.5_R8 + sign(0.5_R8 , delt) + !--- shift wind speed using old coefficient and stability function + rd = rdn / (1.0_R8 + rdn/shr_const_karman*(alz-psimh)) u10n = vmag * rd / rdn @@ -382,13 +388,13 @@ subroutine flux_atmOcn_diurnal( & else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm - call cor30a(ubot(n), vbot(n), tbot(n), qbot(n), rbot(n), & ! in atm params - us(n), vs(n), tBulk(n), ssq, & ! in surf params (NB ts -> tBulk) - zpbl, zbot(n), zbot(n), zref, ztref, ztref, & ! in heights - tau, hsb, hlb, & ! out: fluxes - zo, zot, zoq, hol, ustar, tstar, qstar, & ! out: ss scales - rd, rh, re, & ! out: exch. coeffs - trf, qrf, urf, vrf) ! out: reference-height params + call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n) & ! in atm params + & ,us(n),vs(n),tBulk(n),ssq & ! in surf params (NB ts -> tBulk) + & ,zpbl,zbot(n),zbot(n),zref,ztref,ztref & ! in heights + & ,tau,hsb,hlb & ! out: fluxes + & ,zo,zot,zoq,hol,ustar,tstar,qstar & ! out: ss scales + & ,rd,rh,re & ! out: exch. coeffs + & ,trf,qrf,urf,vrf) ! out: reference-height params ! for the sake of maintaining same defs hol=zbot(n)/hol @@ -396,20 +402,18 @@ subroutine flux_atmOcn_diurnal( & rh=sqrt(rh) re=sqrt(re) - else ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. + ELSE ! N.B.: *no* valid ocn_surface_flux_scheme=2 option if diurnal=.true. call shr_sys_abort(subName//" flux_atmOcn_diurnal requires ocn_surface_flux_scheme = 0 or 1") - endif + ENDIF ustar_prev = ustar * 2.0_R8 iter = 0 - ! --- iterate --- ! Originally this code did three iterations while the non-diurnal version did two ! So in the new loop this is <= flux_con_max_iter instead of < so that the same defaults ! will give the same answers in both cases. - do while( abs((ustar - ustar_prev)/ustar) > flux_con_tol .and. iter <= flux_con_max_iter) iter = iter + 1 ustar_prev = ustar @@ -423,24 +427,27 @@ subroutine flux_atmOcn_diurnal( & Kvisc = 0.0_R8 dif3 = 0.0_R8 - ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) - Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) - Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn - Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn + ustarw = ustar*sqrt(max(tiny,rbot(n)/rhocn)) + Qnsol = lwdn(n) - shr_const_stebol*(tSkin(n))**4 + & + rbot(n)*ustar*(cp*tstar + shr_const_latvap*qstar) + Hd = (Qnsol + Qsol*(1.0_R8-swpen(n)) ) / rcpocn + Fd = (prec(n) + rbot(n)*ustar*qstar ) * SSS / rhocn !--- COOL SKIN EFFECT --- Dcool = lambdaV*molvisc(tBulk(n)) / ustarw - Qdel = Qnsol + Qsol * (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) + Qdel = Qnsol + Qsol * & + (0.137_R8 + 11.0_R8*Dcool - 6.6e-5/Dcool *(1.0_R8 - exp((-1.0_R8*Dcool)/8.0e-4))) Hb = (Qdel/rcpocn)+(Fd*betaS/alphaT) Hb = min(Hb , 0.0_R8) - ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & - ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) + ! lambdaV = lambdaC*(1.0_R8 + ( (0.0_R8-Hb)*16.0_R8*molvisc(tBulk(n))* & + ! shr_const_g*alphaT*molPr(tBulk(n))**2/ustarw**4)**0.75)**(-1._R8/3._R8) lambdaV = 6.5_R8 cSkin(n) = MIN(0.0_R8, lambdaV * molPr(tBulk(n)) * Qdel / ustarw / rcpocn ) !--- REGIME --- - doL = shr_const_zsrflyr * shr_const_karman*shr_const_g * (alphaT*Hd + betaS*Fd ) / ustarw**3 + doL = shr_const_zsrflyr*shr_const_karman*shr_const_g* & + (alphaT*Hd + betaS*Fd ) / ustarw**3 Rid = MAX(0.0_R8,Rid) Smult = dt * (pwr+1.0_R8) / (shr_const_zsrflyr*pwr) Sfact = dt * (pwr+1.0_R8) / (shr_const_zsrflyr)**2 @@ -481,13 +488,14 @@ subroutine flux_atmOcn_diurnal( & !--- IMPLICIT INTEGRATION --- - DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) - DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) - DViter = (speed(n) +(Smult*ustarw*ustarw))/(1.+ Sfact*Kvisc) + DTiter = (warm(n) +(Smult*Hd)) /(1.+ Sfact*Kdiff) + DSiter = (salt(n) -(Smult*Fd)) /(1.+ Sfact*Kdiff) + DViter = (speed(n) +(Smult*ustarw*ustarw)) /(1.+ Sfact*Kvisc) DTiter = MAX( 0.0_R8, DTiter) DViter = MAX( 0.0_R8, DViter) - Rid = (shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / (pwr*MAX(tiny,DViter))**2 + Rid =(shr_const_g*(alphaT*DTiter-betaS*DSiter)*pwr*shr_const_zsrflyr) / & + (pwr*MAX(tiny,DViter))**2 Ribulk = Rid * pwr Ribulk = 0.0_R8 tBulk(n) = ts(n) + DTiter @@ -495,7 +503,11 @@ subroutine flux_atmOcn_diurnal( & !--need to update ssq,delt,delq as function of tBulk ---- - ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! This should be changed to use the subroutine below + ssq = 0.98_R8 * qsat(tBulk(n)) / rbot(n) ! sea surf hum (kg/kg) + ! call shr_wv_sat_qsat_liquid(tBulk(n), pslv(n), qsat, ssq) + ! ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + delt = thbot(n) - tBulk(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) @@ -505,7 +517,6 @@ subroutine flux_atmOcn_diurnal( & !! ocn_surface_flux_scheme = 0 : Default CESM1.2 !! = 1 : COARE algorithm !!................................................................. - if (ocn_surface_flux_scheme .eq. 0) then! use Large algorithm !--- compute stability & evaluate all stability functions --- @@ -536,10 +547,11 @@ subroutine flux_atmOcn_diurnal( & tstar = rh * delt qstar = re * delq - !--- heat fluxes --- - tau = rbot(n) * ustar * ustar - sen(n) = cp * tau * tstar / ustar - lat(n) = shr_const_latvap * tau * qstar / ustar + !--- heat flux --- + + tau = rbot(n) * ustar * ustar + sen (n) = cp * tau * tstar / ustar + lat (n) = shr_const_latvap * tau * qstar / ustar else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm @@ -552,14 +564,14 @@ subroutine flux_atmOcn_diurnal( & & ,trf,qrf,urf,vrf) ! out: reference-height params ! for the sake of maintaining same defs - hol = zbot(n)/hol - rd = sqrt(rd) - rh = sqrt(rh) - re = sqrt(re) + hol=zbot(n)/hol + rd=sqrt(rd) + rh=sqrt(rh) + re=sqrt(re) - !--- heat fluxes --- - sen(n) = hsb - lat(n) = hlb + !--- heat flux --- + sen (n) = hsb + lat (n) = hlb else ! N.B.: NO ocn_surface_flux_scheme=2 option call shr_sys_abort(subName//", flux_diurnal requires ocn_surface_flux_scheme = 0 or 1") @@ -570,6 +582,8 @@ subroutine flux_atmOcn_diurnal( & call shr_sys_abort('No iterations performed ') end if + !--- COMPUTE FLUXES TO ATMOSPHERE AND OCEAN --- + !--- momentum flux --- taux(n) = tau * (ubot(n)-us(n)) / vmag tauy(n) = tau * (vbot(n)-vs(n)) / vmag @@ -595,6 +609,7 @@ subroutine flux_atmOcn_diurnal( & tref(n) = tref(n) - 0.01_R8*ztref ! pot temp to temp correction fac = (re/shr_const_karman) * (alz + al2 - psixh + psix2 ) qref(n) = qbot(n) - delq*fac + duu10n(n) = u10n*u10n ! 10m wind speed squared else if (ocn_surface_flux_scheme .eq. 1) then! use COARE algorithm @@ -603,7 +618,6 @@ subroutine flux_atmOcn_diurnal( & qref(n) = qrf duu10n(n) = urf**2+vrf**2 u10n = sqrt(duu10n(n)) - endif !------------------------------------------------------------ From 4e7bbe42cf9bbf6d91faa19c85107ee78fb55d7f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 12:42:57 +0200 Subject: [PATCH 093/135] updates for noresm workflows --- .github/workflows/bumpversion.yml | 19 -------- .github/workflows/extbuild.yml | 14 +++--- .github/workflows/srt.yml | 75 ++++++++++++++++++------------- 3 files changed, 52 insertions(+), 56 deletions(-) delete mode 100644 .github/workflows/bumpversion.yml diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml deleted file mode 100644 index b17d491f0..000000000 --- a/.github/workflows/bumpversion.yml +++ /dev/null @@ -1,19 +0,0 @@ -name: Bump version -on: - push: - branches: - - main -jobs: - build: - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v2 - - name: Bump version and push tag - id: tag_version - uses: mathieudutour/github-tag-action@v5.5 - with: - github_token: ${{ secrets.GITHUB_TOKEN }} - create_annotated_tag: true - default_bump: patch - dry_run: false - tag_prefix: cmeps diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index 86ed1a533..c5569014f 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -5,9 +5,9 @@ name: extbuild # events but only for the main branch on: push: - branches: [ main ] + branches: [ noresm ] pull_request: - branches: [ main ] + branches: [ noresm ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -23,8 +23,8 @@ jobs: ESMF_VERSION: v8.8.0 PNETCDF_VERSION: checkpoint.1.14.0 NETCDF_FORTRAN_VERSION: v4.6.1 - PIO_VERSION: pio2_6_4 - CDEPS_VERSION: cdeps1.0.64 + PIO_VERSION: pio2_6_5 + CDEPS_VERSION: cdeps1.0.80 steps: - uses: actions/checkout@v4 # Build the ESMF library, if the cache contains a previous build @@ -75,7 +75,7 @@ jobs: with: path: /homme/runner/work/CMEPS/CMEPS/build-cdeps key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps1 - + - name: checkout CDEPS uses: actions/checkout@v4 with: @@ -85,7 +85,7 @@ jobs: - name: get genf90 run: | cd cdeps-src - git submodule update --init + git submodule update --init - name: Build CDEPS if: steps.cache-cdeps.outputs.cache-hit != 'true' uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.26 @@ -95,7 +95,7 @@ jobs: src_root: ${GITHUB_WORKSPACE}/cdeps-src cmake_flags: " -Wno-dev -DDISABLE_FoX=ON -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" - + - name: Build CMEPS run: | export PIO=$HOME/pio diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 2983dea6f..d4c54331e 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -6,9 +6,9 @@ name: scripts regression tests # events but only for the main branch on: push: - branches: [ main ] + branches: [ noresm ] pull_request: - branches: [ main ] + branches: [ noresm ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -25,10 +25,10 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include " - LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.6.1 - PARALLELIO_VERSION: pio2_6_3 + ESMF_VERSION: v8.8.0 + PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -40,9 +40,9 @@ jobs: id: load-env run: | set -x - sudo apt-get update + sudo apt-get update sudo apt-get install libxml2-utils - sudo apt-get install netcdf-bin + sudo apt-get install netcdf-bin sudo apt-get install libnetcdf-dev sudo apt-get install libnetcdff-dev sudo apt-get install pnetcdf-bin @@ -63,30 +63,30 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt - # use the latest cesm main - - name: cesm checkout + # use the latest noresm main + - name: noresm checkout uses: actions/checkout@v4 with: - repository: ESCOMP/CESM - path: cesm + repository: NorESMhub/NorESM + path: noresm # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 with: - path: cesm/components/cmeps - - # Checkout cesm datamodels and support + path: noresm/components/cmeps + + # Checkout noresm datamodels and support # cpl7 is needed - i think that's a bug - name: checkout externals run: | git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" - pushd cesm + pushd noresm ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config - git checkout main + git checkout noresm cd ../cime - git checkout master + git checkout noresm git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then @@ -96,11 +96,11 @@ jobs: fi git submodule update --init cd ../components/cdeps - git checkout main + git checkout noresm git submodule update --init cd ../../share - git checkout main - + git checkout noresm + - name: Cache ESMF id: cache-esmf uses: actions/cache@v4 @@ -119,17 +119,17 @@ jobs: id: cache-inputdata uses: actions/cache@v4 with: - path: $HOME/cesm/inputdata + path: $HOME/noresm/inputdata key: inputdata - name: Build ParallelIO if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: ${GITHUB_WORKSPACE}/pio - + - name: Install ESMF uses: esmf-org/install-esmf-action@v1 env: @@ -150,10 +150,10 @@ jobs: - name: PREP for scripts regression test run: | - mkdir -p $HOME/cesm/scratch - mkdir -p $HOME/cesm/inputdata - pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - export SRCROOT=$GITHUB_WORKSPACE/cesm/ + mkdir -p $HOME/noresm/scratch + mkdir -p $HOME/noresm/inputdata + pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/noresm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$GITHUB_WORKSPACE/pio/include export PIO_LIBDIR=$GITHUB_WORKSPACE/pio/lib @@ -162,7 +162,7 @@ jobs: export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake + cat <> $GITHUB_WORKSPACE/noresm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake set(NetCDF_Fortran_INCLUDE_DIR /usr/include) set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) EOF @@ -170,9 +170,24 @@ jobs: popd - name: scripts regression tests run: | - pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest --no-teardown popd + + # How to download artifacts: + # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts + +# - name: Upload test logs +# if: ${{ failure() }} +# steps: +# - name: Tar test logs +# run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch +# - name: save artifact +# uses: actions/upload-artifact@v4 +# with: +# name: test-logs-${{ matrix.python-version }} +# path: scratch-${{ matrix.python-version }}.tar.gz +# retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From 578607ab3d8830e56e69cf67e6cbd06726cef5d1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:15:27 +0200 Subject: [PATCH 094/135] changed comment --- mediator/med_phases_restart_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5b7f28bc3..4dc72c43a 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -457,7 +457,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Write ocn albedo field bundle (CESM only) + ! Write ocn albedo field bundle (CESM/NorESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) From 38e4c74902dc18dfa89302d9567751de4c95f5bd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:17:11 +0200 Subject: [PATCH 095/135] fixed typo --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 86ea6b2b9..82a2b97d8 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -54,7 +54,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, meridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 From 7f75593a370f3dd13429ca4d0c77a08c606208e5 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:18:15 +0200 Subject: [PATCH 096/135] fixed comment --- cesm/flux_atmocn/flux_atmocn_driver_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 index 86ea6b2b9..82a2b97d8 100644 --- a/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_driver_mod.F90 @@ -54,7 +54,7 @@ subroutine flux_atmOcn_driver(logunit, nMax, & real(R8),intent(out) :: lwup (nMax) ! heat flux: lw upward (W/m^2) real(R8),intent(out) :: evap (nMax) ! water flux: evap ((kg/s)/m^2) real(R8),intent(out) :: taux (nMax) ! surface stress, zonal (N) - real(R8),intent(out) :: tauy (nMax) ! surface stress, maridional (N) + real(R8),intent(out) :: tauy (nMax) ! surface stress, meridional (N) real(R8),intent(out) :: tref (nMax) ! diag: 2m ref height T (K) real(R8),intent(out) :: qref (nMax) ! diag: 2m ref humidity (kg/kg) real(R8),intent(out) :: duu10n(nMax) ! diag: 10m wind speed squared (m/s)^2 From 1a9153bcff7f490d75fb5e141d819f2ad0cfb1b1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 19 Oct 2025 14:29:48 +0200 Subject: [PATCH 097/135] minor formatting change --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 8ec49ebd5..824d4097a 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -144,6 +144,7 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif + call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) From ed805ef26dde04b5979cbfe82f9079e704f26b3a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 20 Oct 2025 10:24:38 +0200 Subject: [PATCH 098/135] update for history --- mediator/med_phases_history_mod.F90 | 77 ++++++++++------------------- 1 file changed, 27 insertions(+), 50 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index b41aae099..5f3bba1e7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,12 +13,12 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : ncomps, compname, compocn, complnd + use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -34,13 +34,9 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of - ! implnd->glc (on land grid), - ! impocn->glc (on ocn grid) and - ! inst only, average (normally yearly) of - ! export->glc (on glc grid) + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component @@ -533,21 +529,20 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) + subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod , only : compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod, only : complnd, compglc + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle - integer , optional , intent(in) :: comp_import ! either land or ocean component id - type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array - integer , intent(out) :: rc + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd + integer , intent(out) :: rc + type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) ! local variables type(file_desc_t) :: io_file @@ -568,7 +563,7 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -619,28 +614,15 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - if (present(comp_import)) then - if (.not. present(fldbun_import)) then - call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) - return - end if - if (comp_import == complnd) then - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' - else if (comp_import == compocn) then - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' - end if - else - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' - end if - - ! Open output file + ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write data to file + ! Write data to history file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -653,23 +635,18 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (present(fldbun_import)) then - ! import field bundle - call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & - is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & - nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (present(fldbun_export)) then - ! export field bundle - do n = 1,size(fldbun_export) - call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & + call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & + is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (present(fldbun_glc)) then + do n = 1,size(fldbun_glc) + call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - else - call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) - return end if end do ! end of loop over m @@ -678,7 +655,7 @@ subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_data2glc + end subroutine med_phases_history_write_lnd2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) From 9d636ecba9e015bef84ffdd654e951c3a4188ac4 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Mon, 20 Oct 2025 07:36:21 -0600 Subject: [PATCH 099/135] uncomment tmate to debug workflow --- .github/workflows/srt.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index d4c54331e..ebc3c8b29 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -27,7 +27,7 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.8.0 + ESMF_VERSION: v8.9.0 PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -190,6 +190,6 @@ jobs: # retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 161b084041eb3043741795350be48f3e37bacdaa Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 21 Oct 2025 18:13:29 +0200 Subject: [PATCH 100/135] backed out changes for noresm --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 12 ++-- mediator/med_phases_history_mod.F90 | 98 +++++++++++++++----------- 2 files changed, 62 insertions(+), 48 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index d26b85814..57a218dd7 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -43,13 +43,13 @@ module shr_megan_mod integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) integer :: class_number ! MEGAN class number + real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list endtype shr_megan_megcomp_t type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr - real(r8) :: coeff ! emissions component coeffecient + type(shr_megan_megcomp_t), pointer :: ptr endtype shr_megan_comp_ptr ! chemical compound in CAM mechanism that has MEGAN emissions @@ -227,8 +227,7 @@ subroutine shr_megan_init( specifier) if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) - shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j) ) - shr_megan_mechcomps(i)%megan_comps(j)%coeff = item%coeffs(j) + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 @@ -244,9 +243,10 @@ end subroutine shr_megan_init !------------------------------------------------------------------------- - function add_megan_comp( name ) result(megan_comp) + function add_megan_comp( name, coeff ) result(megan_comp) character(len=16), intent(in) :: name + real(r8), intent(in) :: coeff type(shr_megan_megcomp_t), pointer :: megan_comp megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) @@ -264,7 +264,7 @@ function add_megan_comp( name ) result(megan_comp) megan_comp%index = shr_megan_megcomps_n+1 megan_comp%name = trim(name) - + megan_comp%coeff = coeff nullify(megan_comp%next_megcomp) call add_megan_comp_to_list(megan_comp) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f3bba1e7..3cd0b4fb2 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,12 +13,12 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : ncomps, compname + use med_internalstate_mod , only : ncomps, compname, compocn, complnd use med_internalstate_mod , only : InternalState, maintask, logunit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -34,9 +34,13 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of + ! implnd->glc (on land grid), + ! impocn->glc (on ocn grid) and + ! inst only, average (normally yearly) of + ! export->glc (on glc grid) ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component @@ -268,20 +272,14 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(currtimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + call ESMF_ClockGetNextTime(mclock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(nexttimestr,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& @@ -529,20 +527,21 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) + subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd, compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod , only : compglc + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd - integer , intent(out) :: rc - type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle + integer , optional , intent(in) :: comp_import ! either land or ocean component id + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array + integer , intent(out) :: rc ! local variables type(file_desc_t) :: io_file @@ -563,7 +562,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' !--------------------------------------- rc = ESMF_SUCCESS @@ -614,15 +613,28 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' - ! Create history file + if (present(comp_import)) then + if (.not. present(fldbun_import)) then + call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) + return + end if + if (comp_import == complnd) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' + else if (comp_import == compocn) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' + end if + else + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' + end if + + ! Open output file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Write data to history file + ! Write data to file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -635,18 +647,23 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & - is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & - nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(fldbun_glc)) then - do n = 1,size(fldbun_glc) - call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + if (present(fldbun_import)) then + ! import field bundle + call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & + is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & + nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (present(fldbun_export)) then + ! export field bundle + do n = 1,size(fldbun_export) + call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + else + call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) + return end if end do ! end of loop over m @@ -655,7 +672,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine med_phases_history_write_lnd2glc + end subroutine med_phases_history_write_data2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) @@ -1787,11 +1804,8 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(yr .le. 9999) then - write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - else - write(nexttime_str,'(i6.6,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - endif + write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec + if (trim(case_name) == 'unset') then call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From ff9320571a09166b82bea6ed1ef0893af4f5947d Mon Sep 17 00:00:00 2001 From: mvertens Date: Fri, 31 Oct 2025 11:12:44 +0100 Subject: [PATCH 101/135] updated shr_megan_mod.F90 to cmeps1.1.23 --- cesm/nuopc_cap_share/shr_megan_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 57a218dd7..d26b85814 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -43,13 +43,13 @@ module shr_megan_mod integer :: index real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) integer :: class_number ! MEGAN class number - real(r8) :: coeff ! emissions component coeffecient real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list endtype shr_megan_megcomp_t type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr + type(shr_megan_megcomp_t), pointer :: ptr + real(r8) :: coeff ! emissions component coeffecient endtype shr_megan_comp_ptr ! chemical compound in CAM mechanism that has MEGAN emissions @@ -227,7 +227,8 @@ subroutine shr_megan_init( specifier) if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) - shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j) ) + shr_megan_mechcomps(i)%megan_comps(j)%coeff = item%coeffs(j) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 @@ -243,10 +244,9 @@ end subroutine shr_megan_init !------------------------------------------------------------------------- - function add_megan_comp( name, coeff ) result(megan_comp) + function add_megan_comp( name ) result(megan_comp) character(len=16), intent(in) :: name - real(r8), intent(in) :: coeff type(shr_megan_megcomp_t), pointer :: megan_comp megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) @@ -264,7 +264,7 @@ function add_megan_comp( name, coeff ) result(megan_comp) megan_comp%index = shr_megan_megcomps_n+1 megan_comp%name = trim(name) - megan_comp%coeff = coeff + nullify(megan_comp%next_megcomp) call add_megan_comp_to_list(megan_comp) From a6505ae928e3df04ef315e563290d68f35069dfb Mon Sep 17 00:00:00 2001 From: mvertens Date: Sat, 1 Nov 2025 14:36:06 +0100 Subject: [PATCH 102/135] backed out cmeps1.1.23 changes to flux_atmocn_COARE_mod.F90 and flux_atmocn_Large.F90 --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 8 ++++---- cesm/flux_atmocn/flux_atmocn_Large.F90 | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 824d4097a..e98e79aea 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -24,7 +24,6 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod use shr_const_mod, only : shr_const_rgas - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private @@ -116,6 +115,9 @@ subroutine flux_atmOcn_COARE( & real(R8) :: tdiff(nMax) ! tbot - ts real(R8) :: vscl + !--- functions --- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + !--- formats ---------------------------------------- character(*),parameter :: subName = '(flux_atmOcn_COARE) ' character(*),parameter :: F00 = "('(flux_atmOcn_COARE) ',4a)" @@ -144,9 +146,7 @@ subroutine flux_atmOcn_COARE( & vmag=vmag*vscl endif endif - - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) call cor30a(ubot(n),vbot(n),tbot(n),qbot(n),rbot(n), & ! in atm params us(n),vs(n),ts(n),ssq, & ! in surf params diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index d58d512ba..8bfedaa9b 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,7 +25,6 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort - use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none public @@ -143,6 +142,8 @@ subroutine flux_atmOcn_large( & real(R8) :: gprec ! convective rainfall argument for ugust ! ------------------------------------------------------------------------- + qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) + ! Large and Yeager 2009 cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 @@ -208,8 +209,7 @@ subroutine flux_atmOcn_large( & endif endif - call shr_wv_sat_qsat_liquid(ts(n), pslv(n), qsat, ssq) - ssq = 0.98_R8 * ssq ! sea surf hum (kg/kg) + ssq = 0.98_R8 * qsat(ts(n)) / rbot(n) ! sea surf hum (kg/kg) delt = thbot(n) - ts(n) ! pot temp diff (K) delq = qbot(n) - ssq ! spec hum dif (kg/kg) alz = log(zbot(n)/zref) From 36e7fa8ed6f0307948eb3efa6c6b53fac471ca9b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 20:21:13 +0100 Subject: [PATCH 103/135] removed unused variable is --- mediator/med_diag_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index e07898624..85edea7c0 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -1751,7 +1751,7 @@ subroutine med_diag_print_atm(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: ica,icl integer :: icn,ics,ico character(len=40) :: str ! string @@ -1873,7 +1873,7 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: ic,nf ! data array indicies integer :: icar,icas integer :: icxs,icxr character(len=40) :: str ! string @@ -1980,7 +1980,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: nf,is ! data array indicies + integer :: nf ! data array index real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh real(r8) :: sum_area From e02828dd9a7ad6f4bc6ad5324ed3e5834aa87fef Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 20:40:47 +0100 Subject: [PATCH 104/135] removed unused variable --- mediator/med_phases_ocnalb_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 39d6b6eea..25c691ca1 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -105,7 +105,6 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) logical :: use_min_ocnalb logical :: isPresent, isSet integer :: fieldCount - character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- From 1a04ba119e4e6473a961e55929907947f99f357e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sat, 1 Nov 2025 21:02:57 +0100 Subject: [PATCH 105/135] removed unused variable --- mediator/med_phases_prep_atm_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 0f031831a..b9665f5a8 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -288,7 +288,6 @@ subroutine med_phases_prep_atm_enthalpy_correction (gcomp, hcorr, rc) type(InternalState) :: is_local integer :: n real(r8) :: local_htot_corr(1) - real(r8) :: local_hrof_corr(1) type(ESMF_VM) :: vm !--------------------------------------- From 0f14d678a35ba3cd23357b4abd9547e6a9e505a7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 4 Nov 2025 17:40:50 +0100 Subject: [PATCH 106/135] made Taylor the default scheme for the ocean albedo calculation for NorESM --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e5c96c77e..015169a92 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -934,7 +934,7 @@ 1 : Taylor et al. (1996) - 0 + 1 From b9abe257043306a408ffe2d49006bb627898c95b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 28 Nov 2025 12:50:43 +0100 Subject: [PATCH 107/135] added new timers in mapping --- mediator/med_map_mod.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index a3d50c5e4..daacdd4af 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -1045,6 +1045,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, FBDat, use_data, field_ ! For mapconsf_uv3d do not use packed field bundles call med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapconsf_uv3d, map_stress=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else ! ----------------------------------- @@ -1314,6 +1315,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS ! get a pointer (data_fracsrc) to the normalization array @@ -1390,6 +1392,8 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, end if end do end if + + call t_stopf('MED:'//subname) end subroutine med_map_field_normalized !================================================================================ @@ -1534,6 +1538,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- + call t_startf('MED:'//subname) rc = ESMF_SUCCESS lmap_stress = .false. @@ -1659,6 +1664,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, map_stress, r deallocate(ownedElemCoords_src) deallocate(ownedElemCoords_dst) + call t_stopf('MED:'//subname) end subroutine med_map_uv_cart3d end module med_map_mod From ba21bc3d2058f0cee74bf081ca87ec93ac0c5fca Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Jan 2026 17:25:59 -0700 Subject: [PATCH 108/135] Change aofluxes_use_shr_wv_sat to false for noresm IMPORTANT: We'll want to exclude the changes in this commit when merging the noresm branch back to escomp. --- cime_config/namelist_definition_drv.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 252d05048..b3f372765 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -998,7 +998,7 @@ - .true. + .false. From 072da1ca7d06aa58f04ec17b10084bbc41e2cfc0 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Sat, 10 Jan 2026 17:52:23 -0700 Subject: [PATCH 109/135] Add use statements --- cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 | 1 + cesm/flux_atmocn/flux_atmocn_Large.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 index 1a57a992c..1cbb8eac9 100644 --- a/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 +++ b/cesm/flux_atmocn/flux_atmocn_COARE_mod.F90 @@ -24,6 +24,7 @@ module flux_atmocn_COARE_mod use shr_flux_mod, only : loc_stebol, loc_latvap, loc_g, loc_cpdair use shr_flux_mod, only : td0, maxscl, alpha, use_coldair_outbreak_mod use shr_const_mod, only : shr_const_rgas + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none private diff --git a/cesm/flux_atmocn/flux_atmocn_Large.F90 b/cesm/flux_atmocn/flux_atmocn_Large.F90 index b55dc5aba..3e1f5719a 100644 --- a/cesm/flux_atmocn/flux_atmocn_Large.F90 +++ b/cesm/flux_atmocn/flux_atmocn_Large.F90 @@ -25,6 +25,7 @@ module flux_atmOcn_large_mod use shr_flux_mod, only: flux_con_tol, flux_con_max_iter use shr_flux_mod, only: alpha, maxscl, td0 use shr_sys_mod, only: shr_sys_abort + use shr_wv_sat_mod, only: shr_wv_sat_qsat_liquid ! use saturation calculation consistent with CAM implicit none public From 97ddd2c5068438e382565a9a9d267f932d3fb555 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 29 Mar 2026 15:15:11 +0200 Subject: [PATCH 110/135] fixed compiler issues --- mediator/med_phases_post_rof_mod.F90 | 14 -------------- mediator/med_phases_prep_rof_mod.F90 | 17 +---------------- 2 files changed, 1 insertion(+), 30 deletions(-) diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 1bf0fd870..5d623fc76 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -109,7 +109,6 @@ subroutine med_phases_post_rof_init(gcomp, rc) end subroutine med_phases_post_rof_init !================================================================================================ - subroutine med_phases_post_rof(gcomp, rc) !--------------------------------------------------------------- ! Post runoff phase @@ -123,7 +122,6 @@ subroutine med_phases_post_rof(gcomp, rc) type(ESMF_Clock) :: dClock integer :: n logical :: exists - integer :: ungriddedUBound(1) character(len=*), parameter :: subname='(med_phases_post_rof)' !--------------------------------------- @@ -220,7 +218,6 @@ subroutine med_phases_post_rof(gcomp, rc) end subroutine med_phases_post_rof !================================================================================================ - subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) !--------------------------------------------------------------- ! Create FBrof_r @@ -280,16 +277,6 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) call med_field_info_esmf_fieldcreate(field_info=field_info, & mesh=mesh, meshloc=ESMF_MESHLOC_ELEMENT, field=field, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, ungriddedUBound=ungriddedUBound, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ungriddedUBound(1) > 0) then - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, & - ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=rof_field_names(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if call ESMF_FieldBundleAdd(FBrof_r, (/field/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do @@ -302,7 +289,6 @@ subroutine med_phases_post_rof_create_rof_field_bundle(gcomp, rc) end subroutine med_phases_post_rof_create_rof_field_bundle !================================================================================================ - subroutine med_phases_post_rof_remove_negative_runoff(gcomp, field_name, rc) !--------------------------------------------------------------- ! For one runoff field, remove negative runoff by downweighting all positive runoff to diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index b1e30e928..465a03158 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_accum => med_methods_FB_accum use med_methods_mod , only : fldbun_average => med_methods_FB_average + use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_field_info_mod , only : med_field_info_type @@ -96,7 +97,6 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: lrank integer :: n, nflds logical :: is_present type(ESMF_Mesh) :: mesh_l @@ -187,21 +187,6 @@ subroutine med_phases_prep_rof_init(gcomp, rc) mesh=mesh_l, meshloc=ESMF_MESHLOC_ELEMENT, & field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, rank=lrank, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lrank == 2) then - call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - - if (lrank == 2) then - lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, & - ungriddedLbound=(/1/), ungriddedUbound=ungriddedUBound, gridToFieldMap=(/2/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=lnd2rof_flds(n), meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if call ESMF_FieldBundleAdd(FBlndAccum2rof_l, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//' adding field '//trim(lnd2rof_flds(n))//' to FBLndAccum2rof_l', & From 681a793f5acf16e4d03785102bec9c8ebd7d9c6e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 1 Apr 2026 10:22:31 +0200 Subject: [PATCH 111/135] fixed comment --- cime_config/config_component_cesm.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 0472a0b5e..3d6ec3ccb 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -122,7 +122,7 @@ Activates additional CO2-related fields to be exchanged between components. Possible values are: CO2A: sets the driver namelist variable flds_co2a = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from + diagnostic CO2 at the lowest model level to be sent from the atmosphere to the land and ocean. CO2B: sets the driver namelist variable flds_co2b = .true.; this adds From f84cfbcd798100d7d295b4bc5280bbd1d37f3d98 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 5 May 2026 17:17:44 +0200 Subject: [PATCH 112/135] updates needed for noresm ww3 development --- cime_config/buildnml | 5 ++++- cime_config/config_component.xml | 4 ++-- cime_config/namelist_definition_drv.xml | 8 ++++---- mediator/esmFldsExchange_cesm_mod.F90 | 17 ++++++++++++++--- mediator/fd_cesm.yaml | 8 ++++---- mediator/med.F90 | 4 ++-- mediator/med_internalstate_mod.F90 | 5 +++-- mediator/med_map_mod.F90 | 4 ++-- mediator/med_phases_aofluxes_mod.F90 | 12 ++++++------ mediator/med_phases_history_mod.F90 | 3 ++- mediator/med_phases_prep_atm_mod.F90 | 4 ++-- mediator/med_phases_prep_ice_mod.F90 | 3 ++- mediator/med_phases_prep_ocn_mod.F90 | 2 +- 13 files changed, 48 insertions(+), 31 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 1c0f3173e..f9385cabc 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -142,7 +142,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" - if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': + # determine coupling mode + config["coupling_mode"] = case.get_value("COUPLING_MODE") + + if config["coupling_mode"] == "cesm" and config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': config["wav_ice_coupling"] = "on" if config["COMP_OCN"] == "blom": diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 626110251..b72db91f1 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -37,8 +37,8 @@ char - cesm - cesm + cesm,noresm + noresm run_coupling env_run.xml coupling mode diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index c9729c344..7eedbeda6 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2217,7 +2217,7 @@ ALLCOMP_attributes .false. - .true. + .true. Auxiliary mediator wav2med average history output every day. Note that ww3dev will use this configuration variable and send @@ -2229,7 +2229,7 @@ MED_attributes Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg - Sw_Hs:Sw_t01:Sw_t0m1:Sw_thm:Sw_lamult:Sw_ustokes:Sw_vstokes + Sw_Hs:Sw_t01:Sw_t0m1:Sw_thm:Sw_lamult:Sw_ustokes:Sw_vstokes Auxiliary mediator wav2med file1 colon delimited output fields. NOTE: these are assumed to be time averaged over a day in @@ -2261,7 +2261,7 @@ MED_attributes .false. - .true. + .true. Auxiliary mediator wav2med file1 time averaged flag for file output. If this flag is set to .false. only instantaneous output will be created in the auxiliary file. @@ -2272,7 +2272,7 @@ MED_attributes wav.24h.avg - ww3 + ww3 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 8850d3c70..6f0cc6cbd 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2276,11 +2276,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compwav, 'Sw_Tm1_avg') call addfld_from(compwav, 'Sw_thm_avg') call addfld_from(compwav, 'Sw_thp0_avg') + call addfld_from(compwav, 'Sw_faw_avg') call addfld_from(compwav, 'Sw_fp0_avg') call addfld_from(compwav, 'Sw_u_avg') call addfld_from(compwav, 'Sw_v_avg') + call addfld_from(compwav, 'Sw_cu_avg') + call addfld_from(compwav, 'Sw_cv_avg') call addfld_from(compwav, 'Sw_tusx_avg') call addfld_from(compwav, 'Sw_tusy_avg') + call addfld_from(compwav, 'Sw_lamult_avg') + call addfld_from(compwav, 'Sw_charn_avg') + call addfld_from(compwav, 'Sw_tm02_avg') + call addfld_from(compwav, 'Sw_foc_avg') + call addfld_from(compwav, 'Sw_ifrac_avg') + call addfld_from(compwav, 'Sw_thick_avg') + call addfld_from(compwav, 'Sw_tauicex_avg') + call addfld_from(compwav, 'Sw_tauicey_avg') end if !----------------------------- @@ -2335,7 +2346,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_t0m1', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_t0m1', mrg_from=compwav, mrg_fld='Sw_t0m1', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- @@ -2348,7 +2359,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_t01', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_t01', mrg_from=compwav, mrg_fld='Sw_t01', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- @@ -2361,7 +2372,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compwav, 'Sw_thm', compocn, mapbilnr_nstod, 'one', wav2ocn_map) call addmrg_to(compocn, 'Sw_thm', mrg_from=compwav, mrg_fld='Sw_thm', mrg_type='copy') end if - end if + end if !----------------------------- ! to ocn: !----------------------------- diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index fb8f1f06d..7ffb6cdb2 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1249,11 +1249,11 @@ description: Daily averaged swell swh (only needed for med history output) # - standard_name: Sw_pdir0_avg - canonical_units: degrees + canonical_units: radians description: Daily averaged wind sea swh (only needed for med history output) # - standard_name: Sw_pdir1_avg - canonical_units: degrees + canonical_units: radians description: Daily averaged swell swh (only needed for med history output) # - standard_name: Sw_pTm10_avg @@ -1269,11 +1269,11 @@ description: Daily averaged mean wave period of the first moment (only needed for med history output) # - standard_name: Sw_thm_avg - canonical_units: degrees + canonical_units: radians description: Daily averaged mean wave direction (only needed for med history output) # - standard_name: Sw_thp0_avg - canonical_units: degrees + canonical_units: radians description: Daily averaged peak wave direction (only needed for med history output) # - standard_name: Sw_fp0_avg diff --git a/mediator/med.F90 b/mediator/med.F90 index b56ab6530..7a053da7e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -832,7 +832,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! advertise phase call med_fldlist_init1(ncomps) - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call esmFldsExchange_cesm(gcomp, phase='advertise', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:3) == 'ufs') then @@ -1849,7 +1849,7 @@ subroutine DataInitialize(gcomp, rc) ! Initialize memory for fldlistFr(:)%flds(:) and fldlistTo(:)%flds(:) - this is needed for ! call below for the initialize phase - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (coupling_mode(1:3) == 'ufs') then diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 01ce1a42f..ae4c004f4 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -47,7 +47,8 @@ module med_internalstate_mod character(len=CS), public :: glc_name = '' ! Coupling mode - character(len=CS), public :: coupling_mode ! valid values are [cesm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6] + ! valid values are [cesm,noresm,ufs.nfrac,ufs.frac,ufs.nfrac.aoflux,ufs.frac.aoflux,hafs,hafs.mom6] + character(len=CS), public :: coupling_mode ! Atmosphere-ocean flux algorithm character(len=CS), public :: aoflux_code ! valid values are [cesm,ccpp] @@ -695,7 +696,7 @@ subroutine med_internalstate_defaultmasks(gcomp, rc) if ( trim(coupling_mode) == 'hafs') then ! not hafs.mom6 if (is_local%wrap%comp_present(compatm)) defaultMasks(compatm,1) = 1 endif - if ( coupling_mode /= 'cesm') then + if ( trim(coupling_mode) /= 'cesm' .and. trim(coupling_mode) /= 'noresm' ) then if (is_local%wrap%comp_present(compatm) .and. atm_name(1:4) == 'datm') then defaultMasks(compatm,1) = 0 end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 7dc27ace6..b81d3b11c 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -415,7 +415,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = defaultMasks(n2,2) ! override defaults for specific cases - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then if (n1 == compwav .and. n2 == compocn) then srcMaskValue = 0 dstMaskValue = ispval_mask @@ -441,7 +441,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, call ESMF_LogWrite(trim(string), ESMF_LOGMSG_INFO) polemethod=ESMF_POLEMETHOD_ALLAVG - if (trim(coupling_mode) == 'cesm' .or. coupling_mode(1:3) == 'ufs') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm' .or. coupling_mode(1:3) == 'ufs') then if (n1 == compwav .or. n2 == compwav) then polemethod = ESMF_POLEMETHOD_NONE ! todo: remove this when ESMF tripolar mapping fix is in place. endif diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 64de18785..46318525f 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -904,7 +904,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) call ESMF_FieldRegridStore(xgrid, field_a, field_x, routehandle=rh_agrid2xgrid_2ndord, & regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, srcTermProcessing=srcTermProcessing_Value, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), & srcTermProcessing=srcTermProcessing_Value, rc=rc) @@ -1302,7 +1302,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) ! Map atm->xgrid if (trim(fldnames_atm_in(nf)) == 'Sa_u' .or. (trim(fldnames_atm_in(nf)) == 'Sa_v')) then - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_patch, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) else @@ -1311,7 +1311,7 @@ subroutine med_aofluxes_map_agrid2xgrid_input(gcomp, rc) end if if (chkerr(rc,__LINE__,u_FILE_u)) return else - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call ESMF_FieldRegrid(field_src, field_dst, routehandle=rh_agrid2xgrid_bilinr, & termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) else @@ -1656,12 +1656,12 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r end if ! The following conditional captures the cases where aoflux_in%psfc is needed in calls - ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode=='cesm' is equivalent to + ! to flux_atmocn / flux_atmocn_ccpp. Note that coupling_mode==['cesm','noresm] is equivalent to ! the CESMCOUPLED CPP token, and coupling_mode(1:3)=='ufs' is roughly equivalent to ! the UFS_AOFLUX CPP token (noting that we should only be in this subroutine if using ! one of the aoflux variants of the ufs coupling_mode). - if ((trim(coupling_mode) == 'cesm') .or. & - (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp')) then + if ( (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') .or. & + (coupling_mode(1:3) == 'ufs' .and. trim(aoflux_code) == 'ccpp') ) then call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 6017869b1..9c426a91b 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -5,6 +5,7 @@ module med_phases_history_mod !----------------------------------------------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_kind_mod , only : CXX=>SHR_KIND_CXX use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance use ESMF , only : ESMF_ClockGetNextTime, ESMF_ClockGetAlarm, ESMF_ClockIsCreated @@ -1092,7 +1093,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) integer :: n,n1,nf character(CL) :: prefix character(CL) :: cvalue - character(CL) :: auxflds + character(CXX) :: auxflds integer :: fieldCount logical :: found logical :: enable_auxfile diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index b9665f5a8..359c81222 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -106,7 +106,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- map ocean albedos from ocn to atm grid if appropriate !--------------------------------------- - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then call med_map_field_packed( & FBSrc=is_local%wrap%FBMed_ocnalb_o, & FBDst=is_local%wrap%FBMed_ocnalb_a, & @@ -120,7 +120,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- - if (trim(coupling_mode) == 'cesm' .or. & + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm' .or. & trim(coupling_mode) == 'ufs.frac.aoflux') then if (is_local%wrap%aoflux_grid == 'ogrid') then call med_aofluxes_map_ogrid2agrid_output(gcomp, rc) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 4aaa8c264..bcaf5d286 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -87,7 +87,8 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Apply precipitation factor from ocean (that scales atm rain and snow to ice) if appropriate - if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then + if ( (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') .and. & + is_local%wrap%flds_scalar_index_precip_factor /= 0) then ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index c14657c51..56aadc699 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -634,7 +634,7 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end do ! Compute sw export to ocean bands if required if (export_swnet_by_bands) then - if (trim(coupling_mode) == 'cesm') then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode == 'noresm')) then c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) From 6756f7708962c906f77336d042a003e146b888e2 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 8 May 2026 10:27:10 +0200 Subject: [PATCH 113/135] fixed compiler issue --- mediator/med_phases_prep_ocn_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 56aadc699..8ddbeb37c 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -634,7 +634,7 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end do ! Compute sw export to ocean bands if required if (export_swnet_by_bands) then - if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode == 'noresm')) then + if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') then c1 = 0.285; c2 = 0.285; c3 = 0.215; c4 = 0.215 Foxx_swnet_vdr(:) = c1 * Foxx_swnet(:) Foxx_swnet_vdf(:) = c2 * Foxx_swnet(:) @@ -755,7 +755,8 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end if ! Apply precipitation factor from ocean (that scales atm rain and snow back to ocn ) if appropriate - if (trim(coupling_mode) == 'cesm' .and. is_local%wrap%flds_scalar_index_precip_factor /= 0) then + if ((trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'noresm') .and. & + is_local%wrap%flds_scalar_index_precip_factor /= 0) then ! Note that in med_internal_mod.F90 all is_local%wrap%flds_scalar_index_precip_factor ! is initialized to 0. From d26de95544bf9e3564a1c5a1bd0c9f3d2d880a66 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 8 May 2026 10:40:15 +0200 Subject: [PATCH 114/135] fixed bug in found in testing --- mediator/fd_cesm.yaml | 151 +++++++++++++++++------------------------- 1 file changed, 62 insertions(+), 89 deletions(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 7ffb6cdb2..6c9021683 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -1135,78 +1135,6 @@ canonical_units: 1 description: ocean import - Langmuir multiplier # - - standard_name: Sw_Hs - canonical_units: m - description: ocean import - Significant wave height - # - - standard_name: Sw_t0m1 - canonical_units: s - description: Wind sea mean wave period (Tm0,-1) - # - - standard_name: Sw_t01 - canonical_units: s - description: Wind sea mean wave period (Tm0,1) - # - - standard_name: Sw_thm - canonical_units: radians - description: Mean wave direction - # - - standard_name: Sw_Fp - canonical_units: 1 - description: ocean import - Peak wave frequency - # - - standard_name: Sw_Dp - canonical_units: 1 - description: ocean import - Peak wave direction - # - - standard_name: Sw_ustokes_wavenumber_1 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 1 - # - - standard_name: Sw_vstokes_wavenumber_1 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 1 - # - - standard_name: Sw_ustokes_wavenumber_2 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 2 - # - - standard_name: Sw_vstokes_wavenumber_2 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 2 - # - - standard_name: Sw_ustokes_wavenumber_3 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 3 - # - - standard_name: Sw_vstokes_wavenumber_3 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 3 - # - - standard_name: Sw_ustokes_wavenumber_4 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 4 - # - - standard_name: Sw_vstokes_wavenumber_4 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 4 - # - - standard_name: Sw_ustokes_wavenumber_5 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 5 - # - - standard_name: Sw_vstokes_wavenumber_5 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 5 - # - - standard_name: Sw_ustokes_wavenumber_6 - canonical_units: m/s - description: ocean import - partitioned Stokes drift zonal wavenumber 6 - # - - standard_name: Sw_vstokes_wavenumber_6 - canonical_units: m/s - description: ocean import - partitioned Stokes drift meridional wavenumber 6 - # - standard_name: Sw_ustokes canonical_units: m/s description: ocean import - Stokes drift u component @@ -1230,68 +1158,113 @@ # - standard_name: Sw_ustokes_avg canonical_units: m/s - description: Daily averaged stokes drift u component (only needed for med history output) + description: Daily averaged stokes drift u component (only needed for mediator history output) # - standard_name: Sw_vstokes_avg canonical_units: m/s - description: Daily averaged stokes drift v component (only needed for med history output) + description: Daily averaged stokes drift v component (only needed for mediator history output) # - standard_name: Sw_hs_avg canonical_units: m - description: Daily averaged significant wave hight (only needed for med history output) + description: Daily averaged significant wave hight (only needed for mediator history output) # - standard_name: Sw_phs0_avg canonical_units: m - description: Daily averaged averaged wind sea swh (only needed for med history output) + description: Daily averaged averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_phs1_avg canonical_units: m - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pdir0_avg canonical_units: radians - description: Daily averaged wind sea swh (only needed for med history output) + description: Daily averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_pdir1_avg canonical_units: radians - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pTm10_avg canonical_units: s - description: Daily averaged wind sea mean wave Tm1 period (only needed for med history output) + description: Daily averaged wind sea mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_pTm11_avg canonical_units: s - description: Daily average swell mean wave Tm1 period (only needed for med history output) + description: Daily average swell mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_Tm1_avg canonical_units: s - description: Daily averaged mean wave period of the first moment (only needed for med history output) + description: Daily averaged mean wave period of the first moment (only needed for mediator history output) # - standard_name: Sw_thm_avg canonical_units: radians - description: Daily averaged mean wave direction (only needed for med history output) + description: Daily averaged mean wave direction (only needed for mediator history output) # - standard_name: Sw_thp0_avg canonical_units: radians - description: Daily averaged peak wave direction (only needed for med history output) + description: Daily averaged peak wave direction (only needed for mediator history output) # - standard_name: Sw_fp0_avg canonical_units: 1/s - description: Daily averaged peak wave frequency (only needed for med history output) + description: Daily averaged peak wave frequency (only needed for mediator history output) # - standard_name: Sw_u_avg canonical_units: m/s - description: Daily averaged surface wind zonal (only needed for med history output) + description: Daily averaged surface wind zonal (only needed for mediator history output) # - standard_name: Sw_v_avg canonical_units: m/s - description: Daily averaged surface wind meridional (only needed for med history output) + description: Daily averaged surface wind meridional (only needed for mediator history output) + # + - standard_name: Sw_cu_avg + canonical_units: m/s + description: Daily averaged surface zonal current(only needed for mediator history output) + # + - standard_name: Sw_cv_avg + canonical_units: m/s + description: Daily averaged surface meridional current (only needed for mediator history output) # - standard_name: Sw_tusx_avg canonical_units: m2/s - description: Daily averaged stokes zonal transport vector (only needed for med history output) + description: Daily averaged stokes zonal transport vector (only needed for mediator history output) # - standard_name: Sw_tusy_avg canonical_units: m2/s - description: Daily averaged stokes meridional transport vector (only needed for med history output) + description: Daily averaged stokes meridional transport vector (only needed for mediator history output) + # + - standard_name: Sw_lamult_avg + canonical_units: 1 + description: Daily averaged Langmuir number (only needed for mediator history output) + # + - standard_name: Sw_charn_avg + canonical_units: 1 + description: Daily averaged Charnock parameter (only needed for mediator history output) + # + - standard_name: Sw_tm02_avg + canonical_units: s + alias: Total_m2-period + description: Daily averaged mean wave period of the second moment (only needed for mediator history output) + # + - standard_name: Sw_foc_avg + canonical_units: W/m3 + description: Daily averaged wave to ocean energy flux (only needed for mediator history output) + # + - standard_name: Sw_faw_avg + canonical_units: W/m3 + description: Daily averaged wind to wave energy flux (only needed for mediator history output) + # + - standard_name: Sw_ifrac_avg + canonical_units: 1 + description: Daily averaged sea ice concentration (only needed for mediator history output) + # + - standard_name: Sw_thick_avg + canonical_units: m + description: Daily averaged sea ice thickness (only needed for mediator history output) + # + - standard_name: Sw_tauicex_avg + canonical_units: m2/s2 + description: Daily averaged x component of momentum flux to sea ice (only needed for mediator history output) + # + - standard_name: Sw_tauicey_avg + canonical_units: m2/s2 + description: Daily averaged y component of momentum flux to sea ice (only needed for mediator history output) From df45638041ea75a2a5592928053925d852f304f1 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 10 May 2026 20:18:40 +0200 Subject: [PATCH 115/135] changed default for ww3 aux fields for noresm coupling_mode --- cime_config/namelist_definition_drv.xml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 7eedbeda6..eedd3862f 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -2217,6 +2217,7 @@ ALLCOMP_attributes .false. + .true. .true. Auxiliary mediator wav2med average history output every day. @@ -2228,7 +2229,8 @@ aux_hist MED_attributes - Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg + "" + Sw_hs_avg:Sw_Tm1_avg:Sw_thm_avg:Sw_u_avg:Sw_v_avg:Sw_ustokes_avg:Sw_vstokes_avg:Sw_tusx_avg:Sw_tusy_avg:Sw_thp0_avg:Sw_fp0_avg:Sw_phs0_avg:Sw_phs1_avg:Sw_pdir0_avg:Sw_pdir1_avg:Sw_pTm10_avg:Sw_pTm11_avg Sw_Hs:Sw_t01:Sw_t0m1:Sw_thm:Sw_lamult:Sw_ustokes:Sw_vstokes Auxiliary mediator wav2med file1 colon delimited output From 5aac7a5a137afbb9ce2e33598ba02b925a5f9e24 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 10 May 2026 20:24:10 +0200 Subject: [PATCH 116/135] made histaux_wav2med_file1_enabled true when running with WW3 for both noresm and cesm --- cime_config/namelist_definition_drv.xml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index eedd3862f..80bbd4920 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -989,16 +989,13 @@ MED_attributes If true, use shr_wv_sat_mod to calculate qsat for atm-ocn flux calculations. - If false, use the older inline calculation of qsat, which uses a different formulation. - (Currently only relevant for ocn_surface_flux_scheme = 0 or 1.) - - .false. + .false. + .true. @@ -2263,6 +2260,7 @@ MED_attributes .false. + .false. .true. Auxiliary mediator wav2med file1 time averaged flag for file output. From d36730d441aaca55e87d59ce60d088526e707648 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 11 May 2026 11:53:19 +0200 Subject: [PATCH 117/135] fixes to get noresm tests working --- .github/workflows/srt.yml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index acda38634..0b1138a41 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -63,6 +63,8 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt + - name: Install git-fleximod + run: pip install git-fleximod # use the latest noresm main - name: noresm checkout uses: actions/checkout@v4 @@ -82,7 +84,7 @@ jobs: git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd noresm - ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio + git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config git checkout noresm cd ../cime @@ -123,10 +125,10 @@ jobs: key: inputdata - name: Build ParallelIO - if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' + if: steps.cache-ParallelIO.outputs.cache-hit != 'true' uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: - parallelio_version: ${{ env.ParallelIO_VERSION }} + parallelio_version: ${{ env.PARALLELIO_VERSION }} enable_fortran: True install_prefix: ${GITHUB_WORKSPACE}/pio From 0e284569c94a5ba0d6e9d58a67be5a27a09abde9 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 11 May 2026 16:25:22 +0200 Subject: [PATCH 118/135] fixed the reference to git-fleximod --- .github/workflows/srt.yml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0b1138a41..0a4e36dec 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -63,8 +63,6 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt - - name: Install git-fleximod - run: pip install git-fleximod # use the latest noresm main - name: noresm checkout uses: actions/checkout@v4 @@ -84,7 +82,7 @@ jobs: git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd noresm - git-fleximod update cime ccs_config cdeps share mct parallelio + ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config git checkout noresm cd ../cime From a0cecec9f9badb1cc6795e62f13e0f40dec8eed5 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 11 May 2026 16:27:41 +0200 Subject: [PATCH 119/135] checking out noresm_develop by default for srt.yml --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0a4e36dec..50b06c2e5 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -69,6 +69,7 @@ jobs: with: repository: NorESMhub/NorESM path: noresm + ref: noresm_develop # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 From 919412e0f51aa937b2b00c53320847df7d35d559 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 11 May 2026 16:29:45 +0200 Subject: [PATCH 120/135] replaced tab with white space --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 50b06c2e5..70c0108e5 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -69,7 +69,7 @@ jobs: with: repository: NorESMhub/NorESM path: noresm - ref: noresm_develop + ref: noresm_develop # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 From 943cdd0539304b033af838d7cce599ee483d9103 Mon Sep 17 00:00:00 2001 From: Matvey Debolskiy Date: Mon, 11 May 2026 20:34:24 +0200 Subject: [PATCH 121/135] change ref to test actions --- .github/workflows/srt.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 70c0108e5..038a780a5 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -69,7 +69,7 @@ jobs: with: repository: NorESMhub/NorESM path: noresm - ref: noresm_develop + ref: cmeps-cime-actions-testing # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 From b54d025c8c7c5e92746e57f7f0830d2cfaee59ce Mon Sep 17 00:00:00 2001 From: Matvey Debolskiy Date: Mon, 11 May 2026 21:29:23 +0200 Subject: [PATCH 122/135] fix checkouts in workflow --- .github/workflows/srt.yml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 038a780a5..0f4bc94b1 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -83,11 +83,9 @@ jobs: git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd noresm - ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio + ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio -v cd ccs_config - git checkout noresm cd ../cime - git checkout noresm git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then From 70496594dad267e5317e2ea41035a94f7217a146 Mon Sep 17 00:00:00 2001 From: Matvey Debolskiy Date: Mon, 11 May 2026 22:12:24 +0200 Subject: [PATCH 123/135] Revert "fix checkouts in workflow" This reverts commit b54d025c8c7c5e92746e57f7f0830d2cfaee59ce. --- .github/workflows/srt.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0f4bc94b1..038a780a5 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -83,9 +83,11 @@ jobs: git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" pushd noresm - ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio -v + ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config + git checkout noresm cd ../cime + git checkout noresm git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then From 9e02e78e0aba212ea2b7a0d3511eb7f1c4547d13 Mon Sep 17 00:00:00 2001 From: Matvey Debolskiy Date: Tue, 12 May 2026 09:13:27 +0200 Subject: [PATCH 124/135] revert testing changes, put action on main, so it's not triggered --- .github/workflows/srt.yml | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 038a780a5..1d398b7d9 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -6,9 +6,9 @@ name: scripts regression tests # events but only for the main branch on: push: - branches: [ noresm ] + branches: [ main ] pull_request: - branches: [ noresm ] + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -69,7 +69,7 @@ jobs: with: repository: NorESMhub/NorESM path: noresm - ref: cmeps-cime-actions-testing + ref: noresm_develop # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 @@ -178,19 +178,20 @@ jobs: # How to download artifacts: # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts -# - name: Upload test logs -# if: ${{ failure() }} -# steps: -# - name: Tar test logs -# run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch -# - name: save artifact -# uses: actions/upload-artifact@v4 -# with: -# name: test-logs-${{ matrix.python-version }} -# path: scratch-${{ matrix.python-version }}.tar.gz -# retention-days: 4 + - name: Upload test logs + if: ${{ failure() }} + steps: + - name: Tar test logs + run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch + - name: save artifact + uses: actions/upload-artifact@v4 + with: + name: test-logs-${{ matrix.python-version }} + path: scratch-${{ matrix.python-version }}.tar.gz + retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details - - name: Setup tmate session - if: ${{ failure() }} - uses: mxschmitt/action-tmate@v3 +# - name: Setup tmate session +# if: ${{ failure() }} +# uses: mxschmitt/action-tmate@v3 + From 0ff1a6f0f27a784ede5593f6e06d9fe10c24f49f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 22 May 2026 11:58:18 +0200 Subject: [PATCH 125/135] merged to escomp cmeps1.1.48 --- .github/workflows/srt.yml | 10 +- cesm/driver/esm.F90 | 8 + cesm/share_wrappers/wtracers_mod.F90 | 19 +- cime_config/buildexe | 4 +- cime_config/buildnml | 43 + cime_config/config_component_cesm.xml | 27 +- cime_config/namelist_definition_drv.xml | 77 +- cime_config/testdefs/testlist_drv.xml | 11 + .../drv/glc_avg_frequently/README | 2 + .../drv/glc_avg_frequently/shell_commands | 1 + .../testmods_dirs/drv/water_tracers/README | 3 + .../drv/water_tracers/shell_commands | 1 + .../drv/water_tracers/user_nl_cpl | 2 + med_test_comps/xatm/src/atm_comp_nuopc.F90 | 57 +- med_test_comps/xglc/src/glc_comp_nuopc.F90 | 110 +- med_test_comps/xice/src/ice_comp_nuopc.F90 | 62 +- med_test_comps/xlnd/src/lnd_comp_nuopc.F90 | 141 ++- med_test_comps/xocn/src/ocn_comp_nuopc.F90 | 67 +- med_test_comps/xrof/src/rof_comp_nuopc.F90 | 73 +- med_test_comps/xshare/dead_nuopc_mod.F90 | 266 ++++- med_test_comps/xwav/src/wav_comp_nuopc.F90 | 32 +- mediator/esmFldsExchange_cesm_mod.F90 | 1004 ++++++++++------- mediator/fd_cesm.yaml | 177 ++- mediator/med.F90 | 15 +- mediator/med_field_info_mod.F90 | 16 +- mediator/med_io_mod.F90 | 235 ++-- mediator/med_methods_mod.F90 | 127 ++- mediator/med_phases_post_atm_mod.F90 | 6 + mediator/med_phases_post_glc_mod.F90 | 8 + mediator/med_phases_post_ice_mod.F90 | 6 + mediator/med_phases_post_lnd_mod.F90 | 6 + mediator/med_phases_post_ocn_mod.F90 | 6 + mediator/med_phases_post_rof_mod.F90 | 6 + mediator/med_phases_post_wav_mod.F90 | 6 + mediator/med_phases_prep_atm_mod.F90 | 6 + mediator/med_phases_prep_glc_mod.F90 | 402 +++++-- mediator/med_phases_prep_ice_mod.F90 | 6 + mediator/med_phases_prep_lnd_mod.F90 | 6 + mediator/med_phases_prep_ocn_mod.F90 | 16 +- mediator/med_phases_prep_rof_mod.F90 | 6 + mediator/med_phases_prep_wav_mod.F90 | 6 + mediator/med_phases_restart_mod.F90 | 4 +- ufs/wtracers_mod.F90 | 98 +- 43 files changed, 2384 insertions(+), 800 deletions(-) create mode 100644 cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/README create mode 100644 cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/drv/water_tracers/README create mode 100644 cime_config/testdefs/testmods_dirs/drv/water_tracers/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/drv/water_tracers/user_nl_cpl diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 1d398b7d9..0abf1fb30 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -2,13 +2,11 @@ name: scripts regression tests -# Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the main branch +# Controls when the action will run. Only runs when manually triggered. (See +# https://github.com/escomp/cmeps/issues/646 for discussion regarding why we don't run +# this automatically.) on: - push: - branches: [ main ] - pull_request: - branches: [ main ] + workflow_dispatch: # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index 9a7bbf783..6dd99b2fa 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -401,6 +401,7 @@ subroutine InitAttributes(driver, rc) use shr_wv_sat_mod , only : shr_wv_sat_make_tables, ShrWVSatTableSpec use shr_wv_sat_mod , only : shr_wv_sat_get_scheme_idx, shr_wv_sat_valid_idx use glc_elevclass_mod, only : glc_elevclass_init + use shr_wtracers_mod , only : shr_wtracers_init !use shr_scam_mod , only : shr_scam_checkSurface ! input/output variables @@ -544,6 +545,13 @@ subroutine InitAttributes(driver, rc) call shr_wv_sat_make_tables(liquid_spec, ice_spec, mixed_spec) end if + !---------------------------------------------------------- + ! Initialize water tracer info + !---------------------------------------------------------- + + call shr_wtracers_init(driver, maintask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end subroutine InitAttributes !================================================================================ diff --git a/cesm/share_wrappers/wtracers_mod.F90 b/cesm/share_wrappers/wtracers_mod.F90 index 860640720..0f0e3f485 100644 --- a/cesm/share_wrappers/wtracers_mod.F90 +++ b/cesm/share_wrappers/wtracers_mod.F90 @@ -4,15 +4,30 @@ module wtracers_mod ! This module wraps shr_wtracers_mod from the CESM_share repository to avoid direct ! dependencies on this share code from CMEPS. ! + ! It is acceptable for CESM-specific CMEPS code (e.g., in the cesm directory) to call + ! directly into shr_wtracers_mod, but CMEPS code shared between CESM and other modeling + ! systems (e.g., UFS) should go through this module. + ! ! See also the version of wtracers_mod in the ufs directory for when we do not have ! access to the CESM_share library. !----------------------------------------------------------------------------- - use shr_wtracers_mod, only : wtracers_is_wtracer_field => shr_wtracers_is_wtracer_field + use shr_wtracers_mod, only : wtracers_present => shr_wtracers_present + use shr_wtracers_mod, only : wtracers_get_num_tracers => shr_wtracers_get_num_tracers + use shr_wtracers_mod, only : wtracers_is_wtracer_field => shr_wtracers_is_wtracer_field + use shr_wtracers_mod, only : wtracers_get_bulk_fieldname => shr_wtracers_get_bulk_fieldname + use shr_wtracers_mod, only : wtracers_check_tracer_ratios => shr_wtracers_check_tracer_ratios + use shr_wtracers_mod, only : WTRACERS_SUFFIX implicit none private - public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + public :: wtracers_present ! return true if there are water tracers in this simulation + public :: wtracers_get_num_tracers ! get number of water tracers in this simulation + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + public :: wtracers_get_bulk_fieldname ! return the name of the equivalent bulk field corresponding to a water tracer field + public :: wtracers_check_tracer_ratios ! check tracer ratios against expectations + + public :: WTRACERS_SUFFIX ! suffix for water tracer field names end module wtracers_mod diff --git a/cime_config/buildexe b/cime_config/buildexe index c8664d705..44f0437e3 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -64,10 +64,10 @@ def _main_func(): skip_mediator = False if ocn_model == 'mom': - gmake_args += "USE_FMS=TRUE" + gmake_args += " USE_FMS=TRUE" if link_libs is not None: - gmake_args += 'USER_SLIBS="{}"'.format(link_libs) + gmake_args += ' USER_SLIBS="{}"'.format(link_libs) comp_classes = case.get_values("COMP_CLASSES") for comp in comp_classes: diff --git a/cime_config/buildnml b/cime_config/buildnml index f9385cabc..c454f3113 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -343,6 +343,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.set_value("esp_cpl_dt", value=esp_time) # End if pause is active + # -------------------------------- + # Overwrite: set water tracers + # -------------------------------- + _add_water_tracers(case.get_value("WATER_TRACERS"), nmlgen) + # -------------------------------- # Specify input data list file # -------------------------------- @@ -612,6 +617,44 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): with open(user_nl_cpl, 'a') as user_file: user_file.write("histaux_lnd2med_file2_flds = \'Flrl_rofsur:Flrl_rofi:Flrl_rofgwl:Flrl_rofsub:Flrl_rofsur_nonh2o\'\n") +############################################################################### +def _add_water_tracers(water_tracers_xml, nmlgen): + ############################################################################### + + if not water_tracers_xml.strip(): + water_tracers = [] + else: + water_tracers = water_tracers_xml.split(":") + tracer_names = [] + tracer_species = [] + tracer_initial_ratios = [] + + for tracer in water_tracers: + # Each item in the list consists of a name and then, optionally, a '%' followed by + # the isotope species for this tracer. For standard water tracers (i.e., tracers + # of bulk water), the list item will only contain the name (without a '%'). + expect( + tracer.count("%") <= 1, + f"Invalid WATER_TRACERS element, '{tracer}': Each element of WATER_TRACERS must contain at most 1 '%' separator", + ) + parts = tracer.split("%") + tracer_names.append(parts[0]) + if len(parts) > 1: + tracer_species.append(parts[1]) + # We could check the validity of the species name here (confirming that it's + # one of the handled species), but that would lead to this allowed list being + # replicated in multiple places (here as well as in the Fortran), which would + # make it more difficult to add new species later. So we're deferring this + # check to runtime. + else: + tracer_species.append("-") + tracer_initial_ratios.append("1.0") + + nmlgen.add_default("water_tracer_names", ":".join(tracer_names)) + nmlgen.add_default("water_tracer_species", ":".join(tracer_species)) + nmlgen.add_default("water_tracer_initial_ratios", ":".join(tracer_initial_ratios)) + + ############################################################################### def _create_runseq(case, coupling_times, valid_comps): ############################################################################### diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index 3d6ec3ccb..64ab48246 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -511,7 +511,7 @@ - + @@ -591,5 +591,30 @@ Freezing point calculation for salt water. + + char + + run_coupling + env_run.xml + + Colon-delimited list of water tracers enabled in this run. + + Each item in the list consists of a name and then, optionally, a '%' followed by the + isotope species for this tracer. For standard water tracers (i.e., tracers of bulk + water), the list item will only contain the name (without a '%'). The name can be + anything; if an isotope species is specified, it must match one of the implemented + water isotopes: H218O, H217O or HDO. By convention, a tracer that is the full + quantity of a given isotope will have a name that is identical to the species (e.g., + H218O:H218O). + + For example, this list could be: + MyRegularTracer:HDO%HDO:H218O%H218O:SomeOtherTracer:MyHdoTracer%HDO:YetAnotherTracer + + This specifies three standard (bulk water) tracers (MyRegularTracer, SomeOtherTracer + and YetAnotherTracer), two isotopes (HDO and H218O), and a tracer that is a subset + of HDO (MyHdoTracer). (Note that the ordering in the list is not important.) + + + diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 80bbd4920..dd3b58082 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -874,7 +874,6 @@ on - off @@ -2282,6 +2281,10 @@ Number of time samples per file. 30 + + 1 + 1 @@ -2632,18 +2635,6 @@ - - logical - flds - ALLCOMP_attributes - - Pass water isotopes between components - - - .false. - - - logical flds @@ -2694,6 +2685,66 @@ + + char + water_tracers + ALLCOMP_attributes + + Colon-delimited list of names of water tracers in this run. + + + + + + + + char + water_tracers + ALLCOMP_attributes + + Colon-delimited list of species of water tracers in this run. + + Each element in the list corresponds to an element in water_tracer_names. A value of + '-' for a given element indicates a standard water tracer (i.e., a tracer of bulk + water). + + + + + + + + char + water_tracers + ALLCOMP_attributes + + Colon-delimited list of initial water tracer ratios (as a fraction of total water). + + Each element in the list corresponds to an element in water_tracer_names. + + For water isotopes, this ratio is typically set to 1 for numerical reasons; the + actual isotopic ratios can then be determined via reference to standard global + ratios. + + + + + + + + logical + water_tracers + ALLCOMP_attributes + + Check consistency between water tracer fields and their corresponding bulk fields. + + This should only be used with artificial tracers that maintain a fixed ratio. + + + .false. + + + diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index b57b7ba12..62677eb3e 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -247,6 +247,17 @@ + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/README b/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/README new file mode 100644 index 000000000..312771240 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/README @@ -0,0 +1,2 @@ +This testmod turns on more frequent averaging of the fields sent to glc so that the +mapping of these fields can be tested in a run shorter than a year. diff --git a/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/shell_commands b/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/shell_commands new file mode 100644 index 000000000..19311727a --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/glc_avg_frequently/shell_commands @@ -0,0 +1 @@ +./xmlchange GLC_AVG_PERIOD=glc_coupling_period diff --git a/cime_config/testdefs/testmods_dirs/drv/water_tracers/README b/cime_config/testdefs/testmods_dirs/drv/water_tracers/README new file mode 100644 index 000000000..002317d39 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/water_tracers/README @@ -0,0 +1,3 @@ +This testmod turns on multiple water tracers along with checks to ensure that they +maintain their correct ratio over time. (These checks will only pass if the water tracers +used in the test do not invoke any physics that would cause a change in their ratios.) diff --git a/cime_config/testdefs/testmods_dirs/drv/water_tracers/shell_commands b/cime_config/testdefs/testmods_dirs/drv/water_tracers/shell_commands new file mode 100644 index 000000000..722b21fc6 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/water_tracers/shell_commands @@ -0,0 +1 @@ +./xmlchange WATER_TRACERS=tracer1:tracer2 diff --git a/cime_config/testdefs/testmods_dirs/drv/water_tracers/user_nl_cpl b/cime_config/testdefs/testmods_dirs/drv/water_tracers/user_nl_cpl new file mode 100644 index 000000000..6adb28e10 --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/water_tracers/user_nl_cpl @@ -0,0 +1,2 @@ +water_tracer_initial_ratios = "0.1:2" +water_tracers_do_checks = .true. diff --git a/med_test_comps/xatm/src/atm_comp_nuopc.F90 b/med_test_comps/xatm/src/atm_comp_nuopc.F90 index 64cd5b768..337ce8611 100644 --- a/med_test_comps/xatm/src/atm_comp_nuopc.F90 +++ b/med_test_comps/xatm/src/atm_comp_nuopc.F90 @@ -15,10 +15,13 @@ module atm_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod , only : WTRACERS_SUFFIX + use shr_wtracers_mod , only : shr_wtracers_present, shr_wtracers_get_num_tracers use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -39,7 +42,6 @@ module atm_comp_nuopc integer :: fldsFrAtm_num = 0 type (fld_list_type) :: fldsToAtm(fldsMax) type (fld_list_type) :: fldsFrAtm(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -121,6 +123,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue character(len=CL) :: logmsg logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -202,6 +206,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (nxg /= 0 .and. nyg /= 0) then + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_topo' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_z' ) @@ -210,6 +217,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_tbot' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_ptem' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_shum' ) + if (has_wtracers) then + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_shum'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pbot' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) @@ -217,6 +228,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowl' ) + if (has_wtracers) then + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_lwdn' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndr' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdr' ) @@ -238,6 +259,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_ofrac' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_tref' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_qref' ) + if (has_wtracers) then + call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_qref'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_t' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_t' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sl_fv' ) @@ -253,6 +278,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_sen' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_lwup' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' ) + if (has_wtracers) then + call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if do n = 1,fldsFrAtm_num if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) @@ -417,7 +446,7 @@ subroutine state_setexport(exportState, rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -440,19 +469,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrAtm_num - if (fldsFrAtm(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrAtm(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrAtm, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrAtm_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -478,6 +504,7 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost !-------------------------------------------------- rc = ESMF_SUCCESS diff --git a/med_test_comps/xglc/src/glc_comp_nuopc.F90 b/med_test_comps/xglc/src/glc_comp_nuopc.F90 index 4b498f8d9..4e62d8336 100644 --- a/med_test_comps/xglc/src/glc_comp_nuopc.F90 +++ b/med_test_comps/xglc/src/glc_comp_nuopc.F90 @@ -15,10 +15,13 @@ module glc_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod, only : WTRACERS_SUFFIX + use shr_wtracers_mod, only : shr_wtracers_present, shr_wtracers_get_num_tracers use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -38,7 +41,6 @@ module glc_comp_nuopc integer :: fldsFrGlc_num = 0 type (fld_list_type) :: fldsToGlc(fldsMax) type (fld_list_type) :: fldsFrGlc(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -128,6 +130,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=CL) :: logmsg character(len=CS) :: cnum logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -207,6 +211,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (nxg /= 0 .and. nyg /= 0) then + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrGlc_num, fldsFrGlc, trim(flds_scalar_name)) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_icemask' ) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_icemask_coupled_fluxes' ) @@ -214,9 +221,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_topo' ) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Flgg_hflx' ) + call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Fgrg_rofi' ) + call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Fgrg_rofl' ) + if (has_wtracers) then + call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Fgrg_rofi'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Fgrg_rofl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if + + ! This is needed for the smb renormalization + call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_area') + call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_tsrf') call fld_list_add(fldsToGlc_num, fldsToGlc, 'Flgl_qice') + if (has_wtracers) then + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Flgl_qice'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if ! Now advertise import and export fields fields do ns = 1,num_icesheets @@ -328,7 +351,7 @@ subroutine state_setexport(rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind, ns + integer :: n, ns, fld_num_save real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -351,20 +374,22 @@ subroutine state_setexport(rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to skip the scalar field + fld_num_save = 1 do ns = 1,num_icesheets - do nf = 2,fldsFrGlc_num - if (fldsFrGlc(nf)%ungridded_ubound == 0) then - call field_setexport(NStateExp(ns), trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrGlc(nf)%ungridded_ubound - call field_setexport(NStateExp(ns), trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = NStateExp(ns), & + flds = fldsFrGlc, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrGlc_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc, & + ! Save fld_num to continue to increment it for ice sheets beyond the first (so + ! different ice sheets will have different field values) + fld_num_save = fld_num_save) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug > 1) then call State_diagnose(NStateExp(ns), trim(subname)//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -396,6 +421,12 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + type(ESMF_VM) :: vm + real(r8) :: lat_min_l(1), lat_max_l(1), lat_min_g(1), lat_max_g(1) + real(r8) :: lon_min_l(1), lon_max_l(1), lon_min_g(1), lon_max_g(1) + real(r8) :: lon_mid + real(r8) :: lon_180(size(lon)) ! longitude with a -180 to 180 convention !-------------------------------------------------- rc = ESMF_SUCCESS @@ -425,8 +456,55 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, else call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (fldname == 'Sg_icemask' .or. fldname == 'Sg_icemask_coupled_fluxes' .or. fldname == 'Sg_ice_covered') then + if (fldname == 'Sg_icemask' .or. fldname == 'Sg_icemask_coupled_fluxes') then data1d(:) = 1._r8 + else if (fldname == 'Sg_area') then + ! These are not actual areas, but they'll do well enough to have some variation + ! in area. Note that deviations from the actual areas will lead to compensations + ! in the SMB renormalization. Here we set the areas to a typical order of + ! magnitude of actual areas on the GLC grid, but don't worry about getting the + ! actual areas right, just allowing this renormalization to have + ! bigger-than-typical correction factors. + data1d(:) = 1.e-6_r8 * lat(:)/90._r8 + else if (fldname == 'Sg_ice_covered') then + ! Split domain into ice-covered (1) and not (0) at the midpoint of the + ! longitude range. We convert to [-180, 180) so that data crossing 0 + ! degrees (the common case for ice sheet grids) is handled correctly. + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Convert longitudes to -180 to 180 convention. Note that if they already were + ! specified as -180 to 180, the following will lead lon_180 to be the same as + ! lon. + where (lon > 180.0_R8) + lon_180 = lon - 360.0_R8 + elsewhere + lon_180 = lon + end where + + lon_min_l(1) = minval(lon_180) + lon_max_l(1) = maxval(lon_180) + call ESMF_VMAllReduce(vm, lon_min_l, lon_min_g, 1, ESMF_REDUCE_MIN, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllReduce(vm, lon_max_l, lon_max_g, 1, ESMF_REDUCE_MAX, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lon_mid = (lon_min_g(1) + lon_max_g(1)) * 0.5_R8 + do i = 1, size(data1d) + data1d(i) = merge(1.0_R8, 0.0_R8, lon_180(i) > lon_mid) + end do + else if (fldname == 'Sg_topo') then + ! Use topo values ranging from 0 to 3000 based on a latitude gradient + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lat_min_l(1) = minval(lat) + lat_max_l(1) = maxval(lat) + call ESMF_VMAllReduce(vm, lat_min_l, lat_min_g, 1, ESMF_REDUCE_MIN, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllReduce(vm, lat_max_l, lat_max_g, 1, ESMF_REDUCE_MAX, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1, size(data1d) + data1d(i) = (lat(i) - lat_min_g(1)) / (lat_max_g(1) - lat_min_g(1)) * 3000.0_R8 + end do else do i = 1,size(data1d) data1d(i) = (nf*100) & diff --git a/med_test_comps/xice/src/ice_comp_nuopc.F90 b/med_test_comps/xice/src/ice_comp_nuopc.F90 index 9185b8e53..cba2154c9 100644 --- a/med_test_comps/xice/src/ice_comp_nuopc.F90 +++ b/med_test_comps/xice/src/ice_comp_nuopc.F90 @@ -15,10 +15,13 @@ module ice_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod , only : WTRACERS_SUFFIX + use shr_wtracers_mod , only : shr_wtracers_present, shr_wtracers_get_num_tracers use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -38,7 +41,6 @@ module ice_comp_nuopc integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -120,6 +122,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: shrlogunit ! original log unit character(len=CL) :: logmsg logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -203,12 +207,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (nxg /= 0 .and. nyg /= 0) then + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrIce_num, fldsFrIce, trim(flds_scalar_name)) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_imask' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_ifrac' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_t' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) + if (has_wtracers) then + call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_qref'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_avsdr' ) @@ -221,10 +232,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_sen' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_lwup' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_evap' ) + if (has_wtracers) then + call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_evap'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_swnet' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_melth' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_meltw' ) + if (has_wtracers) then + call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_meltw'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_salt' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_taux' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_tauy' ) @@ -245,6 +264,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_v' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_shum' ) + if (has_wtracers) then + call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_shum'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_dens' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_tbot' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_swvdr' ) @@ -254,10 +277,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_lwdn' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_rain' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_snow' ) + if (has_wtracers) then + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_rain'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_snow'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + if (has_wtracers) then + ! Note that this field only exists for tracers, not bulk + call fld_list_add(fldsToIce_num, fldsToIce, 'So_roce'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if do n = 1,fldsFrIce_num if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) @@ -430,7 +464,7 @@ subroutine state_setexport(exportState, rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -453,19 +487,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to skip the scalar field - do nf = 2,fldsFrIce_num - if (fldsFrIce(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrIce(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrIce, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrIce_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -491,6 +522,7 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost !-------------------------------------------------- rc = ESMF_SUCCESS diff --git a/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 b/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 index a43215939..6f3c36247 100644 --- a/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 +++ b/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 @@ -15,10 +15,14 @@ module lnd_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod, only : WTRACERS_SUFFIX + use shr_wtracers_mod, only : shr_wtracers_present, shr_wtracers_get_num_tracers + use glc_elevclass_mod, only : glc_get_elevclass_bounds use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -39,7 +43,6 @@ module lnd_comp_nuopc integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost integer :: glc_nec type(ESMF_Mesh) :: mesh @@ -124,6 +127,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue character(CL) :: logmsg logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -212,11 +217,18 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) read(cvalue,*) glc_nec call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) + if (has_wtracers) then + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) @@ -225,20 +237,42 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) + if (has_wtracers) then + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) + if (has_wtracers) then + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst' , ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) + if (has_wtracers) then + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flgl_qice_elev'//WTRACERS_SUFFIX, & + ungridded_lbound=1, ungridded_ubound=glc_nec+1, num_wtracers=num_wtracers) + end if call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) @@ -251,13 +285,36 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) + if (has_wtracers) then + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_shum'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood' ) + if (has_wtracers) then + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_flood'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) + if (has_wtracers) then + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) @@ -447,7 +504,7 @@ subroutine state_setexport(exportState, rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -470,19 +527,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrLnd_num - if (fldsFrLnd(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrLnd(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrLnd, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrLnd_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -509,6 +563,13 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + real(r8) :: glc_elevclass_bounds(0:glc_nec) + integer :: glc_elevclass + real(r8) :: topo_min, topo_max + real(r8) :: sign + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + character(len=*), parameter :: subname = trim(modName)//':(field_setexport) ' !-------------------------------------------------- rc = ESMF_SUCCESS @@ -520,16 +581,48 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, if (present(ungridded_index)) then call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + + if (fldname == 'Sl_topo_elev') then + ! Note that index 1 is bare ground, so need to subtract 1 from the ungridded index to get the elevation class + glc_elevclass = ungridded_index - 1 + if (glc_elevclass < 0 .or. glc_elevclass > glc_nec) then + call shr_sys_abort(subname//'For Sl_topo_elev, ungridded_index outside glc elevclass bounds') + end if + if (glc_elevclass == 0) then + ! Arbitrarily set topo_min and topo_max for bare ground + topo_min = 0._r8 + topo_max = 3000._r8 + else + glc_elevclass_bounds = glc_get_elevclass_bounds() + topo_min = glc_elevclass_bounds(glc_elevclass - 1) + topo_max = glc_elevclass_bounds(glc_elevclass) + end if + do i = 1, size(data2d, dim=2) + ! Make topo vary spatially, ranging from topo_min to topo_max + data2d(ungridded_index,i) = topo_min + (topo_max - topo_min) * & + (0.5_r8 + 0.5_r8 * cos(pi*lat(i)/180.0_R8) * sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) )) end do + + else + ! For qice, ensure that we have a mix of positive and negative values (even for + ! limited ranges of lat and lon) to better exercise the SMB renormalization code in + ! CMEPS + sign = 1._r8 + if (fldname == 'Flgl_qice_elev') then + if (mod(ungridded_index,2) == 0) sign = -1._r8 + end if + + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = sign * ((nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8)) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = sign * ((nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8)) + end do + end if end if else call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) diff --git a/med_test_comps/xocn/src/ocn_comp_nuopc.F90 b/med_test_comps/xocn/src/ocn_comp_nuopc.F90 index 87f8ca251..372ed0450 100644 --- a/med_test_comps/xocn/src/ocn_comp_nuopc.F90 +++ b/med_test_comps/xocn/src/ocn_comp_nuopc.F90 @@ -15,10 +15,13 @@ module ocn_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod , only : WTRACERS_SUFFIX + use shr_wtracers_mod , only : shr_wtracers_present, shr_wtracers_get_num_tracers use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -39,7 +42,6 @@ module ocn_comp_nuopc integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsToOcn(fldsMax) type (fld_list_type) :: fldsFrOcn(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -123,6 +125,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue character(len=CL) :: logmsg logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -192,6 +196,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (nxg /= 0 .and. nyg /= 0) then + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name)) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" ) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" ) @@ -202,10 +209,21 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" ) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" ) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" ) + if (has_wtracers) then + ! Note that this field only exists for tracers, not bulk + call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_roce"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name)) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" ) + if (has_wtracers) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" ) @@ -217,9 +235,30 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" ) + if (has_wtracers) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw" ) + if (has_wtracers) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_meltw"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Forr_rofl_glc" ) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Forr_rofi_glc" ) + if (has_wtracers) then + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Forr_rofl_glc"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToOcn_num, fldsToOcn, "Forr_rofi_glc"//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" ) do n = 1,fldsFrOcn_num @@ -355,7 +394,7 @@ subroutine state_setexport(exportState, rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -378,19 +417,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrOcn_num - if (fldsFrOcn(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrOcn(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrOcn, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrOcn_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -417,6 +453,7 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost !-------------------------------------------------- rc = ESMF_SUCCESS diff --git a/med_test_comps/xrof/src/rof_comp_nuopc.F90 b/med_test_comps/xrof/src/rof_comp_nuopc.F90 index 1b5b9dd49..192668851 100644 --- a/med_test_comps/xrof/src/rof_comp_nuopc.F90 +++ b/med_test_comps/xrof/src/rof_comp_nuopc.F90 @@ -15,10 +15,13 @@ module rof_comp_nuopc use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_log_mod , only : shr_log_getlogunit, shr_log_setlogunit + use shr_wtracers_mod, only : WTRACERS_SUFFIX + use shr_wtracers_mod, only : shr_wtracers_present, shr_wtracers_get_num_tracers use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -39,7 +42,6 @@ module rof_comp_nuopc integer :: fldsFrRof_num = 0 type (fld_list_type) :: fldsToRof(fldsMax) type (fld_list_type) :: fldsFrRof(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -122,6 +124,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue character(len=CL) :: logmsg logical :: isPresent, isSet + logical :: has_wtracers + integer :: num_wtracers character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -193,20 +197,59 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (nxg /= 0 .and. nyg /= 0) then + has_wtracers = shr_wtracers_present() + num_wtracers = shr_wtracers_get_num_tracers() + call fld_list_add(fldsFrRof_num, fldsFrRof, trim(flds_scalar_name)) call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi') + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl_glc') + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi_glc') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_flood') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') + if (has_wtracers) then + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl_glc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi_glc'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_flood'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if call fld_list_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofdto') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') + call fld_list_add(fldsToRof_num, fldsToRof, 'Fgrg_rofi') + call fld_list_add(fldsToRof_num, fldsToRof, 'Fgrg_rofl') + if (has_wtracers) then + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofi'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Fgrg_rofi'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + call fld_list_add(fldsToRof_num, fldsToRof, 'Fgrg_rofl'//WTRACERS_SUFFIX, & + num_wtracers=num_wtracers) + end if do n = 1,fldsFrRof_num if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) @@ -364,7 +407,7 @@ subroutine state_setexport(exportState, rc) integer, intent(out) :: rc ! local variables - integer :: n, nf, nind + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -387,19 +430,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - ! Start from index 2 in order to skip the scalar field - do nf = 2,fldsFrRof_num - if (fldsFrRof(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrRof(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrRof, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrRof_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -425,6 +465,7 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost !-------------------------------------------------- rc = ESMF_SUCCESS diff --git a/med_test_comps/xshare/dead_nuopc_mod.F90 b/med_test_comps/xshare/dead_nuopc_mod.F90 index ee3ca6b68..ca4123244 100644 --- a/med_test_comps/xshare/dead_nuopc_mod.F90 +++ b/med_test_comps/xshare/dead_nuopc_mod.F90 @@ -1,6 +1,8 @@ module dead_nuopc_mod use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND + use ESMF , only : ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE @@ -10,6 +12,9 @@ module dead_nuopc_mod use ESMF , only : operator(/=), operator(==), operator(+) use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort + use shr_wtracers_mod , only : shr_wtracers_get_initial_ratio + use shr_wtracers_mod , only : shr_wtracers_get_bulk_fieldname + use shr_wtracers_mod , only : WTRACERS_SUFFIX use dead_methods_mod , only : chkerr, alarmInit implicit none @@ -20,12 +25,25 @@ module dead_nuopc_mod public :: ModelSetRunClock public :: fld_list_add public :: fld_list_realize + public :: set_all_export_fields + + private :: set_wtracer_field ! !PUBLIC DATA MEMBERS: + integer, parameter, public :: fldname_maxlen = 128 + type fld_list_type - character(len=128) :: stdname + character(len=fldname_maxlen) :: stdname integer :: ungridded_lbound = 0 integer :: ungridded_ubound = 0 + + ! Water tracer fields are handled via ungridded dimensions, but we track the size of + ! this dimension separately to better distinguish between the ungridded dimension + ! used for water tracers vs. the ungridded dimension used for other purposes - + ! particularly for the case of fields that have both. For fields that are not water + ! tracer fields, num_wtracers will be 0; for fields that are water tracer fields, + ! num_wtracers will be the number of water tracers in this simulation. + integer :: num_wtracers = 0 end type fld_list_type public :: fld_list_type @@ -96,7 +114,7 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, nxg, nyg) end subroutine dead_read_inparms !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) + subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound, num_wtracers) ! input/output variables integer , intent(inout) :: num @@ -105,6 +123,10 @@ subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_uboun integer, optional , intent(in) :: ungridded_lbound integer, optional , intent(in) :: ungridded_ubound + ! For water tracers, use num_wtracers instead of ungridded_lbound / ungridded_ubound + ! for the water tracer dimension: + integer, optional , intent(in) :: num_wtracers + ! local variables character(len=*), parameter :: subname='(dead_nuopc_mod:fld_list_add)' !------------------------------------------------------------------------------- @@ -123,6 +145,10 @@ subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_uboun fldlist(num)%ungridded_ubound = ungridded_ubound end if + if (present(num_wtracers)) then + fldlist(num)%num_wtracers = num_wtracers + end if + end subroutine fld_list_add !=============================================================================== @@ -130,7 +156,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove + use ESMF , only : ESMF_MAXSTR, ESMF_State, ESMF_Mesh, ESMF_StateRemove use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU @@ -147,7 +173,6 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal integer :: n type(ESMF_Field) :: field character(len=80) :: stdname - integer :: gridtoFieldMap=2 character(len=*),parameter :: subname='(dead_nuopc_mod:fld_list_realize)' ! ---------------------------------------------- @@ -166,13 +191,34 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & ESMF_LOGMSG_INFO) ! Create the field - if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + if (fldlist(n)%ungridded_lbound > 0 .and. & + fldlist(n)%ungridded_ubound > 0 .and. & + fldlist(n)%num_wtracers > 0) then + ! This field has two ungridded dimensions: one for water tracers and one + ! for some other purpose. The second ungridded dimension will be for water + ! tracers. + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound, 1/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound, fldlist(n)%num_wtracers/), & + gridToFieldMap=(/3/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (fldlist(n)%ungridded_lbound > 0 .and. & + fldlist(n)%ungridded_ubound > 0) then + ! This field has one ungridded dimension field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & - gridToFieldMap=(/gridToFieldMap/), rc=rc) + gridToFieldMap=(/2/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (fldlist(n)%num_wtracers > 0) then + ! This field has one ungridded dimension, for water tracers + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/1/), & + ungriddedUbound=(/fldlist(n)%num_wtracers/), & + gridToFieldMap=(/2/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else + ! This field has no ungridded dimensions field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -198,7 +244,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! create a field with scalar data on the root pe ! ---------------------------------------------- - use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid + use ESMF, only : ESMF_DistGrid, ESMF_Grid use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 @@ -230,6 +276,212 @@ end subroutine SetScalarField end subroutine fld_list_realize + !================================================================================ + subroutine set_all_export_fields(exportState, flds, fld_min, fld_max, lon, lat, field_setexport, rc, fld_num_save) + + ! ---------------------------------------------- + ! Set all export fields for a given component's state + ! + ! This accepts a procedure argument for the subroutine that does the actual setting + ! for each field, since this procedure can differ between different xcomps. + ! + ! Water tracer fields are handled specially: these are set equal to the corresponding + ! bulk field times the initial ratio for this tracer. + ! ---------------------------------------------- + + ! input/output arguments + type(ESMF_State), intent(inout) :: exportState + type(fld_list_type), intent(in) :: flds(:) + integer, intent(in) :: fld_min ! first index in flds to set + integer, intent(in) :: fld_max ! last index in flds to set + real(r8), intent(in) :: lon(:) + real(r8), intent(in) :: lat(:) + integer, intent(out) :: rc + + ! fld_num_save can be provided to continue where we left off from the last call. + ! This is useful for multiple ice sheets, for example, where we want different field + ! values for each ice sheet. It should generally be set to 1 for the initial call from + ! a component (but could be set to some other value if desired). + integer, optional, intent(inout) :: fld_num_save + + interface + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + import :: ESMF_State + import :: r8 + + type(ESMF_State), intent(inout) :: exportState + character(len=*), intent(in) :: fldname + real(r8), intent(in) :: lon(:) + real(r8), intent(in) :: lat(:) + integer, intent(in) :: nf + integer, optional, intent(in) :: ungridded_index + integer, intent(out) :: rc + end subroutine field_setexport + end interface + + ! local variables + integer :: nf, nind, fld_num + character(len=*), parameter :: subname='(dead_nuopc_mod:set_all_export_fields)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (present(fld_num_save)) then + fld_num = fld_num_save + else + fld_num = 1 + end if + + do nf = fld_min,fld_max + if (flds(nf)%num_wtracers > 0) then + ! We'll handle water tracers specially, below. A few notes about this: + ! - We handle water tracers after we are done setting all non-water tracer + ! fields, because the setting of water tracer fields depends on the + ! corresponding non-tracer fields. + ! - We do *not* increment fld_num for the water tracer fields. This ensures that + ! values put in the non-tracer fields remain the same even when introducing + ! water tracers. + cycle + end if + + if (flds(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(flds(nf)%stdname), lon, lat, nf=fld_num, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + fld_num = fld_num + 1 + else + do nind = 1,flds(nf)%ungridded_ubound + call field_setexport(exportState, trim(flds(nf)%stdname), lon, lat, nf=fld_num, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + fld_num = fld_num + 1 + end do + end if + end do + + ! Now handle water tracers. + do nf = fld_min,fld_max + if (flds(nf)%num_wtracers > 0) then + call set_wtracer_field(exportState, flds(nf), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + end do + + if (present(fld_num_save)) then + fld_num_save = fld_num + end if + + end subroutine set_all_export_fields + + !================================================================================ + subroutine set_wtracer_field(exportState, fld, rc) + + ! ---------------------------------------------- + ! Sets a single water tracer field (for all tracers), based on the corresponding bulk + ! field and the initial ratio of this tracer. + ! ---------------------------------------------- + + ! input/output arguments + type(ESMF_State), intent(inout) :: exportState + type(fld_list_type), intent(in) :: fld + integer, intent(out) :: rc + + ! local variables + logical :: is_wtracer_field + type(ESMF_StateItem_Flag) :: bulk_item_flag + character(len=fldname_maxlen) :: wtracer_bulk_fldname + + type(ESMF_Field) :: field_wtracers + type(ESMF_Field) :: field_bulk + + ! If there is no ungridded dimension other than the water tracer dimension, we'll use + ! these variables: + real(r8), pointer :: data_bulk_1d(:) + real(r8), pointer :: data_wtracers_2d(:,:) + + ! If there is an additional ungridded dimension in addition to the water tracer + ! dimension, we'll use these variables: + real(r8), pointer :: data_bulk_2d(:,:) + real(r8), pointer :: data_wtracers_3d(:,:,:) + + integer :: n + + character(len=*), parameter :: subname='(dead_nuopc_mod:set_wtracer_field)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call shr_wtracers_get_bulk_fieldname( & + fieldname = fld%stdname, & + is_wtracer_field = is_wtracer_field, & + bulk_fieldname = wtracer_bulk_fldname) + if (.not. is_wtracer_field) then + call ESMF_LogWrite(subname//": ERROR: "//trim(fld%stdname)// & + " does not end with the expected suffix ('"//WTRACERS_SUFFIX//"') for a water tracer field", & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + end if + + call ESMF_StateGet(exportState, itemName=trim(fld%stdname), field=field_wtracers, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(exportState, itemName=trim(wtracer_bulk_fldname), itemType=bulk_item_flag, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (bulk_item_flag /= ESMF_STATEITEM_NOTFOUND) then + call ESMF_StateGet(exportState, itemName=trim(wtracer_bulk_fldname), field=field_bulk, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fld%ungridded_lbound > 0 .and. fld%ungridded_ubound > 0) then + ! There is an additional ungridded dimension in addition to the water tracer + ! dimension. Note that we assume that the bulk field matches the tracer field in + ! terms of the size of this ungridded dimension. + call ESMF_FieldGet(field_wtracers, farrayPtr=data_wtracers_3d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_bulk, farrayPtr=data_bulk_2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fld%num_wtracers + data_wtracers_3d(:,n,:) = data_bulk_2d(:,:) * shr_wtracers_get_initial_ratio(n) + end do + else + ! No additional ungridded dimension + call ESMF_FieldGet(field_wtracers, farrayPtr=data_wtracers_2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field_bulk, farrayPtr=data_bulk_1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fld%num_wtracers + data_wtracers_2d(n,:) = data_bulk_1d(:) * shr_wtracers_get_initial_ratio(n) + end do + end if + else + ! Corresponding bulk item not found. This is the case for a small number of fields + ! where we have a water tracer field but no corresponding bulk field. In this + ! situation, set the tracer field to the initial ratio everywhere. (It would be + ! ideal to give it some spatial pattern, but for now we just use a constant field + ! for simplicity.) + + if (fld%ungridded_lbound > 0 .and. fld%ungridded_ubound > 0) then + ! There is an additional ungridded dimension in addition to the water tracer + ! dimension. + call ESMF_FieldGet(field_wtracers, farrayPtr=data_wtracers_3d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fld%num_wtracers + data_wtracers_3d(:,n,:) = shr_wtracers_get_initial_ratio(n) + end do + else + ! No additional ungridded dimension + call ESMF_FieldGet(field_wtracers, farrayPtr=data_wtracers_2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fld%num_wtracers + data_wtracers_2d(n,:) = shr_wtracers_get_initial_ratio(n) + end do + end if + end if + end subroutine set_wtracer_field + !=============================================================================== subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) diff --git a/med_test_comps/xwav/src/wav_comp_nuopc.F90 b/med_test_comps/xwav/src/wav_comp_nuopc.F90 index aa4d982e5..635d4c712 100644 --- a/med_test_comps/xwav/src/wav_comp_nuopc.F90 +++ b/med_test_comps/xwav/src/wav_comp_nuopc.F90 @@ -19,6 +19,7 @@ module wav_comp_nuopc use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance use dead_nuopc_mod , only : dead_read_inparms, ModelInitPhase, ModelSetRunClock use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type + use dead_nuopc_mod , only : set_all_export_fields implicit none private ! except @@ -39,7 +40,6 @@ module wav_comp_nuopc integer :: fldsFrWav_num = 0 type (fld_list_type) :: fldsToWav(fldsMax) type (fld_list_type) :: fldsFrWav(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost type(ESMF_Mesh) :: mesh integer :: nxg ! global dim i-direction @@ -349,8 +349,8 @@ subroutine state_setexport(exportState, rc) integer , intent(out) :: rc ! local variables - integer :: nfstart, ubound - integer :: n, nf, nind + integer :: ubound + integer :: n real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer :: spatialDim @@ -373,21 +373,16 @@ subroutine state_setexport(exportState, rc) lat(n) = ownedElemCoords(2*n) end do - nfstart = 0 ! for fields that have ubound > 0 - do nf = 2,fldsFrWav_num ! Start from index 2 in order to skip the scalar field - ubound = fldsFrWav(nf)%ungridded_ubound - if (ubound == 0) then - call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - nfstart = nfstart + nf + ubound - 1 - do nind = 1,ubound - call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nfstart+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do + call set_all_export_fields( & + exportState = exportState, & + flds = fldsFrWav, & + fld_min = 2, & ! Start from index 2 in order to skip the scalar field here + fld_max = fldsFrWav_num, & + lon = lon, & + lat = lat, & + field_setexport = field_setexport, & + rc = rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lon) deallocate(lat) @@ -414,6 +409,7 @@ subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, type(ESMF_Field) :: lfield real(r8), pointer :: data1d(:) real(r8), pointer :: data2d(:,:) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost !-------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 6f0cc6cbd..e85868695 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -63,12 +63,17 @@ module esmFldsExchange_cesm_mod use med_internalstate_mod , only : mrg_fracname_lnd2atm_state, mrg_fracname_lnd2atm_flux, map_fracname_lnd2atm use med_internalstate_mod , only : mrg_fracname_lnd2rof, map_fracname_lnd2rof use med_internalstate_mod , only : mrg_fracname_lnd2glc, map_fracname_lnd2glc + use shr_log_mod , only : shr_log_error + use wtracers_mod , only : wtracers_present + use wtracers_mod , only : WTRACERS_SUFFIX implicit none public public :: esmFldsExchange_cesm + private :: set_suffix_for_water_bulk_or_tracers + ! currently required mapping files character(len=CX) :: rof2ocn_ice_rmap ='unset' character(len=CX) :: rof2ocn_liq_rmap ='unset' @@ -95,9 +100,15 @@ module esmFldsExchange_cesm_mod logical :: flds_co2a ! Pass CO2 from ATM to surface components logical :: flds_co2b ! Pass CO2 from ATM to LND and back from LND to ATM logical :: flds_co2c ! Pass CO2 from ATM to surface (OCN/LND) and back from them to ATM + logical, private :: has_wtracers ! Pass water tracer fields + integer, private :: water_bulk_or_tracers_max ! 2 if running with water tracers, 1 otherwise logical :: flds_r2l_stream_channel_depths ! Pass channel depths from ROF to LND logical :: add_gusts ! Whether to include fields related to the gustiness parameterization + ! Possible values for water_bulk_or_tracers index + integer, parameter, private :: water_bulk_index = 1 + integer, parameter, private :: water_tracers_index = 2 + character(*), parameter :: u_FILE_u = & __FILE__ @@ -136,6 +147,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, ns + integer :: water_bulk_or_tracers_index ! 1 = bulk, 2 = tracers (note that a single index covers all tracers - NOT one index per tracer) + character(len=len(WTRACERS_SUFFIX)) :: suffix ! WTRACERS_SUFFIX for tracers, blank for bulk character(len=CL) :: atm_mesh_name character(len=CL) :: lnd_mesh_name character(len=CL) :: ice_mesh_name @@ -236,6 +249,13 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat + has_wtracers = wtracers_present() + if (has_wtracers) then + water_bulk_or_tracers_max = water_tracers_index + else + water_bulk_or_tracers_max = water_bulk_index + end if + call NUOPC_CompAttributeGet(gcomp, name='flds_r2l_stream_channel_depths', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_r2l_stream_channel_depths @@ -304,10 +324,8 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addfld_from(compatm, 'Sa_z') call addfld_from(compatm, 'Sa_tbot') call addfld_from(compatm, 'Sa_pbot') - call addfld_from(compatm, 'Sa_shum') call addfld_from(compatm, 'Sa_ptem') call addfld_from(compatm, 'Sa_dens') - call addfld_from(compatm, 'Faxa_rainc') else if (is_local%wrap%aoflux_grid == 'ogrid') then if (mapuv_with_cart3d) then @@ -317,16 +335,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap_from(compatm, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_map) end if - call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_map) - call addmap_from(compatm, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) call addmap_from(compatm, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) end if end if + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_shum'//trim(suffix)) + call addfld_from(compatm, 'Faxa_rainc'//trim(suffix)) + else + if (is_local%wrap%aoflux_grid == 'ogrid') then + call addmap_from(compatm, 'Sa_shum'//trim(suffix), compocn, mapbilnr, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_rainc'//trim(suffix), compocn, mapconsf, 'one', atm2ocn_map) + end if + end if + end do ! --------------------------------------------------------------------- ! to med: swnet fluxes used for budget calculation @@ -467,16 +497,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum') - call addfld_to(complnd, 'Sa_shum') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap_from(compatm, 'Sa_shum', complnd, mapbilnr, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_shum'//trim(suffix)) + call addfld_to(complnd, 'Sa_shum'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_shum'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Sa_shum'//trim(suffix), complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_shum'//trim(suffix), & + mrg_from=compatm, mrg_fld='Sa_shum'//trim(suffix), mrg_type='copy') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to lnd: prognostic CO2 at the lowest atm model level ! --------------------------------------------------------------------- @@ -506,49 +542,63 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to lnd: convective and large scale precipitation rate water equivalent from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc') - call addfld_to(complnd, 'Faxa_rainc') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc', rc=rc)) then - call addmap_from(compatm, 'Faxa_rainc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Faxa_rainc', mrg_from=compatm, mrg_fld='Faxa_rainc', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_rainc'//trim(suffix)) + call addfld_to(complnd, 'Faxa_rainc'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainc'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainc'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_rainc'//trim(suffix), complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_rainc'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_rainc'//trim(suffix), mrg_type='copy') + end if end if - end if - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainl') - call addfld_to(complnd, 'Faxa_rainl') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl', rc=rc)) then - call addmap_from(compatm, 'Faxa_rainl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Faxa_rainl', mrg_from=compatm, mrg_fld='Faxa_rainl', mrg_type='copy') + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_rainl'//trim(suffix)) + call addfld_to(complnd, 'Faxa_rainl'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_rainl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_rainl'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_rainl'//trim(suffix), complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_rainl'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_rainl'//trim(suffix), mrg_type='copy') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to lnd: convective and large-scale (stable) snow rate from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_snowc') - call addfld_to(complnd, 'Faxa_snowc') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowc', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Faxa_snowc', mrg_from=compatm, mrg_fld='Faxa_snowc', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_snowc'//trim(suffix)) + call addfld_to(complnd, 'Faxa_snowc'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowc'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowc'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_snowc'//trim(suffix), complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_snowc'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_snowc'//trim(suffix), mrg_type='copy') + end if end if - end if - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_snowl') - call addfld_to(complnd, 'Faxa_snowl') - else - if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowl', complnd, mapconsf, 'one', atm2lnd_map) - call addmrg_to(complnd, 'Faxa_snowl', mrg_from=compatm, mrg_fld='Faxa_snowl', mrg_type='copy') + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_snowl'//trim(suffix)) + call addfld_to(complnd, 'Faxa_snowl'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Faxa_snowl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Faxa_snowl'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_snowl'//trim(suffix), complnd, mapconsf, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Faxa_snowl'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_snowl'//trim(suffix), mrg_type='copy') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to lnd: downward longwave heat flux from atm ! --------------------------------------------------------------------- @@ -683,36 +733,48 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to lnd: tributary water depth ! to lnd: tributary channel depth ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volr') - call addfld_to(complnd, 'Flrr_volr') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr', rc=rc)) then - call addmap_from(comprof, 'Flrr_volr', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volr', mrg_from=comprof, mrg_fld='Flrr_volr', mrg_type='copy') - end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_volrmch') - call addfld_to(complnd, 'Flrr_volrmch') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch', rc=rc)) then - call addmap_from(comprof, 'Flrr_volrmch', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_volrmch', mrg_from=comprof, mrg_fld='Flrr_volrmch', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(comprof, 'Flrr_volr'//trim(suffix)) + call addfld_from(comprof, 'Flrr_volrmch'//trim(suffix)) + call addfld_to(complnd, 'Flrr_volr'//trim(suffix)) + call addfld_to(complnd, 'Flrr_volrmch'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volr'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volr'//trim(suffix), rc=rc)) then + call addmap_from(comprof, 'Flrr_volr'//trim(suffix), complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volr'//trim(suffix), mrg_from=comprof, & + mrg_fld='Flrr_volr'//trim(suffix), mrg_type='copy') + end if + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_volrmch'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_volrmch'//trim(suffix), rc=rc)) then + call addmap_from(comprof, 'Flrr_volrmch'//trim(suffix), complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_volrmch'//trim(suffix), mrg_from=comprof, & + mrg_fld='Flrr_volrmch'//trim(suffix), mrg_type='copy') + end if end if - end if - if (phase == 'advertise') then - call addfld_from(comprof, 'Flrr_flood') - call addfld_to(complnd, 'Flrr_flood') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - call addmap_from(comprof, 'Flrr_flood', complnd, mapconsf, 'one', rof2lnd_map) - call addmrg_to(complnd, 'Flrr_flood', mrg_from=comprof, mrg_fld='Flrr_flood', mrg_type='copy') + end do + + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(comprof, 'Flrr_flood'//trim(suffix)) + call addfld_to(complnd, 'Flrr_flood'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flrr_flood'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//trim(suffix), rc=rc)) then + call addmap_from(comprof, 'Flrr_flood'//trim(suffix), complnd, mapconsf, 'one', rof2lnd_map) + call addmrg_to(complnd, 'Flrr_flood'//trim(suffix), mrg_from=comprof, & + mrg_fld='Flrr_flood'//trim(suffix), mrg_type='copy') + end if end if - end if + end do + if (phase == 'advertise') then call addfld_from(comprof, 'Sr_tdepth') call addfld_to(complnd, 'Sr_tdepth') @@ -967,32 +1029,40 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (phase == 'advertise') then - call addfld_from(complnd , 'Sl_qref') - call addfld_from(compice , 'Si_qref') - call addfld_aoflux('So_qref') - call addfld_to(compatm , 'Sx_qref') - else - if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref', rc=rc)) then - if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref', rc=rc)) then - call addmap_from(complnd , 'Sl_qref', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=complnd, mrg_fld='Sl_qref', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_state) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref', rc=rc)) then - call addmap_from(compice , 'Si_qref', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compice, mrg_fld='Si_qref', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('So_qref', compatm, mapconsf, 'ofrac', ocn2atm_map) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd , 'Sl_qref'//trim(suffix)) + call addfld_from(compice , 'Si_qref'//trim(suffix)) + call addfld_aoflux('So_qref'//trim(suffix)) + call addfld_to(compatm , 'Sx_qref'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(compatm), 'Sx_qref'//trim(suffix), rc=rc)) then + if (fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_qref'//trim(suffix), rc=rc)) then + call addmap_from(complnd , 'Sl_qref'//trim(suffix), compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) + call addmrg_to(compatm , 'Sx_qref'//trim(suffix), & + mrg_from=complnd, mrg_fld='Sl_qref'//trim(suffix), mrg_type='merge', & + mrg_fracname=mrg_fracname_lnd2atm_state) + end if + if (fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_qref'//trim(suffix), rc=rc)) then + call addmap_from(compice , 'Si_qref'//trim(suffix), compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Sx_qref'//trim(suffix), & + mrg_from=compice, mrg_fld='Si_qref'//trim(suffix), mrg_type='merge', & + mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_qref'//trim(suffix), rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('So_qref'//trim(suffix), compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'Sx_qref'//trim(suffix), & + mrg_from=compmed, mrg_fld='So_qref'//trim(suffix), mrg_type='merge', & + mrg_fracname='ofrac') end if - call addmrg_to(compatm , 'Sx_qref', & - mrg_from=compmed, mrg_fld='So_qref', mrg_type='merge', mrg_fracname='ofrac') end if end if - end if + end do ! --------------------------------------------------------------------- ! to atm: merged zonal surface stress @@ -1110,35 +1180,42 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if - if (phase == 'advertise') then - call addfld_to(compatm, 'Faxx_evap') - call addfld_to(compatm, 'Faox_evap') - call addfld_from(complnd, 'Fall_evap') - call addfld_from(compice, 'Faii_evap') - call addfld_aoflux('Faox_evap') - else - if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap', rc=rc)) then - if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap', rc=rc)) then - call addmap_from(complnd , 'Fall_evap', compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) - call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=complnd, mrg_fld='Fall_evap', mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) - end if - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap', rc=rc)) then - call addmap_from(compice , 'Faii_evap', compatm, mapconsf, 'ifrac', ice2atm_map) - call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=compice, mrg_fld='Faii_evap', mrg_type='merge', mrg_fracname='ifrac') - end if - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap', rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('Faox_evap', compatm, mapconsf, 'ofrac', ocn2atm_map) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_to(compatm, 'Faxx_evap'//trim(suffix)) + call addfld_to(compatm, 'Faox_evap'//trim(suffix)) + call addfld_from(complnd, 'Fall_evap'//trim(suffix)) + call addfld_from(compice, 'Faii_evap'//trim(suffix)) + call addfld_aoflux( 'Faox_evap'//trim(suffix)) + else + if (fldchk(is_local%wrap%FBexp(compatm), 'Faxx_evap'//trim(suffix), rc=rc)) then + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_evap'//trim(suffix), rc=rc)) then + call addmap_from(complnd , 'Fall_evap'//trim(suffix), compatm, mapconsf, map_fracname_lnd2atm, lnd2atm_map) + call addmrg_to(compatm , 'Faxx_evap'//trim(suffix), & + mrg_from=complnd, mrg_fld='Fall_evap'//trim(suffix), mrg_type='merge', mrg_fracname=mrg_fracname_lnd2atm_flux) + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_evap'//trim(suffix), rc=rc)) then + call addmap_from(compice , 'Faii_evap'//trim(suffix), compatm, mapconsf, 'ifrac', ice2atm_map) + call addmrg_to(compatm , 'Faxx_evap'//trim(suffix), & + mrg_from=compice, mrg_fld='Faii_evap'//trim(suffix), mrg_type='merge', mrg_fracname='ifrac') + end if + if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_evap'//trim(suffix), rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux('Faox_evap'//trim(suffix), compatm, mapconsf, 'ofrac', ocn2atm_map) + end if + call addmrg_to(compatm , 'Faxx_evap'//trim(suffix), & + mrg_from=compmed, mrg_fld='Faox_evap'//trim(suffix), mrg_type='merge', mrg_fracname='ofrac') + ! unmerged aoflux-only for correct hevap to ocean in cam_out + call addmrg_to(compatm, 'Faox_evap'//trim(suffix), & + mrg_from=compmed, mrg_fld='Faox_evap'//trim(suffix), mrg_type='copy') end if - call addmrg_to(compatm , 'Faxx_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') - ! unmerged aoflux-only for correct hevap to ocean in cam_out - call addmrg_to(compatm, 'Faox_evap', mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy') + end if end if - end if + end do if (phase == 'advertise') then call addfld_to(compatm, 'Faxx_lwup') @@ -1811,40 +1888,46 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: snow rate water equivalent from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc') - call addfld_from(compatm, 'Faxa_rainl') - call addfld_to(compocn, 'Faxa_rain' ) - call addfld_from(compatm, 'Faxa_snowc') - call addfld_from(compatm, 'Faxa_snowl') - call addfld_to(compocn, 'Faxa_snow' ) - else - ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with ofrac - ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization - ! which by default is not actually used - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' , rc=rc)) then - call addmap_from(compatm, 'Faxa_rainl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_rainc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', & - mrg_type='sum_with_weights', mrg_fracname='ofrac') - end if - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowl', compocn, mapconsf, 'one', atm2ocn_map) - call addmap_from(compatm, 'Faxa_snowc', compocn, mapconsf, 'one', atm2ocn_map) - call addmrg_to(compocn, 'Faxa_snow' , & - mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum_with_weights', mrg_fracname='ofrac') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_rainc'//trim(suffix)) + call addfld_from(compatm, 'Faxa_rainl'//trim(suffix)) + call addfld_to(compocn, 'Faxa_rain'//trim(suffix)) + call addfld_from(compatm, 'Faxa_snowc'//trim(suffix)) + call addfld_from(compatm, 'Faxa_snowl'//trim(suffix)) + call addfld_to(compocn, 'Faxa_snow'//trim(suffix)) + else + ! TODO: why are we not merging Faxa_rain and Faxa_snow if they are sent from atm with ofrac + ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization + ! which by default is not actually used + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_rainl'//trim(suffix), compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_rainc'//trim(suffix), compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_rain'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_rainc'//trim(suffix)//':Faxa_rainl'//trim(suffix), & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + end if + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_snow'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_snowl'//trim(suffix), compocn, mapconsf, 'one', atm2ocn_map) + call addmap_from(compatm, 'Faxa_snowc'//trim(suffix), compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_snow'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_snowc'//trim(suffix)//':Faxa_snowl'//trim(suffix), & + mrg_type='sum_with_weights', mrg_fracname='ofrac') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to ocn: merged sensible heat flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compatm , 'Faxa_sen') call addfld_aoflux('Faox_sen') call addfld_from(compice , 'Fioi_melth') call addfld_to(compocn , 'Foxx_sen') @@ -1860,21 +1943,28 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_lat' ) call addfld_aoflux( 'Faox_lat' ) - call addfld_aoflux( 'Faox_evap') call addfld_to(compocn, 'Foxx_lat' ) - call addfld_to(compocn, 'Foxx_evap') else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc)) then call addmrg_to(compocn, 'Foxx_lat', & mrg_from=compmed, mrg_fld='Faox_lat', mrg_type='merge', mrg_fracname='ofrac') end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap', rc=rc)) then - call addmrg_to(compocn, 'Foxx_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='merge', mrg_fracname='ofrac') - end if end if + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_aoflux( 'Faox_evap'//trim(suffix)) + call addfld_to(compocn, 'Foxx_evap'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap'//trim(suffix), rc=rc)) then + call addmrg_to(compocn, 'Foxx_evap'//trim(suffix), & + mrg_from=compmed, mrg_fld='Faox_evap'//trim(suffix), mrg_type='merge', mrg_fracname='ofrac') + end if + end if + end do ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med @@ -2057,17 +2147,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: water flux due to melting ice from ice ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compice , 'Fioi_meltw') - call addfld_to(compocn , 'Fioi_meltw') - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw', rc=rc)) then - call addmap_from(compice, 'Fioi_meltw', compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Fioi_meltw', & - mrg_from=compice, mrg_fld='Fioi_meltw', mrg_type='copy_with_weights', mrg_fracname='ifrac') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compice , 'Fioi_meltw'//trim(suffix)) + call addfld_to(compocn , 'Fioi_meltw'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//trim(suffix), rc=rc)) then + call addmap_from(compice, 'Fioi_meltw'//trim(suffix), compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Fioi_meltw'//trim(suffix), & + mrg_from=compice, mrg_fld='Fioi_meltw'//trim(suffix), mrg_type='copy_with_weights', mrg_fracname='ifrac') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to ocn: heat flux from melting ice from ice ! --------------------------------------------------------------------- @@ -2148,116 +2243,127 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !----------------------------- if (phase == 'advertise') then - ! Note that Flrr_flood below needs to be added to - ! fldlistFr(comprof) in order to be mapped correctly to the ocean but the ocean - ! does not receive it so it is advertised but it will not be connected - call addfld_from(comprof, 'Forr_rofl') call addfld_from(comprof, 'Forr_rofl_nonh2o') - call addfld_from(comprof, 'Forr_rofi') - call addfld_from(comprof, 'Forr_rofl_glc') - call addfld_from(comprof, 'Forr_rofi_glc') - call addfld_to(compocn, 'Foxx_rofl') - call addfld_to(compocn, 'Foxx_rofi') call addfld_to(compocn, 'Forr_rofl_nonh2o') - call addfld_to(compocn, 'Forr_rofl_glc') - call addfld_to(compocn, 'Forr_rofi_glc') - call addfld_to(compocn, 'Flrr_flood') - else - ! Liquid runoff from land and glc - mapping - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - end if - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_nonh2o' , rc=rc)) then - if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_nonh2o' , rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) - end if - end if - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then - call addmap_from(comprof, 'Flrr_flood', compocn, mapconsd, 'one', rof2ocn_map) - end if - end if - if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then - if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc', rc=rc) .or. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl', rc=rc)) then - if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl_glc', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofl_glc', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + else + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_nonh2o' , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_nonh2o' , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_nonh2o', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if end if - end if - end if + end if + end if - ! Liquid runoff from land and glc - merging - forr_rofl_glc_merged_to_ocn = .false. - if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc)) then - ! If the ocean is prepared to handle Forr_rofl_glc as a separate field, then keep - ! it as a separate field rather than merging it to Foxx_rofl - call addmrg_to(compocn, 'Forr_rofl_glc', mrg_from=comprof, mrg_fld='Forr_rofl_glc', mrg_type='copy') - forr_rofl_glc_merged_to_ocn = .true. - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc)) then - mrgfld_source = 'Forr_rofl' - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood', rc=rc)) then - mrgfld_source = trim(mrgfld_source) //':Flrr_flood' - end if - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc', rc=rc) .and. & - .not. forr_rofl_glc_merged_to_ocn) then - mrgfld_source = trim(mrgfld_source) //':Forr_rofl_glc' - end if - call addmrg_to(compocn, 'Foxx_rofl', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') - end if + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Frozen runoff from land and glc - mapping - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - end if - end if - if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then - if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc', rc=rc) .or. & - fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi', rc=rc)) then - if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi_glc', compocn, mapconsd, 'one', 'unset') - else - call addmap_from(comprof, 'Forr_rofi_glc', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) - end if - end if - end if + if (phase == 'advertise') then + ! Note that Flrr_flood below needs to be added to + ! fldlistFr(comprof) in order to be mapped correctly to the ocean but the ocean + ! does not receive it so it is advertised but it will not be connected + call addfld_from(comprof, 'Forr_rofl'//trim(suffix)) + call addfld_from(comprof, 'Forr_rofi'//trim(suffix)) + call addfld_from(comprof, 'Forr_rofl_glc'//trim(suffix)) + call addfld_from(comprof, 'Forr_rofi_glc'//trim(suffix)) + call addfld_to(compocn, 'Foxx_rofl'//trim(suffix)) + call addfld_to(compocn, 'Foxx_rofi'//trim(suffix)) + call addfld_to(compocn, 'Forr_rofl_glc'//trim(suffix)) + call addfld_to(compocn, 'Forr_rofi_glc'//trim(suffix)) + call addfld_to(compocn, 'Flrr_flood'//trim(suffix)) + else + ! Liquid runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//trim(suffix) , rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl'//trim(suffix) , rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl'//trim(suffix), compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl'//trim(suffix), compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + end if + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//trim(suffix), rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl'//trim(suffix), rc=rc)) then + call addmap_from(comprof, 'Flrr_flood'//trim(suffix), compocn, mapconsd, 'one', rof2ocn_map) + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc'//trim(suffix), rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc'//trim(suffix), rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl'//trim(suffix), rc=rc)) then + if (trim(rof2ocn_liq_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofl_glc'//trim(suffix), compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofl_glc'//trim(suffix), compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) + end if + end if + end if - ! Frozen runoff from land and glc - merging - forr_rofi_glc_merged_to_ocn = .false. - if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc)) then - ! If the ocean is prepared to handle Forr_rofi_glc as a separate field, then keep - ! it as a separate field rather than merging it to Foxx_rofi - call addmrg_to(compocn, 'Forr_rofi_glc', mrg_from=comprof, mrg_fld='Forr_rofi_glc', mrg_type='copy') - forr_rofi_glc_merged_to_ocn = .true. - end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc)) then - mrgfld_source = 'Forr_rofi' - if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc', rc=rc) .and. & - .not. forr_rofi_glc_merged_to_ocn) then - mrgfld_source = trim(mrgfld_source) //':Forr_rofi_glc' - end if - call addmrg_to(compocn, 'Foxx_rofi', mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') - end if - end if + ! Liquid runoff from land and glc - merging + forr_rofl_glc_merged_to_ocn = .false. + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc'//trim(suffix), rc=rc)) then + ! If the ocean is prepared to handle Forr_rofl_glc as a separate field, then keep + ! it as a separate field rather than merging it to Foxx_rofl + call addmrg_to(compocn, 'Forr_rofl_glc'//trim(suffix), mrg_from=comprof, & + mrg_fld='Forr_rofl_glc'//trim(suffix), mrg_type='copy') + forr_rofl_glc_merged_to_ocn = .true. + end if + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl'//trim(suffix), rc=rc)) then + mrgfld_source = 'Forr_rofl'//trim(suffix) + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//trim(suffix), rc=rc)) then + mrgfld_source = trim(mrgfld_source) //':Flrr_flood'//trim(suffix) + end if + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl_glc'//trim(suffix), rc=rc) .and. & + .not. forr_rofl_glc_merged_to_ocn) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofl_glc'//trim(suffix) + end if + call addmrg_to(compocn, 'Foxx_rofl'//trim(suffix), mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if + + ! Frozen runoff from land and glc - mapping + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//trim(suffix), rc=rc)) then + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi'//trim(suffix), rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi'//trim(suffix), compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofi'//trim(suffix), compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + end if + end if + end if + if ( fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc'//trim(suffix), rc=rc)) then + if (fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc'//trim(suffix), rc=rc) .or. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi'//trim(suffix), rc=rc)) then + if (trim(rof2ocn_ice_rmap) == 'unset') then + call addmap_from(comprof, 'Forr_rofi_glc'//trim(suffix), compocn, mapconsd, 'one', 'unset') + else + call addmap_from(comprof, 'Forr_rofi_glc'//trim(suffix), compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) + end if + end if + end if + + ! Frozen runoff from land and glc - merging + forr_rofi_glc_merged_to_ocn = .false. + if ( fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc'//trim(suffix), rc=rc)) then + ! If the ocean is prepared to handle Forr_rofi_glc as a separate field, then keep + ! it as a separate field rather than merging it to Foxx_rofi + call addmrg_to(compocn, 'Forr_rofi_glc'//trim(suffix), mrg_from=comprof, & + mrg_fld='Forr_rofi_glc'//trim(suffix), mrg_type='copy') + forr_rofi_glc_merged_to_ocn = .true. + end if + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi'//trim(suffix), rc=rc)) then + mrgfld_source = 'Forr_rofi'//trim(suffix) + if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi_glc'//trim(suffix), rc=rc) .and. & + .not. forr_rofi_glc_merged_to_ocn) then + mrgfld_source = trim(mrgfld_source) //':Forr_rofi_glc'//trim(suffix) + end if + call addmrg_to(compocn, 'Foxx_rofi'//trim(suffix), mrg_from=comprof, mrg_fld=trim(mrgfld_source), mrg_type='sum') + end if + end if + end do !----------------------------- ! from wav: for daily averaged fields for @@ -2764,44 +2870,53 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! to ice: convective and large scale precipitation rate water equivalent from atm ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_rainc') - call addfld_from(compatm, 'Faxa_rainl') - call addfld_from(compatm, 'Faxa_rain' ) - call addfld_to(compice, 'Faxa_rain' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then - call addmap_from(compatm, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain' , mrg_from=compatm, mrg_fld='Faxa_rainc:Faxa_rainl', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then - call addmap_from(compatm, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_rain', mrg_from=compatm, mrg_fld='Faxa_rain', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_rainc'//trim(suffix)) + call addfld_from(compatm, 'Faxa_rainl'//trim(suffix)) + call addfld_from(compatm, 'Faxa_rain'//trim(suffix)) + call addfld_to(compice, 'Faxa_rain'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_rainc'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_rainl'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_rainc'//trim(suffix)//':Faxa_rainl'//trim(suffix), & + mrg_type='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_rain'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_rain'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_rain'//trim(suffix), mrg_type='copy') + end if end if - end if - if (phase == 'advertise') then - call addfld_from(compatm, 'Faxa_snowc') - call addfld_from(compatm, 'Faxa_snowl') - call addfld_from(compatm, 'Faxa_snow' ) - call addfld_to(compice, 'Faxa_snow' ) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then - call addmap_from(compatm, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_map) - call addmap_from(compatm, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow' , & - mrg_from=compatm, mrg_fld='Faxa_snowc:Faxa_snowl', mrg_type='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then - call addmap_from(compatm, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_map) - call addmrg_to(compice, 'Faxa_snow', & - mrg_from=compatm, mrg_fld='Faxa_snow', mrg_type='copy') + if (phase == 'advertise') then + call addfld_from(compatm, 'Faxa_snowc'//trim(suffix)) + call addfld_from(compatm, 'Faxa_snowl'//trim(suffix)) + call addfld_from(compatm, 'Faxa_snow'//trim(suffix)) + call addfld_to(compice, 'Faxa_snow'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_snowc'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmap_from(compatm, 'Faxa_snowl'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_snowc'//trim(suffix)//':Faxa_snowl'//trim(suffix), & + mrg_type='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Faxa_snow'//trim(suffix), compice, mapconsf, 'one', atm2ice_map) + call addmrg_to(compice, 'Faxa_snow'//trim(suffix), mrg_from=compatm, & + mrg_fld='Faxa_snow'//trim(suffix), mrg_type='copy') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm @@ -2903,16 +3018,22 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(compatm, 'Sa_shum') - call addfld_to(compice, 'Sa_shum') - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum', rc=rc)) then - call addmap_from(compatm, 'Sa_shum', compice, mapbilnr, 'one', atm2ice_map) - call addmrg_to(compice, 'Sa_shum', mrg_from=compatm, mrg_fld='Sa_shum', mrg_type='copy') + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_shum'//trim(suffix)) + call addfld_to(compice, 'Sa_shum'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Sa_shum'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_shum'//trim(suffix), rc=rc)) then + call addmap_from(compatm, 'Sa_shum'//trim(suffix), compice, mapbilnr, 'one', atm2ice_map) + call addmrg_to(compice, 'Sa_shum'//trim(suffix), & + mrg_from=compatm, mrg_fld='Sa_shum'//trim(suffix), mrg_type='copy') + end if end if - end if + end do ! --------------------------------------------------------------------- ! to ice: sea surface temperature from ocn ! --------------------------------------------------------------------- @@ -3015,6 +3136,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if end if + !----------------------------- + ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean + !----------------------------- + ! Note that this field is JUST for water tracers, NOT for bulk - so we start the loop at water_tracers_index + do water_bulk_or_tracers_index = water_tracers_index, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(compocn, 'So_roce'//trim(suffix)) + call addfld_to(compice, 'So_roce'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'So_roce'//trim(suffix), rc=rc)) then + call addmap_from(compocn, 'So_roce'//trim(suffix), compice, mapfcopy, 'unset', 'unset') + call addmrg_to(compice, 'So_roce'//trim(suffix), mrg_from=compocn, mrg_fld='So_roce'//trim(suffix), mrg_type='copy') + end if + end if + end do ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- @@ -3199,41 +3339,52 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to rof: liquid and ice from glc ! --------------------------------------------------------------------- - do ns = 1, is_local%wrap%num_icesheets - if (phase == 'advertise') then - call addfld_from(compglc(ns), 'Fgrg_rofl') - call addfld_from(compglc(ns), 'Fgrg_rofi') - call addfld_to(comprof, 'Fgrg_rofl') - call addfld_to(comprof, 'Fgrg_rofi') - else - ! Note: we are assuming that the rof mesh has a mask of one everywhere - if ( fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofl', rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofl', comprof, mapconsd, 'gfrac' , 'unset') - ! Custom merge in med_phases_prep_rof - end if - if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofi', rc=rc)) then - call addmap_from(compglc(ns), 'Fgrg_rofi', comprof, mapconsd, 'gfrac', 'unset') - ! Custom merge in med_phases_prep_rof + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + do ns = 1, is_local%wrap%num_icesheets + if (phase == 'advertise') then + call addfld_from(compglc(ns), 'Fgrg_rofl'//trim(suffix)) + call addfld_from(compglc(ns), 'Fgrg_rofi'//trim(suffix)) + call addfld_to(comprof, 'Fgrg_rofl'//trim(suffix)) + call addfld_to(comprof, 'Fgrg_rofi'//trim(suffix)) + else + ! Note: we are assuming that the rof mesh has a mask of one everywhere + if ( fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofl'//trim(suffix), rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofl'//trim(suffix), comprof, mapconsd, 'gfrac' , 'unset') + ! Custom merge in med_phases_prep_rof + end if + if (fldchk(is_local%wrap%FBImp(compglc(ns), compglc(ns)), 'Fgrg_rofi'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Fgrg_rofi'//trim(suffix), rc=rc)) then + call addmap_from(compglc(ns), 'Fgrg_rofi'//trim(suffix), comprof, mapconsd, 'gfrac', 'unset') + ! Custom merge in med_phases_prep_rof + end if end if - end if + end do end do ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid surface) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Flrl_rofsur') - call addfld_to(comprof, 'Flrl_rofsur') - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsur', comprof, mapconsf, map_fracname_lnd2rof, 'unset') - call addmrg_to(comprof, 'Flrl_rofsur', & - mrg_from=complnd, mrg_fld='Flrl_rofsur', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofsur'//trim(suffix)) + call addfld_to(comprof, 'Flrl_rofsur'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsur'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsur'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flrl_rofsur'//trim(suffix), comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_rofsur'//trim(suffix), & + mrg_from=complnd, mrg_fld='Flrl_rofsur'//trim(suffix), & + mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if end if - end if + end do ! --------------------------------------------------------------------- ! to rof: non-water flux(es) from land (liquid surface) @@ -3253,62 +3404,86 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to rof: water flux from land (ice surface) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Flrl_rofi') - call addfld_to(comprof, 'Flrl_rofi') - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofi', comprof, mapconsf, map_fracname_lnd2rof, 'unset') - call addmrg_to(comprof, 'Flrl_rofi', & - mrg_from=complnd, mrg_fld='Flrl_rofi', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofi'//trim(suffix)) + call addfld_to(comprof, 'Flrl_rofi'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofi'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofi'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flrl_rofi'//trim(suffix), comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_rofi'//trim(suffix), & + mrg_from=complnd, mrg_fld='Flrl_rofi'//trim(suffix), & + mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if end if - end if + end do ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid glacier, wetland, and lake) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Flrl_rofgwl') - call addfld_to(comprof, 'Flrl_rofgwl') - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofgwl', comprof, mapconsf, map_fracname_lnd2rof, 'unset') - call addmrg_to(comprof, 'Flrl_rofgwl', & - mrg_from=complnd, mrg_fld='Flrl_rofgwl', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofgwl'//trim(suffix)) + call addfld_to(comprof, 'Flrl_rofgwl'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofgwl'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofgwl'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flrl_rofgwl'//trim(suffix), comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_rofgwl'//trim(suffix), & + mrg_from=complnd, mrg_fld='Flrl_rofgwl'//trim(suffix), & + mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if end if - end if + end do ! --------------------------------------------------------------------- ! to rof: water flux from land (liquid subsurface) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Flrl_rofsub') - call addfld_to(comprof, 'Flrl_rofsub') - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub', rc=rc)) then - call addmap_from(complnd, 'Flrl_rofsub', comprof, mapconsf, map_fracname_lnd2rof, 'unset') - call addmrg_to(comprof, 'Flrl_rofsub', & - mrg_from=complnd, mrg_fld='Flrl_rofsub', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_rofsub'//trim(suffix)) + call addfld_to(comprof, 'Flrl_rofsub'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_rofsub'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_rofsub'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flrl_rofsub'//trim(suffix), comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_rofsub'//trim(suffix), & + mrg_from=complnd, mrg_fld='Flrl_rofsub'//trim(suffix), & + mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if end if - end if + end do ! --------------------------------------------------------------------- ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld_from(complnd, 'Flrl_irrig') - call addfld_to(comprof, 'Flrl_irrig') - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig', rc=rc)) then - call addmap_from(complnd, 'Flrl_irrig', comprof, mapconsf, map_fracname_lnd2rof, 'unset') - call addmrg_to(comprof, 'Flrl_irrig', & - mrg_from=complnd, mrg_fld='Flrl_irrig', mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flrl_irrig'//trim(suffix)) + call addfld_to(comprof, 'Flrl_irrig'//trim(suffix)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Flrl_irrig'//trim(suffix), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(comprof) , 'Flrl_irrig'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flrl_irrig'//trim(suffix), comprof, mapconsf, map_fracname_lnd2rof, 'unset') + call addmrg_to(comprof, 'Flrl_irrig'//trim(suffix), & + mrg_from=complnd, mrg_fld='Flrl_irrig'//trim(suffix), & + mrg_type='copy_with_weights', mrg_fracname=mrg_fracname_lnd2rof) + end if end if - end if + end do !===================================================================== ! FIELDS TO LAND-ICE (compglc) @@ -3327,17 +3502,12 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) if (phase == 'advertise') then call addfld_from(complnd, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) call addfld_from(complnd, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) - call addfld_from(complnd, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) do ns = 1,is_local%wrap%num_icesheets call addfld_to(compglc(ns), 'Sl_tsrf') - call addfld_to(compglc(ns), 'Flgl_qice') end do else ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 do ns = 1,is_local%wrap%num_icesheets - if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc)) then - call addmap_from(complnd, 'Flgl_qice_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') - end if if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc)) then call addmap_from(complnd, 'Sl_tsrf_elev', compglc(ns), mapbilnr, map_fracname_lnd2glc, 'unset') end if @@ -3347,6 +3517,25 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end do end if + do water_bulk_or_tracers_index = 1, water_bulk_or_tracers_max + call set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (phase == 'advertise') then + call addfld_from(complnd, 'Flgl_qice_elev'//trim(suffix)) ! glacier ice flux (1->glc_nec+1) + do ns = 1,is_local%wrap%num_icesheets + call addfld_to(compglc(ns), 'Flgl_qice'//trim(suffix)) + end do + else + ! custom mapping, accumulation and merging will be done in prep_glc_mod.F90 + do ns = 1,is_local%wrap%num_icesheets + if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev'//trim(suffix), rc=rc)) then + call addmap_from(complnd, 'Flgl_qice_elev'//trim(suffix), compglc(ns), & + mapbilnr, map_fracname_lnd2glc, 'unset') + end if + end do + end if + end do !----------------------------- ! to glc: from ocn @@ -3375,4 +3564,33 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end subroutine esmFldsExchange_cesm + !----------------------------------------------------------------------------- + subroutine set_suffix_for_water_bulk_or_tracers(water_bulk_or_tracers_index, suffix, rc) + + ! Set suffix for water fields based on whether water_bulk_or_tracers_index is the + ! index for bulk (1) or tracers (2). For tracers, the suffix will be WTRACERS_SUFFIX; + ! for bulk, the suffix will be blank. + + use ESMF, only : ESMF_SUCCESS + + ! input/output arguments + integer, intent(in) :: water_bulk_or_tracers_index ! 1 = bulk, 2 = tracers + character(len=*), intent(out) :: suffix + integer, intent(out) :: rc + + character(len=*), parameter :: subname='(set_suffix_for_water_bulk_or_tracers)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + select case (water_bulk_or_tracers_index) + case (water_bulk_index) + suffix = " " + case (water_tracers_index) + suffix = WTRACERS_SUFFIX + case default + call shr_log_error(subname//" ERROR: unexpected value for water_bulk_or_tracers_index", rc=rc) + end select + end subroutine set_suffix_for_water_bulk_or_tracers + end module esmFldsExchange_cesm_mod diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 6c9021683..1885b36df 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -41,32 +41,36 @@ - standard_name: Faox_evap alias: mean_evap_rate_atm_into_ocn canonical_units: kg m-2 s-1 - description: med export - atm/ocn evaporation water flux computed in medidator + description: med export - atm/ocn evaporation water flux computed in mediator + # + - standard_name: Faox_evap_wtracers + canonical_units: kg m-2 s-1 + description: med export - atm/ocn evaporation water tracer flux computed in mediator # - standard_name: Faox_lat alias: mean_laten_heat_flx_atm_into_ocn canonical_units: W m-2 - description: med export - atm/ocn surface latent heat flux computed in medidator + description: med export - atm/ocn surface latent heat flux computed in mediator # - standard_name: Faox_sen alias: mean_sensi_heat_flx_atm_into_ocn canonical_units: W m-2 - description: med export - atm/ocn surface sensible heat flux computed in medidator + description: med export - atm/ocn surface sensible heat flux computed in mediator # - standard_name: Faox_lwup alias: mean_up_lw_flx_ocn canonical_units: W m-2 - description: med export - ocn long wave radiation flux over the ocean computed in medidator + description: med export - ocn long wave radiation flux over the ocean computed in mediator # - standard_name: Faox_taux alias: stress_on_air_ocn_zonal canonical_units: N m-2 - description: med export - atm/ocn zonal surface stress computed in medidator + description: med export - atm/ocn zonal surface stress computed in mediator # - standard_name: Faox_tauy alias: stress_on_air_ocn_merid canonical_units: N m-2 - description: med export - atm/ocn meridional surface stress computed in medidator + description: med export - atm/ocn meridional surface stress computed in mediator # - standard_name: Fwxx_taux alias: mean_zonal_moment_flx @@ -86,6 +90,10 @@ canonical_units: kg m-2 s-1 description: lnd import to med # + - standard_name: Fall_evap_wtracers + canonical_units: kg m-2 s-1 + description: lnd import to med + # - standard_name: Fall_fco2_lnd canonical_units: moles m-2 s-1 description: lnd import to med @@ -166,6 +174,10 @@ canonical_units: kg kg-1 description: lnd import to med # + - standard_name: Sl_qref_wtracers + canonical_units: kg kg-1 + description: lnd import to med + # - standard_name: Sl_ram1 canonical_units: s/m description: lnd import to med @@ -186,7 +198,7 @@ canonical_units: kg m-2 s-1 description: lnd export to river # - - standard_name: Flrl_rofdto + - standard_name: Flrl_irrig_wtracers canonical_units: kg m-2 s-1 description: lnd export to river # @@ -194,14 +206,26 @@ canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofgwl_wtracers + canonical_units: kg m-2 s-1 + description: lnd export to river + # - standard_name: Flrl_rofi canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofi_wtracers + canonical_units: kg m-2 s-1 + description: lnd export to river + # - standard_name: Flrl_rofsub canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofsub_wtracers + canonical_units: kg m-2 s-1 + description: lnd export to river + # - standard_name: Flrl_rofsur canonical_units: kg m-2 s-1 description: lnd export to river @@ -209,6 +233,10 @@ - standard_name: Flrl_rofsur_nonh2o canonical_units: kg m-2 s-1 description: lnd export to river for non-water liquid tracers + # + - standard_name: Flrl_rofsur_wtracers + canonical_units: kg m-2 s-1 + description: lnd export to river # - standard_name: Sl_topo_elev canonical_units: m @@ -222,6 +250,10 @@ canonical_units: kg m-2 s-1 description: lnd import to med in elevation classes (1->glc_nec) # + - standard_name: Flgl_qice_elev_wtracers + canonical_units: kg m-2 s-1 + description: lnd import to med in elevation classes (1->glc_nec) + # #----------------------------------- # section: lnd export from med (computed in med) #----------------------------------- @@ -246,6 +278,10 @@ canonical_units: kg m-2 s-1 description: lnd export to med no elevation classes (computed in med) # + - standard_name: Flgl_qice_wtracers + canonical_units: kg m-2 s-1 + description: lnd export to med no elevation classes (computed in med) + # #----------------------------------- # section: atm import to med #----------------------------------- @@ -313,27 +349,51 @@ canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_rain_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_rainc canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_rainc_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_rainl canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_rainl_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_snow alias: mean_fprec_rate canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_snow_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_snowc canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_snowc_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_snowl canonical_units: kg m-2 s-1 description: atm import to med # + - standard_name: Faxa_snowl_wtracers + canonical_units: kg m-2 s-1 + description: atm import to med + # - standard_name: Faxa_swnet canonical_units: W m-2 description: atm import to med @@ -405,7 +465,11 @@ - standard_name: Sa_shum alias: inst_spec_humid_height_lowest canonical_units: kg kg-1 - description: atm import to med - bottom layer specific humidiaty + description: atm import to med - bottom layer specific humidity + # + - standard_name: Sa_shum_wtracers + canonical_units: kg kg-1 + description: atm import to med - bottom layer tracer specific humidity # - standard_name: Sa_tbot alias: inst_temp_height_lowest @@ -471,7 +535,11 @@ # - standard_name: Faxx_evap canonical_units: kg m-2 s-1 - description: atm export from meditor - merged water evaporation flux + description: atm export from med - merged water evaporation flux + # + - standard_name: Faxx_evap_wtracers + canonical_units: kg m-2 s-1 + description: atm export from med - merged water tracer evaporation flux # - standard_name: Faxx_lat alias: mean_laten_heat_flx @@ -517,6 +585,10 @@ canonical_units: kg kg-1 description: atm export from med # + - standard_name: Sx_qref_wtracers + canonical_units: kg kg-1 + description: atm export from med + # - standard_name: Sx_t alias: surface_temperature canonical_units: K @@ -551,15 +623,31 @@ # - standard_name: Fgrg_rofi canonical_units: kg m-2 s-1 - description: glc import tomed - glacier frozen_runoff_flux_to_ocean + description: glc import to med - glacier frozen runoff flux to ocean + # + - standard_name: Fgrg_rofi_wtracers + canonical_units: kg m-2 s-1 + description: glc import to med - glacier frozen runoff tracer flux to ocean # - standard_name: Fgrg_rofl canonical_units: kg m-2 s-1 description: glc import to med - glacier liquid runoff flux to ocean # + - standard_name: Fgrg_rofl_wtracers + canonical_units: kg m-2 s-1 + description: glc import to med - glacier liquid runoff tracer flux to ocean + # + # Note that Figg_rofi isn't currently implemented in CMEPS, but it is advertised in + # CISM, so we still need to include it here. (The intent when this was first + # implemented was that this would be an optional, alternative routing of ice runoff + # from GLC - a direct creation of icebergs in the ICE model.) - standard_name: Figg_rofi canonical_units: kg m-2 s-1 - description: glc import to med - glc frozen runoff_iceberg flux to ice + description: glc import to med - glc frozen runoff iceberg flux to ice + # + - standard_name: Figg_rofi_wtracers + canonical_units: kg m-2 s-1 + description: glc import to med - glc frozen runoff iceberg tracer flux to ice # - standard_name: Flgg_hflx canonical_units: W m-2 @@ -612,6 +700,10 @@ canonical_units: kg m-2 s-1 description: ice import to med # + - standard_name: Faii_evap_wtracers + canonical_units: kg m-2 s-1 + description: ice import to med + # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice canonical_units: W m-2 @@ -663,6 +755,10 @@ canonical_units: kg m-2 s-1 description: ice import to med to ocean - fresh water to ocean (h2o flux from melting) # + - standard_name: Fioi_meltw_wtracers + canonical_units: kg m-2 s-1 + description: ice import to med to ocean - fresh water tracer flux to ocean (h2o flux from melting) + # - standard_name: Fioi_salt alias: mean_salt_rate canonical_units: kg m-2 s-1 @@ -742,6 +838,10 @@ canonical_units: kg kg-1 description: ice import to med # + - standard_name: Si_qref_wtracers + canonical_units: kg kg-1 + description: ice import to med + # - standard_name: Si_t alias: sea_ice_surface_temperature canonical_units: K @@ -872,6 +972,14 @@ canonical_units: kg kg-1 description: ocn import to med # + - standard_name: So_qref_wtracers + canonical_units: kg kg-1 + description: ocn import to med + # + - standard_name: So_roce_wtracers + canonical_units: unitless + description: ocn import to med + # - standard_name: So_re canonical_units: 1 description: ocn import to med @@ -974,15 +1082,15 @@ - standard_name: Foxx_evap alias: mean_evap_rate canonical_units: kg m-2 s-1 - description: med export to ocn - specific humidity flux + description: med export to ocn - evaporation flux # - - standard_name: Foxx_lat - canonical_units: W m-2 - description: med export to ocn - latent heat flux into ocean + - standard_name: Foxx_evap_wtracers + canonical_units: kg m-2 s-1 + description: med export to ocn - tracer evaporation flux # - standard_name: Foxx_lat canonical_units: W m-2 - description: med export to ocn - latent heat flux into ocean for HDO + description: med export to ocn - latent heat flux into ocean # - standard_name: Foxx_sen alias: mean_sensi_heat_flx @@ -1018,11 +1126,20 @@ canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (frozen) # + - standard_name: Foxx_rofi_wtracers + canonical_units: kg m-2 s-1 + description: med export to ocn - water tracer flux due to runoff (frozen) + # - standard_name: Foxx_rofl alias: mean_runoff_rate canonical_units: kg m-2 s-1 description: med export to ocn - water flux due to runoff (liquid) # + - standard_name: Foxx_rofl_wtracers + alias: mean_runoff_rate + canonical_units: kg m-2 s-1 + description: med export to ocn - water tracer flux due to runoff (liquid) + # - standard_name: Foxx_swnet alias: mean_net_sw_flx canonical_units: W m-2 @@ -1083,14 +1200,26 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to flooding # + - standard_name: Flrr_flood_wtracers + canonical_units: kg m-2 s-1 + description: river import to med - water tracer flux due to flooding + # - standard_name: Flrr_volr canonical_units: m description: river import to med - river channel total water volume # + - standard_name: Flrr_volr_wtracers + canonical_units: m + description: river import to med - river channel total water volume of tracers + # - standard_name: Flrr_volrmch canonical_units: m description: river import to med - river channel main channel water volume # + - standard_name: Flrr_volrmch_wtracers + canonical_units: m + description: river import to med - river channel main channel water volume of tracers + # - standard_name: Sr_tdepth canonical_units: m description: river import to med - tributary channel water depth @@ -1103,10 +1232,18 @@ canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff (frozen) # + - standard_name: Forr_rofi_wtracers + canonical_units: kg m-2 s-1 + description: river export to ocean - water tracer flux due to runoff (frozen) + # - standard_name: Forr_rofi_glc canonical_units: kg m-2 s-1 description: river export to ocean - water flux due to runoff originating from glc (frozen) # + - standard_name: Forr_rofi_glc_wtracers + canonical_units: kg m-2 s-1 + description: river export to ocean - water tracer flux due to runoff originating from glc (frozen) + # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 description: river import to med - liquid water flux due to runoff @@ -1115,6 +1252,10 @@ canonical_units: kg m-2 s-1 description: river import to med - non-water flux due to runoff # + - standard_name: Forr_rofl_wtracers + canonical_units: kg m-2 s-1 + description: river import to med - water tracer flux due to runoff (liquid) + # - standard_name: Forr_rofl_glc canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff originating from glc (liquid) @@ -1123,6 +1264,10 @@ canonical_units: kg m-2 s-1 description: river import to med - non-water flux(es) due to runoff originating from lnd (liquid) # + - standard_name: Forr_rofl_glc_wtracers + canonical_units: kg m-2 s-1 + description: river import to med - water tracer flux due to runoff originating from glc (liquid) + # #----------------------------------- # section: wav import to med #----------------------------------- diff --git a/mediator/med.F90 b/mediator/med.F90 index 7a053da7e..010d69650 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -680,7 +680,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_methods_mod , only : mediator_checkfornans + use med_methods_mod , only : mediator_checkfornans, water_tracers_do_checks ! input/output variables type(ESMF_GridComp) :: gcomp @@ -962,6 +962,19 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif + ! Should mediator check water tracer consistency? + call NUOPC_CompAttributeGet(gcomp, name="water_tracers_do_checks", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) water_tracers_do_checks + else + water_tracers_do_checks = .false. + endif + if(maintask) then + write(logunit,*) ' water_tracers_do_checks is ',water_tracers_do_checks + end if + ! Should target component use all data for first time step? do ncomp = 1,ncomps if (ncomp /= compmed) then diff --git a/mediator/med_field_info_mod.F90 b/mediator/med_field_info_mod.F90 index 9f04ccb0f..f4aa301d0 100644 --- a/mediator/med_field_info_mod.F90 +++ b/mediator/med_field_info_mod.F90 @@ -11,7 +11,7 @@ module med_field_info_mod use ESMF , only : ESMF_FieldCreate, ESMF_FieldGet use med_utils_mod , only : ChkErr => med_utils_ChkErr use shr_log_mod , only : shr_log_error - use wtracers_mod , only : wtracers_is_wtracer_field + use wtracers_mod , only : wtracers_is_wtracer_field, wtracers_get_num_tracers implicit none private @@ -167,7 +167,7 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra ! ! It is assumed that fields generally have no ungridded dimensions. However, for ! fields ending with the water tracer suffix, it is instead assumed that they have a - ! single ungridded dimension of size given by shr_wtracers_get_num_tracers. + ! single ungridded dimension of size given by wtracers_get_num_tracers. ! ! field_info_array is allocated here (and, since it has intent(out), it is ! automatically deallocated if it is already allocated on entry to this subroutine) @@ -188,14 +188,18 @@ subroutine med_field_info_array_from_names_wtracers(field_names, field_info_arra n_fields = size(field_names) allocate(field_info_array(n_fields)) - ! For now, hard-code n_tracers, since we haven't set up the tracer information; we'll - ! fix this in an upcoming set of changes - n_tracers = 0 do i = 1, n_fields is_tracer = wtracers_is_wtracer_field(field_names(i)) if (is_tracer) then - ! Field is a water tracer; assume a single ungridded dimension + ! Field is a water tracer; assume a single ungridded dimension. + ! + ! Note that wtracers_get_num_tracers will return the same value for all water + ! tracers. However, we call this inside the loop - and in particular, inside the + ! is_tracer conditional - to avoid trying to retrieve this value in the + ! situation where there aren't any water tracers and the water tracer module + ! hasn't been initialized. (This may never occur in practice, but it might.) + n_tracers = wtracers_get_num_tracers() field_info_array(i) = med_field_info_create_directly( & name=field_names(i), & ungridded_lbound=[1], & diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 2365dce4e..82fb22e95 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -40,6 +40,8 @@ module med_io_mod ! private member functions private :: med_io_file_exists + private :: med_io_def_var_with_atts + private :: med_io_read_1d_var ! public data members: interface med_io_read @@ -740,7 +742,6 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & integer(kind=Pio_Offset_Kind) :: frame character(CL) :: itemc ! string converted to char character(CL) :: name1 ! var name - character(CL) :: cunit ! var units character(CL) :: lpre ! local prefix character(CS) :: coordvarnames(2) ! coordinate variable names character(CS) :: coordnames(2) ! coordinate long names @@ -762,6 +763,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & type(ESMF_Field) :: lfield integer :: rank logical :: tiles + logical :: ltavg character(CL), allocatable :: fieldNameList(:) ! For a single ungridded dimension, there will be 1 element in ungriddedUBound and 1 @@ -781,6 +783,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float + ltavg = .false. + if (present(tavg)) ltavg = tavg tiles = .false. if (present(ntile)) then @@ -956,25 +960,8 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & write(cnumber,'(i0)') n write(cnumber2,'(i0)') n2 name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber)//'_'//trim(cnumber2) - call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) - if (luse_float) then - rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) - else - rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) - end if - if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then - call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file, varid, "units", trim(cunit)) - end if - rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") - endif - endif + call med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lfillvalue, ltavg, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end do end do else if (rank == 2) then @@ -989,48 +976,14 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & if (trim(itemc) /= "hgt") then write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) - if (luse_float) then - rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) - else - rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) - end if - if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then - call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file, varid, "units", trim(cunit)) - end if - rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") - endif - endif + call med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lfillvalue, ltavg, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if end do else if (rank == 1) then name1 = trim(lpre)//'_'//trim(itemc) - call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) - if (luse_float) then - rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) - else - rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) - end if - if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then - call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file, varid, "units", trim(cunit)) - end if - rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") - endif - endif + call med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lfillvalue, ltavg, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else call shr_log_error(subname//' ERROR: unhandled rank', line=__LINE__, file=u_FILE_u, rc=rc) return @@ -1547,11 +1500,10 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet - use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile - use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_inq_varid - use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile - use pio , only : pio_read_darray, pio_offset_kind, pio_setframe + use pio , only : file_desc_T, io_desc_t, pio_nowrite, pio_openfile + use pio , only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_seterrorhandling, pio_freedecomp, pio_closefile + use pio , only : pio_offset_kind ! input/output arguments character(len=*) ,intent(in) :: filename @@ -1565,14 +1517,12 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) type(ESMF_Field) :: lfield integer :: rcode integer :: nf - integer :: k,n,n2,l + integer :: k,n,n2 type(file_desc_t) :: pioid - type(var_desc_t) :: varid type(io_desc_t) :: iodesc character(CL) :: itemc ! string converted to char character(CL) :: name1 ! var name character(CL) :: lpre ! local prefix - real(r8) :: lfillvalue integer :: rank, lsize real(r8), pointer :: fldptr1(:), fldptr1_tmp(:) real(r8), pointer :: fldptr2(:,:) @@ -1698,23 +1648,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) write(cnumber,'(i0)') n write(cnumber2,'(i0)') n2 name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber)//'_'//trim(cnumber2) - - rcode = pio_inq_varid(pioid, trim(name1), varid) - if (rcode == pio_noerr) then - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call pio_setframe(pioid, varid, lframe) - call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode) - rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) - if (rcode /= pio_noerr) then - lfillvalue = fillvalue - endif - do l = 1,size(fldptr1_tmp) - if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8 - enddo - else - fldptr1_tmp = 0.0_r8 - endif + call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1_tmp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return fldptr3(n,n2,:) = fldptr1_tmp(:) end do end do @@ -1742,23 +1677,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) ! ungridded dimension index of the field bundle 2d field write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - - rcode = pio_inq_varid(pioid, trim(name1), varid) - if (rcode == pio_noerr) then - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call pio_setframe(pioid, varid, lframe) - call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode) - rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) - if (rcode /= pio_noerr) then - lfillvalue = fillvalue - endif - do l = 1,size(fldptr1_tmp) - if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8 - enddo - else - fldptr1_tmp = 0.0_r8 - endif + call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1_tmp, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (gridToFieldMap(1) == 1) then fldptr2(:,n) = fldptr1_tmp(:) else if (gridToFieldMap(1) == 2) then @@ -1770,23 +1690,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) else if (rank == 1) then name1 = trim(lpre)//'_'//trim(itemc) - - rcode = pio_inq_varid(pioid, trim(name1), varid) - if (rcode == pio_noerr) then - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call pio_setframe(pioid,varid,lframe) - call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) - rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) - if (rcode /= pio_noerr) then - lfillvalue = fillvalue - endif - do n = 1,size(fldptr1) - if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 - enddo - else - fldptr1 = 0.0_r8 - endif + call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if enddo ! end of loop over fields @@ -2262,4 +2167,100 @@ subroutine med_io_ymd2date_long(year,month,day,date) if (year < 0) date = -date end subroutine med_io_ymd2date_long + !=============================================================================== + subroutine med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lfillvalue, ltavg, rc) + + !--------------- + ! Define a netcdf variable and set its standard attributes + !--------------- + + use pio , only : var_desc_t, pio_real, pio_double, pio_def_var, pio_put_att + + ! input/output variables + type(file_desc_t) , intent(inout) :: io_file + character(len=*) , intent(in) :: name1 + character(len=*) , intent(in) :: itemc + integer, pointer , intent(in) :: dimid(:) + logical , intent(in) :: luse_float + real(r8) , intent(in) :: lfillvalue + logical , intent(in) :: ltavg + integer , intent(out) :: rc + + ! local variables + type(var_desc_t) :: varid + integer :: rcode + character(CL) :: cunit ! var units + character(*),parameter :: subName = '(med_io_def_var_with_atts) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) + if (luse_float) then + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) + else + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) + end if + if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then + call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) + end if + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) + if (ltavg) then + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") + end if + + end subroutine med_io_def_var_with_atts + + !=============================================================================== + subroutine med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr, rc) + + !--------------- + ! Read a 1-d variable from a netcdf file, replacing fill values with 0. + ! If the variable is not found, the array is zeroed. + !--------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use pio , only : var_desc_t, io_desc_t, pio_noerr, pio_offset_kind + use pio , only : pio_inq_varid, pio_setframe, pio_read_darray, pio_get_att + + ! input/output variables + type(file_desc_t) , intent(inout) :: pioid + character(len=*) , intent(in) :: name1 + type(io_desc_t) , intent(inout) :: iodesc + integer(kind=PIO_OFFSET_KIND) , intent(in) :: lframe + real(r8) , intent(inout) :: fldptr(:) + integer , intent(out) :: rc + + ! local variables + type(var_desc_t) :: varid + integer :: rcode, l + real(r8) :: lfillvalue + character(*),parameter :: subName = '(med_io_read_1d_var) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid, varid, lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr, rcode) + rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do l = 1,size(fldptr) + if (fldptr(l) == lfillvalue) fldptr(l) = 0.0_r8 + enddo + else + fldptr = 0.0_r8 + endif + + end subroutine med_io_read_1d_var + end module med_io_mod diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 5ab81a490..5d5ecde03 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -33,7 +33,8 @@ module med_methods_mod end interface med_methods_check_for_nans ! used/reused in module - logical, public :: mediator_checkfornans ! set in med.F90 AdvertiseFields + logical, public :: mediator_checkfornans ! set in med.F90 AdvertiseFields + logical, public :: water_tracers_do_checks ! set in med.F90 AdvertiseFields logical :: isPresent character(len=1024) :: msgString type(ESMF_FieldStatus_Flag) :: status @@ -60,6 +61,7 @@ module med_methods_mod public med_methods_FB_getdata3d public med_methods_FB_getmesh public med_methods_FB_check_for_nans + public med_methods_FB_check_wtracers public med_methods_State_reset public med_methods_State_diagnose @@ -1147,6 +1149,7 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) ! local variables character(len=CS) :: lstring + character(len=CL) :: msg real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) real(R8), pointer :: dataPtr3d(:,:,:) @@ -1197,7 +1200,8 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif else - call shr_log_error(subname//": ERROR: unhandled field rank", & + write(msg,'(a,i0)') subname//": ERROR: unhandled field rank ", fieldrank + call shr_log_error(msg, & line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -2653,6 +2657,7 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) integer :: nancount character(len=CS) :: nancount_char character(len=CL) :: msg_error + character(len=CL) :: msg logical :: nanfound character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' ! ---------------------------------------------- @@ -2685,7 +2690,8 @@ subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call med_methods_check_for_nans(dataptr3d, nancount) else - call shr_log_error(subname//": ERROR: unhandled field rank", & + write(msg,'(a,i0)') subname//": ERROR: unhandled field rank ", fieldrank + call shr_log_error(msg, & line=__LINE__, file=u_FILE_u, rc=rc) return end if @@ -2758,4 +2764,119 @@ subroutine med_methods_check_for_nans_3d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_3d + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_wtracers(FB, rc) + + ! ---------------------------------------------- + ! Check all water tracer fields in FB for consistency with their non-water-tracer + ! counterparts + ! + ! Aborts if any inconsistencies are found + ! + ! Should only be called in simulations set up to maintain constant water tracer + ! ratios: in general, water tracers will deviate from their initial, fixed ratios, and + ! so it makes no sense to perform these checks since they will always fail. + ! ---------------------------------------------- + + use wtracers_mod, only : wtracers_get_bulk_fieldname, wtracers_check_tracer_ratios + use ESMF, only : ESMF_FieldBundle, ESMF_Field + use ESMF, only : ESMF_FieldBundleGet, ESMF_FieldGet + + ! input/output arguments + type(ESMF_FieldBundle), intent(in) :: FB + integer, intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR), allocatable :: fieldNameList(:) + character(ESMF_MAXSTR) :: fieldNameNonTracer + character(ESMF_MAXSTR) :: FBName + integer :: n + integer :: fieldrank + logical :: hasSuffix + logical :: isPresentNonTracer + type(ESMF_Field) :: fieldTracers + type(ESMF_Field) :: fieldNonTracer + + ! For 1-d bulk arrays: + real(r8), pointer :: dataTracers2d(:,:) ! dimensioned [tracerNum, gridcell] + real(r8), pointer :: dataNonTracer1d(:) ! dimensioned [gridcell] + + ! For 2-d bulk arrays: + real(r8), pointer :: dataTracers3d(:,:,:) ! dimensioned [ungriddedDim, tracerNum, gridcell] + real(r8), pointer :: dataNonTracer2d(:,:) ! dimensioned [ungriddedDim, gridcell] + + character(len=CL) :: msg + character(len=*), parameter :: subname='(med_methods_FB_check_wtracers)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + if (.not. water_tracers_do_checks) return + + call ESMF_FieldBundleGet(FB, name=FBName, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=fieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": Checking FB: "//trim(FBName), ESMF_LOGMSG_INFO) + end if + + do n = 1, fieldCount + call wtracers_get_bulk_fieldname( & + fieldname=fieldNameList(n), & + is_wtracer_field=hasSuffix, & + bulk_fieldname=fieldNameNonTracer) + if (hasSuffix) then + call ESMF_FieldBundleGet(FB, fieldName=fieldNameNonTracer, isPresent=isPresentNonTracer, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresentNonTracer) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": Checking <" // trim(fieldNameList(n)) // & + "> against <" // trim(fieldNameNonTracer) // ">", & + ESMF_LOGMSG_INFO) + end if + + call ESMF_FieldBundleGet(FB, fieldName=fieldNameList(n), field=fieldTracers, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldNameNonTracer, field=fieldNonTracer, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(fieldNonTracer, rank=fieldrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldrank == 1) then + call ESMF_FieldGet(fieldTracers, farrayPtr=dataTracers2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(fieldNonTracer, farrayPtr=dataNonTracer1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call wtracers_check_tracer_ratios(dataTracers2d, dataNonTracer1d, & + trim(FBName)//":"//trim(fieldNameList(n))) + else if (fieldrank == 2) then + call ESMF_FieldGet(fieldTracers, farrayPtr=dataTracers3d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(fieldNonTracer, farrayPtr=dataNonTracer2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call wtracers_check_tracer_ratios(dataTracers3d, dataNonTracer2d, & + trim(FBName)//":"//trim(fieldNameList(n))) + else + write(msg,'(a,i0)') subname//": ERROR: unhandled field rank ", fieldrank + call shr_log_error(msg, & + line=__LINE__, file=u_FILE_u, rc=rc) + return + end if + else + ! This is the situation for a small number of fields where we have a tracer + ! field without a corresponding non-tracer field. + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": Skipping check for <" // trim(fieldNameList(n)) // & + "> which has no corresponding non-tracer field", ESMF_LOGMSG_INFO) + end if + end if + end if + end do + + end subroutine med_methods_FB_check_wtracers + end module med_methods_mod diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 333497a69..a28d2bec9 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -33,6 +33,7 @@ subroutine med_phases_post_atm(gcomp, rc) use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr + use med_methods_mod , only : med_methods_FB_check_wtracers use med_internalstate_mod , only : compocn, compatm, compice, complnd, compwav use perf_mod , only : t_startf, t_stopf @@ -58,6 +59,11 @@ subroutine med_phases_post_atm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(compatm,compatm), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! map atm to ocn if (is_local%wrap%med_coupling_active(compatm,compocn)) then call t_startf('MED:'//trim(subname)//' map_atm2ocn') diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 311324229..3e08e07c0 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -24,6 +24,7 @@ module med_phases_post_glc_mod use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d + use med_methods_mod , only : med_methods_FB_check_wtracers use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_rh_is_created, med_map_routehandles_init @@ -151,6 +152,13 @@ subroutine med_phases_post_glc(gcomp, rc) end if end if + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + do ns = 1,is_local%wrap%num_icesheets + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(compglc(ns),compglc(ns)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + !--------------------------------------- ! glc->rof mapping !--------------------------------------- diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index 739369525..41e92b27e 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -26,6 +26,7 @@ subroutine med_phases_post_ice(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : med_methods_FB_check_wtracers use med_map_mod , only : med_map_field_packed use med_fraction_mod , only : med_fraction_set use med_internalstate_mod , only : InternalState @@ -55,6 +56,11 @@ subroutine med_phases_post_ice(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(compice,compice), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! update ice fraction call med_fraction_set(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index 589698fad..cf9c344d1 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -22,6 +22,7 @@ subroutine med_phases_post_lnd(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : med_methods_FB_check_wtracers use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum @@ -52,6 +53,11 @@ subroutine med_phases_post_lnd(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(complnd,complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index 5913e7258..43a148440 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -30,6 +30,7 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_internalstate_mod , only : compice, compocn, compwav use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn + use med_methods_mod , only : med_methods_FB_check_wtracers use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -54,6 +55,11 @@ subroutine med_phases_post_ocn(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(compocn,compocn), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Map ocn->ice if (is_local%wrap%med_coupling_active(compocn,compice)) then call t_startf('MED:'//trim(subname)//' map_ocn2ice') diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index 5d623fc76..d5c0bce40 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -22,6 +22,7 @@ module med_phases_post_rof_mod use med_methods_mod , only : fldbun_copy => med_methods_FB_copy use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh + use med_methods_mod , only : med_methods_FB_check_wtracers use med_field_info_mod , only : med_field_info_type, med_field_info_create_from_field use med_field_info_mod , only : med_field_info_esmf_fieldcreate use perf_mod , only : t_startf, t_stopf @@ -136,6 +137,11 @@ subroutine med_phases_post_rof(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(comprof,comprof), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, num_rof_fields call fldbun_copy(FBrof_r, is_local%wrap%FBImp(comprof,comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 50592012c..0c8004c96 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -22,6 +22,7 @@ subroutine med_phases_post_wav(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : med_methods_FB_check_wtracers use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compwav, compatm, compocn, compice @@ -50,6 +51,11 @@ subroutine med_phases_post_wav(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBImp(compwav,compwav), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! map wav to atm if (is_local%wrap%med_coupling_active(compwav,compatm)) then call med_map_field_packed( & diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 359c81222..c2b30d13d 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -15,6 +15,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed use med_internalstate_mod , only : InternalState, maintask, logunit, samegrid_atmlnd @@ -256,6 +257,11 @@ subroutine med_phases_prep_atm(gcomp, rc) call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compatm), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index d9635a692..774be0424 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -29,21 +29,27 @@ module med_phases_prep_glc_mod use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : shr_const_pi, shr_const_spval use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh + use med_methods_mod , only : fldbun_getdata3d => med_methods_FB_getdata3d use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : fldbun_accum => med_methods_FB_accum + use med_methods_mod , only : fldbun_average => med_methods_FB_average + use med_methods_mod , only : fldbun_copy => med_methods_FB_copy use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : fldchk => med_methods_FB_FldChk + use med_methods_mod , only : med_methods_FB_check_wtracers use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use med_utils_mod , only : chkerr => med_utils_ChkErr use nuopc_shr_methods , only : alarmInit use glc_elevclass_mod , only : glc_get_num_elevation_classes use glc_elevclass_mod , only : glc_get_elevation_classes use glc_elevclass_mod , only : glc_get_fractional_icecov + use wtracers_mod , only : wtracers_present, wtracers_get_num_tracers, WTRACERS_SUFFIX use perf_mod , only : t_startf, t_stopf use shr_log_mod , only : shr_log_error @@ -58,6 +64,9 @@ module med_phases_prep_glc_mod private :: med_phases_prep_glc_map_lnd2glc private :: med_phases_prep_glc_renormalize_smb + private :: renormalize_smb_accumulate_sums_l + private :: renormalize_smb_accumulate_sums_g + private :: renormalize_smb_do_renormalization ! ----------------- ! lnd -> glc @@ -96,10 +105,15 @@ module med_phases_prep_glc_mod type(ESMF_Field) :: field_frac_l_ec character(len=*), parameter :: qice_fieldname = 'Flgl_qice' ! Name of flux field giving surface mass balance + character(len=*), parameter :: qice_elev_fieldname = 'Flgl_qice_elev' ! Name of flux field giving surface mass balance, separated by elevation class + character(len=*), parameter :: qice_wtracers_fieldname = qice_fieldname//WTRACERS_SUFFIX + character(len=*), parameter :: qice_elev_wtracers_fieldname = qice_elev_fieldname//WTRACERS_SUFFIX character(len=*), parameter :: Sg_frac_fieldname = 'Sg_ice_covered' character(len=*), parameter :: Sg_topo_fieldname = 'Sg_topo' character(len=*), parameter :: Sg_icemask_fieldname = 'Sg_icemask' integer :: ungriddedCount ! this equals the number of elevation classes + 1 (for bare land) + logical :: has_wtracers ! true if this simulation has water tracers + integer :: num_wtracers ! number of water tracers in this simulation ! ----------------- ! ocn -> glc @@ -157,6 +171,14 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! allocate module variables allocate(toglc_frlnd(is_local%wrap%num_icesheets)) + ! Check whether this simulation has water tracers + has_wtracers = wtracers_present() + if (has_wtracers) then + num_wtracers = wtracers_get_num_tracers() + else + num_wtracers = 0 + end if + ! ------------------------------- ! If will accumulate lnd2glc input on land grid ! ------------------------------- @@ -187,6 +209,18 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call ESMF_LogWrite(trim(subname)//' adding field '//trim(fldnames_fr_lnd(n))//' to FBLndAccum_l', & ESMF_LOGMSG_INFO) end do + if (has_wtracers) then + lfield = ESMF_FieldCreate(mesh_l, ESMF_TYPEKIND_R8, name=qice_elev_wtracers_fieldname, & + meshloc=ESMF_MESHLOC_ELEMENT, & + ! Note the assumption of dimension ordering here: [elev, wtracer, gridcell] + ungriddedLbound=(/1,1/), ungriddedUbound=(/ungriddedCount, num_wtracers/), gridToFieldMap=(/3/), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(FBlndAccum2glc_l, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//' adding field '//qice_elev_wtracers_fieldname//' to FBLndAccum_l', & + ESMF_LOGMSG_INFO) + end if call fldbun_reset(FBlndAccum2glc_l, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -215,6 +249,16 @@ subroutine med_phases_prep_glc_init(gcomp, rc) call ESMF_FieldBundleAdd(toglc_frlnd(ns)%FBlndAccum2glc_g, (/lfield/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end do + if (has_wtracers) then + lfield = ESMF_FieldCreate(toglc_frlnd(ns)%mesh_g, ESMF_TYPEKIND_R8, name=qice_elev_wtracers_fieldname, & + meshloc=ESMF_MESHLOC_ELEMENT, & + ! Note the assumption of dimension ordering here: [elev, wtracer, gridcell] + ungriddedLbound=(/1,1/), ungriddedUbound=(/ungriddedCount, num_wtracers/), gridToFieldMap=(/3/), & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleAdd(toglc_frlnd(ns)%FBlndAccum2glc_g, (/lfield/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -375,9 +419,6 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,n - real(r8), pointer :: data2d_in(:,:) - real(r8), pointer :: data2d_out(:,:) character(len=*),parameter :: subname=' (med_phases_prep_glc_accum) ' !--------------------------------------- @@ -394,15 +435,8 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Accumulate fields from land on land mesh that will be sent to glc - do n = 1, size(fldnames_fr_lnd) - call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_in, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d_out, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data2d_out, dim=2) - data2d_out(:,i) = data2d_out(:,i) + data2d_in(:,i) - end do - end do + call fldbun_accum(FBout=FBlndAccum2glc_l, FBin=is_local%wrap%FBImp(complnd,complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return lndAccum2glc_cnt = lndAccum2glc_cnt + 1 if (dbug_flag > 1) then call fldbun_diagnose(FBlndAccum2glc_l, string=trim(subname)// ' FBlndAccum2glc_l ', rc=rc) @@ -622,22 +656,16 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (do_avg) then ! Always average import from accumulated land import data - do n = 1, size(fldnames_fr_lnd) - if (fldchk(FBlndAccum2glc_l, fldnames_fr_lnd(n), rc=rc)) then - call fldbun_getdata2d(FBlndAccum2glc_l, fldnames_fr_lnd(n), data2d, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lndAccum2glc_cnt > 0) then - ! If accumulation count is greater than 0, do the averaging - data2d(:,:) = data2d(:,:) / real(lndAccum2glc_cnt, R8) - else - ! If accumulation count is 0, then simply set the averaged field bundle values from the land - ! to the import field bundle values - call fldbun_getdata2d(is_local%wrap%FBImp(complnd,complnd), fldnames_fr_lnd(n), data2d_import, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - data2d(:,:) = data2d_import(:,:) - end if - end if - end do + if (lndAccum2glc_cnt > 0) then + ! If accumulation count is greater than 0, do the averaging + call fldbun_average(FB=FBlndAccum2glc_l, count=lndAccum2glc_cnt, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! If accumulation count is 0, then simply set the averaged field bundle values from the land + ! to the import field bundle values + call fldbun_copy(FBout=FBlndAccum2glc_l, FBin=is_local%wrap%FBImp(complnd,complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data @@ -730,6 +758,13 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end do end if + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + do ns = 1,is_local%wrap%num_icesheets + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compglc(ns)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -766,8 +801,10 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) real(r8), pointer :: topoglc_g(:) ! ice topographic height on the glc grid extracted from glc import real(r8), pointer :: ice_covered_g(:) ! if points on the glc grid is ice-covered (1) or ice-free (0) integer , pointer :: elevclass_g(:) ! elevation classes glc grid - real(r8), pointer :: dataexp_g(:) ! pointer into + real(r8), pointer :: dataexp1d_g(:) + real(r8), pointer :: dataexp2d_g(:,:) real(r8), pointer :: dataptr2d(:,:) + real(r8), pointer :: dataptr3d(:,:,:) real(r8) :: elev_l, elev_u ! lower and upper elevations in interpolation range real(r8) :: d_elev ! elev_u - elev_l integer :: nfld, ec @@ -775,7 +812,7 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) integer, allocatable :: index_upper(:) ! upper EC index for vertical interpolation, per glc gridcell real(r8), allocatable :: weight_lower(:) ! weight for lower EC, per glc gridcell real(r8), allocatable :: weight_upper(:) ! weight for upper EC, per glc gridcell - integer :: n,lsize_g,ns + integer :: n,lsize_g,ns,t type(ESMF_Field) :: field_lfrac_l integer :: fieldCount character(len=3) :: cnum @@ -790,16 +827,10 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ------------------------------------------------------------------------ - ! Map the accumulate land field from the land grid (in multiple elevation classes) + ! Map the accumulated land field from the land grid (in multiple elevation classes) ! to the glc grid (in multiple elevation classes) using bilinear interpolation ! ------------------------------------------------------------------------ - ! Initialize accumulated field bundle on the glc grid to zero before doing the mapping - do ns = 1,is_local%wrap%num_icesheets - call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - ! TODO(wjs, 2015-01-20) This implies that we pass data to CISM even in places that ! CISM says is ocean (so CISM will ignore the incoming value). This differs from the ! current glint implementation, which sets acab and artm to 0 over ocean (although @@ -818,12 +849,10 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) call ESMF_FieldBundleGet(is_local%wrap%FBFrac(complnd), fieldName=map_fracname_lnd2glc, field=field_lfrac_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! map accumlated land fields to each ice sheet (normalize by the land fraction in the mapping) + ! map accumulated land fields to each ice sheet (normalize by the land fraction in the mapping) do ns = 1,is_local%wrap%num_icesheets call fldbun_reset(toglc_frlnd(ns)%FBlndAccum2glc_g, value=0.0_r8, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - do ns = 1,is_local%wrap%num_icesheets call ESMF_FieldBundleGet(toglc_frlnd(ns)%FBlndAccum2glc_g, fieldlist=fieldlist_glc, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do nfld = 1,fieldcount @@ -953,26 +982,60 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Get a pointer to the data for the field that will be sent to glc (without elevation classes) - call fldbun_getdata1d(is_local%wrap%FBExp(compglc(ns)), fldnames_to_glc(nfld), dataexp_g, rc) + call fldbun_getdata1d(is_local%wrap%FBExp(compglc(ns)), fldnames_to_glc(nfld), dataexp1d_g, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return ! Apply pre-computed vertical interpolation indices and weights do n = 1, lsize_g if (elevclass_g(n) /= 0) then ! ice-covered cells: vertically interpolate between bounding ECs - dataexp_g(n) = dataptr2d(index_lower(n), n) * weight_lower(n) & - + dataptr2d(index_upper(n), n) * weight_upper(n) + dataexp1d_g(n) = dataptr2d(index_lower(n), n) * weight_lower(n) & + + dataptr2d(index_upper(n), n) * weight_upper(n) else ! non ice-covered cells: use bare land value (EC index 1) - dataexp_g(n) = dataptr2d(1, n) + dataexp1d_g(n) = dataptr2d(1, n) end if - end do ! end of loop over land points + end do end do ! end loop over fields (nflds) ! ------------------------------------------------------------------------ - ! Renormalize surface mass balance (smb, here named dataexp_g) so that the global - ! integral on the glc grid is equal to the global integral on the land grid. + ! Now do an equivalent vertical interpolation for the qice water tracer field. This + ! needs to be handled separately from the above loop because there is an extra + ! dimension in this field. + ! ------------------------------------------------------------------------ + + if (has_wtracers) then + + ! Get a pointer to the land data in multiple elevation classes on the glc grid + call fldbun_getdata3d(toglc_frlnd(ns)%FBlndAccum2glc_g, qice_elev_wtracers_fieldname, dataptr3d, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Get a pointer to the data for the field that will be sent to glc (without elevation classes) + call fldbun_getdata2d(is_local%wrap%FBExp(compglc(ns)), qice_wtracers_fieldname, dataexp2d_g, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + ! Apply pre-computed vertical interpolation indices and weights + do n = 1, lsize_g + if (elevclass_g(n) /= 0) then + ! ice-covered cells: vertically interpolate between bounding ECs + do t = 1, num_wtracers + dataexp2d_g(t, n) = dataptr3d(index_lower(n), t, n) * weight_lower(n) & + + dataptr3d(index_upper(n), t, n) * weight_upper(n) + end do + else + ! non ice-covered cells: use bare land value (EC index 1) + do t = 1, num_wtracers + dataexp2d_g(t, n) = dataptr3d(1, t, n) + end do + end if + end do + + end if + + ! ------------------------------------------------------------------------ + ! Renormalize surface mass balance (smb) so that the global integral on the glc + ! grid is equal to the global integral on the land grid. ! ------------------------------------------------------------------------ ! No longer need to make a preemptive adjustment to qice_g to account for area differences @@ -1062,7 +1125,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm real(r8) , pointer :: qice_g(:) ! SMB (Flgl_qice) on glc grid without elev classes - real(r8) , pointer :: qice_l_ec(:,:) ! SMB (Flgl_qice) on land grid with elev classes + real(r8) , pointer :: qice_l_ec(:,:) ! SMB (Flgl_qice_elev) on land grid with elev classes + real(r8) , pointer :: qice_g_wtracers(:,:) ! SMB water tracers (Flgl_qice_wtracers) on glc grid without elev classes + real(r8) , pointer :: qice_l_ec_wtracers(:,:,:) ! SMB water tracers (Flgl_qice_elev_wtracers) on land grid with elev classes real(r8) , pointer :: topo_g(:) ! ice topographic height on the glc grid cell real(r8) , pointer :: frac_g(:) ! total ice fraction in each glc cell real(r8) , pointer :: frac_g_ec(:,:) ! total ice fraction in each glc cell @@ -1071,19 +1136,17 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: icemask_l(:) ! icemask on land grid real(r8) , pointer :: lndfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer - integer :: ec ! loop index over elevation classes - integer :: n + integer :: n, t ! local and global sums of accumulation and ablation; used to compute renormalization factors - real(r8) :: local_accum_lnd(1), global_accum_lnd(1) - real(r8) :: local_accum_glc(1), global_accum_glc(1) - real(r8) :: local_ablat_lnd(1), global_ablat_lnd(1) - real(r8) :: local_ablat_glc(1), global_ablat_glc(1) - - ! renormalization factors (should be close to 1, e.g. in range 0.95 to 1.05) - real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids - real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids - real(r8) :: effective_area ! grid cell area multiplied by min(lndfrac,icemask_l). + ! the first element of each of these is for bulk water; the remaining elements are for water tracers + real(r8) :: local_accum_lnd(1+num_wtracers), global_accum_lnd(1+num_wtracers) + real(r8) :: local_accum_glc(1+num_wtracers), global_accum_glc(1+num_wtracers) + real(r8) :: local_ablat_lnd(1+num_wtracers), global_ablat_lnd(1+num_wtracers) + real(r8) :: local_ablat_glc(1+num_wtracers), global_ablat_glc(1+num_wtracers) + + ! areas + real(r8), allocatable :: effective_area_l(:) ! effective areas on the land grid: grid cell area multiplied by min(lndfrac,icemask_l). real(r8), pointer :: area_g(:) ! areas on glc grid character(len=*), parameter :: subname=' (renormalize_smb) ' !--------------------------------------------------------------- @@ -1167,83 +1230,208 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call fldbun_getdata1d(is_local%wrap%FBFrac(complnd), map_fracname_lnd2glc, lndfrac, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - ! get qice_l_ec - call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_fieldname)//'_elev', qice_l_ec, rc) + allocate(effective_area_l(size(lndfrac))) + do n = 1, size(lndfrac) + effective_area_l(n) = min(lndfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) + end do + + ! determine accumulation and ablation sums for qice on the land grid + call fldbun_getdata2d(FBlndAccum2glc_l, trim(qice_elev_fieldname), qice_l_ec, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + call renormalize_smb_accumulate_sums_l(qice_l_ec, effective_area_l, frac_l_ec, & + local_accum_lnd(1), local_ablat_lnd(1)) - local_accum_lnd(1) = 0.0_r8 - local_ablat_lnd(1) = 0.0_r8 - do n = 1, size(lndfrac) - ! Calculate effective area for sum - need the mapped icemask_l - effective_area = min(lndfrac(n), icemask_l(n)) * is_local%wrap%mesh_info(complnd)%areas(n) - if (effective_area > 0.0_r8) then - do ec = 1, ungriddedCount - if (qice_l_ec(ec,n) >= 0.0_r8) then - local_accum_lnd(1) = local_accum_lnd(1) + effective_area * frac_l_ec(ec,n) * qice_l_ec(ec,n) - else - local_ablat_lnd(1) = local_ablat_lnd(1) + effective_area * frac_l_ec(ec,n) * qice_l_ec(ec,n) - endif - end do ! ec - end if ! if landmaks > 0 - enddo ! n + ! and, similarly, determine accumulation and ablation sums for qice water tracers on the land grid + if (has_wtracers) then + call fldbun_getdata3d(FBlndAccum2glc_l, trim(qice_elev_wtracers_fieldname), qice_l_ec_wtracers, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + do t = 1, num_wtracers + call renormalize_smb_accumulate_sums_l(qice_l_ec_wtracers(:,t,:), effective_area_l, frac_l_ec, & + local_accum_lnd(1+t), local_ablat_lnd(1+t)) + end do + end if + deallocate(effective_area_l) + + ! determine global accum/ablat on the land grid call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_accum_lnd, recvdata=global_accum_lnd, count=1, & + call ESMF_VMAllreduce(vm, senddata=local_accum_lnd, recvdata=global_accum_lnd, count=1+num_wtracers, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMAllreduce(vm, senddata=local_ablat_lnd, recvdata=global_ablat_lnd, count=1, & + call ESMF_VMAllreduce(vm, senddata=local_ablat_lnd, recvdata=global_ablat_lnd, count=1+num_wtracers, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (maintask) then - write(logunit,'(a,d21.10)') trim(subname)//'global_accum_lnd = ', global_accum_lnd - write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_lnd = ', global_ablat_lnd + write(logunit,'(a,d21.10)') trim(subname)//'global_accum_lnd = ', global_accum_lnd(1) + write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_lnd = ', global_ablat_lnd(1) + do t = 1, num_wtracers + write(logunit,'(a,i0,a,d21.10)') trim(subname)//'tracer #', t, & + ': global_accum_lnd = ', global_accum_lnd(1+t) + write(logunit,'(a,i0,a,d21.10)') trim(subname)//'tracer #', t, & + ': global_ablat_lnd = ', global_ablat_lnd(1+t) + end do endif !--------------------------------------- ! Sum qice_g over local glc grid cells. !--------------------------------------- - ! determine qice_g - call fldbun_getdata1d(is_local%wrap%FBExp(compglc(ns)), qice_fieldname, qice_g, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! get areas internal to glc grid call fldbun_getdata1d(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Sg_area', area_g, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - local_accum_glc(1) = 0.0_r8 - local_ablat_glc(1) = 0.0_r8 - do n = 1, size(qice_g) - if (qice_g(n) >= 0.0_r8) then - local_accum_glc(1) = local_accum_glc(1) + icemask_g(n) * area_g(n) * qice_g(n) - else - local_ablat_glc(1) = local_ablat_glc(1) + icemask_g(n) * area_g(n) * qice_g(n) - endif - enddo ! n - call ESMF_VMAllreduce(vm, senddata=local_accum_glc, recvdata=global_accum_glc, count=1, & + ! determine accumulation and ablation sums for qice on the glc grid + call fldbun_getdata1d(is_local%wrap%FBExp(compglc(ns)), qice_fieldname, qice_g, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call renormalize_smb_accumulate_sums_g(qice_g, icemask_g, area_g, & + local_accum_glc(1), local_ablat_glc(1)) + + ! and, similarly, determine accumulation and ablation sums for qice water tracers on the glc grid + if (has_wtracers) then + call fldbun_getdata2d(is_local%wrap%FBExp(compglc(ns)), qice_wtracers_fieldname, qice_g_wtracers, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do t = 1, num_wtracers + call renormalize_smb_accumulate_sums_g(qice_g_wtracers(t,:), icemask_g, area_g, & + local_accum_glc(1+t), local_ablat_glc(1+t)) + end do + end if + + ! determine global accum/ablat on the glc grid + call ESMF_VMAllreduce(vm, senddata=local_accum_glc, recvdata=global_accum_glc, count=1+num_wtracers, & reduceflag=ESMF_REDUCE_SUM, rc=rc) - call ESMF_VMAllreduce(vm, senddata=local_ablat_glc, recvdata=global_ablat_glc, count=1, & + call ESMF_VMAllreduce(vm, senddata=local_ablat_glc, recvdata=global_ablat_glc, count=1+num_wtracers, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (maintask) then - write(logunit,'(a,d21.10)') trim(subname)//'global_accum_glc = ', global_accum_glc - write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_glc = ', global_ablat_glc + write(logunit,'(a,d21.10)') trim(subname)//'global_accum_glc = ', global_accum_glc(1) + write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_glc = ', global_ablat_glc(1) + do t = 1, num_wtracers + write(logunit,'(a,i0,a,d21.10)') trim(subname)//'tracer #', t, & + ': global_accum_glc = ', global_accum_glc(1+t) + write(logunit,'(a,i0,a,d21.10)') trim(subname)//'tracer #', t, & + ': global_ablat_glc = ', global_ablat_glc(1+t) + end do endif - ! Renormalize - if (global_accum_glc(1) > 0.0_r8) then - accum_renorm_factor = global_accum_lnd(1) / global_accum_glc(1) + ! finally, do the actual renormalization + call renormalize_smb_do_renormalization(global_accum_lnd(1), global_ablat_lnd(1), & + global_accum_glc(1), global_ablat_glc(1), subname, qice_g) + do t = 1, num_wtracers + call renormalize_smb_do_renormalization(global_accum_lnd(1+t), global_ablat_lnd(1+t), & + global_accum_glc(1+t), global_ablat_glc(1+t), subname, qice_g_wtracers(t,:), & + tracer_num=t) + end do + + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_glc_renormalize_smb + + !================================================================================================ + subroutine renormalize_smb_accumulate_sums_l(qice_l_ec, effective_area_l, frac_l_ec, & + accum_l, ablat_l) + + ! Compute local accumulation and ablation sums on land grid + + ! input/output variables + real(r8), intent(in) :: qice_l_ec(:,:) + real(r8), intent(in) :: effective_area_l(:) + real(r8), intent(in) :: frac_l_ec(:,:) + real(r8), intent(out) :: accum_l + real(r8), intent(out) :: ablat_l + + ! local variables + integer :: n, ec + !--------------------------------------------------------------- + + accum_l = 0.0_r8 + ablat_l = 0.0_r8 + do n = 1, size(effective_area_l) + if (effective_area_l(n) > 0.0_r8) then + do ec = 1, ungriddedCount + if (qice_l_ec(ec,n) >= 0.0_r8) then + accum_l = accum_l + effective_area_l(n) * frac_l_ec(ec,n) * qice_l_ec(ec,n) + else + ablat_l = ablat_l + effective_area_l(n) * frac_l_ec(ec,n) * qice_l_ec(ec,n) + end if + end do + end if + end do + + end subroutine renormalize_smb_accumulate_sums_l + + !================================================================================================ + subroutine renormalize_smb_accumulate_sums_g(qice_g, icemask_g, area_g, & + accum_g, ablat_g) + + ! Compute local accumulation and ablation sums on glc grid + + ! input/output variables + real(r8), intent(in) :: qice_g(:) + real(r8), intent(in) :: icemask_g(:) + real(r8), intent(in) :: area_g(:) + real(r8), intent(out) :: accum_g + real(r8), intent(out) :: ablat_g + + ! local variables + integer :: n + !--------------------------------------------------------------- + + accum_g = 0.0_r8 + ablat_g = 0.0_r8 + do n = 1, size(qice_g) + if (qice_g(n) >= 0.0_r8) then + accum_g = accum_g + icemask_g(n) * area_g(n) * qice_g(n) + else + ablat_g = ablat_g + icemask_g(n) * area_g(n) * qice_g(n) + end if + end do + + end subroutine renormalize_smb_accumulate_sums_g + + !================================================================================================ + subroutine renormalize_smb_do_renormalization(global_accum_lnd, global_ablat_lnd, & + global_accum_glc, global_ablat_glc, caller_subname, qice_g, tracer_num) + + ! Perform renormalization of qice_g using global sums + + ! input/output variables + real(r8), intent(in) :: global_accum_lnd + real(r8), intent(in) :: global_ablat_lnd + real(r8), intent(in) :: global_accum_glc + real(r8), intent(in) :: global_ablat_glc + character(len=*), intent(in) :: caller_subname ! for diagnostic output + real(r8), intent(inout) :: qice_g(:) + integer, intent(in), optional :: tracer_num ! for diagnostic output + + ! local variables + integer :: n + + ! renormalization factors (should be close to 1, e.g. in range 0.95 to 1.05) + real(r8) :: accum_renorm_factor ! ratio between global accumulation on the two grids + real(r8) :: ablat_renorm_factor ! ratio between global ablation on the two grids + + !--------------------------------------------------------------- + + if (global_accum_glc > 0.0_r8) then + accum_renorm_factor = global_accum_lnd / global_accum_glc else accum_renorm_factor = 0.0_r8 endif - if (global_ablat_glc(1) < 0.0_r8) then ! negative by definition - ablat_renorm_factor = global_ablat_lnd(1) / global_ablat_glc(1) + if (global_ablat_glc < 0.0_r8) then ! negative by definition + ablat_renorm_factor = global_ablat_lnd / global_ablat_glc else ablat_renorm_factor = 0.0_r8 endif if (maintask) then - write(logunit,'(a,d21.10)') trim(subname)//'accum_renorm_factor = ', accum_renorm_factor - write(logunit,'(a,d21.10)') trim(subname)//'ablat_renorm_factor = ', ablat_renorm_factor + if (present(tracer_num)) then + write(logunit,'(a,i0,a,d21.10)') trim(caller_subname)//'tracer #', tracer_num, & + ': accum_renorm_factor = ', accum_renorm_factor + write(logunit,'(a,i0,a,d21.10)') trim(caller_subname)//'tracer #', tracer_num, & + ': ablat_renorm_factor = ', ablat_renorm_factor + else + write(logunit,'(a,d21.10)') trim(caller_subname)//'accum_renorm_factor = ', accum_renorm_factor + write(logunit,'(a,d21.10)') trim(caller_subname)//'ablat_renorm_factor = ', ablat_renorm_factor + endif endif do n = 1, size(qice_g) @@ -1252,11 +1440,9 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) else qice_g(n) = qice_g(n) * ablat_renorm_factor endif - enddo - - call t_stopf('MED:'//subname) + end do - end subroutine med_phases_prep_glc_renormalize_smb + end subroutine renormalize_smb_do_renormalization !================================================================================================ subroutine dynOcnMaskProc(dynamicMaskList, dynamicSrcMaskValue, dynamicDstMaskValue, rc) diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index bcaf5d286..e1898b41d 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -154,6 +155,11 @@ subroutine med_phases_prep_ice(gcomp, rc) call FB_check_for_nans(is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compice), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index a8c298042..a50a609f0 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -30,6 +30,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm @@ -132,6 +133,11 @@ subroutine med_phases_prep_lnd(gcomp, rc) call FB_check_for_nans(is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(complnd), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 8ddbeb37c..ed81f5014 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -21,6 +21,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode @@ -100,7 +101,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use med_constants_mod , only : shr_const_cpsw, shr_const_cpfw, shr_const_cpice, shr_const_tkfrz, shr_const_pi + use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi + use med_constants_mod , only : shr_const_cpice + use med_constants_mod , only : shr_const_cpfw use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_runoff @@ -256,9 +259,10 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw - hrofi(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi(n) * shr_const_cpsw hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw - hrofi_glc(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * rofi_glc(n) * shr_const_cpsw + ! −10 C is a reasonable bulk temperature assumption for iceberg/land-ice runoff + hrofi(n) = -10._r8 * rofi(n) * shr_const_cpice + hrofi_glc(n) = -10._r8 * rofi_glc(n) * shr_const_cpice end do if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm @@ -474,6 +478,12 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compocn), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 465a03158..dc5507733 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -26,6 +26,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_field_info_mod , only : med_field_info_type use med_field_info_mod , only : med_field_info_create_directly, med_field_info_create_from_field use med_field_info_mod , only : med_field_info_esmf_fieldcreate @@ -418,6 +419,11 @@ subroutine med_phases_prep_rof(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(comprof), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- ! zero accumulator and FBAccum !--------------------------------------- diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index f732f4dc6..bd97b4006 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -18,6 +18,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans + use med_methods_mod , only : med_methods_FB_check_wtracers use med_field_info_mod , only : med_field_info_type, med_field_info_array_from_state use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compatm, compwav @@ -214,6 +215,11 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_check_for_nans(is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check water tracers (if there are no water tracers or these checks aren't enabled, + ! this will return without doing anything) + call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compwav), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 4dc72c43a..66753587b 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -348,7 +348,7 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_enddef(io_file) end if - tbnds = days_since + tbnds = (/days_since,days_since/) call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) @@ -356,7 +356,7 @@ subroutine med_phases_restart_write(gcomp, rc) call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=tbnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/ufs/wtracers_mod.F90 b/ufs/wtracers_mod.F90 index 17d2f3014..3fed9dcbf 100644 --- a/ufs/wtracers_mod.F90 +++ b/ufs/wtracers_mod.F90 @@ -8,13 +8,57 @@ module wtracers_mod ! the CESM_share library. !----------------------------------------------------------------------------- + use shr_kind_mod , only : r8=>SHR_KIND_R8 + implicit none private - public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + public :: wtracers_present ! return true if there are water tracers in this simulation + public :: wtracers_get_num_tracers ! get number of water tracers in this simulation + public :: wtracers_is_wtracer_field ! return true if the given field name is a water tracer field + public :: wtracers_get_bulk_fieldname ! return the name of the equivalent bulk field corresponding to a water tracer field + public :: wtracers_check_tracer_ratios ! check tracer ratios against expectations + + interface wtracers_check_tracer_ratios + module procedure wtracers_check_tracer_ratios_1d + module procedure wtracers_check_tracer_ratios_2d + end interface wtracers_check_tracer_ratios + + ! Suffix for water tracer field names + character(len=*), parameter, public :: WTRACERS_SUFFIX = "_wtracers" contains + !----------------------------------------------------------------------- + function wtracers_present() + ! + ! !DESCRIPTION: + ! Return true if there are water tracers in this simulation + ! + ! In this stub implementation, we always return false, since water tracers are not + ! implemented here. + ! + ! !ARGUMENTS + logical :: wtracers_present ! function result + !----------------------------------------------------------------------- + wtracers_present = .false. + end function wtracers_present + + !----------------------------------------------------------------------- + function wtracers_get_num_tracers() + ! + ! !DESCRIPTION: + ! Get number of water tracers in this simulation + ! + ! In this stub implementation, we always return 0, since water tracers are not + ! implemented here. + ! + ! !ARGUMENTS + integer :: wtracers_get_num_tracers ! function result + !----------------------------------------------------------------------- + wtracers_get_num_tracers = 0 + end function wtracers_get_num_tracers + !----------------------------------------------------------------------- function wtracers_is_wtracer_field(fieldname) ! @@ -31,4 +75,56 @@ function wtracers_is_wtracer_field(fieldname) wtracers_is_wtracer_field = .false. end function wtracers_is_wtracer_field + !----------------------------------------------------------------------- + subroutine wtracers_get_bulk_fieldname(fieldname, is_wtracer_field, bulk_fieldname) + ! + ! !DESCRIPTION: + ! Return the name of the equivalent bulk field corresponding to a water tracer field + ! + ! In this stub implementation, we always return false for is_wtracer_field, and set + ! bulk_fieldname equal to fieldname, since water tracers are not implemented here. + ! + ! !ARGUMENTS + character(len=*), intent(in) :: fieldname + logical , intent(out) :: is_wtracer_field + character(len=*), intent(out) :: bulk_fieldname + !----------------------------------------------------------------------- + is_wtracer_field = .false. + bulk_fieldname = fieldname + end subroutine wtracers_get_bulk_fieldname + + !----------------------------------------------------------------------- + subroutine wtracers_check_tracer_ratios_1d(tracers, bulk, name) + ! + ! !DESCRIPTION: + ! Check tracer ratios (tracer/bulk) against expectations + ! + ! In this stub implementation, we simply return without doing anything + ! + ! !ARGUMENTS + real(r8), intent(in) :: tracers(:,:) ! dimensioned [tracerNum, gridcell] + real(r8), intent(in) :: bulk(:) + character(len=*), intent(in) :: name ! for diagnostic output + !----------------------------------------------------------------------- + + ! Do nothing + end subroutine wtracers_check_tracer_ratios_1d + + !----------------------------------------------------------------------- + subroutine wtracers_check_tracer_ratios_2d(tracers, bulk, name) + ! + ! !DESCRIPTION: + ! Check tracer ratios (tracer/bulk) against expectations for 2-d bulk arrays + ! + ! In this stub implementation, we simply return without doing anything + ! + ! !ARGUMENTS + real(r8), intent(in) :: tracers(:,:,:) ! dimensioned [ungriddedDim, tracerNum, gridcell] + real(r8), intent(in) :: bulk(:,:) ! dimensioned [ungriddedDim, gridcell] + character(len=*), intent(in) :: name ! for diagnostic output + !----------------------------------------------------------------------- + + ! Do nothing + end subroutine wtracers_check_tracer_ratios_2d + end module wtracers_mod From 45adcc474a67b595f520974bebbb595ebefcb4cf Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 22 May 2026 12:19:06 +0200 Subject: [PATCH 126/135] fixed invalid flag --- .github/workflows/srt.yml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 0abf1fb30..abb2b0b0f 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -176,17 +176,17 @@ jobs: # How to download artifacts: # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts - - name: Upload test logs - if: ${{ failure() }} - steps: - - name: Tar test logs - run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch - - name: save artifact - uses: actions/upload-artifact@v4 - with: - name: test-logs-${{ matrix.python-version }} - path: scratch-${{ matrix.python-version }}.tar.gz - retention-days: 4 + # - name: Upload test logs + # if: ${{ failure() }} + # steps: + # - name: Tar test logs + # run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch + # - name: save artifact + # uses: actions/upload-artifact@v4 + # with: + # name: test-logs-${{ matrix.python-version }} + # path: scratch-${{ matrix.python-version }}.tar.gz + # retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session From b77515de7e3f47e20c4b71fef35bcbc958f47135 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 Jul 2026 21:00:35 +0200 Subject: [PATCH 127/135] made wav_ice_coupling on for noresm if components include ww3 and cice --- cime_config/buildnml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index f9385cabc..23c16f4e0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -145,7 +145,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # determine coupling mode config["coupling_mode"] = case.get_value("COUPLING_MODE") - if config["coupling_mode"] == "cesm" and config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': + if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': config["wav_ice_coupling"] = "on" if config["COMP_OCN"] == "blom": From 3d2dbab589ab095f2fca94b8e51ab07cc02eb89a Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 7 Jul 2026 11:55:24 +0200 Subject: [PATCH 128/135] updated condition for wav_ice_coupling --- cime_config/buildnml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/cime_config/buildnml b/cime_config/buildnml index 23c16f4e0..9922f8705 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -145,9 +145,12 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # determine coupling mode config["coupling_mode"] = case.get_value("COUPLING_MODE") - if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': - config["wav_ice_coupling"] = "on" + # determine wav_ice_coupling + if config["coupling_mode"] == "cesm" or config["coupling_mode"] == "noresm": + if config['COMP_WAV'] == 'ww3' and config['COMP_ICE'] == 'cice': + config["wav_ice_coupling"] = "on" + # determine dms_from_ocn if ocn component is blom if config["COMP_OCN"] == "blom": if "ecosys" in case.get_value("BLOM_TRACER_MODULES"): config["dms_from_ocn"] = "on" From 94d22a706c86d5c876c6c6d844f2f96d4facb3b4 Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 29 Jul 2026 10:03:20 +0200 Subject: [PATCH 129/135] check on DRV_RESTART_POINTER for branch runs --- cime_config/buildnml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/cime_config/buildnml b/cime_config/buildnml index 1dbb93da3..b3bcfbee1 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -142,6 +142,25 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" + # For a branch run the driver must read the reference case's restart, so + # the driver restart pointer must be set explicitly to the dated + # rpointer.cpl of that reference case. buildnml does not modify xml + # variables, so rather than set DRV_RESTART_POINTER we check that it + # matches the expected dated pointer (built from RUN_REFDATE and + # RUN_REFTOD) and, if not, fail with the exact xmlchange command needed. + # (On a continue run CIME sets DRV_RESTART_POINTER automatically, and a + # hybrid run does not read the driver restart, so neither is checked.) + if not case.get_value("CONTINUE_RUN"): + expected_pointer = "rpointer.cpl.{}-{}".format( + case.get_value("RUN_REFDATE"), case.get_value("RUN_REFTOD") + ) + expect( + case.get_value("DRV_RESTART_POINTER") == expected_pointer, + "For a branch run the driver restart pointer must be set to the " + "dated rpointer.cpl of the reference case. Set it with:\n" + " ./xmlchange DRV_RESTART_POINTER={}".format(expected_pointer), + ) + # determine coupling mode config["coupling_mode"] = case.get_value("COUPLING_MODE") From 23a07d60272fb74af62f2497e39d71f9bfaeb967 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Aug 2026 10:22:45 +0200 Subject: [PATCH 130/135] updated diag table for glc ice and liquid runoff --- mediator/med_diag_mod.F90 | 86 +++++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 34 deletions(-) diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 85edea7c0..17a6617b3 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -142,15 +142,18 @@ module med_diag_mod integer :: f_heat_latvap = unset_index ! heat : latent, vaporization integer :: f_heat_latf = unset_index ! heat : latent, fusion, snow integer :: f_heat_ioff = unset_index ! heat : latent, fusion, frozen runoff + integer :: f_heat_ioff_glc = unset_index ! heat : latent, fusion, frozen runoff from glc integer :: f_heat_sen = unset_index ! heat : sensible integer :: f_heat_rain = unset_index ! heat : heat content of rain integer :: f_heat_snow = unset_index ! heat : heat content of snow integer :: f_heat_evap = unset_index ! heat : heat content of evaporation integer :: f_heat_cond = unset_index ! heat : heat content of evaporation integer :: f_heat_rofl = unset_index ! heat : heat content of liquid runoff + integer :: f_heat_rofl_glc = unset_index ! heat : heat content of liquid runoff from glc integer :: f_heat_rofi = unset_index ! heat : heat content of ice runoff - integer :: f_heat_rofa = unset_index ! heat : total heat content of runoff to atm (v2) - integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux (v2) + integer :: f_heat_rofi_glc = unset_index ! heat : heat content of ice runoff from glc + integer :: f_heat_rofa = unset_index ! heat : total heat content of runoff to atm (noresm - v2) + integer :: f_heat_hmat = unset_index ! heat : surface material enthalpy flux (noresm - v2) integer :: f_watr_frz = unset_index ! water: freezing integer :: f_watr_melt = unset_index ! water: melting @@ -159,7 +162,9 @@ module med_diag_mod integer :: f_watr_evap = unset_index ! water: evaporation integer :: f_watr_salt = unset_index ! water: water equivalent of salt flux integer :: f_watr_roff = unset_index ! water: runoff/flood + integer :: f_watr_roff_glc = unset_index ! water: runoff/flood from glc integer :: f_watr_ioff = unset_index ! water: frozen runoff + integer :: f_watr_ioff_glc = unset_index ! water: frozen runoff from glc integer :: f_heat_beg = unset_index ! 1st index for heat integer :: f_heat_end = unset_index ! Last index for heat @@ -286,6 +291,7 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_latvap ,'hlatvap' ) ! field heat : latent, vaporization call add_to_budget_diag(budget_diags%fields, f_heat_latf ,'hlatfus' ) ! field heat : latent, fusion, snow call add_to_budget_diag(budget_diags%fields, f_heat_ioff ,'hiroff' ) ! field heat : latent, fusion, frozen runoff + call add_to_budget_diag(budget_diags%fields, f_heat_ioff_glc ,'hiroff_glc' ) ! field heat : latent, fusion, frozen runoff from glc call add_to_budget_diag(budget_diags%fields, f_heat_sen ,'hsen' ) ! field heat : sensible if (trim(budget_table_version) == 'v0') then f_heat_beg = f_heat_frz ! field first index for heat @@ -296,9 +302,11 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_heat_evap ,'hevap' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_cond ,'hcond' ) ! field heat : enthalpy of evaporation call add_to_budget_diag(budget_diags%fields, f_heat_rofl ,'hrofl' ) ! field heat : enthalpy of liquid runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofl_glc ,'hrofl_glc') ! field heat : enthalpy of liquid runoff from glc call add_to_budget_diag(budget_diags%fields, f_heat_rofi ,'hrofi' ) ! field heat : enthalpy of ice runoff + call add_to_budget_diag(budget_diags%fields, f_heat_rofi_glc ,'hrofi_glc') ! field heat : enthalpy of ice runoff from glc f_heat_beg = f_heat_frz ! field first index for heat - f_heat_end = f_heat_rofi ! field last index for heat + f_heat_end = f_heat_rofi_glc ! field last index for heat else if (trim(budget_table_version) == 'v2') then call add_to_budget_diag(budget_diags%fields, f_heat_rofa ,'hrofa' ) ! field heat : total enthalpy of runoff to atm call add_to_budget_diag(budget_diags%fields, f_heat_hmat ,'hmat' ) ! field heat : surface material enthalpy flux @@ -322,13 +330,15 @@ subroutine med_diag_init(gcomp, rc) call add_to_budget_diag(budget_diags%fields, f_watr_salt ,'weqsaltf' ) ! field water: water equivalent of salt flux endif call add_to_budget_diag(budget_diags%fields, f_watr_roff ,'wrunoff' ) ! field water: runoff/flood + call add_to_budget_diag(budget_diags%fields, f_watr_roff_glc ,'wrunoff_glc' ) ! field water: runoff/flood from glc call add_to_budget_diag(budget_diags%fields, f_watr_ioff ,'wfrzrof' ) ! field water: frozen runoff + call add_to_budget_diag(budget_diags%fields, f_watr_ioff_glc ,'wfrzrof_glc' ) ! field water: frozen runoff from glc if (trim(budget_table_version) == 'v0' .or. trim(budget_table_version) == 'v2') then !BLOM for v2 f_watr_beg = f_watr_frz ! field firs index for water else f_watr_beg = f_watr_melt ! field firs index for water end if - f_watr_end = f_watr_ioff ! field last index for water + f_watr_end = f_watr_ioff_glc ! field last index for water ! ----------------------------------------- ! Salt fluxes budget terms (for v1 only) @@ -959,15 +969,18 @@ subroutine med_phases_diag_rof( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofl_glc' , f_watr_roff_glc, & + ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc', rc=rc)) then - call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_rof(is_local%wrap%FBImp(comprof,comprof), 'Forr_rofi_glc' , f_watr_ioff_glc, & + ic, areas, budget_local, minus=.true., rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice !------------------------------- ! to river from mediator @@ -987,15 +1000,16 @@ subroutine med_phases_diag_rof( gcomp, rc) call diag_rof(is_local%wrap%FBExp(comprof), 'Flrl_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofl', rc=rc)) then - call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofl' , f_watr_roff, ic, areas, budget_local, rc=rc) + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofl' , f_watr_roff_glc, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (fldbun_fldchk(is_local%wrap%FBExp(comprof), 'Fgrg_rofi', rc=rc)) then - call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofi' , f_watr_ioff, ic, areas, budget_local, rc=rc) + call diag_rof(is_local%wrap%FBExp(comprof), 'Fgrg_rofi' , f_watr_ioff_glc, ic, areas, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) end subroutine med_phases_diag_rof @@ -1067,15 +1081,15 @@ subroutine med_phases_diag_glc( gcomp, rc) do ns = 1,is_local%wrap%num_icesheets areas => is_local%wrap%mesh_info(compglc(ns))%areas - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofl', f_watr_roff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofl', f_watr_roff_glc, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Fgrg_rofi', f_watr_ioff_glc, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Figg_rofi', f_watr_ioff, ic, areas, budget_local, minus=.true., rc=rc) + call diag_glc(is_local%wrap%FBImp(compglc(ns),compglc(ns)), 'Figg_rofi', f_watr_ioff_glc, ic, areas, budget_local, minus=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice call t_stopf('MED:'//subname) end subroutine med_phases_diag_glc @@ -1255,40 +1269,44 @@ subroutine med_phases_diag_ocn( gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc)) then - call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , f_watr_roff , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , f_watr_roff_glc, ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( fldbun_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc)) then - call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , f_watr_ioff , ic, areas, sfrac, budget_local, rc=rc) + call diag_ocn(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , f_watr_ioff_glc, ic, areas, sfrac, budget_local, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (trim(budget_table_version) == 'v1') then - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) - - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrain', f_heat_rain , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', f_heat_snow , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hevap', f_heat_evap , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hcond', f_heat_cond , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', f_heat_rofl , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', f_heat_rofl_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', f_heat_rofi , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', f_heat_rofi_glc , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (trim(budget_table_version) == 'v2') then - ! f_heat_hmat to ocean is sum of contribution from two terms - call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! f_heat_hmat to ocean is sum of contribution from two terms + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call diag_ocn(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', f_heat_hmat , ic, areas, sfrac, budget_local, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if budget_local(f_heat_latf,ic,ip) = -budget_local(f_watr_snow,ic,ip)*shr_const_latice budget_local(f_heat_ioff,ic,ip) = -budget_local(f_watr_ioff,ic,ip)*shr_const_latice + budget_local(f_heat_ioff_glc,ic,ip) = -budget_local(f_watr_ioff_glc,ic,ip)*shr_const_latice deallocate(sfrac) call t_stopf('MED:'//subname) From 17524f227830bc893e9c3e1cc5fa4c19ca555bbb Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Aug 2026 11:04:25 +0200 Subject: [PATCH 131/135] updated med_phases_prep_ocn correctly cmeps1.1.57 --- mediator/med_phases_prep_ocn_mod.F90 | 346 ++++++++++++++++++++------- 1 file changed, 263 insertions(+), 83 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 79771e074..5864488ca 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -4,6 +4,7 @@ module med_phases_prep_ocn_mod ! Mediator phases for preparing ocn export from mediator !----------------------------------------------------------------------------- + use shr_log_mod , only : shr_log_error use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -36,6 +37,8 @@ module med_phases_prep_ocn_mod private :: med_phases_prep_ocn_custom + character(len=CS) :: component_computes_enthalpy_flux + character(*), parameter :: u_FILE_u = & __FILE__ @@ -45,6 +48,7 @@ module med_phases_prep_ocn_mod subroutine med_phases_prep_ocn_init(gcomp, rc) + use NUOPC , only : NUOPC_CompAttributeGet use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_methods_mod , only : FB_Init => med_methods_FB_init @@ -55,6 +59,8 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) ! local variables type(InternalState) :: is_local type(med_field_info_type), allocatable :: field_info_array(:) + character(len=CL) :: cvalue + logical :: isPresent, IsSet character(len=*),parameter :: subname=' (med_phases_prep_ocn_init) ' !--------------------------------------- @@ -80,6 +86,15 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="component_computes_enthalpy_flux", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + component_computes_enthalpy_flux = trim(cvalue) + else + component_computes_enthalpy_flux = 'none' + end if + end subroutine med_phases_prep_ocn_init !----------------------------------------------------------------------------- @@ -89,7 +104,9 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_constants_mod , only : shr_const_cpsw, shr_const_tkfrz, shr_const_pi use med_constants_mod , only : shr_const_cpice + use med_constants_mod , only : shr_const_cpfw use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_correction + use med_phases_prep_atm_mod , only : med_phases_prep_atm_enthalpy_runoff ! input/output variables type(ESMF_GridComp) :: gcomp @@ -112,6 +129,20 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) real(r8), allocatable :: hcorr(:) type(med_fldlist_type), pointer :: fldList character(len=*), parameter :: subname='(med_phases_prep_ocn_accum)' + ! + ! The following applies only to coupling_mode of noresm + real(r8), pointer :: dataptr(:) + real(r8), pointer :: Faxa_hmat (:) + real(r8), pointer :: Faxa_hlat (:) + real(r8), allocatable :: hrof2atm(:) + real(r8) :: ocean_htot_corr(1) + real(r8) :: ocean_atot_corr(1) + real(r8), allocatable :: hrof(:) + ! if separate_varlat is true then do global ocean average for + ! hmat_oa only for the net-mass part, and pass in hmat only local + ! variable latent heat correction part + logical, parameter :: separate_varlat=.true. + real(r8), allocatable :: acorr(:) !--------------------------------------- if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_prep_ocn_accum", "B") @@ -166,100 +197,213 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- custom calculations + !--- custom calculation - enthalpy flux computed in mediator for cesm !--------------------------------------- - ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff - ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so - ! enthalpy from meltw **is not** included below - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc)) then - - call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(coupling_mode) == 'cesm') then + ! compute enthalpy associated with rain, snow, condensation and liquid river & glc runoff + ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so + ! enthalpy from meltw **is not** included below + if (FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrain' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_snow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hsnow' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_evap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hevap' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hcond' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc' , rc=rc) & + ) then + ! Error check + if (trim(component_computes_enthalpy_flux) /= 'med') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to med', rc=rc) + return + end if + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_rain' , rain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrain', hrain, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_evap' , evap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hevap', hevap, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hcond', hcond, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C + hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw + hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw + hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw + hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw + hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw + hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw + ! −10 C is a reasonable bulk temperature assumption for iceberg/land-ice runoff + hrofi(n) = -10._r8 * rofi(n) * shr_const_cpice + hrofi_glc(n) = -10._r8 * rofi_glc(n) * shr_const_cpice + end do + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then + ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm + ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only + ! need to calculate this if data is sent back to the atm + allocate(hcorr(size(tocn))) + glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) + areas => is_local%wrap%mesh_info(compocn)%areas + do n = 1,size(tocn) + hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & + areas(n) * glob_area_inv + end do + call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) + end if + end if ! condition for using global energy fixer + end if ! if coupling_mode is cesm - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_snow' , snow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hsnow', hsnow, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + !--- custom calculation - enthalpy flux obtained from prognostic atm for noresm + !--------------------------------------- + if (trim(coupling_mode) == 'noresm') then + if( FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hmat', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Faxa_hlat', rc=rc)) then + if (trim(component_computes_enthalpy_flux) /= 'atm') then + call shr_log_error(trim(subname)//' ERROR: component_computes_enthalpy_flux must be set to atm', rc=rc) + return + end if + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hmat', Faxa_hmat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Faxa_hlat', Faxa_hlat, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compocn,compocn), 'So_t', tocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofl' , rofl, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl', hrofl, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + areas => is_local%wrap%mesh_info(compocn)%areas - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_rofi' , rofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi', hrofi, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! if separate_varlat is true then do global ocean average only for the + ! net-mass part, and pass in as hmat only the local variable latent heat correction part + if (separate_varlat) then + !----------------------- + ! Determine enthalpy due to ocean river input + !----------------------- + allocate(hrof (size(tocn))) + if ( FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofl' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Foxx_rofi' ,rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofl_glc',rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn),'Forr_rofi_glc',rc=rc) ) then + + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofl' , rofl ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Foxx_rofi' , rofi ,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofl_glc', rofl_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn),'Forr_rofi_glc', rofi_glc,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,size(tocn) + hrof(n) = shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi(n) & + + shr_const_cpfw * (tocn(n) - shr_const_tkfrz) * rofl_glc(n) & + + shr_const_cpice * (tocn(n) - shr_const_tkfrz) * rofi_glc(n) + enddo + else + do n = 1,size(tocn) + hrof(n) = 0._r8 + enddo + endif + + ! send back to atm if requested by atm + if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_hrof', rc=rc)) then + allocate(hrof2atm(size(tocn))) + hrof2atm(:) = hrof(:)*areas(:) / (4._r8 * shr_const_pi) + + ! determine module variable global_hrof_corr in med_phases_prep_atm_mod + call med_phases_prep_atm_enthalpy_runoff(gcomp, hrof2atm, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofl_glc' , rofl_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofl_glc', hrofl_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + !----------------------- + ! Compute Faxa_hmat_oa + !----------------------- + ! Determine hcorr and acorr + allocate(hcorr(size(tocn))) + allocate(acorr(size(tocn))) + if (separate_varlat) then + do n = 1,size(tocn) + hcorr(n) = areas(n) *(Faxa_hmat(n) - Faxa_hlat(n) + hrof(n)) + acorr(n) = areas(n) + end do + else + do n = 1,size(tocn) + hcorr(n) = areas(n) * Faxa_hmat(n) + acorr(n) = areas(n) + end do + endif + deallocate(hrof) - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Forr_rofi_glc' , rofi_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_hrofi_glc', hrofi_glc, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Compute global integral of hcorr - ocean_oa_htot + call med_oa_integral(gcomp, hcorr, ocean_htot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(hcorr) - do n = 1,size(tocn) - ! Need max to ensure that will not have an enthalpy contribution if the water is below 0C - hrain(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rain(n) * shr_const_cpsw - hsnow(n) = min((tocn(n) - shr_const_tkfrz), 0._r8) * snow(n) * shr_const_cpsw - hevap(n) = (tocn(n) - shr_const_tkfrz) * min(evap(n), 0._r8) * shr_const_cpsw - hcond(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * max(evap(n), 0._r8) * shr_const_cpsw - hrofl(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl(n) * shr_const_cpsw - hrofl_glc(n) = max((tocn(n) - shr_const_tkfrz), 0._r8) * rofl_glc(n) * shr_const_cpsw - ! −10 C is a reasonable bulk temperature assumption for iceberg/land-ice runoff - hrofi(n) = -10._r8 * rofi(n) * shr_const_cpice - hrofi_glc(n) = -10._r8 * rofi_glc(n) * shr_const_cpice - end do + ! Compute global integral of acorr - ocean_atot_corr + call med_oa_integral(gcomp, acorr, ocean_atot_corr, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + deallocate(acorr) - ! Determine enthalpy correction factor that will be added to the sensible heat flux sent to the atm - ! Areas here in radians**2 - this is an instantaneous snapshot that will be sent to the atm - only - ! need to calculate this if data is sent back to the atm + ! Set value of Faxa_hmat_oa to ratio of ocean_htot_corr and ocean_atot_corr + call FB_getfldptr(is_local%wrap%FBExp(compocn), 'Faxa_hmat_oa', dataptr, rc=rc) + if (ocean_atot_corr(1) > 0._r8) then + dataptr(:) = ocean_htot_corr(1)/ocean_atot_corr(1) + end if - if (FB_fldchk(is_local%wrap%FBExp(compatm), 'Faxx_sen', rc=rc)) then - allocate(hcorr(size(tocn))) - glob_area_inv = 1._r8 / (4._r8 * shr_const_pi) - areas => is_local%wrap%mesh_info(compocn)%areas - do n = 1,size(tocn) - hcorr(n) = (hrain(n) + hsnow(n) + hcond(n) + hevap(n) + hrofl(n) + hrofi(n) + hrofl_glc(n) + hrofi_glc(n)) * & - areas(n) * glob_area_inv - end do - call med_phases_prep_atm_enthalpy_correction(gcomp, hcorr, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(hcorr) - end if + !----------------------- + ! replace full material enthalpy flux with variable latent + ! heats part only in pointer to ocean export + !----------------------- - end if + ! might add another coupling field later but may not be strictly necessary + if (separate_varlat) then + do n = 1,size(tocn) + Faxa_hmat(n) = Faxa_hlat(n) + end do + else + do n = 1,size(tocn) + Faxa_hmat(n) = 0._r8 ! avoid applying twice for some ocean components such as BLOM + end do + endif + endif + end if ! end of coupling_mode is noresm - ! custom merges to ocean + !--------------------------------------- + !--- custom merges to ocean + !--------------------------------------- call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -679,4 +823,40 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) end subroutine med_phases_prep_ocn_custom + !----------------------------------------------------------------------------- + subroutine med_oa_integral (gcomp, local_array, global_integral, rc) + + use ESMF , only : ESMF_VMAllreduce, ESMF_GridComp, ESMF_GridCompGet, ESMF_REDUCE_SUM, ESMF_SUCCESS + use ESMF , only : ESMF_VM + + ! input/output variables + type(ESMF_GridComp) , intent(in) :: gcomp + real(r8) , intent(in) :: local_array(:) + real(r8) , intent(out) :: global_integral(1) + integer , intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: n + real(r8) :: local_sum(1) + type(ESMF_VM) :: vm + !--------------------------------------- + + rc = ESMF_SUCCESS + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + ! sum contributions to integral + local_sum(1) = 0._r8 + do n = 1,size(local_array) + local_sum(1) = local_sum(1) + local_array(n) + end do + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMAllreduce(vm, senddata=local_sum, recvdata=global_integral, count=1, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine med_oa_integral + end module med_phases_prep_ocn_mod From a7085e819a05503f49c1a7b672a766d59ef1aa03 Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Aug 2026 11:49:09 +0200 Subject: [PATCH 132/135] separated out Faxa_lwdn for noresm coupling --- mediator/esmFldsExchange_cesm_mod.F90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 020039160..938763dce 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -1209,7 +1209,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmrg_to(compatm , 'Faxx_evap'//trim(suffix), & mrg_from=compmed, mrg_fld='Faox_evap'//trim(suffix), mrg_type='merge', mrg_fracname='ofrac') end if - end if end if if (trim(coupling_mode) == 'noresm') then @@ -1744,7 +1743,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- - ! to ocn: merged longwave net heat flux + ! to ocn: merged longwave net heat flux (cesm) ! --------------------------------------------------------------------- if (trim(coupling_mode) == 'cesm') then if (phase == 'advertise') then @@ -1763,7 +1762,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if end if - else if (trim(coupling_mode) == 'noresm') then + end if + ! --------------------------------------------------------------------- + ! to ocn: longwave down from atm (noresm) + ! --------------------------------------------------------------------- + if (trim(coupling_mode) == 'noresm') then if (phase == 'advertise') then call addfld_from(compatm, 'Faxa_lwdn') call addfld_to(complnd, 'Faxa_lwdn') From 75768100ef491e94a552de28025319ab7445bbdf Mon Sep 17 00:00:00 2001 From: mvertens Date: Mon, 3 Aug 2026 13:38:48 +0200 Subject: [PATCH 133/135] fixed problems in merge to fd_cesm.yaml --- mediator/fd_cesm.yaml | 122 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 101 insertions(+), 21 deletions(-) diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 2a22fc824..bf59c9b02 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -75,12 +75,12 @@ - standard_name: Fwxx_taux alias: mean_zonal_moment_flx canonical_units: N m-2 - description: wave import to med - zonal surface stress + description: med export - zonal surface stress to wave computed in mediator # - standard_name: Fwxx_tauy alias: mean_merid_moment_flx canonical_units: N m-2 - description: wave import to med - meridional surface stress + description: med export - meridional surface stress to wave computed in mediator # #----------------------------------- # section: lnd import to med @@ -230,6 +230,10 @@ canonical_units: kg m-2 s-1 description: lnd export to river # + - standard_name: Flrl_rofsur_nonh2o + canonical_units: kg m-2 s-1 + description: lnd export to river for non-water liquid tracers + # - standard_name: Flrl_rofsur_wtracers canonical_units: kg m-2 s-1 description: lnd export to river @@ -316,7 +320,25 @@ alias: mean_down_lw_flx canonical_units: W m-2 description: atm import to med - mean downward SW heat flux + mean downward LW heat flux + # + - standard_name: Faxa_hmat + alias: mean_down_hmat + canonical_units: W m-2 + description: atm import to med + mean downward material enthalpy flux + # + - standard_name: Faxa_hlat + alias: mean_down_hlat + canonical_units: W m-2 + description: atm import to med + variable latent heat part of mat.enth.flx + # + - standard_name: Faxa_hmat_oa + alias: mean_down_hmat_oa + canonical_units: W m-2 + description: med export to ocn + mean downw. mat. enth. flux, ocean average # - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec @@ -1032,6 +1054,11 @@ canonical_units: W m-2 description: med export to ocn heat content of condensation # + - standard_name: Faxx_hrof + alias: heat_content_rof + canonical_units: W m-2 + description: med export to atm gl.avg. of mat.enthalpy of runoff + # - standard_name: Foxx_hrofl alias: heat_content_rofl canonical_units: W m-2 @@ -1219,7 +1246,11 @@ # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 - description: river import to med - water flux due to runoff (liquid) + description: river import to med - liquid water flux due to runoff + # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux due to runoff # - standard_name: Forr_rofl_wtracers canonical_units: kg m-2 s-1 @@ -1229,6 +1260,10 @@ canonical_units: kg m-2 s-1 description: river import to med - water flux due to runoff originating from glc (liquid) # + - standard_name: Forr_rofl_nonh2o + canonical_units: kg m-2 s-1 + description: river import to med - non-water flux(es) due to runoff originating from lnd (liquid) + # - standard_name: Forr_rofl_glc_wtracers canonical_units: kg m-2 s-1 description: river import to med - water tracer flux due to runoff originating from glc (liquid) @@ -1340,68 +1375,113 @@ # - standard_name: Sw_ustokes_avg canonical_units: m/s - description: Daily averaged stokes drift u component (only needed for med history output) + description: Daily averaged stokes drift u component (only needed for mediator history output) # - standard_name: Sw_vstokes_avg canonical_units: m/s - description: Daily averaged stokes drift v component (only needed for med history output) + description: Daily averaged stokes drift v component (only needed for mediator history output) # - standard_name: Sw_hs_avg canonical_units: m - description: Daily averaged significant wave hight (only needed for med history output) + description: Daily averaged significant wave hight (only needed for mediator history output) # - standard_name: Sw_phs0_avg canonical_units: m - description: Daily averaged averaged wind sea swh (only needed for med history output) + description: Daily averaged averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_phs1_avg canonical_units: m - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pdir0_avg canonical_units: degrees - description: Daily averaged wind sea swh (only needed for med history output) + description: Daily averaged wind sea swh (only needed for mediator history output) # - standard_name: Sw_pdir1_avg canonical_units: degrees - description: Daily averaged swell swh (only needed for med history output) + description: Daily averaged swell swh (only needed for mediator history output) # - standard_name: Sw_pTm10_avg canonical_units: s - description: Daily averaged wind sea mean wave Tm1 period (only needed for med history output) + description: Daily averaged wind sea mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_pTm11_avg canonical_units: s - description: Daily average swell mean wave Tm1 period (only needed for med history output) + description: Daily average swell mean wave Tm1 period (only needed for mediator history output) # - standard_name: Sw_Tm1_avg canonical_units: s - description: Daily averaged mean wave period of the first moment (only needed for med history output) + description: Daily averaged mean wave period of the first moment (only needed for mediator history output) # - standard_name: Sw_thm_avg canonical_units: degrees - description: Daily averaged mean wave direction (only needed for med history output) + description: Daily averaged mean wave direction (only needed for mediator history output) # - standard_name: Sw_thp0_avg canonical_units: degrees - description: Daily averaged peak wave direction (only needed for med history output) + description: Daily averaged peak wave direction (only needed for mediator history output) # - standard_name: Sw_fp0_avg canonical_units: 1/s - description: Daily averaged peak wave frequency (only needed for med history output) + description: Daily averaged peak wave frequency (only needed for mediator history output) # - standard_name: Sw_u_avg canonical_units: m/s - description: Daily averaged surface wind zonal (only needed for med history output) + description: Daily averaged surface wind zonal (only needed for mediator history output) # - standard_name: Sw_v_avg canonical_units: m/s - description: Daily averaged surface wind meridional (only needed for med history output) + description: Daily averaged surface wind meridional (only needed for mediator history output) + # + - standard_name: Sw_cu_avg + canonical_units: m/s + description: Daily averaged surface zonal current(only needed for mediator history output) + # + - standard_name: Sw_cv_avg + canonical_units: m/s + description: Daily averaged surface meridional current (only needed for mediator history output) # - standard_name: Sw_tusx_avg canonical_units: m2/s - description: Daily averaged stokes zonal transport vector (only needed for med history output) + description: Daily averaged stokes zonal transport vector (only needed for mediator history output) # - standard_name: Sw_tusy_avg canonical_units: m2/s - description: Daily averaged stokes meridional transport vector (only needed for med history output) + description: Daily averaged stokes meridional transport vector (only needed for mediator history output) + # + - standard_name: Sw_lamult_avg + canonical_units: 1 + description: Daily averaged Langmuir number (only needed for mediator history output) + # + - standard_name: Sw_charn_avg + canonical_units: 1 + description: Daily averaged Charnock parameter (only needed for mediator history output) + # + - standard_name: Sw_tm02_avg + canonical_units: s + alias: Total_m2-period + description: Daily averaged mean wave period of the second moment (only needed for mediator history output) + # + - standard_name: Sw_foc_avg + canonical_units: W/m3 + description: Daily averaged wave to ocean energy flux (only needed for mediator history output) + # + - standard_name: Sw_faw_avg + canonical_units: W/m3 + description: Daily averaged wind to wave energy flux (only needed for mediator history output) + # + - standard_name: Sw_ifrac_avg + canonical_units: 1 + description: Daily averaged sea ice concentration (only needed for mediator history output) + # + - standard_name: Sw_thick_avg + canonical_units: m + description: Daily averaged sea ice thickness (only needed for mediator history output) + # + - standard_name: Sw_tauicex_avg + canonical_units: m2/s2 + description: Daily averaged x component of momentum flux to sea ice (only needed for mediator history output) + # + - standard_name: Sw_tauicey_avg + canonical_units: m2/s2 + description: Daily averaged y component of momentum flux to sea ice (only needed for mediator history output) From ba8cb3ba79d95b6cbfd38796efc5a7df27bc36bd Mon Sep 17 00:00:00 2001 From: mvertens Date: Thu, 13 Aug 2026 21:32:46 +0200 Subject: [PATCH 134/135] removed updates of noresm for .github/workflows files --- .github/workflows/bumpversion.yml | 19 +++++++ .github/workflows/extbuild.yml | 4 +- .github/workflows/srt.yml | 84 +++++++++++++++---------------- 3 files changed, 62 insertions(+), 45 deletions(-) create mode 100644 .github/workflows/bumpversion.yml diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml new file mode 100644 index 000000000..2289f5add --- /dev/null +++ b/.github/workflows/bumpversion.yml @@ -0,0 +1,19 @@ +name: Bump version +on: + push: + branches: + - main +jobs: + build: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - name: Bump version and push tag + id: tag_version + uses: mathieudutour/github-tag-action@v6.2 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + create_annotated_tag: true + default_bump: patch + dry_run: false + tag_prefix: cmeps diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index c5569014f..113f90885 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -5,9 +5,9 @@ name: extbuild # events but only for the main branch on: push: - branches: [ noresm ] + branches: [ main ] pull_request: - branches: [ noresm ] + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index abb2b0b0f..2f8c08445 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -23,9 +23,9 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include " - LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.9.0 + ESMF_VERSION: v8.8.0 PARALLELIO_VERSION: pio2_6_6 CIME_MODEL: cesm CIME_DRIVER: nuopc @@ -38,9 +38,9 @@ jobs: id: load-env run: | set -x - sudo apt-get update + sudo apt-get update sudo apt-get install libxml2-utils - sudo apt-get install netcdf-bin + sudo apt-get install netcdf-bin sudo apt-get install libnetcdf-dev sudo apt-get install libnetcdff-dev sudo apt-get install pnetcdf-bin @@ -61,31 +61,30 @@ jobs: - run: echo "PyYAML" > requirements.txt - name: Install PyYAML run: pip install -r requirements.txt - # use the latest noresm main - - name: noresm checkout + # use the latest cesm main + - name: cesm checkout uses: actions/checkout@v4 with: - repository: NorESMhub/NorESM - path: noresm - ref: noresm_develop + repository: ESCOMP/CESM + path: cesm # this cmeps commit - name: cmeps checkout uses: actions/checkout@v4 with: - path: noresm/components/cmeps - - # Checkout noresm datamodels and support + path: cesm/components/cmeps + + # Checkout cesm datamodels and support # cpl7 is needed - i think that's a bug - name: checkout externals run: | git config --global user.name "${GITHUB_ACTOR}" git config --global user.email "${GITHUB_ACTOR_ID}+${GITHUB_ACTOR}@users.noreply.github.com" - pushd noresm + pushd cesm ./bin/git-fleximod update cime ccs_config cdeps share mct parallelio cd ccs_config - git checkout noresm + git checkout main cd ../cime - git checkout noresm + git checkout master git status if [[ ! -e "${PWD}/.gitmodules.bak" ]] then @@ -95,11 +94,11 @@ jobs: fi git submodule update --init cd ../components/cdeps - git checkout noresm + git checkout main git submodule update --init cd ../../share - git checkout noresm - + git checkout main + - name: Cache ESMF id: cache-esmf uses: actions/cache@v4 @@ -118,17 +117,17 @@ jobs: id: cache-inputdata uses: actions/cache@v4 with: - path: $HOME/noresm/inputdata + path: $HOME/cesm/inputdata key: inputdata - name: Build ParallelIO - if: steps.cache-ParallelIO.outputs.cache-hit != 'true' + if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@b38e34eeb9b75ce81ac94daf7c5245931de00b9d with: - parallelio_version: ${{ env.PARALLELIO_VERSION }} + parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: ${GITHUB_WORKSPACE}/pio - + - name: Install ESMF uses: esmf-org/install-esmf-action@v1 env: @@ -149,10 +148,10 @@ jobs: - name: PREP for scripts regression test run: | - mkdir -p $HOME/noresm/scratch - mkdir -p $HOME/noresm/inputdata - pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests - export SRCROOT=$GITHUB_WORKSPACE/noresm/ + mkdir -p $HOME/cesm/scratch + mkdir -p $HOME/cesm/inputdata + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$GITHUB_WORKSPACE/pio/include export PIO_LIBDIR=$GITHUB_WORKSPACE/pio/lib @@ -161,7 +160,7 @@ jobs: export NETCDF_PATH=/usr export PNETCDF_PATH=/usr export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH - cat <> $GITHUB_WORKSPACE/noresm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake + cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake set(NetCDF_Fortran_INCLUDE_DIR /usr/include) set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) EOF @@ -169,27 +168,26 @@ jobs: popd - name: scripts regression tests run: | - pushd $GITHUB_WORKSPACE/noresm/cime/CIME/tests + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest --no-teardown popd # How to download artifacts: # https://docs.github.com/en/actions/managing-workflow-runs/downloading-workflow-artifacts - # - name: Upload test logs - # if: ${{ failure() }} - # steps: - # - name: Tar test logs - # run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/noresm/scratch - # - name: save artifact - # uses: actions/upload-artifact@v4 - # with: - # name: test-logs-${{ matrix.python-version }} - # path: scratch-${{ matrix.python-version }}.tar.gz - # retention-days: 4 +# - name: Upload test logs +# if: ${{ failure() }} +# steps: +# - name: Tar test logs +# run: tar zcf scratch-${{ matrix.python-version }}.tar.gz /home/runner/cesm/scratch +# - name: save artifact +# uses: actions/upload-artifact@v4 +# with: +# name: test-logs-${{ matrix.python-version }} +# path: scratch-${{ matrix.python-version }}.tar.gz +# retention-days: 4 # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 - + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 24418aa9c7b1acd4b7427d0bd67d2dbf13d28d66 Mon Sep 17 00:00:00 2001 From: mvdebolskiy <80036033+mvdebolskiy@users.noreply.github.com> Date: Thu, 3 Sep 2026 19:48:05 +0200 Subject: [PATCH 135/135] Merge pull request #59 from mvertens/feature/fix_issues_with_glc fix issues in latest update to cmeps. histaux_l2x1yrg should now work properly for lnd2glc and ocn2glc runs. --- mediator/med_phases_history_mod.F90 | 74 ++++++++++++++-------- mediator/med_phases_prep_glc_mod.F90 | 93 +++++++++++++++++----------- 2 files changed, 106 insertions(+), 61 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 772d5c8b5..35a15ca84 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -13,7 +13,7 @@ module med_phases_history_mod use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_AlarmGet use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_SUCCESS, ESMF_MAXSTR, ESMF_LOGERR_PASSTHRU, ESMF_END_ABORT + use ESMF , only : ESMF_SUCCESS use ESMF , only : operator(-), operator(+) use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Model , only : NUOPC_ModelGet @@ -37,10 +37,13 @@ module med_phases_history_mod public :: med_phases_history_write ! inst only - for all variables ! Public routines called from post phases - public :: med_phases_history_write_comp ! inst, avg, aux for component - public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes - public :: med_phases_history_write_lnd2glc ! inst only, yearly average of lnd->glc data on lnd grid - + public :: med_phases_history_write_comp ! inst, avg, aux for component + public :: med_phases_history_write_med ! inst only, med aoflux and ocn albedoes + public :: med_phases_history_write_data2glc ! inst only, average (normally yearly) of + ! implnd->glc (on land grid), + ! impocn->glc (on ocn grid) and + ! inst only, average (normally yearly) of + ! export->glc (on glc grid) ! Private routines private :: med_phases_history_write_comp_inst ! write instantaneous file for a given component private :: med_phases_history_write_comp_avg ! write averaged file for a given component @@ -536,20 +539,21 @@ subroutine med_phases_history_write_med(gcomp, rc) end subroutine med_phases_history_write_med !=============================================================================== - subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) + subroutine med_phases_history_write_data2glc(gcomp, fldbun_import, comp_import, fldbun_export, rc) ! Write yearly average of lnd -> glc fields on both land and glc grids - use med_internalstate_mod, only : complnd, compglc - use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_io_mod , only : med_io_write_time, med_io_define_time - use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date + use med_internalstate_mod , only : compglc, complnd, compocn + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay + use med_io_mod , only : med_io_write_time, med_io_define_time + use med_io_mod , only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date ! input/output variables - type(ESMF_GridComp) , intent(in) :: gcomp - type(ESMF_FieldBundle) , intent(in) :: fldbun_lnd - integer , intent(out) :: rc - type(ESMF_FieldBundle) , intent(in), optional :: fldbun_glc(:) + type(ESMF_GridComp) , intent(in) :: gcomp + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_import ! land or ocean import field bundle + integer , optional , intent(in) :: comp_import ! either land or ocean component id + type(ESMF_FieldBundle) , optional , intent(in) :: fldbun_export(:) ! export field bundle array + integer , intent(out) :: rc ! local variables type(file_desc_t) :: io_file @@ -570,11 +574,11 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) character(len=CL) :: hist_file integer :: m,n logical :: isPresent - character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' + character(len=*), parameter :: subname='(med_phases_history_write_data2glc)' !--------------------------------------- rc = ESMF_SUCCESS - if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_lnd2glc", "B") + if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_data2glc", "B") ! Get the internal state nullify(is_local%wrap) @@ -623,6 +627,19 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.1yr2glc.',trim(nexttime_str),'.nc' + if (present(comp_import)) then + if (.not. present(fldbun_import)) then + call shr_log_error(subname//'if comp_import is present, then fldbun_import must be present', rc=rc) + return + end if + if (comp_import == complnd) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.lnd2glc.',trim(nexttime_str),'.nc' + else if (comp_import == compocn) then + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.ocn2glc.',trim(nexttime_str),'.nc' + end if + else + write(hist_file, "(6a)") trim(case_name),'.cpl',trim(inst_tag),'.hx.exp2glc.',trim(nexttime_str),'.nc' + end if ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -643,18 +660,23 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(io_file, fldbun_lnd, whead(m), wdata(m), & - is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & - nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (present(fldbun_glc)) then - do n = 1,size(fldbun_glc) - call med_io_write(io_file, fldbun_glc(n), whead(m), wdata(m), & + if (present(fldbun_import)) then + ! import field bundle + call med_io_write(io_file, fldbun_import, whead(m), wdata(m), & + is_local%wrap%nx(comp_import), is_local%wrap%ny(comp_import), & + nt=1, pre=trim(compname(comp_import))//'Imp', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else if (present(fldbun_export)) then + ! export field bundle + do n = 1,size(fldbun_export) + call med_io_write(io_file, fldbun_export(n), whead(m), wdata(m), & is_local%wrap%nx(compglc(n)), is_local%wrap%ny(compglc(n)), & nt=1, pre=trim(compname(compglc(n)))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do + else + call shr_log_error(subname//'either fldbun_import or fldbun_export must be present as arguments', rc=rc) + return end if end do ! end of loop over m @@ -663,8 +685,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun_lnd, rc, fldbun_glc) call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_lnd2glc", "E") - end subroutine med_phases_history_write_lnd2glc + if (maintask) call ufs_trace_wrapper("cmeps", "med_phases_history_write_data2glc", "E") + end subroutine med_phases_history_write_data2glc !=============================================================================== subroutine med_phases_history_write_comp(gcomp, compid, rc) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 0d28197be..efe79909e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -515,7 +515,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Prepare the GLC export Fields from the mediator !--------------------------------------- - use med_phases_history_mod, only : med_phases_history_write_lnd2glc + use med_phases_history_mod, only : med_phases_history_write_data2glc ! input/output variables type(ESMF_GridComp) :: gcomp @@ -637,8 +637,21 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_LogWrite(trim(subname)//": glc_avg alarm is not ringing - returning", ESMF_LOGMSG_INFO) end if + ! ------------------------------------------------- ! Average and map data from land (and possibly ocean) - if (do_avg) then + ! ------------------------------------------------- + write_histaux_l2x1yrg = .false. + if (lndAccum2glc_cnt > 0) then + call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & + isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) write_histaux_l2x1yrg + end if + end if + + do_avg_check: if (do_avg) then + if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then ! Average import from accumulated land import data as long as the accumulator has ! been created (if accum_lnd2glc is false, the accumulator isn't created, but this @@ -655,6 +668,9 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) end if end if + ! ------------------------------------------------- + ! ocean to glc coupling + ! ------------------------------------------------- if (is_local%wrap%ocn2glc_coupling) then ! Average import from accumulated ocn import data do n = 1, size(fldnames_fr_ocn) @@ -695,23 +711,22 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) where (data2d == 0._r8) data2d = shr_const_spval end do end do + + ! Write import auxiliary file for ocn if appropriate + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBocnAccum2glc_o, comp_import=compocn, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + ! Reset ocean accumulator ocnAccum2glc_cnt = 0 call fldbun_reset(FBocnAccum2glc_o, value=czero, rc=rc) if (chkErr(rc,__LINE__,u_FILE_u)) return end if - ! Determine if auxiliary file will be written - write_histaux_l2x1yrg = .false. - if (lndAccum2glc_cnt > 0) then - call NUOPC_CompAttributeGet(gcomp, name="histaux_l2x1yrg", value=cvalue, & - isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then - read(cvalue,*) write_histaux_l2x1yrg - end if - end if - - ! Write auxiliary history file if flag is set and accumulation is being done + ! ------------------------------------------------- + ! lnd to glc coupling + ! ------------------------------------------------- if (is_local%wrap%lnd2glc_coupling) then ! Map accumulated field bundle from land grid (with elevation classes) to glc grid (without elevation classes) ! and set FBExp(compglc(ns)) data @@ -719,38 +734,46 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call med_phases_prep_glc_map_lnd2glc(gcomp, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return + ! Write lnd2glc export data if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, & - fldbun_glc=is_local%wrap%FBExp(compglc(:)), rc=rc) + call med_phases_history_write_data2glc(gcomp, fldbun_export=is_local%wrap%FBExp(compglc(:)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - lndAccum2glc_cnt = 0 - call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - else - if (write_histaux_l2x1yrg) then - call med_phases_history_write_lnd2glc(gcomp, FBlndAccum2glc_l, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (dbug_flag > 1) then + do ns = 1,is_local%wrap%num_icesheets + call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + end do + endif end if - if (dbug_flag > 1) then - do ns = 1,is_local%wrap%num_icesheets - call fldbun_diagnose(is_local%wrap%FBExp(compglc(ns)), string=trim(subname)//' FBexp(compglc) ', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - endif - end if + ! Write lnd2glc import data + if (write_histaux_l2x1yrg) then + call med_phases_history_write_data2glc(gcomp, fldbun_import=FBlndAccum2glc_l, comp_import=complnd, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + lndAccum2glc_cnt = 0 + call fldbun_reset(FBlndAccum2glc_l, value=czero, rc=rc) + if (chkErr(rc,__LINE__,u_FILE_u)) return + + end if do_avg_check + + ! ------------------------------------------------- ! Check for nans in fields export to glc - do ns = 1,is_local%wrap%num_icesheets - call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do + ! ------------------------------------------------- + if (is_local%wrap%lnd2glc_coupling) then + do ns = 1,is_local%wrap%num_icesheets + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + end if + ! ------------------------------------------------- ! Check water tracers (if there are no water tracers or these checks aren't enabled, ! this will return without doing anything) + ! ------------------------------------------------- do ns = 1,is_local%wrap%num_icesheets call med_methods_FB_check_wtracers(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return