From aabe844ed5870d82d8c879590d14a69f06896815 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 28 Oct 2022 10:06:46 -0400 Subject: [PATCH] Update CMEPS to latest ESCOMP/master (#72) * add support for external land component * update exchange fields for nems to include land * remove physparam.f in MED_typedefs.meta Ufuk Turuncoglu --- cesm/driver/esm.F90 | 6 +- cesm/driver/esm_time_mod.F90 | 53 +- cesm/flux_atmocn/shr_flux_mod.F90 | 20 +- .../{shr_pio_mod.F90 => driver_pio_mod.F90} | 324 +---- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 4 +- cesm/nuopc_cap_share/seq_drydep_mod.F90 | 1211 +---------------- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 655 +++++++++ cime_config/buildnml | 4 +- cime_config/config_component.xml | 6 +- cime_config/config_component_cesm.xml | 8 +- cime_config/namelist_definition_drv.xml | 335 ++--- cime_config/namelist_definition_drv_flds.xml | 22 +- mediator/esmFldsExchange_cesm_mod.F90 | 1 + mediator/esmFldsExchange_nems_mod.F90 | 59 +- mediator/med_map_mod.F90 | 8 +- mediator/med_phases_aofluxes_mod.F90 | 15 +- mediator/med_phases_prep_lnd_mod.F90 | 14 +- ufs/ccpp/data/MED_typedefs.meta | 2 +- 18 files changed, 1023 insertions(+), 1724 deletions(-) rename cesm/nuopc_cap_share/{shr_pio_mod.F90 => driver_pio_mod.F90} (58%) create mode 100644 cesm/nuopc_cap_share/shr_drydep_mod.F90 diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f788c2478..b6f39ad52 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -808,7 +808,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init, shr_pio_component_init + use driver_pio_mod , only : driver_pio_init, driver_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -934,7 +934,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call shr_pio_init(driver, rc=rc) + call driver_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) @@ -1182,7 +1182,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call shr_pio_component_init(driver, size(comps), rc) + call driver_pio_component_init(driver, size(comps), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 40c57b87c..7afcbc992 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -29,18 +29,18 @@ module esm_time_mod ! Clock and alarm options character(len=*), private, parameter :: & - optNONE = "none" , & - optNever = "never" , & - optNSteps = "nsteps" , & - optNSeconds = "nseconds" , & - optNMinutes = "nminutes" , & - optNHours = "nhours" , & - optNDays = "ndays" , & - optNMonths = "nmonths" , & - optNYears = "nyears" , & - optMonthly = "monthly" , & - optYearly = "yearly" , & - optDate = "date" , & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nstep" , & + optNSeconds = "nsecond" , & + optNMinutes = "nminute" , & + optNHours = "nhour" , & + optNDays = "nday" , & + optNMonths = "nmonth" , & + optNYears = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & optGLCCouplingPeriod = "glc_coupling_period" ! Module data @@ -434,13 +434,14 @@ subroutine esm_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - else if (trim(option) == optNSteps .or. & - trim(option) == optNSeconds .or. & - trim(option) == optNMinutes .or. & - trim(option) == optNHours .or. & - trim(option) == optNDays .or. & - trim(option) == optNMonths .or. & - trim(option) == optNYears) then + else if (& + trim(option) == optNSteps .or. trim(option) == trim(optNSteps)//'s' .or. & + trim(option) == optNSeconds .or. trim(option) == trim(optNSeconds)//'s' .or. & + trim(option) == optNMinutes .or. trim(option) == trim(optNMinutes)//'s' .or. & + trim(option) == optNHours .or. trim(option) == trim(optNHours)//'s' .or. & + trim(option) == optNDays .or. trim(option) == trim(optNDays)//'s' .or. & + trim(option) == optNMonths .or. trim(option) == trim(optNMonths)//'s' .or. & + trim(option) == optNYears .or. trim(option) == trim(optNYears)//'s' ) then if (.not.present(opt_n)) then call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE @@ -451,7 +452,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & rc = ESMF_FAILURE return end if - end if + end if ! Determine inputs for call to create alarm selectcase (trim(option)) @@ -479,36 +480,36 @@ subroutine esm_time_alarmInit( clock, alarm, option, & if (ChkErr(rc,__LINE__,u_FILE_u)) return update_nextalarm = .false. - case (optNSteps) + case (optNSteps,trim(optNSteps)//'s') call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNSeconds) + case (optNSeconds,trim(optNSeconds)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNMinutes) + case (optNMinutes,trim(optNMinutes)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNHours) + case (optNHours,trim(optNHours)//'s') call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNDays) + case (optNDays,trim(optNDays)//'s') call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n update_nextalarm = .true. - case (optNMonths) + case (optNMonths,trim(optNMonths)//'s') call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return AlarmInterval = AlarmInterval * opt_n diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 87d8be9d5..9e74abf28 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -133,8 +133,8 @@ end subroutine shr_flux_adjust_constants ! Thomas Toniazzo (Bjerknes Centre, Bergen) ” !=============================================================================== SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & - & qbot ,s16O ,sHDO ,s18O ,rbot , & - & tbot ,us ,vs , & + & qbot ,s16O ,sHDO ,s18O ,rbot, & + & tbot ,us ,vs, pslv, & & ts ,mask , seq_flux_atmocn_minwind, & & sen ,lat ,lwup , & & r16O, rhdo, r18O, & @@ -169,6 +169,7 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & real(R8) ,intent(in) :: r18O (nMax) ! ocn H218O tracer ratio/Rstd real(R8) ,intent(in) :: rbot (nMax) ! atm air density (kg/m^3) real(R8) ,intent(in) :: tbot (nMax) ! atm T (K) + real(R8) ,intent(in) :: pslv (nMax) ! atm sea level pressure(Pa) real(R8) ,intent(in) :: us (nMax) ! ocn u-velocity (m/s) real(R8) ,intent(in) :: vs (nMax) ! ocn v-velocity (m/s) real(R8) ,intent(in) :: ts (nMax) ! ocn temperature (K) @@ -553,9 +554,22 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & endif ENDDO + else if (ocn_surface_flux_scheme .eq. 2) then + + call flux_atmOcn_UA(logunit,& + nMax, zbot, ubot, vbot, thbot, & + qbot, s16O, sHDO, s18O, rbot, & + tbot, pslv, us, vs, & + ts, mask, sen, lat, lwup, & + r16O, rhdo, r18O, & + evap, evap_16O, evap_HDO, evap_18O, & + taux, tauy, tref, qref, & + duu10n, ustar_sv, re_sv, ssq_sv, & + missval) + else - call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0 or 1") + call shr_sys_abort(subName//" subroutine flux_atmOcn requires ocn_surface_flux_scheme = 0, 1 or 2") endif !! ocn_surface_flux_scheme diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 similarity index 58% rename from cesm/nuopc_cap_share/shr_pio_mod.F90 rename to cesm/nuopc_cap_share/driver_pio_mod.F90 index e05a1ed99..0e743d669 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -1,5 +1,6 @@ -module shr_pio_mod +module driver_pio_mod use pio + use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in use shr_file_mod, only : shr_file_getunit, shr_file_freeunit use shr_log_mod, only : shr_log_unit @@ -14,56 +15,17 @@ module shr_pio_mod #include #endif private - public :: shr_pio_init - public :: shr_pio_component_init - public :: shr_pio_getiosys - public :: shr_pio_getiotype - public :: shr_pio_getioroot - public :: shr_pio_finalize - public :: shr_pio_getioformat - public :: shr_pio_getrearranger - public :: shr_pio_log_comp_settings - - interface shr_pio_getiotype - module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname - end interface - interface shr_pio_getioformat - module procedure shr_pio_getioformat_fromid, shr_pio_getioformat_fromname - end interface - interface shr_pio_getiosys - module procedure shr_pio_getiosys_fromid, shr_pio_getiosys_fromname - end interface - interface shr_pio_getioroot - module procedure shr_pio_getioroot_fromid, shr_pio_getioroot_fromname - end interface - interface shr_pio_getindex - module procedure shr_pio_getindex_fromid, shr_pio_getindex_fromname - end interface - interface shr_pio_getrearranger - module procedure shr_pio_getrearranger_fromid, shr_pio_getrearranger_fromname - end interface - - type pio_comp_t - integer :: compid - integer :: pio_root - integer :: pio_stride - integer :: pio_numiotasks - integer :: pio_iotype - integer :: pio_rearranger - integer :: pio_netcdf_ioformat - logical :: pio_async_interface - end type pio_comp_t - - character(len=16), allocatable :: io_compname(:) - type(pio_comp_t), allocatable :: pio_comp_settings(:) - type (iosystem_desc_t), allocatable, target :: iosystems(:) + public :: driver_pio_init + public :: driver_pio_component_init + public :: driver_pio_finalize + public :: driver_pio_log_comp_settings + integer :: io_comm - logical :: pio_async_interface - integer, allocatable :: io_compid(:) integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 type(pio_rearr_opt_t) :: pio_rearr_opts + logical, allocatable :: pio_async_interface(:) integer :: total_comps logical :: mastertask @@ -88,7 +50,7 @@ module shr_pio_mod !! !< - subroutine shr_pio_init(driver, rc) + subroutine driver_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError use NUOPC, only: NUOPC_CompAttributeGet @@ -104,7 +66,7 @@ subroutine shr_pio_init(driver, rc) character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr - character(*), parameter :: subName = '(shr_pio_init) ' + character(*), parameter :: subName = '(driver_pio_init) ' call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -205,9 +167,9 @@ subroutine shr_pio_init(driver, rc) write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if - end subroutine shr_pio_init + end subroutine driver_pio_init - subroutine shr_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -234,6 +196,8 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(io_compname(ncomps)) allocate(iosystems(ncomps)) + allocate(pio_async_interface(ncomps)) + nullify(gcomp) do_async_init = 0 @@ -310,13 +274,13 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + pio_async_interface(i) = (trim(cval) == '.true.') call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_comp_settings(i)%pio_async_interface) then + if (pio_async_interface(i)) then do_async_init = do_async_init + 1 else if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then @@ -335,7 +299,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(async_iosystems(do_async_init)) j=1 do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then + if(pio_async_interface(i)) then iosystems(i) = async_iosystems(j) j = j+1 endif @@ -344,9 +308,9 @@ subroutine shr_pio_component_init(driver, ncomps, rc) endif deallocate(gcomp) - end subroutine shr_pio_component_init + end subroutine driver_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp, logunit) + subroutine driver_pio_log_comp_settings(gcomp, logunit) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet @@ -377,173 +341,21 @@ subroutine shr_pio_log_comp_settings(gcomp, logunit) write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - end subroutine shr_pio_log_comp_settings + end subroutine driver_pio_log_comp_settings !=============================================================================== - subroutine shr_pio_finalize( ) + subroutine driver_pio_finalize( ) integer :: ierr integer :: i do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do - end subroutine shr_pio_finalize - -!=============================================================================== - function shr_pio_getiotype_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_iotype - - end function shr_pio_getiotype_fromid - - - function shr_pio_getiotype_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_iotype - - end function shr_pio_getiotype_fromname - - function shr_pio_getrearranger_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_rearranger - - end function shr_pio_getrearranger_fromid - - - function shr_pio_getrearranger_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_rearranger - - end function shr_pio_getrearranger_fromname - - function shr_pio_getioformat_fromid(compid) result(io_format) - integer, intent(in) :: compid - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(compid))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromid - - - function shr_pio_getioformat_fromname(component) result(io_format) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(component))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromname - -!=============================================================================== - function shr_pio_getioroot_fromid(compid) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(compid))%pio_root - - end function shr_pio_getioroot_fromid - - function shr_pio_getioroot_fromname(component) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(component))%pio_root - - - end function shr_pio_getioroot_fromname - + end subroutine driver_pio_finalize !=============================================================================== - !! Given a component name, return the index of that component. - !! This is the index into io_compid, io_compname, comp_pio_iotype, etc. - !! If the given component is not found, return -1 - - integer function shr_pio_getindex_fromid(compid) result(index) - implicit none - integer, intent(in) :: compid - integer :: i - character(len=shr_kind_cl) :: msg - index = -1 - do i=1,total_comps - if(io_compid(i)==compid) then - index = i - exit - end if - end do - - if(index<0) then - write(msg, *) 'shr_pio_getindex :: compid=',compid,' out of allowed range: ' - call shr_sys_abort(msg) - end if - end function shr_pio_getindex_fromid - - - integer function shr_pio_getindex_fromname(component) result(index) - use shr_string_mod, only : shr_string_toupper - - implicit none - - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - - character(len=len(component)) :: component_ucase - integer :: i - - ! convert component name to upper case in order to match case in io_compname - component_ucase = shr_string_toUpper(component) - - index = -1 ! flag for not found - do i=1,size(io_compname) - if (trim(component_ucase) == trim(io_compname(i))) then - index = i - exit - end if - end do - if(index<0) then - call shr_sys_abort(' shr_pio_getindex:: compid out of allowed range') - end if - end function shr_pio_getindex_fromname - - function shr_pio_getiosys_fromid(compid) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(compid)) - - end function shr_pio_getiosys_fromid - - function shr_pio_getiosys_fromname(component) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(component)) - - end function shr_pio_getiosys_fromname - - subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + subroutine driver_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: pio_netcdf_format integer, intent(out) :: pio_netcdf_ioformat @@ -560,10 +372,10 @@ subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, p pio_netcdf_ioformat = pio_default_netcdf_ioformat endif - end subroutine shr_pio_getioformatfromname + end subroutine driver_pio_getioformatfromname - subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) + subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: typename integer, intent(out) :: iotype @@ -583,90 +395,12 @@ subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'shr_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(shr_log_unit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if - end subroutine shr_pio_getiotypefromname - -!=============================================================================== - subroutine shr_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & - pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) - integer, intent(in) :: npes, mycomm - integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks - integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat - logical, intent(in) :: iamroot - character(*),parameter :: subName = '(shr_pio_namelist_set) ' - - call shr_mpi_bcast(pio_iotype , mycomm) - call shr_mpi_bcast(pio_stride , mycomm) - call shr_mpi_bcast(pio_root , mycomm) - call shr_mpi_bcast(pio_numiotasks, mycomm) - call shr_mpi_bcast(pio_rearranger, mycomm) - call shr_mpi_bcast(pio_netcdf_ioformat, mycomm) - - if (pio_root<0) then - pio_root = 1 - endif - if(.not. pio_async_interface) then - pio_root = min(pio_root,npes-1) -! If you are asking for parallel IO then you should use at least two io pes - if(npes > 1 .and. pio_numiotasks == 1 .and. & - (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. & - pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then - pio_numiotasks = 2 - pio_stride = min(pio_stride, npes/2) - endif - endif - - !-------------------------------------------------------------------------- - ! check/set/correct io pio parameters - !-------------------------------------------------------------------------- - if (pio_stride>0.and.pio_numiotasks<0) then - pio_numiotasks = max(1,npes/pio_stride) - else if(pio_numiotasks>0 .and. pio_stride<0) then - pio_stride = max(1,npes/pio_numiotasks) - else if(pio_numiotasks<0 .and. pio_stride<0) then - pio_stride = max(1,npes/4) - pio_numiotasks = max(1,npes/pio_stride) - end if - if(pio_stride == 1 .and. .not. pio_async_interface) then - pio_root = 0 - endif - if(pio_rearranger .ne. PIO_REARR_SUBSET .and. pio_rearranger .ne. PIO_REARR_BOX) then - write(shr_log_unit,*) 'pio_rearranger value, ',pio_rearranger,& - ', not supported - using PIO_REARR_BOX' - pio_rearranger = PIO_REARR_BOX - - endif - - - if (.not. pio_async_interface .and. & - pio_root + (pio_stride)*(pio_numiotasks-1) >= npes .or. & - pio_stride<=0 .or. pio_numiotasks<=0 .or. pio_root < 0 .or. & - pio_root > npes-1 ) then - if(npes<100) then - pio_stride = max(1,npes/4) - else if(npes<1000) then - pio_stride = max(1,npes/8) - else - pio_stride = max(1,npes/16) - end if - if(pio_stride>1) then - pio_numiotasks = npes/pio_stride - pio_root = min(1,npes-1) - else - pio_numiotasks = npes - pio_root = 0 - end if - if( iamroot) then - write(shr_log_unit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults: ',& - pio_stride,pio_numiotasks, pio_root - end if - end if - - end subroutine shr_pio_namelist_set + end subroutine driver_pio_getiotypefromname !=============================================================================== -end module shr_pio_mod +end module driver_pio_mod diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index da7891c49..8d472902b 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use shr_pio_mod, only : shr_pio_log_comp_settings + use driver_pio_mod, only : driver_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -165,7 +165,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log - call shr_pio_log_comp_settings(gcomp, logunit) + call driver_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 diff --git a/cesm/nuopc_cap_share/seq_drydep_mod.F90 b/cesm/nuopc_cap_share/seq_drydep_mod.F90 index 0d98f5c85..780a6c611 100644 --- a/cesm/nuopc_cap_share/seq_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/seq_drydep_mod.F90 @@ -1,1221 +1,26 @@ module seq_drydep_mod - !======================================================================== - ! Module for handling dry depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers - !======================================================================== - - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS - use shr_sys_mod , only : shr_sys_abort - use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod , only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV - use shr_mpi_mod , only : shr_mpi_bcast - use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + use shr_drydep_mod, only: seq_drydep_setHCoeff=>shr_drydep_setHCoeff + use shr_drydep_mod implicit none - private - - ! public member functions - public :: seq_drydep_readnl ! Read namelist - public :: seq_drydep_init ! Initialization of drydep data - public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients - - ! private array sizes - integer, public, parameter :: n_species_table = 192 ! Number of species to work with - integer, private, parameter :: maxspc = 210 ! Maximum number of species - integer, private, parameter :: NSeas = 5 ! Number of seasons - integer, private, parameter :: NLUse = 11 ! Number of land-use types - logical, private :: drydep_initialized = .false. - - ! public data members: ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen - - real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) - - logical, public :: lnd_drydep ! If dry-dep fields passed - integer, public :: n_drydep = 0 ! Number in drypdep list - logical :: drydep_init = .false. ! has seq_drydep_init been called? - character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) - real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) - integer, public, allocatable, dimension(:) :: mapping ! mapping to species table - - ! --- Indices for each species --- - integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx - - !--------------------------------------------------------------------------- - ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 - ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 - ! Table 3-5 compiled by P. Hess - ! - ! index #1 : season - ! 1 -> midsummer with lush vegetation - ! 2 -> autumn with unharvested cropland - ! 3 -> late autumn after frost, no snow - ! 4 -> winter, snow on ground, and subfreezing - ! 5 -> transitional spring with partially green short annuals - ! - ! index #2 : landuse type - ! 1 -> urban land - ! 2 -> agricultural land - ! 3 -> range land - ! 4 -> deciduous forest - ! 5 -> coniferous forest - ! 6 -> mixed forest including wetland - ! 7 -> water, both salt and fresh - ! 8 -> barren land, mostly desert - ! 9 -> nonforested wetland - ! 10 -> mixed agricultural and range land - ! 11 -> rocky open areas with low growing shrubs - ! - ! JFL August 2000 - !--------------------------------------------------------------------------- - - !--------------------------------------------------------------------------- - ! table to parameterize the impact of soil moisture on the deposition of H2 and - ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). - !--------------------------------------------------------------------------- - - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_a(NLUse) = & - (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & - 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_b(NLUse) = & - (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & - -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_c(NLUse) = & - (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & - 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) - - !--- deposition of h2 and CO on soils - ! - !--- ri: Richardson number (dimensionless) - !--- rlu: Resistance of leaves in upper canopy (s.m-1) - !--- rac: Aerodynamic resistance to lower canopy (s.m-1) - !--- rgss: Ground surface resistance for SO2 (s.m-1) - !--- rgso: Ground surface resistance for O3 (s.m-1) - !--- rcls: Lower canopy resistance for SO2 (s.m-1) - !--- rclo: Lower canopy resistance for O3 (s.m-1) - ! - real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo - - data ri (1,1:NLUse) & - /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ - data rlu (1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rac (1,1:NLUse) & - / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ - data rgss(1,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ - data rgso(1,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rclo(1,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ - - data ri (2,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (2,1:NLUse) & - / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ - data rgss(2,1:NLUse) & - / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ - data rgso(2,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ - data rcls(2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(2,1:NLUse) & - /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ - - data ri (3,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (3,1:NLUse) & - / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ - data rgss(3,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ - data rgso(3,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(3,1:NLUse) & - /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ - - data ri (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (4,1:NLUse) & - / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ - data rgss(4,1:NLUse) & - / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ - data rgso(4,1:NLUse) & - / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ - data rcls(4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ - data rclo(4,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ - - data ri (5,1:NLUse) & - /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ - data rlu (5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rac (5,1:NLUse) & - / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ - data rgss(5,1:NLUse) & - / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ - data rgso(5,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rclo(5,1:NLUse) & - /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ - - !--------------------------------------------------------------------------- - ! ... roughness length - !--------------------------------------------------------------------------- - real(r8), public, dimension(NSeas,NLUse) :: z0 - - data z0 (1,1:NLUse) & - /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ - data z0 (2,1:NLUse) & - /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ - data z0 (3,1:NLUse) & - /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ - data z0 (4,1:NLUse) & - /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ - data z0 (5,1:NLUse) & - /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ - - !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & - ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & - ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & - ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & - ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & - ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) - - !--------------------------------------------------------------------------- - ! public chemical data - !--------------------------------------------------------------------------- - - !--- data for foxd (reactivity factor for oxidation) ---- - real(r8), public, parameter :: dfoxd(n_species_table) = & - (/ 1._r8 & ! OX - ,1._r8 & ! H2O2 - ,1._r8 & ! OH - ,.1_r8 & ! HO2 - ,1.e-36_r8 & ! CO - ,1.e-36_r8 & ! CH4 - ,1._r8 & ! CH3O2 - ,1._r8 & ! CH3OOH - ,1._r8 & ! CH2O - ,1._r8 & ! HCOOH - ,0._r8 & ! NO - ,.1_r8 & ! NO2 - ,1.e-36_r8 & ! HNO3 - ,1.e-36_r8 & ! CO2 - ,1.e-36_r8 & ! NH3 - ,.1_r8 & ! N2O5 - ,1._r8 & ! NO3 - ,1._r8 & ! CH3OH - ,.1_r8 & ! HO2NO2 - ,1._r8 & ! O1D - ,1.e-36_r8 & ! C2H6 - ,.1_r8 & ! C2H5O2 - ,.1_r8 & ! PO2 - ,.1_r8 & ! MACRO2 - ,.1_r8 & ! ISOPO2 - ,1.e-36_r8 & ! C4H10 - ,1._r8 & ! CH3CHO - ,1._r8 & ! C2H5OOH - ,1.e-36_r8 & ! C3H6 - ,1._r8 & ! POOH - ,1.e-36_r8 & ! C2H4 - ,.1_r8 & ! PAN - ,1._r8 & ! CH3COOOH - ,1.e-36_r8 & ! MTERP - ,1._r8 & ! GLYOXAL - ,1._r8 & ! CH3COCHO - ,1._r8 & ! GLYALD - ,.1_r8 & ! CH3CO3 - ,1.e-36_r8 & ! C3H8 - ,.1_r8 & ! C3H7O2 - ,1._r8 & ! CH3COCH3 - ,1._r8 & ! C3H7OOH - ,.1_r8 & ! RO2 - ,1._r8 & ! ROOH - ,1.e-36_r8 & ! Rn - ,1.e-36_r8 & ! ISOP - ,1._r8 & ! MVK - ,1._r8 & ! MACR - ,1._r8 & ! C2H5OH - ,1._r8 & ! ONITR - ,.1_r8 & ! ONIT - ,.1_r8 & ! ISOPNO3 - ,1._r8 & ! HYDRALD - ,1.e-36_r8 & ! HCN - ,1.e-36_r8 & ! CH3CN - ,1.e-36_r8 & ! SO2 - ,0.1_r8 & ! SOAGff0 - ,0.1_r8 & ! SOAGff1 - ,0.1_r8 & ! SOAGff2 - ,0.1_r8 & ! SOAGff3 - ,0.1_r8 & ! SOAGff4 - ,0.1_r8 & ! SOAGbg0 - ,0.1_r8 & ! SOAGbg1 - ,0.1_r8 & ! SOAGbg2 - ,0.1_r8 & ! SOAGbg3 - ,0.1_r8 & ! SOAGbg4 - ,0.1_r8 & ! SOAG0 - ,0.1_r8 & ! SOAG1 - ,0.1_r8 & ! SOAG2 - ,0.1_r8 & ! SOAG3 - ,0.1_r8 & ! SOAG4 - ,0.1_r8 & ! IVOC - ,0.1_r8 & ! SVOC - ,0.1_r8 & ! IVOCbb - ,0.1_r8 & ! IVOCff - ,0.1_r8 & ! SVOCbb - ,0.1_r8 & ! SVOCff - ,1.e-36_r8 & ! N2O - ,1.e-36_r8 & ! H2 - ,1.e-36_r8 & ! C2H2 - ,1._r8 & ! CH3COOH - ,1._r8 & ! EOOH - ,1._r8 & ! HYAC - ,1.e-36_r8 & ! BIGENE - ,1.e-36_r8 & ! BIGALK - ,1._r8 & ! MEK - ,1._r8 & ! MEKOOH - ,1._r8 & ! MACROOH - ,1._r8 & ! MPAN - ,1._r8 & ! ALKNIT - ,1._r8 & ! NOA - ,1._r8 & ! ISOPNITA - ,1._r8 & ! ISOPNITB - ,1._r8 & ! ISOPNOOH - ,1._r8 & ! NC4CHO - ,1._r8 & ! NC4CH2OH - ,1._r8 & ! TERPNIT - ,1._r8 & ! NTERPOOH - ,1._r8 & ! ALKOOH - ,1._r8 & ! BIGALD - ,1._r8 & ! HPALD - ,1._r8 & ! IEPOX - ,1._r8 & ! XOOH - ,1._r8 & ! ISOPOOH - ,1.e-36_r8 & ! TOLUENE - ,1._r8 & ! CRESOL - ,1._r8 & ! TOLOOH - ,1.e-36_r8 & ! BENZENE - ,1._r8 & ! PHENOL - ,1._r8 & ! BEPOMUC - ,1._r8 & ! PHENOOH - ,1._r8 & ! C6H5OOH - ,1._r8 & ! BENZOOH - ,1._r8 & ! BIGALD1 - ,1._r8 & ! BIGALD2 - ,1._r8 & ! BIGALD3 - ,1._r8 & ! BIGALD4 - ,1._r8 & ! TEPOMUC - ,1._r8 & ! BZOOH - ,1._r8 & ! BZALD - ,1._r8 & ! PBZNIT - ,1.e-36_r8 & ! XYLENES - ,1._r8 & ! XYLOL - ,1._r8 & ! XYLOLOOH - ,1._r8 & ! XYLENOOH - ,1.e-36_r8 & ! BCARY - ,1._r8 & ! TERPOOH - ,1._r8 & ! TERPROD1 - ,1._r8 & ! TERPROD2 - ,1._r8 & ! TERP2OOH - ,1.e-36_r8 & ! DMS - ,1.e-36_r8 & ! H2SO4 - ,1._r8 & ! HONITR - ,1._r8 & ! MACRN - ,1._r8 & ! MVKN - ,1._r8 & ! ISOPN2B - ,1._r8 & ! ISOPN3B - ,1._r8 & ! ISOPN4D - ,1._r8 & ! ISOPN1D - ,1._r8 & ! ISOPNOOHD - ,1._r8 & ! ISOPNOOHB - ,1._r8 & ! ISOPNBNO3 - ,1._r8 & ! NO3CH2CHO - ,1._r8 & ! HYPERACET - ,1._r8 & ! HCOCH2OOH - ,1._r8 & ! DHPMPAL - ,1._r8 & ! MVKOOH - ,1._r8 & ! ISOPOH - ,1._r8 & ! ISOPFDN - ,1._r8 & ! ISOPFNP - ,1._r8 & ! INHEB - ,1._r8 & ! HMHP - ,1._r8 & ! HPALD1 - ,1._r8 & ! INHED - ,1._r8 & ! HPALD4 - ,1._r8 & ! ISOPHFP - ,1._r8 & ! HPALDB1C - ,1._r8 & ! HPALDB4C - ,1._r8 & ! ICHE - ,1._r8 & ! ISOPFDNC - ,1._r8 & ! ISOPFNC - ,1._r8 & ! TERPNT - ,1._r8 & ! TERPNS - ,1._r8 & ! TERPNT1 - ,1._r8 & ! TERPNS1 - ,1._r8 & ! TERPNPT - ,1._r8 & ! TERPNPS - ,1._r8 & ! TERPNPT1 - ,1._r8 & ! TERPNPS1 - ,1._r8 & ! TERPFDN - ,1._r8 & ! SQTN - ,1._r8 & ! TERPHFN - ,1._r8 & ! TERP1OOH - ,1._r8 & ! TERPDHDP - ,1._r8 & ! TERPF2 - ,1._r8 & ! TERPF1 - ,1._r8 & ! TERPA - ,1._r8 & ! TERPA2 - ,1._r8 & ! TERPK - ,1._r8 & ! TERPAPAN - ,1._r8 & ! TERPACID - ,1._r8 & ! TERPA2PAN - ,1.e-36_r8 & ! APIN - ,1.e-36_r8 & ! BPIN - ,1.e-36_r8 & ! LIMON - ,1.e-36_r8 & ! MYRC - ,1._r8 & ! TERPACID2 - ,1._r8 & ! TERPACID3 - ,1._r8 & ! TERPA3PAN - ,1._r8 & ! TERPOOHL - ,1._r8 & ! TERPA3 - ,1._r8 & ! TERP2AOOH - /) + character(len=*), parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(len=*), parameter :: drydep_method = DD_XLND ! XLND is the only option now + logical, protected :: lnd_drydep - ! PRIVATE DATA: - - Interface seq_drydep_setHCoeff ! overload subroutine - Module Procedure set_hcoeff_scalar - Module Procedure set_hcoeff_vector - End Interface - - real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- - - !--------------------------------------------------------------------------- - ! private chemical data - !--------------------------------------------------------------------------- - - !--- Names of species that can work with --- - character(len=20), public, parameter :: species_name_table(n_species_table) = & - (/ 'OX ' & - ,'H2O2 ' & - ,'OH ' & - ,'HO2 ' & - ,'CO ' & - ,'CH4 ' & - ,'CH3O2 ' & - ,'CH3OOH ' & - ,'CH2O ' & - ,'HCOOH ' & - ,'NO ' & - ,'NO2 ' & - ,'HNO3 ' & - ,'CO2 ' & - ,'NH3 ' & - ,'N2O5 ' & - ,'NO3 ' & - ,'CH3OH ' & - ,'HO2NO2 ' & - ,'O1D ' & - ,'C2H6 ' & - ,'C2H5O2 ' & - ,'PO2 ' & - ,'MACRO2 ' & - ,'ISOPO2 ' & - ,'C4H10 ' & - ,'CH3CHO ' & - ,'C2H5OOH ' & - ,'C3H6 ' & - ,'POOH ' & - ,'C2H4 ' & - ,'PAN ' & - ,'CH3COOOH ' & - ,'MTERP ' & - ,'GLYOXAL ' & - ,'CH3COCHO ' & - ,'GLYALD ' & - ,'CH3CO3 ' & - ,'C3H8 ' & - ,'C3H7O2 ' & - ,'CH3COCH3 ' & - ,'C3H7OOH ' & - ,'RO2 ' & - ,'ROOH ' & - ,'Rn ' & - ,'ISOP ' & - ,'MVK ' & - ,'MACR ' & - ,'C2H5OH ' & - ,'ONITR ' & - ,'ONIT ' & - ,'ISOPNO3 ' & - ,'HYDRALD ' & - ,'HCN ' & - ,'CH3CN ' & - ,'SO2 ' & - ,'SOAGff0 ' & - ,'SOAGff1 ' & - ,'SOAGff2 ' & - ,'SOAGff3 ' & - ,'SOAGff4 ' & - ,'SOAGbg0 ' & - ,'SOAGbg1 ' & - ,'SOAGbg2 ' & - ,'SOAGbg3 ' & - ,'SOAGbg4 ' & - ,'SOAG0 ' & - ,'SOAG1 ' & - ,'SOAG2 ' & - ,'SOAG3 ' & - ,'SOAG4 ' & - ,'IVOC ' & - ,'SVOC ' & - ,'IVOCbb ' & - ,'IVOCff ' & - ,'SVOCbb ' & - ,'SVOCff ' & - ,'N2O ' & - ,'H2 ' & - ,'C2H2 ' & - ,'CH3COOH ' & - ,'EOOH ' & - ,'HYAC ' & - ,'BIGENE ' & - ,'BIGALK ' & - ,'MEK ' & - ,'MEKOOH ' & - ,'MACROOH ' & - ,'MPAN ' & - ,'ALKNIT ' & - ,'NOA ' & - ,'ISOPNITA ' & - ,'ISOPNITB ' & - ,'ISOPNOOH ' & - ,'NC4CHO ' & - ,'NC4CH2OH ' & - ,'TERPNIT ' & - ,'NTERPOOH ' & - ,'ALKOOH ' & - ,'BIGALD ' & - ,'HPALD ' & - ,'IEPOX ' & - ,'XOOH ' & - ,'ISOPOOH ' & - ,'TOLUENE ' & - ,'CRESOL ' & - ,'TOLOOH ' & - ,'BENZENE ' & - ,'PHENOL ' & - ,'BEPOMUC ' & - ,'PHENOOH ' & - ,'C6H5OOH ' & - ,'BENZOOH ' & - ,'BIGALD1 ' & - ,'BIGALD2 ' & - ,'BIGALD3 ' & - ,'BIGALD4 ' & - ,'TEPOMUC ' & - ,'BZOOH ' & - ,'BZALD ' & - ,'PBZNIT ' & - ,'XYLENES ' & - ,'XYLOL ' & - ,'XYLOLOOH ' & - ,'XYLENOOH ' & - ,'BCARY ' & - ,'TERPOOH ' & - ,'TERPROD1 ' & - ,'TERPROD2 ' & - ,'TERP2OOH ' & - ,'DMS ' & - ,'H2SO4 ' & - ,'HONITR ' & - ,'MACRN ' & - ,'MVKN ' & - ,'ISOPN2B ' & - ,'ISOPN3B ' & - ,'ISOPN4D ' & - ,'ISOPN1D ' & - ,'ISOPNOOHD' & - ,'ISOPNOOHB' & - ,'ISOPNBNO3' & - ,'NO3CH2CHO' & - ,'HYPERACET' & - ,'HCOCH2OOH' & - ,'DHPMPAL ' & - ,'MVKOOH ' & - ,'ISOPOH ' & - ,'ISOPFDN ' & - ,'ISOPFNP ' & - ,'INHEB ' & - ,'HMHP ' & - ,'HPALD1 ' & - ,'INHED ' & - ,'HPALD4 ' & - ,'ISOPHFP ' & - ,'HPALDB1C ' & - ,'HPALDB4C ' & - ,'ICHE ' & - ,'ISOPFDNC ' & - ,'ISOPFNC ' & - ,'TERPNT ' & - ,'TERPNS ' & - ,'TERPNT1 ' & - ,'TERPNS1 ' & - ,'TERPNPT ' & - ,'TERPNPS ' & - ,'TERPNPT1 ' & - ,'TERPNPS1 ' & - ,'TERPFDN ' & - ,'SQTN ' & - ,'TERPHFN ' & - ,'TERP1OOH ' & - ,'TERPDHDP ' & - ,'TERPF2 ' & - ,'TERPF1 ' & - ,'TERPA ' & - ,'TERPA2 ' & - ,'TERPK ' & - ,'TERPAPAN ' & - ,'TERPACID ' & - ,'TERPA2PAN' & - ,'APIN ' & - ,'BPIN ' & - ,'LIMON ' & - ,'MYRC ' & - ,'TERPACID2' & - ,'TERPACID3' & - ,'TERPA3PAN' & - ,'TERPOOHL ' & - ,'TERPA3 ' & - ,'TERP2AOOH' & - /) - - !--- data for effective Henry's Law coefficient --- - real(r8), public, parameter :: dheff(n_species_table*6) = & - (/1.03e-02_r8, 2830._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OX - ,8.70e+04_r8, 7320._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & ! H2O2 - ,3.90e+01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! OH - ,6.90e+02_r8, 5900._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HO2 - ,9.81e-04_r8, 1650._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CO - ,1.41e-03_r8, 1820._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH4 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3O2 - ,3.00e+02_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OOH - ,3.23e+03_r8, 7100._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH2O - ,8.90e+03_r8, 6100._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! HCOOH - ,1.92e-03_r8, 1762._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO - ,1.20e-02_r8, 2440._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO2 - ,2.10e+05_r8, 8700._r8,2.2e+01_r8, 0._r8,0._r8 , 0._r8 & ! HNO3 - ,3.44e-02_r8, 2715._r8,4.3e-07_r8,-1000._r8,4.7e-11_r8,-1760._r8 & ! CO2 - ,6.02e+01_r8, 4160._r8,1.7e-05_r8,-4325._r8,1.0e-14_r8,-6716._r8 & ! NH3 - ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O5 - ,3.80e-02_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3 - ,2.03e+02_r8, 5645._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3OH - ,4.00e+01_r8, 8400._r8,1.3e-06_r8, 0._r8,0._r8 , 0._r8 & ! HO2NO2 - ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! O1D - ,1.88e-03_r8, 2750._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H6 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5O2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRO2 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPO2 - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C4H10 - ,1.29e+01_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CHO - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H6 - ,1.50e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! POOH - ,5.96e-03_r8, 2200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H4 - ,2.80e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PAN - ,8.37e+02_r8, 5310._r8,1.8e-04_r8, -20._r8,0._r8 , 0._r8 & ! CH3COOOH - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MTERP - ,4.19e+05_r8, 7480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYOXAL - ,3.50e+03_r8, 7545._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCHO - ,4.00e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! GLYALD - ,1.00e-01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CO3 - ,1.51e-03_r8, 3120._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H8 - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7O2 - ,2.78e+01_r8, 5530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COCH3 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C3H7OOH - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! RO2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ROOH - ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! Rn - ,3.45e-02_r8, 4400._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOP - ,4.10e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVK - ,6.50e+00_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACR - ,1.90e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H5OH - ,1.44e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONITR - ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ONIT - ,2.38e+00_r8, 5280._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNO3 - ,1.10e+05_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYDRALD - ,9.02e+00_r8, 8258._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCN - ,5.28e+01_r8, 3970._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3CN - ,1.36e+00_r8, 3100._r8,1.30e-02_r8,1960._r8,6.6e-08_r8, 1500._r8 & ! SO2 - ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff0 - ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff1 - ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff2 - ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff3 - ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGff4 - ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg0 - ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg1 - ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg2 - ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg3 - ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAGbg4 - ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG0 - ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG1 - ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG2 - ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG3 - ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SOAG4 - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOC - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IVOCff - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCbb - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SVOCff - ,2.42e-02_r8, 2710._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! N2O - ,7.9e-04_r8, 530._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2 - ,4.14e-02_r8, 1890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C2H2 - ,4.1e+03_r8, 6200._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CH3COOH - ,1.9e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! EOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYAC - ,5.96e-03_r8, 2365._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGENE - ,1.24e-03_r8, 3010._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALK - ,1.80e+01_r8, 5740._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEK - ,6.4e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MEKOOH - ,4.4e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACROOH - ,1.72e+00_r8, 5700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MPAN - ,1.01e+00_r8, 5790._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKNIT - ,1.e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NOA - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITA - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNITB - ,8.75e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOH - ,1.46e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CHO - ,4.02e+04_r8, 9500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NC4CH2OH - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNIT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NTERPOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ALKOOH - ,9.6e+00_r8, 6220._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! IEPOX - ,1.e+11_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XOOH - ,3.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOOH - ,1.5e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLUENE - ,5.67e+02_r8, 5800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! CRESOL - ,2.30e+04_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TOLOOH - ,1.8e-01_r8, 3800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZENE - ,2.84e+03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOL - ,3.e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BEPOMUC - ,1.5e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PHENOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! C6H5OOH - ,2.3e+03_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BENZOOH - ,1.e+05_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD1 - ,2.9e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD2 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD3 - ,2.2e+04_r8, 5890._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BIGALD4 - ,2.5e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TEPOMUC - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZOOH - ,3.24e+01_r8, 6300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BZALD - ,2.8e+00_r8, 5730._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! PBZNIT - ,2.e-01_r8, 4300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENES - ,1.01e+03_r8, 6800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOL - ,1.9e+06_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLOLOOH - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! XYLENOOH - ,5.57e-03_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BCARY - ,3.6e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOH - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD1 - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPROD2 - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2OOH - ,5.4e-01_r8, 3460._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DMS - ,1.e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! H2SO4 - ,2.64e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HONITR - ,4.14e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MACRN - ,1.84e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKN - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN2B - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN3B - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN4D - ,4.82e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPN1D - ,9.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHD - ,6.61e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNOOHB - ,8.34e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPNBNO3 - ,3.39e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! NO3CH2CHO - ,1.16e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HYPERACET - ,2.99e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HCOCH2OOH - ,9.37e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! DHPMPAL - ,1.24e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MVKOOH - ,8.77e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPOH - ,5.02e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDN - ,2.97e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNP - ,1.05e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHEB - ,1.70e+06_r8, 9870._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HMHP - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD1 - ,1.51e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! INHED - ,2.30e+05_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALD4 - ,7.60e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPHFP - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB1C - ,5.43e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! HPALDB4C - ,2.09e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ICHE - ,7.16e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFDNC - ,1.41e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! ISOPFNC - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT - ,8.41e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNT1 - ,8.55e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNS1 - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT - ,6.67e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPT1 - ,6.78e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPNPS1 - ,1.65e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPFDN - ,9.04e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! SQTN - ,7.53e+11_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPHFN - ,3.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP1OOH - ,3.41e+14_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPDHDP - ,6.54e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF2 - ,4.05e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPF1 - ,3.92e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA - ,7.20e+04_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2 - ,6.39e+01_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPK - ,7.94e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPAPAN - ,5.63e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID - ,9.59e+03_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA2PAN - ,2.94e-02_r8, 1800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! APIN - ,1.52e-02_r8, 4500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! BPIN - ,4.86e-02_r8, 4600._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! LIMON - ,7.30e-02_r8, 2800._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! MYRC - ,2.64e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID2 - ,3.38e+09_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPACID3 - ,1.23e+07_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3PAN - ,4.41e+12_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPOOHL - ,1.04e+08_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERPA3 - ,3.67e+06_r8, 6014._r8,0._r8 , 0._r8,0._r8 , 0._r8 & ! TERP2AOOH - /) - - real(r8), private, parameter :: wh2o = SHR_CONST_MWWV - real(r8), private, parameter :: mol_wgts(n_species_table) = & - (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & - 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & - 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & - 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & - 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & - 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & - 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & - 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & - 58.0768013_r8, 76.0910034_r8, 89.070126_r8, 90.078067_r8, 222.000000_r8, & - 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & - 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & - 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & - 170.3_r8, 170.3_r8, 44.0129_r8, 2.0148_r8, 26.0368_r8, & - 60.0504_r8, 78.0646_r8, 74.0762_r8, 56.1032_r8, 72.1438_r8, & - 72.1026_r8, 104.101_r8, 120.101_r8, 147.085_r8, 133.141_r8, & - 119.074_r8, 147.126_r8, 147.126_r8, 163.125_r8, 145.111_r8, & - 147.126_r8, 215.24_r8, 231.24_r8, 104.143_r8, 98.0982_r8, & - 116.112_r8, 118.127_r8, 150.126_r8, 118.127_r8, 92.1362_r8, & - 108.136_r8, 174.148_r8, 78.1104_r8, 94.1098_r8, 126.109_r8, & - 176.122_r8, 110.109_r8, 160.122_r8, 84.0724_r8, 98.0982_r8, & - 98.0982_r8, 112.124_r8, 140.134_r8, 124.135_r8, 106.121_r8, & - 183.118_r8, 106.162_r8, 122.161_r8, 204.173_r8, 188.174_r8, & - 204.343_r8, 186.241_r8, 168.227_r8, 154.201_r8, 200.226_r8, & - 62.1324_r8, 98.0784_r8, 135.118733_r8, 149.102257_r8, 149.102257_r8, & - 147.129469_r8, 147.129469_r8, 147.129469_r8, 147.129469_r8, 163.128874_r8, & - 163.128874_r8, 147.129469_r8, 105.049617_r8, 90.078067_r8, 76.05145_r8, & - 136.103494_r8, 120.104089_r8, 102.131897_r8, 226.141733_r8, 197.143565_r8, & - 163.128874_r8, 64.040714_r8, 116.11542_r8, 163.128874_r8, 116.11542_r8, & - 150.130112_r8, 116.11542_r8, 116.11542_r8, 116.11542_r8, 224.125851_r8, & - 195.127684_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, 215.246675_r8, & - 231.24608_r8, 231.24608_r8, 231.24608_r8, 231.24608_r8, 294.258938_r8, & - 283.36388_r8, 265.260771_r8, 186.248507_r8, 236.262604_r8, 110.153964_r8, & - 168.233221_r8, 168.233221_r8, 154.206603_r8, 138.207199_r8, 245.229603_r8, & - 200.232031_r8, 231.202986_r8, 136.228394_r8, 136.228394_r8, 136.228394_r8, & - 136.228394_r8, 186.205413_r8, 202.204818_r8, 247.202391_r8, 218.247317_r8, & - 170.206008_r8, 186.248507_r8 /) - - -!=============================================================================== -CONTAINS -!=============================================================================== +contains subroutine seq_drydep_readnl(NLFilename, drydep_nflds) - !======================================================================== - ! reads drydep_inparm namelist and determines the number of drydep velocity - ! fields that are sent from the land component - !======================================================================== - character(len=*), intent(in) :: NLFilename ! Namelist filename integer, intent(out) :: drydep_nflds - !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - type(ESMF_VM) :: vm - integer :: localPet - integer :: mpicom - integer :: rc - character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" - character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" - character(*),parameter :: subName = '(seq_drydep_read) ' - !----------------------------------------------------------------------------- - - namelist /drydep_inparm/ drydep_list, drydep_method - - !----------------------------------------------------------------------------- - ! Read namelist and figure out the drydep field list to pass - ! First check if file exists and if not, n_drydep will be zero - !----------------------------------------------------------------------------- + call shr_drydep_readnl(NLFilename, drydep_nflds) - rc = ESMF_SUCCESS - drydep_nflds = 0 - - !--- Open and read namelist --- - if ( len_trim(NLFilename) == 0 )then - call shr_sys_abort( subName//'ERROR: nlfilename not set' ) - end if - - call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - - if (localPet==0) then - inquire( file=trim(NLFileName), exist=exists) - if ( exists ) then - open(newunit=unitn, file=trim(NLFilename), status='old' ) - write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) - call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) - if (ierr == 0) then - ! Note that ierr /= 0, no namelist is present. - read(unitn, drydep_inparm, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of drydep_inparm namelist in seq_drydep_readnl') - end if - endif - close( unitn ) - end if - end if - call shr_mpi_bcast( drydep_list, mpicom ) - call shr_mpi_bcast( drydep_method, mpicom ) - - do i=1,maxspc - if(len_trim(drydep_list(i)) > 0) then - drydep_nflds=drydep_nflds+1 - endif - enddo - - ! set module variable - n_drydep = drydep_nflds - - ! Make sure method is valid and determine if land is passing drydep fields - lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) - if (localpet==0) then - write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( drydep_nflds == 0 )then - write(s_logunit,F00) 'No dry deposition fields will be transfered' - else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds - end if - end if - - if ( trim(drydep_method)/=trim(DD_XATM) .and. & - trim(drydep_method)/=trim(DD_XLND) .and. & - trim(drydep_method)/=trim(DD_TABL) ) then - write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) - write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & - DD_XATM,', ', DD_XLND,', or ', DD_TABL - call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') - endif - - if (.not. drydep_initialized) then - call seq_drydep_init() - end if + lnd_drydep = drydep_nflds>0 end subroutine seq_drydep_readnl -!==================================================================================== - - subroutine seq_drydep_init( ) - - !======================================================================== - ! Initialization of dry deposition fields - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - !======================================================================== - - !----- local ----- - integer :: i, l ! Indices - character(len=32) :: test_name ! field test name - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_init) ' - character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" - - !----------------------------------------------------------------------------- - ! Return if this routine has already been called (e.g. cam and clm both call this) - !----------------------------------------------------------------------------- - if(allocated(foxd)) return - !----------------------------------------------------------------------------- - ! Allocate and fill foxd, drat and mapping as well as species indices - !----------------------------------------------------------------------------- - - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if - - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'O3S', 'O3INERT' ) - test_name = 'OX' - case( 'Pb' ) - test_name = 'HNO3' - case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'O3A' ) - test_name = 'OX' - case( 'XMPAN' ) - test_name = 'MPAN' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) - end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo - - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere - - where( rac < small_value) - rac = small_value - endwhere - - drydep_initialized = .true. - - end subroutine seq_drydep_init - -!==================================================================================== - - subroutine set_hcoeff_scalar( sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is scalar - ! wrapper routine used when surface temperature is a scalar (single column) rather - ! than an array (multiple columns). - ! - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - !======================================================================== - - implicit none - - real(r8), intent(in) :: sfc_temp ! Input surface temperature - real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients - - !----- local ----- - real(r8) :: sfc_temp_tmp(1) ! surface temp - - sfc_temp_tmp(:) = sfc_temp - call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) - - end subroutine set_hcoeff_scalar - -!==================================================================================== - - subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is vector - ! sets dry depositions coefficients -- used by both land and atmosphere models - !======================================================================== - - integer, intent(in) :: ncol ! Input size of surface-temp vector - real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature - real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients - - !----- local ----- - real(r8), parameter :: t0 = 298._r8 ! Standard Temperature - real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH - integer :: m, l, id ! indices - real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) - real(r8) :: dhr ! temperature dependence of Henry's law coefficient - real(r8) :: dk1s(ncol) ! DK Work array 1 - real(r8) :: dk2s(ncol) ! DK Work array 2 - real(r8) :: wrk(ncol) ! Work array - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' - character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" - - !------------------------------------------------------------------------------- - ! notes: - !------------------------------------------------------------------------------- - - wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) - do m = 1,n_drydep - l = mapping(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) - heff(:,m) = e298*exp( dhr*wrk(:) ) - !--- Calculate coefficients based on the drydep tables --- - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - where( heff(:,m) /= 0._r8 ) - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) - elsewhere - heff(:,m) = dk1s(:)*ph_inv - endwhere - end if - !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- - if( dheff(id+5) /= 0._r8 ) then - if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' & - .or. trim( drydep_list(m) ) == 'SO2' ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) - dk2s(:) = e298*exp( dhr*wrk(:) ) - !--- For Carbon dioxide --- - if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) - !--- For NH3 --- - else if( trim( drydep_list(m) ) == 'NH3' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) - !--- This can't happen --- - else - write(s_logunit,F00) 'Bad species ',drydep_list(m) - call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) - end if - end if - end if - end do - - end subroutine set_hcoeff_vector - -!=============================================================================== - end module seq_drydep_mod diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 new file mode 100644 index 000000000..ae67df4f9 --- /dev/null +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -0,0 +1,655 @@ +module shr_drydep_mod + + !======================================================================== + ! Module for handling dry depostion of tracers. + ! This module is shared by land and atmosphere models for the computations of + ! dry deposition of tracers + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX + use shr_const_mod , only : SHR_CONST_MWWV + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) + + implicit none + private + + ! public member functions + public :: shr_drydep_readnl ! Read namelist + public :: shr_drydep_init ! Initialization of drydep data + public :: shr_drydep_setHCoeff ! Calculate Henry's law coefficients + + ! private array sizes + + integer, private, parameter :: maxspc = 210 ! Maximum number of species + integer, public, protected :: n_species_table ! Number of species to work with + integer, private, parameter :: NSeas = 5 ! Number of seasons + integer, public, parameter :: NLUse = 11 ! Number of land-use types + integer, private, protected :: NHen + + logical, private :: drydep_initialized = .false. + + ! public data members: + + real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) + + integer, public, protected :: n_drydep = 0 ! Number in drypdep list + character(len=32), public, protected :: drydep_list(maxspc) = '' ! List of dry-dep species + + character(len=CS), public, protected :: drydep_fields_token = '' ! First drydep fields token + + real(r8), public, allocatable, protected :: foxd(:) ! reactivity factor for oxidation (dimensioness) + real(r8), public, allocatable, protected :: drat(:) ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) + integer, public, allocatable, protected :: mapping(:) ! mapping to species table + ! --- Indices for each species --- + integer, public, protected :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx + + !--------------------------------------------------------------------------- + ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 + ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 + ! Table 3-5 compiled by P. Hess + ! + ! index #1 : season + ! 1 -> midsummer with lush vegetation + ! 2 -> autumn with unharvested cropland + ! 3 -> late autumn after frost, no snow + ! 4 -> winter, snow on ground, and subfreezing + ! 5 -> transitional spring with partially green short annuals + ! + ! index #2 : landuse type + ! 1 -> urban land + ! 2 -> agricultural land + ! 3 -> range land + ! 4 -> deciduous forest + ! 5 -> coniferous forest + ! 6 -> mixed forest including wetland + ! 7 -> water, both salt and fresh + ! 8 -> barren land, mostly desert + ! 9 -> nonforested wetland + ! 10 -> mixed agricultural and range land + ! 11 -> rocky open areas with low growing shrubs + ! + ! JFL August 2000 + !--------------------------------------------------------------------------- + + !--------------------------------------------------------------------------- + ! table to parameterize the impact of soil moisture on the deposition of H2 and + ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). + !--------------------------------------------------------------------------- + + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_a(NLUse) = & + (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & + 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_b(NLUse) = & + (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & + -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) + !--- deposition of h2 and CO on soils --- + real(r8), parameter, public :: h2_c(NLUse) = & + (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & + 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) + + !--- deposition of h2 and CO on soils + ! + !--- ri: Richardson number (dimensionless) + !--- rlu: Resistance of leaves in upper canopy (s.m-1) + !--- rac: Aerodynamic resistance to lower canopy (s.m-1) + !--- rgss: Ground surface resistance for SO2 (s.m-1) + !--- rgso: Ground surface resistance for O3 (s.m-1) + !--- rcls: Lower canopy resistance for SO2 (s.m-1) + !--- rclo: Lower canopy resistance for O3 (s.m-1) + ! + real(r8), public, protected, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo + + data ri (1,1:NLUse) & + /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ + data rlu (1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rac (1,1:NLUse) & + / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ + data rgss(1,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ + data rgso(1,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(1,1:NLUse) & + /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ + data rclo(1,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ + + data ri (2,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (2,1:NLUse) & + / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ + data rgss(2,1:NLUse) & + / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ + data rgso(2,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ + data rcls(2,1:NLUse) & + /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(2,1:NLUse) & + /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ + + data ri (3,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (3,1:NLUse) & + / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ + data rgss(3,1:NLUse) & + / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ + data rgso(3,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(3,1:NLUse) & + /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rclo(3,1:NLUse) & + /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ + + data ri (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ + data rlu (4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ + data rac (4,1:NLUse) & + / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ + data rgss(4,1:NLUse) & + / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ + data rgso(4,1:NLUse) & + / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ + data rcls(4,1:NLUse) & + /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ + data rclo(4,1:NLUse) & + /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ + + data ri (5,1:NLUse) & + /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ + data rlu (5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rac (5,1:NLUse) & + / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ + data rgss(5,1:NLUse) & + / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ + data rgso(5,1:NLUse) & + / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ + data rcls(5,1:NLUse) & + /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ + data rclo(5,1:NLUse) & + /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ + + !--------------------------------------------------------------------------- + ! ... roughness length + !--------------------------------------------------------------------------- + real(r8), public, protected, dimension(NSeas,NLUse) :: z0 + + data z0 (1,1:NLUse) & + /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ + data z0 (2,1:NLUse) & + /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ + data z0 (3,1:NLUse) & + /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ + data z0 (4,1:NLUse) & + /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ + data z0 (5,1:NLUse) & + /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ + + !--------------------------------------------------------------------------- + ! public chemical data + !--------------------------------------------------------------------------- + + !--- data for foxd (reactivity factor for oxidation) ---- + real(r8), public, protected, allocatable :: dfoxd(:) + + ! PRIVATE DATA: + + Interface shr_drydep_setHCoeff + Module Procedure set_hcoeff_scalar + Module Procedure set_hcoeff_vector + End Interface + + real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- + + !--------------------------------------------------------------------------- + ! private chemical data + !--------------------------------------------------------------------------- + + !--- Names of species that can work with --- + character(len=16), public, protected, allocatable :: species_name_table(:) + + !--- data for effective Henry's Law coefficient --- + real(r8), public, protected, allocatable :: dheff(:,:) + + real(r8), private, parameter :: wh2o = SHR_CONST_MWWV + real(r8), allocatable :: mol_wgts(:) + + character(len=500) :: dep_data_file = 'NONE' ! complete file path + +!=============================================================================== +CONTAINS +!=============================================================================== + + subroutine shr_drydep_readnl(NLFilename, drydep_nflds) + + !======================================================================== + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component + !======================================================================== + + character(len=*), intent(in) :: NLFilename ! Namelist filename + integer, intent(out) :: drydep_nflds + + !----- local ----- + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + character(*),parameter :: F00 = "('(shr_drydep_read) ',8a)" + character(*),parameter :: FI1 = "('(shr_drydep_init) ',a,I2)" + character(*),parameter :: subName = '(shr_drydep_read) ' + !----------------------------------------------------------------------------- + + namelist /drydep_inparm/ drydep_list, dep_data_file + + !----------------------------------------------------------------------------- + ! Read namelist and figure out the drydep field list to pass + ! First check if file exists and if not, n_drydep will be zero + !----------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 )then + call shr_sys_abort( subName//'ERROR: nlfilename not set' ) + end if + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (localPet==0) then + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,F00) 'Read in drydep_inparm namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) + if (ierr == 0) then + ! Note that ierr /= 0, no namelist is present. + read(unitn, drydep_inparm, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort( 'problem on read of drydep_inparm namelist in shr_drydep_readnl') + end if + endif + close( unitn ) + end if + end if + call shr_mpi_bcast( drydep_list, mpicom ) + call shr_mpi_bcast( dep_data_file, mpicom ) + + drydep_nflds = 0 + + do i=1,maxspc + if(len_trim(drydep_list(i)) > 0) then + drydep_nflds=drydep_nflds+1 + endif + enddo + + ! set module variable + n_drydep = drydep_nflds + + if (localpet==0) then + if ( drydep_nflds == 0 )then + write(s_logunit,F00) 'No dry deposition fields will be transfered' + else + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds + end if + end if + + if (.not. drydep_initialized) then + call shr_drydep_init() + end if + + end subroutine shr_drydep_readnl + +!==================================================================================== + + subroutine shr_drydep_init( ) + + use shr_pio_mod, only: shr_pio_getiosys, shr_pio_getiotype + use pio + use netcdf + + !======================================================================== + ! Initialization of dry deposition fields + ! reads drydep_inparm namelist and sets up CCSM driver list of fields for + ! land-atmosphere communications. + !======================================================================== + + !----- local ----- + integer :: i, l ! Indices + character(len=32) :: test_name ! field test name + integer :: dimid, varid, fileid + type(ESMF_VM) :: vm + integer :: localPet + integer :: mpicom + integer :: rc + + !----- formats ----- + character(*),parameter :: subName = '(shr_drydep_init) ' + character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" + + !----------------------------------------------------------------------------- + ! Return if this routine has already been called (e.g. cam and clm both call this) + !----------------------------------------------------------------------------- + if(allocated(foxd)) return + + if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + rc = nf90_noerr + + if (localPet==0) then + rc = nf90_open(path=trim(dep_data_file), mode=nf90_nowrite, ncid=fileid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: not able to open file: '//trim(dep_data_file)) + + rc = nf90_inq_dimid(fileid,'n_species_table',dimid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid n_species_table') + + rc = nf90_inquire_dimension(fileid,dimid,len=n_species_table) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension n_species_table') + + rc = nf90_inq_dimid(fileid,'NHen',dimid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_dimid NHen') + + rc = nf90_inquire_dimension(fileid,dimid,len=nHen) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inquire_dimension nHen') + endif + call shr_mpi_bcast( n_species_table, mpicom ) + call shr_mpi_bcast( nHen, mpicom ) + + allocate( mol_wgts(n_species_table) ) + allocate( dfoxd(n_species_table) ) + allocate( species_name_table(n_species_table) ) + allocate( dheff(nhen,n_species_table)) + + if (localPet==0) then + rc = nf90_inq_varid(fileid,'mol_wghts',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid mol_wghts') + rc = nf90_get_var(fileid,varid,mol_wgts) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var mol_wgts') + + rc = nf90_inq_varid(fileid,'dfoxd',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dfoxd') + rc = nf90_get_var(fileid,varid,dfoxd) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dfoxd') + + rc = nf90_inq_varid(fileid,'species_name_table',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid species_name_table') + rc = nf90_get_var(fileid,varid,species_name_table) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var species_name_table') + + rc = nf90_inq_varid(fileid,'dheff',varid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_inq_varid dheff') + rc = nf90_get_var(fileid,varid,dheff) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_get_var dheff') + + rc = nf90_close(fileid) + if (rc/=nf90_noerr) call shr_sys_abort(subName//' ERROR: nf90_close') + end if + call shr_mpi_bcast( mol_wgts, mpicom ) + call shr_mpi_bcast( dfoxd, mpicom ) + call shr_mpi_bcast( species_name_table, mpicom ) + call shr_mpi_bcast( dheff, mpicom ) + + !----------------------------------------------------------------------------- + ! Allocate and fill foxd, drat and mapping as well as species indices + !----------------------------------------------------------------------------- + + if ( n_drydep > 0 ) then + + allocate( foxd(n_drydep) ) + allocate( drat(n_drydep) ) + allocate( mapping(n_drydep) ) + + ! This initializes these variables to infinity. + foxd = shr_infnan_posinf + drat = shr_infnan_posinf + + mapping(:) = 0 + + end if + + h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 + + !--- Loop over drydep species that need to be worked with --- + do i=1,n_drydep + if ( len_trim(drydep_list(i))==0 ) exit + + test_name = drydep_list(i) + + if( trim(test_name) == 'O3' ) then + test_name = 'OX' + end if + + !--- Figure out if species maps to a species in the species table --- + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + + !--- If it doesn't map to a species in the species table find species close enough --- + if( mapping(i) < 1 ) then + select case( trim(test_name) ) + case( 'O3S', 'O3INERT' ) + test_name = 'OX' + case( 'Pb' ) + test_name = 'HNO3' + case( 'SOGM','SOGI','SOGT','SOGB','SOGX' ) + test_name = 'CH3OOH' + case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) + test_name = 'OX' ! this is just a place holder. values are explicitly set below + case( 'SOAGbb0' ) + test_name = 'SOAGff0' + case( 'SOAGbb1' ) + test_name = 'SOAGff1' + case( 'SOAGbb2' ) + test_name = 'SOAGff2' + case( 'SOAGbb3' ) + test_name = 'SOAGff3' + case( 'SOAGbb4' ) + test_name = 'SOAGff4' + case( 'O3A' ) + test_name = 'OX' + case( 'XMPAN' ) + test_name = 'MPAN' + case( 'XPAN' ) + test_name = 'PAN' + case( 'XNO' ) + test_name = 'NO' + case( 'XNO2' ) + test_name = 'NO2' + case( 'XHNO3' ) + test_name = 'HNO3' + case( 'XONIT' ) + test_name = 'ONIT' + case( 'XONITR' ) + test_name = 'ONITR' + case( 'XHO2NO2') + test_name = 'HO2NO2' + case( 'XNH4NO3' ) + test_name = 'HNO3' + case( 'NH4NO3' ) + test_name = 'HNO3' + case default + test_name = 'blank' + end select + + !--- If found a match check the species table again --- + if( trim(test_name) /= 'blank' ) then + do l = 1,n_species_table + if( trim( test_name ) == trim( species_name_table(l) ) ) then + mapping(i) = l + exit + end if + end do + else + write(s_logunit,F00) trim(drydep_list(i)),' not in tables; will have dep vel = 0' + call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) + end if + end if + + !--- Figure out the specific species indices --- + if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i + if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i + if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i + if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i + if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i + if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i + if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i + if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i + if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i + + if( mapping(i) > 0) then + l = mapping(i) + foxd(i) = dfoxd(l) + drat(i) = sqrt(mol_wgts(l)/wh2o) + endif + + enddo + + where( rgss < 1._r8 ) + rgss = 1._r8 + endwhere + + where( rac < small_value) + rac = small_value + endwhere + + drydep_initialized = .true. + + end subroutine shr_drydep_init + +!==================================================================================== + + subroutine set_hcoeff_scalar( sfc_temp, heff ) + + !======================================================================== + ! Interface to shr_drydep_setHCoeff when input is scalar + ! wrapper routine used when surface temperature is a scalar (single column) rather + ! than an array (multiple columns). + ! + ! !REVISION HISTORY: + ! 2008-Nov-12 - F. Vitt - first version + !======================================================================== + + implicit none + + real(r8), intent(in) :: sfc_temp ! Input surface temperature + real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients + + !----- local ----- + real(r8) :: sfc_temp_tmp(1) ! surface temp + + sfc_temp_tmp(:) = sfc_temp + call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) + + end subroutine set_hcoeff_scalar + +!==================================================================================== + + subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) + + !======================================================================== + ! Interface to shr_drydep_setHCoeff when input is vector + ! sets dry depositions coefficients -- used by both land and atmosphere models + !======================================================================== + + integer, intent(in) :: ncol ! Input size of surface-temp vector + real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature + real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients + + !----- local ----- + real(r8), parameter :: t0 = 298._r8 ! Standard Temperature + real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH + integer :: m, l ! indices + real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) + real(r8) :: dhr ! temperature dependence of Henry's law coefficient + real(r8) :: dk1s(ncol) ! DK Work array 1 + real(r8) :: dk2s(ncol) ! DK Work array 2 + real(r8) :: wrk(ncol) ! Work array + + !----- formats ----- + character(*),parameter :: subName = '(shr_drydep_set_hcoeff) ' + character(*),parameter :: F00 = "('(shr_drydep_set_hcoeff) ',8a)" + + !------------------------------------------------------------------------------- + ! notes: + !------------------------------------------------------------------------------- + + wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) + do m = 1,n_drydep + l = mapping(m) + e298 = dheff(1,l) + dhr = dheff(2,l) + heff(:,m) = e298*exp( dhr*wrk(:) ) + !--- Calculate coefficients based on the drydep tables --- + if( dheff(3,l) /= 0._r8 .and. dheff(5,l) == 0._r8 ) then + e298 = dheff(3,l) + dhr = dheff(4,l) + dk1s(:) = e298*exp( dhr*wrk(:) ) + where( heff(:,m) /= 0._r8 ) + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) + elsewhere + heff(:,m) = dk1s(:)*ph_inv + endwhere + end if + !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- + if( dheff(5,l) /= 0._r8 ) then + if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' .or. trim( drydep_list(m) ) == 'SO2' ) then + e298 = dheff(3,l) + dhr = dheff(4,l) + dk1s(:) = e298*exp( dhr*wrk(:) ) + e298 = dheff(5,l) + dhr = dheff(6,l) + dk2s(:) = e298*exp( dhr*wrk(:) ) + !--- For Carbon dioxide --- + if( trim(drydep_list(m)) == 'CO2'.or. trim( drydep_list(m) ) == 'SO2' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv*(1._r8 + dk2s(:)*ph_inv)) + !--- For NH3 --- + else if( trim( drydep_list(m) ) == 'NH3' ) then + heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) + !--- This can't happen --- + else + write(s_logunit,F00) 'Bad species ',drydep_list(m) + call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) + end if + end if + end if + end do + + end subroutine set_hcoeff_vector + +!=============================================================================== + +end module shr_drydep_mod diff --git a/cime_config/buildnml b/cime_config/buildnml index 23354c522..fd5d73df0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -107,10 +107,10 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) #-------------------------------- - # Overwrite: wav-ice coupling (assumes cice6 as the ice component + # Set default wav-ice coupling (assumes cice6 as the ice component #-------------------------------- if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.set_value('wavice_coupling', value='.true.') + nmlgen.add_default('wavice_coupling', value='.true.') #-------------------------------- # Overwrite: set brnch_retain_casename diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index b8909947b..923e9afa8 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -340,7 +340,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end ndays run_begin_stop_restart env_run.xml @@ -372,7 +372,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end $STOP_OPTION run_begin_stop_restart env_run.xml @@ -404,7 +404,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears never run_begin_stop_restart env_run.xml diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index b3becd832..cfcdc12ef 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -422,11 +422,11 @@ run_coupling env_run.xml - OPTION1 (like RASM_OPTION1 in CPL7) runs prep_ocn_avg, + OPTION1 (like RASM_OPTION1 in CPL7) runs prep_ocn_avg, BEFORE the aoflux and ocnalb calculations, thereby reducing most of the lags and field inconsistency but still allowing the ocean to run concurrently with the ice and atmosphere. - OPTION2 (like CESM1_MOD in CPL7) runs prep_ocn_avg, + OPTION2 (like CESM1_MOD in CPL7) runs prep_ocn_avg, AFTER the aoflux and ocnalb calculations, thereby permitting maximum concurrency TIGHT (like CESM1_MOD_TIGHT), is a tight coupling run sequence @@ -439,7 +439,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end never med_history env_run.xml @@ -468,7 +468,7 @@ char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end never nmonths diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index a535a0fa6..e35ff537d 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -894,7 +894,17 @@ ogrid - + + integer + control + MED_attributes + + atm/ocn flux calculation scheme + + + 0 + + real control @@ -1062,23 +1072,22 @@ char time ALLCOMP_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history snapshot option (used with history_n and history_ymd) set by HIST_OPTION in env_run.xml. history_option alarms are: [none/never], turns option off - [nstep/s] , history snapshot every history_n nsteps , relative to current run start time - [nsecond/s] , history snapshot every history_n nseconds, relative to current run start time - [nminute/s] , history snapshot every history_n nminutes, relative to current run start time - [nhour/s] , history snapshot every history_n nhours , relative to current run start time - [nday/s] , history snapshot every history_n ndays , relative to current run start time - [monthly/s] , history snapshot every month , relative to current run start time - [nmonth/s] , history snapshot every history_n nmonths , relative to current run start time - [nyear/s] , history snapshot every history_n nyears , relative to current run start time - [date] , history snapshot at history_ymd value - [ifdays0] , history snapshot at history_n calendar day value and seconds equal 0 - [end] , history snapshot at end + [nsteps] , history snapshot every history_n nsteps , relative to current run start time + [nseconds] , history snapshot every history_n nseconds, relative to current run start time + [nminutes] , history snapshot every history_n nminutes, relative to current run start time + [nhours] , history snapshot every history_n nhours , relative to current run start time + [ndays] , history snapshot every history_n ndays , relative to current run start time + [monthly] , history snapshot every month , relative to current run start time + [nmonths] , history snapshot every history_n nmonths , relative to current run start time + [nyears] , history snapshot every history_n nyears , relative to current run start time + [date] , history snapshot at history_ymd value + [end] , history snapshot at end $HIST_OPTION @@ -1119,7 +1128,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for mediator aoflux and oceean albedoes (used with history_n and history_ymd) @@ -1147,7 +1156,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for atm import/export/fields snapshot option (used with history_n and history_ymd) @@ -1170,7 +1179,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1529,7 +1538,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for ice import/export/fields snapshot option (used with history_n and history_ymd) @@ -1552,7 +1561,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1580,7 +1589,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for glc import/export/fields snapshot option (used with history_n and history_ymd) @@ -1603,7 +1612,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1631,7 +1640,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for lnd import/export/fields snapshot option (used with history_n and history_ymd) @@ -1654,7 +1663,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1760,7 +1769,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for ocn import/export/fields snapshot option (used with history_n and history_ymd) @@ -1783,7 +1792,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1811,7 +1820,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for rof import/export/fields snapshot option (used with history_n and history_ymd) @@ -1834,7 +1843,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -1927,7 +1936,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator history for wav import/export/fields snapshot option (used with history_n and history_ymd) @@ -1950,7 +1959,7 @@ char time MED_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end mediator time average history option (used with histavg_n and histavg_ymd) @@ -2580,22 +2589,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,monthly,nmonths,nyears,date,end sets the run length with stop_n and stop_ymd stop_option alarms are: - [none/never], turns option off - [nstep/s] , stops every stop_n nsteps , relative to current run start time - [nsecond/s] , stops every stop_n nseconds, relative to current run start time - [nminute/s] , stops every stop_n nminutes, relative to current run start time - [nhour/s] , stops every stop_n nhours , relative to current run start time - [nday/s] , stops every stop_n ndays , relative to current run start time - [nmonth/s] , stops every stop_n nmonths , relative to current run start time - [monthly/s] , stops every month , relative to current run start time - [nyear/s] , stops every stop_n nyears , relative to current run start time - [date] , stops at stop_ymd value - [ifdays0] , stops at stop_n calendar day value and seconds equal 0 - [end] , stops at end + [none/never] , turns option off + [nsteps] , stops every stop_n nsteps , relative to current run start time + [nseconds] , stops every stop_n nseconds, relative to current run start time + [nminutes] , stops every stop_n nminutes, relative to current run start time + [nhours] , stops every stop_n nhours , relative to current run start time + [ndays] , stops every stop_n ndays , relative to current run start time + [nmonths] , stops every stop_n nmonths , relative to current run start time + [nyears] , stops every stop_n nyears , relative to current run start time + [monthly] , stops every month , relative to current run start time + [yearly] , stops every year , relative to current run start time + [end] , stops at end + [date] , stops at stop_ymd value $STOP_OPTION @@ -2644,22 +2653,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,monthly,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end sets the restart frequency with restart_n and restart_ymd restart_option alarms are: [none/never], turns option off - [nstep/s] , restarts every restart_n nsteps , relative to current run start time - [nsecond/s] , restarts every restart_n nseconds, relative to current run start time - [nminute/s] , restarts every restart_n nminutes, relative to current run start time - [nhour/s] , restarts every restart_n nhours , relative to current run start time - [nday/s] , restarts every restart_n ndays , relative to current run start time - [monthly/s] , restarts every month , relative to current run start time - [nmonth/s] , restarts every restart_n nmonths , relative to current run start time - [nyear/s] , restarts every restart_n nyears , relative to current run start time - [date] , restarts at restart_ymd value - [ifdays0] , restarts at restart_n calendar day value and seconds equal 0 - [end] , restarts at end + [nsteps] , restarts every restart_n nsteps , relative to current run start time + [nseconds] , restarts every restart_n nseconds, relative to current run start time + [nminutes] , restarts every restart_n nminutes, relative to current run start time + [nhours] , restarts every restart_n nhours , relative to current run start time + [ndays] , restarts every restart_n ndays , relative to current run start time + [nmonths] , restarts every restart_n nmonths , relative to current run start time + [nyears] , restarts every restart_n nyears , relative to current run start time + [monthly] , restarts every month , relative to current run start time + [yearly] , restarts every year , relative to current run start time + [date] , restarts at restart_ymd value + [end] , restarts at end $REST_OPTION @@ -2711,22 +2720,22 @@ char time CLOCK_attributes - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,monthly,nmonths,nmonth,nyears,nyear,date,ifdays0,end + none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,monthly,yearly,date,end Sets timing output file frequency (like rest_option but relative to run start date) tprof_option alarms are: [none/never], turns option off - [nstep/s] , every tprof_n nsteps , relative to current run start time - [nsecond/s] , every tprof_n nseconds, relative to current run start time - [nminute/s] , every tprof_n nminutes, relative to current run start time - [nhour/s] , every tprof_n nhours , relative to current run start time - [nday/s] , every tprof_n ndays , relative to current run start time - [monthly/s] , every month , relative to current run start time - [nmonth/s] , every tprof_n nmonths , relative to current run start time - [nyear/s] , every tprof_n nyears , relative to current run start time - [date] , at tprof_ymd value - [ifdays0] , at tprof_n calendar day value and seconds equal 0 - [end] , at end + [nsteps] , every tprof_n nsteps , relative to current run start time + [nseconds] , every tprof_n nseconds, relative to current run start time + [nminutes] , every tprof_n nminutes, relative to current run start time + [nhours] , every tprof_n nhours , relative to current run start time + [ndays] , every tprof_n ndays , relative to current run start time + [nmonths] , every tprof_n nmonths , relative to current run start time + [nyears] , every tprof_n nyears , relative to current run start time + [monthly] , every month , relative to current run start time + [yearly] , every year , relative to current run start time + [date] , at tprof_ymd value + [end] , at end never @@ -2761,19 +2770,19 @@ - + - - - - - - - - + + + + + + + + @@ -3689,105 +3698,105 @@ components that need to look at the same data. - Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in + Buildconf/camconf/drv_flds_in,Buildconf/clmconf/drv_flds_in,Buildconf/datmconf/drv_flds_in - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component atm + + + $DATA_ASSIMILATION_ATM + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component CPL + + + $DATA_ASSIMILATION_CPL + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component ocn + + + $DATA_ASSIMILATION_OCN + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component wav + + + $DATA_ASSIMILATION_WAV + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component glc + + + $DATA_ASSIMILATION_GLC + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component rof + + + $DATA_ASSIMILATION_ROF + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component ice + + + $DATA_ASSIMILATION_ICE + + - - - - - - - - - - - + + logical + data_assimilation + ALLCOMP_attributes + + Whether Data Assimilation is on for component lnd + + + $DATA_ASSIMILATION_LND + + logical diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index beceb238c..b8d96bcd6 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -62,27 +62,23 @@ - - char + + char(300) dry-deposition drydep_inparm - xactive_lnd,xactive_atm,table - Where dry deposition is calculated (from land, atmosphere, or from a table) - This specifies the method used to calculate dry - deposition velocities of gas-phase chemical species. The available methods are: - 'table' - prescribed method in CAM - 'xactive_atm' - interactive method in CAM - 'xactive_lnd' - interactive method in CLM + List of species that undergo dry deposition. - - char(300) - dry-deposition + + char + abs + drv_flds_in drydep_inparm - List of species that undergo dry deposition. + Full pathname of file containing gas phase deposition data including effective + Henry's law coefficients. diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 9bf8062eb..48ac2a2ed 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -291,6 +291,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_map) call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_map) call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_map) + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_map) if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_map) end if diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 302142b1a..a2a2dbdac 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -27,7 +27,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : mastertask, logunit - use med_internalstate_mod , only : compmed, compatm, compocn, compice, comprof, compwav, ncomps + use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use med_internalstate_mod , only : mapconsf_aofrac, mapbilnr_nstod @@ -94,6 +94,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice)) call addfld(fldListFr(compice)%flds, 'Si_imask') if (is_local%wrap%comp_present(compocn)) call addfld(fldListFr(compocn)%flds, 'So_omask') + if (is_local%wrap%comp_present(complnd)) call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') else if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then @@ -185,6 +186,10 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then call addfld(fldListFr(compatm)%flds, 'Sa_ofrac') end if + ! lfrac used by atm + if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') + end if end if ! to atm: unmerged from ice @@ -249,6 +254,20 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if + ! to atm: unmerged surface temperatures from lnd + if (phase == 'advertise') then + if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then + call addfld(fldListFr(complnd)%flds, 'Sl_t') + call addfld(fldListTo(compatm)%flds, 'Sl_t') + end if + else + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, maptype, 'lfrin', 'unset') + call addmrg(fldListTo(compatm)%flds, 'Sl_t', mrg_from=complnd, mrg_fld='Sl_t', mrg_type='copy') + end if + end if + ! to atm: unmerged from mediator, merge will be done under FV3/CCPP composite step ! - zonal surface stress, meridional surface stress ! - surface latent heat flux, @@ -729,6 +748,44 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end do deallocate(flds) + !===================================================================== + ! FIELDS TO LAND (complnd) + !===================================================================== + + ! to lnd - states and fluxes from atm + if ( trim(coupling_mode) == 'nems_orig_data') then + allocate(flds(21)) + flds = (/'Sa_z ', 'Sa_topo ', 'Sa_tbot ', 'Sa_pbot ', & + 'Sa_shum ', 'Sa_u ', 'Sa_v ', 'Faxa_lwdn ', & + 'Sa_ptem ', 'Sa_dens ', 'Faxa_swdn ', 'Sa_pslv ', & + 'Faxa_snowc', 'Faxa_snowl', 'Faxa_rainc', 'Faxa_rainl', & + 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swvdf', & + 'Faxa_swnet'/) + else + allocate(flds(18)) + flds = (/'Sa_z ', 'Sa_ta ', 'Sa_pslv ', 'Sa_qa ', & + 'Sa_ua ', 'Sa_va ', 'Faxa_swdn ', 'Faxa_lwdn ', & + 'Faxa_swnet', 'Faxa_rain ', 'Sa_prsl ', 'vfrac ', & + 'Faxa_snow ', 'Faxa_rainc', 'Sa_tskn ', 'Sa_exner ', & + 'Sa_ustar ', 'zorl ' /) + end if + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + end if + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, maptype, 'one', 'unset') + call addmrg(fldListTo(complnd)%flds, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + end if + end if + end do + deallocate(flds) + end subroutine esmFldsExchange_nems end module esmFldsExchange_nems_mod diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 08519c3bc..178eb15ec 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -340,7 +340,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, compname + use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, complnd, compname use med_internalstate_mod , only : coupling_mode, dststatus_print use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -400,6 +400,12 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, dstMaskValue = ispval_mask endif end if + if (trim(coupling_mode(1:4)) == 'nems') then + if (n1 == compatm .and. n2 == complnd) then + srcMaskValue = ispval_mask + dstMaskValue = ispval_mask + end if + end if if (trim(coupling_mode) == 'hafs') then if (n1 == compatm .and. n2 == compwav) then srcMaskValue = ispval_mask diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 582a622a4..c0c442a7f 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -398,6 +398,12 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) else ocn_surface_flux_scheme = 0 end if +#ifdef CESMCOUPLED + if (mastertask) then + write(logunit,*) + write(logunit,'(a)') trim(subname)//' ocn_surface_flux_scheme is '//trim(cvalue) + end if +#endif ! bottom level potential temperature and/or botom level density ! will need to be computed if not received from the atm @@ -1050,7 +1056,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) nMax=aoflux_in%lsize, & zbot=aoflux_in%zbot, ubot=aoflux_in%ubot, vbot=aoflux_in%vbot, thbot=aoflux_in%thbot, qbot=aoflux_in%shum, & s16O=aoflux_in%shum_16O, sHDO=aoflux_in%shum_HDO, s18O=aoflux_in%shum_18O, rbot=aoflux_in%dens, & - tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, ts=aoflux_in%tocn, & + tbot=aoflux_in%tbot, us=aoflux_in%uocn, vs=aoflux_in%vocn, pslv=aoflux_in%psfc, ts=aoflux_in%tocn, & mask=aoflux_in%mask, seq_flux_atmocn_minwind=0.5_r8, & sen=aoflux_out%sen, lat=aoflux_out%lat, lwup=aoflux_out%lwup, & r16O=aoflux_in%roce_16O, rhdo=aoflux_in%roce_HDO, r18O=aoflux_in%roce_18O, & @@ -1507,6 +1513,8 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r ! Set pointers for aoflux_in attributes ! Note that if computation is on the xgrid, fldbun_a and fldbun_o are both fldbun_x + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk + ! input/output variables type(ESMF_FieldBundle) , intent(inout) :: fldbun_a type(ESMF_FieldBundle) , intent(inout) :: fldbun_o @@ -1575,6 +1583,11 @@ subroutine set_aoflux_in_pointers(fldbun_a, fldbun_o, aoflux_in, lsize, xgrid, r if (chkerr(rc,__LINE__,u_FILE_u)) return end if + if (FB_fldchk(fldbun_a, 'Sa_pslv', rc=rc)) then + call fldbun_getfldptr(fldbun_a, 'Sa_pslv', aoflux_in%psfc, xgrid=xgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + ! if either density or potential temperature are computed, will need bottom level pressure if (compute_atm_dens .or. compute_atm_thbot) then call fldbun_getfldptr(fldbun_a, 'Sa_pbot', aoflux_in%pbot, xgrid=xgrid, rc=rc) diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 81114c1bf..ed1181f99 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -4,7 +4,8 @@ module med_phases_prep_lnd_mod ! Mediator phases for preparing land export from mediator !----------------------------------------------------------------------------- - use med_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_kind_mod, only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 + use med_methods_mod, only : fldchk => med_methods_FB_FldChk implicit none private @@ -21,7 +22,7 @@ module med_phases_prep_lnd_mod subroutine med_phases_prep_lnd(gcomp, rc) use NUOPC , only : NUOPC_CompAttributeGet - use ESMF , only : operator(/=) + use ESMF , only : operator(/=), operator(==) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet @@ -49,6 +50,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) real(r8) :: tmp(1) real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. + logical :: field_found real(r8), pointer :: dataptr_scalar_lnd(:,:) real(r8), pointer :: dataptr_scalar_atm(:,:) character(len=*), parameter :: subname='(med_phases_prep_lnd)' @@ -91,9 +93,15 @@ subroutine med_phases_prep_lnd(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//trim(subname)//' merge') + ! check cpl_scalars is in the state or not? fix for land components that do not have cpl_scalars + call ESMF_StateGet(is_local%wrap%NStateExp(complnd), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + field_found = .true. + if (itemType == ESMF_STATEITEM_NOTFOUND) field_found = .false. + ! obtain nextsw_cday from atm if it is in the import state and send it to lnd scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. mastertask) then + if (scalar_id > 0 .and. field_found .and. mastertask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 6204c6a21..d83aeb29b 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -1234,7 +1234,7 @@ name = MED_typedefs type = module relative_path = ../../../../../FV3/ccpp/physics/physics - dependencies = machine.F,physcons.F90,physparam.f + dependencies = machine.F,physcons.F90 [ccpp-arg-table] name = MED_typedefs