Radiation Scheme in CCPP
Data Types | Modules | Functions/Subroutines | Variables
radiation_aerosols.f File Reference

Go to the source code of this file.

Data Types

type  module_radiation_aerosols::gocart_index_type
 
type  module_radiation_aerosols::tracer_index_type
 

Modules

module  module_radiation_aerosols
 This module contains climatological atmospheric aerosol schemes for radiation computations.
 

Functions/Subroutines

subroutine, public module_radiation_aerosols::aer_init
 The initialization program to set up necessary parameters and working arrays. More...
 
subroutine wrt_aerlog
 This subroutine writes aerosol parameter configuration to run log file. More...
 
subroutine set_spectrum
 This subroutine defines the one wavenumber solar fluxes based on toa solar spectral distribution, and define the one wavenumber IR fluxes based on black-body emission distribution at a predefined temperature. More...
 
subroutine set_volcaer
 The initialization program for stratospheric volcanic aerosols. More...
 
subroutine module_radiation_aerosols::clim_aerinit
 the opac-climatology aerosol initialization program to set up necessary parameters and working arrays. More...
 
subroutine set_aercoef
 the initialization program for climatological aerosols. the program reads and maps the pre-tabulated aerosol optical spectral data onto corresponding SW radiation spectral bands. More...
 
subroutine optavg
 compute mean aerosols optical properties over each SW radiation spectral band for each of the species components. This program follows GFDL's approach for thick cloud optical property in SW radiation scheme (2000). More...
 
subroutine, public module_radiation_aerosols::aer_update
 This subroutine checks and updates time varying climatology aerosol data sets. More...
 
subroutine trop_update
 update the monthly global distribution of aerosol profiles in five degree horizontal resolution. More...
 
subroutine volc_update
 search historical volcanic data sets to find and read in monthly 45-degree lat-zone band of optical depth. More...
 
subroutine module_radiation_aerosols::aer_property
 This subroutine maps the 5 degree global climatological aerosol data set onto model grids, and compute aerosol optical properties for SW and LW radiations. More...
 
subroutine radclimaer
 This subroutine computes aerosols optical properties in NSWLWBD bands. there are seven different vertical profile structures. in the troposphere, aerosol distribution at each grid point is composed from up to six components out of ten different substances. More...
 
subroutine module_radiation_aerosols::gocart_init
 the initialization program for gocart aerosols More...
 
subroutine set_aerspc (raddt, fdaer)
 determine merging coefficients ctaer; setup aerosol specification. More...
 
subroutine rd_gocart_luts
 This subroutine reads input gocart aerosol optical data from Mie code calculations. More...
 
subroutine optavg_grt
 This subroutine computes mean aerosols optical properties over each SW/LW radiation spectral band for each of the species components. This program follows GFDL's approach for thick cloud optical property in SW radiation scheme (2000) More...
 
subroutine rd_gocart_clim
 This subroutine: More...
 
subroutine module_radiation_aerosols::setgocartaer
 This subroutine computes SW + LW aerosol optical properties for gocart aerosol species (merged from fcst and clim fields). More...
 
subroutine map_aermr
 This subroutine maps input tracer fields (trcly) to local tracer array (aermr). More...
 
subroutine aeropt_grt
 This subroutine computes aerosols optical properties in NSWLWBD SW/LW bands. Aerosol distribution at each grid point is composed from up to NMXG aerosol species (from NUM_GRIDCOMP components). More...
 
subroutine, public module_radiation_aerosols::setaer
 This subroutine computes aerosols optical properties. More...
 

Variables

character(40), parameter module_radiation_aerosols::vtagaer ='NCEP-Radiation_aerosols v5.2 Jan 2013 '
 
integer, parameter, public module_radiation_aerosols::nf_aesw = 3
 num of output fields for sw rad More...
 
integer, parameter, public module_radiation_aerosols::nf_aelw = 3
 num of output fields for lw rad More...
 
integer, parameter, public module_radiation_aerosols::nlwstr = 1
 starting band number in ir region More...
 
integer, parameter, public module_radiation_aerosols::nspc = 5
 num of species for output aod (opnl) More...
 
integer, parameter, public module_radiation_aerosols::nspc1 = NSPC + 1
 total+species More...
 
real(kind=kind_phys), parameter module_radiation_aerosols::f_zero = 0.0
 
real(kind=kind_phys), parameter module_radiation_aerosols::f_one = 1.0
 
integer, save module_radiation_aerosols::nswbnd = NBDSW
 
integer, save module_radiation_aerosols::nlwbnd = NBDLW
 
integer, save module_radiation_aerosols::nswlwbd = NBDSW+NBDLW
 
integer, parameter, public module_radiation_aerosols::nwvsol = 151
 num of wvnum regions where solar flux is constant More...
 
integer, parameter, public module_radiation_aerosols::nwvtot = 57600
 total num of wvnum included More...
 
integer, parameter, public module_radiation_aerosols::nwvtir = 4000
 total num of wvnum in ir range More...
 
integer, dimension(nwvsol), save module_radiation_aerosols::nwvns0
 
real(kind=kind_phys), dimension(nwvsol), save module_radiation_aerosols::s0intv
 
integer, parameter module_radiation_aerosols::minvyr = 1850
 
integer, parameter module_radiation_aerosols::maxvyr = 1999
 
integer, dimension(:,:,:), allocatable, save module_radiation_aerosols::ivolae
 
integer module_radiation_aerosols::kyrstr
 
integer module_radiation_aerosols::kyrend
 
integer module_radiation_aerosols::kyrsav
 
integer module_radiation_aerosols::kmonsav
 
integer, parameter module_radiation_aerosols::nxc = 5
 
integer, parameter module_radiation_aerosols::nae = 7
 
integer, parameter module_radiation_aerosols::ndm = 5
 
integer, parameter module_radiation_aerosols::imxae = 72
 
integer, parameter module_radiation_aerosols::jmxae = 37
 
integer, parameter module_radiation_aerosols::naerbnd =61
 
integer, parameter module_radiation_aerosols::nrhlev =8
 
integer, parameter module_radiation_aerosols::ncm1 = 6
 
integer, parameter module_radiation_aerosols::ncm2 = 4
 
integer, parameter module_radiation_aerosols::ncm = NCM1+NCM2
 
real(kind=kind_phys), dimension(nrhlev), save module_radiation_aerosols::rhlev
 
real(kind=kind_phys), dimension(ndm, nae), save module_radiation_aerosols::haer
 
real(kind=kind_phys), dimension(ndm, nae), save module_radiation_aerosols::prsref
 
real(kind=kind_phys), dimension(ndm, nae), save module_radiation_aerosols::sigref
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::extrhi
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::scarhi
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::ssarhi
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::asyrhi
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::extrhd
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::scarhd
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::ssarhd
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::asyrhd
 
real(kind=kind_phys), dimension(:), allocatable, save module_radiation_aerosols::extstra
 
real(kind=kind_phys), dimension(nxc, imxae, jmxae), save module_radiation_aerosols::cmixg
 
real(kind=kind_phys), dimension(2,imxae, jmxae), save module_radiation_aerosols::denng
 
integer, dimension(nxc, imxae, jmxae), save module_radiation_aerosols::idxcg
 
integer, dimension( imxae, jmxae), save module_radiation_aerosols::kprfg
 
integer, parameter module_radiation_aerosols::kaerbnd =61
 
integer, parameter module_radiation_aerosols::krhlev =36
 
integer, save module_radiation_aerosols::kcm1 = 0
 
integer, save module_radiation_aerosols::kcm2 = 0
 
integer, save module_radiation_aerosols::kcm
 
real(kind=kind_phys), dimension(:) module_radiation_aerosols::rhlev_grt
 
real(kind=kind_phys), dimension(krhlev) module_radiation_aerosols::data
 
integer, dimension(:), allocatable module_radiation_aerosols::iendwv_grt
 
real(kind=kind_phys), dimension(:,:), allocatable module_radiation_aerosols::rhidext0_grt
 
real(kind=kind_phys), dimension(:,:), allocatable module_radiation_aerosols::rhidssa0_grt
 
real(kind=kind_phys), dimension(:,:), allocatable module_radiation_aerosols::rhidasy0_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable module_radiation_aerosols::rhdpext0_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable module_radiation_aerosols::rhdpssa0_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable module_radiation_aerosols::rhdpasy0_grt
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::extrhi_grt
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::ssarhi_grt
 
real(kind=kind_phys), dimension(:,:), allocatable, save module_radiation_aerosols::asyrhi_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::extrhd_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::ssarhd_grt
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::asyrhd_grt
 
integer, parameter module_radiation_aerosols::imxg = 144
 
integer, parameter module_radiation_aerosols::jmxg = 91
 
integer, parameter module_radiation_aerosols::kmxg = 30
 
integer, save module_radiation_aerosols::nmxg
 
real(kind=kind_phys), parameter module_radiation_aerosols::dltx = 360.0 / float(IMXG)
 
real(kind=kind_phys), parameter module_radiation_aerosols::dlty = 180.0 / float(JMXG-1)
 
real(kind=kind_phys), dimension(:,:,:), allocatable, save module_radiation_aerosols::psclmg
 
real(kind=kind_phys), dimension(:,:,:,:), allocatable, save module_radiation_aerosols::dmclmg
 
real(kind=kind_phys), dimension(:), allocatable, save module_radiation_aerosols::geos_rlon
 
real(kind=kind_phys), dimension(:), allocatable, save module_radiation_aerosols::geos_rlat
 
character *4, save module_radiation_aerosols::gocart_climo = 'xxxx'
 
real(kind=kind_io4), dimension(:), allocatable module_radiation_aerosols::molwgt
 
logical, save module_radiation_aerosols::lgrtint = .true.
 
logical, save module_radiation_aerosols::lckprnt = .false.
 
real(kind=kind_phys), save module_radiation_aerosols::ctaer = f_zero
 
logical, save module_radiation_aerosols::get_fcst = .true.
 
logical, save module_radiation_aerosols::get_clim = .true.
 
integer, save module_radiation_aerosols::isoot
 
integer, save module_radiation_aerosols::iwaso
 
integer, save module_radiation_aerosols::isuso
 
integer, save module_radiation_aerosols::issam
 
integer, save module_radiation_aerosols::isscm
 
type(gocart_index_type), save module_radiation_aerosols::dm_indx
 
type(tracer_index_type), save module_radiation_aerosols::dmfcs_indx
 
integer, save module_radiation_aerosols::num_gridcomp = 0
 
character, dimension(:), allocatable, save module_radiation_aerosols::gridcomp
 
integer, parameter module_radiation_aerosols::max_num_gridcomp = 5
 
character *2, dimension(max_num_gridcomp) module_radiation_aerosols::max_gridcomp
 
integer, dimension(ncm) module_radiation_aerosols::idxspc
 
real(kind=kind_phys), parameter module_radiation_aerosols::wvn550 = 1.0e4/0.55
 
integer, save module_radiation_aerosols::nv_aod = 1
 

Function/Subroutine Documentation

subroutine setgocartaer::aeropt_grt ( )
private

Definition at line 5025 of file radiation_aerosols.f.

References module_radiation_aerosols::asyrhd_grt, module_radiation_aerosols::asyrhi_grt, module_radiation_aerosols::dm_indx, module_radiation_aerosols::extrhd_grt, module_radiation_aerosols::extrhi_grt, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, module_radiation_aerosols::gridcomp, module_radiation_aerosols::isoot, module_radiation_aerosols::issam, module_radiation_aerosols::isuso, module_radiation_aerosols::iwaso, module_radiation_aerosols::kcm1, module_radiation_aerosols::krhlev, module_radiation_aerosols::max_gridcomp, module_radiation_aerosols::max_num_gridcomp, module_radiation_aerosols::num_gridcomp, module_radiation_aerosols::nv_aod, module_radiation_aerosols::rhlev_grt, module_radiation_aerosols::ssarhd_grt, and module_radiation_aerosols::ssarhi_grt.

Referenced by module_radiation_aerosols::setgocartaer().

5025 !...................................
5026 ! --- inputs: (in scope variables)
5027 ! --- outputs: (in scope variables)
5028 
5029 ! ================================================================== !
5030 ! !
5031 ! subprogram: aeropt_grt !
5032 ! !
5033 ! compute aerosols optical properties in NSWLWBD sw/lw bands. !
5034 ! Aerosol distribution at each grid point is composed from up to !
5035 ! NMXG aerosol species (from NUM_GRIDCOMP components). !
5036 ! !
5037 ! input variables: !
5038 ! dmanl - aerosol dry mass g/m3 NLAY*NMXG !
5039 ! rh1 - relative humidity % NLAY !
5040 ! dz1 - layer thickness km NLAY !
5041 ! NLAY - vertical dimensions - 1 !
5042 ! ivflip - control flag for direction of vertical index !
5043 ! =0: index from toa to surface !
5044 ! =1: index from surface to toa !
5045 ! !
5046 ! output variables: !
5047 ! tauae - aerosol optical depth - NLAY*NSWLWBD !
5048 ! ssaae - aerosol single scattering albedo - NLAY*NSWLWBD !
5049 ! asyae - aerosol asymmetry parameter - NLAY*NSWLWBD !
5050 ! !
5051 ! ================================================================== !
5052 !
5053  implicit none
5054 
5055 ! --- inputs:
5056 ! --- outputs:
5057 
5058 ! --- locals:
5059  real (kind=kind_phys) :: aerdm
5060  real (kind=kind_phys) :: ext1, ssa1, asy1, ex00, ss00, as00, &
5061  & ex01, ss01, as01, exint
5062  real (kind=kind_phys) :: tau, ssa, asy, &
5063  & sum_tau, sum_ssa, sum_asy
5064 
5065 ! --- subgroups for sub-micron dust
5066 ! --- corresponds to 0.1-0.18, 0.18-0.3, 0.3-0.6, 0.6-1.0 micron
5067 
5068  real (kind=kind_phys) :: fd(4)
5069  data fd / 0.01053,0.08421,0.25263,0.65263 /
5070 
5071  character :: tp*2
5072  integer :: icmp, n, kk, ib, ih2, ih1, ii, ij, ijk
5073  real (kind=kind_phys) :: drh0, drh1, rdrh
5074 
5075  real (kind=kind_phys) :: qmin
5076  data qmin / 1.e-20 /
5077 
5078 !===> ... begin here
5079 
5080 ! --- initialize (assume no aerosols)
5081  tauae = f_zero
5082  ssaae = f_one
5083  asyae = f_zero
5084 
5085  tauae_gocart = f_zero
5086 
5087 !===> ... loop over vertical layers
5088 !
5089  lab_do_layer : do kk = 1, nlay
5090 
5091 ! --- linear interp coeffs for rh-dep species
5092 
5093  ih2 = 1
5094  do while ( rh1(kk) > rhlev_grt(ih2) )
5095  ih2 = ih2 + 1
5096  if ( ih2 > krhlev ) exit
5097  enddo
5098  ih1 = max( 1, ih2-1 )
5099  ih2 = min( krhlev, ih2 )
5100 
5101  drh0 = rhlev_grt(ih2) - rhlev_grt(ih1)
5102  drh1 = rh1(kk) - rhlev_grt(ih1)
5103  if ( ih1 == ih2 ) then
5104  rdrh = f_zero
5105  else
5106  rdrh = drh1 / drh0
5107  endif
5108 
5109 ! --- loop through sw/lw spectral bands
5110 
5111  lab_do_ib : do ib = 1, nswlwbd
5112  sum_tau = f_zero
5113  sum_ssa = f_zero
5114  sum_asy = f_zero
5115 
5116 ! --- loop through aerosol grid components
5117  lab_do_icmp : do icmp = 1, num_gridcomp
5118  ext1 = f_zero
5119  ssa1 = f_zero
5120  asy1 = f_zero
5121 
5122  tp = gridcomp(icmp)
5123 
5124  select case ( tp )
5125 
5126 ! -- dust aerosols: no humidification effect
5127  case ( 'DU')
5128  do n = 1, kcm1
5129 
5130  if (n <= 4) then
5131  aerdm = dmanl(kk,dm_indx%dust1) * fd(n)
5132  else
5133  aerdm = dmanl(kk,dm_indx%dust1+n-4 )
5134  endif
5135 
5136  if (aerdm < qmin) aerdm = f_zero
5137  ex00 = extrhi_grt(n,ib)*(1000.*dz1(kk))*aerdm
5138  ss00 = ssarhi_grt(n,ib)
5139  as00 = asyrhi_grt(n,ib)
5140  ext1 = ext1 + ex00
5141  ssa1 = ssa1 + ex00 * ss00
5142  asy1 = asy1 + ex00 * ss00 * as00
5143 
5144  enddo
5145 
5146 ! -- suso aerosols: with humidification effect
5147  case ( 'SU')
5148  ij = isuso
5149  exint = extrhd_grt(ih1,ij,ib) &
5150  & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib))
5151  ss00 = ssarhd_grt(ih1,ij,ib) &
5152  & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib))
5153  as00 = asyrhd_grt(ih1,ij,ib) &
5154  & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib))
5155 
5156  aerdm = dmanl(kk, dm_indx%suso)
5157  if (aerdm < qmin) aerdm = f_zero
5158  ex00 = exint*(1000.*dz1(kk))*aerdm
5159  ext1 = ex00
5160  ssa1 = ex00 * ss00
5161  asy1 = ex00 * ss00 * as00
5162 
5163 ! -- seasalt aerosols: with humidification effect
5164  case ( 'SS')
5165  do n = 1, 2
5166  ij = issam + (n-1)
5167  exint = extrhd_grt(ih1,ij,ib) &
5168  & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib))
5169  ss00 = ssarhd_grt(ih1,ij,ib) &
5170  & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib))
5171  as00 = asyrhd_grt(ih1,ij,ib) &
5172  & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib))
5173 
5174  aerdm = dmanl(kk, dm_indx%ssam+n-1)
5175  if (aerdm < qmin) aerdm = f_zero
5176  ex00 = exint*(1000.*dz1(kk))*aerdm
5177  ext1 = ext1 + ex00
5178  ssa1 = ssa1 + ex00 * ss00
5179  asy1 = asy1 + ex00 * ss00 * as00
5180 
5181  enddo
5182 
5183 ! -- organic carbon/black carbon:
5184 ! using 'waso' and 'soot' for hydrophilic OC and BC
5185 ! using 'waso' and 'soot' at RH=0 for hydrophobic OC and BC
5186  case ( 'OC', 'BC')
5187  if(tp == 'OC') then
5188  ii = dm_indx%waso_phobic
5189  ij = iwaso
5190  else
5191  ii = dm_indx%soot_phobic
5192  ij = isoot
5193  endif
5194 
5195 ! --- hydrophobic
5196  aerdm = dmanl(kk, ii)
5197  if (aerdm < qmin) aerdm = f_zero
5198  ex00 = extrhd_grt(1,ij,ib)*(1000.*dz1(kk))*aerdm
5199  ss00 = ssarhd_grt(1,ij,ib)
5200  as00 = asyrhd_grt(1,ij,ib)
5201 ! --- hydrophilic
5202  aerdm = dmanl(kk, ii+1)
5203  if (aerdm < qmin) aerdm = f_zero
5204  exint = extrhd_grt(ih1,ij,ib) &
5205  & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib))
5206  ex01 = exint*(1000.*dz1(kk))*aerdm
5207  ss01 = ssarhd_grt(ih1,ij,ib) &
5208  & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib))
5209  as01 = asyrhd_grt(ih1,ij,ib) &
5210  & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib))
5211 
5212  ext1 = ex00 + ex01
5213  ssa1 = (ex00 * ss00) + (ex01 * ss01)
5214  asy1 = (ex00 * ss00 * as00) + (ex01 * ss01 * as01)
5215 
5216  end select
5217 
5218 ! --- determine tau, ssa, asy for each grid component
5219  tau = ext1
5220  if (ext1 > f_zero) ssa=min(f_one,ssa1/ext1)
5221  if (ssa1 > f_zero) asy=min(f_one,asy1/ssa1)
5222 
5223 ! --- save tau at 550 nm for each grid component
5224  if ( ib == nv_aod ) then
5225  do ijk = 1, max_num_gridcomp
5226  if ( tp == max_gridcomp(ijk) ) then
5227  tauae_gocart(kk,ijk) = tau
5228  endif
5229  enddo
5230  endif
5231 
5232 ! --- update sum_tau, sum_ssa, sum_asy
5233  sum_tau = sum_tau + tau
5234  sum_ssa = sum_ssa + tau * ssa
5235  sum_asy = sum_asy + tau * ssa * asy
5236 
5237  enddo lab_do_icmp
5238 
5239 
5240 ! --- determine total tau, ssa, asy for aerosol mixture
5241  tauae(kk,ib) = sum_tau
5242  if (sum_tau > f_zero) ssaae(kk,ib) = sum_ssa / sum_tau
5243  if (sum_ssa > f_zero) asyae(kk,ib) = sum_asy / sum_ssa
5244 
5245  enddo lab_do_ib
5246 
5247  enddo lab_do_layer
5248 
5249 !
5250  return
5251 !...................................
5252  end subroutine aeropt_grt
5253 !--------------------------------
5254 
5255 !................................
aeropt_grt
subroutine aeropt_grt
This subroutine computes aerosols optical properties in NSWLWBD SW/LW bands. Aerosol distribution at ...
Definition: radiation_aerosols.f:5025

