1 |
|
|
! |
2 |
|
|
! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $ |
3 |
|
|
! |
4 |
|
|
SUBROUTINE readaerosolstrato2_rrtm(debut, ok_volcan) |
5 |
|
|
|
6 |
|
|
USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & |
7 |
|
|
nf95_inq_varid, nf95_open |
8 |
|
|
USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite |
9 |
|
|
|
10 |
|
|
USE phys_cal_mod, ONLY : mth_cur |
11 |
|
|
USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured |
12 |
|
|
USE mod_phys_lmdz_mpi_data |
13 |
|
|
USE mod_phys_lmdz_omp_data |
14 |
|
|
USE mod_phys_lmdz_para |
15 |
|
|
USE phys_state_var_mod |
16 |
|
|
USE phys_local_var_mod |
17 |
|
|
USE aero_mod |
18 |
|
|
USE dimphy |
19 |
|
|
USE YOERAD, ONLY : NLW |
20 |
|
|
USE YOMCST |
21 |
|
|
#ifdef CPP_XIOS |
22 |
|
|
USE xios |
23 |
|
|
#endif |
24 |
|
|
|
25 |
|
|
IMPLICIT NONE |
26 |
|
|
|
27 |
|
|
INCLUDE "clesphys.h" |
28 |
|
|
|
29 |
|
|
CHARACTER (len = 80) :: abort_message |
30 |
|
|
CHARACTER (LEN=20) :: modname = 'readaerosolstrato2' |
31 |
|
|
|
32 |
|
|
! Variable input |
33 |
|
|
LOGICAL, INTENT(IN) :: debut |
34 |
|
|
LOGICAL, INTENT(IN) :: ok_volcan !activate volcanic diags |
35 |
|
|
|
36 |
|
|
! Variables locales |
37 |
|
|
INTEGER n_lat ! number of latitudes in the input data |
38 |
|
|
INTEGER n_lon ! number of longitudes |
39 |
|
|
INTEGER n_lev ! number of levels in the input data |
40 |
|
|
INTEGER n_month ! number of months in the input data |
41 |
|
|
INTEGER n_wav ! number of wavelengths in the input data |
42 |
|
|
REAL, ALLOCATABLE:: latitude(:) |
43 |
|
|
REAL, ALLOCATABLE:: time(:) |
44 |
|
|
REAL, ALLOCATABLE:: lev(:) |
45 |
|
|
REAL, ALLOCATABLE:: wav(:) |
46 |
|
|
INTEGER i,k,wave,band |
47 |
|
|
INTEGER, SAVE :: mth_pre=1 |
48 |
|
|
!$OMP THREADPRIVATE(mth_pre) |
49 |
|
|
|
50 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: tau_aer_strat |
51 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: piz_aer_strat |
52 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cg_aer_strat |
53 |
|
|
REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: taulw_aer_strat |
54 |
|
|
!$OMP THREADPRIVATE(tau_aer_strat,piz_aer_strat,cg_aer_strat,taulw_aer_strat) |
55 |
|
|
|
56 |
|
|
! Champs reconstitues |
57 |
|
|
REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :) |
58 |
|
|
REAL, ALLOCATABLE:: pizaerstrat(:, :, :, :) |
59 |
|
|
REAL, ALLOCATABLE:: cgaerstrat(:, :, :, :) |
60 |
|
|
REAL, ALLOCATABLE:: taulwaerstrat(:, :, :, :) |
61 |
|
|
|
62 |
|
|
REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :, :) |
63 |
|
|
REAL, ALLOCATABLE:: pizaerstrat_mois(:, :, :, :) |
64 |
|
|
REAL, ALLOCATABLE:: cgaerstrat_mois(:, :, :, :) |
65 |
|
|
REAL, ALLOCATABLE:: taulwaerstrat_mois(:, :, :, :) |
66 |
|
|
|
67 |
|
|
REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :, :) |
68 |
|
|
REAL, ALLOCATABLE:: pizaerstrat_mois_glo(:, :, :) |
69 |
|
|
REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :) |
70 |
|
|
REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :) |
71 |
|
|
REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :) |
72 |
|
|
REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :) |
73 |
|
|
REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :) |
74 |
|
|
REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :) |
75 |
|
|
|
76 |
|
|
! For NetCDF: |
77 |
|
|
INTEGER ncid_in ! IDs for input files |
78 |
|
|
INTEGER varid, ncerr |
79 |
|
|
|
80 |
|
|
!-------------------------------------------------------- |
81 |
|
|
|
82 |
|
|
IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev,NSW)) |
83 |
|
|
IF (.not.ALLOCATED(piz_aer_strat)) ALLOCATE(piz_aer_strat(klon,klev,NSW)) |
84 |
|
|
IF (.not.ALLOCATED(cg_aer_strat)) ALLOCATE(cg_aer_strat(klon,klev,NSW)) |
85 |
|
|
|
86 |
|
|
IF (.not.ALLOCATED(taulw_aer_strat)) ALLOCATE(taulw_aer_strat(klon,klev,NLW)) |
87 |
|
|
|
88 |
|
|
!--we only read monthly strat aerosol data |
89 |
|
|
IF (debut.OR.mth_cur.NE.mth_pre) THEN |
90 |
|
|
|
91 |
|
|
!--only root reads the data |
92 |
|
|
IF (is_mpi_root.AND.is_omp_root) THEN |
93 |
|
|
|
94 |
|
|
!--check mth_cur |
95 |
|
|
IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN |
96 |
|
|
print *,'probleme avec le mois dans readaerosolstrat =', mth_cur |
97 |
|
|
ENDIF |
98 |
|
|
|
99 |
|
|
!--initialize n_lon as input data is 2D (lat-alt) only |
100 |
|
|
n_lon = nbp_lon |
101 |
|
|
|
102 |
|
|
!--Starts with SW optical properties |
103 |
|
|
|
104 |
|
|
CALL nf95_open("tauswstrat.2D.nc", nf90_nowrite, ncid_in) |
105 |
|
|
|
106 |
|
|
CALL nf95_inq_varid(ncid_in, "LEV", varid) |
107 |
|
|
CALL nf95_gw_var(ncid_in, varid, lev) |
108 |
|
|
n_lev = size(lev) |
109 |
|
|
IF (n_lev.NE.klev) THEN |
110 |
|
|
abort_message='Le nombre de niveaux n est pas egal a klev' |
111 |
|
|
CALL abort_physic(modname,abort_message,1) |
112 |
|
|
ENDIF |
113 |
|
|
|
114 |
|
|
CALL nf95_inq_varid(ncid_in, "LAT", varid) |
115 |
|
|
CALL nf95_gw_var(ncid_in, varid, latitude) |
116 |
|
|
n_lat = size(latitude) |
117 |
|
|
|
118 |
|
|
IF (grid_type/=unstructured) THEN |
119 |
|
|
IF (n_lat.NE.nbp_lat) THEN |
120 |
|
|
print *, 'latitude=', n_lat, nbp_lat |
121 |
|
|
abort_message='Le nombre de lat n est pas egal a nbp_lat' |
122 |
|
|
CALL abort_physic(modname,abort_message,1) |
123 |
|
|
ENDIF |
124 |
|
|
ENDIF |
125 |
|
|
|
126 |
|
|
CALL nf95_inq_varid(ncid_in, "TIME", varid) |
127 |
|
|
CALL nf95_gw_var(ncid_in, varid, time) |
128 |
|
|
n_month = size(time) |
129 |
|
|
IF (n_month.NE.12) THEN |
130 |
|
|
abort_message='Le nombre de month n est pas egal a 12' |
131 |
|
|
CALL abort_physic(modname,abort_message,1) |
132 |
|
|
ENDIF |
133 |
|
|
|
134 |
|
|
CALL nf95_inq_varid(ncid_in, "WAV", varid) |
135 |
|
|
CALL nf95_gw_var(ncid_in, varid, wav) |
136 |
|
|
n_wav = size(wav) |
137 |
|
|
print *, 'WAV aerosol strato=', n_wav, wav |
138 |
|
|
IF (n_wav.NE.NSW) THEN |
139 |
|
|
abort_message='Le nombre de wav n est pas egal a NSW' |
140 |
|
|
CALL abort_physic(modname,abort_message,1) |
141 |
|
|
ENDIF |
142 |
|
|
|
143 |
|
|
ALLOCATE(tauaerstrat(n_lat, n_lev, n_wav, n_month)) |
144 |
|
|
ALLOCATE(pizaerstrat(n_lat, n_lev, n_wav, n_month)) |
145 |
|
|
ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month)) |
146 |
|
|
|
147 |
|
|
!--reading stratospheric aerosol tau per layer |
148 |
|
|
CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid) |
149 |
|
|
ncerr = nf90_get_var(ncid_in, varid, tauaerstrat) |
150 |
|
|
print *,'code erreur readaerosolstrato=', ncerr, varid |
151 |
|
|
|
152 |
|
|
!--reading stratospheric aerosol omega per layer |
153 |
|
|
CALL nf95_inq_varid(ncid_in, "OME_SUN", varid) |
154 |
|
|
ncerr = nf90_get_var(ncid_in, varid, pizaerstrat) |
155 |
|
|
print *,'code erreur readaerosolstrato=', ncerr, varid |
156 |
|
|
|
157 |
|
|
!--reading stratospheric aerosol g per layer |
158 |
|
|
CALL nf95_inq_varid(ncid_in, "GGG_SUN", varid) |
159 |
|
|
ncerr = nf90_get_var(ncid_in, varid, cgaerstrat) |
160 |
|
|
print *,'code erreur readaerosolstrato sw=', ncerr, varid |
161 |
|
|
|
162 |
|
|
CALL nf95_close(ncid_in) |
163 |
|
|
|
164 |
|
|
|
165 |
|
|
IF (grid_type/=unstructured) THEN |
166 |
|
|
ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) |
167 |
|
|
ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) |
168 |
|
|
ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) |
169 |
|
|
|
170 |
|
|
ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav)) |
171 |
|
|
ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav)) |
172 |
|
|
ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav)) |
173 |
|
|
!--select the correct month |
174 |
|
|
!--and copy into 1st longitude |
175 |
|
|
tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur) |
176 |
|
|
pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur) |
177 |
|
|
cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur) |
178 |
|
|
|
179 |
|
|
!--copy longitudes |
180 |
|
|
DO i=2, n_lon |
181 |
|
|
tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:) |
182 |
|
|
pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:) |
183 |
|
|
cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:) |
184 |
|
|
ENDDO |
185 |
|
|
|
186 |
|
|
!---reduce to a klon_glo grid |
187 |
|
|
DO band=1, NSW |
188 |
|
|
CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band)) |
189 |
|
|
CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band)) |
190 |
|
|
CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band)) |
191 |
|
|
ENDDO |
192 |
|
|
ENDIF |
193 |
|
|
!--Now LW optical properties |
194 |
|
|
! |
195 |
|
|
|
196 |
|
|
CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in) |
197 |
|
|
|
198 |
|
|
CALL nf95_inq_varid(ncid_in, "LEV", varid) |
199 |
|
|
CALL nf95_gw_var(ncid_in, varid, lev) |
200 |
|
|
n_lev = size(lev) |
201 |
|
|
IF (n_lev.NE.klev) THEN |
202 |
|
|
abort_message='Le nombre de niveaux n est pas egal a klev' |
203 |
|
|
CALL abort_physic(modname,abort_message,1) |
204 |
|
|
ENDIF |
205 |
|
|
|
206 |
|
|
CALL nf95_inq_varid(ncid_in, "LAT", varid) |
207 |
|
|
CALL nf95_gw_var(ncid_in, varid, latitude) |
208 |
|
|
n_lat = size(latitude) |
209 |
|
|
|
210 |
|
|
IF (grid_type/=unstructured) THEN |
211 |
|
|
IF (n_lat.NE.nbp_lat) THEN |
212 |
|
|
abort_message='Le nombre de lat n est pas egal a nbp_lat' |
213 |
|
|
CALL abort_physic(modname,abort_message,1) |
214 |
|
|
ENDIF |
215 |
|
|
ENDIF |
216 |
|
|
|
217 |
|
|
CALL nf95_inq_varid(ncid_in, "TIME", varid) |
218 |
|
|
CALL nf95_gw_var(ncid_in, varid, time) |
219 |
|
|
n_month = size(time) |
220 |
|
|
IF (n_month.NE.12) THEN |
221 |
|
|
abort_message='Le nombre de month n est pas egal a 12' |
222 |
|
|
CALL abort_physic(modname,abort_message,1) |
223 |
|
|
ENDIF |
224 |
|
|
|
225 |
|
|
CALL nf95_inq_varid(ncid_in, "WAV", varid) |
226 |
|
|
CALL nf95_gw_var(ncid_in, varid, wav) |
227 |
|
|
n_wav = size(wav) |
228 |
|
|
print *, 'WAV aerosol strato=', n_wav, wav |
229 |
|
|
IF (n_wav.NE.NLW) THEN |
230 |
|
|
abort_message='Le nombre de wav n est pas egal a NLW' |
231 |
|
|
CALL abort_physic(modname,abort_message,1) |
232 |
|
|
ENDIF |
233 |
|
|
|
234 |
|
|
ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month)) |
235 |
|
|
|
236 |
|
|
!--reading stratospheric aerosol lw tau per layer |
237 |
|
|
CALL nf95_inq_varid(ncid_in, "TAU_EAR", varid) |
238 |
|
|
ncerr = nf90_get_var(ncid_in, varid, taulwaerstrat) |
239 |
|
|
print *,'code erreur readaerosolstrato lw=', ncerr, varid |
240 |
|
|
|
241 |
|
|
CALL nf95_close(ncid_in) |
242 |
|
|
|
243 |
|
|
IF (grid_type/=unstructured) THEN |
244 |
|
|
|
245 |
|
|
ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav)) |
246 |
|
|
ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav)) |
247 |
|
|
|
248 |
|
|
!--select the correct month |
249 |
|
|
!--and copy into 1st longitude |
250 |
|
|
taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur) |
251 |
|
|
!--copy longitudes |
252 |
|
|
DO i=2, n_lon |
253 |
|
|
taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:) |
254 |
|
|
ENDDO |
255 |
|
|
|
256 |
|
|
!---reduce to a klon_glo grid |
257 |
|
|
DO band=1, NLW |
258 |
|
|
CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band)) |
259 |
|
|
ENDDO |
260 |
|
|
ENDIF |
261 |
|
|
|
262 |
|
|
ELSE !--proc other than mpi_root and omp_root |
263 |
|
|
!--dummy allocation needed for debug mode |
264 |
|
|
|
265 |
|
|
ALLOCATE(tauaerstrat_mois_glo(1,1,1)) |
266 |
|
|
ALLOCATE(pizaerstrat_mois_glo(1,1,1)) |
267 |
|
|
ALLOCATE(cgaerstrat_mois_glo(1,1,1)) |
268 |
|
|
ALLOCATE(taulwaerstrat_mois_glo(1,1,1)) |
269 |
|
|
|
270 |
|
|
ALLOCATE(tauaerstrat(0,0,0,12)) |
271 |
|
|
ALLOCATE(pizaerstrat(0,0,0,12)) |
272 |
|
|
ALLOCATE(cgaerstrat(0,0,0,12)) |
273 |
|
|
ALLOCATE(taulwaerstrat(0,0,0,12)) |
274 |
|
|
|
275 |
|
|
|
276 |
|
|
ENDIF !--is_mpi_root and is_omp_root |
277 |
|
|
|
278 |
|
|
!$OMP BARRIER |
279 |
|
|
|
280 |
|
|
!--keep memory of previous month |
281 |
|
|
mth_pre=mth_cur |
282 |
|
|
|
283 |
|
|
IF (grid_type==unstructured) THEN |
284 |
|
|
|
285 |
|
|
#ifdef CPP_XIOS |
286 |
|
|
|
287 |
|
|
IF (is_omp_master) THEN |
288 |
|
|
ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW)) |
289 |
|
|
ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW)) |
290 |
|
|
ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW)) |
291 |
|
|
ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW)) |
292 |
|
|
|
293 |
|
|
CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8)) |
294 |
|
|
CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi) |
295 |
|
|
CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8)) |
296 |
|
|
CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi) |
297 |
|
|
CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8)) |
298 |
|
|
CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi) |
299 |
|
|
CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8)) |
300 |
|
|
CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi) |
301 |
|
|
ELSE |
302 |
|
|
ALLOCATE(tauaerstrat_mpi(0, 0, 0)) |
303 |
|
|
ALLOCATE(pizaerstrat_mpi(0, 0, 0)) |
304 |
|
|
ALLOCATE(cgaerstrat_mpi(0, 0, 0)) |
305 |
|
|
ALLOCATE(taulwaerstrat_mpi(0, 0, 0)) |
306 |
|
|
ENDIF |
307 |
|
|
|
308 |
|
|
CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat) |
309 |
|
|
CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat) |
310 |
|
|
CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat) |
311 |
|
|
CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat) |
312 |
|
|
#endif |
313 |
|
|
ELSE |
314 |
|
|
|
315 |
|
|
!--scatter on all proc |
316 |
|
|
CALL scatter(tauaerstrat_mois_glo,tau_aer_strat) |
317 |
|
|
CALL scatter(pizaerstrat_mois_glo,piz_aer_strat) |
318 |
|
|
CALL scatter(cgaerstrat_mois_glo,cg_aer_strat) |
319 |
|
|
CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat) |
320 |
|
|
IF (is_mpi_root.AND.is_omp_root) DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois) |
321 |
|
|
|
322 |
|
|
ENDIF |
323 |
|
|
|
324 |
|
|
IF (is_mpi_root.AND.is_omp_root) THEN |
325 |
|
|
DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat) |
326 |
|
|
ENDIF |
327 |
|
|
|
328 |
|
|
|
329 |
|
|
!$OMP BARRIER |
330 |
|
|
|
331 |
|
|
ENDIF !--debut ou nouveau mois |
332 |
|
|
|
333 |
|
|
!--total vertical aod at the 5 SW wavelengths |
334 |
|
|
!--for now use band 3 AOD into all 5 wavelengths |
335 |
|
|
!--it is only a reasonable approximation for 550 nm (wave=2) |
336 |
|
|
band=3 |
337 |
|
|
DO i=1, klon |
338 |
|
|
DO k=1, klev |
339 |
|
|
IF (stratomask(i,k).GT.0.999999) THEN |
340 |
|
|
DO wave=1, nwave_sw |
341 |
|
|
tausum_aero(i,wave,id_STRAT_phy)=tausum_aero(i,wave,id_STRAT_phy)+tau_aer_strat(i,k,band) |
342 |
|
|
ENDDO |
343 |
|
|
ENDIF |
344 |
|
|
ENDDO |
345 |
|
|
ENDDO |
346 |
|
|
|
347 |
|
|
IF (.NOT. ok_volcan) THEN |
348 |
|
|
! |
349 |
|
|
!--this is the default case |
350 |
|
|
!--stratospheric aerosols are added to both index 2 and 1 for double radiation calls |
351 |
|
|
!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones |
352 |
|
|
DO band=1, NSW |
353 |
|
|
WHERE (stratomask.GT.0.999999) |
354 |
|
|
!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW |
355 |
|
|
cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
356 |
|
|
cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
357 |
|
|
MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
358 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 ) |
359 |
|
|
piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
360 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
361 |
|
|
MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 ) |
362 |
|
|
tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band) |
363 |
|
|
!--strat aerosols are added to index 1 : natural aerosols only for bands 1 to NSW |
364 |
|
|
cg_aero_sw_rrtm(:,:,1,band) = ( cg_aero_sw_rrtm(:,:,1,band)*piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & |
365 |
|
|
cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
366 |
|
|
MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & |
367 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 ) |
368 |
|
|
piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + & |
369 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
370 |
|
|
MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 ) |
371 |
|
|
tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band) |
372 |
|
|
ENDWHERE |
373 |
|
|
ENDDO |
374 |
|
|
! |
375 |
|
|
ELSE |
376 |
|
|
! |
377 |
|
|
!--this is the VOLMIP case |
378 |
|
|
!--stratospheric aerosols are only added to index 2 in this case |
379 |
|
|
!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones |
380 |
|
|
DO band=1, NSW |
381 |
|
|
WHERE (stratomask.GT.0.999999) |
382 |
|
|
!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW |
383 |
|
|
cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
384 |
|
|
cg_aer_strat(:,:,band)*piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
385 |
|
|
MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
386 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 ) |
387 |
|
|
piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + & |
388 |
|
|
piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / & |
389 |
|
|
MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 ) |
390 |
|
|
tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band) |
391 |
|
|
ENDWHERE |
392 |
|
|
ENDDO |
393 |
|
|
ENDIF |
394 |
|
|
|
395 |
|
|
!--total vertical aod at 10 um |
396 |
|
|
!--this is approximated from band 7 of RRTM |
397 |
|
|
band=7 |
398 |
|
|
DO i=1, klon |
399 |
|
|
DO k=1, klev |
400 |
|
|
IF (stratomask(i,k).GT.0.999999) THEN |
401 |
|
|
DO wave=1, nwave_lw |
402 |
|
|
tausum_aero(i,nwave_sw+wave,id_STRAT_phy)=tausum_aero(i,nwave_sw+wave,id_STRAT_phy)+taulw_aer_strat(i,k,band) |
403 |
|
|
ENDDO |
404 |
|
|
ENDIF |
405 |
|
|
ENDDO |
406 |
|
|
ENDDO |
407 |
|
|
|
408 |
|
|
IF (.NOT. ok_volcan) THEN |
409 |
|
|
!--this is the default case |
410 |
|
|
!--stratospheric aerosols are added to both index 2 and 1 |
411 |
|
|
DO band=1, NLW |
412 |
|
|
WHERE (stratomask.GT.0.999999) |
413 |
|
|
tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band) |
414 |
|
|
tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) + taulw_aer_strat(:,:,band) |
415 |
|
|
ENDWHERE |
416 |
|
|
ENDDO |
417 |
|
|
! |
418 |
|
|
ELSE |
419 |
|
|
! |
420 |
|
|
!--this is the VOLMIP case |
421 |
|
|
DO band=1, NLW |
422 |
|
|
!--stratospheric aerosols are not added to index 1 |
423 |
|
|
!--and we copy index 2 in index 1 because we want the same dust aerosol LW properties as above |
424 |
|
|
tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,2,band) |
425 |
|
|
! |
426 |
|
|
WHERE (stratomask.GT.0.999999) |
427 |
|
|
!--stratospheric aerosols are only added to index 2 |
428 |
|
|
tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band) |
429 |
|
|
ENDWHERE |
430 |
|
|
ENDDO |
431 |
|
|
ENDIF |
432 |
|
|
|
433 |
|
|
!--default SSA value if there is no aerosol |
434 |
|
|
!--to avoid 0 values that seems to cause some problem to RRTM |
435 |
|
|
WHERE (tau_aero_sw_rrtm.LT.1.e-14) |
436 |
|
|
piz_aero_sw_rrtm = 1.0 |
437 |
|
|
ENDWHERE |
438 |
|
|
|
439 |
|
|
!--in principle this should not be necessary |
440 |
|
|
!--as these variables have min values already but just in case |
441 |
|
|
!--put 1e-15 min value to both SW and LW AOD |
442 |
|
|
tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15) |
443 |
|
|
tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15) |
444 |
|
|
|
445 |
|
|
END SUBROUTINE readaerosolstrato2_rrtm |