Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Manages the absorber concentrations in the layers RRTMG operates
3 : ! including an extra layer over the model if needed.
4 : !
5 : ! Creator: Francis Vitt
6 : ! 9 May 2011
7 : !--------------------------------------------------------------------------------
8 : module rrtmg_state
9 :
10 : use shr_kind_mod, only: r8 => shr_kind_r8
11 : use ppgrid, only: pcols, pver, pverp
12 : use cam_history, only: outfld
13 :
14 : implicit none
15 : private
16 : save
17 :
18 : public :: rrtmg_state_t
19 : public :: rrtmg_state_init
20 : public :: rrtmg_state_create
21 : public :: rrtmg_state_update
22 : public :: rrtmg_state_destroy
23 : public :: num_rrtmg_levs
24 :
25 : type rrtmg_state_t
26 :
27 : real(r8), allocatable :: h2ovmr(:,:) ! h2o volume mixing ratio
28 : real(r8), allocatable :: o3vmr(:,:) ! o3 volume mixing ratio
29 : real(r8), allocatable :: co2vmr(:,:) ! co2 volume mixing ratio
30 : real(r8), allocatable :: ch4vmr(:,:) ! ch4 volume mixing ratio
31 : real(r8), allocatable :: o2vmr(:,:) ! o2 volume mixing ratio
32 : real(r8), allocatable :: n2ovmr(:,:) ! n2o volume mixing ratio
33 : real(r8), allocatable :: cfc11vmr(:,:) ! cfc11 volume mixing ratio
34 : real(r8), allocatable :: cfc12vmr(:,:) ! cfc12 volume mixing ratio
35 : real(r8), allocatable :: cfc22vmr(:,:) ! cfc22 volume mixing ratio
36 : real(r8), allocatable :: ccl4vmr(:,:) ! ccl4 volume mixing ratio
37 :
38 : real(r8), allocatable :: pmidmb(:,:) ! Level pressure (hPa)
39 : real(r8), allocatable :: pintmb(:,:) ! Model interface pressure (hPa)
40 : real(r8), allocatable :: tlay(:,:) ! mid point temperature
41 : real(r8), allocatable :: tlev(:,:) ! interface temperature
42 :
43 : end type rrtmg_state_t
44 :
45 : integer :: num_rrtmg_levs ! number of pressure levels greate than 1.e-4_r8 mbar
46 :
47 : real(r8), parameter :: amdw = 1.607793_r8 ! Molecular weight of dry air / water vapor
48 : real(r8), parameter :: amdc = 0.658114_r8 ! Molecular weight of dry air / carbon dioxide
49 : real(r8), parameter :: amdo = 0.603428_r8 ! Molecular weight of dry air / ozone
50 : real(r8), parameter :: amdm = 1.805423_r8 ! Molecular weight of dry air / methane
51 : real(r8), parameter :: amdn = 0.658090_r8 ! Molecular weight of dry air / nitrous oxide
52 : real(r8), parameter :: amdo2 = 0.905140_r8 ! Molecular weight of dry air / oxygen
53 : real(r8), parameter :: amdc1 = 0.210852_r8 ! Molecular weight of dry air / CFC11
54 : real(r8), parameter :: amdc2 = 0.239546_r8 ! Molecular weight of dry air / CFC12
55 :
56 : contains
57 :
58 : !--------------------------------------------------------------------------------
59 : ! sets the number of model levels RRTMG operates
60 : !--------------------------------------------------------------------------------
61 1536 : subroutine rrtmg_state_init
62 :
63 : use ref_pres,only : pref_edge
64 : implicit none
65 :
66 : ! The following cuts off RRTMG at roughly the point where it becomes
67 : ! invalid due to low pressure.
68 145920 : num_rrtmg_levs = count( pref_edge(:) > 1._r8 ) ! pascals (1.e-2 mbar)
69 :
70 1536 : end subroutine rrtmg_state_init
71 :
72 : !--------------------------------------------------------------------------------
73 : ! creates (alloacates) an rrtmg_state object
74 : !--------------------------------------------------------------------------------
75 :
76 30960 : function rrtmg_state_create( pstate, cam_in ) result( rstate )
77 1536 : use physics_types, only: physics_state
78 : use camsrfexch, only: cam_in_t
79 : use physconst, only: stebol
80 :
81 : implicit none
82 :
83 : type(physics_state), intent(in) :: pstate
84 : type(cam_in_t), intent(in) :: cam_in
85 :
86 : type(rrtmg_state_t) :: rstate
87 :
88 : real(r8) dy ! Temporary layer pressure thickness
89 : real(r8) :: tint(pcols,pverp) ! Model interface temperature
90 : integer :: ncol, i, kk, k
91 :
92 92880 : allocate( rstate%h2ovmr(pcols,num_rrtmg_levs) )
93 61920 : allocate( rstate%o3vmr(pcols,num_rrtmg_levs) )
94 61920 : allocate( rstate%co2vmr(pcols,num_rrtmg_levs) )
95 61920 : allocate( rstate%ch4vmr(pcols,num_rrtmg_levs) )
96 61920 : allocate( rstate%o2vmr(pcols,num_rrtmg_levs) )
97 61920 : allocate( rstate%n2ovmr(pcols,num_rrtmg_levs) )
98 61920 : allocate( rstate%cfc11vmr(pcols,num_rrtmg_levs) )
99 61920 : allocate( rstate%cfc12vmr(pcols,num_rrtmg_levs) )
100 61920 : allocate( rstate%cfc22vmr(pcols,num_rrtmg_levs) )
101 61920 : allocate( rstate%ccl4vmr(pcols,num_rrtmg_levs) )
102 :
103 61920 : allocate( rstate%pmidmb(pcols,num_rrtmg_levs) )
104 92880 : allocate( rstate%pintmb(pcols,num_rrtmg_levs+1) )
105 61920 : allocate( rstate%tlay(pcols,num_rrtmg_levs) )
106 61920 : allocate( rstate%tlev(pcols,num_rrtmg_levs+1) )
107 :
108 30960 : ncol = pstate%ncol
109 :
110 : ! Calculate interface temperatures (following method
111 : ! used in radtpl for the longwave), using surface upward flux and
112 : ! stebol constant in mks units
113 516960 : do i = 1,ncol
114 486000 : tint(i,1) = pstate%t(i,1)
115 486000 : tint(i,pverp) = sqrt(sqrt(cam_in%lwup(i)/stebol))
116 45228960 : do k = 2,pver
117 44712000 : dy = (pstate%lnpint(i,k) - pstate%lnpmid(i,k)) / (pstate%lnpmid(i,k-1) - pstate%lnpmid(i,k))
118 45198000 : tint(i,k) = pstate%t(i,k) - dy * (pstate%t(i,k) - pstate%t(i,k-1))
119 : end do
120 : end do
121 :
122 2910240 : do k = 1, num_rrtmg_levs
123 :
124 2879280 : kk = max(k + (pverp-num_rrtmg_levs)-1,1)
125 :
126 48077280 : rstate%pmidmb(:ncol,k) = pstate%pmid(:ncol,kk) * 1.e-2_r8
127 48077280 : rstate%pintmb(:ncol,k) = pstate%pint(:ncol,kk) * 1.e-2_r8
128 :
129 48077280 : rstate%tlay(:ncol,k) = pstate%t(:ncol,kk)
130 48108240 : rstate%tlev(:ncol,k) = tint(:ncol,kk)
131 :
132 : enddo
133 :
134 : ! bottom interface
135 516960 : rstate%pintmb(:ncol,num_rrtmg_levs+1) = pstate%pint(:ncol,pverp) * 1.e-2_r8 ! mbar
136 516960 : rstate%tlev(:ncol,num_rrtmg_levs+1) = tint(:ncol,pverp)
137 :
138 : ! top layer thickness
139 30960 : if (num_rrtmg_levs==pverp) then
140 0 : rstate%pmidmb(:ncol,1) = 0.5_r8 * rstate%pintmb(:ncol,2)
141 0 : rstate%pintmb(:ncol,1) = 1.e-4_r8 ! mbar
142 : endif
143 :
144 61920 : endfunction rrtmg_state_create
145 :
146 : !--------------------------------------------------------------------------------
147 : ! updates the concentration fields
148 : !--------------------------------------------------------------------------------
149 61920 : subroutine rrtmg_state_update(pstate,pbuf,icall,rstate)
150 30960 : use physics_types, only: physics_state
151 : use physics_buffer, only: physics_buffer_desc
152 : use rad_constituents, only: rad_cnst_get_gas
153 :
154 : implicit none
155 :
156 : type(physics_state), intent(in), target :: pstate
157 : type(physics_buffer_desc), pointer :: pbuf(:)
158 : integer, intent(in) :: icall ! index through climate/diagnostic radiation calls
159 : type(rrtmg_state_t) :: rstate
160 :
161 61920 : real(r8), pointer, dimension(:,:) :: sp_hum ! specific humidity
162 61920 : real(r8), pointer, dimension(:,:) :: n2o ! nitrous oxide mass mixing ratio
163 61920 : real(r8), pointer, dimension(:,:) :: ch4 ! methane mass mixing ratio
164 61920 : real(r8), pointer, dimension(:,:) :: o2 ! O2 mass mixing ratio
165 61920 : real(r8), pointer, dimension(:,:) :: cfc11 ! cfc11 mass mixing ratio
166 61920 : real(r8), pointer, dimension(:,:) :: cfc12 ! cfc12 mass mixing ratio
167 61920 : real(r8), pointer, dimension(:,:) :: o3 ! Ozone mass mixing ratio
168 61920 : real(r8), pointer, dimension(:,:) :: co2 ! co2 mass mixing ratio
169 :
170 : integer :: ncol, i, kk, k, lchnk
171 : real(r8) :: H, P_top, P_surface
172 : real(r8), dimension(pcols) :: P_int, P_mid, alpha, beta, a, b, chi_mid, chi_0, chi_eff
173 :
174 61920 : ncol = pstate%ncol
175 61920 : lchnk = pstate%lchnk
176 :
177 : ! Get specific humidity
178 61920 : call rad_cnst_get_gas(icall,'H2O', pstate, pbuf, sp_hum)
179 : ! Get oxygen mass mixing ratio.
180 61920 : call rad_cnst_get_gas(icall,'O2', pstate, pbuf, o2)
181 : ! Get ozone mass mixing ratio.
182 61920 : call rad_cnst_get_gas(icall,'O3', pstate, pbuf, o3)
183 : ! Get CO2 mass mixing ratio
184 61920 : call rad_cnst_get_gas(icall,'CO2', pstate, pbuf, co2)
185 : ! Get N2O mass mixing ratio
186 61920 : call rad_cnst_get_gas(icall,'N2O', pstate, pbuf, n2o)
187 : ! Get CH4 mass mixing ratio
188 61920 : call rad_cnst_get_gas(icall,'CH4', pstate, pbuf, ch4)
189 : ! Get CFC mass mixing ratios
190 61920 : call rad_cnst_get_gas(icall,'CFC11', pstate, pbuf, cfc11)
191 61920 : call rad_cnst_get_gas(icall,'CFC12', pstate, pbuf, cfc12)
192 :
193 5820480 : do k = 1, num_rrtmg_levs
194 :
195 5758560 : kk = max(k + (pverp-num_rrtmg_levs)-1,1)
196 :
197 96154560 : rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm
198 96154560 : rstate%h2ovmr(:ncol,k) = (sp_hum(:ncol,kk) / (1._r8 - sp_hum(:ncol,kk))) * amdw
199 96154560 : rstate%o3vmr(:ncol,k) = o3(:ncol,kk) * amdo
200 96154560 : rstate%co2vmr(:ncol,k) = co2(:ncol,kk) * amdc
201 96154560 : rstate%ch4vmr(:ncol,k) = ch4(:ncol,kk) * amdm
202 96154560 : rstate%o2vmr(:ncol,k) = o2(:ncol,kk) * amdo2
203 96154560 : rstate%n2ovmr(:ncol,k) = n2o(:ncol,kk) * amdn
204 96154560 : rstate%cfc11vmr(:ncol,k) = cfc11(:ncol,kk) * amdc1
205 96154560 : rstate%cfc12vmr(:ncol,k) = cfc12(:ncol,kk) * amdc2
206 96154560 : rstate%cfc22vmr(:ncol,k) = 0._r8
207 96216480 : rstate%ccl4vmr(:ncol,k) = 0._r8
208 :
209 : enddo
210 :
211 : ! For the purpose of attenuating solar fluxes above the CAM model top, we assume that ozone
212 : ! mixing decreases linearly in each column from the value in the top layer of CAM to zero at
213 : ! the pressure level set by P_top. P_top has been set to 50 Pa (0.5 hPa) based on model tuning
214 : ! to produce temperatures at the top of CAM that are most consistent with WACCM at similar pressure levels.
215 :
216 61920 : P_top = 50.0_r8 ! pressure (Pa) at which we assume O3 = 0 in linear decay from CAM top
217 1033920 : P_int(:ncol) = pstate%pint(:ncol,1) ! pressure (Pa) at upper interface of CAM
218 1033920 : P_mid(:ncol) = pstate%pmid(:ncol,1) ! pressure (Pa) at midpoint of top layer of CAM
219 61920 : alpha(:) = 0.0_r8
220 61920 : beta(:) = 0.0_r8
221 1033920 : alpha(:ncol) = log(P_int(:ncol)/P_top)
222 1033920 : beta(:ncol) = log(P_mid(:ncol)/P_int(:ncol))/log(P_mid(:ncol)/P_top)
223 :
224 1033920 : a(:ncol) = ( (1._r8 + alpha(:ncol)) * exp(-alpha(:ncol)) - 1._r8 ) / alpha(:ncol)
225 1033920 : b(:ncol) = 1_r8 - exp(-alpha(:ncol))
226 :
227 9102240 : where(alpha .gt. 0) ! only apply where top level is below 80 km
228 61920 : chi_mid(:) = o3(:,1)*amdo ! molar mixing ratio of O3 at midpoint of top layer
229 : chi_0(:) = chi_mid(:) / (1._r8 + beta(:))
230 : chi_eff(:) = chi_0(:) * (a(:) + b(:))
231 61920 : rstate%o3vmr(:,1) = chi_eff(:)
232 : chi_eff(:) = chi_eff(:) * P_int(:) / amdo / 9.8_r8 ! O3 column above in kg m-2
233 : chi_eff(:) = chi_eff(:) / 2.1415e-5_r8 ! O3 column above in DU
234 : endwhere
235 :
236 61920 : call outfld('O3colAbove', chi_eff(:ncol), ncol, lchnk)
237 :
238 123840 : end subroutine rrtmg_state_update
239 :
240 : !--------------------------------------------------------------------------------
241 : ! de-allocates an rrtmg_state object
242 : !--------------------------------------------------------------------------------
243 30960 : subroutine rrtmg_state_destroy(rstate)
244 :
245 : implicit none
246 :
247 : type(rrtmg_state_t) :: rstate
248 :
249 30960 : deallocate(rstate%h2ovmr)
250 30960 : deallocate(rstate%o3vmr)
251 30960 : deallocate(rstate%co2vmr)
252 30960 : deallocate(rstate%ch4vmr)
253 30960 : deallocate(rstate%o2vmr)
254 30960 : deallocate(rstate%n2ovmr)
255 30960 : deallocate(rstate%cfc11vmr)
256 30960 : deallocate(rstate%cfc12vmr)
257 30960 : deallocate(rstate%cfc22vmr)
258 30960 : deallocate(rstate%ccl4vmr)
259 :
260 30960 : deallocate(rstate%pmidmb)
261 30960 : deallocate(rstate%pintmb)
262 30960 : deallocate(rstate%tlay)
263 30960 : deallocate(rstate%tlev)
264 :
265 61920 : endsubroutine rrtmg_state_destroy
266 :
267 0 : end module rrtmg_state
|