Here is the caller graph for this function:

subroutine setgocartaer::map_aermr ( )
private

Definition at line 4939 of file radiation_aerosols.f.

References module_radiation_aerosols::dm_indx, module_radiation_aerosols::dmfcs_indx, and module_radiation_aerosols::f_zero.

Referenced by module_radiation_aerosols::setgocartaer().

4939 !.............................
4940 ! --- inputs: (in scope variables)
4941 ! --- outputs: (in scope variables)
4942 
4943 ! ==================================================================== !
4944 ! !
4945 ! subprogram: map_aermr !
4946 ! !
4947 ! map input tracer fields (trcly) to local tracer array (aermr) !
4948 ! !
4949 ! ==================== defination of variables =================== !
4950 ! !
4951 ! input arguments: !
4952 ! IMAX - horizontal dimension of arrays 1 !
4953 ! NLAY - vertical dimensions of arrays 1 !
4954 ! trcly - layer tracer mass mixing ratio g/g IMAX*NLAY*NTRAC!
4955 ! output arguments: (to module variables) !
4956 ! aermr - layer aerosol mass mixing ratio g/g IMAX*NLAY*NMXG !
4957 ! !
4958 ! note: !
4959 ! NTRAC is the number of tracers excluding water vapor !
4960 ! NMXG is the number of prognostic aerosol species !
4961 ! ================================================================== !
4962 !
4963  implicit none
4964 
4965 ! --- inputs:
4966 ! --- output:
4967 
4968 ! --- local:
4969  integer :: i, indx, ii
4970  character :: tp*2
4971 
4972 ! initialize
4973  aermr(:,:,:) = f_zero
4974  ii = 1 !! <---- trcly does not contain q
4975 
4976 ! ==> DU: du1 (submicron bins), du2, du3, du4, du5
4977  if( gfs_phy_tracer%doing_DU ) then
4978  aermr(:,:,dm_indx%dust1) = trcly(:,:,dmfcs_indx%du001-ii)
4979  aermr(:,:,dm_indx%dust2) = trcly(:,:,dmfcs_indx%du002-ii)
4980  aermr(:,:,dm_indx%dust3) = trcly(:,:,dmfcs_indx%du003-ii)
4981  aermr(:,:,dm_indx%dust4) = trcly(:,:,dmfcs_indx%du004-ii)
4982  aermr(:,:,dm_indx%dust5) = trcly(:,:,dmfcs_indx%du005-ii)
4983  endif
4984 
4985 ! ==> OC: oc_phobic, oc_philic
4986  if( gfs_phy_tracer%doing_OC ) then
4987  aermr(:,:,dm_indx%waso_phobic) = &
4988  & trcly(:,:,dmfcs_indx%ocphobic-ii)
4989  aermr(:,:,dm_indx%waso_philic) = &
4990  & trcly(:,:,dmfcs_indx%ocphilic-ii)
4991  endif
4992 
4993 ! ==> BC: bc_phobic, bc_philic
4994  if( gfs_phy_tracer%doing_BC ) then
4995  aermr(:,:,dm_indx%soot_phobic) = &
4996  & trcly(:,:,dmfcs_indx%bcphobic-ii)
4997  aermr(:,:,dm_indx%soot_philic) = &
4998  & trcly(:,:,dmfcs_indx%bcphilic-ii)
4999  endif
5000 
5001 ! ==> SS: ss1, ss2 (submicron bins), ss3, ss4, ss5
5002  if( gfs_phy_tracer%doing_SS ) then
5003  aermr(:,:,dm_indx%ssam) = trcly(:,:,dmfcs_indx%ss001-ii) &
5004  & + trcly(:,:,dmfcs_indx%ss002-ii)
5005  aermr(:,:,dm_indx%sscm) = trcly(:,:,dmfcs_indx%ss003-ii) &
5006  & + trcly(:,:,dmfcs_indx%ss004-ii) &
5007  & + trcly(:,:,dmfcs_indx%ss005-ii)
5008  endif
5009 
5010 ! ==> SU: so4
5011  if( gfs_phy_tracer%doing_SU ) then
5012  aermr(:,:,dm_indx%suso) = trcly(:,:,dmfcs_indx%so4-ii)
5013  endif
5014 
5015  return
5016 !...................................

Here is the caller graph for this function:

subroutine clim_aerinit::optavg ( )
private

Definition at line 1370 of file radiation_aerosols.f.

References module_radiation_aerosols::asyrhd, module_radiation_aerosols::asyrhi, module_radiation_aerosols::extrhd, module_radiation_aerosols::extrhi, module_radiation_aerosols::extstra, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, physparam::lalwflg, physparam::laswflg, module_radiation_aerosols::ncm1, module_radiation_aerosols::ncm2, module_radiation_aerosols::nlwbnd, module_radiation_aerosols::nrhlev, module_radiation_aerosols::nswbnd, module_radiation_aerosols::scarhd, module_radiation_aerosols::scarhi, module_radiation_aerosols::ssarhd, and module_radiation_aerosols::ssarhi.

Referenced by set_aercoef().

