camsrfexch.F90

Go to the documentation of this file.

!> \file
!! \brief Data types for exchange between CAM and coupler components.
!!
!! Module to handle data that is exchanged between the CAM atmosphere
!! model and the surface models (land, sea-ice, and ocean).

module camsrfexch

use shr_kind_mod,  only: r8 => shr_kind_r8, r4 => shr_kind_r4
use constituents,  only: pcnst
use ppgrid,        only: pcols, begchunk, endchunk
use phys_grid,     only: get_ncols_p, phys_grid_initialized
use infnan,        only: posinf, assignment(=)
use abortutils,    only: endrun
use cam_logfile,   only: iulog

implicit none
private

! Public interfaces

public atm2hub_alloc              ! Atmosphere to surface data allocation method
public hub2atm_alloc              ! Merged hub surface to atmosphere data allocation method
public hub2atm_setopts            ! Set options to allocate optional parts of data type
public atm2hub_deallocate
public hub2atm_deallocate
public cam_export

!> \struct cam_out_t
!! \brief CAM export state
!!
!! Container for the data sent from the atmosphere to the coupler component

type, public :: cam_out_t 
   integer  :: lchnk               !< chunk index
   integer  :: ncol                !< number of columns in chunk
   real(r8) :: tbot(pcols)         !< bot level temperature
   real(r8) :: zbot(pcols)         !< bot level height above surface
   real(r8) :: ubot(pcols)         !< bot level u wind
   real(r8) :: vbot(pcols)         !< bot level v wind
   real(r8) :: qbot(pcols,pcnst)   !< bot level specific humidity
   real(r8) :: pbot(pcols)         !< bot level pressure
   real(r8) :: rho(pcols)          !< bot level density  
   real(r8) :: netsw(pcols)        !   
   real(r8) :: flwds(pcols)        ! 
   real(r8) :: precsc(pcols)       !
   real(r8) :: precsl(pcols)       !
   real(r8) :: precc(pcols)        ! 
   real(r8) :: precl(pcols)        ! 
   real(r8) :: soll(pcols)         ! 
   real(r8) :: sols(pcols)         ! 
   real(r8) :: solld(pcols)        !
   real(r8) :: solsd(pcols)        !
   real(r8) :: thbot(pcols)        ! 
   real(r8) :: co2prog(pcols)      !< prognostic co2
   real(r8) :: co2diag(pcols)      !< diagnostic co2
   real(r8) :: psl(pcols)
   real(r8) :: bcphiwet(pcols)     !< wet deposition of hydrophilic black carbon
   real(r8) :: bcphidry(pcols)     !< dry deposition of hydrophilic black carbon
   real(r8) :: bcphodry(pcols)     !< dry deposition of hydrophobic black carbon
   real(r8) :: ocphiwet(pcols)     !< wet deposition of hydrophilic organic carbon
   real(r8) :: ocphidry(pcols)     !< dry deposition of hydrophilic organic carbon
   real(r8) :: ocphodry(pcols)     !< dry deposition of hydrophobic organic carbon
   real(r8) :: dstwet1(pcols)      !< wet deposition of dust (bin1)
   real(r8) :: dstdry1(pcols)      !< dry deposition of dust (bin1)
   real(r8) :: dstwet2(pcols)      !< wet deposition of dust (bin2)
   real(r8) :: dstdry2(pcols)      !< dry deposition of dust (bin2)
   real(r8) :: dstwet3(pcols)      !< wet deposition of dust (bin3)
   real(r8) :: dstdry3(pcols)      !< dry deposition of dust (bin3)
   real(r8) :: dstwet4(pcols)      !< wet deposition of dust (bin4)
   real(r8) :: dstdry4(pcols)      !< dry deposition of dust (bin4)
end type cam_out_t 

!> \struct cam_in_t
!! \brief CAM import state
!!
!! Container for the data sent to the atmosphere from the coupler component.
!! This is the merged state of sea-ice, land and ocean.

