!-------------------------------------------------------------------
! rebins the 4 sea salt bins into 2 bins for the radiation
!
! N.B. This code looks for the constituents of SSLTA and SSLTC
! in the physics buffer first, and uses those if found.
! Consequently, it is not possible to have prognostic sea
! salt be radiatively active if the prescribed sea salt is
! also present. The current (cam3_5_52) chemistry configurations
! don't allow both prescribed and prognostic to be present
! simultaneously, but a more flexible chemistry package that
! allows this would break this code.
!
! Created by: Francis Vitt
! Date: 9 May 2008
!-------------------------------------------------------------------
module sslt_rebin 3,1
use shr_kind_mod
, only: r8 => shr_kind_r8
implicit none
integer :: indices(4)
integer :: idxa, idxc
logical :: has_sslt = .false.
character(len=1) :: source
character(len=1), parameter :: DATA = 'D'
character(len=1), parameter :: PROG = 'P'
private
public :: sslt_rebin_init, sslt_rebin_adv, sslt_rebin_register
contains
!-------------------------------------------------------------------
!-------------------------------------------------------------------
subroutine sslt_rebin_register 1,4
use ppgrid
, only : pver
use phys_buffer
, only : pbuf_add
! add SSLTA and SSLTC to physics buffer
call pbuf_add
('SSLTA','physpkg',1,pver,1,idxa)
call pbuf_add
('SSLTC','physpkg',1,pver,1,idxc)
endsubroutine sslt_rebin_register
!-------------------------------------------------------------------
!-------------------------------------------------------------------
subroutine sslt_rebin_init 1,14
use constituents
, only : cnst_get_ind
use phys_buffer
, only : pbuf, pbuf_get_fld_idx
use ppgrid
, only : pver
use cam_history
, only : addfld, phys_decomp
implicit none
indices(1) = pbuf_get_fld_idx
('sslt1', failcode=-1 )
indices(2) = pbuf_get_fld_idx
('sslt2', failcode=-1 )
indices(3) = pbuf_get_fld_idx
('sslt3', failcode=-1 )
indices(4) = pbuf_get_fld_idx
('sslt4', failcode=-1 )
has_sslt = all( indices(:) > 0 )
if ( has_sslt ) source = DATA
if ( .not. has_sslt ) then
call cnst_get_ind
('SSLT01', indices(1), abort=.false.)
call cnst_get_ind
('SSLT02', indices(2), abort=.false.)
call cnst_get_ind
('SSLT03', indices(3), abort=.false.)
call cnst_get_ind
('SSLT04', indices(4), abort=.false.)
has_sslt = all( indices(:) > 0 )
if ( has_sslt ) source = PROG
endif
if ( has_sslt ) then
call addfld
('SSLTA','kg/kg', pver, 'A', 'sea salt', phys_decomp )
call addfld
('SSLTC','kg/kg', pver, 'A', 'sea salt', phys_decomp )
endif
! initialize the pbuf values
pbuf(idxa)%fld_ptr = 0._r8
pbuf(idxc)%fld_ptr = 0._r8
end subroutine sslt_rebin_init
!-------------------------------------------------------------------
!-------------------------------------------------------------------
subroutine sslt_rebin_adv(pbuf, phys_state) 1,6
use physics_types
,only : physics_state
use phys_buffer
, only : pbuf_size_max, pbuf_fld
use ppgrid
, only : pver, pcols
use cam_history
, only : outfld
implicit none
type(pbuf_fld), intent(in) :: pbuf(pbuf_size_max)
type(physics_state), target, intent(in) :: phys_state
!++ changed wgt_sscm declaration for roundoff validation with earlier code
! real(r8), parameter :: wgt_sscm = 6.0_r8 / 7.0_r8 ! Fraction of total seasalt mass in coarse mode
real, parameter :: wgt_sscm = 6.0 / 7.0 ! Fraction of total seasalt mass in coarse mode
real(r8), dimension(:,:), pointer :: sslt1, sslt2, sslt3, sslt4
real(r8), dimension(:,:), pointer :: sslta, ssltc
integer :: lchnk, ncol
real(r8) :: sslt_sum(pcols,pver)
lchnk = phys_state%lchnk
ncol = phys_state%ncol
if (.not. has_sslt) return
select case( source )
case (PROG)
sslt1 => phys_state%q(:,:,indices(1))
sslt2 => phys_state%q(:,:,indices(2))
sslt3 => phys_state%q(:,:,indices(3))
sslt4 => phys_state%q(:,:,indices(4))
case (DATA)
sslt1 => pbuf(indices(1))%fld_ptr(1,:,:,lchnk,1)
sslt2 => pbuf(indices(2))%fld_ptr(1,:,:,lchnk,1)
sslt3 => pbuf(indices(3))%fld_ptr(1,:,:,lchnk,1)
sslt4 => pbuf(indices(4))%fld_ptr(1,:,:,lchnk,1)
end select
sslta => pbuf(idxa)%fld_ptr(1,:,:,lchnk,1)
ssltc => pbuf(idxc)%fld_ptr(1,:,:,lchnk,1)
sslt_sum(:ncol,:) = sslt1(:ncol,:) + sslt2(:ncol,:) + sslt3(:ncol,:) + sslt4(:ncol,:)
sslta(:ncol,:) = (1._r8-wgt_sscm)*sslt_sum(:ncol,:) ! fraction of seasalt mass in accumulation mode
ssltc(:ncol,:) = wgt_sscm*sslt_sum(:ncol,:) ! fraction of seasalt mass in coagulation mode
call outfld
( 'SSLTA', sslta(:ncol,:), ncol, lchnk )
call outfld
( 'SSLTC', ssltc(:ncol,:), ncol, lchnk )
end subroutine sslt_rebin_adv
end module sslt_rebin