1370 !................................
1371 ! --- inputs: (in-scope variables, module variables
1372 ! --- outputs: (module variables)
1373 
1374 ! ==================================================================== !
1375 ! !
1376 ! subprogram: optavg !
1377 ! !
1378 ! compute mean aerosols optical properties over each sw radiation !
1379 ! spectral band for each of the species components. This program !
1380 ! follows gfdl's approach for thick cloud opertical property in !
1381 ! sw radiation scheme (2000). !
1382 ! !
1383 ! ==================== defination of variables =================== !
1384 ! !
1385 ! major input variables: !
1386 ! nv1,nv2 (NSWBND) - start/end spectral band indices of aerosol data !
1387 ! for each sw radiation spectral band !
1388 ! nr1,nr2 (NLWBND) - start/end spectral band indices of aerosol data !
1389 ! for each ir radiation spectral band !
1390 ! solwaer (NSWBND,NAERBND) !
1391 ! - solar flux weight over each sw radiation band !
1392 ! vs each aerosol data spectral band !
1393 ! eirwaer (NLWBND,NAERBND) !
1394 ! - ir flux weight over each lw radiation band !
1395 ! vs each aerosol data spectral band !
1396 ! solbnd (NSWBND) - solar flux weight over each sw radiation band !
1397 ! eirbnd (NLWBND) - ir flux weight over each lw radiation band !
1398 ! NSWBND - total number of sw spectral bands !
1399 ! NLWBND - total number of lw spectral bands !
1400 ! !
1401 ! external module variables: (in physparam) !
1402 ! laswflg - control flag for sw spectral region !
1403 ! lalwflg - control flag for lw spectral region !
1404 ! !
1405 ! output variables: (to module variables) !
1406 ! !
1407 ! ================================================================== !
1408 
1409 ! --- inputs:
1410 ! --- output:
1411 
1412 ! --- locals:
1413  real (kind=kind_phys) :: sumk, sums, sumok, sumokg, sumreft, &
1414  & sp, refb, reft, rsolbd, rirbd
1415 
1416  integer :: ib, nb, ni, nh, nc
1417 !
1418 !===> ... begin here
1419 !
1420 ! --- ... loop for each sw radiation spectral band
1421 
1422  if ( laswflg ) then
1423 
1424  do nb = 1, nswbnd
1425  rsolbd = f_one / solbnd(nb)
1426 
1427 ! --- for rh independent aerosol species
1428 
1429  do nc = 1, ncm1
1430  sumk = f_zero
1431  sums = f_zero
1432  sumok = f_zero
1433  sumokg = f_zero
1434  sumreft = f_zero
1435 
1436  do ni = nv1(nb), nv2(nb)
1437  sp = sqrt( (f_one - rhidssa0(ni,nc)) &
1438  & / (f_one - rhidssa0(ni,nc)*rhidasy0(ni,nc)) )
1439  reft = (f_one - sp) / (f_one + sp)
1440  sumreft = sumreft + reft*solwaer(nb,ni)
1441 
1442  sumk = sumk + rhidext0(ni,nc)*solwaer(nb,ni)
1443  sums = sums + rhidsca0(ni,nc)*solwaer(nb,ni)
1444  sumok = sumok + rhidssa0(ni,nc)*solwaer(nb,ni) &
1445  & * rhidext0(ni,nc)
1446  sumokg = sumokg + rhidssa0(ni,nc)*solwaer(nb,ni) &
1447  & * rhidext0(ni,nc)*rhidasy0(ni,nc)
1448  enddo
1449 
1450  refb = sumreft * rsolbd
1451 
1452  extrhi(nc,nb) = sumk * rsolbd
1453  scarhi(nc,nb) = sums * rsolbd
1454  asyrhi(nc,nb) = sumokg / (sumok + 1.0e-10)
1455  ssarhi(nc,nb) = 4.0*refb &
1456  & / ( (f_one+refb)**2 - asyrhi(nc,nb)*(f_one-refb)**2 )
1457  enddo ! end do_nc_block for rh-ind aeros
1458 
1459 ! --- for rh dependent aerosols species
1460 
1461  do nc = 1, ncm2
1462  do nh = 1, nrhlev
1463  sumk = f_zero
1464  sums = f_zero
1465  sumok = f_zero
1466  sumokg = f_zero
1467  sumreft = f_zero
1468 
1469  do ni = nv1(nb), nv2(nb)
1470  sp = sqrt( (f_one - rhdpssa0(ni,nh,nc)) &
1471  & / (f_one - rhdpssa0(ni,nh,nc)*rhdpasy0(ni,nh,nc)) )
1472  reft = (f_one - sp) / (f_one + sp)
1473  sumreft = sumreft + reft*solwaer(nb,ni)
1474 
1475  sumk = sumk + rhdpext0(ni,nh,nc)*solwaer(nb,ni)
1476  sums = sums + rhdpsca0(ni,nh,nc)*solwaer(nb,ni)
1477  sumok = sumok + rhdpssa0(ni,nh,nc)*solwaer(nb,ni) &
1478  & * rhdpext0(ni,nh,nc)
1479  sumokg = sumokg + rhdpssa0(ni,nh,nc)*solwaer(nb,ni) &
1480  & * rhdpext0(ni,nh,nc)*rhdpasy0(ni,nh,nc)
1481  enddo
1482 
1483  refb = sumreft * rsolbd
1484 
1485  extrhd(nh,nc,nb) = sumk * rsolbd
1486  scarhd(nh,nc,nb) = sums * rsolbd
1487  asyrhd(nh,nc,nb) = sumokg / (sumok + 1.0e-10)
1488  ssarhd(nh,nc,nb) = 4.0*refb &
1489  & / ( (f_one+refb)**2 - asyrhd(nh,nc,nb)*(f_one-refb)**2 )
1490  enddo ! end do_nh_block
1491  enddo ! end do_nc_block for rh-dep aeros
1492 
1493 ! --- for stratospheric background aerosols
1494 
1495  sumk = f_zero
1496  do ni = nv1(nb), nv2(nb)
1497  sumk = sumk + straext0(ni)*solwaer(nb,ni)
1498  enddo
1499 
1500  extstra(nb) = sumk * rsolbd
1501 
1502 ! --- check print
1503 ! if ( nb > 6 .and. nb < 10) then
1504 ! print *,' in optavg for sw band',nb
1505 ! print *,' nv1, nv2:',nv1(nb),nv2(nb)
1506 ! print *,' solwaer:',solwaer(nb,nv1(nb):nv2(nb))
1507 ! print *,' extrhi:', extrhi(:,nb)
1508 ! do i = 1, NRHLEV
1509 ! print *,' extrhd for rhlev:',i
1510 ! print *,extrhd(i,:,nb)
1511 ! enddo
1512 ! print *,' sumk, rsolbd, extstra:',sumk,rsolbd,extstra(nb)
1513 ! endif
1514 
1515  enddo ! end do_nb_block for sw
1516  endif ! end if_laswflg_block
1517 
1518 ! --- ... loop for each lw radiation spectral band
1519 
1520  if ( lalwflg ) then
1521 
1522  do nb = 1, nlwbnd
1523 
1524  ib = nswbnd + nb
1525  rirbd = f_one / eirbnd(nb)
1526 
1527 ! --- for rh independent aerosol species
1528 
1529  do nc = 1, ncm1
1530  sumk = f_zero
1531  sums = f_zero
1532  sumok = f_zero
1533  sumokg = f_zero
1534  sumreft = f_zero
1535 
1536  do ni = nr1(nb), nr2(nb)
1537  sp = sqrt( (f_one - rhidssa0(ni,nc)) &
1538  & / (f_one - rhidssa0(ni,nc)*rhidasy0(ni,nc)) )
1539  reft = (f_one - sp) / (f_one + sp)
1540  sumreft = sumreft + reft*eirwaer(nb,ni)
1541 
1542  sumk = sumk + rhidext0(ni,nc)*eirwaer(nb,ni)
1543  sums = sums + rhidsca0(ni,nc)*eirwaer(nb,ni)
1544  sumok = sumok + rhidssa0(ni,nc)*eirwaer(nb,ni) &
1545  & * rhidext0(ni,nc)
1546  sumokg = sumokg + rhidssa0(ni,nc)*eirwaer(nb,ni) &
1547  & * rhidext0(ni,nc)*rhidasy0(ni,nc)
1548  enddo
1549 
1550  refb = sumreft * rirbd
1551 
1552  extrhi(nc,ib) = sumk * rirbd
1553  scarhi(nc,ib) = sums * rirbd
1554  asyrhi(nc,ib) = sumokg / (sumok + 1.0e-10)
1555  ssarhi(nc,ib) = 4.0*refb &
1556  & / ( (f_one+refb)**2 - asyrhi(nc,ib)*(f_one-refb)**2 )
1557  enddo ! end do_nc_block for rh-ind aeros
1558 
1559 ! --- for rh dependent aerosols species
1560 
1561  do nc = 1, ncm2
1562  do nh = 1, nrhlev
1563  sumk = f_zero
1564  sums = f_zero
1565  sumok = f_zero
1566  sumokg = f_zero
1567  sumreft = f_zero
1568 
1569  do ni = nr1(nb), nr2(nb)
1570  sp = sqrt( (f_one - rhdpssa0(ni,nh,nc)) &
1571  & / (f_one - rhdpssa0(ni,nh,nc)*rhdpasy0(ni,nh,nc)) )
1572  reft = (f_one - sp) / (f_one + sp)
1573  sumreft = sumreft + reft*eirwaer(nb,ni)
1574 
1575  sumk = sumk + rhdpext0(ni,nh,nc)*eirwaer(nb,ni)
1576  sums = sums + rhdpsca0(ni,nh,nc)*eirwaer(nb,ni)
1577  sumok = sumok + rhdpssa0(ni,nh,nc)*eirwaer(nb,ni) &
1578  & * rhdpext0(ni,nh,nc)
1579  sumokg = sumokg + rhdpssa0(ni,nh,nc)*eirwaer(nb,ni) &
1580  & * rhdpext0(ni,nh,nc)*rhdpasy0(ni,nh,nc)
1581  enddo
1582 
1583  refb = sumreft * rirbd
1584 
1585  extrhd(nh,nc,ib) = sumk * rirbd
1586  scarhd(nh,nc,ib) = sums * rirbd
1587  asyrhd(nh,nc,ib) = sumokg / (sumok + 1.0e-10)
1588  ssarhd(nh,nc,ib) = 4.0*refb &
1589  & / ( (f_one+refb)**2 - asyrhd(nh,nc,ib)*(f_one-refb)**2 )
1590  enddo ! end do_nh_block
1591  enddo ! end do_nc_block for rh-dep aeros
1592 
1593 ! --- for stratospheric background aerosols
1594 
1595  sumk = f_zero
1596  do ni = nr1(nb), nr2(nb)
1597  sumk = sumk + straext0(ni)*eirwaer(nb,ni)
1598  enddo
1599 
1600  extstra(ib) = sumk * rirbd
1601 
1602 ! --- check print
1603 ! if ( nb >= 1 .and. nb < 5) then
1604 ! print *,' in optavg for ir band:',nb
1605 ! print *,' nr1, nr2:',nr1(nb),nr2(nb)
1606 ! print *,' eirwaer:',eirwaer(nb,nr1(nb):nr2(nb))
1607 ! print *,' extrhi:', extrhi(:,ib)
1608 ! do i = 1, NRHLEV
1609 ! print *,' extrhd for rhlev:',i
1610 ! print *,extrhd(i,:,ib)
1611 ! enddo
1612 ! print *,' sumk, rirbd, extstra:',sumk,rirbd,extstra(ib)
1613 ! endif
1614 
1615  enddo ! end do_nb_block for lw
1616  endif ! end if_lalwflg_block
1617 !
1618  return
1619 !................................
1620  end subroutine optavg
1621 !--------------------------------
1622 !
1623 !...................................
optavg
subroutine optavg
compute mean aerosols optical properties over each SW radiation spectral band for each of the species...
Definition: radiation_aerosols.f:1370

Here is the caller graph for this function:

subroutine gocart_init::optavg_grt ( )
private

Definition at line 4118 of file radiation_aerosols.f.

References module_radiation_aerosols::asyrhd_grt, module_radiation_aerosols::asyrhi_grt, module_radiation_aerosols::extrhd_grt, module_radiation_aerosols::extrhi_grt, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, module_radiation_aerosols::kcm1, module_radiation_aerosols::kcm2, module_radiation_aerosols::krhlev, module_radiation_aerosols::rhdpasy0_grt, module_radiation_aerosols::rhdpext0_grt, module_radiation_aerosols::rhdpssa0_grt, module_radiation_aerosols::rhidasy0_grt, module_radiation_aerosols::rhidext0_grt, module_radiation_aerosols::rhidssa0_grt, module_radiation_aerosols::ssarhd_grt, and module_radiation_aerosols::ssarhi_grt.

Referenced by module_radiation_aerosols::gocart_init().

4118 !.............................
4119 ! --- inputs: (in scope variables)
4120 ! --- outputs: (in scope variables)
4121 
4122 ! ==================================================================== !
4123 ! !
4124 ! subprogram: optavg_grt !
4125 ! !
4126 ! compute mean aerosols optical properties over each sw/lw radiation !
4127 ! spectral band for each of the species components. This program !
4128 ! follows gfdl's approach for thick cloud opertical property in !
4129 ! sw radiation scheme (2000). !
4130 ! !
4131 ! ==================== defination of variables =================== !
4132 ! !
4133 ! input arguments: !
4134 ! nv1,nv2 (NBDSW) - start/end spectral band indices of aerosol data !
4135 ! for each sw radiation spectral band !
4136 ! nr1,nr2 (NLWBND) - start/end spectral band indices of aerosol data !
4137 ! for each ir radiation spectral band !
4138 ! solwaer (NBDSW,KAERBND) !
4139 ! - solar flux weight over each sw radiation band !
4140 ! vs each aerosol data spectral band !
4141 ! eirwaer (NLWBND,KAERBND) !
4142 ! - ir flux weight over each lw radiation band !
4143 ! vs each aerosol data spectral band !
4144 ! solbnd (NBDSW) - solar flux weight over each sw radiation band !
4145 ! eirbnd (NLWBND) - ir flux weight over each lw radiation band !
4146 ! NBDSW - total number of sw spectral bands !
4147 ! NLWBND - total number of lw spectral bands !
4148 ! NSWLWBD - total number of sw+lw spectral bands !
4149 ! !
4150 ! output arguments: (to module variables) !
4151 ! !
4152 ! ================================================================== !
4153 !
4154  implicit none
4155 
4156 ! --- inputs:
4157 ! --- output:
4158 
4159 ! --- locals:
4160  real (kind=kind_phys) :: sumk, sumok, sumokg, sumreft, &
4161  & sp, refb, reft, rsolbd, rirbd
4162 
4163  integer :: ib, nb, ni, nh, nc
4164 !
4165 !===> ... begin here
4166 
4167 ! --- ... allocate aerosol optical data
4168  if (.not. allocated(extrhd_grt) .and. kcm2 > 0 ) then
4169  allocate ( extrhd_grt(krhlev,kcm2,nswlwbd) )
4170  allocate ( ssarhd_grt(krhlev,kcm2,nswlwbd) )
4171  allocate ( asyrhd_grt(krhlev,kcm2,nswlwbd) )
4172  endif
4173  if (.not. allocated(extrhi_grt) .and. kcm1 > 0 ) then
4174  allocate ( extrhi_grt(kcm1,nswlwbd) )
4175  allocate ( ssarhi_grt(kcm1,nswlwbd) )
4176  allocate ( asyrhi_grt(kcm1,nswlwbd) )
4177  endif
4178 !
4179 ! --- ... loop for each sw radiation spectral band
4180 
4181  do nb = 1, nbdsw
4182  rsolbd = f_one / solbnd(nb)
4183 
4184 ! --- for rh independent aerosol species
4185 
4186  lab_rhi: if (kcm1 > 0 ) then
4187  do nc = 1, kcm1
4188  sumk = f_zero
4189  sumok = f_zero
4190  sumokg = f_zero
4191  sumreft = f_zero
4192 
4193  do ni = nv1(nb), nv2(nb)
4194  sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) &
4195  & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) )
4196  reft = (f_one - sp) / (f_one + sp)
4197  sumreft = sumreft + reft*solwaer(nb,ni)
4198 
4199  sumk = sumk + rhidext0_grt(ni,nc)*solwaer(nb,ni)
4200  sumok = sumok + rhidssa0_grt(ni,nc)*solwaer(nb,ni) &
4201  & * rhidext0_grt(ni,nc)
4202  sumokg = sumokg + rhidssa0_grt(ni,nc)*solwaer(nb,ni) &
4203  & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc)
4204  enddo
4205 
4206  refb = sumreft * rsolbd
4207 
4208  extrhi_grt(nc,nb) = sumk * rsolbd
4209  asyrhi_grt(nc,nb) = sumokg / (sumok + 1.0e-10)
4210  ssarhi_grt(nc,nb) = 4.0*refb &
4211  & / ( (f_one+refb)**2 - asyrhi_grt(nc,nb)*(f_one-refb)**2 )
4212 
4213  enddo ! end do_nc_block for rh-ind aeros
4214  endif lab_rhi
4215 
4216 ! --- for rh dependent aerosols species
4217 
4218  lab_rhd: if (kcm2 > 0 ) then
4219  do nc = 1, kcm2
4220  do nh = 1, krhlev
4221  sumk = f_zero
4222  sumok = f_zero
4223  sumokg = f_zero
4224  sumreft = f_zero
4225 
4226  do ni = nv1(nb), nv2(nb)
4227  sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) &
4228  & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)))
4229  reft = (f_one - sp) / (f_one + sp)
4230  sumreft = sumreft + reft*solwaer(nb,ni)
4231 
4232  sumk = sumk + rhdpext0_grt(ni,nh,nc)*solwaer(nb,ni)
4233  sumok = sumok + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) &
4234  & * rhdpext0_grt(ni,nh,nc)
4235  sumokg = sumokg + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) &
4236  & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)
4237  enddo
4238 
4239  refb = sumreft * rsolbd
4240 
4241  extrhd_grt(nh,nc,nb) = sumk * rsolbd
4242  asyrhd_grt(nh,nc,nb) = sumokg / (sumok + 1.0e-10)
4243  ssarhd_grt(nh,nc,nb) = 4.0*refb &
4244  & /((f_one+refb)**2 - asyrhd_grt(nh,nc,nb)*(f_one-refb)**2)
4245  enddo ! end do_nh_block
4246  enddo ! end do_nc_block for rh-dep aeros
4247  endif lab_rhd
4248 
4249  enddo ! end do_nb_block for sw
4250 
4251 ! --- ... loop for each lw radiation spectral band
4252 
4253  do nb = 1, nlwbnd
4254 
4255  ib = nbdsw + nb
4256  rirbd = f_one / eirbnd(nb)
4257 
4258 ! --- for rh independent aerosol species
4259 
4260  lab_rhi_lw: if (kcm1 > 0 ) then
4261  do nc = 1, kcm1
4262  sumk = f_zero
4263  sumok = f_zero
4264  sumokg = f_zero
4265  sumreft = f_zero
4266 
4267  do ni = nr1(nb), nr2(nb)
4268  sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) &
4269  & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) )
4270  reft = (f_one - sp) / (f_one + sp)
4271  sumreft = sumreft + reft*eirwaer(nb,ni)
4272 
4273  sumk = sumk + rhidext0_grt(ni,nc)*eirwaer(nb,ni)
4274  sumok = sumok + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) &
4275  & * rhidext0_grt(ni,nc)
4276  sumokg = sumokg + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) &
4277  & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc)
4278  enddo
4279 
4280  refb = sumreft * rirbd
4281 
4282  extrhi_grt(nc,ib) = sumk * rirbd
4283  asyrhi_grt(nc,ib) = sumokg / (sumok + 1.0e-10)
4284  ssarhi_grt(nc,ib) = 4.0*refb &
4285  & / ( (f_one+refb)**2 - asyrhi_grt(nc,ib)*(f_one-refb)**2 )
4286  enddo ! end do_nc_block for rh-ind aeros
4287  endif lab_rhi_lw
4288 
4289 ! --- for rh dependent aerosols species
4290 
4291  lab_rhd_lw: if (kcm2 > 0 ) then
4292  do nc = 1, kcm2
4293  do nh = 1, krhlev
4294  sumk = f_zero
4295  sumok = f_zero
4296  sumokg = f_zero
4297  sumreft = f_zero
4298 
4299  do ni = nr1(nb), nr2(nb)
4300  sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) &
4301  & /(f_one - rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)) )
4302  reft = (f_one - sp) / (f_one + sp)
4303  sumreft = sumreft + reft*eirwaer(nb,ni)
4304 
4305  sumk = sumk + rhdpext0_grt(ni,nh,nc)*eirwaer(nb,ni)
4306  sumok = sumok + rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) &
4307  & * rhdpext0_grt(ni,nh,nc)
4308  sumokg = sumokg+ rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) &
4309  & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)
4310  enddo
4311 
4312  refb = sumreft * rirbd
4313 
4314  extrhd_grt(nh,nc,ib) = sumk * rirbd
4315  asyrhd_grt(nh,nc,ib) = sumokg / (sumok + 1.0e-10)
4316  ssarhd_grt(nh,nc,ib) = 4.0*refb &
4317  & /((f_one+refb)**2 - asyrhd_grt(nh,nc,ib)*(f_one-refb)**2 )
4318  enddo ! end do_nh_block
4319  enddo ! end do_nc_block for rh-dep aeros
4320  endif lab_rhd_lw
4321 
4322  enddo ! end do_nb_block for lw
4323 
4324 !
4325  return
4326 !................................

Here is the caller graph for this function:

subroutine aer_property::radclimaer ( )
private

Definition at line 3011 of file radiation_aerosols.f.

References module_radiation_aerosols::asyrhd, module_radiation_aerosols::asyrhi, module_radiation_aerosols::extrhd, module_radiation_aerosols::extrhi, module_radiation_aerosols::extstra, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, module_radiation_aerosols::idxspc, physparam::ivflip, module_radiation_aerosols::ncm, module_radiation_aerosols::ncm1, module_radiation_aerosols::nrhlev, module_radiation_aerosols::nswbnd, module_radiation_aerosols::nswlwbd, module_radiation_aerosols::nv_aod, module_radiation_aerosols::rhlev, module_radiation_aerosols::scarhd, module_radiation_aerosols::scarhi, module_radiation_aerosols::ssarhd, and module_radiation_aerosols::ssarhi.

Referenced by module_radiation_aerosols::aer_property().

