1 | ! |
---|
2 | ! $Id: lwu.F90 3666 2020-04-20 10:13:34Z lebasn $ |
---|
3 | ! |
---|
4 | SUBROUTINE LWU & |
---|
5 | & ( KIDIA, KFDIA, KLON, KLEV,& |
---|
6 | & PAER , PCCO2, PDP , PPMB, PQOF , PTAVE, PVIEW, PWV,& |
---|
7 | & PABCU & |
---|
8 | & ) |
---|
9 | |
---|
10 | !**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS |
---|
11 | |
---|
12 | ! PURPOSE. |
---|
13 | ! -------- |
---|
14 | ! COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND |
---|
15 | ! TEMPERATURE EFFECTS |
---|
16 | |
---|
17 | !** INTERFACE. |
---|
18 | ! ---------- |
---|
19 | |
---|
20 | ! EXPLICIT ARGUMENTS : |
---|
21 | ! -------------------- |
---|
22 | ! ==== INPUTS === |
---|
23 | ! PAER : (KLON,6,KLEV) ; OPTICAL THICKNESS OF THE AEROSOLS |
---|
24 | ! PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) |
---|
25 | ! PDP : (KLON,KLEV) ; LAYER PRESSURE THICKNESS (PA) |
---|
26 | ! PPMB : (KLON,KLEV+1) ; HALF LEVEL PRESSURE |
---|
27 | ! PQOF : (KLON,KLEV) ; CONCENTRATION IN OZONE (PA/PA) |
---|
28 | ! PTAVE : (KLON,KLEV) ; TEMPERATURE |
---|
29 | ! PWV : (KLON,KLEV) ; SPECIFIC HUMIDITY PA/PA |
---|
30 | ! PVIEW : (KLON) ; COSECANT OF VIEWING ANGLE |
---|
31 | ! ==== OUTPUTS === |
---|
32 | ! PABCU :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS |
---|
33 | |
---|
34 | ! IMPLICIT ARGUMENTS : NONE |
---|
35 | ! -------------------- |
---|
36 | |
---|
37 | ! METHOD. |
---|
38 | ! ------- |
---|
39 | |
---|
40 | ! 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF |
---|
41 | ! ABSORBERS. |
---|
42 | |
---|
43 | ! EXTERNALS. |
---|
44 | ! ---------- |
---|
45 | |
---|
46 | ! NONE |
---|
47 | |
---|
48 | ! REFERENCE. |
---|
49 | ! ---------- |
---|
50 | |
---|
51 | ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND |
---|
52 | ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS |
---|
53 | |
---|
54 | ! AUTHOR. |
---|
55 | ! ------- |
---|
56 | ! JEAN-JACQUES MORCRETTE *ECMWF* |
---|
57 | |
---|
58 | ! MODIFICATIONS. |
---|
59 | ! -------------- |
---|
60 | ! ORIGINAL : 89-07-14 |
---|
61 | ! JJ Morcrette 97-04-18 Revised Continuum + Clean-up |
---|
62 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning |
---|
63 | |
---|
64 | !----------------------------------------------------------------------- |
---|
65 | |
---|
66 | USE PARKIND1 ,ONLY : JPIM ,JPRB |
---|
67 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
---|
68 | |
---|
69 | USE YOMCST , ONLY : RG |
---|
70 | USE YOESW , ONLY : RAER |
---|
71 | USE YOELW , ONLY : NSIL ,NUA ,NG1 ,NG1P1 ,& |
---|
72 | & ALWT ,BLWT ,RO3T ,RT1 ,TREF ,& |
---|
73 | & RVGCO2 ,RVGH2O ,RVGO3 |
---|
74 | !USE YOERDI , ONLY : RCH4 ,RN2O ,RCFC11 ,RCFC12 |
---|
75 | USE YOERDU , ONLY : R10E ,REPSCO ,REPSCQ |
---|
76 | #ifdef REPROBUS |
---|
77 | USE chem_rep, ONLY: rch42d, rn2o2d, rcfc112d, rcfc122d, ok_rtime2d |
---|
78 | USE infotrac_phy, ONLY : type_trac |
---|
79 | #endif |
---|
80 | |
---|
81 | |
---|
82 | IMPLICIT NONE |
---|
83 | |
---|
84 | INTEGER(KIND=JPIM),INTENT(IN) :: KLON |
---|
85 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
---|
86 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
---|
87 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
---|
88 | REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) |
---|
89 | REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2 |
---|
90 | REAL(KIND=JPRB) ,INTENT(IN) :: PDP(KLON,KLEV) |
---|
91 | REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1) |
---|
92 | REAL(KIND=JPRB) ,INTENT(IN) :: PQOF(KLON,KLEV) |
---|
93 | REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV) |
---|
94 | REAL(KIND=JPRB) ,INTENT(IN) :: PVIEW(KLON) |
---|
95 | REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV) |
---|
96 | REAL(KIND=JPRB) ,INTENT(OUT) :: PABCU(KLON,NUA,3*KLEV+1) |
---|
97 | |
---|
98 | #include "clesphys.h" |
---|
99 | !----------------------------------------------------------------------- |
---|
100 | |
---|
101 | !* 0.1 ARGUMENTS |
---|
102 | ! --------- |
---|
103 | |
---|
104 | !----------------------------------------------------------------------- |
---|
105 | |
---|
106 | ! ------------ |
---|
107 | REAL(KIND=JPRB) :: ZABLY(KLON,7,3*KLEV+1) , ZDPM(KLON,3*KLEV)& |
---|
108 | & , ZDUC(KLON, 3*KLEV+1) , ZFACT(KLON)& |
---|
109 | & , ZUPM(KLON,3*KLEV) |
---|
110 | REAL(KIND=JPRB) :: ZPHIO(KLON),ZPSC2(KLON) , ZPSC3(KLON), ZPSH1(KLON)& |
---|
111 | & , ZPSH2(KLON),ZPSH3(KLON) , ZPSH4(KLON), ZPSH5(KLON)& |
---|
112 | & , ZPSH6(KLON),ZPSIO(KLON) , ZTCON(KLON)& |
---|
113 | & , ZPHM6(KLON),ZPSM6(KLON) , ZPHN6(KLON), ZPSN6(KLON) |
---|
114 | REAL(KIND=JPRB) :: ZSSIG(KLON,3*KLEV+1) , ZTAVI(KLON)& |
---|
115 | & , ZUAER(KLON,NSIL) , ZXOZ(KLON) , ZXWV(KLON) |
---|
116 | |
---|
117 | INTEGER(KIND=JPIM) :: IAE1, IAE2, IAE3, IC, ICP1, IG1, IJ, IJPN,& |
---|
118 | & IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, JA, JAE, & |
---|
119 | & JK, JKI, JKK, JL |
---|
120 | |
---|
121 | REAL(KIND=JPRB) :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,& |
---|
122 | & ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, & |
---|
123 | & ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, & |
---|
124 | & ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, & |
---|
125 | & ZUPMH2O, ZUPMO3, ZZABLY |
---|
126 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
127 | |
---|
128 | |
---|
129 | !----------------------------------------------------------------------- |
---|
130 | |
---|
131 | !* 1. INITIALIZATION |
---|
132 | ! -------------- |
---|
133 | |
---|
134 | !----------------------------------------------------------------------- |
---|
135 | |
---|
136 | !* 2. PRESSURE OVER GAUSS SUB-LEVELS |
---|
137 | ! ------------------------------ |
---|
138 | |
---|
139 | IF (LHOOK) CALL DR_HOOK('LWU',0,ZHOOK_HANDLE) |
---|
140 | DO JL = KIDIA,KFDIA |
---|
141 | ZSSIG(JL, 1 ) = PPMB(JL,1) * 100._JPRB |
---|
142 | ENDDO |
---|
143 | |
---|
144 | DO JK = 1 , KLEV |
---|
145 | IKJ=(JK-1)*NG1P1+1 |
---|
146 | IKJR = IKJ |
---|
147 | IKJP = IKJ + NG1P1 |
---|
148 | DO JL = KIDIA,KFDIA |
---|
149 | ZSSIG(JL,IKJP)=PPMB(JL,JK+1)* 100._JPRB |
---|
150 | ENDDO |
---|
151 | DO IG1=1,NG1 |
---|
152 | IKJ=IKJ+1 |
---|
153 | DO JL = KIDIA,KFDIA |
---|
154 | ZSSIG(JL,IKJ)= (ZSSIG(JL,IKJR) + ZSSIG(JL,IKJP)) * 0.5_JPRB & |
---|
155 | & + RT1(IG1) * (ZSSIG(JL,IKJP) - ZSSIG(JL,IKJR)) * 0.5_JPRB |
---|
156 | ENDDO |
---|
157 | ENDDO |
---|
158 | ENDDO |
---|
159 | |
---|
160 | !----------------------------------------------------------------------- |
---|
161 | |
---|
162 | !* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS |
---|
163 | ! -------------------------------------------------- |
---|
164 | |
---|
165 | DO JKI=1,3*KLEV |
---|
166 | IKIP1=JKI+1 |
---|
167 | DO JL = KIDIA,KFDIA |
---|
168 | ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,IKIP1))*0.5_JPRB |
---|
169 | ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,IKIP1))/(10._JPRB*RG) |
---|
170 | ENDDO |
---|
171 | ENDDO |
---|
172 | |
---|
173 | DO JK = 1 , KLEV |
---|
174 | IKL = KLEV+1 - JK |
---|
175 | DO JL = KIDIA,KFDIA |
---|
176 | ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ ) |
---|
177 | ZXOZ(JL) = MAX (PQOF(JL,IKL) / PDP(JL,IKL) , REPSCO ) |
---|
178 | ENDDO |
---|
179 | IKJ=(JK-1)*NG1P1+1 |
---|
180 | IKJPN=IKJ+NG1 |
---|
181 | DO JKK=IKJ,IKJPN |
---|
182 | DO JL = KIDIA,KFDIA |
---|
183 | ZDPMG = ZDPM(JL,JKK) |
---|
184 | ZDPMP0 = ZDPMG / 101325._JPRB |
---|
185 | ZUPMG = ZUPM(JL,JKK) * ZDPMP0 |
---|
186 | ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0 |
---|
187 | ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0 |
---|
188 | ZUPMO3 = ( ZUPM(JL,JKK) + RVGO3 ) * ZDPMP0 |
---|
189 | ZDUC(JL,JKK) = ZDPMG |
---|
190 | ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPMG |
---|
191 | ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3 |
---|
192 | ZU6 = ZXWV(JL) * ZUPMG |
---|
193 | ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1.0_JPRB+0.608_JPRB*ZXWV(JL)) |
---|
194 | ZABLY(JL,1,JKK) = ZXWV(JL) * ZUPMH2O |
---|
195 | ZABLY(JL,5,JKK) = ZU6 * ZFPPW |
---|
196 | ZABLY(JL,4,JKK) = ZU6 * (1.0_JPRB-ZFPPW) |
---|
197 | ZABLY(JL,3,JKK) = PCCO2 * ZUPMCO2 |
---|
198 | ZABLY(JL,2,JKK) = PCCO2 * ZDPMG |
---|
199 | ENDDO |
---|
200 | ENDDO |
---|
201 | ENDDO |
---|
202 | |
---|
203 | !----------------------------------------------------------------------- |
---|
204 | |
---|
205 | !* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE |
---|
206 | ! -------------------------------------------------- |
---|
207 | |
---|
208 | DO JA = 1, NUA |
---|
209 | DO JL = KIDIA,KFDIA |
---|
210 | PABCU(JL,JA,3*KLEV+1) = 0.0_JPRB |
---|
211 | ENDDO |
---|
212 | ENDDO |
---|
213 | |
---|
214 | DO JK = 1 , KLEV |
---|
215 | IJ=(JK-1)*NG1P1+1 |
---|
216 | IJPN=IJ+NG1 |
---|
217 | IKL=KLEV+1-JK |
---|
218 | |
---|
219 | !* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE |
---|
220 | ! -------------------------------------------------- |
---|
221 | ! -- NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM |
---|
222 | |
---|
223 | IAE1=3*KLEV+1-IJ |
---|
224 | IAE2=3*KLEV+1-(IJ+1) |
---|
225 | IAE3=3*KLEV+1-IJPN |
---|
226 | ! print *,'IAE1= ',IAE1 |
---|
227 | ! print *,'IAE2= ',IAE2 |
---|
228 | ! print *,'IAE3= ',IAE3 |
---|
229 | ! print *,'KIDIA= ',KIDIA |
---|
230 | ! print *,'KFDIA= ',KFDIA |
---|
231 | ! print *,'KLEV= ',KLEV |
---|
232 | DO JAE=1,6 |
---|
233 | DO JL = KIDIA,KFDIA |
---|
234 | ! print *,'JL= ',JL,'-JAE= ',JAE,'-JK= ',JK,'-NSIL= ',NSIL |
---|
235 | ZUAER(JL,JAE) =& |
---|
236 | & (RAER(JAE,1)*PAER(JL,1,JK)+RAER(JAE,2)*PAER(JL,2,JK)& |
---|
237 | & +RAER(JAE,3)*PAER(JL,3,JK)+RAER(JAE,4)*PAER(JL,4,JK)& |
---|
238 | & +RAER(JAE,5)*PAER(JL,5,JK)+RAER(JAE,6)*PAER(JL,6,JK))& |
---|
239 | & /(ZDUC(JL,IAE1)+ZDUC(JL,IAE2)+ZDUC(JL,IAE3)) |
---|
240 | ENDDO |
---|
241 | ENDDO |
---|
242 | |
---|
243 | !* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS |
---|
244 | ! -------------------------------------------------- |
---|
245 | |
---|
246 | DO JL = KIDIA,KFDIA |
---|
247 | ZTAVI(JL)=PTAVE(JL,IKL) |
---|
248 | ZFACT(JL)=1.0_JPRB-ZTAVI(JL)/296._JPRB |
---|
249 | ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB/ZTAVI(JL)-1.0_JPRB)) |
---|
250 | ! ZTCON(JL)=EXP(6.08*ZFACT(JL)) |
---|
251 | ZTX=ZTAVI(JL)-TREF |
---|
252 | ZTX2=ZTX*ZTX |
---|
253 | ZZABLY = ZABLY(JL,1,IAE1)+ZABLY(JL,1,IAE2)+ZABLY(JL,1,IAE3) |
---|
254 | ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0.0_JPRB), 6.0_JPRB) |
---|
255 | ZCAH1=ALWT(1,1)+ZUP*(ALWT(1,2)+ZUP*(ALWT(1,3))) |
---|
256 | ZCBH1=BLWT(1,1)+ZUP*(BLWT(1,2)+ZUP*(BLWT(1,3))) |
---|
257 | ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 ) |
---|
258 | ZCAH2=ALWT(2,1)+ZUP*(ALWT(2,2)+ZUP*(ALWT(2,3))) |
---|
259 | ZCBH2=BLWT(2,1)+ZUP*(BLWT(2,2)+ZUP*(BLWT(2,3))) |
---|
260 | ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 ) |
---|
261 | ZCAH3=ALWT(3,1)+ZUP*(ALWT(3,2)+ZUP*(ALWT(3,3))) |
---|
262 | ZCBH3=BLWT(3,1)+ZUP*(BLWT(3,2)+ZUP*(BLWT(3,3))) |
---|
263 | ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 ) |
---|
264 | ZCAH4=ALWT(4,1)+ZUP*(ALWT(4,2)+ZUP*(ALWT(4,3))) |
---|
265 | ZCBH4=BLWT(4,1)+ZUP*(BLWT(4,2)+ZUP*(BLWT(4,3))) |
---|
266 | ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 ) |
---|
267 | ZCAH5=ALWT(5,1)+ZUP*(ALWT(5,2)+ZUP*(ALWT(5,3))) |
---|
268 | ZCBH5=BLWT(5,1)+ZUP*(BLWT(5,2)+ZUP*(BLWT(5,3))) |
---|
269 | ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 ) |
---|
270 | ZCAH6=ALWT(6,1)+ZUP*(ALWT(6,2)+ZUP*(ALWT(6,3))) |
---|
271 | ZCBH6=BLWT(6,1)+ZUP*(BLWT(6,2)+ZUP*(BLWT(6,3))) |
---|
272 | ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 ) |
---|
273 | ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX - 1.13E-6_JPRB * ZTX2 ) |
---|
274 | ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX - 3.30E-6_JPRB * ZTX2 ) |
---|
275 | ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX + 2.05E-7_JPRB * ZTX2 ) |
---|
276 | ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX - 2.30E-6_JPRB * ZTX2 ) |
---|
277 | ENDDO |
---|
278 | |
---|
279 | DO JL = KIDIA,KFDIA |
---|
280 | ZTAVI(JL)=PTAVE(JL,IKL) |
---|
281 | ZTX=ZTAVI(JL)-TREF |
---|
282 | ZTX2=ZTX*ZTX |
---|
283 | ZZABLY = ZABLY(JL,3,IAE1)+ZABLY(JL,3,IAE2)+ZABLY(JL,3,IAE3) |
---|
284 | ZALUP = R10E * LOG ( ZZABLY ) |
---|
285 | ZUP = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP ) |
---|
286 | ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP |
---|
287 | ZCAC8=ALWT(8,1)+ZUP*(ALWT(8,2)+ZUP*(ALWT(8,3))) |
---|
288 | ZCBC8=BLWT(8,1)+ZUP*(BLWT(8,2)+ZUP*(BLWT(8,3))) |
---|
289 | ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 ) |
---|
290 | ZPHIO(JL) = EXP( RO3T(1) * ZTX + RO3T(2) * ZTX2) |
---|
291 | ZPSIO(JL) = EXP( 2.0_JPRB* (RO3T(3)*ZTX+RO3T(4)*ZTX2)) |
---|
292 | ENDDO |
---|
293 | |
---|
294 | DO JKK=IJ,IJPN |
---|
295 | IC=3*KLEV+1-JKK |
---|
296 | ICP1=IC+1 |
---|
297 | DO JL = KIDIA,KFDIA |
---|
298 | ZDIFF = PVIEW(JL) |
---|
299 | !- H2O continuum |
---|
300 | PABCU(JL,10,IC)=PABCU(JL,10,ICP1)+ ZABLY(JL,4,IC) *ZDIFF |
---|
301 | PABCU(JL,11,IC)=PABCU(JL,11,ICP1)+ ZABLY(JL,5,IC)*ZTCON(JL)*ZDIFF |
---|
302 | !- O3 |
---|
303 | PABCU(JL,12,IC)=PABCU(JL,12,ICP1)+ ZABLY(JL,6,IC)*ZPHIO(JL)*ZDIFF |
---|
304 | PABCU(JL,13,IC)=PABCU(JL,13,ICP1)+ ZABLY(JL,7,IC)*ZPSIO(JL)*ZDIFF |
---|
305 | !- CO2 |
---|
306 | PABCU(JL,7,IC)=PABCU(JL,7,ICP1)+ ZABLY(JL,3,IC)*ZPSC2(JL)*ZDIFF |
---|
307 | PABCU(JL,8,IC)=PABCU(JL,8,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF |
---|
308 | PABCU(JL,9,IC)=PABCU(JL,9,ICP1)+ ZABLY(JL,3,IC)*ZPSC3(JL)*ZDIFF |
---|
309 | !- H2O |
---|
310 | PABCU(JL,1,IC)=PABCU(JL,1,ICP1)+ ZABLY(JL,1,IC)*ZPSH1(JL) |
---|
311 | PABCU(JL,2,IC)=PABCU(JL,2,ICP1)+ ZABLY(JL,1,IC)*ZPSH2(JL) |
---|
312 | PABCU(JL,3,IC)=PABCU(JL,3,ICP1)+ ZABLY(JL,1,IC)*ZPSH5(JL)*ZDIFF |
---|
313 | PABCU(JL,4,IC)=PABCU(JL,4,ICP1)+ ZABLY(JL,1,IC)*ZPSH3(JL) |
---|
314 | PABCU(JL,5,IC)=PABCU(JL,5,ICP1)+ ZABLY(JL,1,IC)*ZPSH4(JL) |
---|
315 | PABCU(JL,6,IC)=PABCU(JL,6,ICP1)+ ZABLY(JL,1,IC)*ZPSH6(JL)*ZDIFF |
---|
316 | !- aerosols |
---|
317 | PABCU(JL,14,IC)=PABCU(JL,14,ICP1)+ ZUAER(JL,1) *ZDUC(JL,IC)*ZDIFF |
---|
318 | PABCU(JL,15,IC)=PABCU(JL,15,ICP1)+ ZUAER(JL,2) *ZDUC(JL,IC)*ZDIFF |
---|
319 | PABCU(JL,16,IC)=PABCU(JL,16,ICP1)+ ZUAER(JL,3) *ZDUC(JL,IC)*ZDIFF |
---|
320 | PABCU(JL,17,IC)=PABCU(JL,17,ICP1)+ ZUAER(JL,4) *ZDUC(JL,IC)*ZDIFF |
---|
321 | PABCU(JL,18,IC)=PABCU(JL,18,ICP1)+ ZUAER(JL,5) *ZDUC(JL,IC)*ZDIFF |
---|
322 | #ifdef REPROBUS |
---|
323 | IF (type_trac=='repr'.and. ok_rtime2d) THEN |
---|
324 | !- CH4 |
---|
325 | PABCU(JL,19,IC)=PABCU(JL,19,ICP1)& |
---|
326 | & + ZABLY(JL,2,IC)*RCH42D(JL, IC)/PCCO2*ZPHM6(JL)*ZDIFF |
---|
327 | PABCU(JL,20,IC)=PABCU(JL,20,ICP1)& |
---|
328 | & + ZABLY(JL,3,IC)*RCH42D(JL, IC)/PCCO2*ZPSM6(JL)*ZDIFF |
---|
329 | !- N2O |
---|
330 | PABCU(JL,21,IC)=PABCU(JL,21,ICP1)& |
---|
331 | & + ZABLY(JL,2,IC)*RN2O2D(JL, IC)/PCCO2*ZPHN6(JL)*ZDIFF |
---|
332 | PABCU(JL,22,IC)=PABCU(JL,22,ICP1)& |
---|
333 | & + ZABLY(JL,3,IC)*RN2O2D(JL, IC)/PCCO2*ZPSN6(JL)*ZDIFF |
---|
334 | !- CFC11 |
---|
335 | PABCU(JL,23,IC)=PABCU(JL,23,ICP1)& |
---|
336 | & + ZABLY(JL,2,IC)*RCFC112D(JL, IC)/PCCO2 *ZDIFF |
---|
337 | !- CFC12 |
---|
338 | PABCU(JL,24,IC)=PABCU(JL,24,ICP1)& |
---|
339 | & + ZABLY(JL,2,IC)*RCFC122D(JL, IC)/PCCO2 *ZDIFF |
---|
340 | |
---|
341 | ELSE |
---|
342 | #endif |
---|
343 | !- CH4 |
---|
344 | PABCU(JL,19,IC)=PABCU(JL,19,ICP1)& |
---|
345 | & + ZABLY(JL,2,IC)*RCH4/PCCO2*ZPHM6(JL)*ZDIFF |
---|
346 | PABCU(JL,20,IC)=PABCU(JL,20,ICP1)& |
---|
347 | & + ZABLY(JL,3,IC)*RCH4/PCCO2*ZPSM6(JL)*ZDIFF |
---|
348 | !- N2O |
---|
349 | PABCU(JL,21,IC)=PABCU(JL,21,ICP1)& |
---|
350 | & + ZABLY(JL,2,IC)*RN2O/PCCO2*ZPHN6(JL)*ZDIFF |
---|
351 | PABCU(JL,22,IC)=PABCU(JL,22,ICP1)& |
---|
352 | & + ZABLY(JL,3,IC)*RN2O/PCCO2*ZPSN6(JL)*ZDIFF |
---|
353 | !- CFC11 |
---|
354 | PABCU(JL,23,IC)=PABCU(JL,23,ICP1)& |
---|
355 | & + ZABLY(JL,2,IC)*RCFC11/PCCO2 *ZDIFF |
---|
356 | !- CFC12 |
---|
357 | PABCU(JL,24,IC)=PABCU(JL,24,ICP1)& |
---|
358 | & + ZABLY(JL,2,IC)*RCFC12/PCCO2 *ZDIFF |
---|
359 | #ifdef REPROBUS |
---|
360 | END IF |
---|
361 | #endif |
---|
362 | ENDDO |
---|
363 | ENDDO |
---|
364 | |
---|
365 | ENDDO |
---|
366 | ! print *,'END OF LWU' |
---|
367 | |
---|
368 | |
---|
369 | |
---|
370 | !----------------------------------------------------------------------- |
---|
371 | |
---|
372 | IF (LHOOK) CALL DR_HOOK('LWU',1,ZHOOK_HANDLE) |
---|
373 | END SUBROUTINE LWU |
---|