type, public :: cam_in_t    
   integer  :: lchnk                   !< chunk index
   integer  :: ncol                    !< number of active columns
   real(r8) :: asdir(pcols)            !< albedo: shortwave, direct
   real(r8) :: asdif(pcols)            !< albedo: shortwave, diffuse
   real(r8) :: aldir(pcols)            !< albedo: longwave, direct
   real(r8) :: aldif(pcols)            !< albedo: longwave, diffuse
   real(r8) :: lwup(pcols)             !< longwave up radiative flux
   real(r8) :: lhf(pcols)              !< latent heat flux
   real(r8) :: shf(pcols)              !< sensible heat flux
   real(r8) :: wsx(pcols)              !< surface u-stress (N)
   real(r8) :: wsy(pcols)              !< surface v-stress (N)
   real(r8) :: tref(pcols)             !< ref height surface air temp
   real(r8) :: qref(pcols)             !< ref height specific humidity 
   real(r8) :: u10(pcols)              !< 10m wind speed
   real(r8) :: ts(pcols)               !< merged surface temp 
   real(r8) :: sst(pcols)              !< sea surface temp
   real(r8) :: snowhland(pcols)        !< snow depth (liquid water equivalent) over land 
   real(r8) :: snowhice(pcols)         !< snow depth over ice
   real(r8) :: fco2_lnd(pcols)         !< co2 flux from lnd
   real(r8) :: fco2_ocn(pcols)         !< co2 flux from ocn
   real(r8) :: fdms(pcols)             !< dms flux
   real(r8) :: landfrac(pcols)         !< land area fraction
   real(r8) :: icefrac(pcols)          !< sea-ice areal fraction
   real(r8) :: ocnfrac(pcols)          !< ocean areal fraction
   real(r8), pointer, dimension(:) :: ram1  !< aerodynamical resistance (s/m) (pcols)
   real(r8), pointer, dimension(:) :: fv    !< friction velocity (m/s) (pcols)
   real(r8), pointer, dimension(:) :: soilw !< volumetric soil water (m3/m3)
   real(r8) :: cflx(pcols,pcnst)       !< constituent flux (evap)
   real(r8) :: ustar(pcols)            !< atm/ocn saved version of ustar
   real(r8) :: re(pcols)               !< atm/ocn saved version of re
   real(r8) :: ssq(pcols)              !< atm/ocn saved version of ssq
   real(r8), pointer, dimension(:,:) :: depvel !< deposition velocities
end type cam_in_t    

logical :: dust = .false.     !< .true. => aerosol dust package is being used

!===============================================================================
CONTAINS
!===============================================================================

!> \brief Initialize objects of type cam_in_t
!! \param cam_in object of type cam_in_t

subroutine hub2atm_alloc( cam_in )
   use seq_drydep_mod, only : lnd_drydep, n_drydep
   use cam_cpl_indices, only: index_x2a_sl_soilw

   ! ARGUMENTS:
   type(cam_in_t), pointer ::  cam_in(:)     ! Merged surface state

   ! LOCAL VARIABLES:
   integer :: c        ! chunk index
   integer :: ierror   ! Error code
   !----------------------------------------------------------------------- 

   if ( .not. phys_grid_initialized() ) call endrun( "HUB2ATM_ALLOC error: phys_grid not called yet" )
   allocate (cam_in(begchunk:endchunk), stat=ierror)
   if ( ierror /= 0 )then
      write(iulog,*) 'Allocation error: ', ierror
      call endrun('HUB2ATM_ALLOC error: allocation error')
   end if

   do c = begchunk,endchunk
      nullify(cam_in(c)%ram1)
      nullify(cam_in(c)%fv)
      nullify(cam_in(c)%soilw)
      nullify(cam_in(c)%depvel)
   enddo
   if ( dust ) then
      do c = begchunk,endchunk 
         allocate (cam_in(c)%ram1(pcols), stat=ierror)
         if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error ram1')
         allocate (cam_in(c)%fv(pcols), stat=ierror)
         if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error fv')
         if (index_x2a_sl_soilw /= 0) then
            allocate (cam_in(c)%soilw(pcols), stat=ierror)
            if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error soilw')
         end if
      end do
   endif  !dust

   if (lnd_drydep .and. n_drydep>0) then
      do c = begchunk,endchunk 
         allocate (cam_in(c)%depvel(pcols,n_drydep), stat=ierror)
         if ( ierror /= 0 ) call endrun('HUB2ATM_ALLOC error: allocation error depvel')
      end do
   endif
          
   do c = begchunk,endchunk
      cam_in(c)%lchnk = c
      cam_in(c)%ncol  = get_ncols_p(c)
      cam_in(c)%asdir    (:) = 0._r8
      cam_in(c)%asdif    (:) = 0._r8
      cam_in(c)%aldir    (:) = 0._r8
      cam_in(c)%aldif    (:) = 0._r8
      cam_in(c)%lwup     (:) = 0._r8
      cam_in(c)%lhf      (:) = 0._r8
      cam_in(c)%shf      (:) = 0._r8
      cam_in(c)%wsx      (:) = 0._r8
      cam_in(c)%wsy      (:) = 0._r8
      cam_in(c)%tref     (:) = 0._r8
      cam_in(c)%qref     (:) = 0._r8
      cam_in(c)%u10      (:) = 0._r8
      cam_in(c)%ts       (:) = 0._r8
      cam_in(c)%sst      (:) = 0._r8
      cam_in(c)%snowhland(:) = 0._r8
      cam_in(c)%snowhice (:) = 0._r8
      cam_in(c)%fco2_lnd (:) = 0._r8
      cam_in(c)%fco2_ocn (:) = 0._r8
      cam_in(c)%fdms     (:) = 0._r8
      cam_in(c)%landfrac (:) = posinf
      cam_in(c)%icefrac  (:) = posinf
      cam_in(c)%ocnfrac  (:) = posinf
      if ( dust ) then
         cam_in(c)%ram1  (:) = 0.1_r8
         cam_in(c)%fv    (:) = 0.1_r8
         if (associated(cam_in(c)%soilw)) &
            cam_in(c)%soilw (:) = 0.0_r8
      endif
      cam_in(c)%cflx   (:,:) = 0._r8
      cam_in(c)%ustar    (:) = 0._r8
      cam_in(c)%re       (:) = 0._r8
      cam_in(c)%ssq      (:) = 0._r8
      if (lnd_drydep .and. n_drydep>0) then
         cam_in(c)%depvel (:,:) = 0._r8
      endif
   end do