3011 !................................
3012 
3013 ! --- inputs: (in scope variables)
3014 ! --- outputs: (in scope variables)
3015 
3016 ! ================================================================== !
3017 ! !
3018 ! compute aerosols optical properties in NSWLWBD bands. there are !
3019 ! seven different vertical profile structures. in the troposphere, !
3020 ! aerosol distribution at each grid point is composed from up to !
3021 ! six components out of a total of ten different substances. !
3022 ! !
3023 ! ref: wmo report wcp-112 (1986) !
3024 ! !
3025 ! input variables: !
3026 ! cmix - mixing ratioes of aerosol components - NCM !
3027 ! denn - aerosol number densities - 2 !
3028 ! rh1 - relative humidity - NLAY !
3029 ! delz - effective layer thickness km NLAY !
3030 ! idmaer - aerosol domain index - NLAY !
3031 ! NXC - number of different aerosol components- 1 !
3032 ! NLAY - vertical dimensions - 1 !
3033 ! !
3034 ! output variables: !
3035 ! tauae - optical depth - NLAY*NSWLWBD!
3036 ! ssaae - single scattering albedo - NLAY*NSWLWBD!
3037 ! asyae - asymmetry parameter - NLAY*NSWLWBD!
3038 !! aerodp - vertically integrated aer-opt-depth - IMAX*NSPC+1 !
3039 ! !
3040 ! ================================================================== !
3041 !
3042  real (kind=kind_phys) :: crt1, crt2
3043  parameter(crt1=30.0, crt2=0.03333)
3044 
3045 ! --- inputs:
3046 ! --- outputs:
3047 
3048 ! --- locals:
3049  real (kind=kind_phys) :: cm, hd, hdi, sig0u, sig0l, ratio, tt0, &
3050  & ex00, sc00, ss00, as00, ex01, sc01, ss01, as01, tt1, &
3051  & ex02, sc02, ss02, as02, ex03, sc03, ss03, as03, tt2, &
3052  & ext1, sca1, ssa1, asy1, drh0, drh1, rdrh
3053 
3054  integer :: ih1, ih2, kk, idom, icmp, ib, ii, ic, ic1
3055  integer :: idx
3056 
3057 !===> ... begin here
3058 
3059  spcodp = f_zero
3060 
3061 !===> ... loop over vertical layers from top to surface
3062 
3063  lab_do_layer : do kk = 1, nlay
3064 
3065 ! --- linear interp coeffs for rh-dep species
3066 
3067  ih2 = 1
3068  do while ( rh1(kk) > rhlev(ih2) )
3069  ih2 = ih2 + 1
3070  if ( ih2 > nrhlev ) exit
3071  enddo
3072  ih1 = max( 1, ih2-1 )
3073  ih2 = min( nrhlev, ih2 )
3074 
3075  drh0 = rhlev(ih2) - rhlev(ih1)
3076  drh1 = rh1(kk) - rhlev(ih1)
3077  if ( ih1 == ih2 ) then
3078  rdrh = f_zero
3079  else
3080  rdrh = drh1 / drh0
3081  endif
3082 
3083 ! --- assign optical properties in each domain
3084 
3085  idom = idmaer(kk)
3086 
3087  lab_if_idom : if (idom == 5) then
3088 ! --- 5th domain - upper stratosphere assume no aerosol
3089 
3090  do ib = 1, nswlwbd
3091  tauae(kk,ib) = f_zero
3092  if ( ib <= nswbnd ) then
3093  ssaae(kk,ib) = 0.99
3094  asyae(kk,ib) = 0.696
3095  else
3096  ssaae(kk,ib) = 0.5
3097  asyae(kk,ib) = 0.3
3098  endif
3099  enddo
3100 
3101  elseif (idom == 4) then lab_if_idom
3102 ! --- 4th domain - stratospheric layers
3103 
3104  do ib = 1, nswlwbd
3105  tauae(kk,ib) = extstra(ib) * delz(kk)
3106  if ( ib <= nswbnd ) then
3107  ssaae(kk,ib) = 0.99
3108  asyae(kk,ib) = 0.696
3109  else
3110  ssaae(kk,ib) = 0.5
3111  asyae(kk,ib) = 0.3
3112  endif
3113  enddo
3114 
3115 ! --- compute aod from individual species' contribution (optional)
3116  idx = idxspc(10) ! for sulfate
3117  spcodp(idx) = spcodp(idx) + tauae(kk,nv_aod)
3118 
3119  elseif (idom == 3) then lab_if_idom
3120 ! --- 3rd domain - free tropospheric layers
3121 ! 1:inso 0.17e-3; 2:soot 0.4; 7:waso 0.59983; n:730
3122 
3123  do ib = 1, nswlwbd
3124  ex01 = extrhi(1,ib)
3125  sc01 = scarhi(1,ib)
3126  ss01 = ssarhi(1,ib)
3127  as01 = asyrhi(1,ib)
3128 
3129  ex02 = extrhi(2,ib)
3130  sc02 = scarhi(2,ib)
3131  ss02 = ssarhi(2,ib)
3132  as02 = asyrhi(2,ib)
3133 
3134  ex03 = extrhd(ih1,1,ib) &
3135  & + rdrh * (extrhd(ih2,1,ib) - extrhd(ih1,1,ib))
3136  sc03 = scarhd(ih1,1,ib) &
3137  & + rdrh * (scarhd(ih2,1,ib) - scarhd(ih1,1,ib))
3138  ss03 = ssarhd(ih1,1,ib) &
3139  & + rdrh * (ssarhd(ih2,1,ib) - ssarhd(ih1,1,ib))
3140  as03 = asyrhd(ih1,1,ib) &
3141  & + rdrh * (asyrhd(ih2,1,ib) - asyrhd(ih1,1,ib))
3142 
3143  ext1 = 0.17e-3*ex01 + 0.4*ex02 + 0.59983*ex03
3144  sca1 = 0.17e-3*sc01 + 0.4*sc02 + 0.59983*sc03
3145  ssa1 = 0.17e-3*ss01*ex01 + 0.4*ss02*ex02 + 0.59983*ss03*ex03
3146  asy1 = 0.17e-3*as01*sc01 + 0.4*as02*sc02 + 0.59983*as03*sc03
3147 
3148  tauae(kk,ib) = ext1 * 730.0 * delz(kk)
3149  ssaae(kk,ib) = min(f_one, ssa1/ext1)
3150  asyae(kk,ib) = min(f_one, asy1/sca1)
3151 
3152 ! --- compute aod from individual species' contribution (optional)
3153  if ( ib==nv_aod ) then
3154  spcodp(1) = spcodp(1) + 0.17e-3*ex01*730.0*delz(kk) ! dust (inso) #1
3155  spcodp(2) = spcodp(2) + 0.4 *ex02*730.0*delz(kk) ! black carbon #2
3156  spcodp(3) = spcodp(3) + 0.59983*ex03*730.0*delz(kk) ! water soluble #7
3157  endif
3158 
3159  enddo
3160 
3161  elseif (idom == 1) then lab_if_idom
3162 ! --- 1st domain - mixing layer
3163 
3164  lab_do_ib : do ib = 1, nswlwbd
3165  ext1 = f_zero
3166  sca1 = f_zero
3167  ssa1 = f_zero
3168  asy1 = f_zero
3169 
3170  lab_do_icmp : do icmp = 1, ncm
3171  ic = icmp
3172  idx = idxspc(icmp)
3173 
3174  cm = cmix(icmp)
3175  lab_if_cm : if ( cm > f_zero ) then
3176 
3177  lab_if_ic : if ( ic <= ncm1 ) then ! component withour rh dep
3178  tt0 = cm * extrhi(ic,ib)
3179  ext1 = ext1 + tt0
3180  sca1 = sca1 + cm * scarhi(ic,ib)
3181  ssa1 = ssa1 + cm * ssarhi(ic,ib) * extrhi(ic,ib)
3182  asy1 = asy1 + cm * asyrhi(ic,ib) * scarhi(ic,ib)
3183  else lab_if_ic ! component with rh dep
3184  ic1 = ic - ncm1
3185 
3186  ex00 = extrhd(ih1,ic1,ib) &
3187  & + rdrh * (extrhd(ih2,ic1,ib) - extrhd(ih1,ic1,ib))
3188  sc00 = scarhd(ih1,ic1,ib) &
3189  & + rdrh * (scarhd(ih2,ic1,ib) - scarhd(ih1,ic1,ib))
3190  ss00 = ssarhd(ih1,ic1,ib) &
3191  & + rdrh * (ssarhd(ih2,ic1,ib) - ssarhd(ih1,ic1,ib))
3192  as00 = asyrhd(ih1,ic1,ib) &
3193  & + rdrh * (asyrhd(ih2,ic1,ib) - asyrhd(ih1,ic1,ib))
3194 
3195  tt0 = cm * ex00
3196  ext1 = ext1 + tt0
3197  sca1 = sca1 + cm * sc00
3198  ssa1 = ssa1 + cm * ss00 * ex00
3199  asy1 = asy1 + cm * as00 * sc00
3200  endif lab_if_ic
3201 
3202 ! --- compute aod from individual species' contribution (optional)
3203  if ( ib==nv_aod ) then
3204  spcodp(idx) = spcodp(idx) + tt0*denn(1)*delz(kk) ! idx for dif species
3205  endif
3206 
3207  endif lab_if_cm
3208  enddo lab_do_icmp
3209 
3210  tauae(kk,ib) = ext1 * denn(1) * delz(kk)
3211  ssaae(kk,ib) = min(f_one, ssa1/ext1)
3212  asyae(kk,ib) = min(f_one, asy1/sca1)
3213  enddo lab_do_ib
3214 
3215  elseif (idom == 2) then lab_if_idom
3216 ! --- 2nd domain - mineral transport layers
3217 
3218  do ib = 1, nswlwbd
3219  tauae(kk,ib) = extrhi(6,ib) * denn(2) * delz(kk)
3220  ssaae(kk,ib) = ssarhi(6,ib)
3221  asyae(kk,ib) = asyrhi(6,ib)
3222  enddo
3223 
3224 ! --- compute aod from individual species' contribution (optional)
3225  spcodp(1) = spcodp(1) + tauae(kk,nv_aod) ! dust
3226 
3227  else lab_if_idom
3228 ! --- domain index out off range, assume no aerosol
3229 
3230  do ib = 1, nswlwbd
3231  tauae(kk,ib) = f_zero
3232  ssaae(kk,ib) = f_one
3233  asyae(kk,ib) = f_zero
3234  enddo
3235 
3236 ! write(6,19) kk,idom
3237 ! 19 format(/' *** ERROR in sub AEROS: domain index out' &
3238 ! &, ' of range! K, IDOM =',3i5,' ***')
3239 ! stop 19
3240 
3241  endif lab_if_idom
3242 
3243  enddo lab_do_layer
3244 
3245 !
3246 !===> ... smooth profile at domain boundaries
3247 !
3248  if ( ivflip == 0 ) then ! input from toa to sfc
3249 
3250  do ib = 1, nswlwbd
3251  do kk = 2, nlay
3252  if ( tauae(kk,ib) > f_zero ) then
3253  ratio = tauae(kk-1,ib) / tauae(kk,ib)
3254  else
3255  ratio = f_one
3256  endif
3257 
3258  tt0 = tauae(kk,ib) + tauae(kk-1,ib)
3259  tt1 = 0.2 * tt0
3260  tt2 = tt0 - tt1
3261 
3262  if ( ratio > crt1 ) then
3263  tauae(kk,ib) = tt1
3264  tauae(kk-1,ib) = tt2
3265  endif
3266 
3267  if ( ratio < crt2 ) then
3268  tauae(kk,ib) = tt2
3269  tauae(kk-1,ib) = tt1
3270  endif
3271  enddo ! do_kk_loop
3272  enddo ! do_ib_loop
3273 
3274  else ! input from sfc to toa
3275 
3276  do ib = 1, nswlwbd
3277  do kk = nlay-1, 1, -1
3278  if ( tauae(kk,ib) > f_zero ) then
3279  ratio = tauae(kk+1,ib) / tauae(kk,ib)
3280  else
3281  ratio = f_one
3282  endif
3283 
3284  tt0 = tauae(kk,ib) + tauae(kk+1,ib)
3285  tt1 = 0.2 * tt0
3286  tt2 = tt0 - tt1
3287 
3288  if ( ratio > crt1 ) then
3289  tauae(kk,ib) = tt1
3290  tauae(kk+1,ib) = tt2
3291  endif
3292 
3293  if ( ratio < crt2 ) then
3294  tauae(kk,ib) = tt2
3295  tauae(kk+1,ib) = tt1
3296  endif
3297  enddo ! do_kk_loop
3298  enddo ! do_ib_loop
3299 
3300  endif
3301 
3302 !
3303  return
3304 !................................
3305  end subroutine radclimaer
3306 !--------------------------------
3307 !
3308 !...................................
radclimaer
subroutine radclimaer
This subroutine computes aerosols optical properties in NSWLWBD bands. there are seven different vert...
Definition: radiation_aerosols.f:3011

Here is the caller graph for this function:

subroutine gocart_init::rd_gocart_clim ( )
private
  1. read in aerosol dry mass and surface pressure from GEOS3-GOCART C3.1 2000 monthly dataset or aerosol mixing ratio and surface pressure from GEOS4-GOCART 2000-2007 averaged monthly data set.
  2. compute goes lat/lon array (for horizontal mapping)

Definition at line 4336 of file radiation_aerosols.f.

References module_radiation_aerosols::dltx, module_radiation_aerosols::dlty, module_radiation_aerosols::dm_indx, module_radiation_aerosols::dmclmg, module_radiation_aerosols::f_zero, module_radiation_aerosols::geos_rlat, module_radiation_aerosols::geos_rlon, module_radiation_aerosols::gocart_climo, module_radiation_aerosols::gridcomp, module_radiation_aerosols::imxg, module_radiation_aerosols::jmxg, module_radiation_aerosols::kmxg, module_radiation_aerosols::molwgt, module_radiation_aerosols::nmxg, module_radiation_aerosols::num_gridcomp, and module_radiation_aerosols::psclmg.

Referenced by module_radiation_aerosols::gocart_init().

