From a018cfa0d0309ca38eed52b17529b20b6075227e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Wed, 17 Apr 2019 16:07:48 -0600 Subject: [PATCH 01/15] changes to get mom cap working again --- src/drivers/nuopc/cime_config/buildnml | 1 + .../cime_config/namelist_definition_drv.xml | 36 +++++++++---------- src/drivers/nuopc/mediator/fd.yaml | 8 +++++ 3 files changed, 26 insertions(+), 19 deletions(-) diff --git a/src/drivers/nuopc/cime_config/buildnml b/src/drivers/nuopc/cime_config/buildnml index 2716b29befb..9ed9f63f16a 100755 --- a/src/drivers/nuopc/cime_config/buildnml +++ b/src/drivers/nuopc/cime_config/buildnml @@ -49,6 +49,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' + config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' # needed for determining the run sequence config['COMP_ATM'] = case.get_value("COMP_ATM") diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index f49fc73cd9a..d6bbf0369fb 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -1005,19 +1005,6 @@ - - char - control - MED_attributes - off,ocn - - Only used for C,G compsets: if ocn, ocn provides EP balance factor for precip - - - $CPL_EPBAL - - - logical control @@ -1554,8 +1541,7 @@ n total number of scalars in the scalar coupling field - 3 - 4 + 5 @@ -1595,6 +1581,18 @@ n + + integer + expdef + ALLCOMP_attributes + + index of valid glc input from mediator + + + 4 + + + integer expdef @@ -1603,12 +1601,12 @@ n index of scalar containing epbal precipitation factor from ocn (only for POP) - 0 - 4 + 0 + 5 - + char mapping abs @@ -1619,7 +1617,7 @@ n - + char mapping abs diff --git a/src/drivers/nuopc/mediator/fd.yaml b/src/drivers/nuopc/mediator/fd.yaml index 3936273fcda..5c7eaf837af 100644 --- a/src/drivers/nuopc/mediator/fd.yaml +++ b/src/drivers/nuopc/mediator/fd.yaml @@ -193,6 +193,14 @@ # section: atmosphere export #----------------------------------- # + - standard_name: Faxa_nhx + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_noy + canonical_units: kg m-2 s-1 + description: atmosphere export + # - standard_name: Faxa_bcph canonical_units: kg m-2 s-1 description: atmosphere export From 7b8e02b723a5e44bbca601d2c94a81d97f2fd7d7 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Apr 2019 13:24:56 -0600 Subject: [PATCH 02/15] introduction of new aofluxes calculation in mediator --- .../data_comps/dice/nuopc/ice_comp_nuopc.F90 | 4 + .../mct/cime_config/config_component_cesm.xml | 2 +- .../cime_config/config_component_cesm.xml | 56 +-- .../cime_config/namelist_definition_drv.xml | 8 +- .../nuopc/mediator/med_calc_aofluxes_mod.F90 | 403 ++++++++++++++++++ .../mediator/med_phases_aofluxes_mod.F90 | 19 +- 6 files changed, 450 insertions(+), 42 deletions(-) create mode 100644 src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 diff --git a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index 8bc0022e4b2..77a41a846f4 100644 --- a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -347,6 +347,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + write(logunit,*) " obtaining dice mesh from " // trim(cvalue) + end if + !-------------------------------- ! Initialize model !-------------------------------- diff --git a/src/drivers/mct/cime_config/config_component_cesm.xml b/src/drivers/mct/cime_config/config_component_cesm.xml index 79f98007473..2839cf84603 100644 --- a/src/drivers/mct/cime_config/config_component_cesm.xml +++ b/src/drivers/mct/cime_config/config_component_cesm.xml @@ -221,7 +221,7 @@ 288 72 48 - 4 + 24 24 24 24 diff --git a/src/drivers/nuopc/cime_config/config_component_cesm.xml b/src/drivers/nuopc/cime_config/config_component_cesm.xml index fe281c4a324..4eba9bde6bc 100644 --- a/src/drivers/nuopc/cime_config/config_component_cesm.xml +++ b/src/drivers/nuopc/cime_config/config_component_cesm.xml @@ -203,34 +203,34 @@ 48 - 24 - 24 - 24 - 24 - 48 - 1 - 96 - 96 - 96 - 96 - 192 - 192 - 192 - 192 - 384 - 384 - 384 - 144 - 72 - 144 - 288 - 48 - 48 - 24 - 24 - 1 - 4 - 4 + 24 + 24 + 24 + 24 + 48 + 1 + 96 + 96 + 96 + 96 + 192 + 192 + 192 + 192 + 384 + 384 + 384 + 144 + 72 + 144 + 288 + 48 + 48 + 24 + 24 + 1 + + run_coupling env_run.xml diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index d6bbf0369fb..09f188d9b1d 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -108,11 +108,10 @@ char expdef DRIVER_attributes - e3sm,cesm + cesm cime model cesm - e3sm @@ -784,7 +783,6 @@ 0.01 0.0 - 0.0 @@ -797,7 +795,6 @@ 5 - 2 @@ -809,8 +806,9 @@ if true use Mahrt and Sun 1995,MWR modification to surface flux calculation + .false. + .false. .true. - .false. diff --git a/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 new file mode 100644 index 00000000000..b944b2b5161 --- /dev/null +++ b/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 @@ -0,0 +1,403 @@ +module med_calc_aofluxes_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 ESMF , only : ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite + use med_constants_mod , only : R8 + use med_internalstate_mod , only : logunit + use water_isotopes , only : wiso_flxoce ! calculate water isotope fluxes. + use shr_const_mod + + implicit none + private ! default private + + ! public member functions: + public :: flux_adjust_constants ! adjust constant values used in flux calculations. + public :: flux_atmOcn ! computes atm/ocn fluxes + + ! The follow variables are not declared as parameters so that they can be + ! adjusted to support aquaplanet and potentially other simple model modes. + ! The shr_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 shr_flux_atmocn and shr_flux_atmice routines. + + real(R8) :: loc_zvir = shr_const_zvir + real(R8) :: loc_cpdair = shr_const_cpdair + real(R8) :: loc_cpvir = shr_const_cpvir + real(R8) :: loc_karman = shr_const_karman + real(R8) :: loc_g = shr_const_g + real(R8) :: loc_latvap = shr_const_latvap + real(R8) :: loc_latice = shr_const_latice + real(R8) :: loc_stebol = shr_const_stebol + + ! These control convergence of the iterative flux calculation + real(r8) :: flux_con_tol = 0.0_R8 + 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__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine 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 , optional, intent(in) :: flux_convergence_max_iteration + logical , optional, intent(in) :: coldair_outbreak_mod + !---------------------------------------------------------------------------- + + if (present(zvir)) loc_zvir = zvir + if (present(cpair)) loc_cpdair = cpair + if (present(cpvir)) loc_cpvir = cpvir + if (present(karman)) loc_karman = karman + if (present(gravit)) loc_g = gravit + if (present(latvap)) loc_latvap = latvap + if (present(latice)) loc_latice = latice + if (present(stebol)) loc_stebol = stebol + if (present(flux_convergence_tolerance )) flux_con_tol = flux_convergence_tolerance + if (present(flux_convergence_max_iteration )) flux_con_max_iter = flux_convergence_max_iteration + if (present(coldair_outbreak_mod )) use_coldair_outbreak_mod = coldair_outbreak_mod + + end subroutine flux_adjust_constants + + !=============================================================================== + + subroutine flux_atmOcn(nMax , zbot , ubot , vbot , thbot , prec_gust, gust_fac, & + qbot , s16O , sHDO , s18O , rbot , & + tbot , 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, rc) + + ! Calculate atm/ocn fluxes + + ! input/output variables + 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) :: 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) :: prec_gust (nMax) ! atm precip for convective gustiness (kg/m^3) + real(R8) ,intent(in) :: gust_fac ! wind gustiness factor + + !--- 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 + integer ,intent(out) :: rc + + 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 :: umin = 0.5_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) + + !--- local variables -------------------------------- + integer :: n ! vector loop index + integer :: iter + real(R8) :: vmag ! surface wind magnitude (m/s) + real(R8) :: vmag_old ! surface wind magnitude without gustiness (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 + + !--- 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) :: ugust ! function: gustiness as a function of convective rainfall + real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) + real(R8) :: Tk ! dummy arg ~ temperature (K) + real(R8) :: xd ! dummy arg ~ ? + real(R8) :: gprec ! dummy arg ~ ? + !--- 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) + + ! Convective gustiness appropriate for input precipitation. + ! Following Redelsperger 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) = gust_fac*log(1._R8+57801.6_R8*gprec-3.55332096e7_R8*(gprec**2.0_R8)) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(shr_flux_atmOcn) ' + character(*),parameter :: F00 = "('(shr_flux_atmOcn) ',4a)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + 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 --- + + ! old version + !vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + !--- vmag+ugust (convective gustiness) Limit to a max precip 6 cm/day = 0.00069444 m/s. + !--- reverts to original formula if gust_fac=0 + + !PMA saves vmag_old for taux tauy computation + + vmag_old = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + if (gust_fac .gt. 1.e-12_R8) then + vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(prec_gust(n),6.94444e-4_R8))) + else + vmag = vmag_old + endif + 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 + vmag_old=vmag_old*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 + ren = 0.0346_R8 + + !--- 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 + rdn/loc_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update transfer coeffs at 10m and neutral stability --- + rdn = sqrt(cdn(u10n)) + ren = 0.0346_R8 + rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 + + !--- 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 ESMF_LogWrite('No iterations performed - ERROR in med_calc_aofluxe') + rc=ESMF_Failure + return + end if + + !------------------------------------------------------------ + ! compute the fluxes + !------------------------------------------------------------ + + tau = rbot(n) * ustar * ustar + + !--- momentum flux --- + taux(n) = tau * (ubot(n)-us(n)) / vmag_old !PMA uses vmag_old for taux + tauy(n) = tau * (vbot(n)-vs(n)) / vmag_old ! tauy c20170620 + + !--- 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 + + !------------------------------------------------------------ + ! 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 + + 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 + end DO + + end subroutine flux_atmOcn + +end module med_calc_aofluxes_mod diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index 7fdbd66418b..e1abbcff55d 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -221,6 +221,8 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, character(*),parameter :: subName = '(med_aofluxes_init) ' !----------------------------------------------------------------------- + call t_startf('MED:'//subname) + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif @@ -410,12 +412,12 @@ end subroutine med_aofluxes_init subroutine med_aofluxes_run(gcomp, aoflux, rc) - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info - use NUOPC , only : NUOPC_CompAttributeGet - use shr_flux_mod , only : shr_flux_atmocn, shr_flux_adjust_constants - use perf_mod , only : t_startf, t_stopf + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info + use NUOPC , only : NUOPC_CompAttributeGet + use med_calc_aofluxes_mod , only : flux_atmocn, flux_adjust_constants + use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- ! Determine atm/ocn fluxes eother on atm or on ocean grid @@ -464,7 +466,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_convergence - call shr_flux_adjust_constants(& + call flux_adjust_constants(& flux_convergence_tolerance=flux_convergence, & flux_convergence_max_iteration=flux_max_iteration, & coldair_outbreak_mod=coldair_outbreak_mod) @@ -535,7 +537,8 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) aoflux%evap, aoflux%evap_16O, aoflux%evap_HDO, aoflux%evap_18O, & aoflux%taux, aoflux%tauy, aoflux%tref, aoflux%qref, & aoflux%duu10n, ustar_sv=aoflux%ustar, re_sv=aoflux%re, ssq_sv=aoflux%ssq, & - missval = 0.0_r8) + missval = 0.0_r8, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize if (aoflux%mask(n) /= 0) then From 7b4950779ed71952a411a7cb0eeed37b39ef08db Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 23 Apr 2019 14:43:58 -0600 Subject: [PATCH 03/15] updates to get pop/ww3 caps working --- src/drivers/nuopc/cime_config/buildnml | 1 + src/drivers/nuopc/cime_config/namelist_definition_drv.xml | 6 +++--- src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 | 4 ++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/drivers/nuopc/cime_config/buildnml b/src/drivers/nuopc/cime_config/buildnml index 9ed9f63f16a..3376b7d01a1 100755 --- a/src/drivers/nuopc/cime_config/buildnml +++ b/src/drivers/nuopc/cime_config/buildnml @@ -50,6 +50,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' + config['atm_grid'] = case.get_value('ATM_GRID') # needed for determining the run sequence config['COMP_ATM'] = case.get_value("COMP_ATM") diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index 09f188d9b1d..53878cff395 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -806,9 +806,9 @@ if true use Mahrt and Sun 1995,MWR modification to surface flux calculation - .false. - .false. - .true. + .true. + .false. + .false. diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index e1abbcff55d..659b16c504e 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -528,8 +528,8 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end do end if - call shr_flux_atmocn (& - lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, & + call flux_atmocn (& + lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, aoflux%prec_gust, gust_fac, & aoflux%shum, aoflux%shum_16O, aoflux%shum_HDO, aoflux%shum_18O, aoflux%dens , & aoflux%tbot, aoflux%uocn, aoflux%vocn, & aoflux%tocn, aoflux%mask, aoflux%sen, aoflux%lat, aoflux%lwup, & From fdaa2abf701b8b4bd3cf5c527cf3fa6021c3ef00 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Thu, 25 Apr 2019 20:26:26 -0600 Subject: [PATCH 04/15] fixes to get GECO compset running --- config/cesm/config_grids.xml | 1 + .../cime_config/config_component_cesm.xml | 2 +- .../nuopc/mediator/esmFldsExchange.F90 | 4 ++ .../mediator/med_phases_prep_ocn_mod.F90 | 38 +++++-------------- 4 files changed, 16 insertions(+), 29 deletions(-) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 5e7d79f0244..b35d2c35d96 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -1412,6 +1412,7 @@ $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.1v2.161014.nc $DIN_LOC_ROOT/share/domains/domain.lnd.TL319_tx0.1v3.170730.nc $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.1v3.170730.nc + $DIN_LOC_ROOT/share/meshes/TL319_151007_ESMFmesh.nc TL319 grid for JRA55 diff --git a/src/drivers/nuopc/cime_config/config_component_cesm.xml b/src/drivers/nuopc/cime_config/config_component_cesm.xml index 4eba9bde6bc..2573e79c984 100644 --- a/src/drivers/nuopc/cime_config/config_component_cesm.xml +++ b/src/drivers/nuopc/cime_config/config_component_cesm.xml @@ -269,7 +269,7 @@ integer $ATM_NCPL - 1 + 24 4 24 24 diff --git a/src/drivers/nuopc/mediator/esmFldsExchange.F90 b/src/drivers/nuopc/mediator/esmFldsExchange.F90 index f1404adda15..c42c586bd7c 100644 --- a/src/drivers/nuopc/mediator/esmFldsExchange.F90 +++ b/src/drivers/nuopc/mediator/esmFldsExchange.F90 @@ -1145,7 +1145,11 @@ subroutine esmFldsExchange(gcomp, phase, rc) call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') else call addmap(fldListFr(compice)%flds, 'Si_ifrac_n' , compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Si_ifrac_n', mrg_from1=compice, mrg_fld1='Si_ifrac_n', & + mrg_type1='copy') call addmap(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_swpen_ifrac_n', mrg_from1=compice, mrg_fld1='Fioi_swpen_ifrac_n', & + mrg_type1='copy') ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if end if diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 index 05bf4fdc5cf..1bda68d0c20 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 @@ -151,6 +151,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) real(R8), pointer :: Faox_lwup(:) real(R8), pointer :: Faxa_lwdn(:) real(R8), pointer :: dataptr_i(:), dataptr_o(:) + real(R8), pointer :: dataptr2d_i(:,:), dataptr2d_o(:,:) real(R8) :: ifrac_scaled, ofrac_scaled real(R8) :: ifracr_scaled, ofracr_scaled real(R8) :: frac_sum @@ -334,12 +335,9 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) fswabsi = Faxa_swndr(n) * (1.0_R8 - albnir_dir) + Faxa_swndf(n) * (1.0_R8 - albnir_dif) Foxx_swnet(n) = fswabsv + fswabsi - if (export_swnet_afracr) then - Foxx_swnet_afracr(n) = fswabsv + fswabsi - end if - ! Add swpen from sea ice if sea ice is present if (is_local%wrap%comp_present(compice)) then + if (trim(coupling_mode) == 'cesm') then ifrac_scaled = ifrac(n) ofrac_scaled = ofrac(n) @@ -359,7 +357,12 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) ofracr_scaled = ofrac(n) ifrac_scaled = ifrac(n) end if - Foxx_swnet(n) = ofracr_scaled*Foxx_swnet(n) + ifrac_scaled*Fioi_swpen(n) + + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + + if (export_swnet_afracr) then + Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) + end if if (export_swnet_by_bands) then if (import_swpen_by_bands) then @@ -384,34 +387,13 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) end do ! Output to ocean per ice thickness fraction and sw penetrating into ocean - if ( FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn) , 'Si_ifrac_n', rc=rc)) then - - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', dataptr_i, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Si_ifrac_n', dataptr_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = dataptr_i(:) - end if - - if ( FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', rc=rc) .and. & - FB_fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_swpen_ifrac_n', rc=rc)) then - - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', dataptr_i, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Fioi_swpen_ifrac_n', dataptr_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr_o(:) = dataptr_i(:) - end if - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', dataptr_o, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', fldptr1=dataptr_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return dataptr_o(:) = ofrac(:) end if - if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then - call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', dataptr_o, rc=rc) + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', fldptr1=dataptr_o, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return dataptr_o(:) = ofracr(:) end if From f3f1fd8047138134f97584ea7618c701754cc8d6 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 26 Apr 2019 12:38:29 -0600 Subject: [PATCH 05/15] add --xml-driver to create_test --- scripts/create_test | 9 ++++++--- scripts/lib/CIME/test_utils.py | 15 ++++++++++++++- .../nuopc/mediator/med_phases_restart_mod.F90 | 11 ++++++----- 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/scripts/create_test b/scripts/create_test index 2bcd5bae1ae..f6957eff090 100755 --- a/scripts/create_test +++ b/scripts/create_test @@ -157,6 +157,9 @@ def parse_command_line(args, description): parser.add_argument("--xml-testlist", help="Use this testlist to lookup tests.The default is specified in config_files.xml") + parser.add_argument("--xml-driver", choices=('mct', 'nuopc', 'moab'), + help="Override driver specified in tests and use this one.") + parser.add_argument("testargs", nargs="*", help="Tests to run. Testname form is TEST.GRID.COMPSET[.MACHINE_COMPILER]") @@ -388,9 +391,9 @@ def parse_command_line(args, description): "At least one of --xml-machine, --xml-testlist, " "--xml-compiler, --xml-category or a valid test name must be provided.") - test_data = get_tests_from_xml(args.xml_machine, args.xml_category, - args.xml_compiler, args.xml_testlist, - machine_name, args.compiler) + test_data = get_tests_from_xml(xml_machine=args.xml_machine, xml_category=args.xml_category, + xml_compiler=args.xml_compiler, xml_testlist=args.xml_testlist, + machine=machine_name, compiler=args.compiler, driver=args.xml_driver) test_names = [item["name"] for item in test_data] for test_datum in test_data: test_extra_data[test_datum["name"]] = test_datum diff --git a/scripts/lib/CIME/test_utils.py b/scripts/lib/CIME/test_utils.py index dd67eb4a48a..25f2af0a0a0 100644 --- a/scripts/lib/CIME/test_utils.py +++ b/scripts/lib/CIME/test_utils.py @@ -11,7 +11,7 @@ logger = logging.getLogger(__name__) def get_tests_from_xml(xml_machine=None,xml_category=None,xml_compiler=None, xml_testlist=None, - machine=None, compiler=None): + machine=None, compiler=None, driver=None): """ Parse testlists for a list of tests """ @@ -46,6 +46,19 @@ def get_tests_from_xml(xml_machine=None,xml_category=None,xml_compiler=None, xml test["name"] = CIME.utils.get_full_test_name(test["testname"], grid=test["grid"], compset=test["compset"], machine=thismach, compiler=thiscompiler, testmod=None if "testmods" not in test else test["testmods"]) + if driver: + # override default or specified driver + founddriver = False + for specdriver in ("Vnuopc","Vmct","Vmoab"): + if specdriver in test["name"]: + test["name"] = test["name"].replace(specdriver,"V{}".format(driver)) + founddriver = True + if not founddriver: + name = test["name"] + index = name.find('.') + test["name"] = name[:index] + "_V{}".format(driver) + name[index:] + + logger.debug("Adding test {} with compiler {}".format(test["name"], test["compiler"])) listoftests += newtests logger.debug("Found {:d} tests".format(len(listoftests))) diff --git a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index bcb4837d406..0da2742f04a 100644 --- a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -38,7 +38,7 @@ subroutine med_phases_restart_write(gcomp, rc) use med_constants_mod , only : med_constants_noleap use med_constants_mod , only : med_constants_gregorian use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_internalstate_mod , only : InternalState + use med_internalstate_mod, only : mastertask, logunit, InternalState use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd use med_io_mod , only : med_io_sec2hms @@ -177,10 +177,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif - - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + if(mastertask) then + call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", unit=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + endif timediff = nexttime - reftime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) dayssince = day + sec/real(SecPerDay,R8) From 2f1b4e92c8ff5857bac6181093baa4af02f143fd Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 26 Apr 2019 12:44:13 -0600 Subject: [PATCH 06/15] changes to git dice working with Si_ifrac_01 --- .../data_comps/dice/nuopc/dice_comp_mod.F90 | 25 ++++++++++++++++--- .../data_comps/dice/nuopc/ice_comp_nuopc.F90 | 12 ++++++--- .../nuopc/cime_config/config_component.xml | 2 +- 3 files changed, 31 insertions(+), 8 deletions(-) diff --git a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 index 68062a36a11..8f1a7d6443e 100644 --- a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +++ b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 @@ -118,7 +118,8 @@ module dice_comp_mod !=============================================================================== subroutine dice_comp_advertise(importState, exportState, flds_scalar_name, & - ice_present, ice_prognostic, fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) + ice_present, ice_prognostic, flds_i2o_per_cat, & + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState @@ -126,6 +127,7 @@ subroutine dice_comp_advertise(importState, exportState, flds_scalar_name, & character(len=*) , intent(in) :: flds_scalar_name logical , intent(in) :: ice_present logical , intent(in) :: ice_prognostic + logical , intent(in) :: flds_i2o_per_cat integer , intent(out) :: fldsToIce_num integer , intent(out) :: fldsFrIce_num type (fld_list_type) , intent(out) :: fldsToIce(:) @@ -154,6 +156,15 @@ subroutine dice_comp_advertise(importState, exportState, flds_scalar_name, & call dshr_fld_add(data_fld='ifrac', data_fld_array=avifld, model_fld='Si_ifrac', model_fld_array=avofld, & model_fld_concat=flds_i2x, model_fld_index=kiFrac, fldlist_num=fldsFrIce_num, fldlist=fldsFrIce) + if (flds_i2o_per_cat) then + call dshr_fld_add(model_fld='Si_ifrac_01' , model_fld_concat=flds_i2x, model_fld_index=kiFrac_01) + call dshr_fld_add(model_fld='Fioi_swpen_ifrac_01', model_fld_concat=flds_i2x, model_fld_index=kswpen_iFrac_01) + call dshr_fld_add(med_fld='Si_ifrac_n', fldlist_num=fldsFrIce_num, fldlist=fldsFrIce, & + ungridded_lbound=1, ungridded_ubound=1) + call dshr_fld_add(med_fld='Fioi_swpen_ifrac_n', fldlist_num=fldsFrIce_num, fldlist=fldsFrIce, & + ungridded_lbound=1, ungridded_ubound=1) + end if + ! export fields that have no corresponding stream field (computed internally) call dshr_fld_add(model_fld='Si_imask', model_fld_concat=flds_i2x, model_fld_index=km, & @@ -500,7 +511,7 @@ subroutine dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task ! optional per thickness category fields if (flds_i2o_per_cat) then kiFrac_01 = mct_aVect_indexRA(i2x,'Si_ifrac_01') - kswpen_iFrac_01 = mct_aVect_indexRA(i2x,'PFioi_swpen_ifrac_01') + kswpen_iFrac_01 = mct_aVect_indexRA(i2x,'Fioi_swpen_ifrac_01') end if call mct_aVect_init(x2i, rList=flds_x2i, lsize=lsize) @@ -966,10 +977,11 @@ end subroutine dice_comp_import !=============================================================================== - subroutine dice_comp_export(exportState, rc) + subroutine dice_comp_export(exportState, flds_i2o_per_cat, rc) ! input/output variables type(ESMF_State) :: exportState + logical, intent(in) :: flds_i2o_per_cat integer, intent(out) :: rc ! local variables @@ -981,6 +993,13 @@ subroutine dice_comp_export(exportState, rc) call dshr_export(i2x%rattr(kiFrac,:) , exportState, 'Si_ifrac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (flds_i2o_per_cat) then + call dshr_export(i2x%rattr(kiFrac_01,:), exportState, 'Si_ifrac_n', ungridded_index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kswpen_iFrac_01,:), exportState, 'Fioi_swpen_ifrac_n', ungridded_index=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call dshr_export(i2x%rattr(km,:) , exportState, 'Si_imask', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index 77a41a846f4..7f54b781504 100644 --- a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -230,9 +230,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_i2o_per_cat + call dice_comp_advertise(importstate, exportState, flds_scalar_name, & - ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) + ice_present, ice_prognostic, flds_i2o_per_cat, & + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -410,7 +414,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) calendar, modeldt, current_ymd, current_tod, cosArg) ! Pack export state - call dice_comp_export(exportState, rc=rc) + call dice_comp_export(exportState, flds_i2o_per_cat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & @@ -543,7 +547,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call dice_comp_export(exportState, rc=rc) + call dice_comp_export(exportState, flds_i2o_per_cat, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- diff --git a/src/drivers/nuopc/cime_config/config_component.xml b/src/drivers/nuopc/cime_config/config_component.xml index b090350ab71..0a5fe506105 100644 --- a/src/drivers/nuopc/cime_config/config_component.xml +++ b/src/drivers/nuopc/cime_config/config_component.xml @@ -1914,7 +1914,7 @@ integer - 2 + 1 1,2 build_macros env_build.xml From e0a1a0e8acbfeb7c6b2e3545313d6002bdf57756 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 29 Apr 2019 21:35:59 -0600 Subject: [PATCH 07/15] added new grid for pop forcing --- config/cesm/config_grids.xml | 1 + 1 file changed, 1 insertion(+) diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index b35d2c35d96..c7d9be8ae74 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -1529,6 +1529,7 @@ 1440 720 + $DIN_LOC_ROOT/share/meshes/JRA025m.170209_ESMFmesh.nc JRA is 0.25 degree runoff grid for use with JRA-55 runoff data From 0fc0ee2e0152ef63a179b518dbaa62558c385d42 Mon Sep 17 00:00:00 2001 From: mvertens Date: Wed, 1 May 2019 13:57:22 -0600 Subject: [PATCH 08/15] changes to have nag working --- .../xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 | 2 +- .../nuopc/cime_driver/ensemble_driver.F90 | 2 +- src/drivers/nuopc/cime_driver/esm.F90 | 4 +- src/drivers/nuopc/mediator/esmFlds.F90 | 2 +- .../nuopc/mediator/esmFldsExchange.F90 | 48 ++++++++++--------- src/drivers/nuopc/mediator/med.F90 | 2 +- .../nuopc/mediator/med_internalstate_mod.F90 | 17 +++---- .../mediator/med_phases_prep_ocn_mod.F90 | 2 +- .../mediator/med_phases_prep_rof_mod.F90 | 8 ++-- 9 files changed, 45 insertions(+), 42 deletions(-) diff --git a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index 83885a73e94..6da7c9f24cf 100644 --- a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -494,7 +494,7 @@ 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' .or. fldname == 'Sg_ice_covered') then data1d(:) = 1._r8 else do i = 1,size(data1d) diff --git a/src/drivers/nuopc/cime_driver/ensemble_driver.F90 b/src/drivers/nuopc/cime_driver/ensemble_driver.F90 index a5ac49cffb8..27062a1e125 100644 --- a/src/drivers/nuopc/cime_driver/ensemble_driver.F90 +++ b/src/drivers/nuopc/cime_driver/ensemble_driver.F90 @@ -307,7 +307,7 @@ subroutine InitRestart(ensemble_driver, read_restart, rc) endif ! Add rest_case_name and read_restart to ensemble_driver attributes - call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) + call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'rest_case_name','read_restart '/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rest_case_name = ' ' diff --git a/src/drivers/nuopc/cime_driver/esm.F90 b/src/drivers/nuopc/cime_driver/esm.F90 index 8dba1506c63..f3d6d370f47 100644 --- a/src/drivers/nuopc/cime_driver/esm.F90 +++ b/src/drivers/nuopc/cime_driver/esm.F90 @@ -489,7 +489,7 @@ subroutine InitRestart(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Add rest_case_name and read_restart to driver attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) + call NUOPC_CompAttributeAdd(driver, attrList=(/'rest_case_name','read_restart '/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return rest_case_name = ' ' @@ -938,7 +938,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r ! Add all the other attributes in AttrList (which have already been added to driver attributes) !------ allocate(attrList(5)) - attrList = (/"read_restart", "orb_eccen", "orb_obliqr", "orb_lambm0", "orb_mvelpp"/) + attrList = (/"read_restart", "orb_eccen ", "orb_obliqr ", "orb_lambm0 ", "orb_mvelpp "/) call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/esmFlds.F90 b/src/drivers/nuopc/mediator/esmFlds.F90 index e3b1c41863b..f84b52cebac 100644 --- a/src/drivers/nuopc/mediator/esmFlds.F90 +++ b/src/drivers/nuopc/mediator/esmFlds.F90 @@ -38,7 +38,7 @@ module esmflds integer , public, parameter :: nmappers = 8 character(len=*) , public, parameter :: mapnames(nmappers) = & - (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'nstod', 'nstod_consd', 'nstod_consf'/) + (/'bilnr ','consf ', 'consd ', 'patch ', 'fcopy ', 'nstod ', 'nstod_consd', 'nstod_consf'/) !----------------------------------------------- ! Set coupling mode diff --git a/src/drivers/nuopc/mediator/esmFldsExchange.F90 b/src/drivers/nuopc/mediator/esmFldsExchange.F90 index c42c586bd7c..2cd04909c5f 100644 --- a/src/drivers/nuopc/mediator/esmFldsExchange.F90 +++ b/src/drivers/nuopc/mediator/esmFldsExchange.F90 @@ -448,8 +448,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- allocate(flds(9)) - flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', & - 'Sa_ptem', 'Sa_pbot', 'Sa_shum', 'Sa_shum_wiso'/) + flds = (/'Sa_z ', 'Sa_topo ', 'Sa_u ', 'Sa_v ', 'Sa_tbot ', & + 'Sa_ptem ', 'Sa_pbot ', 'Sa_shum ', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -493,9 +493,9 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! TODO (mvertens, 2019-03-10): add water isotopes from atm allocate(flds(14)) - flds = (/'Faxa_rainc' , 'Faxa_rainl' , 'Faxa_snowc' , 'Faxa_snowl' , & - 'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & - 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) + flds = (/'Faxa_rainc ', 'Faxa_rainl ', 'Faxa_snowc ', 'Faxa_snowl ', & + 'Faxa_lwdn ', 'Faxa_swndr ', 'Faxa_swvdr ', 'Faxa_swndf ', 'Faxa_swvdf ', & + 'Faxa_bcph ', 'Faxa_ocph ', 'Faxa_dstwet', 'Faxa_dstdry', 'Faxa_ndep ' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -519,7 +519,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: river water flux back to land due to flooding ! --------------------------------------------------------------------- allocate(flds(6)) - flds = (/'Flrr_volr', 'Flrr_volr_wiso', 'Flrr_volrmch', 'Flrr_volrmch_wiso', 'Flrr_flood', 'Flrr_flood_wiso'/) + flds = (/'Flrr_volr ', 'Flrr_volr_wiso ', 'Flrr_volrmch ', & + 'Flrr_volrmch_wiso', 'Flrr_flood ', 'Flrr_flood_wiso '/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -543,7 +544,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: fields with multiple elevation classes from glc ! --------------------------------------------------------------------- allocate(flds(2)) - flds = (/'Sg_icemask', 'Sg_icemask_coupled_fluxes'/) + flds = (/'Sg_icemask ', 'Sg_icemask_coupled_fluxes'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -652,7 +653,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- allocate(suffix(4)) - suffix = (/'tref', 'u10', 'qref', 'qref_wiso'/) + suffix = (/'tref ', 'u10 ', 'qref ', 'qref_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -705,7 +706,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- allocate(suffix(7)) - suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_wiso'/) + suffix = (/'taux ', 'tauy ', 'lat ', 'sen ', 'lwup ', 'evap ', 'evap_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -820,7 +821,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: mean snow volume per unit area from ice ! --------------------------------------------------------------------- allocate(flds(3)) - flds = (/'Si_snowh', 'Si_vice', 'Si_vsno'/) + flds = (/'Si_snowh', 'Si_vice ', 'Si_vsno '/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -848,7 +849,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- allocate(flds(3)) - flds = (/'So_ssq', 'So_re', 'So_ustar'/) + flds = (/'So_ssq ', 'So_re ', 'So_ustar'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -872,7 +873,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- allocate(flds(3)) - flds = (/'Sl_fv', 'Sl_ram1', 'Sl_snowh'/) + flds = (/'Sl_fv ', 'Sl_ram1 ', 'Sl_snowh'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -991,7 +992,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ocn: downward diffuse visible incident solar radiation from atm ! --------------------------------------------------------------------- allocate(flds(5)) - flds = (/'Faxa_lwdn', 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swndf'/) + flds = (/'Faxa_lwdn ', 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swndf'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1354,7 +1355,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ocn: nitrogen deposition fields (2) from atm ! --------------------------------------------------------------------- allocate(flds(5)) - flds = (/'Faxa_bcph', 'Faxa_ocph', 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) + flds = (/'Faxa_bcph ', 'Faxa_ocph ', 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep ' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1452,7 +1453,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! Is fd.yaml correctly aliasing Fioi_melth? allocate(flds(5)) - flds = (/'Fioi_melth', 'Fioi_salt', 'Fioi_bcphi', 'Fioi_bcpho', 'Fioi_flxdst'/) + flds = (/'Fioi_melth ', 'Fioi_salt ', 'Fioi_bcphi ', 'Fioi_bcpho ', 'Fioi_flxdst'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1555,7 +1556,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ocn: Stokes drift depth from wave !----------------------------- allocate(flds(4)) - flds = (/'Sw_lamult', 'Sw_ustokes', 'Sw_vstokes', 'Sw_hstokes'/) + flds = (/'Sw_lamult ', 'Sw_ustokes', 'Sw_vstokes', 'Sw_hstokes'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1599,8 +1600,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- allocate(flds(9)) - flds = (/'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & - 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry' /) + flds = (/'Faxa_lwdn ' , 'Faxa_swndr ' , 'Faxa_swvdr ' , 'Faxa_swndf ' , 'Faxa_swvdf ', & + 'Faxa_bcph ' , 'Faxa_ocph ' , 'Faxa_dstwet' , 'Faxa_dstdry' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1712,7 +1713,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- allocate(flds(9)) - flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', 'Sa_shum', 'Sa_shum_wiso'/) + flds = (/'Sa_z ', 'Sa_pbot ', 'Sa_tbot ', 'Sa_ptem ', & + 'Sa_dens ', 'Sa_u ', 'Sa_v ', 'Sa_shum ', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1743,7 +1745,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: meridional sea surface slope from ocn ! --------------------------------------------------------------------- allocate(flds(6)) - flds = (/'So_t', 'So_s', 'So_u', 'So_v', 'So_dhdx', 'So_dhdy'/) + flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ', 'So_dhdx', 'So_dhdy'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1844,7 +1846,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- allocate(flds(4)) - flds = (/'So_t', 'So_u', 'So_v', 'So_bldepth'/) + flds = (/'So_t ', 'So_u ', 'So_v ', 'So_bldepth'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1867,7 +1869,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to wav: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- allocate(flds(3)) - flds = (/'Sa_u', 'Sa_v', 'Sa_tbot'/) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_tbot'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1903,7 +1905,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! 'Flrl_rofi' , 'Flrl_rofi_wiso' , 'Flrl_irrig' , 'Flrl_irrig_wiso' /) allocate(flds(6)) - flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi', 'Flrl_irrig'/) + flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi ', 'Flrl_irrig '/) do n = 1,size(flds) fldname = trim(flds(n)) diff --git a/src/drivers/nuopc/mediator/med.F90 b/src/drivers/nuopc/mediator/med.F90 index 0ea2d2d22d5..7e00e24bacc 100644 --- a/src/drivers/nuopc/mediator/med.F90 +++ b/src/drivers/nuopc/mediator/med.F90 @@ -1958,7 +1958,7 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_ALARM) :: glc_avg_alarm logical :: glc_present character(len=16) :: glc_avg_period - integer :: first_time = .true. + logical :: first_time = .true. character(len=*),parameter :: subname='(module_MED:SetRunClock)' !----------------------------------------------------------- diff --git a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 index 332cc8c4801..2865160ddb9 100644 --- a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 +++ b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 @@ -31,14 +31,15 @@ module med_internalstate_mod ! tcraig, turned off glc2ocn and glc2ice for time being logical, public, parameter :: med_coupling_allowed(ncomps,ncomps) = & - (/ .false., .false., .false., .false., .false., .false., .false., .false., & ! med - .false., .false., .true. , .true. , .true. , .false., .false., .false., & ! atm - .false., .true. , .false., .false., .false., .true. , .false., .true. , & ! lnd - .false., .true. , .false., .false., .true. , .true. , .true. , .false., & ! ocn - .false., .true. , .false., .true. , .false., .true. , .false., .false., & ! ice - .false., .false., .true. , .false., .false., .false., .false., .false., & ! rof - .false., .true. , .false., .true. , .true. , .false., .false., .false., & ! wav - .false., .false., .true. , .false., .false., .false., .false., .false. /) ! glc + reshape([ .false., .false., .false., .false., .false., .false., .false., .false., & ! med + .false., .false., .true. , .true. , .true. , .false., .false., .false., & ! atm + .false., .true. , .false., .false., .false., .true. , .false., .true. , & ! lnd + .false., .true. , .false., .false., .true. , .true. , .true. , .false., & ! ocn + .false., .true. , .false., .true. , .false., .true. , .false., .false., & ! ice + .false., .false., .true. , .false., .false., .false., .false., .false., & ! rof + .false., .true. , .false., .true. , .true. , .false., .false., .false., & ! wav + .false., .false., .true. , .false., .false., .false., .false., .false. ], & ! glc + shape(med_coupling_allowed)) ! med atm lnd ocn ice rof wav glc ! private internal state to keep instance data diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 index 1bda68d0c20..cbeba9c73ac 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 @@ -411,7 +411,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) allocate(fldnames(4)) - fldnames = (/'Faxa_rain',' Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) + fldnames = (/'Faxa_rain','Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) do n = 1,size(fldnames) if (FB_fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 index d54a8724b68..adfe3759148 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 @@ -44,7 +44,7 @@ module med_phases_prep_rof_mod character(len=*), parameter :: volr_field = 'Flrr_volrmch' character(len=*), parameter :: irrig_flux_field = 'Flrl_irrig' character(len=*), parameter :: irrig_normalized_field = 'Flrl_irrig_normalized' - character(len=*), parameter :: irrig_volr0_field = 'Flrl_irrig_volr0' + character(len=*), parameter :: irrig_volr0_field = 'Flrl_irrig_volr0 ' character(*) , parameter :: u_FILE_u = & __FILE__ @@ -404,13 +404,13 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) call FB_init(FBout=FBlndIrrig, & flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(complnd,complnd), & - fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) + fieldNameList=(/irrig_normalized_field, irrig_volr0_field/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return call FB_init(FBout=FBrofIrrig, & flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(comprof,comprof), & - fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) + fieldNameList=(/irrig_normalized_field, irrig_volr0_field/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return end if @@ -490,7 +490,7 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! ------------------------------------------------------------------------ call med_map_FB_Regrid_Norm(& - (/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & + (/irrig_normalized_field, irrig_volr0_field/), & FBlndIrrig, FBrofIrrig, & is_local%wrap%FBFrac(complnd), 'lfrac', & is_local%wrap%RH(complnd, comprof, mapconsf), & From 8c42a8c4e764b3e0955e9c9d9ee928f565a61aef Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 3 May 2019 18:13:20 -0600 Subject: [PATCH 09/15] updates for merge to latest nuopc-cmeps --- .../nuopc/cime_config/config_component.xml | 2 +- .../cime_config/namelist_definition_drv.xml | 2 +- .../nuopc/mediator/med_calc_aofluxes_mod.F90 | 403 ------------------ .../mediator/med_phases_aofluxes_mod.F90 | 386 +++++++++++++++-- 4 files changed, 361 insertions(+), 432 deletions(-) delete mode 100644 src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 diff --git a/src/drivers/nuopc/cime_config/config_component.xml b/src/drivers/nuopc/cime_config/config_component.xml index 0a5fe506105..b090350ab71 100644 --- a/src/drivers/nuopc/cime_config/config_component.xml +++ b/src/drivers/nuopc/cime_config/config_component.xml @@ -1914,7 +1914,7 @@ integer - 1 + 2 1,2 build_macros env_build.xml diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index 53878cff395..27d6766e2e1 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -781,7 +781,7 @@ Setting this to zero will always do flux_max_iteration - 0.01 + 0.0 0.0 diff --git a/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 deleted file mode 100644 index b944b2b5161..00000000000 --- a/src/drivers/nuopc/mediator/med_calc_aofluxes_mod.F90 +++ /dev/null @@ -1,403 +0,0 @@ -module med_calc_aofluxes_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 ESMF , only : ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite - use med_constants_mod , only : R8 - use med_internalstate_mod , only : logunit - use water_isotopes , only : wiso_flxoce ! calculate water isotope fluxes. - use shr_const_mod - - implicit none - private ! default private - - ! public member functions: - public :: flux_adjust_constants ! adjust constant values used in flux calculations. - public :: flux_atmOcn ! computes atm/ocn fluxes - - ! The follow variables are not declared as parameters so that they can be - ! adjusted to support aquaplanet and potentially other simple model modes. - ! The shr_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 shr_flux_atmocn and shr_flux_atmice routines. - - real(R8) :: loc_zvir = shr_const_zvir - real(R8) :: loc_cpdair = shr_const_cpdair - real(R8) :: loc_cpvir = shr_const_cpvir - real(R8) :: loc_karman = shr_const_karman - real(R8) :: loc_g = shr_const_g - real(R8) :: loc_latvap = shr_const_latvap - real(R8) :: loc_latice = shr_const_latice - real(R8) :: loc_stebol = shr_const_stebol - - ! These control convergence of the iterative flux calculation - real(r8) :: flux_con_tol = 0.0_R8 - 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__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine 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 , optional, intent(in) :: flux_convergence_max_iteration - logical , optional, intent(in) :: coldair_outbreak_mod - !---------------------------------------------------------------------------- - - if (present(zvir)) loc_zvir = zvir - if (present(cpair)) loc_cpdair = cpair - if (present(cpvir)) loc_cpvir = cpvir - if (present(karman)) loc_karman = karman - if (present(gravit)) loc_g = gravit - if (present(latvap)) loc_latvap = latvap - if (present(latice)) loc_latice = latice - if (present(stebol)) loc_stebol = stebol - if (present(flux_convergence_tolerance )) flux_con_tol = flux_convergence_tolerance - if (present(flux_convergence_max_iteration )) flux_con_max_iter = flux_convergence_max_iteration - if (present(coldair_outbreak_mod )) use_coldair_outbreak_mod = coldair_outbreak_mod - - end subroutine flux_adjust_constants - - !=============================================================================== - - subroutine flux_atmOcn(nMax , zbot , ubot , vbot , thbot , prec_gust, gust_fac, & - qbot , s16O , sHDO , s18O , rbot , & - tbot , 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, rc) - - ! Calculate atm/ocn fluxes - - ! input/output variables - 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) :: 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) :: prec_gust (nMax) ! atm precip for convective gustiness (kg/m^3) - real(R8) ,intent(in) :: gust_fac ! wind gustiness factor - - !--- 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 - integer ,intent(out) :: rc - - 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 :: umin = 0.5_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) - - !--- local variables -------------------------------- - integer :: n ! vector loop index - integer :: iter - real(R8) :: vmag ! surface wind magnitude (m/s) - real(R8) :: vmag_old ! surface wind magnitude without gustiness (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 - - !--- 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) :: ugust ! function: gustiness as a function of convective rainfall - real(R8) :: Umps ! dummy arg ~ wind velocity (m/s) - real(R8) :: Tk ! dummy arg ~ temperature (K) - real(R8) :: xd ! dummy arg ~ ? - real(R8) :: gprec ! dummy arg ~ ? - !--- 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) - - ! Convective gustiness appropriate for input precipitation. - ! Following Redelsperger 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) = gust_fac*log(1._R8+57801.6_R8*gprec-3.55332096e7_R8*(gprec**2.0_R8)) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(shr_flux_atmOcn) ' - character(*),parameter :: F00 = "('(shr_flux_atmOcn) ',4a)" - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - 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 --- - - ! old version - !vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - !--- vmag+ugust (convective gustiness) Limit to a max precip 6 cm/day = 0.00069444 m/s. - !--- reverts to original formula if gust_fac=0 - - !PMA saves vmag_old for taux tauy computation - - vmag_old = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - if (gust_fac .gt. 1.e-12_R8) then - vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) + ugust(min(prec_gust(n),6.94444e-4_R8))) - else - vmag = vmag_old - endif - 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 - vmag_old=vmag_old*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 - ren = 0.0346_R8 - - !--- 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 + rdn/loc_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 - rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 - - !--- 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 ESMF_LogWrite('No iterations performed - ERROR in med_calc_aofluxe') - rc=ESMF_Failure - return - end if - - !------------------------------------------------------------ - ! compute the fluxes - !------------------------------------------------------------ - - tau = rbot(n) * ustar * ustar - - !--- momentum flux --- - taux(n) = tau * (ubot(n)-us(n)) / vmag_old !PMA uses vmag_old for taux - tauy(n) = tau * (vbot(n)-vs(n)) / vmag_old ! tauy c20170620 - - !--- 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 - - !------------------------------------------------------------ - ! 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 - - 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 - end DO - - end subroutine flux_atmOcn - -end module med_calc_aofluxes_mod diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index 659b16c504e..9d94314cbf9 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -9,6 +9,17 @@ module med_phases_aofluxes_mod use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init + use shr_const_mod , only : shr_const_zvir + use shr_const_mod , only : shr_const_zvir + use shr_const_mod , only : shr_const_cpdair + use shr_const_mod , only : shr_const_cpvir + use shr_const_mod , only : shr_const_karman + use shr_const_mod , only : shr_const_g + use shr_const_mod , only : shr_const_latvap + use shr_const_mod , only : shr_const_latice + use shr_const_mod , only : shr_const_stebol + use shr_const_mod , only : shr_const_spval + use water_isotopes , only : wiso_flxoce ! calculate water isotope fluxes. implicit none private @@ -25,6 +36,8 @@ module med_phases_aofluxes_mod private :: med_aofluxes_init private :: med_aofluxes_run + private :: med_aoflux_adjust_constants ! adjust constant values used in flux calculations. + private :: med_aoflux_compute ! computes atm/ocn fluxes !-------------------------------------------------------------------------- ! Private data @@ -70,13 +83,36 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ustar (:) ! saved ustar real(R8) , pointer :: re (:) ! saved re real(R8) , pointer :: ssq (:) ! saved sq - real(R8) , pointer :: prec_gust (:) ! atm precip for convective gustiness (kg/m^3) ! Fields that are not obtained via GetFldPtr - real(R8) , pointer :: uGust (:) ! wind gust logical :: created ! has this data type been created end type aoflux_type + ! The follow variables are not declared as parameters so that they can be + ! adjusted to support aquaplanet and potentially other simple model modes. + ! The shr_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 shr_flux_atmocn and shr_flux_atmice routines. + + real(R8) :: loc_zvir = shr_const_zvir + real(R8) :: loc_cpdair = shr_const_cpdair + real(R8) :: loc_cpvir = shr_const_cpvir + real(R8) :: loc_karman = shr_const_karman + real(R8) :: loc_g = shr_const_g + real(R8) :: loc_latvap = shr_const_latvap + real(R8) :: loc_latice = shr_const_latice + real(R8) :: loc_stebol = shr_const_stebol + + ! These control convergence of the iterative flux calculation + real(r8) :: flux_con_tol = 0.0_R8 + 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 + ! The following three variables are obtained as attributes from gcomp logical :: flds_wiso ! use case logical :: compute_atm_dens @@ -363,19 +399,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, allocate(aoflux%shum_HDO(lsize)); aoflux%shum_HDO(:) = 0._R8 end if - ! Optional field used for gust parameterization - if ( FB_fldchk(FBAtm, 'Faxa_rainc', rc=rc)) then - call FB_GetFldPtr(FBAtm, fldname='Faxa_rainc', fldptr1=aoflux%prec_gust, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - aoflux%prec_gust(:) = 0.0_R8 - end if - - !---------------------------------- - ! Fields that are not obtained via GetFldPtr - !---------------------------------- - allocate(aoflux%uGust(lsize)) - aoflux%uGust(:) = 0.0_R8 - !---------------------------------- ! setup the compute mask. !---------------------------------- @@ -416,7 +439,6 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info use NUOPC , only : NUOPC_CompAttributeGet - use med_calc_aofluxes_mod , only : flux_atmocn, flux_adjust_constants use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- @@ -466,7 +488,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_convergence - call flux_adjust_constants(& + call med_aoflux_adjust_constants(& flux_convergence_tolerance=flux_convergence, & flux_convergence_max_iteration=flux_max_iteration, & coldair_outbreak_mod=coldair_outbreak_mod) @@ -506,13 +528,6 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) ! Update atmosphere/ocean surface fluxes !---------------------------------- - if (associated(aoflux%prec_gust)) then - do n = 1,lsize - !aoflux%uGust(n) = 1.5_R8*sqrt(uocn(n)**2 + vocn(n)**2) ! there is no wind gust data from ocn - aoflux%uGust(n) = 0.0_R8 - end do - end if - if (compute_atm_thbot) then do n = 1,lsize if (aoflux%mask(n) /= 0._r8) then @@ -528,8 +543,8 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end do end if - call flux_atmocn (& - lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, aoflux%prec_gust, gust_fac, & + call med_aoflux_compute (& + lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, & aoflux%shum, aoflux%shum_16O, aoflux%shum_HDO, aoflux%shum_18O, aoflux%dens , & aoflux%tbot, aoflux%uocn, aoflux%vocn, & aoflux%tocn, aoflux%mask, aoflux%sen, aoflux%lat, aoflux%lwup, & @@ -537,7 +552,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) aoflux%evap, aoflux%evap_16O, aoflux%evap_HDO, aoflux%evap_18O, & aoflux%taux, aoflux%tauy, aoflux%tref, aoflux%qref, & aoflux%duu10n, ustar_sv=aoflux%ustar, re_sv=aoflux%re, ssq_sv=aoflux%ssq, & - missval = 0.0_r8, rc=rc) + missval=0.0_r8, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize @@ -549,4 +564,321 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end subroutine med_aofluxes_run + !=============================================================================== + + subroutine med_aoflux_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 , optional, intent(in) :: flux_convergence_max_iteration + logical , optional, intent(in) :: coldair_outbreak_mod + !---------------------------------------------------------------------------- + + if (present(zvir)) loc_zvir = zvir + if (present(cpair)) loc_cpdair = cpair + if (present(cpvir)) loc_cpvir = cpvir + if (present(karman)) loc_karman = karman + if (present(gravit)) loc_g = gravit + if (present(latvap)) loc_latvap = latvap + if (present(latice)) loc_latice = latice + if (present(stebol)) loc_stebol = stebol + if (present(flux_convergence_tolerance )) flux_con_tol = flux_convergence_tolerance + if (present(flux_convergence_max_iteration )) flux_con_max_iter = flux_convergence_max_iteration + if (present(coldair_outbreak_mod )) use_coldair_outbreak_mod = coldair_outbreak_mod + + end subroutine med_aoflux_adjust_constants + + !=============================================================================== + + subroutine med_aoflux_compute(nMax ,zbot ,ubot ,vbot ,thbot , & + qbot ,s16O ,sHDO ,s18O ,rbot , & + tbot ,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, rc) + + !------------------------------------ + ! Internal atm/ocn flux calculation + !------------------------------------ + + use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite + + ! input/output variables + 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) :: 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 variables + 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 + integer ,intent(out) :: rc + + 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 :: umin = 0.5_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) + + !--- local variables -------------------------------- + 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) :: spval ! local missing value + + !--- 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) :: gprec ! dummy arg ~ ? + !--- 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) + + !--- formats ---------------------------------------- + character(*),parameter :: subName = '(shr_flux_atmOcn) ' + character(*),parameter :: F00 = "('(shr_flux_atmOcn) ',4a)" + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + 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 + vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) + + ! Cold Air Outbreak Modification: increase windspeed for negative tbot-ts + ! based on Mahrt & Sun 1995,MWR + if (use_coldair_outbreak_mod) then + 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) + 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 + ren = 0.0346_R8 + + !--- 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 + rdn/loc_karman*(alz-psimh)) + u10n = vmag * rd / rdn + + !--- update transfer coeffs at 10m and neutral stability --- + rdn = sqrt(cdn(u10n)) + ren = 0.0346_R8 + rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 + + !--- 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 ESMF_LogWrite('No iterations performed - ERROR in med_calc_aofluxe') + rc=ESMF_Failure + return + 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 + + !------------------------------------------------------------ + ! 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 + + 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 + end DO + + end subroutine med_aoflux_compute + end module med_phases_aofluxes_mod From 427261d1b281173576b0c07150ffbd48a646bcb3 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 5 May 2019 14:17:59 -0600 Subject: [PATCH 10/15] fixed bug in coldair outbreak setting --- src/drivers/nuopc/cime_config/namelist_definition_drv.xml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index 27d6766e2e1..639ad70da2b 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -806,9 +806,7 @@ if true use Mahrt and Sun 1995,MWR modification to surface flux calculation - .true. - .false. - .false. + .true. From 201c1c3f5f2fe44c7e8c3904d8165d693cdc4d9f Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 5 May 2019 21:53:03 -0600 Subject: [PATCH 11/15] changes for new calendar functionality --- .../nuopc/cime_driver/ensemble_driver.F90 | 31 ++++++- .../nuopc/mediator/med_constants_mod.F90 | 6 +- src/drivers/nuopc/mediator/med_io_mod.F90 | 86 +++++++++++-------- .../mediator/med_phases_aofluxes_mod.F90 | 20 ++--- .../nuopc/mediator/med_phases_history_mod.F90 | 24 ++---- .../nuopc/mediator/med_phases_restart_mod.F90 | 30 ++----- .../nuopc/mediator/shr_nuopc_time_mod.F90 | 51 +++-------- 7 files changed, 112 insertions(+), 136 deletions(-) diff --git a/src/drivers/nuopc/cime_driver/ensemble_driver.F90 b/src/drivers/nuopc/cime_driver/ensemble_driver.F90 index 27062a1e125..00149a1ccc0 100644 --- a/src/drivers/nuopc/cime_driver/ensemble_driver.F90 +++ b/src/drivers/nuopc/cime_driver/ensemble_driver.F90 @@ -75,21 +75,25 @@ end subroutine SetServices !================================================================================ subroutine SetModelServices(ensemble_driver, rc) + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_Clock, ESMF_VMGet use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ConfigGetAttribute use ESMF , only : ESMF_ConfigGetLen, ESMF_RC_NOT_VALID, ESMF_LogFoundAllocError use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_GridCompSet, ESMF_SUCCESS, ESMF_METHOD_INITIALIZE, ESMF_RC_ARG_BAD + use ESMF , only : ESMF_CalendarSetDefault + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver , only : NUOPC_DriverAddComp - use esm, only : ESMSetServices => SetServices, ReadAttributes -! use pio_interface, only : PIOSetServices => SetServices + use esm , only : ESMSetServices => SetServices, ReadAttributes + !use pio_interface , only : PIOSetServices => SetServices use shr_nuopc_time_mod , only : shr_nuopc_time_clockInit use med_internalstate_mod , only : logunit ! initialized here use shr_log_mod , only : shrloglev=>shr_log_level, shrlogunit=> shr_log_unit use shr_file_mod , only : shr_file_getUnit, shr_file_getLoglevel use shr_file_mod , only : shr_file_setloglevel, shr_file_setlogunit + ! input/output variables type(ESMF_GridComp) :: ensemble_driver integer, intent(out) :: rc @@ -119,11 +123,11 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=5) :: inst_suffix character(len=CL) :: msgstr character(len=CL) :: cvalue + character(len=CL) :: calendar character(len=*) , parameter :: start_type_start = "startup" character(len=*) , parameter :: start_type_cont = "continue" character(len=*) , parameter :: start_type_brnch = "branch" character(len=*) , parameter :: subname = "(ensemble_driver.F90:SetModelServices)" - !------------------------------------------- rc = ESMF_SUCCESS @@ -146,6 +150,20 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (calendar == 'NO_LEAP') then + call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (calendar == 'GREGORIAN') then + call ESMF_CalendarSetDefault(ESMF_CALKIND_GREGORIAN, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + write (msgstr, *) "Only NO_LEAP and GREGORIAN calendars currently supported" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + end if + call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -170,6 +188,7 @@ subroutine SetModelServices(ensemble_driver, rc) call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue, *) number_of_members + !------------------------------------------- ! Extract the config object from the ensemble_driver !------------------------------------------- @@ -221,6 +240,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(driver, config, "MED_modelio"//trim(inst_suffix)//"::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set the mediator log to the MED task 0 if (mod(localPet,ntasks_per_member)==cpl_rootpe) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) @@ -246,15 +266,19 @@ subroutine SetModelServices(ensemble_driver, rc) end subroutine SetModelServices + !================================================================================ + subroutine InitRestart(ensemble_driver, read_restart, rc) !----------------------------------------------------- ! Determine if will restart and read pointer file ! if appropriate !----------------------------------------------------- + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use ESMF , only : ESMF_LogSetError, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_RC_NOT_VALID use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + ! input/output variables type(ESMF_GridComp) , intent(inout) :: ensemble_driver logical , intent(out) :: read_restart ! read the restart file, based on start_type @@ -263,7 +287,6 @@ subroutine InitRestart(ensemble_driver, read_restart, rc) ! local variables character(len=CL) :: cvalue ! temporary integer :: ierr ! error return - character(len=CL) :: restart_file ! Full archive path to restart file character(len=CL) :: restart_pfile ! Restart pointer file character(len=CL) :: rest_case_name ! Short case identification diff --git a/src/drivers/nuopc/mediator/med_constants_mod.F90 b/src/drivers/nuopc/mediator/med_constants_mod.F90 index f64e377734b..7a18ebd675c 100644 --- a/src/drivers/nuopc/mediator/med_constants_mod.F90 +++ b/src/drivers/nuopc/mediator/med_constants_mod.F90 @@ -9,11 +9,7 @@ module med_constants_mod use shr_kind_mod , only : CX=>SHR_KIND_CX use shr_kind_mod , only : CXX=>SHR_KIND_CXX - use shr_cal_mod , only : med_constants_noleap => shr_cal_noleap - use shr_cal_mod , only : med_constants_gregorian => shr_cal_gregorian - use shr_cal_mod , only : shr_cal_ymd2date - use shr_cal_mod , only : shr_cal_noleap - use shr_cal_mod , only : shr_cal_gregorian + use shr_const_mod implicit none diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index d947e7d5de2..71ead9c8f81 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -137,7 +137,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! local variables logical :: lclobber - integer :: tmp(1) integer :: rcode integer :: nmode integer :: lfile_ind @@ -305,6 +304,7 @@ character(len=24) function med_io_date2yyyymmdd (date) integer, intent(in) :: date ! date expressed as an integer: yyyymmdd call shr_cal_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) + end function med_io_date2yyyymmdd !=============================================================================== @@ -366,7 +366,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet - use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL + use med_constants_mod , only : fillvalue=>SHR_CONST_SPVAL use esmFlds , only : shr_nuopc_fldList_GetMetadata use pio , only : var_desc_t, io_desc_t, pio_offset_kind use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double @@ -1021,44 +1021,45 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_char !=============================================================================== - subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& + subroutine med_io_write_time(filename, iam, time_units, calendar, time_val, nt,& whead, wdata, tbnds, file_ind, rc) !--------------- ! Write time variable to netcdf file !--------------- - use shr_cal_mod , only : shr_cal_calMaxLen - use shr_cal_mod , only : shr_cal_noleap - use shr_cal_mod , only : shr_cal_gregorian - use shr_cal_mod , only : shr_cal_calendarName - use pio , only : var_desc_t, PIO_UNLIMITED - use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att - use pio , only : pio_inq_varid, pio_put_var + use ESMF, only : operator(==) + use ESMF, only : ESMF_Calendar + use ESMF, only : ESMF_CALKIND_360DAY, ESMF_CALKIND_GREGORIAN + use ESMF, only : ESMF_CALKIND_JULIAN, ESMF_CALKIND_JULIANDAY, ESMF_CALKIND_MODJULIANDAY + use ESMF, only : ESMF_CALKIND_NOCALENDAR, ESMF_CALKIND_NOLEAP + use pio , only : var_desc_t, PIO_UNLIMITED + use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att + use pio , only : pio_inq_varid, pio_put_var ! input/output variables - character(len=*), intent(in) :: filename ! file - integer, intent(in) :: iam ! local pet - character(len=*), intent(in) :: time_units ! units of time - character(len=*), intent(in) :: time_cal ! calendar type - real(r8) , intent(in) :: time_val ! data to be written - integer , optional, intent(in) :: nt - logical, optional, intent(in) :: whead ! write header - logical, optional, intent(in) :: wdata ! write data - real(r8), optional, intent(in) :: tbnds(2) ! time bounds - integer, optional, intent(in) :: file_ind - integer , intent(out):: rc + character(len=*) , intent(in) :: filename ! file + integer , intent(in) :: iam ! local pet + character(len=*) , intent(in) :: time_units ! units of time + type(ESMF_Calendar) , intent(in) :: calendar ! calendar + real(r8) , intent(in) :: time_val ! data to be written + integer , optional, intent(in) :: nt + logical , optional, intent(in) :: whead ! write header + logical , optional, intent(in) :: wdata ! write data + real(r8) , optional, intent(in) :: tbnds(2) ! time bounds + integer , optional, intent(in) :: file_ind + integer , intent(out):: rc ! local variables - integer :: rcode - integer :: dimid(1) - integer :: dimid2(2) - type(var_desc_t) :: varid - logical :: lwhead, lwdata - integer :: start(4),count(4) - character(len=shr_cal_calMaxLen) :: lcalendar - real(r8) :: time_val_1d(1) - integer :: lfile_ind + integer :: rcode + integer :: dimid(1) + integer :: dimid2(2) + type(var_desc_t) :: varid + logical :: lwhead, lwdata + integer :: start(4),count(4) + real(r8) :: time_val_1d(1) + integer :: lfile_ind + character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_write_time) ' !------------------------------------------------------------------------------- @@ -1081,13 +1082,22 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& rcode = pio_def_var(io_file(lfile_ind),'time',PIO_DOUBLE,dimid,varid) rcode = pio_put_att(io_file(lfile_ind),varid,'units',trim(time_units)) - lcalendar = shr_cal_calendarName(time_cal,trap=.false.) - if (trim(lcalendar) == trim(shr_cal_noleap)) then - lcalendar = 'noleap' - elseif (trim(lcalendar) == trim(shr_cal_gregorian)) then - lcalendar = 'gregorian' - endif - rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(lcalendar)) + if (calendar == ESMF_CALKIND_360DAY) then + calname = 'ESMF_CALKIND_360DAY' + else if (calendar == ESMF_CALKIND_GREGORIAN) then + calname = 'ESMF_CALKIND_GREGORIAN' + else if (calendar == ESMF_CALKIND_JULIAN) then + calname = 'ESMF_CALKIND_JULIAN' + else if (calendar == ESMF_CALKIND_JULIANDAY) then + calname = 'ESMF_CALKIND_JULIANDAY' + else if (calendar == ESMF_CALKIND_MODJULIANDAY) then + calname = 'ESMF_CALKIND_MODJULIANDAY' + else if (calendar == ESMF_CALKIND_NOCALENDAR) then + calname = 'ESMF_CALKIND_NOCALENDAR' + else if (calendar == ESMF_CALKIND_NOLEAP) then + calname = 'ESMF_CALKIND_NOLEAP' + end if + rcode = pio_put_att(io_file(lfile_ind),varid,'calendar',trim(calname)) if (present(tbnds)) then dimid2(2) = dimid(1) @@ -1129,7 +1139,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) ! Read FB from netcdf file !--------------- - use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE @@ -1141,6 +1150,7 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) 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 med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_constants_mod , only : fillvalue=>SHR_CONST_SPVAL ! input/output arguments character(len=*) ,intent(in) :: filename ! file diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index 9d94314cbf9..d6207e9b204 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -1,6 +1,16 @@ module med_phases_aofluxes_mod use med_constants_mod , only : R8, CL, CX + use med_constants_mod , only : shr_const_zvir + use med_constants_mod , only : shr_const_zvir + use med_constants_mod , only : shr_const_cpdair + use med_constants_mod , only : shr_const_cpvir + use med_constants_mod , only : shr_const_karman + use med_constants_mod , only : shr_const_g + use med_constants_mod , only : shr_const_latvap + use med_constants_mod , only : shr_const_latice + use med_constants_mod , only : shr_const_stebol + use med_constants_mod , only : shr_const_spval use med_internalstate_mod , only : mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck @@ -9,16 +19,6 @@ module med_phases_aofluxes_mod use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init - use shr_const_mod , only : shr_const_zvir - use shr_const_mod , only : shr_const_zvir - use shr_const_mod , only : shr_const_cpdair - use shr_const_mod , only : shr_const_cpvir - use shr_const_mod , only : shr_const_karman - use shr_const_mod , only : shr_const_g - use shr_const_mod , only : shr_const_latvap - use shr_const_mod , only : shr_const_latice - use shr_const_mod , only : shr_const_stebol - use shr_const_mod , only : shr_const_spval use water_isotopes , only : wiso_flxoce ! calculate water isotope fluxes. implicit none diff --git a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index cfef2313607..0bec38d3e25 100644 --- a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -31,6 +31,7 @@ subroutine med_phases_history_write(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : operator(==), operator(-) use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated + use ESMF , only : ESMF_Calendar use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo @@ -45,7 +46,6 @@ subroutine med_phases_history_write(gcomp, rc) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_constants_mod , only : R8, CL, CS - use med_constants_mod , only : med_constants_noleap, med_constants_gregorian use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef @@ -65,6 +65,7 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_Time) :: nexttime type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_CalKind_Flag) :: calkindflag + type(ESMF_Calendar) :: calendar ! calendar type character(len=64) :: currtimestr character(len=64) :: nexttimestr type(InternalState) :: is_local @@ -78,7 +79,6 @@ subroutine med_phases_history_write(gcomp, rc) real(r8) :: dayssince ! Time interval since reference time integer :: fk ! index character(CL) :: time_units ! units of time variable - character(CL) :: calendar ! calendar type character(CL) :: case_name ! case name character(CL) :: hist_file ! Local path to history filename character(CS) :: cpl_inst_tag ! instance tag @@ -130,6 +130,7 @@ subroutine med_phases_history_write(gcomp, rc) else cpl_inst_tag = "" endif + !--------------------------------------- ! --- Get the clock info !--------------------------------------- @@ -137,25 +138,12 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) + call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (calkindflag == ESMF_CALKIND_GREGORIAN) then - calendar = med_constants_gregorian - elseif (calkindflag == ESMF_CALKIND_NOLEAP) then - calendar = med_constants_noleap - else - call ESMF_LogWrite(trim(subname)//' ERROR: calendar not supported', ESMF_LOGMSG_ERROR, rc=dbrc) - rc=ESMF_Failure - return - endif - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec @@ -263,12 +251,12 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=dbrc) if (tbnds(1) >= tbnds(2)) then call med_io_write(hist_file, iam, & - time_units=time_units, time_cal=calendar, time_val=dayssince, & + time_units=time_units, calendar=calendar, time_val=dayssince, & whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(hist_file, iam, & - time_units=time_units, time_cal=calendar, time_val=dayssince, & + time_units=time_units, calendar=calendar, time_val=dayssince, & whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif diff --git a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index 0da2742f04a..05d6e961e0c 100644 --- a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -27,18 +27,16 @@ subroutine med_phases_restart_write(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_Alarm use ESMF , only : ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_MAXSTR - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, operator(==), operator(-) use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated + use ESMF , only : ESMF_Calendar use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : ncomps, compname, compocn - use med_constants_mod , only : med_constants_noleap - use med_constants_mod , only : med_constants_gregorian use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_internalstate_mod, only : mastertask, logunit, InternalState + use med_internalstate_mod , only : mastertask, logunit, InternalState use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd use med_io_mod , only : med_io_sec2hms @@ -54,7 +52,7 @@ subroutine med_phases_restart_write(gcomp, rc) type(ESMF_Time) :: currtime, reftime, starttime, nexttime type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time type(ESMF_Alarm) :: alarm - type(ESMF_CalKind_Flag) :: calkindflag + type(ESMF_Calendar) :: calendar character(len=64) :: currtimestr, nexttimestr type(InternalState) :: is_local integer :: i,j,m,n,n1,ncnt @@ -71,7 +69,6 @@ subroutine med_phases_restart_write(gcomp, rc) real(R8) :: dayssince ! Time interval since reference time integer :: unitn ! unit number character(ESMF_MAXSTR) :: time_units ! units of time variable - character(ESMF_MAXSTR) :: calendar ! calendar type character(ESMF_MAXSTR) :: case_name ! case name character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename @@ -84,8 +81,8 @@ subroutine med_phases_restart_write(gcomp, rc) logical :: whead,wdata ! for writing restart/restart cdf files integer :: iam ! vm stuff character(len=ESMF_MAXSTR) :: tmpstr - integer :: dbrc - logical :: isPresent + integer :: dbrc + logical :: isPresent character(len=*), parameter :: subname='(med_phases_restart_write)' !--------------------------------------- @@ -151,19 +148,9 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) + call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (calkindflag == ESMF_CALKIND_GREGORIAN) then - calendar = med_constants_gregorian - elseif (calkindflag == ESMF_CALKIND_NOLEAP) then - calendar = med_constants_noleap - else - call ESMF_LogWrite(trim(subname)//' ERROR: calendar not supported', ESMF_LOGMSG_ERROR, rc=dbrc) - rc=ESMF_Failure - return - endif - call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec @@ -241,12 +228,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": time "//trim(time_units), ESMF_LOGMSG_INFO, rc=dbrc) if (tbnds(1) >= tbnds(2)) then call med_io_write(restart_file, iam=iam, & - time_units=time_units, time_cal=calendar, time_val=dayssince, & + time_units=time_units, calendar=calendar, time_val=dayssince, & whead=whead, wdata=wdata, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(restart_file, iam=iam, & - time_units=time_units, time_cal=calendar, time_val=dayssince, & + time_units=time_units, calendar=calendar, time_val=dayssince, & whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -497,7 +484,6 @@ subroutine med_phases_restart_read(gcomp, rc) end subroutine med_phases_restart_read - !=============================================================================== subroutine ymd2date(year,month,day,date) ! Converts year, month, day to coded-date diff --git a/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 b/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 index dd807ec0474..d32183b1a47 100644 --- a/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 +++ b/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 @@ -21,8 +21,8 @@ module shr_nuopc_time_mod implicit none private ! default private + public :: shr_nuopc_time_clockInit ! initialize driver clock (assumes default calendar) public :: shr_nuopc_time_alarmInit ! initialize an alarm - public :: shr_nuopc_time_clockInit ! initialize driver clock public :: shr_nuopc_time_set_component_stop_alarm private :: shr_nuopc_time_timeInit @@ -82,8 +82,6 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) type(ESMF_Time) :: StopTime2 ! Stop time type(ESMF_Time) :: Clocktime ! Loop time type(ESMF_TimeInterval) :: TimeStep ! Clock time-step - type(ESMF_Calendar) :: calendar ! esmf calendar - type(ESMF_CalKind_Flag) :: caltype ! esmf calendar type type(ESMF_Alarm) :: alarm_stop ! alarm type(ESMF_Alarm) :: alarm_datestop ! alarm integer :: ref_ymd ! Reference date (YYYYMMDD) @@ -116,7 +114,6 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) integer :: unitn ! unit number integer :: ierr ! Return code character(CL) :: tmpstr ! temporary - character(CS) :: calendar_name ! Calendar name character(CS) :: inst_suffix integer :: tmp(6) ! Array for Broadcast logical :: isPresent @@ -137,31 +134,6 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return mastertask = localPet == 0 - !--------------------------------------------------------------------------- - ! Create the driver calendar - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(esmdriver, name="calendar", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - calendar_name = shr_cal_calendarName(cvalue) - - if ( trim(calendar_name) == trim(shr_cal_noleap)) then - caltype = ESMF_CALKIND_NOLEAP - else if ( trim(calendar_name) == trim(shr_cal_gregorian)) then - caltype = ESMF_CALKIND_GREGORIAN - else - call ESMF_LogWrite(trim(subname)//': unrecognized ESMF calendar specified: '//& - trim(calendar_name), ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - end if - - call ESMF_LogWrite(trim(subname)//': driver calendar is : '// trim(calendar_name), & - ESMF_LOGMSG_INFO, rc=rc) - - calendar = ESMF_CalendarCreate( name='CMEPS_'//trim(calendar_name), & - calkindflag=caltype, rc=rc ) - if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------------------------------------------- ! Determine clock start time, reference time and current time @@ -238,7 +210,7 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) endif endif if (mastertask) then - call shr_nuopc_time_read_restart_calendar_settings(restart_file, & + call shr_nuopc_time_read_restart(restart_file, & start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -267,9 +239,10 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) curr_tod = start_tod endif - ! Determine start time + ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) + call shr_nuopc_time_date2ymd(start_ymd, yr, mon, day) - call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, calendar=calendar, rc=rc) + call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(mastertask .or. dbug_flag > 2) then write(tmpstr,'(i10)') start_ymd @@ -282,7 +255,7 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) ! Determine reference time call shr_nuopc_time_date2ymd(ref_ymd, yr, mon, day) - call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, calendar=calendar, rc=rc) + call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(mastertask .or. dbug_flag > 2) then @@ -295,7 +268,7 @@ subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) endif ! Determine current time call shr_nuopc_time_date2ymd(curr_ymd, yr, mon, day) - call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, calendar=calendar, rc=rc) + call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(mastertask .or. dbug_flag > 2) then write(tmpstr,'(i10)') curr_ymd @@ -531,7 +504,7 @@ subroutine shr_nuopc_time_alarmInit( clock, alarm, option, & integer , intent(inout) :: rc ! Return code ! local variables - type(ESMF_Calendar) :: cal ! calendar + type(ESMF_Calendar) :: cal ! calendar integer :: lymd ! local ymd integer :: ltod ! local tod integer :: cyy,cmm,cdd,csec ! time info @@ -566,7 +539,7 @@ subroutine shr_nuopc_time_alarmInit( clock, alarm, option, & NextAlarm = CurrTime endif - ! Determine calendar + ! Get calendar from clock call ESMF_ClockGet(clock, calendar=cal) ! Determine inputs for call to create alarm @@ -960,7 +933,7 @@ end subroutine shr_nuopc_time_date2ymd !=============================================================================== - subroutine shr_nuopc_time_read_restart_calendar_settings(restart_file, & + subroutine shr_nuopc_time_read_restart(restart_file, & start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr @@ -981,7 +954,7 @@ subroutine shr_nuopc_time_read_restart_calendar_settings(restart_file, & ! local variables integer :: status, ncid, varid ! netcdf stuff character(CL) :: tmpstr ! temporary - character(len=*), parameter :: subname = "(shr_nuopc_time_read_restart_calendar_settings)" + character(len=*), parameter :: subname = "(shr_nuopc_time_read_restart)" !---------------------------------------------------------------- ! use netcdf here since it's serial @@ -1084,6 +1057,6 @@ subroutine shr_nuopc_time_read_restart_calendar_settings(restart_file, & write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - end subroutine shr_nuopc_time_read_restart_calendar_settings + end subroutine shr_nuopc_time_read_restart end module shr_nuopc_time_mod From c493c3cb9faf0c58b14140dfd6e691c6eca2f082 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Mon, 6 May 2019 12:59:40 -0600 Subject: [PATCH 12/15] reverted back to original version for med_phases_aofluxes_mod.F90 due to requirement for cam to use shr_flux_mod.F90 in aqua-planet mode --- .../mediator/med_phases_aofluxes_mod.F90 | 382 +----------------- 1 file changed, 9 insertions(+), 373 deletions(-) diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index d6207e9b204..c470057d05c 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -1,16 +1,6 @@ module med_phases_aofluxes_mod use med_constants_mod , only : R8, CL, CX - use med_constants_mod , only : shr_const_zvir - use med_constants_mod , only : shr_const_zvir - use med_constants_mod , only : shr_const_cpdair - use med_constants_mod , only : shr_const_cpvir - use med_constants_mod , only : shr_const_karman - use med_constants_mod , only : shr_const_g - use med_constants_mod , only : shr_const_latvap - use med_constants_mod , only : shr_const_latice - use med_constants_mod , only : shr_const_stebol - use med_constants_mod , only : shr_const_spval use med_internalstate_mod , only : mastertask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck @@ -19,7 +9,6 @@ module med_phases_aofluxes_mod use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init - use water_isotopes , only : wiso_flxoce ! calculate water isotope fluxes. implicit none private @@ -36,8 +25,6 @@ module med_phases_aofluxes_mod private :: med_aofluxes_init private :: med_aofluxes_run - private :: med_aoflux_adjust_constants ! adjust constant values used in flux calculations. - private :: med_aoflux_compute ! computes atm/ocn fluxes !-------------------------------------------------------------------------- ! Private data @@ -83,36 +70,9 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ustar (:) ! saved ustar real(R8) , pointer :: re (:) ! saved re real(R8) , pointer :: ssq (:) ! saved sq - - ! Fields that are not obtained via GetFldPtr logical :: created ! has this data type been created end type aoflux_type - ! The follow variables are not declared as parameters so that they can be - ! adjusted to support aquaplanet and potentially other simple model modes. - ! The shr_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 shr_flux_atmocn and shr_flux_atmice routines. - - real(R8) :: loc_zvir = shr_const_zvir - real(R8) :: loc_cpdair = shr_const_cpdair - real(R8) :: loc_cpvir = shr_const_cpvir - real(R8) :: loc_karman = shr_const_karman - real(R8) :: loc_g = shr_const_g - real(R8) :: loc_latvap = shr_const_latvap - real(R8) :: loc_latice = shr_const_latice - real(R8) :: loc_stebol = shr_const_stebol - - ! These control convergence of the iterative flux calculation - real(r8) :: flux_con_tol = 0.0_R8 - 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 - ! The following three variables are obtained as attributes from gcomp logical :: flds_wiso ! use case logical :: compute_atm_dens @@ -257,8 +217,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, character(*),parameter :: subName = '(med_aofluxes_init) ' !----------------------------------------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif @@ -435,11 +393,12 @@ end subroutine med_aofluxes_init subroutine med_aofluxes_run(gcomp, aoflux, rc) - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info - use NUOPC , only : NUOPC_CompAttributeGet - use perf_mod , only : t_startf, t_stopf + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info + use NUOPC , only : NUOPC_CompAttributeGet + use shr_flux_mod , only : shr_flux_atmocn, shr_flux_adjust_constants + use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- ! Determine atm/ocn fluxes eother on atm or on ocean grid @@ -456,7 +415,6 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) character(CL) :: cvalue integer :: n,i ! indices integer :: lsize ! local size - real(R8) :: gust_fac = huge(1.0_R8) ! wind gust factor real(R8) :: flux_convergence ! convergence criteria for imlicit flux computation integer :: flux_max_iteration ! maximum number of iterations for convergence logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) @@ -472,10 +430,6 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) !---------------------------------- if (first_call) then - call NUOPC_CompAttributeGet(gcomp, name='gust_fac', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) gust_fac - call NUOPC_CompAttributeGet(gcomp, name='coldair_outbreak_mod', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) coldair_outbreak_mod @@ -488,7 +442,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_convergence - call med_aoflux_adjust_constants(& + call shr_flux_adjust_constants(& flux_convergence_tolerance=flux_convergence, & flux_convergence_max_iteration=flux_max_iteration, & coldair_outbreak_mod=coldair_outbreak_mod) @@ -543,7 +497,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end do end if - call med_aoflux_compute (& + call shr_flux_atmocn (& lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, & aoflux%shum, aoflux%shum_16O, aoflux%shum_HDO, aoflux%shum_18O, aoflux%dens , & aoflux%tbot, aoflux%uocn, aoflux%vocn, & @@ -552,8 +506,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) aoflux%evap, aoflux%evap_16O, aoflux%evap_HDO, aoflux%evap_18O, & aoflux%taux, aoflux%tauy, aoflux%tref, aoflux%qref, & aoflux%duu10n, ustar_sv=aoflux%ustar, re_sv=aoflux%re, ssq_sv=aoflux%ssq, & - missval=0.0_r8, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + missval = 0.0_r8) do n = 1,lsize if (aoflux%mask(n) /= 0) then @@ -564,321 +517,4 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end subroutine med_aofluxes_run - !=============================================================================== - - subroutine med_aoflux_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 , optional, intent(in) :: flux_convergence_max_iteration - logical , optional, intent(in) :: coldair_outbreak_mod - !---------------------------------------------------------------------------- - - if (present(zvir)) loc_zvir = zvir - if (present(cpair)) loc_cpdair = cpair - if (present(cpvir)) loc_cpvir = cpvir - if (present(karman)) loc_karman = karman - if (present(gravit)) loc_g = gravit - if (present(latvap)) loc_latvap = latvap - if (present(latice)) loc_latice = latice - if (present(stebol)) loc_stebol = stebol - if (present(flux_convergence_tolerance )) flux_con_tol = flux_convergence_tolerance - if (present(flux_convergence_max_iteration )) flux_con_max_iter = flux_convergence_max_iteration - if (present(coldair_outbreak_mod )) use_coldair_outbreak_mod = coldair_outbreak_mod - - end subroutine med_aoflux_adjust_constants - - !=============================================================================== - - subroutine med_aoflux_compute(nMax ,zbot ,ubot ,vbot ,thbot , & - qbot ,s16O ,sHDO ,s18O ,rbot , & - tbot ,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, rc) - - !------------------------------------ - ! Internal atm/ocn flux calculation - !------------------------------------ - - use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite - - ! input/output variables - 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) :: 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 variables - 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 - integer ,intent(out) :: rc - - 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 :: umin = 0.5_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) - - !--- local variables -------------------------------- - 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) :: spval ! local missing value - - !--- 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) :: gprec ! dummy arg ~ ? - !--- 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) - - !--- formats ---------------------------------------- - character(*),parameter :: subName = '(shr_flux_atmOcn) ' - character(*),parameter :: F00 = "('(shr_flux_atmOcn) ',4a)" - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - 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 - vmag = max(umin, sqrt( (ubot(n)-us(n))**2 + (vbot(n)-vs(n))**2) ) - - ! Cold Air Outbreak Modification: increase windspeed for negative tbot-ts - ! based on Mahrt & Sun 1995,MWR - if (use_coldair_outbreak_mod) then - 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) - 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 - ren = 0.0346_R8 - - !--- 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 + rdn/loc_karman*(alz-psimh)) - u10n = vmag * rd / rdn - - !--- update transfer coeffs at 10m and neutral stability --- - rdn = sqrt(cdn(u10n)) - ren = 0.0346_R8 - rhn = (1.0_R8-stable)*0.0327_R8 + stable * 0.018_R8 - - !--- 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 ESMF_LogWrite('No iterations performed - ERROR in med_calc_aofluxe') - rc=ESMF_Failure - return - 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 - - !------------------------------------------------------------ - ! 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 - - 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 - end DO - - end subroutine med_aoflux_compute - end module med_phases_aofluxes_mod From 50eb5d79f253c28094d68cf710a1c24d3118bae6 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 10 May 2019 12:49:40 -0600 Subject: [PATCH 13/15] removed shr_cal references --- src/drivers/nuopc/mediator/med_io_mod.F90 | 229 ++++++++++++++---- .../nuopc/mediator/med_phases_history_mod.F90 | 32 +-- 2 files changed, 202 insertions(+), 59 deletions(-) diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index 71ead9c8f81..271bda165d8 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -1,30 +1,36 @@ module med_io_mod - ! !DESCRIPTION: Writes attribute vectors to netcdf - ! !USES: + !------------------------------------------ + ! Create mediator history files + !------------------------------------------ + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_VMBroadCast use pio , only : file_desc_t, iosystem_desc_t - use med_constants_mod , only : R4, R8, CL + use med_constants_mod , only : R4, R8, I8, CL use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use med_internalstate_mod , only : logunit, med_id use shr_nuopc_methods_mod , only : FB_getFieldN => shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod , only : FB_getFldPtr => shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : FB_getNameN => shr_nuopc_methods_FB_getNameN + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr implicit none private ! public member functions: - public med_io_wopen - public med_io_close - public med_io_redef - public med_io_enddef - public med_io_date2yyyymmdd - public med_io_sec2hms - public med_io_read - public med_io_write - public med_io_init + public :: med_io_wopen + public :: med_io_close + public :: med_io_redef + public :: med_io_enddef + public :: med_io_sec2hms + public :: med_io_read + public :: med_io_write + public :: med_io_init + public :: med_io_date2yyyymmdd + public :: med_io_datetod2string + public :: med_io_ymd2date ! private member functions private :: med_io_file_exists @@ -47,6 +53,18 @@ module med_io_mod module procedure med_io_write_char module procedure med_io_write_time end interface med_io_write + interface med_io_date2ymd + module procedure med_io_date2ymd_int + module procedure med_io_date2ymd_long + end interface med_io_date2ymd + interface med_io_datetod2string + module procedure med_io_datetod2string_int + module procedure med_io_datetod2string_long + end interface med_io_datetod2string + interface med_io_ymd2date + module procedure med_io_ymd2date_int + module procedure med_io_ymd2date_long + end interface med_io_ymd2date !------------------------------------------------------------------------------- ! module data @@ -75,8 +93,6 @@ logical function med_io_file_exists(vm, iam, filename) ! inquire if i/o file exists !--------------- - use ESMF, only : ESMF_VMBroadCast - ! input/output variables type(ESMF_VM) :: vm integer, intent(in) :: iam @@ -105,8 +121,7 @@ subroutine med_io_init() ! initialize pio !--------------- - use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat - use med_internalstate_mod , only : med_id + use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype, shr_pio_getioformat io_subsystem => shr_pio_getiosys(med_id) pio_iotype = shr_pio_getiotype(med_id) @@ -121,11 +136,10 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! open netcdf file !--------------- - use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef - use PIO , only : pio_put_att, pio_redef, pio_get_att - use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber - use med_internalstate_mod , only : logunit + use pio , only : PIO_IOTYPE_PNETCDF, PIO_IOTYPE_NETCDF, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef + use pio , only : pio_put_att, pio_redef, pio_get_att + use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber ! input/output arguments character(*), intent(in) :: filename @@ -221,7 +235,6 @@ subroutine med_io_close(filename, iam, file_ind, rc) !--------------- use pio, only: pio_file_is_open, pio_closefile - use med_internalstate_mod, only : logunit ! input/output variables character(*), intent(in) :: filename @@ -278,8 +291,7 @@ end subroutine med_io_redef !=============================================================================== subroutine med_io_enddef(filename,file_ind) - use med_internalstate_mod , only : logunit - use pio , only : pio_enddef + use pio, only : pio_enddef ! input/output variables character(len=*) , intent(in) :: filename @@ -299,19 +311,15 @@ end subroutine med_io_enddef !=============================================================================== character(len=24) function med_io_date2yyyymmdd (date) - use shr_cal_mod, only : shr_cal_datetod2string - integer, intent(in) :: date ! date expressed as an integer: yyyymmdd - call shr_cal_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) + call med_io_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) end function med_io_date2yyyymmdd !=============================================================================== character(len=8) function med_io_sec2hms (seconds, rc) - use med_internalstate_mod , only : logunit - ! input arguments integer, intent(in) :: seconds integer, intent(out) :: rc @@ -1487,12 +1495,10 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) ! Read 1d integer array from netcdf file !--------------- - use med_constants_mod , only : R8 - use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling - use pio , only : pio_get_var, pio_inq_varid, pio_get_att, pio_openfile - use pio , only : pio_nowrite, pio_openfile, pio_global - use pio , only : pio_closefile - use med_internalstate_mod , only : logunit + use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling + use pio , only : pio_get_var, pio_inq_varid, pio_get_att, pio_openfile + use pio , only : pio_nowrite, pio_openfile, pio_global + use pio , only : pio_closefile ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1574,11 +1580,9 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) ! Read 1d double array from netcdf file !--------------- - use med_constants_mod , only : R8 - use pio , only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling - use pio , only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var - use pio , only : pio_nowrite, pio_openfile, pio_global, pio_get_att - use med_internalstate_mod , only : logunit + use pio , only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling + use pio , only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var + use pio , only : pio_nowrite, pio_openfile, pio_global, pio_get_att ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1631,10 +1635,9 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) ! Read char string from netcdf file !--------------- - use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_closefile, pio_inq_varid, pio_get_var - use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite - use med_internalstate_mod , only : logunit + use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_closefile, pio_inq_varid, pio_get_var + use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1683,4 +1686,140 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) call pio_closefile(pioid) end subroutine med_io_read_char + !=============================================================================== + subroutine med_io_date2ymd_int (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer,intent(in) :: date ! coded-date (yyyymmdd) + integer,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer :: tdate ! temporary date + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + end subroutine med_io_date2ymd_int + + subroutine med_io_date2ymd_long (date,year,month,day) + ! Converts coded-date (yyyymmdd) to year/month/day. + ! input/output variables + integer(I8),intent(in) :: date ! coded-date ([yy]yyyymmdd) + integer ,intent(out) :: year,month,day ! calendar year,month,day + ! local variables + integer(I8) :: tdate ! temporary date + character(*),parameter :: subName = "(med_io_date2ymd_long)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year =int(tdate/10000) + if (date < 0) year = -year + month = int( mod(tdate,10000_I8)/ 100) + day = mod(tdate, 100_I8) + end subroutine med_io_date2ymd_long + + !=============================================================================== + subroutine med_io_datetod2string_int(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call med_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine med_io_datetod2string_int + + subroutine med_io_datetod2string_long(date_str, ymd, tod) + ! Converts coded date (yyyymmdd) and optional time of day to a string like + ! 'yyyy-mm-dd-ttttt' (if tod is present) or 'yyyy-mm-dd' (if tod is absent). + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + + ! input/output variables + character(len=*) , intent(out) :: date_str + integer(i8) , intent(in) :: ymd + integer, optional, intent(in) :: tod + + ! local variables + integer :: yy, mm, dd + character(len=6) :: year_str + character(len=3) :: month_str + character(len=3) :: day_str + character(len=6) :: time_str + !--------------------------------------- + + call med_io_date2ymd(ymd, yy, mm, dd) + + ! Convert year, month, day and time of day to a string like 'yyyy-mm-dd-ttttt'. + ! yyyy in the output string will have at least 4 but no more than 6 characters (with + ! leading zeroes if necessary). + write(year_str,'(i6.4)') yy + year_str = adjustl(year_str) + write(month_str,'(a,i2.2)') '-',mm + write(day_str ,'(a,i2.2)') '-',dd + if (present(tod)) then + write(time_str,'(a,i5.5)') '-',tod + else + time_str = ' ' + end if + date_str = trim(year_str) // trim(month_str) // trim(day_str) // trim(time_str) + + end subroutine med_io_datetod2string_long + + !=============================================================================== + subroutine med_io_ymd2date_int(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer,intent(in ) :: year,month,day ! calendar year,month,day + integer,intent(out) :: date ! coded (yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine med_io_ymd2date_int + + subroutine med_io_ymd2date_long(year,month,day,date) + ! Converts year, month, day to coded-date + + ! input/output variables + integer ,intent(in ) :: year,month,day ! calendar year,month,day + integer(I8),intent(out) :: date ! coded ([yy]yyyymmdd) calendar date + !--------------------------------------- + + ! NOTE: this calendar has a year zero (but no day or month zero) + date = abs(year)*10000_I8 + month*100 + day ! coded calendar date + if (year < 0) date = -date + end subroutine med_io_ymd2date_long + end module med_io_mod diff --git a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index 0bec38d3e25..42e29fac4d9 100644 --- a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -4,12 +4,13 @@ module med_phases_history_mod ! Mediator Phases !----------------------------------------------------------------------------- - use ESMF, only : ESMF_Alarm + use ESMF , only : ESMF_Alarm + use med_constants_mod , only : R8, CL, CS, I8 implicit none private - public :: med_phases_history_write + public :: med_phases_history_write type(ESMF_Alarm) :: AlarmHist type(ESMF_Alarm) :: AlarmHistAvg @@ -24,18 +25,20 @@ subroutine med_phases_history_write(gcomp, rc) ! Write mediator history file - use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_CalKind_Flag - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockGetNextTime, ESMF_VMGet, ESMF_TimeGet - use ESMF , only : ESMF_TimeIntervalGet, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff - use ESMF , only : ESMF_CALKIND_GREGORIAN, ESMF_CALKIND_NOLEAP - 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_VM, ESMF_VMGet + use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_ClockGetNextTime + use ESMF , only : ESMF_Calendar + use ESMF , only : ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalGet + use ESMF , only : ESMF_Alarm, ESMF_AlarmIsRinging, ESMF_AlarmRingerOff + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : operator(==), operator(-) use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated - use ESMF , only : ESMF_Calendar use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo - use shr_cal_mod , only : shr_cal_ymd2date use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose @@ -45,11 +48,11 @@ subroutine med_phases_history_write(gcomp, rc) use shr_nuopc_time_mod , only : alarmInit => shr_nuopc_time_alarmInit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : SecPerDay => med_constants_SecPerDay - use med_constants_mod , only : R8, CL, CS use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms + use med_io_mod , only : med_io_ymd2date use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -64,7 +67,6 @@ subroutine med_phases_history_write(gcomp, rc) type(ESMF_Time) :: starttime type(ESMF_Time) :: nexttime type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - type(ESMF_CalKind_Flag) :: calkindflag type(ESMF_Calendar) :: calendar ! calendar type character(len=64) :: currtimestr character(len=64) :: nexttimestr @@ -90,11 +92,11 @@ subroutine med_phases_history_write(gcomp, rc) logical :: whead,wdata ! for writing restart/history cdf files integer :: dbrc integer :: iam + logical :: isPresent logical,save :: first_call = .true. character(len=*), parameter :: subname='(med_phases_history_write)' - logical :: isPresent - !--------------------------------------- + call t_startf('MED:'//subname) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) @@ -162,7 +164,7 @@ subroutine med_phases_history_write(gcomp, rc) dayssince = day + sec/real(SecPerDay,R8) call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - call shr_cal_ymd2date(yr,mon,day,start_ymd) + call med_io_ymd2date(yr,mon,day,start_ymd) start_tod = sec time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -300,4 +302,6 @@ subroutine med_phases_history_write(gcomp, rc) end subroutine med_phases_history_write + !=============================================================================== + end module med_phases_history_mod From 635001cd36e971875133d97181d6dfb7d985c36e Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Fri, 10 May 2019 13:04:47 -0600 Subject: [PATCH 14/15] removal of use_string_mod --- .../cime_config/namelist_definition_drv.xml | 24 ++-- src/drivers/nuopc/mediator/med_merge_mod.F90 | 125 ++++++++++++++++-- .../nuopc/mediator/med_phases_ocnalb_mod.F90 | 2 +- 3 files changed, 127 insertions(+), 24 deletions(-) diff --git a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index 639ad70da2b..36a77826103 100644 --- a/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -171,7 +171,7 @@ fixed_year - variable_year + variable_year @@ -184,9 +184,9 @@ 1990 - 1850 - 2000 - 1850 + 1850 + 2000 + 1850 @@ -199,9 +199,9 @@ 1990 - 1850 - 2000 - 1850 + 1850 + 2000 + 1850 @@ -769,7 +769,7 @@ - + @@ -781,8 +781,8 @@ Setting this to zero will always do flux_max_iteration - 0.0 - 0.0 + 0.01 + 0.0 @@ -794,7 +794,7 @@ Iterate atmocn flux calculation a max of this value - 5 + 5 @@ -806,7 +806,7 @@ if true use Mahrt and Sun 1995,MWR modification to surface flux calculation - .true. + .true. diff --git a/src/drivers/nuopc/mediator/med_merge_mod.F90 b/src/drivers/nuopc/mediator/med_merge_mod.F90 index 8a5ffc45168..43f6ad545d1 100644 --- a/src/drivers/nuopc/mediator/med_merge_mod.F90 +++ b/src/drivers/nuopc/mediator/med_merge_mod.F90 @@ -15,6 +15,7 @@ module med_merge_mod use shr_nuopc_methods_mod , only : FB_Reset => shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : FieldPtr_Compare => shr_nuopc_methods_FieldPtr_Compare + use med_internalstate_mod , only : logunit implicit none private @@ -32,9 +33,9 @@ module med_merge_mod character(*),parameter :: u_FILE_u = & __FILE__ -!----------------------------------------------------------------------------- +!=============================================================================== contains -!----------------------------------------------------------------------------- +!=============================================================================== subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, rc) @@ -43,13 +44,10 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LogMsg_Info use ESMF , only : ESMF_LogSetError, ESMF_RC_OBJ_NOT_CREATED use med_constants_mod , only : CL, CX, CS - use shr_string_mod , only : shr_string_listGetNum - use shr_string_mod , only : shr_string_listGetName use esmFlds , only : compmed, compname use esmFlds , only : shr_nuopc_fldList_type use esmFlds , only : shr_nuopc_fldList_GetNumFlds use esmFlds , only : shr_nuopc_fldList_GetFldInfo - use med_internalstate_mod , only : logunit use perf_mod , only : t_startf, t_stopf ! ---------------------------------------------- @@ -115,9 +113,10 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, ! If merge_field is a colon delimited string then cycle through every field - otherwise by default nm ! will only equal 1 - do nm = 1,shr_string_listGetNum(merge_fields) + do nm = 1,merge_listGetNum(merge_fields) - call shr_string_listGetName(merge_fields, nm, merge_field) + call merge_listGetName(merge_fields, nm, merge_field, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (merge_type /= 'unset' .and. merge_field /= 'unset') then @@ -200,7 +199,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, end subroutine med_merge_auto - !----------------------------------------------------------------------------- + !=============================================================================== subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fldw, rc) @@ -258,7 +257,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! Get appropriate field pointers !------------------------- - ! Get field pointer to output field + ! Get field pointer to output field call ESMF_FieldBundleGet(FBout, fieldName=trim(FBoutfld), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, rank=lrank, rc=rc) @@ -355,7 +354,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld end subroutine med_merge_auto_field - !----------------------------------------------------------------------------- + !=============================================================================== subroutine med_merge_field_1D(FBout, fnameout, & FBinA, fnameA, wgtA, & @@ -536,7 +535,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & end subroutine med_merge_field_1D - !----------------------------------------------------------------------------- + !=============================================================================== subroutine med_merge_field_2D(FBout, fnameout, & FBinA, fnameA, wgtA, & @@ -722,4 +721,108 @@ subroutine med_merge_field_2D(FBout, fnameout, & end subroutine med_merge_field_2D + !=============================================================================== + + integer function merge_listGetNum(str) + + ! return number of fields in a colon delimited string list + + ! input/output variables + character(*),intent(in) :: str ! string to search + + ! local variables + integer :: n + integer :: count ! counts occurances of char + character(len=1) :: listDel = ":" ! note single exec implications + !--------------------------------------- + + merge_listGetNum = 0 + if (len_trim(str) > 0) then + count = 0 + do n = 1, len_trim(str) + if (str(n:n) == listDel) count = count + 1 + end do + merge_listGetNum = count + 1 + endif + + end function merge_listGetNum + + !=============================================================================== + + subroutine merge_listGetName(list, k, name, rc) + + ! Get name of k-th field in colon deliminted list + + use ESMF, only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO + + ! input/output variables + character(len=*) ,intent(in) :: list ! list/string + integer ,intent(in) :: k ! index of field + character(len=*) ,intent(out) :: name ! k-th name in list + integer, optional ,intent(out) :: rc ! return code + + ! local variables + integer :: i,n ! generic indecies + integer :: kFlds ! number of fields in list + integer :: i0,i1 ! name = list(i0:i1) + integer :: nChar + logical :: valid_list + character(len=1) :: listDel = ':' + character(len=2) :: listDel2 = '::' + !--------------------------------------- + + rc = ESMF_SUCCESS + + ! check that this is a valid list + valid_list = .true. + nChar = len_trim(list) + if (nChar < 1) then ! list is an empty string + valid_list = .false. + else if ( list(1:1) == listDel ) then ! first char is delimiter + valid_list = .false. + else if (list(nChar:nChar) == listDel ) then ! last char is delimiter + valid_list = .false. + else if (index(trim(list)," " ) > 0) then ! white-space in a field name + valid_list = .false. + else if (index(trim(list),listDel2) > 0) then ! found zero length field + valid_list = .false. + end if + if (.not. valid_list) then + write(logunit,*) "ERROR: invalid list = ",trim(list) + call ESMF_LogWrite("ERROR: invalid list = "//trim(list), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + !--- check that this is a valid index --- + kFlds = merge_listGetNum(list) + if (k<1 .or. kFldsmed_constants_dbug_flag + use med_constants_mod , only : shr_const_pi use med_internalstate_mod , only : InternalState, logunit use esmFlds , only : compatm, compocn use perf_mod , only : t_startf, t_stopf From 03f1d19a305c96f4882418d47af000f54d0af086 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 12 May 2019 15:10:41 -0600 Subject: [PATCH 15/15] set default for PIO_REARRANGER to box rearranger --- config/cesm/machines/config_pio.xml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/config/cesm/machines/config_pio.xml b/config/cesm/machines/config_pio.xml index 0ab038bc0cd..40f22b32a07 100644 --- a/config/cesm/machines/config_pio.xml +++ b/config/cesm/machines/config_pio.xml @@ -58,7 +58,9 @@ - $PIO_VERSION + + + 1