LMDZ
recmwf_aero.F90
Go to the documentation of this file.
1 !
2 ! $Id: recmwf_aero.F90 2146 2014-11-14 20:22:21Z idelkadi $
3 !
4 !OPTIONS XOPT(NOEVAL)
5 SUBROUTINE recmwf_aero (KST, KEND, KPROMA, KTDIA , KLEV,&
6  & kmode,&
7  & palbd , palbp , paprs , paprsf , pcco2 , pclfr,&
8  & pqo3 , paer , pdp , pemis , pmu0,&
9  & pq , pqs , pqiwp , pqlwp , pslm , pt , pts,&
10  & pref_liq, pref_ice,&
11 !--OB
12  & pref_liq_pi, pref_ice_pi,&
13 !--fin
14  & pemtd , pemtu , ptrso,&
15  & pth , pctrso, pcemtr, ptrsod,&
16  & plwfc, plwft, pswfc, pswft, psfswdir, psfswdif,&
17  & pfsdnn, pfsdnv,&
18  & ppiza_tot,pcga_tot,ptau_tot, &
19 !--OB
20  & ppiza_nat,pcga_nat,ptau_nat, &
21 !--fin OB
22 !--C.Kleinschmitt
23  & ptau_lw_tot, ptau_lw_nat, &
24 !--end
25  & pflux,pfluc,&
26  & pfsdn ,pfsup , pfscdn , pfscup,&
27 !--OB diagnostics
28  & ptopswadaero,psolswadaero,&
29  & ptopswad0aero,psolswad0aero,&
30  & ptopswaiaero,psolswaiaero,&
31  & ptopswcfaero,psolswcfaero,&
32 !--LW diagnostics CK
33  & ptoplwadaero,psollwadaero,&
34  & ptoplwad0aero,psollwad0aero,&
35  & ptoplwaiaero,psollwaiaero,&
36 !..end
37  & ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat)
38 !--fin
39 
40 !**** *RECMWF* - METEO-FRANCE RADIATION INTERFACE TO ECMWF RADIATION SCHEME
41 
42 ! PURPOSE.
43 ! --------
44 ! SIMPLE INTERFACE TO RADLSW (NO INTERPOLATION)
45 
46 !** INTERFACE.
47 ! ----------
48 
49 ! EXPLICIT ARGUMENTS :
50 ! --------------------
51 ! KST : START INDEX OF DATA IN KPROMA-LONG VECTOR
52 ! KEND : END INDEX OF DATA IN KPROMA-LONG VECTOR
53 ! KPROMA : VECTOR LENGTH
54 ! KTDIA : INDEX OF TOP LEVEL FROM WHICH COMPUTATIONS ARE ACTIVE
55 ! KLEV : NUMBER OF LEVELS
56 ! PAER : (KPROMA,KLEV ,6) ; OPTICAL THICKNESS OF THE AEROSOLS
57 ! PALBD : (KPROMA,NSW) ; DIFFUSE ALBEDO IN THE 2 SW INTERVALS
58 ! PALBP : (KPROMA,NSW) ; PARALLEL ALBEDO IN THE 2 SW INTERVALS
59 ! PAPRS : (KPROMA,KLEV+1) ; HALF LEVEL PRESSURE
60 ! PAPRSF : (KPROMA,KLEV ) ; FULL LEVEL PRESSURE
61 ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA)
62 ! PCLFR : (KPROMA,KLEV ) ; CLOUD FRACTIONAL COVER
63 ! PQO3 : (KPROMA,KLEV ) ; OZONE MIXING RATIO (MASS)
64 ! PDP : (KPROMA,KLEV) ; LAYER PRESSURE THICKNESS
65 ! PEMIS : (KPROMA) ; SURFACE EMISSIVITY
66 ! PMU0 : (KPROMA) ; SOLAR ANGLE
67 ! PQ : (KPROMA,KLEV ) ; SPECIFIC HUMIDITY PA/PA
68 ! PQS : (KPROMA,KLEV ) ; SATURATION SPECIFIC HUMIDITY PA/PA
69 ! PQIWP : (KPROMA,KLEV ) ; ICE WATER KG/KG
70 ! PQLWP : (KPROMA,KLEV ) ; LIQUID WATER KG/KG
71 ! PSLM : (KPROMA) ; LAND-SEA MASK
72 ! PT : (KPROMA,KLEV) ; FULL LEVEL TEMPERATURE
73 ! PTS : (KPROMA) ; SURFACE TEMPERATURE
74 ! PPIZA_TOT : (KPROMA,KLEV,NSW); Single scattering albedo of total aerosol
75 ! PCGA_TOT : (KPROMA,KLEV,NSW); Assymetry factor for total aerosol
76 ! PTAU_TOT: (KPROMA,KLEV,NSW) ; Optical depth of total aerosol
77 ! PREF_LIQ (KPROMA,KLEV) ; Liquid droplet radius (um) - present-day
78 ! PREF_ICE (KPROMA,KLEV) ; Ice crystal radius (um) - present-day
79 !--OB
80 ! PREF_LIQ_PI (KPROMA,KLEV) ; Liquid droplet radius (um) - pre-industrial
81 ! PREF_ICE_PI (KPROMA,KLEV) ; Ice crystal radius (um) - pre-industrial
82 ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
83 ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
84 ! flag_aerosol-input-I- aerosol flag from 0 to 6
85 ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (T/F)
86 ! PPIZA_NAT : (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosol
87 ! PCGA_NAT : (KPROMA,KLEV,NSW); Assymetry factor for natural aerosol
88 ! PTAU_NAT: (KPROMA,KLEV,NSW) ; Optical depth of natural aerosol
89 ! PTAU_LW_TOT (KPROMA,KLEV,NLW); LW Optical depth of total aerosols
90 ! PTAU_LW_NAT (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols
91 !--fin OB
92 
93 ! ==== OUTPUTS ===
94 ! PEMTD (KPROMA,KLEV+1) ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
95 ! PEMTU (KPROMA,KLEV+1) ; TOTAL UPWARD LONGWAVE EMISSIVITY
96 ! PTRSO (KPROMA,KLEV+1) ; TOTAL SHORTWAVE TRANSMISSIVITY
97 ! PTH (KPROMA,KLEV+1) ; HALF LEVEL TEMPERATURE
98 ! PCTRSO(KPROMA,2) ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
99 ! PCEMTR(KPROMA,2) ; CLEAR-SKY NET LONGWAVE EMISSIVITY
100 ! PTRSOD(KPROMA) ; TOTAL-SKY SURFACE SW TRANSMISSITY
101 ! PLWFC (KPROMA,2) ; CLEAR-SKY LONGWAVE FLUXES
102 ! PLWFT (KPROMA,KLEV+1) ; TOTAL-SKY LONGWAVE FLUXES
103 ! PSWFC (KPROMA,2) ; CLEAR-SKY SHORTWAVE FLUXES
104 ! PSWFT (KPROMA,KLEV+1) ; TOTAL-SKY SHORTWAVE FLUXES
105 ! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
106 ! PFLUX (KPROMA,2,KLEV+1) ; LW total sky flux (1=up, 2=down)
107 ! PFLUC (KPROMA,2,KLEV+1) ; LW clear sky flux (1=up, 2=down)
108 ! PFSDN(KPROMA,KLEV+1) ; SW total sky flux down
109 ! PFSUP(KPROMA,KLEV+1) ; SW total sky flux up
110 ! PFSCDN(KPROMA,KLEV+1) ; SW clear sky flux down
111 ! PFSCUP(KPROMA,KLEV+1) ; SW clear sky flux up
112 
113 
114 ! IMPLICIT ARGUMENTS : NONE
115 ! --------------------
116 
117 ! METHOD.
118 ! -------
119 ! SEE DOCUMENTATION
120 
121 ! EXTERNALS.
122 ! ----------
123 
124 ! REFERENCE.
125 ! ----------
126 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
127 
128 ! AUTHORS.
129 ! --------
130 ! ORIGINAL BY B. RITTER *ECMWF* 83-10-13
131 ! REWRITING FOR IFS BY J.-J. MORCRETTE 94-11-15
132 ! 96-11: Ph. Dandin. Meteo-France
133 ! REWRITING FOR DM BY J.PH. PIEDELIEVRE 1998-07
134 ! Duplication of RFMR to use present (cy25) ECMWF radiation scheme : Y. Bouteloup 09-2003
135 ! Use of 6 aerosols & introduce NSW : F. Bouyssel 09-2004
136 ! 04-11-18 : 4 New arguments for AROME : Y. Seity
137 ! 2005-10-10 Y. Seity : 3 optional arguments for dust optical properties
138 ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation (ECMWF)
139 ! Olivier Boucher: added LMD radiation diagnostics 2014-03
140 
141 !-----------------------------------------------------------------------
142 
143 USE parkind1 ,ONLY : jpim ,jprb
144 USE yomhook ,ONLY : lhook, dr_hook
145 USE yoeaerd , ONLY : rcaeros
146 USE yomcst , ONLY : rmd ,rmo3
147 USE yomphy3 , ONLY : rii0
148 USE yoerad , ONLY : nlw, naer, rccnlnd ,rccnsea
149 USE yoerad , ONLY : naer, rccnlnd ,rccnsea
150 USE yoerdu , ONLY : repscq
151 USE yomgem , ONLY : ngptot
152 USE yoerdi , ONLY : rrae ,repclc ,reph2o
153 USE yomarphy , ONLY : lrdust
154 USE phys_output_mod, ONLY : swaero_diag
155 
156 !-----------------------------------------------------------------------
157 
158 !* 0.1 ARGUMENTS.
159 ! ----------
160 
161 IMPLICIT NONE
162 include "clesphys.h"
163 
164 
165 INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA
166 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
167 INTEGER(KIND=JPIM),INTENT(IN) :: KST
168 INTEGER(KIND=JPIM),INTENT(IN) :: KEND
169 INTEGER(KIND=JPIM) :: KTDIA ! Argument NOT used
170 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE
171 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(kproma,nsw)
172 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(kproma,nsw)
173 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRS(kproma,klev+1)
174 REAL(KIND=JPRB) ,INTENT(IN) :: PAPRSF(kproma,klev)
175 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2
176 REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(kproma,klev)
177 REAL(KIND=JPRB) ,INTENT(IN) :: PQO3(kproma,klev)
178 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(kproma,klev,6)
179 REAL(KIND=JPRB) ,INTENT(IN) :: PDP(kproma,klev)
180 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(kproma)
181 REAL(KIND=JPRB) ,INTENT(IN) :: PMU0(kproma)
182 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(kproma,klev)
183 REAL(KIND=JPRB) ,INTENT(IN) :: PQS(kproma,klev)
184 REAL(KIND=JPRB) ,INTENT(IN) :: PQIWP(kproma,klev)
185 REAL(KIND=JPRB) ,INTENT(IN) :: PQLWP(kproma,klev)
186 REAL(KIND=JPRB) ,INTENT(IN) :: PSLM(kproma)
187 REAL(KIND=JPRB) ,INTENT(IN) :: PT(kproma,klev)
188 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(kproma)
189 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_TOT(kproma,klev,nsw)
190 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_TOT(kproma,klev,nsw)
191 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_TOT(kproma,klev,nsw)
192 !--OB
193 REAL(KIND=JPRB) ,INTENT(IN) :: PPIZA_NAT(kproma,klev,nsw)
194 REAL(KIND=JPRB) ,INTENT(IN) :: PCGA_NAT(kproma,klev,nsw)
195 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_NAT(kproma,klev,nsw)
196 REAL(KIND=JPRB) :: PPIZA_ZERO(kproma,klev,nsw)
197 REAL(KIND=JPRB) :: PCGA_ZERO(kproma,klev,nsw)
198 REAL(KIND=JPRB) :: PTAU_ZERO(kproma,klev,nsw)
199 !--fin
200 !--C.Kleinschmitt
201 REAL(KIND=JPRB) :: PTAU_LW_ZERO(kproma,klev,nlw)
202 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_TOT(kproma,klev,nlw)
203 REAL(KIND=JPRB) ,INTENT(IN) :: PTAU_LW_NAT(kproma,klev,nlw)
204 !--end
205 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ(kproma,klev)
206 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE(kproma,klev)
207 !--OB
208 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_LIQ_PI(kproma,klev)
209 REAL(KIND=JPRB) ,INTENT(IN) :: PREF_ICE_PI(kproma,klev)
210 LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not
211 INTEGER, INTENT(in) :: flag_aerosol ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
212 LOGICAL, INTENT(in) :: flag_aerosol_strat ! use stratospheric aerosols
213 REAL(KIND=JPRB) ,INTENT(out) :: PTOPSWADAERO(kproma), PSOLSWADAERO(kproma) ! Aerosol direct forcing at TOA and surface
214 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAD0AERO(kproma), PSOLSWAD0AERO(kproma) ! Aerosol direct forcing at TOA and surface
215 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWAIAERO(kproma), PSOLSWAIAERO(kproma) ! ditto, indirect
216 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPSWCFAERO(kproma,3), PSOLSWCFAERO(kproma,3) !--do we keep this ?
217 !--fin
218 !--CK
219 REAL(KIND=JPRB) ,INTENT(out) :: PTOPLWADAERO(kproma), PSOLLWADAERO(kproma) ! LW Aerosol direct forcing at TOA + surface
220 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAD0AERO(kproma), PSOLLWAD0AERO(kproma) ! LW Aerosol direct forcing at TOA + surface
221 REAL(KIND=JPRB) ,INTENT(OUT) :: PTOPLWAIAERO(kproma), PSOLLWAIAERO(kproma) ! LW Aer. indirect forcing at TOA + surface
222 !--end
223 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTD(kproma,klev+1)
224 REAL(KIND=JPRB) ,INTENT(OUT) :: PEMTU(kproma,klev+1)
225 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSO(kproma,klev+1)
226 REAL(KIND=JPRB) ,INTENT(INOUT) :: PTH(kproma,klev+1)
227 REAL(KIND=JPRB) ,INTENT(OUT) :: PCTRSO(kproma,2)
228 REAL(KIND=JPRB) ,INTENT(OUT) :: PCEMTR(kproma,2)
229 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRSOD(kproma)
230 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFC(kproma,2)
231 REAL(KIND=JPRB) ,INTENT(OUT) :: PLWFT(kproma,klev+1)
232 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFC(kproma,2)
233 REAL(KIND=JPRB) ,INTENT(OUT) :: PSWFT(kproma,klev+1)
234 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIR(kproma,nsw)
235 REAL(KIND=JPRB) ,INTENT(OUT) :: PSFSWDIF(kproma,nsw)
236 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNN(kproma)
237 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDNV(kproma)
238 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(kproma,2,klev+1) ! LW total sky flux (1=up, 2=down)
239 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(kproma,2,klev+1) ! LW clear sky flux (1=up, 2=down)
240 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSDN(kproma,klev+1) ! SW total sky flux down
241 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUP(kproma,klev+1) ! SW total sky flux up
242 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCDN(kproma,klev+1) ! SW clear sky flux down
243 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSCUP(kproma,klev+1) ! SW clear sky flux up
244 
245 ! ==== COMPUTED IN RADITE ===
246 ! ------------------------------------------------------------------
247 !* 0.2 LOCAL ARRAYS.
248 ! -------------
249 REAL(KIND=JPRB) :: ZRAER (kproma,6,klev)
250 REAL(KIND=JPRB) :: ZRCLC (kproma,klev)
251 REAL(KIND=JPRB) :: ZRMU0 (kproma)
252 REAL(KIND=JPRB) :: ZRPR (kproma,klev)
253 REAL(KIND=JPRB) :: ZRTI (kproma,klev)
254 REAL(KIND=JPRB) :: ZQLWP (kproma,klev ) , ZQIWP (kproma,klev )
255 
256 REAL(KIND=JPRB) :: ZPQO3 (kproma,klev)
257 REAL(KIND=JPRB) :: ZQOZ (ngptot,klev)
258 REAL(KIND=JPRB) :: ZQS (kproma,klev)
259 REAL(KIND=JPRB) :: ZQ (kproma,klev)
260 REAL(KIND=JPRB) :: ZEMTD (kproma,klev+1)
261 REAL(KIND=JPRB) :: ZEMTU (kproma,klev+1)
262 REAL(KIND=JPRB) :: ZTRSOC (kproma,2)
263 REAL(KIND=JPRB) :: ZEMTC (kproma,2)
264 
265 REAL(KIND=JPRB) :: ZNBAS (kproma)
266 REAL(KIND=JPRB) :: ZNTOP (kproma)
267 REAL(KIND=JPRB) :: ZQRAIN (kproma,klev)
268 REAL(KIND=JPRB) :: ZQRAINT(kproma,klev)
269 REAL(KIND=JPRB) :: ZCCNL (kproma)
270 REAL(KIND=JPRB) :: ZCCNO (kproma)
271 
272 ! output of radlsw
273 
274 REAL(KIND=JPRB) :: ZEMIT (kproma)
275 REAL(KIND=JPRB) :: ZFCT (kproma,klev+1)
276 REAL(KIND=JPRB) :: ZFLT (kproma,klev+1)
277 REAL(KIND=JPRB) :: ZFCS (kproma,klev+1)
278 REAL(KIND=JPRB) :: ZFLS (kproma,klev+1)
279 REAL(KIND=JPRB) :: ZFRSOD (kproma),ZSUDU(kproma)
280 REAL(KIND=JPRB) :: ZPARF (kproma),ZUVDF(kproma),ZPARCF(kproma),ZTINCF(kproma)
281 
282 INTEGER(KIND=JPIM) :: IBEG, IEND, JK, JL
283 
284 REAL(KIND=JPRB) :: ZCRAE, ZRII0, ZEMIW(kproma)
285 REAL(KIND=JPRB) :: ZHOOK_HANDLE
286 
287 !---aerosol radiative diagnostics
288 ! Key to define the aerosol effect acting on climate
289 ! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
290 ! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
291 ! FALSE: fluxes use no aerosols (case 1)
292 ! to be used only for maintaining bit reproducibility with aerosol diagnostics activated
293 LOGICAL :: AEROSOLFEEDBACK_ACTIVE = .true.
294 
295 !OB - Fluxes including aerosol effects
296 ! | direct effect
297 !ind effect | no aerosol NATural TOTal
298 !standard | 5
299 !natural (PI) | 1 3
300 !total (PD) | 2 4
301 ! so we need which case when ?
302 ! if flag_aerosol is on
303 ! ok_ade and ok_aie = 4-2, 4-3 and 4 to proceed
304 ! ok_ade and not ok_aie = 3-1 and 3 to proceed
305 ! not ok_ade and ok_aie = 2-1 and 2 to proceed
306 ! not ok_ade and not ok_aie = 1 to proceed
307 ! therefore the cases have the following corresponding switches
308 ! 1 = not ok_ade or not ok_aie
309 ! 2 = ok_aie
310 ! 3 = ok_ade
311 ! 4 = ok_ade and ok_aie
312 ! 5 = no aerosol feedback wanted or no aerosol at all
313 ! if they are called in this order then the correct call is used to proceed
314 
315 REAL(KIND=JPRB) :: ZFSUP_AERO(kproma,klev+1,5)
316 REAL(KIND=JPRB) :: ZFSDN_AERO(kproma,klev+1,5)
317 REAL(KIND=JPRB) :: ZFSUP0_AERO(kproma,klev+1,5)
318 REAL(KIND=JPRB) :: ZFSDN0_AERO(kproma,klev+1,5)
319 !--LW (CK):
320 REAL(KIND=JPRB) :: LWUP_AERO(kproma,klev+1,5)
321 REAL(KIND=JPRB) :: LWDN_AERO(kproma,klev+1,5)
322 REAL(KIND=JPRB) :: LWUP0_AERO(kproma,klev+1,5)
323 REAL(KIND=JPRB) :: LWDN0_AERO(kproma,klev+1,5)
324 
325 #include "radlsw.intfb.h"
326 
327 IF (lhook) CALL dr_hook('RECMWF_AERO',0,zhook_handle)
328 ibeg=kst
329 iend=kend
330 
331 !* 1. PREPARATORY WORK
332 ! ----------------
333 !--OB
334 ! 1.0 INITIALIZATIONS
335 ! --------------
336 
337 zfsup_aero(:,:,:)=0.
338 zfsdn_aero(:,:,:)=0.
339 zfsup0_aero(:,:,:)=0.
340 zfsdn0_aero(:,:,:)=0.
341 
342 lwup_aero(:,:,:)=0.
343 lwdn_aero(:,:,:)=0.
344 lwup0_aero(:,:,:)=0.
345 lwdn0_aero(:,:,:)=0.
346 
347 ptau_zero(:,:,:) =1.e-15
348 ppiza_zero(:,:,:)=1.0
349 pcga_zero(:,:,:) =0.0
350 
351 ptau_lw_zero(:,:,:) =1.e-15
352 
353 
354 !* 1.1 LOCAL CONSTANTS
355 ! ---------------
356 
357 zrii0=rii0
358 zcrae=rrae*(rrae+2.0_jprb)
359 
360 !* 2.1 FULL-LEVEL QUANTITIES
361 
362 zrpr =paprsf
363 
364 DO jk=1,klev
365  DO jl=ibeg,iend
366 ! ZPQO3(JL,JK)=PQO3(JL,JK)*PDP(JL,JK)*RMD/RMO3
367  zpqo3(jl,jk)=pqo3(jl,jk)*pdp(jl,jk)
368  zrclc(jl,jk)=max( 0.0_jprb ,min( 1.0_jprb ,pclfr(jl,jk)))
369  IF (zrclc(jl,jk) > repclc) THEN
370  zqlwp(jl,jk)=pqlwp(jl,jk)
371  zqiwp(jl,jk)=pqiwp(jl,jk)
372  ELSE
373  zqlwp(jl,jk)=reph2o*zrclc(jl,jk)
374  zqiwp(jl,jk)=reph2o*zrclc(jl,jk)
375  ENDIF
376  zqrain(jl,jk)=0.
377  zqraint(jl,jk)=0.
378  zrti(jl,jk) =pt(jl,jk)
379  zqs(jl,jk)=max(2.0_jprb*reph2o,pqs(jl,jk))
380  zq(jl,jk)=max(reph2o,min(pq(jl,jk),zqs(jl,jk)*(1.0_jprb-reph2o)))
381  zemiw(jl)=pemis(jl)
382  ENDDO
383 ENDDO
384 
385 IF (naer == 0) THEN
386  zraer=rcaeros
387 ELSE
388  DO jk=1,klev
389  DO jl=ibeg,iend
390  zraer(jl,1,jk)=paer(jl,jk,1)
391  zraer(jl,2,jk)=paer(jl,jk,2)
392  zraer(jl,3,jk)=paer(jl,jk,3)
393  zraer(jl,4,jk)=paer(jl,jk,4)
394  zraer(jl,5,jk)=rcaeros
395  zraer(jl,6,jk)=paer(jl,jk,6)
396  ENDDO
397  ENDDO
398 ENDIF
399 
400 !* 2.2 HALF-LEVEL QUANTITIES
401 
402 DO jk=2,klev
403  DO jl=ibeg,iend
404  pth(jl,jk)=&
405  & (pt(jl,jk-1)*paprsf(jl,jk-1)*(paprsf(jl,jk)-paprs(jl,jk))&
406  & +pt(jl,jk)*paprsf(jl,jk)*(paprs(jl,jk)-paprsf(jl,jk-1)))&
407  & *(1.0_jprb/(paprs(jl,jk)*(paprsf(jl,jk)-paprsf(jl,jk-1))))
408  ENDDO
409 ENDDO
410 
411 !* 2.3 QUANTITIES AT BOUNDARIES
412 
413 DO jl=ibeg,iend
414  pth(jl,klev+1)=pts(jl)
415  pth(jl,1)=pt(jl,1)-paprsf(jl,1)*(pt(jl,1)-pth(jl,2))&
416  & /(paprsf(jl,1)-paprs(jl,2))
417  znbas(jl)=1.
418  zntop(jl)=1.
419  zccnl(jl)=rccnlnd
420  zccno(jl)=rccnsea
421 ENDDO
422 
423 !* 3.1 SOLAR ZENITH ANGLE IS EARTH'S CURVATURE
424 ! CORRECTED
425 
426 ! CCMVAL: on impose ZRMU0=PMU0 MPL 25032010
427 ! 2eme essai en 3D MPL 20052010
428 !DO JL=IBEG,IEND
429 ! ZRMU0(JL)=PMU0(JL)
430 !ENDDO
431 !!!!! A REVOIR MPL 20091201: enleve cette correction pour comparer a AR4
432  DO jl=ibeg,iend
433  IF (pmu0(jl) > 1.e-10_jprb) THEN
434  zrmu0(jl)=rrae/(sqrt(pmu0(jl)**2+zcrae)-pmu0(jl))
435  ELSE
436  zrmu0(jl)= rrae/sqrt(zcrae)
437  ENDIF
438  ENDDO
439 
440 !* 4.1 CALL TO ACTUAL RADIATION SCHEME
441 !
442 !----now we make multiple calls to the radiation according to which
443 !----aerosol flags are on
444 
445 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
446 
447 IF ( .not. ok_ade .or. .not. ok_aie ) THEN
448 
449 ! natural aerosols for direct and indirect effect
450 ! PI cloud optical properties
451 ! use PREF_LIQ_PI and PREF_ICE_PI
452 ! use NAT aerosol optical properties
453 ! store fluxes in index 1
454 
455 CALL radlsw (&
456  & ibeg , iend , kproma , klev , kmode , naer,&
457  & zrii0 ,&
458  & zraer , palbd , palbp , paprs , zrpr ,&
459  & zccnl , zccno ,&
460  & pcco2 , zrclc , pdp , pemis , zemiw ,pslm , zrmu0 , zpqo3,&
461  & zq , zqiwp , zqlwp , zqs , zqrain,zqraint ,&
462  & pth , zrti , pts , znbas , zntop ,&
463  & pref_liq_pi, pref_ice_pi,&
464  & zemit , zfct , zflt , zfcs , zfls ,&
465  & zfrsod, zsudu , zuvdf , zparf , zparcf, ztincf, psfswdir,&
466  & psfswdif,pfsdnn, pfsdnv ,&
467  & lrdust,ppiza_nat,pcga_nat,ptau_nat,ptau_lw_nat,pflux,pfluc,&
468  & pfsdn , pfsup , pfscdn , pfscup )
469 
470 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
471 zfsup0_aero(:,:,1) = pfscup(:,:)
472 zfsdn0_aero(:,:,1) = pfscdn(:,:)
473 
474 zfsup_aero(:,:,1) = pfsup(:,:)
475 zfsdn_aero(:,:,1) = pfsdn(:,:)
476 
477 lwup0_aero(:,:,1) = pfluc(:,1,:)
478 lwdn0_aero(:,:,1) = pfluc(:,2,:)
479 
480 lwup_aero(:,:,1) = pflux(:,1,:)
481 lwdn_aero(:,:,1) = pflux(:,2,:)
482 
483 ENDIF
484 
485 IF (ok_aie) THEN
486 
487 ! natural aerosols for direct indirect effect
488 ! use NAT aerosol optical properties
489 ! PD cloud optical properties
490 ! use PREF_LIQ and PREF_ICE
491 ! store fluxes in index 2
492 
493 CALL radlsw (&
494  & ibeg , iend , kproma , klev , kmode , naer,&
495  & zrii0 ,&
496  & zraer , palbd , palbp , paprs , zrpr ,&
497  & zccnl , zccno ,&
498  & pcco2 , zrclc , pdp , pemis , zemiw ,pslm , zrmu0 , zpqo3,&
499  & zq , zqiwp , zqlwp , zqs , zqrain,zqraint ,&
500  & pth , zrti , pts , znbas , zntop ,&
501  & pref_liq, pref_ice,&
502  & zemit , zfct , zflt , zfcs , zfls ,&
503  & zfrsod, zsudu , zuvdf , zparf , zparcf, ztincf, psfswdir,&
504  & psfswdif,pfsdnn, pfsdnv ,&
505  & lrdust,ppiza_nat,pcga_nat,ptau_nat,ptau_lw_nat,pflux,pfluc,&
506  & pfsdn , pfsup , pfscdn , pfscup )
507 
508 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
509 zfsup0_aero(:,:,2) = pfscup(:,:)
510 zfsdn0_aero(:,:,2) = pfscdn(:,:)
511 
512 zfsup_aero(:,:,2) = pfsup(:,:)
513 zfsdn_aero(:,:,2) = pfsdn(:,:)
514 
515 lwup0_aero(:,:,2) = pfluc(:,1,:)
516 lwdn0_aero(:,:,2) = pfluc(:,2,:)
517 
518 lwup_aero(:,:,2) = pflux(:,1,:)
519 lwdn_aero(:,:,2) = pflux(:,2,:)
520 
521 ENDIF ! ok_aie
522 
523 IF (ok_ade) THEN
524 
525 ! direct effect of total aerosol activated
526 ! TOT aerosols for direct effect
527 ! PI cloud optical properties
528 ! use PREF_LIQ_PI and PREF_ICE_PI
529 ! STORE fluxes in index 3
530 
531 CALL radlsw (&
532  & ibeg , iend , kproma , klev , kmode , naer,&
533  & zrii0 ,&
534  & zraer , palbd , palbp , paprs , zrpr ,&
535  & zccnl , zccno ,&
536  & pcco2 , zrclc , pdp , pemis , zemiw ,pslm , zrmu0 , zpqo3,&
537  & zq , zqiwp , zqlwp , zqs , zqrain,zqraint ,&
538  & pth , zrti , pts , znbas , zntop ,&
539  & pref_liq_pi, pref_ice_pi,&
540  & zemit , zfct , zflt , zfcs , zfls ,&
541  & zfrsod, zsudu , zuvdf , zparf , zparcf, ztincf, psfswdir,&
542  & psfswdif,pfsdnn, pfsdnv ,&
543  & lrdust,ppiza_tot,pcga_tot,ptau_tot,ptau_lw_tot,pflux,pfluc,&
544  & pfsdn , pfsup , pfscdn , pfscup )
545 
546 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
547 zfsup0_aero(:,:,3) = pfscup(:,:)
548 zfsdn0_aero(:,:,3) = pfscdn(:,:)
549 
550 zfsup_aero(:,:,3) = pfsup(:,:)
551 zfsdn_aero(:,:,3) = pfsdn(:,:)
552 
553 lwup0_aero(:,:,3) = pfluc(:,1,:)
554 lwdn0_aero(:,:,3) = pfluc(:,2,:)
555 
556 lwup_aero(:,:,3) = pflux(:,1,:)
557 lwdn_aero(:,:,3) = pflux(:,2,:)
558 
559 ENDIF !-end ok_ade
560 
561 IF (ok_ade .and. ok_aie) THEN
562 
563 ! total aerosols for direct indirect effect
564 ! use TOT aerosol optical properties
565 ! PD cloud optical properties
566 ! use PREF_LIQ and PREF_ICE
567 ! store fluxes in index 4
568 
569 CALL radlsw (&
570  & ibeg , iend , kproma , klev , kmode , naer,&
571  & zrii0 ,&
572  & zraer , palbd , palbp , paprs , zrpr ,&
573  & zccnl , zccno ,&
574  & pcco2 , zrclc , pdp , pemis , zemiw ,pslm , zrmu0 , zpqo3,&
575  & zq , zqiwp , zqlwp , zqs , zqrain,zqraint ,&
576  & pth , zrti , pts , znbas , zntop ,&
577  & pref_liq, pref_ice,&
578  & zemit , zfct , zflt , zfcs , zfls ,&
579  & zfrsod, zsudu , zuvdf , zparf , zparcf, ztincf, psfswdir,&
580  & psfswdif,pfsdnn, pfsdnv ,&
581  & lrdust,ppiza_tot,pcga_tot,ptau_tot,ptau_lw_tot,pflux,pfluc,&
582  & pfsdn , pfsup , pfscdn , pfscup )
583 
584 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
585 zfsup0_aero(:,:,4) = pfscup(:,:)
586 zfsdn0_aero(:,:,4) = pfscdn(:,:)
587 
588 zfsup_aero(:,:,4) = pfsup(:,:)
589 zfsdn_aero(:,:,4) = pfsdn(:,:)
590 
591 lwup0_aero(:,:,4) = pfluc(:,1,:)
592 lwdn0_aero(:,:,4) = pfluc(:,2,:)
593 
594 lwup_aero(:,:,4) = pflux(:,1,:)
595 lwdn_aero(:,:,4) = pflux(:,2,:)
596 
597 ENDIF ! ok_ade .and. ok_aie
598 
599 ENDIF !--if flag_aerosol GT 0 OR flag_aerosol_strat
600 
601 ! case with no aerosols at all is also computed IF ACTIVEFEEDBACK_ACTIVE is false
602 !IF (swaero_diag .OR. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
603 IF (.not. aerosolfeedback_active .OR. flag_aerosol .EQ. 0 ) THEN
604 
605 ! ZERO aerosol effect
606 ! ZERO aerosol optical depth
607 ! STANDARD cloud optical properties
608 ! STORE fluxes in index 5
609 
610 CALL radlsw (&
611  & ibeg , iend , kproma , klev , kmode , naer,&
612  & zrii0 ,&
613  & zraer , palbd , palbp , paprs , zrpr ,&
614  & zccnl , zccno ,&
615  & pcco2 , zrclc , pdp , pemis , zemiw ,pslm , zrmu0 , zpqo3,&
616  & zq , zqiwp , zqlwp , zqs , zqrain,zqraint ,&
617  & pth , zrti , pts , znbas , zntop ,&
618 !--this needs to be changed to fixed cloud optical properties
619  & pref_liq_pi, pref_ice_pi,&
620  & zemit , zfct , zflt , zfcs , zfls ,&
621  & zfrsod, zsudu , zuvdf , zparf , zparcf, ztincf, psfswdir,&
622  & psfswdif,pfsdnn, pfsdnv ,&
623  & lrdust,ppiza_zero,pcga_zero,ptau_zero, ptau_lw_zero,pflux,pfluc,&
624  & pfsdn , pfsup , pfscdn , pfscup )
625 
626 !* SAVE VARIABLES IN INTERIM VARIABLES A LA SW_AEROAR4
627 zfsup0_aero(:,:,5) = pfscup(:,:)
628 zfsdn0_aero(:,:,5) = pfscdn(:,:)
629 
630 zfsup_aero(:,:,5) = pfsup(:,:)
631 zfsdn_aero(:,:,5) = pfsdn(:,:)
632 
633 lwup0_aero(:,:,5) = pfluc(:,1,:)
634 lwdn0_aero(:,:,5) = pfluc(:,2,:)
635 
636 lwup_aero(:,:,5) = pflux(:,1,:)
637 lwdn_aero(:,:,5) = pflux(:,2,:)
638 
639 ENDIF ! .not. AEROSOLFEEDBACK_ACTIVE
640 
641 !* 4.2 TRANSFORM FLUXES TO MODEL HISTORICAL VARIABLES
642 
643 DO jk=1,klev+1
644  DO jl=ibeg,iend
645  pswft(jl,jk)=zfls(jl,jk)/(zrii0*zrmu0(jl))
646  plwft(jl,jk)=zflt(jl,jk)
647  ENDDO
648 ENDDO
649 
650 zemtd=plwft
651 zemtu=plwft
652 
653 DO jl=ibeg,iend
654  ztrsoc(jl, 1)=zfcs(jl, 1)/(zrii0*zrmu0(jl))
655  ztrsoc(jl, 2)=zfcs(jl,klev+1)/(zrii0*zrmu0(jl))
656  zemtc(jl, 1)=zfct(jl, 1)
657  zemtc(jl, 2)=zfct(jl,klev+1)
658 ENDDO
659 
660 ! ------------ -- ------- -- ---- -----
661 !* 5.1 STORAGE OF TRANSMISSIVITY AND EMISSIVITIES
662 !* IN KPROMA-LONG ARRAYS
663 
664 DO jk=1,klev+1
665  DO jl=ibeg,iend
666  pemtd(jl,jk)=zemtd(jl,jk)
667  pemtu(jl,jk)=zemtu(jl,jk)
668  ptrso(jl,jk)=max(0.0_jprb,min(1.0_jprb,pswft(jl,jk)))
669  ENDDO
670 ENDDO
671 DO jk=1,2
672  DO jl=ibeg,iend
673  pcemtr(jl,jk)=zemtc(jl,jk)
674  pctrso(jl,jk)=max( 0.0_jprb,min(1.0_jprb,ztrsoc(jl,jk)))
675  ENDDO
676 ENDDO
677 DO jl=ibeg,iend
678  ptrsod(jl)=max(0.0_jprb,min(1.0_jprb,zfrsod(jl)/(zrii0*zrmu0(jl))))
679 ENDDO
680 
681 !* 7.3 RECONSTRUCT FLUXES FOR DIAGNOSTICS
682 
683 DO jl=ibeg,iend
684  IF (pmu0(jl) < 1.e-10_jprb) zrmu0(jl)=0.0_jprb
685 ENDDO
686 DO jk=1,klev+1
687  DO jl=ibeg,iend
688  plwft(jl,jk)=pemtd(jl,jk)
689  pswft(jl,jk)=zrmu0(jl)*zrii0*ptrso(jl,jk)
690  ENDDO
691 ENDDO
692 DO jk=1,2
693  DO jl=ibeg,iend
694  pswfc(jl,jk)=zrmu0(jl)*zrii0*pctrso(jl,jk)
695  plwfc(jl,jk)=pcemtr(jl,jk)
696  ENDDO
697 ENDDO
698 
699 !* 8.0 DIAGNOSTICS
700 !---Now we copy back the correct fields to proceed to the next timestep
701 
702 IF ( aerosolfeedback_active .AND. (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) ) THEN
703 
704  IF ( ok_ade .and. ok_aie ) THEN
705  pfsup(:,:) = zfsup_aero(:,:,4)
706  pfsdn(:,:) = zfsdn_aero(:,:,4)
707  pfscup(:,:) = zfsup0_aero(:,:,4)
708  pfscdn(:,:) = zfsdn0_aero(:,:,4)
709 
710  pflux(:,1,:) = lwup_aero(:,:,4)
711  pflux(:,2,:) = lwdn_aero(:,:,4)
712  pfluc(:,1,:) = lwup0_aero(:,:,4)
713  pfluc(:,2,:) = lwdn0_aero(:,:,4)
714  ENDIF
715 
716  IF ( ok_ade .and. (.not. ok_aie) ) THEN
717  pfsup(:,:) = zfsup_aero(:,:,3)
718  pfsdn(:,:) = zfsdn_aero(:,:,3)
719  pfscup(:,:) = zfsup0_aero(:,:,3)
720  pfscdn(:,:) = zfsdn0_aero(:,:,3)
721 
722  pflux(:,1,:) = lwup_aero(:,:,3)
723  pflux(:,2,:) = lwdn_aero(:,:,3)
724  pfluc(:,1,:) = lwup0_aero(:,:,3)
725  pfluc(:,2,:) = lwdn0_aero(:,:,3)
726  ENDIF
727 
728  IF ( (.not. ok_ade) .and. ok_aie ) THEN
729  pfsup(:,:) = zfsup_aero(:,:,2)
730  pfsdn(:,:) = zfsdn_aero(:,:,2)
731  pfscup(:,:) = zfsup0_aero(:,:,2)
732  pfscdn(:,:) = zfsdn0_aero(:,:,2)
733 
734  pflux(:,1,:) = lwup_aero(:,:,2)
735  pflux(:,2,:) = lwdn_aero(:,:,2)
736  pfluc(:,1,:) = lwup0_aero(:,:,2)
737  pfluc(:,2,:) = lwdn0_aero(:,:,2)
738  ENDiF
739 
740  IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
741  pfsup(:,:) = zfsup_aero(:,:,1)
742  pfsdn(:,:) = zfsdn_aero(:,:,1)
743  pfscup(:,:) = zfsup0_aero(:,:,1)
744  pfscdn(:,:) = zfsdn0_aero(:,:,1)
745 
746  pflux(:,1,:) = lwup_aero(:,:,1)
747  pflux(:,2,:) = lwdn_aero(:,:,1)
748  pfluc(:,1,:) = lwup0_aero(:,:,1)
749  pfluc(:,2,:) = lwdn0_aero(:,:,1)
750  ENDIF
751 
752 ! The following allows to compute the forcing diagostics without
753 ! letting the aerosol forcing act on the meteorology
754 ! SEE logic above
755 
756 ELSE !--not AEROSOLFEEDBACK_ACTIVE
757 
758  pfsup(:,:) = zfsup_aero(:,:,5)
759  pfsdn(:,:) = zfsdn_aero(:,:,5)
760  pfscup(:,:) = zfsup0_aero(:,:,5)
761  pfscdn(:,:) = zfsdn0_aero(:,:,5)
762 
763  pflux(:,1,:) = lwup_aero(:,:,5)
764  pflux(:,2,:) = lwdn_aero(:,:,5)
765  pfluc(:,1,:) = lwup0_aero(:,:,5)
766  pfluc(:,2,:) = lwdn0_aero(:,:,5)
767 
768 ENDIF
769 
770 !OB- HERE CHECK WITH MP IF BOTTOM AND TOP INDICES ARE OK !!!!!!!!!!!!!!!!!!
771 ! net anthropogenic forcing direct and 1st indirect effect diagnostics
772 ! requires a natural aerosol field read and used
773 ! Difference of net fluxes from double call to radiation
774 ! Will need to be extended to LW radiation -> done by CK (2014-05-23)
775 
776 IF (flag_aerosol .GT. 0 .OR. flag_aerosol_strat) THEN
777 
778 IF (ok_ade.AND.ok_aie) THEN
779 
780 ! direct anthropogenic forcing
781  psolswadaero(:) = (zfsdn_aero(:,1,4) -zfsup_aero(:,1,4)) -(zfsdn_aero(:,1,2) -zfsup_aero(:,1,2))
782  ptopswadaero(:) = (zfsdn_aero(:,klev+1,4) -zfsup_aero(:,klev+1,4)) -(zfsdn_aero(:,klev+1,2) -zfsup_aero(:,klev+1,2))
783  psolswad0aero(:) = (zfsdn0_aero(:,1,4) -zfsup0_aero(:,1,4)) -(zfsdn0_aero(:,1,2) -zfsup0_aero(:,1,2))
784  ptopswad0aero(:) = (zfsdn0_aero(:,klev+1,4)-zfsup0_aero(:,klev+1,4))-(zfsdn0_aero(:,klev+1,2)-zfsup0_aero(:,klev+1,2))
785 
786 ! indirect anthropogenic forcing
787  psolswaiaero(:) = (zfsdn_aero(:,1,4) -zfsup_aero(:,1,4)) -(zfsdn_aero(:,1,3) -zfsup_aero(:,1,3))
788  ptopswaiaero(:) = (zfsdn_aero(:,klev+1,4)-zfsup_aero(:,klev+1,4))-(zfsdn_aero(:,klev+1,3)-zfsup_aero(:,klev+1,3))
789 
790 ! Cloud radiative forcing with natural aerosol for direct effect
791  psolswcfaero(:,1) = (zfsdn_aero(:,1,2) -zfsup_aero(:,1,2)) -(zfsdn0_aero(:,1,2) -zfsup0_aero(:,1,2))
792  ptopswcfaero(:,1) = (zfsdn_aero(:,klev+1,2)-zfsup_aero(:,klev+1,2))-(zfsdn0_aero(:,klev+1,2)-zfsup0_aero(:,klev+1,2))
793 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
794  psolswcfaero(:,2) = (zfsdn_aero(:,1,4) -zfsup_aero(:,1,4)) -(zfsdn0_aero(:,1,4) -zfsup0_aero(:,1,4))
795  ptopswcfaero(:,2) = (zfsdn_aero(:,klev+1,4)-zfsup_aero(:,klev+1,4))-(zfsdn0_aero(:,klev+1,4)-zfsup0_aero(:,klev+1,4))
796 ! Cloud radiative forcing with no direct effect at all
797  psolswcfaero(:,3) = 0.0
798  ptopswcfaero(:,3) = 0.0
799 
800 ! LW direct anthropogenic forcing
801  psollwadaero(:) = (-lwdn_aero(:,1,4) -lwup_aero(:,1,4)) -(-lwdn_aero(:,1,2) -lwup_aero(:,1,2))
802  ptoplwadaero(:) = (-lwdn_aero(:,klev+1,4) -lwup_aero(:,klev+1,4)) -(-lwdn_aero(:,klev+1,2) -lwup_aero(:,klev+1,2))
803  psollwad0aero(:) = (-lwdn0_aero(:,1,4) -lwup0_aero(:,1,4)) -(-lwdn0_aero(:,1,2) -lwup0_aero(:,1,2))
804  ptoplwad0aero(:) = (-lwdn0_aero(:,klev+1,4)-lwup0_aero(:,klev+1,4))-(-lwdn0_aero(:,klev+1,2)-lwup0_aero(:,klev+1,2))
805 
806 ! LW indirect anthropogenic forcing
807  psollwaiaero(:) = (-lwdn_aero(:,1,4) -lwup_aero(:,1,4)) -(-lwdn_aero(:,1,3) -lwup_aero(:,1,3))
808  ptoplwaiaero(:) = (-lwdn_aero(:,klev+1,4)-lwup_aero(:,klev+1,4))-(-lwdn_aero(:,klev+1,3)-lwup_aero(:,klev+1,3))
809 
810 ENDIF
811 
812 IF (ok_ade.AND..NOT.ok_aie) THEN
813 
814 ! direct anthropogenic forcing
815  psolswadaero(:) = (zfsdn_aero(:,1,3) -zfsup_aero(:,1,3)) -(zfsdn_aero(:,1,1) -zfsup_aero(:,1,1))
816  ptopswadaero(:) = (zfsdn_aero(:,klev+1,3) -zfsup_aero(:,klev+1,3)) -(zfsdn_aero(:,klev+1,1) -zfsup_aero(:,klev+1,1))
817  psolswad0aero(:) = (zfsdn0_aero(:,1,3) -zfsup0_aero(:,1,3)) -(zfsdn0_aero(:,1,1) -zfsup0_aero(:,1,1))
818  ptopswad0aero(:) = (zfsdn0_aero(:,klev+1,3)-zfsup0_aero(:,klev+1,3))-(zfsdn0_aero(:,klev+1,1)-zfsup0_aero(:,klev+1,1))
819 
820 ! indirect anthropogenic forcing
821  psolswaiaero(:) = 0.0
822  ptopswaiaero(:) = 0.0
823 
824 ! Cloud radiative forcing with natural aerosol for direct effect
825  psolswcfaero(:,1) = (zfsdn_aero(:,1,1) -zfsup_aero(:,1,1)) -(zfsdn0_aero(:,1,1) -zfsup0_aero(:,1,1))
826  ptopswcfaero(:,1) = (zfsdn_aero(:,klev+1,1)-zfsup_aero(:,klev+1,1))-(zfsdn0_aero(:,klev+1,1)-zfsup0_aero(:,klev+1,1))
827 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
828  psolswcfaero(:,2) = (zfsdn_aero(:,1,3) -zfsup_aero(:,1,3)) -(zfsdn0_aero(:,1,3) -zfsup0_aero(:,1,3))
829  ptopswcfaero(:,2) = (zfsdn_aero(:,klev+1,3)-zfsup_aero(:,klev+1,3))-(zfsdn0_aero(:,klev+1,3)-zfsup0_aero(:,klev+1,3))
830 ! Cloud radiative forcing with no direct effect at all
831  psolswcfaero(:,3) = 0.0
832  ptopswcfaero(:,3) = 0.0
833 
834 ! LW direct anthropogenic forcing
835  psollwadaero(:) = (-lwdn_aero(:,1,3) -lwup_aero(:,1,3)) -(-lwdn_aero(:,1,1) -lwup_aero(:,1,1))
836  ptoplwadaero(:) = (-lwdn_aero(:,klev+1,3) -lwup_aero(:,klev+1,3)) -(-lwdn_aero(:,klev+1,1) -lwup_aero(:,klev+1,1))
837  psollwad0aero(:) = (-lwdn0_aero(:,1,3) -lwup0_aero(:,1,3)) -(-lwdn0_aero(:,1,1) -lwup0_aero(:,1,1))
838  ptoplwad0aero(:) = (-lwdn0_aero(:,klev+1,3)-lwup0_aero(:,klev+1,3))-(-lwdn0_aero(:,klev+1,1)-lwup0_aero(:,klev+1,1))
839 
840 ! LW indirect anthropogenic forcing
841  psollwaiaero(:) = 0.0
842  ptoplwaiaero(:) = 0.0
843 
844 ENDIF
845 
846 IF (.NOT.ok_ade.AND.ok_aie) THEN
847 
848 ! direct anthropogenic forcing
849  psolswadaero(:) = 0.0
850  ptopswadaero(:) = 0.0
851  psolswad0aero(:) = 0.0
852  ptopswad0aero(:) = 0.0
853 
854 ! indirect anthropogenic forcing
855  psolswaiaero(:) = (zfsdn_aero(:,1,2) -zfsup_aero(:,1,2)) -(zfsdn_aero(:,1,1) -zfsup_aero(:,1,1))
856  ptopswaiaero(:) = (zfsdn_aero(:,klev+1,2)-zfsup_aero(:,klev+1,2))-(zfsdn_aero(:,klev+1,1)-zfsup_aero(:,klev+1,1))
857 
858 ! Cloud radiative forcing with natural aerosol for direct effect
859  psolswcfaero(:,1) = (zfsdn_aero(:,1,2) -zfsup_aero(:,1,2)) -(zfsdn0_aero(:,1,2) -zfsup0_aero(:,1,2))
860  ptopswcfaero(:,1) = (zfsdn_aero(:,klev+1,2)-zfsup_aero(:,klev+1,2))-(zfsdn0_aero(:,klev+1,2)-zfsup0_aero(:,klev+1,2))
861 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
862  psolswcfaero(:,2) = 0.0
863  ptopswcfaero(:,2) = 0.0
864 ! Cloud radiative forcing with no direct effect at all
865  psolswcfaero(:,3) = 0.0
866  ptopswcfaero(:,3) = 0.0
867 
868 ! LW direct anthropogenic forcing
869  psollwadaero(:) = 0.0
870  ptoplwadaero(:) = 0.0
871  psollwad0aero(:) = 0.0
872  ptoplwad0aero(:) = 0.0
873 
874 ! LW indirect anthropogenic forcing
875  psollwaiaero(:) = (-lwdn_aero(:,1,2) -lwup_aero(:,1,2)) -(-lwdn_aero(:,1,1) -lwup_aero(:,1,1))
876  ptoplwaiaero(:) = (-lwdn_aero(:,klev+1,2)-lwup_aero(:,klev+1,2))-(-lwdn_aero(:,klev+1,1)-lwup_aero(:,klev+1,1))
877 
878 ENDIF
879 
880 IF (.NOT.ok_ade.AND..NOT.ok_aie) THEN
881 
882 ! direct anthropogenic forcing
883  psolswadaero(:) = 0.0
884  ptopswadaero(:) = 0.0
885  psolswad0aero(:) = 0.0
886  ptopswad0aero(:) = 0.0
887 
888 ! indirect anthropogenic forcing
889  psolswaiaero(:) = 0.0
890  ptopswaiaero(:) = 0.0
891 
892 ! Cloud radiative forcing with natural aerosol for direct effect
893  psolswcfaero(:,1) = (zfsdn_aero(:,1,1) -zfsup_aero(:,1,1)) -(zfsdn0_aero(:,1,1) -zfsup0_aero(:,1,1))
894  ptopswcfaero(:,1) = (zfsdn_aero(:,klev+1,1)-zfsup_aero(:,klev+1,1))-(zfsdn0_aero(:,klev+1,1)-zfsup0_aero(:,klev+1,1))
895 ! Cloud radiative forcing with anthropogenic aerosol for direct effect
896  psolswcfaero(:,2) = 0.0
897  ptopswcfaero(:,2) = 0.0
898 ! Cloud radiative forcing with no direct effect at all
899  psolswcfaero(:,3) = 0.0
900  ptopswcfaero(:,3) = 0.0
901 
902 ! LW direct anthropogenic forcing
903  psollwadaero(:) = 0.0
904  ptoplwadaero(:) = 0.0
905  psollwad0aero(:) = 0.0
906  ptoplwad0aero(:) = 0.0
907 
908 ! LW indirect anthropogenic forcing
909  psollwaiaero(:) = 0.0
910  ptoplwaiaero(:) = 0.0
911 
912 ENDIF
913 
914 ENDIF
915 
916 !IF (swaero_diag .OR. .NOT. AEROSOLFEEDBACK_ACTIVE) THEN
917 IF (.NOT. aerosolfeedback_active) THEN
918 ! Cloudforcing without aerosol at all
919  psolswcfaero(:,3) = (zfsdn_aero(:,1,5) -zfsup_aero(:,1,5)) -(zfsdn0_aero(:,1,5) -zfsup0_aero(:,1,5))
920  ptopswcfaero(:,3) = (zfsdn_aero(:,klev+1,5)-zfsup_aero(:,klev+1,5))-(zfsdn0_aero(:,klev+1,5)-zfsup0_aero(:,klev+1,5))
921 
922 ENDIF
923 
924 IF (lhook) CALL dr_hook('RECMWF_AERO',1,zhook_handle)
925 END SUBROUTINE recmwf_aero
pcco2
INTERFACE SUBROUTINE RRTM_ECRT_140GP pcco2
Definition: rrtm_ecrt_140gp.intfb.h:3
yoerad::nlw
integer(kind=jpim) nlw
Definition: yoerad.F90:26
pth
INTERFACE SUBROUTINE RRTM_ECRT_140GP pth
Definition: rrtm_ecrt_140gp.intfb.h:3
yoerdi::reph2o
real(kind=jprb) reph2o
Definition: yoerdi.F90:22
phys_output_var_mod::swaero_diag
logical, save swaero_diag
Definition: phys_output_var_mod.F90:49
yoerdi
Definition: yoerdi.F90:1
yoerad::naer
integer(kind=jpim) naer
Definition: yoerad.F90:13
yoerad::rccnsea
real(kind=jprb) rccnsea
Definition: yoerad.F90:69
yomgem
Definition: yomgem.F90:1
yomgem::ngptot
integer(kind=jpim) ngptot
Definition: yomgem.F90:19
yomcst::rmo3
real(kind=jprb) rmo3
Definition: yomcst.F90:38
radlsw
subroutine radlsw(KIDIA, KFDIA, KLON, KLEV, KMODE, KAER, PRII0, PAER, PALBD, PALBP, PAPH, PAP, PCCNL, PCCNO, PCCO2, PCLFR, PDP, PEMIS, PEMIW, PLSM, PMU0, POZON, PQ, PQIWP, PQLWP, PQS, PQRAIN, PRAINT, PTH, PT, PTS, PNBAS, PNTOP, PREF_LIQ, PREF_ICE, PEMIT, PFCT, PFLT, PFCS, PFLS, PFRSOD, PSUDU, PUVDF, PPARF, PPARCF, PTINCF, PSFSWDIR, PSFSWDIF, PFSDNN, PFSDNV, LRDUST, PPIZA_DST, PCGA_DST, PTAUREL_DST, PTAU_LW, PFLUX, PFLUC, PFSDN, PFSUP, PFSCDN, PFSCUP)
Definition: radlsw.F90:16
yomarphy::lrdust
logical lrdust
Definition: yomarphy.F90:39
phys_output_mod
Definition: phys_output_mod.F90:4
yomphy3::rii0
real(kind=jprb) rii0
Definition: yomphy3.F90:163
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
yoerad
Definition: yoerad.F90:1
paprs
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL &zphi geo500!IM on interpole a chaque pas de temps le paprs
Definition: calcul_STDlev.h:144
recmwf_aero
subroutine recmwf_aero(KST, KEND, KPROMA, KTDIA, KLEV, KMODE, PALBD, PALBP, PAPRS, PAPRSF, PCCO2, PCLFR, PQO3, PAER, PDP, PEMIS, PMU0, PQ, PQS, PQIWP, PQLWP, PSLM, PT, PTS, PREF_LIQ, PREF_ICE,
Definition: recmwf_aero.F90:12
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
yoerad::rccnlnd
real(kind=jprb) rccnlnd
Definition: yoerad.F90:69
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
yoeaerd::rcaeros
real(kind=jprb) rcaeros
Definition: yoeaerd.F90:37
yoerdu::repscq
real(kind=jprb) repscq
Definition: yoerdu.F90:22
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
yoerdi::rrae
real(kind=jprb) rrae
Definition: yoerdi.F90:13
pt
INTERFACE SUBROUTINE RRTM_ECRT_140GP pt
Definition: rrtm_ecrt_140gp.intfb.h:3
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
paer
INTERFACE SUBROUTINE RRTM_ECRT_140GP && paer
Definition: rrtm_ecrt_140gp.intfb.h:3
pts
INTERFACE SUBROUTINE RRTM_ECRT_140GP && pts
Definition: rrtm_ecrt_140gp.intfb.h:3
yoerdi::repclc
real(kind=jprb) repclc
Definition: yoerdi.F90:21
yomcst
Definition: yomcst.F90:1
yomcst::rmd
real(kind=jprb) rmd
Definition: yomcst.F90:36
pq
INTERFACE SUBROUTINE RRTM_ECRT_140GP && pq
Definition: rrtm_ecrt_140gp.intfb.h:3
yoerdu
Definition: yoerdu.F90:1