4336 !...................................
4337 ! --- inputs: (in scope variables)
4338 ! --- outputs: (in scope variables)
4339 
4340 ! ================================================================== !
4341 ! !
4342 ! subprogram: rd_gocart_clim !
4343 ! !
4344 ! 1. read in aerosol dry mass and surface pressure from GEOS3-GOCART !
4345 ! C3.1 2000 monthly data set !
4346 ! or aerosol mixing ratio and surface pressure from GEOS4-GOCART !
4347 ! 2000-2007 averaged monthly data set !
4348 ! 2. compute goes lat/lon array (for horizontal mapping) !
4349 ! !
4350 ! ==================== defination of variables =================== !
4351 ! !
4352 ! inputs arguments: !
4353 ! imon - month of the year !
4354 ! me - print message control flag !
4355 ! !
4356 ! outputs arguments: (to the module variables) !
4357 ! psclmg - pressure (sfc to toa) cb IMXG*JMXG*KMXG !
4358 ! dmclmg - aerosol dry mass/mixing ratio IMXG*JMXG*KMXG*NMXG !
4359 ! geos_rlon - goes longitude deg IMXG !
4360 ! geos_rlat - goes latitude deg JMXG !
4361 ! !
4362 ! usage: call rd_gocart_clim !
4363 ! !
4364 ! program history: !
4365 ! 05/18/2010 --- Lu Add the option to read GEOS4-GOCART climo !
4366 ! ================================================================== !
4367 !
4368  implicit none
4369 
4370 ! --- inputs:
4371 ! --- output:
4372 
4373 ! --- locals:
4374  integer, parameter :: maxspc = 5
4375  real (kind=kind_io4), parameter :: pint = 0.01
4376  real (kind=kind_io4), parameter :: epsq = 0.0
4377 
4378  integer :: i, j, k, numspci, ii
4379  integer :: icmp, nrecl, nt1, nt2, nn(maxspc)
4380  character :: ymd*6, yr*4, mn*2, tp*2, &
4381  & fname*30, fin*30, aerosol_file*40
4382  logical :: file_exist
4383 
4384  real (kind=kind_io4), dimension(KMXG) :: sig
4385  real (kind=kind_io4), dimension(IMXG,JMXG) :: ps
4386  real (kind=kind_io4), dimension(IMXG,JMXG,KMXG) :: temp
4387  real (kind=kind_io4), dimension(IMXG,JMXG,KMXG,MAXSPC):: buff
4388  real (kind=kind_phys) :: pstmp
4389 
4390 ! Add the following variables for GEOS4-GOCART
4391  real (kind=kind_io4), dimension(KMXG):: hyam, hybm
4392  real (kind=kind_io4) :: p0
4393 
4394  data yr /'2000'/ !!<=== use 2000 as the climo proxy
4395 
4396 !* sigma_coordinate for GEOS3-GOCART
4397 !* P(i,j,k) = PINT + SIG(k) * (PS(i,j) - PINT)
4398  data sig / &
4399  & 9.98547e-01,9.94147e-01,9.86350e-01,9.74300e-01,9.56950e-01, &
4400  & 9.33150e-01,9.01750e-01,8.61500e-01,8.11000e-01,7.50600e-01, &
4401  & 6.82900e-01,6.10850e-01,5.37050e-01,4.63900e-01,3.93650e-01, &
4402  & 3.28275e-01,2.69500e-01,2.18295e-01,1.74820e-01,1.38840e-01, &
4403  & 1.09790e-01,8.66900e-02,6.84150e-02,5.39800e-02,4.25750e-02, &
4404  & 3.35700e-02,2.39900e-02,1.36775e-02,5.01750e-03,5.30000e-04 /
4405 
4406 !* hybrid_sigma_pressure_coordinate for GEOS4-GOCART
4407 !* p(i,j,k) = a(k)*p0 + b(k)*ps(i,j)
4408  data hyam/ &
4409  & 0, 0.0062694, 0.02377049, 0.05011813, 0.08278809, 0.1186361, &
4410  & 0.1540329, 0.1836373, 0.2043698, 0.2167788, 0.221193, &
4411  & 0.217729, 0.2062951, 0.1865887, 0.1615213, 0.1372958, &
4412  & 0.1167039, 0.09920014, 0.08432171, 0.06656809, 0.04765031, &
4413  & 0.03382346, 0.0237648, 0.01435208, 0.00659734, 0.002826232, &
4414  & 0.001118959, 0.0004086494, 0.0001368611, 3.750308e-05/
4415 
4416  data hybm / &
4417  & 0.992555, 0.9642, 0.90556, 0.816375, 0.703815, 0.576585, &
4418  & 0.44445, 0.324385, 0.226815, 0.149165, 0.089375, &
4419  & 0.045865, 0.017485, 0.00348, 0, 0, 0, 0, 0, &
4420  & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
4421 
4422  data p0 /1013.25 /
4423 
4424 !===> ... begin here
4425 
4426 ! --- allocate and initialize gocart climatological data
4427  if ( .not. allocated (dmclmg) ) then
4428  allocate ( dmclmg(imxg,jmxg,kmxg,nmxg) )
4429  allocate ( psclmg(imxg,jmxg,kmxg) )
4430  allocate ( molwgt(nmxg) )
4431  endif
4432 
4433  dmclmg(:,:,:,:) = f_zero
4434  psclmg(:,:,:) = f_zero
4435  molwgt(:) = f_zero
4436 
4437 ! --- allocate and initialize geos lat and lon arrays
4438  if ( .not. allocated ( geos_rlon )) then
4439  allocate (geos_rlon(imxg))
4440  allocate (geos_rlat(jmxg))
4441  endif
4442 
4443  geos_rlon(:) = f_zero
4444  geos_rlat(:) = f_zero
4445 
4446 ! --- compute geos lat and lon arrays
4447  do i = 1, imxg
4448  geos_rlon(i) = -180. + (i-1)* dltx
4449  end do
4450  do j = 2, jmxg-1
4451  geos_rlat(j) = -90. + (j-1)* dlty
4452  end do
4453  geos_rlat(1) = -89.5
4454  geos_rlat(jmxg) = 89.5
4455 
4456 ! --- determine whether GEOS3 or GEOS4 data set is provided
4457  if ( gocart_climo == 'xxxx' ) then
4458  gocart_climo='0000'
4459 ! check geos3-gocart climo
4460  aerosol_file = '200001.PS.avg'
4461  inquire (file = aerosol_file, exist = file_exist)
4462  if ( file_exist ) gocart_climo='ver3'
4463 ! check geos4-gocart climo
4464  aerosol_file = 'gocart_climo_2000x2007_ps_01.bin'
4465  inquire (file = aerosol_file, exist = file_exist)
4466  if ( file_exist ) gocart_climo='ver4'
4467  endif
4468 !
4469 !
4470 ! --- read ps (sfc pressure) and compute 3d pressure field (psclmg)
4471 !
4472  write(mn,'(i2.2)') imon
4473  ymd = yr//mn
4474  aerosol_file = 'null'
4475  if ( gocart_climo == 'ver3' ) then
4476  aerosol_file = ymd//'.PS.avg'
4477  elseif ( gocart_climo == 'ver4' ) then
4478  aerosol_file = 'gocart_climo_2000x2007_ps_'//mn//'.bin'
4479  endif
4480 !
4481  inquire (file = aerosol_file, exist = file_exist)
4482  lab_if_ps : if ( file_exist ) then
4483 
4484  close(niaercm)
4485  if ( gocart_climo == 'ver3' ) then
4486  nrecl = 4 * (imxg * jmxg)
4487  open(niaercm, file=trim(aerosol_file), &
4488  & access='direct',recl=nrecl)
4489  read(niaercm, rec=1) ps
4490  do j = 1, jmxg
4491  do i = 1, imxg
4492  do k = 1, kmxg
4493  pstmp = pint + sig(k) * (ps(i,j) - pint)
4494  psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb
4495  enddo
4496  enddo
4497  enddo
4498 
4499  elseif ( gocart_climo == 'ver4' ) then
4500  open(niaercm, file=trim(aerosol_file), &
4501  & status='old', form='unformatted')
4502  read(niaercm) ps(:,:)
4503  do j = 1, jmxg
4504  do i = 1, imxg
4505  do k = 1, kmxg
4506  pstmp = hyam(k)*p0 + hybm(k)*ps(i,j)
4507  psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb
4508  enddo
4509  enddo
4510  enddo
4511 
4512  endif ! ---- end if_gocart_climo
4513 
4514  else lab_if_ps
4515 
4516  print *,' *** Requested aerosol data file "', &
4517  & trim(aerosol_file), '" not found!'
4518  print *,' *** Stopped in RD_GOCART_CLIM ! ', me
4519  stop 1006
4520  endif lab_if_ps
4521 !
4522 ! --- read aerosol dry mass (g/m3) or mixing ratios (mol/mol,kg/kg)
4523 !
4524  lab_do_icmp : do icmp = 1, num_gridcomp
4525 
4526  tp = gridcomp(icmp)
4527 
4528 ! determine aerosol_file
4529  aerosol_file = 'null'
4530  if ( gocart_climo == 'ver3' ) then
4531  if(tp == 'DU') fname='.DU.STD.tv20.g.avg'
4532  if(tp == 'SS') fname='.SS.STD.tv17.g.avg'
4533  if(tp == 'SU') fname='.SU.STD.tv15.g.avg'
4534  if(tp == 'OC') fname='.CC.STD.tv15.g.avg'
4535  if(tp == 'BC') fname='.CC.STD.tv15.g.avg'
4536  aerosol_file=ymd//trim(fname)
4537  elseif ( gocart_climo == 'ver4' ) then
4538  fin = 'gocart_climo_2000x2007_'
4539  if(tp == 'DU') fname=trim(fin)//'du_'
4540  if(tp == 'SS') fname=trim(fin)//'ss_'
4541  if(tp == 'SU') fname=trim(fin)//'su_'
4542  if(tp == 'OC') fname=trim(fin)//'cc_'
4543  if(tp == 'BC') fname=trim(fin)//'cc_'
4544  aerosol_file=trim(fname)//mn//'.bin'
4545  endif
4546 
4547  numspci = 4
4548  if(tp == 'DU') numspci = 5
4549  inquire (file=trim(aerosol_file), exist = file_exist)
4550  lab_if_aer: if ( file_exist ) then
4551 !
4552  close(niaercm)
4553  if ( gocart_climo == 'ver3' ) then
4554  nrecl = 4 * numspci * (imxg * jmxg * kmxg + 3)
4555  open (niaercm, file=trim(aerosol_file), &
4556  & access='direct', recl=nrecl)
4557  read(niaercm,rec=1)(nt1,nt2,nn(i),buff(:,:,:,i),i=1,numspci)
4558 
4559  elseif ( gocart_climo == 'ver4' ) then
4560  open (niaercm, file=trim(aerosol_file), &
4561  & status='old', form='unformatted')
4562  do i = 1, numspci
4563  do k = 1, kmxg
4564  read(niaercm) temp(:,:,k)
4565  buff(:,:,k,i) = temp(:,:,k)
4566  enddo
4567  enddo
4568  endif
4569 
4570 !!===> fill dmclmg with working array buff
4571  select case ( tp )
4572 
4573 ! fill in DU from DU: du1, du2, du3, du4, du5
4574  case ('DU' )
4575  if ( dm_indx%dust1 /= -999) then
4576  do ii = 1, 5
4577  dmclmg(:,:,:,dm_indx%dust1+ii-1) = buff(:,:,:,ii)
4578  enddo
4579  else
4580  print *, 'ERROR: invalid DU index, abort! ',me
4581  stop 1007
4582  endif
4583 
4584 ! fill in BC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic
4585  case ('BC' )
4586  if ( dm_indx%soot_phobic /= -999) then
4587  dmclmg(:,:,:,dm_indx%soot_phobic)=buff(:,:,:,1)
4588  dmclmg(:,:,:,dm_indx%soot_philic)=buff(:,:,:,3)
4589  molwgt(dm_indx%soot_phobic) = 12.
4590  molwgt(dm_indx%soot_philic) = 12.
4591  else
4592  print *, 'ERROR: invalid BC index, abort! ',me
4593  stop 1008
4594  endif
4595 
4596 ! fill in SU from SU: dms, so2, so4, msa
4597  case ('SU' )
4598  if ( dm_indx%suso /= -999) then
4599  dmclmg(:,:,:,dm_indx%suso) = buff(:,:,:,3)
4600  molwgt(dm_indx%suso) = 96.
4601  else
4602  print *, 'ERROR: invalid SU index, abort! ',me
4603  stop 1009
4604  endif
4605 
4606 ! fill in OC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic
4607  case ('OC' )
4608  if ( dm_indx%waso_phobic /= -999) then
4609  dmclmg(:,:,:,dm_indx%waso_phobic) = 1.4*buff(:,:,:,2)
4610  dmclmg(:,:,:,dm_indx%waso_philic) = 1.4*buff(:,:,:,4)
4611  molwgt(dm_indx%waso_phobic) = 12.
4612  molwgt(dm_indx%waso_philic) = 12.
4613  else
4614  print *, 'ERROR: invalid OC index, abort! ',me
4615  stop 1010
4616  endif
4617 
4618 ! fill in SS from SS: ss1, ss2, ss3, ss4
4619  case ('SS' )
4620  if ( dm_indx%ssam /= -999) then
4621  dmclmg(:,:,:,dm_indx%ssam) = buff(:,:,:,1)
4622  dmclmg(:,:,:,dm_indx%sscm) = buff(:,:,:,2) + &
4623  & buff(:,:,:,3)+buff(:,:,:,4)
4624  else
4625  print *, 'ERROR: invalid SS index, abort! ',me
4626  stop 1011
4627  endif
4628 
4629  case default
4630 
4631  print *, 'ERROR: invalid aerosol species, abort ',tp
4632  stop 1012
4633 
4634  end select
4635 
4636  else lab_if_aer
4637  print *,' *** Requested aerosol data file "',aerosol_file, &
4638  & '" not found!'
4639  print *,' *** Stopped in RD_GOCART_CLIM ! ', me
4640  stop 1013
4641  endif lab_if_aer
4642 
4643  enddo lab_do_icmp
4644 
4645  return
4646 !...................................
4647  end subroutine rd_gocart_clim
4648 !-----------------------------------
4649 !
4650 !...................................
rd_gocart_clim
subroutine rd_gocart_clim
This subroutine:
Definition: radiation_aerosols.f:4336

Here is the caller graph for this function:

subroutine gocart_init::rd_gocart_luts ( )
private

Definition at line 3942 of file radiation_aerosols.f.

References module_radiation_aerosols::iendwv_grt, module_radiation_aerosols::isoot, module_radiation_aerosols::issam, module_radiation_aerosols::isscm, module_radiation_aerosols::isuso, module_radiation_aerosols::iwaso, module_radiation_aerosols::kaerbnd, module_radiation_aerosols::kcm1, module_radiation_aerosols::kcm2, module_radiation_aerosols::krhlev, module_radiation_aerosols::lckprnt, module_radiation_aerosols::rhdpasy0_grt, module_radiation_aerosols::rhdpext0_grt, module_radiation_aerosols::rhdpssa0_grt, module_radiation_aerosols::rhidasy0_grt, module_radiation_aerosols::rhidext0_grt, and module_radiation_aerosols::rhidssa0_grt.

Referenced by module_radiation_aerosols::gocart_init().

3942 !.............................
3943 ! --- inputs: (in scope variables)
3944 ! --- outputs: (in scope variables)
3945 
3946 ! ==================================================================== !
3947 ! subprogram: rd_gocart_luts !
3948 ! read input gocart aerosol optical data from Mie code calculations !
3949 ! !
3950 ! Remarks (Quanhua (Mark) Liu, JCSDA, June 2008) !
3951 ! The LUT is for NCEP selected 61 wave numbers and 6 aerosols !
3952 ! (dust, soot, suso, waso, ssam, and sscm) and 36 aerosol effective !
3953 ! size in microns. !
3954 ! !
3955 ! The LUT is computed using Mie code with a logorithm size !
3956 ! distribution for each of 36 effective sizes. The standard deviation !
3957 ! sigma of the size, and min/max size follows Chin et al. 2000 !
3958 ! For each effective size, it corresponds a relative humidity value. !
3959 ! !
3960 ! The LUT contains the density, sigma, relative humidity, mean mode !
3961 ! radius, effective size, mass extinction coefficient, single !
3962 ! scattering albedo, asymmetry factor, and phase function !
3963 ! !
3964 ! ================================================================== !
3965 !
3966  implicit none
3967 
3968 ! --- inputs:
3969 ! --- output:
3970 
3971 ! --- locals:
3972  INTEGER, PARAMETER :: np = 100, np2 = 2*np, nwave=100, &
3973  & naero=6, n_p=36
3974  INTEGER :: nw, ns, nh, n_bin
3975  real (kind=kind_io8), Dimension( NP2 ) :: angle, cos_angle, &
3976  & Cos_Weight
3977  real (kind=kind_io8), Dimension(n_p,nAero) :: rh, rm, reff
3978  real (kind=kind_io8), Dimension(nWave,n_p,nAero) :: &
3979  & ext0, sca0, asy0
3980  real (kind=kind_io8), Dimension(NP2,n_p,nWave,nAero) :: ph0
3981  real (kind=kind_io8) :: wavelength(nwave), density(naero), &
3982  & sigma(nAero), wave,n_fac,PI,t1,s1,g1
3983  CHARACTER(len=80) :: aerosolname(naero)
3984  INTEGER :: i, j, k, l, ij
3985 
3986  character :: aerosol_file*30
3987  logical :: file_exist
3988  integer :: indx_dust(8) ! map 36 dust bins to gocart size bins
3989 
3990  data aerosol_file /"NCEP_AEROSOL.bin"/
3991  data aerosolname/ ' Dust ', ' Soot ', ' SUSO ', ' WASO ', &
3992  & ' SSAM ', ' SSCM '/
3993 
3994 !! 8 dust bins
3995 !! 1 2 3 4 5 6 7 8
3996 !! .1-.18, .18-.3, .3-.6, 0.6-1.0, 1.0-1.8, 1.8-3, 3-6, 6-10 <-- def
3997 !! 0.1399 0.2399 0.4499 0.8000 1.3994 2.3964 4.4964 7.9887 <-- reff
3998  data indx_dust/4, 8, 12, 18, 21, 24, 30, 36/
3999 
4000  pi = acos(-1.d0)
4001 
4002 ! -- allocate aerosol optical data
4003  if ( .not. allocated( iendwv_grt ) ) then
4004  allocate ( iendwv_grt(kaerbnd) )
4005  endif
4006  if (.not. allocated(rhidext0_grt) .and. kcm1 > 0 ) then
4007  allocate ( rhidext0_grt(kaerbnd,kcm1))
4008  allocate ( rhidssa0_grt(kaerbnd,kcm1))
4009  allocate ( rhidasy0_grt(kaerbnd,kcm1))
4010  endif
4011  if (.not. allocated(rhdpext0_grt) .and. kcm2 > 0 ) then
4012  allocate ( rhdpext0_grt(kaerbnd,krhlev,kcm2))
4013  allocate ( rhdpssa0_grt(kaerbnd,krhlev,kcm2))
4014  allocate ( rhdpasy0_grt(kaerbnd,krhlev,kcm2))
4015  endif
4016 
4017 ! -- read luts
4018  inquire (file = aerosol_file, exist = file_exist)
4019 
4020  if ( file_exist ) then
4021  if(me==0 .and. lckprnt) print *,'RAD -open :',aerosol_file
4022  close (niaercm)
4023  open (unit=niaercm,file=aerosol_file,status='OLD', &
4024  & form='UNFORMATTED')
4025  else
4026  print *,' Requested aerosol data file "',aerosol_file, &
4027  & '" not found!', me
4028  print *,' *** Stopped in subroutine RD_GOCART_LUTS !!'
4029  stop 1003
4030  endif ! end if_file_exist_block
4031 
4032  READ(niaercm) (cos_angle(i),i=1,np)
4033  READ(niaercm) (cos_weight(i),i=1,np)
4034  READ(niaercm)
4035  READ(niaercm)
4036  READ(niaercm) nw,ns
4037  READ(niaercm)
4038  READ(niaercm) (wavelength(i),i=1,nw)
4039 
4040 ! --- check nAero and NW
4041  if (nw /= kaerbnd) then
4042  print *, "Incorrect spectral band, abort ", nw
4043  stop 1004
4044  endif
4045 
4046 ! --- convert wavelength to wavenumber
4047  do i = 1, kaerbnd
4048  iendwv_grt(i) = 10000. / wavelength(i)
4049  if(me==0 .and. lckprnt) print *,'RAD -wn,lamda:', &
4050  & i,iendwv_grt(i),wavelength(i)
4051  enddo
4052 
4053  DO j = 1, naero
4054  if(me==0 .and. lckprnt) print *,'RAD -read LUTs:', &
4055  & j,aerosolname(j)
4056  READ(niaercm)
4057  READ(niaercm)
4058  READ(niaercm) n_bin, density(j), sigma(j)
4059  READ(niaercm)
4060  READ(niaercm) (rh(i,j),i=1, n_bin)
4061  READ(niaercm)
4062  READ(niaercm) (rm(i,j),i=1, n_bin)
4063  READ(niaercm)
4064  READ(niaercm) (reff(i,j),i=1, n_bin)
4065 
4066 ! --- check n_bin
4067  if (n_bin /= krhlev ) then
4068  print *, "Incorrect rh levels, abort ", n_bin
4069  stop 1005
4070  endif
4071 
4072 ! --- read luts
4073  DO k = 1, nw
4074  READ(niaercm) wave,(ext0(k,l,j),l=1,n_bin)
4075  READ(niaercm) (sca0(k,l,j),l=1,n_bin)
4076  READ(niaercm) (asy0(k,l,j),l=1,n_bin)
4077  READ(niaercm) (ph0(1:np2,l,k,j),l=1,n_bin)
4078  END DO
4079 
4080 ! --- map luts input to module variables
4081  if (aerosolname(j) == ' Dust ' ) then
4082  if ( kcm1 > 0) then
4083  do i = 1, kcm1
4084  rhidext0_grt(1:kaerbnd,i)=ext0(1:kaerbnd,indx_dust(i),j)
4085  rhidssa0_grt(1:kaerbnd,i)=sca0(1:kaerbnd,indx_dust(i),j)
4086  rhidasy0_grt(1:kaerbnd,i)=asy0(1:kaerbnd,indx_dust(i),j)
4087  enddo
4088  endif
4089  else
4090  if ( kcm2 > 0) then
4091  if (aerosolname(j) == ' Soot ') ij = isoot
4092  if (aerosolname(j) == ' SUSO ') ij = isuso
4093  if (aerosolname(j) == ' WASO ') ij = iwaso
4094  if (aerosolname(j) == ' SSAM ') ij = issam
4095  if (aerosolname(j) == ' SSCM ') ij = isscm
4096  if ( ij .ne. -999 ) then
4097  rhdpext0_grt(1:kaerbnd,1:krhlev,ij) = &
4098  & ext0(1:kaerbnd,1:krhlev,j)
4099  rhdpssa0_grt(1:kaerbnd,1:krhlev,ij) = &
4100  & sca0(1:kaerbnd,1:krhlev,j)
4101  rhdpasy0_grt(1:kaerbnd,1:krhlev,ij) = &
4102  & asy0(1:kaerbnd,1:krhlev,j)
4103  endif ! if_ij
4104  endif ! if_KCM2
4105  endif
4106  END DO
4107 
4108  return
4109 !...................................