end subroutine hub2atm_alloc

!===============================================================================

!> \brief Initialize objects of type cam_out_t
!! \param cam_out object of type cam_out_t

subroutine atm2hub_alloc( cam_out )

   ! ARGUMENTS:
   type(cam_out_t), pointer :: cam_out(:)    ! Atmosphere to surface input

   ! LOCAL VARIABLES:
   integer :: c            ! chunk index
   integer :: ierror       ! Error code
   !----------------------------------------------------------------------- 

   if ( .not. phys_grid_initialized() ) call endrun( "ATM2HUB_ALLOC error: phys_grid not called yet" )
   allocate (cam_out(begchunk:endchunk), stat=ierror)
   if ( ierror /= 0 )then
      write(iulog,*) 'Allocation error: ', ierror
      call endrun('ATM2HUB_ALLOC error: allocation error')
   end if

   do c = begchunk,endchunk
      cam_out(c)%lchnk       = c
      cam_out(c)%ncol        = get_ncols_p(c)
      cam_out(c)%tbot(:)     = 0._r8
      cam_out(c)%zbot(:)     = 0._r8
      cam_out(c)%ubot(:)     = 0._r8
      cam_out(c)%vbot(:)     = 0._r8
      cam_out(c)%qbot(:,:)   = 0._r8
      cam_out(c)%pbot(:)     = 0._r8
      cam_out(c)%rho(:)      = 0._r8
      cam_out(c)%netsw(:)    = 0._r8
      cam_out(c)%flwds(:)    = 0._r8
      cam_out(c)%precsc(:)   = 0._r8
      cam_out(c)%precsl(:)   = 0._r8
      cam_out(c)%precc(:)    = 0._r8
      cam_out(c)%precl(:)    = 0._r8
      cam_out(c)%soll(:)     = 0._r8
      cam_out(c)%sols(:)     = 0._r8
      cam_out(c)%solld(:)    = 0._r8
      cam_out(c)%solsd(:)    = 0._r8
      cam_out(c)%thbot(:)    = 0._r8
      cam_out(c)%co2prog(:)  = 0._r8
      cam_out(c)%co2diag(:)  = 0._r8
      cam_out(c)%psl(:)      = 0._r8
      cam_out(c)%bcphidry(:) = 0._r8
      cam_out(c)%bcphodry(:) = 0._r8
      cam_out(c)%bcphiwet(:) = 0._r8
      cam_out(c)%ocphidry(:) = 0._r8
      cam_out(c)%ocphodry(:) = 0._r8
      cam_out(c)%ocphiwet(:) = 0._r8
      cam_out(c)%dstdry1(:)  = 0._r8
      cam_out(c)%dstwet1(:)  = 0._r8
      cam_out(c)%dstdry2(:)  = 0._r8
      cam_out(c)%dstwet2(:)  = 0._r8
      cam_out(c)%dstdry3(:)  = 0._r8
      cam_out(c)%dstwet3(:)  = 0._r8
      cam_out(c)%dstdry4(:)  = 0._r8
      cam_out(c)%dstwet4(:)  = 0._r8
   end do

