module lnd_import_export use shr_kind_mod , only: r8 => shr_kind_r8, cl=>shr_kind_cl use abortutils , only: endrun use clm_atmlnd , only: lnd2atm_type use clm_glclnd , only: lnd2glc_type use decompmod , only: bounds_type use clm_cpl_indices use clmtype implicit none contains !=============================================================================== subroutine lnd_import( bounds, x2l, a2l, a2l_not_downscaled_gcell, x2s) !--------------------------------------------------------------------------- ! !DESCRIPTION: ! Convert the input data from the coupler to the land model ! ! !USES: use clm_atmlnd , only: atm2lnd_type, atm2lnd_downscaled_fields_type use clm_glclnd , only: glc2lnd_type use clm_varctl , only: co2_type, co2_ppmv, iulog, use_c13, create_glacier_mec_landunit use clm_varcon , only: rair, o2_molar_const, c13ratio use shr_const_mod , only: SHR_CONST_TKFRZ use domainMod , only: ldomain implicit none ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds ! bounds real(r8) , intent(in) :: x2l(:,:) ! driver import state to land model type(atm2lnd_type) , intent(inout) :: a2l ! clm internal input data type type(atm2lnd_downscaled_fields_type) , intent(inout) :: a2l_not_downscaled_gcell ! clm internal input data type type(glc2lnd_type) , intent(inout) :: x2s ! clm internal input data type ! ! !LOCAL VARIABLES: integer :: g,i,nstep,ier ! indices, number of steps, and error code real(r8) :: forc_rainc ! rainxy Atm flux mm/s real(r8) :: e ! vapor pressure (Pa) real(r8) :: qsat ! saturation specific humidity (kg/kg) real(r8) :: forc_t ! atmospheric temperature (Kelvin) real(r8) :: forc_q ! atmospheric specific humidity (kg/kg) real(r8) :: forc_pbot ! atmospheric pressure (Pa) real(r8) :: forc_rainl ! rainxy Atm flux mm/s real(r8) :: forc_snowc ! snowfxy Atm flux mm/s real(r8) :: forc_snowl ! snowfxl Atm flux mm/s real(r8) :: co2_ppmv_diag ! temporary real(r8) :: co2_ppmv_prog ! temporary real(r8) :: co2_ppmv_val ! temporary integer :: co2_type_idx ! integer flag for co2_type options real(r8) :: esatw ! saturation vapor pressure over water (Pa) real(r8) :: esati ! saturation vapor pressure over ice (Pa) real(r8) :: a0,a1,a2,a3,a4,a5,a6 ! coefficients for esat over water real(r8) :: b0,b1,b2,b3,b4,b5,b6 ! coefficients for esat over ice real(r8) :: tdc, t ! Kelvins to Celcius function and its input integer :: num ! counter character(len=32), parameter :: sub = 'lnd_import_mct' ! Constants to compute vapor pressure parameter (a0=6.107799961_r8 , a1=4.436518521e-01_r8, & a2=1.428945805e-02_r8, a3=2.650648471e-04_r8, & a4=3.031240396e-06_r8, a5=2.034080948e-08_r8, & a6=6.136820929e-11_r8) parameter (b0=6.109177956_r8 , b1=5.034698970e-01_r8, & b2=1.886013408e-02_r8, b3=4.176223716e-04_r8, & b4=5.824720280e-06_r8, b5=4.838803174e-08_r8, & b6=1.838826904e-10_r8) ! ! function declarations ! tdc(t) = min( 50._r8, max(-50._r8,(t-SHR_CONST_TKFRZ)) ) esatw(t) = 100._r8*(a0+t*(a1+t*(a2+t*(a3+t*(a4+t*(a5+t*a6)))))) esati(t) = 100._r8*(b0+t*(b1+t*(b2+t*(b3+t*(b4+t*(b5+t*b6)))))) !--------------------------------------------------------------------------- co2_type_idx = 0 if (co2_type == 'prognostic') then co2_type_idx = 1 else if (co2_type == 'diagnostic') then co2_type_idx = 2 end if if (co2_type == 'prognostic' .and. index_x2l_Sa_co2prog == 0) then call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2prog for co2_type equal to prognostic' ) else if (co2_type == 'diagnostic' .and. index_x2l_Sa_co2diag == 0) then call endrun( sub//' ERROR: must have nonzero index_x2l_Sa_co2diag for co2_type equal to diagnostic' ) end if ! Note that the precipitation fluxes received from the coupler ! are in units of kg/s/m^2. To convert these precipitation rates ! in units of mm/sec, one must divide by 1000 kg/m^3 and multiply ! by 1000 mm/m resulting in an overall factor of unity. ! Below the units are therefore given in mm/s. do g = bounds%begg,bounds%endg i = 1 + (g - bounds%begg) ! Determine flooding input, sign convention is positive downward and ! hierarchy is atm/glc/lnd/rof/ice/ocn. so water sent from rof to land is negative, ! change the sign to indicate addition of water to system. a2l%forc_flood(g) = -x2l(index_x2l_Flrr_flood,i) a2l%volr(g) = x2l(index_x2l_Flrr_volr,i) * (ldomain%area(g) * 1.e6_r8) a2l%volrmch(g)= x2l(index_x2l_Flrr_volrmch,i) * (ldomain%area(g) * 1.e6_r8) ! Determine required receive fields a2l%forc_hgt(g) = x2l(index_x2l_Sa_z,i) ! zgcmxy Atm state m a2l%forc_u(g) = x2l(index_x2l_Sa_u,i) ! forc_uxy Atm state m/s a2l%forc_v(g) = x2l(index_x2l_Sa_v,i) ! forc_vxy Atm state m/s a2l%forc_solad(g,2) = x2l(index_x2l_Faxa_swndr,i) ! forc_sollxy Atm flux W/m^2 a2l%forc_solad(g,1) = x2l(index_x2l_Faxa_swvdr,i) ! forc_solsxy Atm flux W/m^2 a2l%forc_solai(g,2) = x2l(index_x2l_Faxa_swndf,i) ! forc_solldxy Atm flux W/m^2 a2l%forc_solai(g,1) = x2l(index_x2l_Faxa_swvdf,i) ! forc_solsdxy Atm flux W/m^2 a2l_not_downscaled_gcell%forc_th(g) = x2l(index_x2l_Sa_ptem,i) ! forc_thxy Atm state K a2l_not_downscaled_gcell%forc_q(g) = x2l(index_x2l_Sa_shum,i) ! forc_qxy Atm state kg/kg a2l_not_downscaled_gcell%forc_pbot(g) = x2l(index_x2l_Sa_pbot,i) ! ptcmxy Atm state Pa a2l_not_downscaled_gcell%forc_t(g) = x2l(index_x2l_Sa_tbot,i) ! forc_txy Atm state K a2l_not_downscaled_gcell%forc_lwrad(g) = x2l(index_x2l_Faxa_lwdn,i) ! flwdsxy Atm flux W/m^2 forc_rainc = x2l(index_x2l_Faxa_rainc,i) ! mm/s forc_rainl = x2l(index_x2l_Faxa_rainl,i) ! mm/s forc_snowc = x2l(index_x2l_Faxa_snowc,i) ! mm/s forc_snowl = x2l(index_x2l_Faxa_snowl,i) ! mm/s ! atmosphere coupling, for prognostic/prescribed aerosols a2l%forc_aer(g,1) = x2l(index_x2l_Faxa_bcphidry,i) a2l%forc_aer(g,2) = x2l(index_x2l_Faxa_bcphodry,i) a2l%forc_aer(g,3) = x2l(index_x2l_Faxa_bcphiwet,i) a2l%forc_aer(g,4) = x2l(index_x2l_Faxa_ocphidry,i) a2l%forc_aer(g,5) = x2l(index_x2l_Faxa_ocphodry,i) a2l%forc_aer(g,6) = x2l(index_x2l_Faxa_ocphiwet,i) a2l%forc_aer(g,7) = x2l(index_x2l_Faxa_dstwet1,i) a2l%forc_aer(g,8) = x2l(index_x2l_Faxa_dstdry1,i) a2l%forc_aer(g,9) = x2l(index_x2l_Faxa_dstwet2,i) a2l%forc_aer(g,10) = x2l(index_x2l_Faxa_dstdry2,i) a2l%forc_aer(g,11) = x2l(index_x2l_Faxa_dstwet3,i) a2l%forc_aer(g,12) = x2l(index_x2l_Faxa_dstdry3,i) a2l%forc_aer(g,13) = x2l(index_x2l_Faxa_dstwet4,i) a2l%forc_aer(g,14) = x2l(index_x2l_Faxa_dstdry4,i) ! Determine optional receive fields if (index_x2l_Sa_co2prog /= 0) then co2_ppmv_prog = x2l(index_x2l_Sa_co2prog,i) ! co2 atm state prognostic else co2_ppmv_prog = co2_ppmv end if if (index_x2l_Sa_co2diag /= 0) then co2_ppmv_diag = x2l(index_x2l_Sa_co2diag,i) ! co2 atm state diagnostic else co2_ppmv_diag = co2_ppmv end if if (index_x2l_Sa_methane /= 0) then a2l%forc_pch4(g) = x2l(index_x2l_Sa_methane,i) endif ! Determine derived quantities for required fields forc_t = a2l_not_downscaled_gcell%forc_t(g) forc_q = a2l_not_downscaled_gcell%forc_q(g) forc_pbot = a2l_not_downscaled_gcell%forc_pbot(g) a2l%forc_hgt_u(g) = a2l%forc_hgt(g) !observational height of wind [m] a2l%forc_hgt_t(g) = a2l%forc_hgt(g) !observational height of temperature [m] a2l%forc_hgt_q(g) = a2l%forc_hgt(g) !observational height of humidity [m] a2l%forc_vp(g) = forc_q * forc_pbot & / (0.622_r8 + 0.378_r8 * forc_q) a2l_not_downscaled_gcell%forc_rho(g) = (forc_pbot - 0.378_r8 * a2l%forc_vp(g)) & / (rair * forc_t) a2l%forc_po2(g) = o2_molar_const * forc_pbot a2l%forc_wind(g) = sqrt(a2l%forc_u(g)**2 + a2l%forc_v(g)**2) a2l%forc_solar(g) = a2l%forc_solad(g,1) + a2l%forc_solai(g,1) + & a2l%forc_solad(g,2) + a2l%forc_solai(g,2) a2l_not_downscaled_gcell%forc_rain(g) = forc_rainc + forc_rainl a2l_not_downscaled_gcell%forc_snow(g) = forc_snowc + forc_snowl if (forc_t > SHR_CONST_TKFRZ) then e = esatw(tdc(forc_t)) else e = esati(tdc(forc_t)) end if qsat = 0.622_r8*e / (forc_pbot - 0.378_r8*e) a2l%forc_rh(g) = 100.0_r8*(forc_q / qsat) ! Make sure relative humidity is properly bounded ! a2l%forc_rh(g) = min( 100.0_r8, a2l%forc_rh(g) ) ! a2l%forc_rh(g) = max( 0.0_r8, a2l%forc_rh(g) ) ! Determine derived quantities for optional fields ! Note that the following does unit conversions from ppmv to partial pressures (Pa) ! Note that forc_pbot is in Pa if (co2_type_idx == 1) then co2_ppmv_val = co2_ppmv_prog else if (co2_type_idx == 2) then co2_ppmv_val = co2_ppmv_diag else co2_ppmv_val = co2_ppmv end if a2l%forc_pco2(g) = co2_ppmv_val * 1.e-6_r8 * forc_pbot if (use_c13) then a2l%forc_pc13o2(g) = co2_ppmv_val * c13ratio * 1.e-6_r8 * forc_pbot end if ! glc coupling if (create_glacier_mec_landunit) then do num = 0,glc_nec x2s%frac(g,num) = x2l(index_x2l_Sg_ice_covered(num),i) x2s%topo(g,num) = x2l(index_x2l_Sg_topo(num),i) x2s%hflx(g,num) = x2l(index_x2l_Flgg_hflx(num),i) end do x2s%icemask(g) = x2l(index_x2l_Sg_icemask,i) end if end do end subroutine lnd_import !=============================================================================== subroutine lnd_export( bounds, clm_l2a, clm_s2x, l2x) !--------------------------------------------------------------------------- ! !DESCRIPTION: ! Convert the data to be sent from the clm model to the coupler ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use clm_varctl , only : iulog, create_glacier_mec_landunit use clm_time_manager , only : get_nstep, get_step_size use seq_drydep_mod , only : n_drydep use shr_megan_mod , only : shr_megan_mechcomps_n ! ! !ARGUMENTS: implicit none type(bounds_type) , intent(in) :: bounds ! bounds type(lnd2atm_type), intent(inout) :: clm_l2a ! clm land to atmosphere exchange data type type(lnd2glc_type), intent(inout) :: clm_s2x ! clm land to atmosphere exchange data type real(r8) , intent(out) :: l2x(:,:)! land to coupler export state on land grid ! ! !LOCAL VARIABLES: integer :: g,i ! indices integer :: ier ! error status integer :: nstep ! time step index integer :: dtime ! time step integer :: num ! counter !--------------------------------------------------------------------------- ! cesm sign convention is that fluxes are positive downward l2x(:,:) = 0.0_r8 do g = bounds%begg,bounds%endg i = 1 + (g-bounds%begg) l2x(index_l2x_Sl_t,i) = clm_l2a%t_rad(g) l2x(index_l2x_Sl_snowh,i) = clm_l2a%h2osno(g) l2x(index_l2x_Sl_avsdr,i) = clm_l2a%albd(g,1) l2x(index_l2x_Sl_anidr,i) = clm_l2a%albd(g,2) l2x(index_l2x_Sl_avsdf,i) = clm_l2a%albi(g,1) l2x(index_l2x_Sl_anidf,i) = clm_l2a%albi(g,2) l2x(index_l2x_Sl_tref,i) = clm_l2a%t_ref2m(g) l2x(index_l2x_Sl_qref,i) = clm_l2a%q_ref2m(g) l2x(index_l2x_Sl_u10,i) = clm_l2a%u_ref10m(g) l2x(index_l2x_Fall_taux,i) = -clm_l2a%taux(g) l2x(index_l2x_Fall_tauy,i) = -clm_l2a%tauy(g) l2x(index_l2x_Fall_lat,i) = -clm_l2a%eflx_lh_tot(g) l2x(index_l2x_Fall_sen,i) = -clm_l2a%eflx_sh_tot(g) l2x(index_l2x_Fall_lwup,i) = -clm_l2a%eflx_lwrad_out(g) l2x(index_l2x_Fall_evap,i) = -clm_l2a%qflx_evap_tot(g) l2x(index_l2x_Fall_swnet,i) = clm_l2a%fsa(g) if (index_l2x_Fall_fco2_lnd /= 0) then l2x(index_l2x_Fall_fco2_lnd,i) = -clm_l2a%nee(g) end if ! Additional fields for DUST, PROGSSLT, dry-deposition and VOC ! These are now standard fields, but the check on the index makes sure the driver handles them if (index_l2x_Sl_ram1 /= 0 ) l2x(index_l2x_Sl_ram1,i) = clm_l2a%ram1(g) if (index_l2x_Sl_fv /= 0 ) l2x(index_l2x_Sl_fv,i) = clm_l2a%fv(g) if (index_l2x_Sl_soilw /= 0 ) l2x(index_l2x_Sl_soilw,i) = clm_l2a%h2osoi_vol(g,1) if (index_l2x_Fall_flxdst1 /= 0 ) l2x(index_l2x_Fall_flxdst1,i)= -clm_l2a%flxdst(g,1) if (index_l2x_Fall_flxdst2 /= 0 ) l2x(index_l2x_Fall_flxdst2,i)= -clm_l2a%flxdst(g,2) if (index_l2x_Fall_flxdst3 /= 0 ) l2x(index_l2x_Fall_flxdst3,i)= -clm_l2a%flxdst(g,3) if (index_l2x_Fall_flxdst4 /= 0 ) l2x(index_l2x_Fall_flxdst4,i)= -clm_l2a%flxdst(g,4) ! for dry dep velocities if (index_l2x_Sl_ddvel /= 0 ) then l2x(index_l2x_Sl_ddvel:index_l2x_Sl_ddvel+n_drydep-1,i) = & clm_l2a%ddvel(g,:n_drydep) end if ! for MEGAN VOC emis fluxes if (index_l2x_Fall_flxvoc /= 0 ) then l2x(index_l2x_Fall_flxvoc:index_l2x_Fall_flxvoc+shr_megan_mechcomps_n-1,i) = & -clm_l2a%flxvoc(g,:shr_megan_mechcomps_n) end if if (index_l2x_Fall_methane /= 0) then l2x(index_l2x_Fall_methane,i) = -clm_l2a%flux_ch4(g) endif ! sign convention is positive downward with ! hierarchy of atm/glc/lnd/rof/ice/ocn. so water sent from land to rof is positive l2x(index_l2x_Flrl_rofsur,i) = clm_l2a%rofliq(g) l2x(index_l2x_Flrl_rofgwl,i) = 0.0_r8 l2x(index_l2x_Flrl_rofsub,i) = 0.0_r8 l2x(index_l2x_Flrl_rofdto,i) = 0.0_r8 l2x(index_l2x_Flrl_rofi,i) = clm_l2a%rofice(g) ! glc coupling if (create_glacier_mec_landunit) then do num = 0,glc_nec l2x(index_l2x_Sl_tsrf(num),i) = clm_s2x%tsrf(g,num) l2x(index_l2x_Sl_topo(num),i) = clm_s2x%topo(g,num) l2x(index_l2x_Flgl_qice(num),i) = clm_s2x%qice(g,num) end do end if end do end subroutine lnd_export end module lnd_import_export