Here is the caller graph for this function:

subroutine clim_aerinit::set_aercoef ( )
private

Definition at line 1033 of file radiation_aerosols.f.

References physparam::aeros_file, module_radiation_aerosols::asyrhd, module_radiation_aerosols::asyrhi, module_radiation_aerosols::extrhd, module_radiation_aerosols::extrhi, module_radiation_aerosols::extstra, module_radiation_aerosols::f_zero, module_radiation_aerosols::haer, module_radiation_aerosols::imxae, module_radiation_aerosols::jmxae, physparam::lalwflg, physparam::laswflg, module_radiation_aerosols::naerbnd, module_radiation_aerosols::ncm1, module_radiation_aerosols::ncm2, module_radiation_aerosols::nlwbnd, module_radiation_aerosols::nlwstr, module_radiation_aerosols::nrhlev, module_radiation_aerosols::nswbnd, module_radiation_aerosols::nswlwbd, module_radsw_parameters::nswstr, module_radiation_aerosols::nv_aod, optavg(), module_radiation_aerosols::prsref, module_radiation_aerosols::scarhd, module_radiation_aerosols::scarhi, module_radiation_aerosols::sigref, module_radiation_aerosols::ssarhd, module_radiation_aerosols::ssarhi, module_radiation_aerosols::wvn550, module_radlw_parameters::wvnlw1, and module_radlw_parameters::wvnlw2.

Referenced by module_radiation_aerosols::clim_aerinit().

1033 !................................
1034 ! --- inputs: (in-scope variables, module constants)
1035 ! --- outputs: (module variables)
1036 
1037 ! ================================================================== !
1038 ! !
1039 ! subprogram : set_aercoef !
1040 ! !
1041 ! this is the initialization progrmam for climatological aerosols !
1042 ! !
1043 ! the program reads and maps the pre-tabulated aerosol optical !
1044 ! spectral data onto corresponding sw radiation spectral bands. !
1045 ! !
1046 ! ==================== defination of variables =================== !
1047 ! !
1048 ! inputs: (in-scope variables, module constants) !
1049 ! solfwv(:) - real, solar flux for individual wavenumber (w/m2) !
1050 ! eirfwv(:) - real, lw flux(273k) for individual wavenum (w/m2) !
1051 ! me - integer, select cpu number as print control flag !
1052 ! !
1053 ! outputs: (to the module variables) !
1054 ! !
1055 ! external module variables: (in physparam) !
1056 ! lalwflg - module control flag for lw trop-aer: =f:no; =t:yes !
1057 ! laswflg - module control flag for sw trop-aer: =f:no; =t:yes !
1058 ! aeros_file- external aerosol data file name !
1059 ! !
1060 ! internal module variables: !
1061 ! IMXAE - number of longitude points in global aeros data set !
1062 ! JMXAE - number of latitude points in global aeros data set !
1063 ! wvnsw1,wvnsw2 (NSWSTR:NSWEND) !
1064 ! - start/end wavenumbers for each of sw bands !
1065 ! wvnlw1,wvnlw2 ( 1:NBDLW) !
1066 ! - start/end wavenumbers for each of lw bands !
1067 ! NSWLWBD - total num of bands (sw+lw) for aeros optical properties!
1068 ! NSWBND - number of sw spectral bands actually invloved !
1069 ! NLWBND - number of lw spectral bands actually invloved !
1070 ! NIAERCM - unit number for reading input data set !
1071 ! extrhi - extinction coef for rh-indep aeros NCM1*NSWLWBD!
1072 ! scarhi - scattering coef for rh-indep aeros NCM1*NSWLWBD!
1073 ! ssarhi - single-scat-alb for rh-indep aeros NCM1*NSWLWBD!
1074 ! asyrhi - asymmetry factor for rh-indep aeros NCM1*NSWLWBD!
1075 ! extrhd - extinction coef for rh-dep aeros NRHLEV*NCM2*NSWLWBD!
1076 ! scarhd - scattering coef for rh-dep aeros NRHLEV*NCM2*NSWLWBD!
1077 ! ssarhd - single-scat-alb for rh-dep aeros NRHLEV*NCM2*NSWLWBD!
1078 ! asyrhd - asymmetry factor for rh-dep aeros NRHLEV*NCM2*NSWLWBD!
1079 ! !
1080 ! major local variables: !
1081 ! for handling spectral band structures !
1082 ! iendwv - ending wvnum (cm**-1) for each band NAERBND !
1083 ! for handling optical properties of rh independent species (NCM1) !
1084 ! 1. insoluble (inso); 2. soot (soot); !
1085 ! 3. mineral nuc mode (minm); 4. mineral acc mode (miam); !
1086 ! 5. mineral coa mode (micm); 6. mineral transport(mitr). !
1087 ! rhidext0 - extinction coefficient NAERBND*NCM1 !
1088 ! rhidsca0 - scattering coefficient NAERBND*NCM1 !
1089 ! rhidssa0 - single scattering albedo NAERBND*NCM1 !
1090 ! rhidasy0 - asymmetry parameter NAERBND*NCM1 !
1091 ! for handling optical properties of rh ndependent species (NCM2) !
1092 ! 1. water soluble (waso); 2. sea salt acc mode(ssam); !
1093 ! 3. sea salt coa mode(sscm); 4. sulfate droplets (suso). !
1094 ! rh level (NRHLEV): 00%, 50%, 70%, 80%, 90%, 95%, 98%, 99% !
1095 ! rhdpext0 - extinction coefficient NAERBND,NRHLEV,NCM2!
1096 ! rhdpsca0 - scattering coefficient NAERBND,NRHLEV,NCM2!
1097 ! rhdpssa0 - single scattering albedo NAERBND,NRHLEV,NCM2!
1098 ! rhdpasy0 - asymmetry parameter NAERBND,NRHLEV,NCM2!
1099 ! for handling optical properties of stratospheric bkgrnd aerosols !
1100 ! straext0 - extingction coefficients NAERBND !
1101 ! !
1102 ! usage: call set_aercoef !
1103 ! !
1104 ! subprograms called: optavg !
1105 ! !
1106 ! ================================================================== !
1107 !
1108 ! --- inputs: ( none )
1109 ! --- output: ( none )
1110 
1111 ! --- locals:
1112  integer, dimension(NAERBND) :: iendwv
1113 
1114  integer :: i, j, k, m, mb, ib, ii, id, iw, iw1, iw2
1115 
1116  real (kind=kind_phys) :: sumsol, sumir
1117 
1118  logical :: file_exist
1119  character :: cline*80
1120 !
1121 !===> ... begin here
1122 !
1123 ! --- ... reading climatological aerosols data
1124 
1125  inquire (file=aeros_file, exist=file_exist)
1126 
1127  if ( file_exist ) then
1128  close (niaercm)
1129  open (unit=niaercm,file=aeros_file,status='OLD', &
1130  & form='FORMATTED')
1131  rewind(niaercm)
1132  else
1133  print *,' Requested aerosol data file "',aeros_file, &
1134  & '" not found!'
1135  print *,' *** Stopped in subroutine aero_init !!'
1136  stop
1137  endif ! end if_file_exist_block
1138 
1139 ! --- ... skip monthly global distribution
1140 
1141  do m = 1, 12
1142  read (niaercm,12) cline
1143  12 format(a80/)
1144 
1145  do j = 1, jmxae
1146  do i = 1, imxae
1147  read(niaercm,*) id
1148  enddo
1149  enddo
1150  enddo ! end do_m_block
1151 
1152 ! --- ... aloocate and input aerosol optical data
1153 
1154  if ( .not. allocated( extrhi ) ) then
1155  allocate ( extrhi( ncm1,nswlwbd) )
1156  allocate ( scarhi( ncm1,nswlwbd) )
1157  allocate ( ssarhi( ncm1,nswlwbd) )
1158  allocate ( asyrhi( ncm1,nswlwbd) )
1159  allocate ( extrhd(nrhlev,ncm2,nswlwbd) )
1160  allocate ( scarhd(nrhlev,ncm2,nswlwbd) )
1161  allocate ( ssarhd(nrhlev,ncm2,nswlwbd) )
1162  allocate ( asyrhd(nrhlev,ncm2,nswlwbd) )
1163  allocate ( extstra( nswlwbd) )
1164  endif
1165 
1166  read(niaercm,21) cline ! ending wave num for 61 aeros spectral bands
1167  21 format(a80)
1168  read(niaercm,22) iendwv(:)
1169  22 format(13i6)
1170 
1171  read(niaercm,21) cline ! atmos scale height for 5 domains, 7 profs
1172  read(niaercm,24) haer(:,:)
1173  24 format(20f4.1)
1174 
1175  read(niaercm,21) cline ! reference pressure for 5 domains, 7 profs
1176  read(niaercm,26) prsref(:,:)
1177  26 format(10f7.2)
1178 
1179  read(niaercm,21) cline ! rh indep ext coef for 61 bands, 6 species
1180  read(niaercm,28) rhidext0(:,:)
1181  28 format(8e10.3)
1182 
1183  read(niaercm,21) cline ! rh indep sca coef for 61 bands, 6 species
1184  read(niaercm,28) rhidsca0(:,:)
1185 
1186  read(niaercm,21) cline ! rh indep ssa coef for 61 bands, 6 species
1187  read(niaercm,28) rhidssa0(:,:)
1188 
1189  read(niaercm,21) cline ! rh indep asy coef for 61 bands, 6 species
1190  read(niaercm,28) rhidasy0(:,:)
1191 
1192  read(niaercm,21) cline ! rh dep ext coef for 61 bands, 8 rh lev, 4 species
1193  read(niaercm,28) rhdpext0(:,:,:)
1194 
1195  read(niaercm,21) cline ! rh dep sca coef for 61 bands, 8 rh lev, 4 species
1196  read(niaercm,28) rhdpsca0(:,:,:)
1197 
1198  read(niaercm,21) cline ! rh dep ssa coef for 61 bands, 8 rh lev, 4 species
1199  read(niaercm,28) rhdpssa0(:,:,:)
1200 
1201  read(niaercm,21) cline ! rh dep asy coef for 61 bands, 8 rh lev, 4 species
1202  read(niaercm,28) rhdpasy0(:,:,:)
1203 
1204  read(niaercm,21) cline ! stratospheric background aeros for 61 bands
1205  read(niaercm,28) straext0(:)
1206 
1207  close (niaercm)
1208 
1209 ! --- ... convert pressure reference level (in mb) to sigma reference level
1210 ! assume an 1000mb reference surface pressure
1211 
1212  sigref(:,:) = 0.001 * prsref(:,:)
1213 
1214 ! --- ... compute solar flux weights and interval indices for mapping
1215 ! spectral bands between sw radiation and aerosol data
1216 
1217  if ( laswflg ) then
1218  solbnd(:) = f_zero
1219  solwaer(:,:) = f_zero
1220 
1221  do ib = 1, nswbnd
1222  mb = ib + nswstr - 1
1223  ii = 1
1224  iw1 = nint(wvnsw1(mb))
1225  iw2 = nint(wvnsw2(mb))
1226 
1227  if ( wvnsw2(mb)>=wvn550 .and. wvn550>=wvnsw1(mb) ) then
1228  nv_aod = ib ! sw band number covering 550nm wavelenth
1229  endif
1230 
1231  lab_swdowhile : do while ( iw1 > iendwv(ii) )
1232  if ( ii == naerbnd ) exit lab_swdowhile
1233  ii = ii + 1
1234  enddo lab_swdowhile
1235 
1236  sumsol = f_zero
1237  nv1(ib) = ii
1238 
1239  do iw = iw1, iw2
1240  solbnd(ib) = solbnd(ib) + solfwv(iw)
1241  sumsol = sumsol + solfwv(iw)
1242 
1243  if ( iw == iendwv(ii) ) then
1244  solwaer(ib,ii) = sumsol
1245 
1246  if ( ii < naerbnd ) then
1247  sumsol = f_zero
1248  ii = ii + 1
1249  endif
1250  endif
1251  enddo
1252 
1253  if ( iw2 /= iendwv(ii) ) then
1254  solwaer(ib,ii) = sumsol
1255  endif
1256 
1257  nv2(ib) = ii
1258 ! frcbnd(ib) = solbnd(ib) / soltot
1259  enddo ! end do_ib_block for sw
1260  endif ! end if_laswflg_block
1261 
1262 ! --- ... compute lw flux weights and interval indices for mapping
1263 ! spectral bands between lw radiation and aerosol data
1264 
1265  if ( lalwflg ) then
1266  eirbnd(:) = f_zero
1267  eirwaer(:,:) = f_zero
1268 
1269  do ib = 1, nlwbnd
1270  ii = 1
1271  if ( nlwbnd == 1 ) then
1272 ! iw1 = 250 ! corresponding 40 mu
1273  iw1 = 400 ! corresponding 25 mu
1274  iw2 = 2500 ! corresponding 4 mu
1275  else
1276  mb = ib + nlwstr - 1
1277  iw1 = nint(wvnlw1(mb))
1278  iw2 = nint(wvnlw2(mb))
1279  endif
1280 
1281  lab_lwdowhile : do while ( iw1 > iendwv(ii) )
1282  if ( ii == naerbnd ) exit lab_lwdowhile
1283  ii = ii + 1
1284  enddo lab_lwdowhile
1285 
1286  sumir = f_zero
1287  nr1(ib) = ii
1288 
1289  do iw = iw1, iw2
1290  eirbnd(ib) = eirbnd(ib) + eirfwv(iw)
1291  sumir = sumir + eirfwv(iw)
1292 
1293  if ( iw == iendwv(ii) ) then
1294  eirwaer(ib,ii) = sumir
1295 
1296  if ( ii < naerbnd ) then
1297  sumir = f_zero
1298  ii = ii + 1
1299  endif
1300  endif
1301  enddo
1302 
1303  if ( iw2 /= iendwv(ii) ) then
1304  eirwaer(ib,ii) = sumir
1305  endif
1306 
1307  nr2(ib) = ii
1308  enddo ! end do_ib_block for lw
1309  endif ! end if_lalwflg_block
1310 
1311 ! --- compute spectral band mean properties for each species
1312 
1313  call optavg
1314 ! --- inputs: (in-scope variables, module variables)
1315 ! --- outputs: (module variables)
1316 
1317 ! --- check print
1318 ! do ib = 1, NSWBND
1319 ! print *,' After optavg, for sw band:',ib
1320 ! print *,' extrhi:', extrhi(:,ib)
1321 ! print *,' scarhi:', scarhi(:,ib)
1322 ! print *,' ssarhi:', ssarhi(:,ib)
1323 ! print *,' asyrhi:', asyrhi(:,ib)
1324 ! mb = ib + NSWSTR - 1
1325 ! print *,' wvnsw1,wvnsw2 :',wvnsw1(mb),wvnsw2(mb)
1326 ! do i = 1, NRHLEV
1327 ! print *,' extrhd for rhlev:',i
1328 ! print *,extrhd(i,:,ib)
1329 ! print *,' scarhd for rhlev:',i
1330 ! print *,scarhd(i,:,ib)
1331 ! print *,' ssarhd for rhlev:',i
1332 ! print *,ssarhd(i,:,ib)
1333 ! print *,' asyrhd for rhlev:',i
1334 ! print *,asyrhd(i,:,ib)
1335 ! enddo
1336 ! print *,' extstra:', extstra(ib)
1337 ! enddo
1338 ! print *,' wvnlw1 :',wvnlw1
1339 ! print *,' wvnlw2 :',wvnlw2
1340 ! do ib = 1, NLWBND
1341 ! ii = NSWBND + ib
1342 ! print *,' After optavg, for lw band:',ib
1343 ! print *,' extrhi:', extrhi(:,ii)
1344 ! print *,' scarhi:', scarhi(:,ii)
1345 ! print *,' ssarhi:', ssarhi(:,ii)
1346 ! print *,' asyrhi:', asyrhi(:,ii)
1347 ! do i = 1, NRHLEV
1348 ! print *,' extrhd for rhlev:',i
1349 ! print *,extrhd(i,:,ii)
1350 ! print *,' scarhd for rhlev:',i
1351 ! print *,scarhd(i,:,ii)
1352 ! print *,' ssarhd for rhlev:',i
1353 ! print *,ssarhd(i,:,ii)
1354 ! print *,' asyrhd for rhlev:',i
1355 ! print *,asyrhd(i,:,ii)
1356 ! enddo
1357 ! print *,' extstra:', extstra(ii)
1358 ! enddo
1359 !
1360  return
1361 !................................
optavg
subroutine optavg
compute mean aerosols optical properties over each SW radiation spectral band for each of the species...
Definition: radiation_aerosols.f:1370

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine gocart_init::set_aerspc ( real (kind=kind_phys), intent(in)  raddt,
real (kind=kind_phys), intent(in)  fdaer 
)
private

Definition at line 3643 of file radiation_aerosols.f.

References module_radiation_aerosols::ctaer, module_radiation_aerosols::dm_indx, module_radiation_aerosols::dmfcs_indx, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, module_radiation_aerosols::get_clim, module_radiation_aerosols::get_fcst, module_radiation_aerosols::gridcomp, module_radiation_aerosols::isoot, module_radiation_aerosols::issam, module_radiation_aerosols::isscm, module_radiation_aerosols::isuso, module_radiation_aerosols::iwaso, module_radiation_aerosols::kcm, module_radiation_aerosols::kcm1, module_radiation_aerosols::kcm2, module_radiation_aerosols::lckprnt, module_radiation_aerosols::max_gridcomp, module_radiation_aerosols::max_num_gridcomp, module_radiation_aerosols::nmxg, and module_radiation_aerosols::num_gridcomp.