end subroutine atm2hub_alloc

!> \brief Destroy objects of type cam_out_t
!! \param cam_out object of type cam_out_t

subroutine atm2hub_deallocate(cam_out)
   type(cam_out_t), pointer :: cam_out(:)    ! Atmosphere to surface input
   if(associated(cam_out)) then
      deallocate(cam_out)
   end if
   nullify(cam_out)
end subroutine atm2hub_deallocate

!> \brief Destroy objects of type cam_in_t
!! \param cam_in object of type cam_in_t

subroutine hub2atm_deallocate(cam_in)
   type(cam_in_t), pointer :: cam_in(:)    ! Atmosphere to surface input
   integer :: c

   if(associated(cam_in)) then
      do c=begchunk,endchunk
         if(associated(cam_in(c)%ram1)) then
            deallocate(cam_in(c)%ram1)
            nullify(cam_in(c)%ram1)
         end if
         if(associated(cam_in(c)%fv)) then
            deallocate(cam_in(c)%fv)
            nullify(cam_in(c)%fv)
         end if
         if(associated(cam_in(c)%soilw)) then
            deallocate(cam_in(c)%soilw)
            nullify(cam_in(c)%soilw)
         end if
         if(associated(cam_in(c)%depvel)) then
            deallocate(cam_in(c)%depvel)
            nullify(cam_in(c)%depvel)
         end if
         
      enddo

      deallocate(cam_in)
   end if
   nullify(cam_in)

end subroutine hub2atm_deallocate

!======================================================================

!> \brief Set options used to initialize cam_in_t objects.
!!
!!  Method for outside packages to influence what is allocated
!!  (For now, just aerosol dust controls if fv, ram1, and soilw
!!  arrays are allocated.)
!!
!! \param[in] aero_dust_in set value of the camsrfexch::dust attribute

subroutine hub2atm_setopts( aero_dust_in )

   ! ARGUMENTS:
   logical, intent(in),optional :: aero_dust_in

   !----------------------------------------------------------------------- 
   if ( present(aero_dust_in ) ) then
      dust = aero_dust_in
   endif

end subroutine hub2atm_setopts

!> \brief Set components of cam_out_t objects.
!!
!! Set components of cam_out_t objects from fields in the state
!! and physics buffer.  Also sets fields in the comsrf module.
!!
!! \param[in] state physics state object
!! \param[in] pbuf  physics buffer
!! \param[inout] cam_out  export object

