-
Debolskiy Andrey authoredDebolskiy Andrey authored
rrtm_interface.f90 11.08 KiB
MODULE INM_rrtm_interface
use parkinds, only: rf=>kind_rf, im=>kind_im
use rrtmg_lw_rad, only: rrtmg_lw
use rrtmg_sw_rad, only: rrtmg_sw
use parrrtm, only : nbndlw, ngptlw
use parrrsw, only : nbndsw, ngptsw
IMPLICIT NONE
PRIVATE
PUBLIC :: rrtm_init
type radiationDataType
real, allocatable :: uflx(:,:) !Total sky upward flux (W/m2)
real, allocatable :: dflx(:,:) !Total sky downward flux (W/m2)
real, allocatable :: uflxc(:,:) !Clear sky upward flux (W/m2)
real, allocatable :: dflxc(:,:) !Clear sky downward flux (W/m2)
real, allocatable :: hr(:,:) !Total sky radiative heating rate (K/d)
real, allocatable :: hrc(:,:) !Clear sky radiative heating rate (K/d)
end type radiationDataType
!real,dimension(1,34) :: uflx,dflx,uflxc,dflxc ! Total sky and Clear sky longwave upward,downward flux (W/m2)
!real,dimension(1,34) :: swuflx,swdflx,swuflxc,swdflxc ! Total sky and Clear sky shortwave upward,downward flux (W/m2)
!real,dimension(1,33) :: hr,hrc ! Total sky and Clear sky longwave radiative heating rate (K/d)
!real,dimension(1,33) :: swhr,swhrc ! Total sky and Clear sky longwave radiative heating rate (K/d)
CONTAINS
SUBROUTINE rrtm_init (t_init,t_lay,p_init,p_lay,q_lay,o3_lay,o2_lay,tsfc,nlay,swuflx,swdflx,swuflxc,swdflxc,swhr,swhrc,uflx,dflx,uflxc,dflxc,hr,hrc)
!INPUT
type (forcing_1d), intent(in) :: t_init,t_lay,p_init,p_lay,q_init,o3_lay,o2_lay
integer, intent(in) :: nlay
real(kind=rf), intent(in) :: tsfc ! Surface temperature (K)
!OUTUP
real,dimension(ncol,nlay+1), intent(out) :: uflx,dflx,uflxc,dflxc ! Total sky and Clear sky longwave upward,downward flux (W/m2)
real,dimension(ncol,nlay+1), intent(out) :: swuflx,swdflx,swuflxc,swdflxc ! Total sky and Clear sky shortwave upward,downward flux (W/m2)
real,dimension(ncol,nlay), intent(out) :: hr,hrc ! Total sky and Clear sky longwave radiative heating rate (K/d)
real,dimension(ncol,nlay), intent(out) :: swhr,swhrc ! Total sky and Clear sky longwave radiative heating rate (K/d)
!Local
!----- Input for rrtm-----
! Note: All volume mixing ratios are in dimensionless units of mole fraction obtained
! by scaling mass mixing ratio (g/g) with the appropriate molecular weights (g/mol)
!real, allocatable, intent(inout) :: uflx(:,:),dflx(:,:),uflxc(:,:),dflxc(:,:),swuflx(:,:),swdflx(:,:),swuflxc(:,:),swdflxc(:,:)
!uflx,dflx,uflxc,dflxc - Total sky and Clear sky longwave upward,downward flux (W/m2)
!swuflx,swdflx,swuflxc,swdflxc - Total sky and Clear sky shortwave upward,downward flux (W/m2)
!hr,hrc - Total sky and Clear sky longwave radiative heating rate (K/d)
!swhr,swhrc - Total sky and Clear sky longwave radiative heating rate (K/d)
integer,parameter :: ncol=1
integer,parameter:: dyofyr=150 ! Day of the year (used to get Earth/Sun)
integer, parameter :: isolvar = 0 ! Flag for solar variability method
real,parameter :: scon = 1360.85 ! Solar constant (W/m2)
integer,parameter :: iaer =10 ! Aerosol option flag
! 0: No aerosol
! 6: ECMWF method
! 10:Input aerosol optical
! properties
integer,parameter :: icld=0 ! Cloud overlap method
! 0: Clear only
! 1: Random ! 2: Maximum/random
! 3: Maximum
integer,parameter:: idrv=0 ! Flag for calculation of dFdT, the change
! in upward flux as a function of
! surface temperature [0=off, 1=on]
! 0: Normal forward calculation
! 1: Normal forward calculation with
! duflx_dt and duflxc_dt output
real:: play(ncol,nlay),plev(ncol,nlay+1),tlay(ncol,nlay),tlev(ncol,nlay+1) ! Layer,Interface pressures and temperatures (hPa, mb) (K)
real,dimension(ncol,nlay):: h2ovmr,o3vmr,co2vmr,ch4vmr,n2ovmr,o2vmr,cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ! H2O,o3,co2,ch4,n20,o2 volume mixing ratio
real:: emis(ncol,nbndlw) ! Surface emissivity
real:: asdir,aldir,asdif,aldif ! UV/vis,Near-IR surface albedo direct,diffuse rad
real :: adjes ! Flux adjustment for Earth/Sun distance
real :: coszen(ncol) ! Cosine of solar zenith angle
integer :: inflgsw ! Flag for cloud optical properties
integer :: iceflgsw ! Flag for ice particle specification
integer :: liqflgsw ! Flag for liquid droplet specification
integer :: inflglw ! Flag for cloud optical properties
integer :: iceflglw ! Flag for ice particle specification
integer :: liqflglw ! Flag for liquid droplet specification
real,dimension(ngptlw,ncol,nlay) :: cldfmcl_lw,taucmcl_lw,ssacmcl_lw,asmcmcl_lw,fsfcmcl_lw,ciwpmcl_lw,clwpmcl_lw
real,dimension(ncol,nlay) :: reicmcl_lw,relqmcl_lw
real :: cldfmcl_sw(ngptsw,ncol,nlay) ! Cloud fraction
real :: taucmcl_sw (ngptsw,ncol,nlay) ! In-cloud optical depth
real :: ssacmcl_sw (ngptsw,ncol,nlay) ! In-cloud single scattering albedo
! Dimensions: (ngptsw,ncol,nlay)
real :: asmcmcl_sw (ngptsw,ncol,nlay) ! In-cloud asymmetry parameter
! Dimensions: (ngptsw,ncol,nlay)
real :: fsfcmcl_sw (ngptsw,ncol,nlay) ! In-cloud forward scattering fraction
! Dimensions: (ngptsw,ncol,nlay)
real :: ciwpmcl_sw (ngptsw,ncol,nlay) ! In-cloud ice water path (g/m2)
! Dimensions: (ngptsw,ncol,nlay)
real :: clwpmcl_sw (ngptsw,ncol,nlay) ! In-cloud liquid water path (g/m2)
! Dimensions: (ngptsw,ncol,nlay)
real :: reicmcl_sw (ncol,nlay) ! Cloud ice effective radius (microns)
! Dimensions: (ncol,nlay)
! specific definition of reicmcl depends on setting of iceflgsw:
! iceflgsw = 0: (inactive)
!
! iceflgsw = 1: ice effective radius, r_ec, (Ebert and Curry, 1992),
! r_ec range is limited to 13.0 to 130.0 microns
! iceflgsw = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996)
! r_k range is limited to 5.0 to 131.0 microns
! iceflgsw = 3: generalized effective size, dge, (Fu, 1996),
! dge range is limited to 5.0 to 140.0 microns
! [dge = 1.0315 * r_ec]
real :: relqmcl_sw (ncol,nlay) ! Cloud water drop effective radius (microns)
real:: tauaer_lw (ncol,nlay,nbndlw) ! Aerosol longwave
real:: tauaer_sw (ncol,nlay,nbndsw), ssaaer_sw (ncol,nlay,nbndsw),asmaer_sw (ncol,nlay,nbndsw),ecaer_sw (ncol,nlay,nbndsw) ! Aerosol
! ----- Local -----
integer :: i,j,k
do i=1,nlay
tlay(1,i)=t_lay%val(i)
play(1,i)=p_lay%val(i)
h2ovmr(1,i)=q_lay%val(i)
o3vmr(1,i)=o3_lay%val(i)
o2vmr(1,i)=o2_lay%val(i)
enddo do i=1,nlay+1
tlev(1,i)=p_init%val(i)
plev(1,i)=p_init%val(i)
enddo
!for longwave
!flags
inflglw = 0
iceflglw = 0
liqflglw = 0
!variables
do i=1,ncol
do j=1,nlay
do k=1,nbndlw
cldfmcl_lw(k,i,j) = 0
taucmcl_lw(k,i,j) = 0
ssacmcl_lw(k,i,j) = 0
asmcmcl_lw(k,i,j) = 0
fsfcmcl_lw(k,i,j) = 0
ciwpmcl_lw(k,i,j) = 0
clwpmcl_lw(k,i,j) = 0
tauaer_lw(i,j,k) = 0
enddo
co2vmr(i,j) = 0
ch4vmr(i,j) = 0
n2ovmr(i,j) = 0
cfc11vmr(i,j) = 0
cfc12vmr(i,j) = 0
cfc22vmr(i,j) = 0
ccl4vmr(i,j) = 0
reicmcl_lw(i,j) = 0
relqmcl_lw(i,j) = 0
enddo
enddo
call rrtmg_lw &
(ncol ,nlay ,icld ,idrv , &
play ,plev ,tlay ,tlev ,tsfc , &
h2ovmr ,o3vmr ,co2vmr ,ch4vmr ,n2ovmr ,o2vmr , &
cfc11vmr,cfc12vmr,cfc22vmr,ccl4vmr ,emis , &
inflglw ,iceflglw,liqflglw,cldfmcl_lw , &
taucmcl_lw ,ciwpmcl_lw ,clwpmcl_lw ,reicmcl_lw ,relqmcl_lw , &
tauaer_lw , &
uflx ,dflx ,hr ,uflxc ,dflxc, hrc)
!for shortwave
!flags
inflgsw = 0
iceflgsw = 0
liqflgsw = 0
!variables
asdir = 0.2
asdif = 0.2
aldir = 0.2
aldif = 0.2
coszen = 0.6
adjes = 1
!arrays
do i=1,ncol
do j=1,nlay
do k=1,nbndsw
cldfmcl_sw(k,i,j) = 0._rb
taucmcl_sw(k,i,j) = 0._rb
ssacmcl_sw(k,i,j) = 0._rb
asmcmcl_sw(k,i,j) = 0._rb
fsfcmcl_sw(k,i,j) = 0._rb
ciwpmcl(k,i,j) = 0._rb
clwpmcl(k,i,j) = 0._rb
tauaer_sw(i,j,k) = 0._rb
ssaaer_sw(i,j,k) = 0._rb
asmaer_sw(i,j,k) = 0._rb ecaer_sw(i,j,k) = 0._rb
enddo
co2vmr(i,j) = 0._rb
ch4vmr(i,j) = 0._rb
n2ovmr(i,j) = 0._rb
cfc11vmr(i,j) = 0._rb
cfc12vmr(i,j) = 0._rb
cfc22vmr(i,j) = 0._rb
ccl4vmr(i,j) = 0._rb
reicmcl(i,j) = 0._rb
relqmcl(i,j) = 0._rb
enddo
enddo
call rrtmg_sw &
(ncol ,nlay ,icld ,iaer , &
play ,plev ,tlay ,tlev ,tsfc , &
h2ovmr , o3vmr ,co2vmr ,ch4vmr ,n2ovmr ,o2vmr , &
asdir ,asdif ,aldir ,aldif , &
coszen ,adjes ,dyofyr ,scon ,isolvar, &
inflgsw ,iceflgsw,liqflgsw,cldfmcl_sw , &
taucmcl_sw ,ssacmcl_sw ,asmcmcl_sw ,fsfcmcl_sw , &
ciwpmcl ,clwpmcl ,reicmcl ,relqmcl , &
tauaer_sw ,ssaaer_sw ,asmaer_sw ,ecaer_sw , &
swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc)
END SUBROUTINE rrtm_init
END MODULE INM_rrtm_interface