Referenced by module_radiation_aerosols::gocart_init().

3643 !.............................
3644 ! --- inputs: (in scope variables)
3645 ! --- outputs: (in scope variables)
3646 
3647 ! ==================================================================== !
3648 ! !
3649 ! subprogram: set_aerspc !
3650 ! !
3651 ! determine merging coefficients ctaer; !
3652 ! set up aerosol specification: num_gridcomp, gridcomp, dm_indx, !
3653 ! dmfcs_indx, isoot, iwaso, isuso, issam, isscm !
3654 ! !
3655 ! Aerosol optical properties (ext, ssa, asy) are determined from !
3656 ! NMGX (<=12) aerosol species !
3657 ! ==> DU: dust1 (4 sub-micron bins), dust2, dust3, dust4, dust5 !
3658 ! BC: soot_phobic, soot_philic !
3659 ! OC: waso_phobic, waso_philic !
3660 ! SU: suso (=so4) !
3661 ! SS: ssam (accumulation mode), sscm (coarse mode) !
3662 ! !
3663 ! The current version only supports prognostic aerosols (from GOCART !
3664 ! in-line calculations) and climo aerosols (from GEOS-GOCART runs) !
3665 ! !
3666 ! ================================================================== !
3667 !
3668  implicit none
3669 
3670 ! --- inputs:
3671  real (kind=kind_phys), intent(in) :: raddt, fdaer
3672 ! --- output:
3673 
3674 ! --- local:
3675 ! real (kind=kind_phys) :: raddt
3676  integer :: i, indxr
3677  character*2 :: tp, gridcomp_tmp(max_num_gridcomp)
3678 
3679 !! ===> determine ctaer (user specified weight for fcst fields)
3680 ! raddt = min(fhswr,fhlwr) / 24.
3681  if( fdaer >= 99999. ) ctaer = f_one
3682  if((fdaer>0.).and.(fdaer<99999.)) ctaer=exp(-raddt/fdaer)
3683 
3684  if(me==0 .and. lckprnt) then
3685  print *, 'RAD -raddt, fdaer,ctaer: ', raddt, fdaer, ctaer
3686  if (ctaer == f_one ) then
3687  print *, 'LU -aerosol fields determined from fcst'
3688  elseif (ctaer == f_zero) then
3689  print *, 'LU -aerosol fields determined from clim'
3690  else
3691  print *, 'LU -aerosol fields determined from fcst/clim'
3692  endif
3693  endif
3694 
3695 !! ===> determine get_fcst and get_clim
3696 !! if fcst is chosen (ctaer == f_one ), set get_clim to F
3697 !! if clim is chosen (ctaer == f_zero), set get_fcst to F
3698  if ( ctaer == f_one ) get_clim = .false.
3699  if ( ctaer == f_zero ) get_fcst = .false.
3700 
3701 !! ===> determine aerosol species to be included in the calculations
3702 !! of aerosol optical properties (ext, ssa, asy)
3703 
3704 !* If climo option is chosen, the aerosol composition is hardwired
3705 !* to full package. If not, the composition is determined from
3706 !* tracer_config on-the-fly (full package or subset)
3707  lab_if_fcst : if ( get_fcst ) then
3708 
3709 !! use tracer_config to determine num_gridcomp and gridcomp
3710  if ( gfs_phy_tracer%doing_GOCART ) then
3711  if ( gfs_phy_tracer%doing_DU ) then
3712  num_gridcomp = num_gridcomp + 1
3713  gridcomp_tmp(num_gridcomp) = 'DU'
3714  endif
3715  if ( gfs_phy_tracer%doing_SU ) then
3716  num_gridcomp = num_gridcomp + 1
3717  gridcomp_tmp(num_gridcomp) = 'SU'
3718  endif
3719  if ( gfs_phy_tracer%doing_SS ) then
3720  num_gridcomp = num_gridcomp + 1
3721  gridcomp_tmp(num_gridcomp) = 'SS'
3722  endif
3723  if ( gfs_phy_tracer%doing_OC ) then
3724  num_gridcomp = num_gridcomp + 1
3725  gridcomp_tmp(num_gridcomp) = 'OC'
3726  endif
3727  if ( gfs_phy_tracer%doing_BC ) then
3728  num_gridcomp = num_gridcomp + 1
3729  gridcomp_tmp(num_gridcomp) = 'BC'
3730  endif
3731 !
3732  if ( num_gridcomp > 0 ) then
3733  allocate ( gridcomp(num_gridcomp) )
3734  gridcomp(1:num_gridcomp) = gridcomp_tmp(1:num_gridcomp)
3735  else
3736  print *,'ERROR: prognostic aerosols not found,abort',me
3737  stop 1000
3738  endif
3739 
3740  else ! gfs_phy_tracer%doing_GOCART=F
3741 
3742  print *,'ERROR: prognostic aerosols option off, abort',me
3743  stop 1001
3744 
3745  endif ! end_if_gfs_phy_tracer%doing_GOCART_if_
3746 
3747  else lab_if_fcst
3748 
3749 !! set to full package (max_num_gridcomp and max_gridcomp)
3750  num_gridcomp = max_num_gridcomp
3751  allocate ( gridcomp(num_gridcomp) )
3752  gridcomp(1:num_gridcomp) = max_gridcomp(1:num_gridcomp)
3753 
3754  endif lab_if_fcst
3755 
3756 !!
3757 !! Aerosol specification is determined as such:
3758 !! A. For radiation-aerosol feedback, the specification is based on the aeropt
3759 !! routine from Mian Chin and Hongbin Yu (hydrophobic and hydrophilic for
3760 !! OC/BC; submicron and supermicron for SS, 8-bins (with 4 subgroups for the
3761 !! the submicron bin) for DU, and SO4 for SU)
3762 !! B. For transport, the specification is determined from GOCART in-line module
3763 !! C. For LUTS, (waso, soot, ssam, sscm, suso, dust) is used, based on the
3764 !! the OPAC climo aerosol scheme (implemented by Yu-Tai Hou)
3765 
3766 !!=== <A> determine dm_indx and NMXG
3767  indxr = 0
3768  dm_indx%waso_phobic = -999 ! OC
3769  dm_indx%soot_phobic = -999 ! BC
3770  dm_indx%ssam = -999 ! SS
3771  dm_indx%suso = -999 ! SU
3772  dm_indx%dust1 = -999 ! DU
3773  do i = 1, num_gridcomp
3774  tp = gridcomp(i)
3775  select case ( tp )
3776  case ( 'OC') ! consider hydrophobic and hydrophilic
3777  dm_indx%waso_phobic = indxr + 1
3778  dm_indx%waso_philic = indxr + 2
3779  indxr = indxr + 2
3780  case ( 'BC') ! consider hydrophobic and hydrophilic
3781  dm_indx%soot_phobic = indxr + 1
3782  dm_indx%soot_philic = indxr + 2
3783  indxr = indxr + 2
3784  case ( 'SS') ! consider submicron and supermicron
3785  dm_indx%ssam = indxr + 1
3786  dm_indx%sscm = indxr + 2
3787  indxr = indxr + 2
3788  case ( 'SU') ! consider SO4 only
3789  dm_indx%suso = indxr + 1
3790  indxr = indxr + 1
3791  case ( 'DU') ! consider all 5 bins
3792  dm_indx%dust1 = indxr + 1
3793  dm_indx%dust2 = indxr + 2
3794  dm_indx%dust3 = indxr + 3
3795  dm_indx%dust4 = indxr + 4
3796  dm_indx%dust5 = indxr + 5
3797  indxr = indxr + 5
3798  case default
3799  print *,'ERROR: aerosol species not supported, abort',me
3800  stop 1002
3801  end select
3802  enddo
3803 !!
3804  nmxg = indxr ! num of gocart aer spec for opt cal
3805 !!
3806 
3807 !!=== <B> determine dmfcs_indx
3808 !! SS: 5-bins are considered for transport while only two groups
3809 !! (accumulation/coarse modes) are considered for radiation
3810 !! DU: 5-bins are considered for transport while 8 bins (with the
3811 !! submicorn bin exptended to 4 bins) are considered for radiation
3812 !! SU: DMS, SO2, and MSA are not considered for radiation
3813 
3814  if ( get_fcst ) then
3815  if ( gfs_phy_tracer%doing_OC ) then
3816  dmfcs_indx%ocphobic = trcindx('ocphobic', gfs_phy_tracer)
3817  dmfcs_indx%ocphilic = trcindx('ocphilic', gfs_phy_tracer)
3818  endif
3819  if ( gfs_phy_tracer%doing_BC ) then
3820  dmfcs_indx%bcphobic = trcindx('bcphobic', gfs_phy_tracer)
3821  dmfcs_indx%bcphilic = trcindx('bcphilic', gfs_phy_tracer)
3822  endif
3823  if ( gfs_phy_tracer%doing_SS ) then
3824  dmfcs_indx%ss001 = trcindx('ss001', gfs_phy_tracer)
3825  dmfcs_indx%ss002 = trcindx('ss002', gfs_phy_tracer)
3826  dmfcs_indx%ss003 = trcindx('ss003', gfs_phy_tracer)
3827  dmfcs_indx%ss004 = trcindx('ss004', gfs_phy_tracer)
3828  dmfcs_indx%ss005 = trcindx('ss005', gfs_phy_tracer)
3829  endif
3830  if ( gfs_phy_tracer%doing_SU ) then
3831  dmfcs_indx%so4 = trcindx('so4', gfs_phy_tracer)
3832  endif
3833  if ( gfs_phy_tracer%doing_DU ) then
3834  dmfcs_indx%du001 = trcindx('du001', gfs_phy_tracer)
3835  dmfcs_indx%du002 = trcindx('du002', gfs_phy_tracer)
3836  dmfcs_indx%du003 = trcindx('du003', gfs_phy_tracer)
3837  dmfcs_indx%du004 = trcindx('du004', gfs_phy_tracer)
3838  dmfcs_indx%du005 = trcindx('du005', gfs_phy_tracer)
3839  endif
3840  endif
3841 
3842 !!
3843 !!=== <C> determin KCM, KCM1, KCM2
3844 !! DU: submicron bin (dust1) contains 4 sub-groups (e.g., hardwire
3845 !! 8 bins for aerosol optical properties luts)
3846 !! OC/BC: while hydrophobic aerosols are rh-independent, the luts
3847 !! for hydrophilic aerosols are used (e.g., use the coeff
3848 !! corresponding to rh=0)
3849 !!
3850  indxr = 1
3851  isoot = -999
3852  iwaso = -999
3853  isuso = -999
3854  issam = -999
3855  isscm = -999
3856  do i = 1, num_gridcomp
3857  tp = gridcomp(i)
3858  if ( tp /= 'DU' ) then
3859  select case ( tp )
3860  case ( 'OC ')
3861  iwaso = indxr
3862  case ( 'BC ')
3863  isoot = indxr
3864  case ( 'SU ')
3865  isuso = indxr
3866  case ( 'SS ')
3867  issam = indxr
3868  isscm = indxr + 1
3869  end select
3870  if ( tp /= 'SS' ) then
3871  indxr = indxr + 1
3872  else
3873  indxr = indxr + 2
3874  endif
3875  else
3876  kcm1 = 8 ! num of rh independent aer species
3877  endif
3878  enddo
3879  kcm2 = indxr - 1 ! num of rh dependent aer species
3880  kcm = kcm1 + kcm2 ! total num of aer species
3881 
3882 !!
3883 !! check print starts here
3884  if( me == 0 .and. lckprnt) then
3885  print *, 'RAD -num_gridcomp:', num_gridcomp
3886  print *, 'RAD -gridcomp :', gridcomp(:)
3887  print *, 'RAD -NMXG:', nmxg
3888  print *, 'RAD -dm_indx ===> '
3889  print *, 'RAD -aerspc: dust1=', dm_indx%dust1
3890  print *, 'RAD -aerspc: dust2=', dm_indx%dust2
3891  print *, 'RAD -aerspc: dust3=', dm_indx%dust3
3892  print *, 'RAD -aerspc: dust4=', dm_indx%dust4
3893  print *, 'RAD -aerspc: dust5=', dm_indx%dust5
3894  print *, 'RAD -aerspc: ssam=', dm_indx%ssam
3895  print *, 'RAD -aerspc: sscm=', dm_indx%sscm
3896  print *, 'RAD -aerspc: suso=', dm_indx%suso
3897  print *, 'RAD -aerspc: waso_phobic=',dm_indx%waso_phobic
3898  print *, 'RAD -aerspc: waso_philic=',dm_indx%waso_philic
3899  print *, 'RAD -aerspc: soot_phobic=',dm_indx%soot_phobic
3900  print *, 'RAD -aerspc: soot_philic=',dm_indx%soot_philic
3901 
3902  print *, 'RAD -KCM1 =', kcm1
3903  print *, 'RAD -KCM2 =', kcm2
3904  print *, 'RAD -KCM =', kcm
3905  if ( kcm2 > 0 ) then
3906  print *, 'RAD -aerspc: issam=', issam
3907  print *, 'RAD -aerspc: isscm=', isscm
3908  print *, 'RAD -aerspc: isuso=', isuso
3909  print *, 'RAD -aerspc: iwaso=', iwaso
3910  print *, 'RAD -aerspc: isoot=', isoot
3911  endif
3912 
3913  if ( get_fcst ) then
3914  print *, 'RAD -dmfcs_indx ===> '
3915  print *, 'RAD -trc_du001=',dmfcs_indx%du001
3916  print *, 'RAD -trc_du002=',dmfcs_indx%du002
3917  print *, 'RAD -trc_du003=',dmfcs_indx%du003
3918  print *, 'RAD -trc_du004=',dmfcs_indx%du004
3919  print *, 'RAD -trc_du005=',dmfcs_indx%du005
3920  print *, 'RAD -trc_so4 =',dmfcs_indx%so4
3921  print *, 'RAD -trc_ocphobic=',dmfcs_indx%ocphobic
3922  print *, 'RAD -trc_ocphilic=',dmfcs_indx%ocphilic
3923  print *, 'RAD -trc_bcphobic=',dmfcs_indx%bcphobic
3924  print *, 'RAD -trc_bcphilic=',dmfcs_indx%bcphilic
3925  print *, 'RAD -trc_ss001=',dmfcs_indx%ss001
3926  print *, 'RAD -trc_ss002=',dmfcs_indx%ss002
3927  print *, 'RAD -trc_ss003=',dmfcs_indx%ss003
3928  print *, 'RAD -trc_ss004=',dmfcs_indx%ss004
3929  print *, 'RAD -trc_ss005=',dmfcs_indx%ss005
3930  endif
3931  endif
3932 !! check print ends here
3933 
3934  return
3935 ! !

Here is the caller graph for this function:

subroutine aer_init::set_spectrum ( )
private

Definition at line 809 of file radiation_aerosols.f.

References physcons::con_boltz, physcons::con_c, physcons::con_pi, physcons::con_plnk, physcons::con_t0c, module_radiation_aerosols::nwvns0, module_radiation_aerosols::nwvsol, module_radiation_aerosols::nwvtir, and module_radiation_aerosols::s0intv.

Referenced by module_radiation_aerosols::aer_init().

809 !................................
810 ! --- inputs: (module constants)
811 ! --- outputs: (in-scope variables)
812 
813 ! ================================================================== !
814 ! !
815 ! subprogram : set_spectrum !
816 ! !
817 ! define the one wavenumber solar fluxes based on toa solar spectral!
818 ! distrobution, and define the one wavenumber ir fluxes based on !
819 ! black-body emission distribution at a predefined temperature. !
820 ! !
821 ! ==================== defination of variables =================== !
822 ! !
823 ! inputs: (module constants) !
824 ! NWVTOT - total num of wave numbers used in sw spectrum !
825 ! NWVTIR - total num of wave numbers used in the ir region !
826 ! !
827 ! outputs: (in-scope variables) !
828 ! solfwv(NWVTOT) - solar flux for each individual wavenumber (w/m2)!
829 ! eirfwv(NWVTIR) - ir flux(273k) for each individual wavenum (w/m2)!
830 ! !
831 ! subroutines called: none !
832 ! !
833 ! usage: call set_spectrum !
834 ! !
835 ! ================================================================== !
836 
837 ! --- inputs: (module constants)
838 ! integer :: NWVTOT, NWVTIR
839 
840 ! --- output: (in-scope variables)
841 ! real (kind=kind_phys), dimension(NWVTOT) :: solfwv ! one wvn sol flux
842 ! real (kind=kind_phys), dimension(NWVTIR) :: eirfwv ! one wvn ir flux
843 
844 ! --- locals:
845  real (kind=kind_phys) :: soltot, tmp1, tmp2, tmp3
846 
847  integer :: nb, nw, nw1, nw2, nmax, nmin
848 !
849 !===> ... begin here
850 !
851 ! nmax = min( NWVTOT, nint( maxval(wvnsw2) ))
852 ! nmin = max( 1, nint( minval(wvnsw1) ))
853 
854 ! --- check print
855 ! print *,' MINWVN, MAXWVN = ',nmin, nmax
856 ! --- ... define the one wavenumber solar fluxes based on toa solar
857 ! spectral distribution
858 
859 ! soltot1 = f_zero
860 ! soltot = f_zero
861  do nb = 1, nwvsol
862  if ( nb == 1 ) then
863  nw1 = 1
864  else
865  nw1 = nw1 + nwvns0(nb-1)
866  endif
867 
868  nw2 = nw1 + nwvns0(nb) - 1
869 
870  do nw = nw1, nw2
871  solfwv(nw) = s0intv(nb)
872 ! soltot1 = soltot1 + s0intv(nb)
873 ! if ( nw >= nmin .and. nw <= nmax ) then
874 ! soltot = soltot + s0intv(nb)
875 ! endif
876  enddo
877  enddo
878 
879 ! --- ... define the one wavenumber ir fluxes based on black-body
880 ! emission distribution at a predefined temperature
881 
882  tmp1 = 2.0 * con_pi * con_plnk * (con_c**2)
883  tmp2 = con_plnk * con_c / (con_boltz * con_t0c)
884 
885  do nw = 1, nwvtir
886  tmp3 = 100.0 * nw
887  eirfwv(nw) = (tmp1 * tmp3**3) / (exp(tmp2*tmp3) - 1.0)
888  enddo
889 !
890  return
891 !................................