subroutine cam_export(state,cam_out,pbuf)

   use physics_types,    only: physics_state
   use ppgrid,           only: pver
   use comsrf,           only: psm1, srfrpdel, prcsnw
   use chem_surfvals,    only: chem_surfvals_get
   use co2_cycle,        only: co2_transport, c_i
   use physconst,        only: mwdry, mwco2
   use constituents,     only: pcnst
   use cam_control_mod,  only: rair
   use physics_buffer,   only: pbuf_get_index, pbuf_get_field, physics_buffer_desc

   ! Input arguments
   type(physics_state),  intent(in)    :: state
   type (cam_out_t),     intent(inout) :: cam_out
   type(physics_buffer_desc), pointer  :: pbuf(:)

   ! Local variables
   integer :: i              ! Longitude index
   integer :: m              ! constituent index
   integer :: lchnk          ! Chunk index
   integer :: ncol
   integer :: prec_dp_idx, snow_dp_idx, prec_sh_idx, snow_sh_idx
   integer :: prec_sed_idx,snow_sed_idx,prec_pcw_idx,snow_pcw_idx

   real(r8), pointer :: prec_dp(:)                 ! total precipitation   from ZM convection
   real(r8), pointer :: snow_dp(:)                 ! snow from ZM   convection
   real(r8), pointer :: prec_sh(:)                 ! total precipitation   from Hack convection
   real(r8), pointer :: snow_sh(:)                 ! snow from   Hack   convection
   real(r8), pointer :: prec_sed(:)                ! total precipitation   from ZM convection
   real(r8), pointer :: snow_sed(:)                ! snow from ZM   convection
   real(r8), pointer :: prec_pcw(:)                ! total precipitation   from Hack convection
   real(r8), pointer :: snow_pcw(:)                ! snow from Hack   convection
   !-----------------------------------------------------------------------

   lchnk = state%lchnk
   ncol  = state%ncol

   prec_dp_idx = pbuf_get_index('PREC_DP')
   snow_dp_idx = pbuf_get_index('SNOW_DP')
   prec_sh_idx = pbuf_get_index('PREC_SH')
   snow_sh_idx = pbuf_get_index('SNOW_SH')
   prec_sed_idx = pbuf_get_index('PREC_SED')
   snow_sed_idx = pbuf_get_index('SNOW_SED')
   prec_pcw_idx = pbuf_get_index('PREC_PCW')
   snow_pcw_idx = pbuf_get_index('SNOW_PCW')

   call pbuf_get_field(pbuf, prec_dp_idx, prec_dp)
   call pbuf_get_field(pbuf, snow_dp_idx, snow_dp)
   call pbuf_get_field(pbuf, prec_sh_idx, prec_sh)
   call pbuf_get_field(pbuf, snow_sh_idx, snow_sh)
   call pbuf_get_field(pbuf, prec_sed_idx, prec_sed)
   call pbuf_get_field(pbuf, snow_sed_idx, snow_sed)
   call pbuf_get_field(pbuf, prec_pcw_idx, prec_pcw)
   call pbuf_get_field(pbuf, snow_pcw_idx, snow_pcw)

   do i=1,ncol
      cam_out%tbot(i)  = state%t(i,pver)
      cam_out%thbot(i) = state%t(i,pver) * state%exner(i,pver)
      cam_out%zbot(i)  = state%zm(i,pver)
      cam_out%ubot(i)  = state%u(i,pver)
      cam_out%vbot(i)  = state%v(i,pver)
      cam_out%pbot(i)  = state%pmid(i,pver)
      cam_out%rho(i)   = cam_out%pbot(i)/(rair*cam_out%tbot(i))
      psm1(i,lchnk)    = state%ps(i)
      srfrpdel(i,lchnk)= state%rpdel(i,pver)
   end do
   do m = 1, pcnst
     do i = 1, ncol
        cam_out%qbot(i,m) = state%q(i,pver,m) 
     end do
   end do

   cam_out%co2diag(:ncol) = chem_surfvals_get('CO2VMR') * 1.0e+6_r8 
   if (co2_transport()) then
      do i=1,ncol
         cam_out%co2prog(i) = state%q(i,pver,c_i(4)) * 1.0e+6_r8 *mwdry/mwco2
      end do
   end if

   ! Precipation and snow rates from shallow convection, deep convection and stratiform processes.
   ! Compute total convective and stratiform precipitation and snow rates

   do i=1,ncol
      cam_out%precc (i) = prec_dp(i)  + prec_sh(i)
      cam_out%precl (i) = prec_sed(i) + prec_pcw(i)
      cam_out%precsc(i) = snow_dp(i)  + snow_sh(i)
      cam_out%precsl(i) = snow_sed(i) + snow_pcw(i)

      ! These checks should not be necessary if they exist in the parameterizations
      if (cam_out%precc(i) .lt.0._r8) cam_out%precc(i)=0._r8
      if (cam_out%precl(i) .lt.0._r8) cam_out%precl(i)=0._r8
      if (cam_out%precsc(i).lt.0._r8) cam_out%precsc(i)=0._r8
      if (cam_out%precsl(i).lt.0._r8) cam_out%precsl(i)=0._r8
      if (cam_out%precsc(i).gt.cam_out%precc(i)) cam_out%precsc(i)=cam_out%precc(i)
      if (cam_out%precsl(i).gt.cam_out%precl(i)) cam_out%precsl(i)=cam_out%precl(i)
   end do

   ! total snowfall rate: needed by slab ocean model
   prcsnw(:ncol,lchnk) = cam_out%precsc(:ncol) + cam_out%precsl(:ncol)   

end subroutine cam_export

end module camsrfexch