!**********************************************************************************
! This computer software was prepared by Battelle Memorial Institute, hereinafter
! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
!
! MOSAIC module: see module_mosaic_driver.F for references and terms of use
!**********************************************************************************
!----------------------------------------------------------------------
! This module contains interface wrapper routines to couple the aerosol
! modules with mixactivate in the physics directory. Due to compiling
! dependencies, these cannot be placed in module_mixactivate.
!----------------------------------------------------------------------
MODULE module_mixactivate_wrappers
CONTAINS
!----------------------------------------------------------------------
!----------------------------------------------------------------------
subroutine mosaic_mixactivate ( &
id, ktau, dtstep, config_flags, idrydep_onoff, &
rho_phy, t_phy, w, cldfra, cldfra_old, &
ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
qsrflx, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure, only: grid_config_rec_type
use module_state_description, only: num_chem
use module_data_mosaic_asect
use module_mixactivate, only: mixactivate
! wrapper to call mixactivate for mosaic description of aerosol
implicit none
! subr arguments
integer, intent(in) :: &
id, ktau, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte, &
idrydep_onoff
real, intent(in) :: dtstep
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
rho_phy, t_phy, w, &
z, dz8w, p_at_w, t_at_w, exch_h
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
real, intent(in), &
dimension( its:ite, jts:jte, num_chem ) :: ddvel
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qv, qc, qi
LOGICAL, intent(in) :: f_qc, f_qi
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qndrop3d
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
chem
real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource,&
ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
type(grid_config_rec_type), intent(in) :: config_flags
real, intent(out) :: qsrflx(ims:ime, jms:jme, num_chem) ! wet deposition flux of aerosol
! local vars
! real qsrflx(ims:ime, jms:jme, num_chem) ! wet deposition flux of aerosol
real sumhygro,sumvol
integer i,j,k,l,m,n
real hygro( its:ite, kts:kte, jts:jte, maxd_asize, maxd_atype ) ! bulk
qsrflx(:,:,:) = 0.0
! calculate volume-weighted bulk hygroscopicity for each type and size
do 100 j=jts,jte
do 100 k=kts,kte
do 100 i=its,ite
do n=1,ntype_aer
do m=1,nsize_aer(n)
sumhygro=0.
sumvol=0.
do l=1,ncomp_aer(n)
sumhygro = sumhygro+hygro_aer(l,n)* &
chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
end do ! comp
hygro(i,k,j,m,n)=sumhygro/sumvol
end do ! size
end do ! type
100 continue
! check arguments of mixactivate for consistency between send, receive
! 06-nov-2005 rce - id & ktau added to arg list
call mixactivate( msectional, &
chem, num_chem, qv, qc, qi, qndrop3d, &
t_phy, w, ddvel, idrydep_onoff, &
maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
dens_aer, mw_aer, &
waterptr_aer, hygro, ai_phase, cw_phase, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
cldfra, cldfra_old, qsrflx, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
id, ktau, dtstep, &
f_qc, f_qi )
end subroutine mosaic_mixactivate
!----------------------------------------------------------------------
!----------------------------------------------------------------------
subroutine mosaic_mixactivate_init( &
config_flags, chem, scalar, &
chem_in_opt, & !BSINGH(12/04/13): Added for SAPRC 8 bin vbs
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure, only: grid_config_rec_type
use module_state_description, only: num_chem, num_scalar, p_qndrop
use module_data_mosaic_asect
implicit none
! subr arguments
type(grid_config_rec_type), intent(in) :: config_flags
integer, intent(in) :: &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte
INTEGER, INTENT(IN ) :: chem_in_opt !BSINGH(12/04/13): Added for SAPRC 8 bin vbs
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
chem
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_scalar ) :: &
scalar
integer :: i, j, k, m, n, l
do j=jts,jte
do k=kts,kte
do i=its,ite
scalar(i,k,j,p_qndrop) = 0.
end do
end do
end do
if( cw_phase > 0 ) then !sanity check in case using prognostic
!drop number without aq. chemistry
if (config_flags%chem_in_opt == 1) then !added by MS to transfer cloud borne species to interstitial species when using chem_in_opt=1
do n=1,ntype_aer
do m=1,nsize_aer(n)
chem(its:ite,kts:kte,jts:jte,numptr_aer(m,n,cw_phase)) = 0.
do l=1,ncomp_aer(n)
if( ai_phase > 0 ) then
! add cloud borne aerosol mass to interstitial aerosol mass
chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,ai_phase))= &
chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,ai_phase)) + &
chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,cw_phase))
endif ! for ai_phase>0
chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,cw_phase)) = 0.
end do ! comp
end do ! size
end do
else
do n=1,ntype_aer
do m=1,nsize_aer(n)
chem(its:ite,kts:kte,jts:jte,numptr_aer(m,n,cw_phase)) = 0.
do l=1,ncomp_aer(n)
chem(its:ite,kts:kte,jts:jte,massptr_aer(l,m,n,cw_phase)) = 0.
end do ! comp
end do ! size
end do ! type
endif !chem_in_opt
end if
end subroutine mosaic_mixactivate_init
!----------------------------------------------------------------------
!----------------------------------------------------------------------
subroutine sorgam_mixactivate ( &
id, ktau, dtstep, config_flags, idrydep_onoff, &
rho_phy, t_phy, w, cldfra, cldfra_old, &
ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure, only: grid_config_rec_type
use module_state_description, only: num_chem
use module_data_sorgam
use module_mixactivate, only: mixactivate
! wrapper to call mixactivate for sorgam description of aerosol
implicit none
! subr arguments
integer, intent(in) :: &
id, ktau, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte, &
idrydep_onoff
real, intent(in) :: dtstep
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
rho_phy, t_phy, w, &
z, dz8w, p_at_w, t_at_w, exch_h
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
real, intent(in), &
dimension( its:ite, jts:jte, num_chem ) :: ddvel
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qv, qc, qi
LOGICAL, intent(in) :: f_qc, f_qi
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qndrop3d
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
chem
real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
type(grid_config_rec_type), intent(in) :: config_flags
! local vars
real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
real sumhygro,sumvol
integer i,j,k,l,m,n
real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype )
! calculate volume-weighted bulk hygroscopicity for each type and size
do 100 j=jts,jte
do 100 k=kts,kte
do 100 i=its,ite
do n=1,ntype_aer
do m=1,nsize_aer(n)
sumhygro=0
sumvol=0
do l=1,ncomp_aer(n)
sumhygro = sumhygro+hygro_aer(l,n)* &
chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
end do ! comp
hygro(i,k,j,m,n)=sumhygro/sumvol
end do ! size
end do ! type
100 continue
! check arguments of mixactivate for consistency between send, receive
! 06-nov-2005 rce - id & ktau added to arg list
call mixactivate( msectional, &
chem, num_chem, qv, qc, qi, qndrop3d, &
t_phy, w, ddvel, idrydep_onoff, &
maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
dens_aer, mw_aer, &
waterptr_aer, hygro, ai_phase, cw_phase, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
cldfra, cldfra_old, qsrflx, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
id, ktau, dtstep, &
f_qc, f_qi )
end subroutine sorgam_mixactivate
!!! TUCCELLA
subroutine soa_vbs_mixactivate ( &
id, ktau, dtstep, config_flags, idrydep_onoff, &
rho_phy, t_phy, w, cldfra, cldfra_old, &
ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure, only: grid_config_rec_type
use module_state_description, only: num_chem
use module_data_soa_vbs
use module_mixactivate, only: mixactivate
! wrapper to call mixactivate for sorgam description of aerosol
implicit none
! subr arguments
integer, intent(in) :: &
id, ktau, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte, &
idrydep_onoff
real, intent(in) :: dtstep
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
rho_phy, t_phy, w, &
z, dz8w, p_at_w, t_at_w, exch_h
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
real, intent(in), &
dimension( its:ite, jts:jte, num_chem ) :: ddvel
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qv, qc, qi
LOGICAL, intent(in) :: f_qc, f_qi
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qndrop3d
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
chem
real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
type(grid_config_rec_type), intent(in) :: config_flags ! local vars
real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
real sumhygro,sumvol
integer i,j,k,l,m,n
real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype )
! calculate volume-weighted bulk hygroscopicity for each type and size
do 100 j=jts,jte
do 100 k=kts,kte
do 100 i=its,ite
do n=1,ntype_aer
do m=1,nsize_aer(n)
sumhygro=0
sumvol=0
do l=1,ncomp_aer(n)
sumhygro = sumhygro+hygro_aer(l,n)* &
chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
end do ! comp
hygro(i,k,j,m,n)=sumhygro/sumvol
end do ! size
end do ! type
100 continue
! check arguments of mixactivate for consistency between send, receive
! 06-nov-2005 rce - id & ktau added to arg list
call mixactivate( msectional, &
chem, num_chem, qv, qc, qi, qndrop3d, &
t_phy, w, ddvel, idrydep_onoff, &
maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
dens_aer, mw_aer, &
waterptr_aer, hygro, ai_phase, cw_phase, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
cldfra, cldfra_old, qsrflx, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
id, ktau, dtstep, &
f_qc, f_qi )
end subroutine soa_vbs_mixactivate
subroutine sorgam_vbs_mixactivate ( &
id, ktau, dtstep, config_flags, idrydep_onoff, &
rho_phy, t_phy, w, cldfra, cldfra_old, &
ddvel, z, dz8w, p_at_w, t_at_w, exch_h, &
qv, qc, qi, qndrop3d, f_qc, f_qi, chem, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure, only: grid_config_rec_type
use module_state_description, only: num_chem
use module_data_sorgam_vbs
use module_mixactivate, only: mixactivate
! wrapper to call mixactivate for sorgam description of aerosol
implicit none
! subr arguments
integer, intent(in) :: &
id, ktau, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte, &
idrydep_onoff
real, intent(in) :: dtstep
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
rho_phy, t_phy, w, &
z, dz8w, p_at_w, t_at_w, exch_h
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: cldfra, cldfra_old
real, intent(in), &
dimension( its:ite, jts:jte, num_chem ) :: ddvel
real, intent(in), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qv, qc, qi
LOGICAL, intent(in) :: f_qc, f_qi
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme ) :: &
qndrop3d
real, intent(inout), &
dimension( ims:ime, kms:kme, jms:jme, 1:num_chem ) :: &
chem
real, intent(out), dimension(ims:ime,kms:kme,jms:jme) :: nsource, &
ccn1,ccn2,ccn3,ccn4,ccn5,ccn6 ! number conc of aerosols activated at supersat
type(grid_config_rec_type), intent(in) :: config_flags
! local vars
real qsrflx(ims:ime, jms:jme, num_chem) ! dry deposition flux of aerosol
real sumhygro,sumvol
integer i,j,k,l,m,n
real hygro( its:ite, kts:kte, jts:jte,maxd_asize, maxd_atype )
! calculate volume-weighted bulk hygroscopicity for each type and size
do 100 j=jts,jte
do 100 k=kts,kte
do 100 i=its,ite
do n=1,ntype_aer
do m=1,nsize_aer(n)
sumhygro=0
sumvol=0
do l=1,ncomp_aer(n)
sumhygro = sumhygro+hygro_aer(l,n)* &
chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
sumvol = sumvol+chem(i,k,j,massptr_aer(l,m,n,ai_phase))/dens_aer(l,n)
end do ! comp
hygro(i,k,j,m,n)=sumhygro/sumvol
end do ! size
end do ! type
100 continue
! check arguments of mixactivate for consistency between send, receive
! 06-nov-2005 rce - id & ktau added to arg list
call mixactivate( msectional, &
chem, num_chem, qv, qc, qi, qndrop3d, &
t_phy, w, ddvel, idrydep_onoff, &
maxd_acomp, maxd_asize, maxd_atype, maxd_aphase, &
ncomp_aer, nsize_aer, ntype_aer, nphase_aer, &
numptr_aer, massptr_aer, dlo_sect, dhi_sect, sigmag_aer, dcen_sect, &
dens_aer, mw_aer, &
waterptr_aer, hygro, ai_phase, cw_phase, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte, &
rho_phy, z, dz8w, p_at_w, t_at_w, exch_h, &
cldfra, cldfra_old, qsrflx, &
ccn1, ccn2, ccn3, ccn4, ccn5, ccn6, nsource, &
id, ktau, dtstep, &
f_qc, f_qi )
end subroutine sorgam_vbs_mixactivate
END MODULE module_mixactivate_wrappers