Here is the caller graph for this function:

subroutine aer_init::set_volcaer ( )
private

Definition at line 898 of file radiation_aerosols.f.

References module_radiation_aerosols::ivolae.

Referenced by module_radiation_aerosols::aer_init().

898 !.............................
899 ! --- inputs: ( none )
900 ! --- outputs: (module variables)
901 
902 ! ================================================================== !
903 ! !
904 ! subprogram : set_volcaer !
905 ! !
906 ! this is the initialization progrmam for stratospheric volcanic !
907 ! aerosols. !
908 ! !
909 ! subroutines called: none !
910 ! !
911 ! usage: call set_volcaer !
912 ! !
913 ! ================================================================== !
914 
915 ! --- inputs: (none)
916 
917 ! --- output: (module variables)
918 ! integer :: ivolae(:,:,:)
919 
920 ! --- locals:
921 !
922 !===> ... begin here
923 !
924 ! --- allocate data space
925 
926  if ( .not. allocated(ivolae) ) then
927  allocate ( ivolae(12,4,10) ) ! for 12-mon,4-lat_zone,10-year
928  endif
929 !
930  return
931 !................................
932  end subroutine set_volcaer
933 !--------------------------------
934 !
935 !...................................
set_volcaer
subroutine set_volcaer
The initialization program for stratospheric volcanic aerosols.
Definition: radiation_aerosols.f:898

Here is the caller graph for this function:

subroutine aer_update::trop_update ( )
private

Definition at line 1705 of file radiation_aerosols.f.

References physparam::aeros_file, module_radiation_aerosols::cmixg, module_radiation_aerosols::denng, module_radiation_aerosols::f_one, module_radiation_aerosols::f_zero, module_radiation_aerosols::idxcg, module_radiation_aerosols::imxae, module_radiation_aerosols::jmxae, module_radiation_aerosols::kprfg, and module_radiation_aerosols::nxc.

Referenced by module_radiation_aerosols::aer_update().

1705 !................................
1706 ! --- inputs: (in scope variables, module variables)
1707 ! --- outputs: (module variables)
1708 
1709 ! ================================================================== !
1710 ! !
1711 ! subprogram : trop_update !
1712 ! !
1713 ! updates the monthly global distribution of aerosol profiles in !
1714 ! five degree horizontal resolution. !
1715 ! !
1716 ! ==================== defination of variables =================== !
1717 ! !
1718 ! inputs: (in-scope variables, module constants) !
1719 ! imon - integer, month of the year !
1720 ! me - integer, print message control flag !
1721 ! !
1722 ! outputs: (module variables) !
1723 ! !
1724 ! external module variables: (in physparam) !
1725 ! aeros_file - external aerosol data file name !
1726 ! !
1727 ! internal module variables: !
1728 ! kprfg ( IMXAE*JMXAE) - aeros profile index !
1729 ! idxcg (NXC*IMXAE*JMXAE) - aeros component index !
1730 ! cmixg (NXC*IMXAE*JMXAE) - aeros component mixing ratio !
1731 ! denng ( 2 *IMXAE*JMXAE) - aerosols number density !
1732 ! !
1733 ! NIAERCM - unit number for input data set !
1734 ! !
1735 ! subroutines called: none !
1736 ! !
1737 ! usage: call trop_update !
1738 ! !
1739 ! ================================================================== !
1740 
1741 ! --- inputs: ( none )
1742 ! --- output: ( none )
1743 
1744 ! --- locals:
1745 ! real (kind=kind_io8) :: cmix(NXC), denn, tem
1746  real (kind=kind_phys) :: cmix(nxc), denn, tem
1747  integer :: idxc(nxc), kprf
1748 
1749  integer :: i, id, j, k, m, nc
1750  logical :: file_exist
1751 
1752  character :: cline*80, ctyp*3
1753 !
1754 !===> ... begin here
1755 !
1756 ! --- ... reading climatological aerosols data
1757 
1758  inquire (file=aeros_file, exist=file_exist)
1759 
1760  if ( file_exist ) then
1761  close(niaercm)
1762  open (unit=niaercm,file=aeros_file,status='OLD', &
1763  & form='FORMATTED')
1764  rewind(niaercm)
1765 
1766  if ( me == 0 ) then
1767  print *,' Opened aerosol data file: ',aeros_file
1768  endif
1769  else
1770  print *,' Requested aerosol data file "',aeros_file, &
1771  & '" not found!'
1772  print *,' *** Stopped in subroutine trop_update !!'
1773  stop
1774  endif ! end if_file_exist_block
1775 
1776  do j = 1, jmxae
1777  do i = 1, imxae
1778  do m = 1, nxc
1779  idxcg(m,i,j) = 0
1780  cmixg(m,i,j) = f_zero
1781  enddo
1782  enddo
1783  enddo
1784 
1785  do j = 1, jmxae
1786  do i = 1, imxae
1787  do m = 1, 2
1788  denng(m,i,j) = f_zero
1789  enddo
1790  enddo
1791  enddo
1792 
1793 ! --- ... loop over 12 month global distribution
1794 
1795  lab_do_12mon : do m = 1, 12
1796 
1797  read(niaercm,12) cline
1798  12 format(a80/)
1799 
1800  if ( m /= imon ) then
1801 ! if ( me == 0 ) print *,' *** Skipped ',cline
1802 
1803  do j = 1, jmxae
1804  do i = 1, imxae
1805  read(niaercm,*) id
1806  enddo
1807  enddo
1808  else
1809  if ( me == 0 ) print *,' --- Reading ',cline
1810 
1811  do j = 1, jmxae
1812  do i = 1, imxae
1813  read(niaercm,14) (idxc(k),cmix(k),k=1,nxc),kprf,denn,nc,ctyp
1814  14 format(5(i2,e11.4),i2,f8.2,i3,1x,a3)
1815 
1816  kprfg(i,j) = kprf
1817  denng(1,i,j) = denn ! num density of 1st layer
1818  if ( kprf >= 6 ) then
1819  denng(2,i,j) = cmix(nxc) ! num density of 2dn layer
1820  else
1821  denng(2,i,j) = f_zero
1822  endif
1823 
1824  tem = f_one
1825  do k = 1, nxc-1
1826  idxcg(k,i,j) = idxc(k) ! component index
1827  cmixg(k,i,j) = cmix(k) ! component mixing ratio
1828  tem = tem - cmix(k)
1829  enddo
1830  idxcg(nxc,i,j) = idxc(nxc)
1831  cmixg(nxc,i,j) = tem ! to make sure all add to 1.
1832  enddo
1833  enddo
1834 
1835  close (niaercm)
1836  exit lab_do_12mon
1837  endif ! end if_m_block
1838 
1839  enddo lab_do_12mon
1840 
1841 ! -- check print
1842 
1843 ! print *,' IDXCG :'
1844 ! print 16,idxcg
1845 ! 16 format(40i3)
1846 ! print *,' CMIXG :'
1847 ! print 17,cmixg
1848 ! print *,' DENNG :'
1849 ! print 17,denng
1850 ! print *,' KPRFG :'
1851 ! print 17,kprfg
1852 ! 17 format(8e16.9)
1853 !
1854  return
1855 !................................

Here is the caller graph for this function:

subroutine aer_update::volc_update ( )
private

Definition at line 1863 of file radiation_aerosols.f.

References module_radiation_aerosols::ivolae, module_radiation_aerosols::kmonsav, module_radiation_aerosols::kyrend, module_radiation_aerosols::kyrsav, module_radiation_aerosols::kyrstr, module_radiation_aerosols::maxvyr, and module_radiation_aerosols::minvyr.

Referenced by module_radiation_aerosols::aer_update().

1863 !................................
1864 ! --- inputs: (in scope variables, module variables)
1865 ! --- outputs: (module variables)
1866 
1867 ! ================================================================== !
1868 ! !
1869 ! subprogram : volc_update !
1870 ! !
1871 ! searches historical volcanic data sets to find and read in !
1872 ! monthly 45-degree lat-zone band data of optical depth. !
1873 ! !
1874 ! ==================== defination of variables =================== !
1875 ! !
1876 ! inputs: (in-scope variables, module constants) !
1877 ! iyear - integer, 4-digit calender year 1 !
1878 ! imon - integer, month of the year 1 !
1879 ! me - integer, print message control flag 1 !
1880 ! NIAERCM - integer, unit number for input data set 1 !
1881 ! !
1882 ! outputs: (module variables) !
1883 ! ivolae - integer, monthly, 45-deg lat-zone volc odp 12*4*10 !
1884 ! kyrstr - integer, starting year of data in the input file !
1885 ! kyrend - integer, ending year of data in the input file !
1886 ! kyrsav - integer, the year of data in use in the input file !
1887 ! kmonsav - integer, the month of data in use in the input file !
1888 ! !
1889 ! subroutines called: none !
1890 ! !
1891 ! usage: call volc_aerinit !
1892 ! !
1893 ! ================================================================== !
1894 
1895 ! --- inputs: (in-scope variables, module constants)
1896 ! integer :: iyear, imon, me, NIAERCM
1897 
1898 ! --- output: (module variables)
1899 ! integer :: ivolae(:,:,:), kyrstr, kyrend, kyrsav, kmonsav
1900 
1901 ! --- locals:
1902  integer :: i, j, k
1903  logical :: file_exist
1904 
1905  character :: cline*80, volcano_file*32
1906  data volcano_file / 'volcanic_aerosols_1850-1859.txt ' /
1907 !
1908 !===> ... begin here
1909 !
1910  kmonsav = imon
1911 
1912  if ( kyrstr<=iyear .and. iyear<=kyrend ) then ! use previously input data
1913  kyrsav = iyear
1914  return
1915  else ! need to input new data
1916  kyrsav = iyear
1917  kyrstr = iyear - mod(iyear,10)
1918  kyrend = kyrstr + 9
1919 
1920 ! --- check print
1921 ! print *,' kyrstr, kyrend, kyrsav, kmonsav =', &
1922 ! & kyrstr,kyrend,kyrsav,kmonsav
1923 
1924  if ( iyear < minvyr .or. iyear > maxvyr ) then
1925 ! if ( .not. allocated(ivolae) ) then
1926 ! allocate ( ivolae(12,4,10) ) ! for 12-mon,4-lat_zone,10-year
1927 ! endif
1928  ivolae(:,:,:) = 1 ! set as lowest value
1929  if ( me == 0 ) then
1930  print *,' Request volcanic date out of range,', &
1931  & ' optical depth set to lowest value'
1932  endif
1933  else
1934  write(volcano_file(19:27),60) kyrstr,kyrend
1935  60 format(i4.4,'-',i4.4)
1936 
1937  inquire (file=volcano_file, exist=file_exist)
1938  if ( file_exist ) then
1939  close(niaercm)
1940  open (unit=niaercm,file=volcano_file,status='OLD', &
1941  & form='FORMATTED')
1942 
1943  read(niaercm,62) cline
1944  62 format(a80)
1945 
1946 ! --- check print
1947  if ( me == 0 ) then
1948  print *,' Opened volcanic data file: ',volcano_file
1949  print *, cline
1950  endif
1951 
1952  do k = 1, 10
1953  do j = 1, 4
1954  read(niaercm,64) (ivolae(i,j,k),i=1,12)
1955  64 format(12i5)
1956  enddo
1957  enddo
1958 
1959  close (niaercm)
1960  else
1961  print *,' Requested volcanic data file "', &
1962  & volcano_file,'" not found!'
1963  print *,' *** Stopped in subroutine VOLC_AERINIT !!'
1964  stop
1965  endif ! end if_file_exist_block
1966 
1967  endif ! end if_iyear_block
1968  endif ! end if_kyrstr_block
1969 
1970 ! --- check print
1971  if ( me == 0 ) then
1972  k = mod(kyrsav,10) + 1
1973  print *,' CHECK: Sample Volcanic data used for month, year:', &
1974  & imon, iyear
1975  print *, ivolae(kmonsav,:,k)
1976  endif
1977 !
1978  return
1979 !................................
1980  end subroutine volc_update
1981 !--------------------------------
1982 !
1983 !...................................
volc_update
subroutine volc_update
search historical volcanic data sets to find and read in monthly 45-degree lat-zone band of optical d...
Definition: radiation_aerosols.f:1863

Here is the caller graph for this function:

subroutine aer_init::wrt_aerlog ( )
private

Definition at line 712 of file radiation_aerosols.f.

References physparam::iaerflg, physparam::iaermdl, physparam::lalw1bd, physparam::lalwflg, physparam::laswflg, physparam::lavoflg, and module_radiation_aerosols::vtagaer.

Referenced by module_radiation_aerosols::aer_init().

712 !................................
713 ! --- inputs: (in scope variables)
714 ! --- outputs: ( none )
715 
716 ! ================================================================== !
717 ! !
718 ! subprogram : wrt_aerlog !
719 ! !
720 ! write aerosol parameter configuration to run log file. !
721 ! !
722 ! ==================== defination of variables =================== !
723 ! !
724 ! external module variables: (in physparam) !
725 ! iaermdl - aerosol scheme flag: 0:opac-clm; 1:gocart-clim; !
726 ! 2:gocart-prog !
727 ! iaerflg - aerosol effect control flag: 3-digits (volc,lw,sw) !
728 ! lalwflg - toposphere lw aerosol effect: =f:no; =t:yes !
729 ! laswflg - toposphere sw aerosol effect: =f:no; =t:yes !
730 ! lavoflg - stratospherer volcanic aeros effect: =f:no; =t:yes !
731 ! !
732 ! outputs: ( none ) !
733 ! !
734 ! subroutines called: none !
735 ! !
736 ! usage: call wrt_aerlog !
737 ! !
738 ! ================================================================== !
739 
740 ! --- inputs: ( none )
741 ! --- output: ( none )
742 ! --- locals:
743 
744 !
745 !===> ... begin here
746 !
747  print *, vtagaer ! print out version tag
748 
749  if ( iaermdl == 0 ) then
750  print *,' - Using OPAC-seasonal climatology for tropospheric', &
751  & ' aerosol effect'
752  elseif ( iaermdl == 1 ) then
753  print *,' - Using GOCART-climatology for tropospheric', &
754  & ' aerosol effect'
755  elseif ( iaermdl == 2 ) then
756  print *,' - Using GOCART-prognostic aerosols for tropospheric', &
757  & ' aerosol effect'
758  else
759  print *,' !!! ERROR in selection of aerosol model scheme', &
760  & ' IAER_MDL =',iaermdl
761  stop
762  endif ! end_if_iaermdl_block
763 
764  print *,' IAER=',iaerflg,' LW-trop-aer=',lalwflg, &
765  & ' SW-trop-aer=',laswflg,' Volc-aer=',lavoflg
766 
767  if ( iaerflg <= 0 ) then ! turn off all aerosol effects
768  print *,' - No tropospheric/volcanic aerosol effect included'
769  print *,' Input values of aerosol optical properties to' &
770  & ,' both SW and LW radiations are set to zeros'
771  else
772  if ( iaerflg >= 100 ) then ! incl stratospheric volcanic aerosols
773  print *,' - Include stratospheric volcanic aerosol effect'
774  else ! no stratospheric volcanic aerosols
775  print *,' - No stratospheric volcanic aerosol effect'
776  endif
777 
778  if ( laswflg ) then ! chcek for sw effect
779  print *,' - Compute multi-band aerosol optical' &
780  & ,' properties for SW input parameters'
781  else
782  print *,' - No SW radiation aerosol effect, values of' &
783  & ,' aerosol properties to SW input are set to zeros'
784  endif
785 
786  if ( lalwflg ) then ! check for lw effect
787  if ( lalw1bd ) then
788  print *,' - Compute 1 broad-band aerosol optical' &
789  & ,' properties for LW input parameters'
790  else
791  print *,' - Compute multi-band aerosol optical' &
792  & ,' properties for LW input parameters'
793  endif
794  else
795  print *,' - No LW radiation aerosol effect, values of' &
796  & ,' aerosol properties to LW input are set to zeros'
797  endif
798  endif ! end if_iaerflg_block
799 !
800  return
801 !................................

Here is the caller graph for this function: