1 | subroutine Atm_RT_INI |
---|
2 | |
---|
3 | !--------------------------------------------------------------------------+ |
---|
4 | ! Mon 24-Jun-2013 MAR | |
---|
5 | ! subroutine Atm_RT_INI initializes MAR PHYsics interface | |
---|
6 | ! with ECMWF Solar/Infrared Radiative Transfer Scheme | |
---|
7 | ! | |
---|
8 | ! version 3.p.4.1 created by H. Gallee, Tue 2-Apr-2013 | |
---|
9 | ! Last Modification by H. Gallee, Mon 24-Jun-2013 | |
---|
10 | ! | |
---|
11 | !--------------------------------------------------------------------------+ |
---|
12 | ! | |
---|
13 | ! Content: CALL of - ECMWF Code initializing the Radiation Transfert | |
---|
14 | ! - ECMWF Radiation Transfert | |
---|
15 | ! | |
---|
16 | ! ECMWF Code Source: J.-J. Morcrette, 28 nov 2002 | |
---|
17 | ! | |
---|
18 | !--------------------------------------------------------------------------+ |
---|
19 | |
---|
20 | use Mod_Real |
---|
21 | use Mod_PHY_RT_dat |
---|
22 | use Mod_PHY____grd |
---|
23 | use Mod_PHY_S0_grd |
---|
24 | use Mod_PHY_RT_grd |
---|
25 | use Mod_PHY_DY_kkl |
---|
26 | use Mod_SISVAT_gpt |
---|
27 | |
---|
28 | |
---|
29 | |
---|
30 | #include "tsmbkind.h" |
---|
31 | |
---|
32 | |
---|
33 | |
---|
34 | |
---|
35 | ! Global Variables (ECMWF) |
---|
36 | ! ======================== |
---|
37 | |
---|
38 | USE PARRTM1D , ONLY : JP_LON ,JP_IDIA ,JP_FDIA ,JP_TDIA ,& |
---|
39 | & JP_LEV ,JP_LW ,JP_SW ,JP_NUA ,JP_MODE ,& |
---|
40 | & JP_AER ,JP_LEVP1 |
---|
41 | USE YOMCST , ONLY : RD ,RG ,RTT ,RSIGMA ,& |
---|
42 | & RCPD ,RPI ,RDAY ,REA ,RI0 ,& |
---|
43 | & REPSM ,RMD ,RKBOL ,RNAVO ,R ,& |
---|
44 | & RLVTT ,RLSTT |
---|
45 | USE YOERAD , ONLY : NSW ,NTSW ,NRADFR ,& |
---|
46 | & LRRTM ,LINHOM ,LOIFUEC ,LTEMPDS ,LOWASYF ,& |
---|
47 | & LOWHSSS,LONEWSW ,LNEWAER ,LHVOLCA ,& |
---|
48 | & NRADIP ,NRADLP ,NOZOCL ,& |
---|
49 | & NICEOPT,NLIQOPT ,NOVLP ,NHOWINH ,RMINICE |
---|
50 | USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,& |
---|
51 | & RCTRBGA,RCVOBGA ,RCSTBGA ,RCAEOPS ,RCAEOPL ,RCAEOPU ,& |
---|
52 | & RCAEOPD,RCTRPT ,RCAEADK ,RCAEADM ,RCAEROS |
---|
53 | USE YOERDI , ONLY : RCH4 ,RN2O ,RO3 ,RCFC11 ,& |
---|
54 | & RCFC12 |
---|
55 | USE YOERDU , ONLY : RCDAY ,R10E ,DIFF ,REPLOG ,& |
---|
56 | & REPSC ,REPSCO ,REPSCQ ,REPSCT ,REPSCW ,& |
---|
57 | & NTRAER |
---|
58 | USE YOETHF , ONLY : R2ES ,R3LES ,R3IES ,R4LES ,& |
---|
59 | & R4IES ,R5LES ,R5IES ,R5ALVCP ,R5ALSCP ,& |
---|
60 | & RALVDCP,RALSDCP ,RTWAT ,RTICE ,RTICECU |
---|
61 | |
---|
62 | |
---|
63 | |
---|
64 | |
---|
65 | IMPLICIT NONE |
---|
66 | |
---|
67 | |
---|
68 | |
---|
69 | |
---|
70 | ! INTERNAL VARIABLES |
---|
71 | ! ================== |
---|
72 | |
---|
73 | integer :: i ,j ,ikl |
---|
74 | |
---|
75 | ! For Use in radlsw |
---|
76 | ! ^^^^^^^^^^^^^^^^^ |
---|
77 | INTEGER_M :: KIDIA ,KFDIA ,KTDIA ,KLON ,KLEV |
---|
78 | INTEGER_M :: KMODE ,KAER ,KSW |
---|
79 | |
---|
80 | INTEGER_M :: KBOX ,NBOX |
---|
81 | INTEGER_M :: NDUMP ,ILWRAD |
---|
82 | ! |
---|
83 | REAL_B :: PRII05 |
---|
84 | |
---|
85 | REAL_B :: PAER5(JP_LON,JP_AER,JP_LEV) ! Aerosol Optical Depth |
---|
86 | REAL_B :: PALBD5(JP_LON,JP_SW) |
---|
87 | REAL_B :: PALBP5(JP_LON,JP_SW) |
---|
88 | ! |
---|
89 | REAL_B :: PAPH5(JP_LON,JP_LEVP1) |
---|
90 | REAL_B :: PAP5(JP_LON,JP_LEV) |
---|
91 | ! |
---|
92 | REAL_B :: PCCO25 |
---|
93 | REAL_B :: PCLFR5(JP_LON,JP_LEV) |
---|
94 | REAL_B :: PDP5(JP_LON,JP_LEV) |
---|
95 | REAL_B :: PEMIS5(JP_LON) |
---|
96 | REAL_B :: PEMIW5(JP_LON) |
---|
97 | REAL_B :: PLSM5(JP_LON) |
---|
98 | REAL_B :: PMU05(JP_LON) |
---|
99 | REAL_B :: POZON5(JP_LON,JP_LEV) |
---|
100 | REAL_B :: PQ5(JP_LON,JP_LEV) |
---|
101 | ! |
---|
102 | REAL_B :: PQIWP5(JP_LON,JP_LEV) |
---|
103 | REAL_B :: PQLWP5(JP_LON,JP_LEV) ! Dropplets Concentration |
---|
104 | REAL_B :: PSQIW5(JP_LON,JP_LEV) ! Ice Crystals Concentration |
---|
105 | REAL_B :: PSQLW5(JP_LON,JP_LEV) ! |
---|
106 | REAL_B :: PQS5(JP_LON,JP_LEV) |
---|
107 | REAL_B :: PQRAIN5(JP_LON,JP_LEV) |
---|
108 | REAL_B :: PRAINT5(JP_LON,JP_LEV) |
---|
109 | REAL_B :: PRLVRI5(JP_LON,JP_LEV) |
---|
110 | REAL_B :: PRLVRL5(JP_LON,JP_LEV) |
---|
111 | REAL_B :: PTH5(JP_LON,JP_LEVP1) |
---|
112 | REAL_B :: PT5(JP_LON,JP_LEV) |
---|
113 | REAL_B :: PTS5(JP_LON) |
---|
114 | REAL_B :: PNBAS5(JP_LON) |
---|
115 | REAL_B :: PNTOP5(JP_LON) |
---|
116 | |
---|
117 | ! For Use in SUCLD |
---|
118 | ! ^^^^^^^^^^^^^^^^ |
---|
119 | REAL_B :: ZETA(JP_LEV) |
---|
120 | REAL_B :: ZETAH(JP_LEVP1) |
---|
121 | |
---|
122 | ! For Use in SUOVLP |
---|
123 | ! ^^^^^^^^^^^^^^^^^ |
---|
124 | REAL_B :: ZTVIR |
---|
125 | REAL_B :: ZFACT |
---|
126 | REAL_B :: ZAZ(JP_LEV) |
---|
127 | REAL_B :: ZAZH(JP_LEVP1) |
---|
128 | |
---|
129 | |
---|
130 | |
---|
131 | ! Local Variables |
---|
132 | ! ---------------- |
---|
133 | |
---|
134 | REAL_B :: RTIMTR |
---|
135 | |
---|
136 | INTEGER_M :: JL , JK , JAER ,JNU |
---|
137 | INTEGER_M :: KULOUT , NINDAT , NSSSSS ,KPRTLEV |
---|
138 | INTEGER_M :: IYR , MONTH , IDAY ,IMINUT |
---|
139 | INTEGER_M :: KPRINT , SKSHIFT |
---|
140 | |
---|
141 | |
---|
142 | |
---|
143 | |
---|
144 | ! Load External Functions |
---|
145 | ! ======================= |
---|
146 | |
---|
147 | #include "fctast.h" |
---|
148 | #include "fcttim.h" |
---|
149 | #include "fcttre.h" |
---|
150 | |
---|
151 | |
---|
152 | KPRTLEV= 1 |
---|
153 | KPRINT = 1 |
---|
154 | SKSHIFT= 0 |
---|
155 | |
---|
156 | |
---|
157 | |
---|
158 | |
---|
159 | ! Time Base |
---|
160 | ! ========= |
---|
161 | |
---|
162 | NINDAT = min(yearTU,2004)*10000+mon_TU*100+Day_TU ! Date in the form yyyyMMdd |
---|
163 | NSSSSS = HourTU * 3600+minuTU* 60+sec_TU ! Nb of second since day Begin |
---|
164 | IYR = NAA(NINDAT) |
---|
165 | MONTH = NMM(NINDAT) |
---|
166 | IDAY = NDD(NINDAT) |
---|
167 | RTIMTR = RTIME(IYR,MONTH,IDAY,NSSSSS) |
---|
168 | IMINUT = INT(FLOAT(NSSSSS)/60.) |
---|
169 | |
---|
170 | |
---|
171 | |
---|
172 | |
---|
173 | ! Basic Initialization |
---|
174 | ! ==================== |
---|
175 | |
---|
176 | ! Dimensions (auxiliary variables) |
---|
177 | ! -------------------------------- |
---|
178 | |
---|
179 | KIDIA = 1 ! DO'NT CHANGE |
---|
180 | KFDIA = JP_LON ! Nb Columns |
---|
181 | KTDIA = 1 ! |
---|
182 | KLON = JP_LON ! Nb Columns |
---|
183 | KLEV = JP_LEV ! Nb Levels |
---|
184 | KMODE = JP_MODE ! Used in Planck Fcts Specification |
---|
185 | KAER = JP_AER ! |
---|
186 | |
---|
187 | ! Nb of Solar Spectral Intervals |
---|
188 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
189 | KSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
190 | NSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
191 | NTSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
192 | |
---|
193 | KBOX = 0 ! \VER |
---|
194 | NBOX = 1 ! \VER |
---|
195 | |
---|
196 | ILWRAD = 1 ! 0: Morcrette, 1991 operational before 20000627 |
---|
197 | ! 1: Mlawer et al., 1997 now ECMWF-operational |
---|
198 | ! 2: Morcrette, 1991 original as in ERA-15' |
---|
199 | |
---|
200 | NDUMP = 3 ! No Print |
---|
201 | ! NDUMP = 2 ! 1D Results |
---|
202 | ! NDUMP = 1 ! Debug |
---|
203 | ! NDUMP = 0 ! ALL |
---|
204 | KULOUT = 6 ! Output Device for SUCST |
---|
205 | |
---|
206 | |
---|
207 | ! Verification of the Dimensions |
---|
208 | ! ------------------------------ |
---|
209 | |
---|
210 | write(6,*) 'INITIALISATION OF ECMWF RADIATIVE TRANSFERT: BEGIN' |
---|
211 | |
---|
212 | write(6,*) 'CONTROL' |
---|
213 | write(6,*) 'JP_LON=',JP_LON |
---|
214 | write(6,*) 'kcolp',kcolp |
---|
215 | IF (kcolp .GT.JP_LON) THEN |
---|
216 | write(6,6001) kcolp ,JP_LON |
---|
217 | 6001 format(' @!#& BAD dimensions SET-UP (kcolp > JP_LON); = ('& |
---|
218 | & ,i3,',',i3,')') |
---|
219 | STOP |
---|
220 | END IF |
---|
221 | IF (mzp .NE.JP_LEV) THEN |
---|
222 | write(6,6002) mzp ,JP_LEV |
---|
223 | 6002 format(' @!#& BAD dimensions SET-UP (mzp /= JP_LEV); = ('& |
---|
224 | & ,i3,',',i3,')') |
---|
225 | STOP |
---|
226 | END IF |
---|
227 | IF (naero .NE.JP_AER) THEN |
---|
228 | write(6,6003) naero ,JP_AER |
---|
229 | 6003 format(' @!#& BAD dimensions SET-UP (naero/= JP_AER); = ('& |
---|
230 | & ,i3,',',i3,')') |
---|
231 | STOP |
---|
232 | END IF |
---|
233 | |
---|
234 | |
---|
235 | ! Mathematical Constants |
---|
236 | ! ---------------------- |
---|
237 | |
---|
238 | REPLOG = 1.E-12 ! Minimum Logarithm Argument |
---|
239 | REPSC = 1.E-12 |
---|
240 | REPSCO = 1.E-12 |
---|
241 | REPSCQ = 1.E-12 |
---|
242 | REPSCT = 1.E-12 |
---|
243 | REPSCW = 1.E-12 |
---|
244 | |
---|
245 | |
---|
246 | ! Switches (general) |
---|
247 | ! ------------------ |
---|
248 | |
---|
249 | LONEWSW= .TRUE. ! .TRUE. SWSN radiative routine is used |
---|
250 | IF (ILWRAD.EQ.1) THEN |
---|
251 | LRRTM = .TRUE. ! .TRUE. RRTM radiative routine is used |
---|
252 | ELSE |
---|
253 | LRRTM = .FALSE. ! .FALSE.RRTM radiative routine is NOT used |
---|
254 | END IF |
---|
255 | LTEMPDS= .FALSE. ! .TRUE. ALLOWS FOR SURF. T DISCONTIN. IN RAD.COMPUT. |
---|
256 | |
---|
257 | NTRAER = 19 ! NUMBER OF TRANSMISSION FUNCTIONS W OR W/O AEROSOLS |
---|
258 | |
---|
259 | |
---|
260 | ! Switches (Clouds Optical Properties) |
---|
261 | ! ------------------------------------ |
---|
262 | |
---|
263 | LINHOM = .FALSE. ! Tiedke (1995) correct. factor (0.7) of tau not used |
---|
264 | NHOWINH= 2 ! Tau correction factor: exp(-(sig/tau)^2) |
---|
265 | ! (used if LINHOM = .TRUE.) |
---|
266 | LOIFUEC= .FALSE. ! .FALSE. IF ICE CLOUDS AS EBERT-CURRY (LW & SW) |
---|
267 | LOWASYF= .FALSE. ! .FALSE. IF WATER CLOUDS AS FOUQUART (SW) |
---|
268 | LOWHSSS= .FALSE. ! .FALSE. IF WATER CLOUDS AS SMITH-SHI (LW) |
---|
269 | NRADIP = 3 ! Ice effective Radius: |
---|
270 | ! 0 fixed 40 microns |
---|
271 | ! 1 f(T) 40 - 130 microns |
---|
272 | ! 2 f(T) 30 - 60 microns Jakob-Klein |
---|
273 | ! 3 f(T,IWC) Sun-Rikus, 1999 |
---|
274 | RMINICE= 15 ! Minimum Diameter for Ice Particles (micronm) |
---|
275 | ! Needed only if NRADIP = 3 |
---|
276 | ! (see von Walden et al., 2003 (Oct) Tab. 2 p.1393) |
---|
277 | NRADLP = 0 ! Liquid effective Radius: f(Pressure) |
---|
278 | ! 0 effective radius - liquid as f(Pressure) |
---|
279 | ! 1 fixed 10 microns over land, 13 over ocean |
---|
280 | ! 2 computed from LWC Martin et al, 1994 |
---|
281 | NLIQOPT= 1 ! Cloud Optical Properties (Water): 1=ECMWF Operat. |
---|
282 | ! 0 LW: Smith-Shi, 1992; SW: Fouquart, 1987 |
---|
283 | ! 1 LW: Savijarvi, 1997; SW: Slingo , 1989 |
---|
284 | ! 2 LW: Lindner,Li, 2000; SW: Slingo , 1989 |
---|
285 | NICEOPT= 1 ! Cloud Optical Properties (Ice) : 1=ECMWF Operat. |
---|
286 | ! 0 LW: Smith,Shi , 1992; SW: Ebert-Curry, 1992 |
---|
287 | ! 1 LW: Ebert,Curry, 1992; SW: Ebert-Curry, 1992 |
---|
288 | ! 2 LW: Fu,Liou , 1993; SW: Fu,Liou , 1993 |
---|
289 | ! 3 LW: Fu et al. , 1998; SW: Fu , 1996 |
---|
290 | NOVLP = 2 ! CLOUD OVERLAP CONFIGURATION: |
---|
291 | ! 1=MRN, 2=MAX, 3=RAN, 4=Hogan |
---|
292 | |
---|
293 | |
---|
294 | ! Switches (Aerosols/O3) |
---|
295 | ! ---------------------- |
---|
296 | |
---|
297 | LNEWAER= .TRUE. ! Climatology of Aerosols: TEGEN ET AL. 1997 / GADS |
---|
298 | LHVOLCA= .TRUE. ! .TRUE. IF GISS HISTORY OF VOLCANIC AEROSOLS IS ON |
---|
299 | ! NOZOCL = -1 ! TESTS the vertical quadrature (NO absorber) |
---|
300 | ! NOZOCL = 0 ! whatever is read for O3 as input profile |
---|
301 | ! NOZOCL = 1 ! OLD ECMWF O3 climatology and aerosols |
---|
302 | NOZOCL = 2 ! Fortuin-Langematz O3 climatology and aerosols |
---|
303 | ! NOZOCL = 3 ! OLD ECMWF O3 climatology and NO aerosols |
---|
304 | ! NOZOCL = 4 ! Fortuin-Langematz O3 climatology and NO aerosols |
---|
305 | |
---|
306 | |
---|
307 | ! BASIC CONSTANTS |
---|
308 | ! --------------- |
---|
309 | |
---|
310 | ! ***** |
---|
311 | CALL SUCST (KULOUT, NINDAT, NSSSSS, KPRTLEV) ! Initialize common YOMCST |
---|
312 | ! ***** ! (Basic Constants) |
---|
313 | ! Initialize common YOMRIP |
---|
314 | ! (only date and time) |
---|
315 | |
---|
316 | ! YOENCST - THERMODYNAMIC TRANSITION OF PHASE |
---|
317 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
318 | RTT=273.16 ! |
---|
319 | |
---|
320 | ! YOETHF - DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS |
---|
321 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
322 | RTWAT=RTT ! |
---|
323 | RTICE=RTT-23. ! |
---|
324 | |
---|
325 | ! YOERDU - CONTROL, PARAMETERS AND SECURITY IN RADIATION |
---|
326 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
327 | RCDAY = RDAY * RG / RCPD ! |
---|
328 | R10E = 0.4342945 ! DECIMAL / NATURAL |
---|
329 | ! LOG. FACTOR |
---|
330 | DIFF = 1.66 ! DIFFUSIVITY FACTOR |
---|
331 | |
---|
332 | |
---|
333 | ! Space/Time Independant Coefficients |
---|
334 | ! ----------------------------------- |
---|
335 | |
---|
336 | CALL SURDI ! ECMWF Surface Albedo, Emissivity |
---|
337 | CALL SULWN ! Initialize common YOELW (new LW Coeff.) |
---|
338 | CALL SUOLW ! Initialize common YOELW (old LW Coeff.) |
---|
339 | |
---|
340 | ! Initialization routine for RRTM |
---|
341 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
342 | CALL SURRTAB ! AER'S RRTM LW RADIATION |
---|
343 | CALL SURRTPK ! Initialize common YOERRTWN |
---|
344 | ! (k-coefficients in spectral intervals) |
---|
345 | CALL SURRTRF ! Initialize common YOERRTRF |
---|
346 | ! (RRTM Reference Atmosphere) |
---|
347 | CALL SURRTFTR ! Initialize common YOERRTRF |
---|
348 | |
---|
349 | ! RRTM routine ! BAND [cm-1] ! low ! high |
---|
350 | ! ----------------------+---------------+---------------+--------- |
---|
351 | CALL RRTM_KGB1 ! 1: 10- 250 ! H2O ! H2O |
---|
352 | CALL RRTM_KGB2 ! 2: 250- 500 ! H2O ! H2O |
---|
353 | CALL RRTM_KGB3 ! 3: 500- 630 ! H2O,CO2 ! H2O,CO2 |
---|
354 | CALL RRTM_KGB4 ! 4: 630- 700 ! H2O,CO2 ! O3,CO2 |
---|
355 | CALL RRTM_KGB5 ! 5: 700- 820 ! H2O,CO2 ! O3,CO2 |
---|
356 | CALL RRTM_KGB6 ! 6: 820- 980 ! H2O ! nothing |
---|
357 | CALL RRTM_KGB7 ! 7: 980-1080 ! H2O,O3 ! O3 |
---|
358 | CALL RRTM_KGB8 ! 8: 1080-1180 ! (i.e.>~300mb) ! O3 |
---|
359 | ! ! H2O ! |
---|
360 | CALL RRTM_KGB9 ! 9: 1180-1390 ! H2O,CH4 ! CH4 |
---|
361 | CALL RRTM_KGB10 ! 10: 1390-1480 ! H2O ! H2O |
---|
362 | CALL RRTM_KGB11 ! 11: 1480-1800 ! H2O ! H2O |
---|
363 | CALL RRTM_KGB12 ! 12: 1800-2080 ! H2O,CO2 ! nothing |
---|
364 | CALL RRTM_KGB13 ! 13: 2080-2250 ! H2O,N2O ! nothing |
---|
365 | CALL RRTM_KGB14 ! 14: 2250-2380 ! CO2 ! CO2 |
---|
366 | CALL RRTM_KGB15 ! 15: 2380-2600 ! N2O,CO2 ! nothing |
---|
367 | CALL RRTM_KGB16 ! 16: 2600-3000 ! H2O,CH4 ! nothing |
---|
368 | |
---|
369 | ! Reduce absorption coefficient data from 256 to 140 g-points |
---|
370 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
371 | CALL RRTM_INIT_140GP |
---|
372 | |
---|
373 | ! Initialization routine for SW (6 spectral interval resolution) |
---|
374 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
375 | CALL SUSWN ( NTSW , KSW ) ! Initialize common YOESW |
---|
376 | |
---|
377 | |
---|
378 | write(6,*) 'INITIALISATION OF ECMWF RADIATIVE TRANSFERT: END ' |
---|
379 | |
---|
380 | |
---|
381 | |
---|
382 | |
---|
383 | ! Radiation: Global (Time dependant) Parameters |
---|
384 | ! ============================================= |
---|
385 | |
---|
386 | PRII05 = RI0 ! INSOLATION |
---|
387 | ! PRII05 = RI0/(dST_UA*dST_UA) ! INSOLATION (dST_UA: Distance Soleil-Terre [UA]) |
---|
388 | PCCO25 = 360.E-06*44./29. ! CONCENTRATION IN CO2 [Pa/Pa] |
---|
389 | |
---|
390 | |
---|
391 | |
---|
392 | |
---|
393 | ! Surface Properties |
---|
394 | ! ================== |
---|
395 | |
---|
396 | ! Land/sea Mask |
---|
397 | ! ------------- |
---|
398 | |
---|
399 | ! Martin CONTROL |
---|
400 | !PRINT*, 'CONTROL dans Atm_RT_INI' |
---|
401 | !PRINT*,'SIZE(psa_DY)=)',SIZE(psa_DY) |
---|
402 | !PRINT*, 'psa_DY=',psa_DY |
---|
403 | ! Martin CONTROL |
---|
404 | |
---|
405 | DO jl=1,KLON |
---|
406 | ikl = min(jl,kcolp) |
---|
407 | i = ii__AP(ikl) |
---|
408 | j = jj__AP(ikl) |
---|
409 | PLSM5 (JL) = 1 - MaskSV_gpt(ikl) |
---|
410 | |
---|
411 | |
---|
412 | |
---|
413 | |
---|
414 | ! Atmospheric Thermodynamics (Time and Space dependant) |
---|
415 | ! ===================================================== |
---|
416 | |
---|
417 | ! Pressure Distribution |
---|
418 | ! -------------------------- |
---|
419 | |
---|
420 | JK=1+KLEV |
---|
421 | PAPH5 (JL,JK) = (psa_DY(ikl) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa] |
---|
422 | DO JK=1,KLEV |
---|
423 | PAPH5 (JL,JK) = (psa_DY(ikl) * sigma(JK) + pt__DY) * 1000. ! Pressure (Layer) [Pa] |
---|
424 | PAP5 (JL,JK) = (psa_DY(ikl) * sigmi(JK) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa] |
---|
425 | PDP5 (JL,JK) = psa_DY(ikl) *dsigmi(JK) * 1000. ! Pressure (Layer Thickness)[Pa] |
---|
426 | |
---|
427 | |
---|
428 | ! Temperature Distribution |
---|
429 | ! -------------------------- |
---|
430 | |
---|
431 | PT5 (JL,JK) = Ta__DY(ikl,JK) |
---|
432 | |
---|
433 | |
---|
434 | ! Water Species Distribution |
---|
435 | ! -------------------------- |
---|
436 | |
---|
437 | PQ5 (JL,JK) = qv__DY(ikl,JK) ! Water Vapor Concentr. [kg/kg] |
---|
438 | |
---|
439 | ENDDO |
---|
440 | ENDDO |
---|
441 | |
---|
442 | |
---|
443 | |
---|
444 | |
---|
445 | ! Initialization (Climatologies, Time independant) |
---|
446 | ! ================================================ |
---|
447 | |
---|
448 | ! Aerosols Radiative Characteristics (YOEAER) |
---|
449 | ! ---------------------------------- |
---|
450 | |
---|
451 | ! ******* |
---|
452 | CALL SUAERL ! Aerosols LW Radiative Charact. |
---|
453 | CALL SUAERSN ( NTSW , KSW ) ! Aerosols SW Radiative Charact. |
---|
454 | ! ******* |
---|
455 | |
---|
456 | |
---|
457 | ! Aerosols Optical Thickness Horizontal Distribution (model grid |
---|
458 | ! -------------------------------------------------- independant) |
---|
459 | |
---|
460 | ! ******** |
---|
461 | CALL SUAERH ! |
---|
462 | CALL SUECAEBC ! BLACK CARBON (URBAN/FOREST FIRE ORIGIN) |
---|
463 | CALL SUECAEOR ! ORGANIC-TYPE |
---|
464 | CALL SUECAESD ! SOIL-DUST ORIGIN |
---|
465 | CALL SUECAESS ! SEA -SALT ORIGIN |
---|
466 | CALL SUECAESU ! SULFATE-TYPE |
---|
467 | ! ******** |
---|
468 | |
---|
469 | |
---|
470 | ! Clouds (YOECLD) |
---|
471 | ! --------------- |
---|
472 | |
---|
473 | DO jk=1,klev |
---|
474 | ZETA(jk) =PAP5(1,jk) /PAPH5(1,klev+1) |
---|
475 | ENDDO |
---|
476 | DO jk=1,klev+1 |
---|
477 | ZETAH(jk)=PAPH5(1,jk)/PAPH5(1,klev+1) |
---|
478 | ENDDO |
---|
479 | ! Martin Control |
---|
480 | !PRINT*, 'PAPH5(1,:)=',PAPH5(1,:) |
---|
481 | !PRINT*, 'ZETAH=',ZETAH |
---|
482 | ! Martin Control |
---|
483 | |
---|
484 | ! ***** |
---|
485 | CALL SUCLD ( KLEV , ZETA ) |
---|
486 | ! ***** |
---|
487 | |
---|
488 | |
---|
489 | ! Cloud Optical Parameters SW/LW (all parameterizations) |
---|
490 | ! ------------------------------------------------------ |
---|
491 | |
---|
492 | ! ******* |
---|
493 | CALL SUCLOPN ( NTSW , KSW , KLEV ) ! Initialize YOECLOP |
---|
494 | ! ******* |
---|
495 | |
---|
496 | |
---|
497 | ! Radar Reflectivity |
---|
498 | ! ------------------ |
---|
499 | |
---|
500 | ZAZH(KLEV+1)= 0. |
---|
501 | ZAZ(1) =100000. |
---|
502 | JL=KIDIA |
---|
503 | DO jk=KLEV,2,-1 |
---|
504 | ZTVIR = PT5(JL,jk) /(1.-0.608*PQ5(jl,jk)) |
---|
505 | ZFACT = LOG(PAPH5(jl,jk+1))- LOG(PAPH5(jl,jk)) |
---|
506 | ZAZH(jk) = ZAZH(jk+1) + R * ZTVIR/(RMD*RG)*ZFACT |
---|
507 | ZAZ(jk) = 0.5*(ZAZH(jk+1)+ZAZH(jk))*1000. |
---|
508 | END DO |
---|
509 | |
---|
510 | ! ****** |
---|
511 | CALL SUOVLP ( KLEV , ZAZ ) ! Initialize ALPHA1 (%radar refl.) |
---|
512 | ! ****** ! (Hogan & Illingsworth, 1999) |
---|
513 | |
---|
514 | |
---|
515 | ! NO Absorber |
---|
516 | ! ----------- |
---|
517 | |
---|
518 | IF (NOZOCL.EQ.-1) THEN |
---|
519 | RCH4 = 1.E-18 |
---|
520 | RN2O = 1.E-18 |
---|
521 | RO3 = 1.E-18 |
---|
522 | RCFC11 = 1.E-18 |
---|
523 | RCFC12 = 1.E-18 |
---|
524 | PCCO25 = 1.E-18 |
---|
525 | DO jk=1,klev |
---|
526 | DO jl=KIDIA,KFDIA |
---|
527 | POZON5(JL,JK) = 0. |
---|
528 | ENDDO |
---|
529 | ENDDO |
---|
530 | DO JK=1,KLEV |
---|
531 | DO JAER=1,KAER |
---|
532 | DO JL=KIDIA,KFDIA |
---|
533 | PAER5(JL,JAER,JK)= ZEPAER |
---|
534 | ENDDO |
---|
535 | ENDDO |
---|
536 | ENDDO |
---|
537 | END IF |
---|
538 | |
---|
539 | |
---|
540 | |
---|
541 | return |
---|
542 | end subroutine Atm_RT_INI |
---|