Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

Atm_RT_RUN.F90 @ 3765

Last change on this file since 3765 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR

Integration of MAR physics

File size: 31.3 KB

Line
1	subroutine Atm_RT_RUN(rklonr,iklOUT)
2
3	!--------------------------------------------------------------------------+
4	! Mon 24-Jun-2013 MAR \|
5	! subroutine Atm_RT_RUN interfaces MAR PHYsics \|
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____dat
22	use Mod_PHY_RT_dat
23	use Mod_PHY____grd
24	use Mod_PHY_S0_grd
25	use Mod_PHY_RT_grd
26	use Mod_PHY_S0_kkl
27	use Mod_PHY_RT_kkl
28	use Mod_PHY_DY_kkl
29	use Mod_PHY_CM_kkl
30	use Mod_SISVAT_gpt
31
32
33	#include "tsmbkind.h"
34
35
36
37	! Global Variables (ECMWF)
38	! ========================
39
40	USE PARRTM1D , ONLY : JP_LON ,JP_IDIA ,JP_FDIA ,JP_TDIA ,&
41	& JP_LEV ,JP_LW ,JP_SW ,JP_NUA ,JP_MODE ,&
42	& JP_AER ,JP_LEVP1
43	USE YOMCST , ONLY : RD ,RG ,RTT ,RSIGMA ,&
44	& RCPD ,RPI ,RDAY ,REA ,RI0 ,&
45	& REPSM ,RMD ,RKBOL ,RNAVO ,R ,&
46	& RLVTT ,RLSTT
47	USE YOERAD , ONLY : NSW ,NTSW ,NRADFR ,&
48	& LRRTM ,LINHOM ,LOIFUEC ,LTEMPDS ,LOWASYF ,&
49	& LOWHSSS,LONEWSW ,LNEWAER ,LHVOLCA ,&
50	& NRADIP ,NRADLP ,NOZOCL ,&
51	& NICEOPT,NLIQOPT ,NOVLP ,NHOWINH ,RMINICE
52	USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,&
53	& RCTRBGA,RCVOBGA ,RCSTBGA ,RCAEOPS ,RCAEOPL ,RCAEOPU ,&
54	& RCAEOPD,RCTRPT ,RCAEADK ,RCAEADM ,RCAEROS
55	USE YOERDI , ONLY : RCH4 ,RN2O ,RO3 ,RCFC11 ,&
56	& RCFC12
57	USE YOERDU , ONLY : RCDAY ,R10E ,DIFF ,REPLOG ,&
58	& REPSC ,REPSCO ,REPSCQ ,REPSCT ,REPSCW ,&
59	& NTRAER
60	USE YOETHF , ONLY : R2ES ,R3LES ,R3IES ,R4LES ,&
61	& R4IES ,R5LES ,R5IES ,R5ALVCP ,R5ALSCP ,&
62	& RALVDCP,RALSDCP ,RTWAT ,RTICE ,RTICECU
63
64
65
66	IMPLICIT NONE
67
68	logical :: RTi_qi_and_qs = .TRUE. ! * as Very small Cloud Particle: T
69	!Gilles: T > F to have interactive cloud frac. & radiation
70	logical :: CFrCEP = .FALSE. ! ECMWF or CMiPhy Cloud Fraction: T OR F
71
72
73
74	! INPUT (from MAR/ECMWF Interface)
75	! -----
76
77	integer :: rklonr ! nb des pts de grilles
78	integer :: iklOUT ! OUTPUT (pt de grille)
79
80	integer :: kj ! Index des niveaux
81	integer :: nAe ! Index d'aerosols
82
83	! #DB integer :: kio
84	! #DB integer :: kjo
85	integer, dimension(rklonr) :: k2ii !
86	integer, dimension(rklonr) :: k2jj !
87	! #DB integer :: jkjllw
88	! #DB integer :: lijio
89
90
91
92	! INTERNAL VARIABLES
93	! ------------------
94
95	! For Use in radlsw
96	! ^^^^^^^^^^^^^^^^^
97	REAL_B :: PGELAM5(JP_LON)
98	REAL_B :: PGEMU5(JP_LON)
99	REAL_B :: PSLON5(JP_LON)
100	REAL_B :: PCLON5(JP_LON)
101	REAL_B :: ZOZON5(JP_LON,JP_LEV)
102	REAL_B :: ZAER5(JP_LON,JP_AER,JP_LEV)
103	!
104	!
105	INTEGER_M :: KIDIA ,KFDIA ,KTDIA ,KLON ,KLEV
106	INTEGER_M :: KMODE ,KAER ,KSW
107
108	INTEGER_M :: KBOX ,NBOX
109	INTEGER_M :: NDUMP ,ILWRAD
110	!
111	REAL_B :: PRII05
112
113	REAL_B :: PAER5(JP_LON,JP_AER,JP_LEV) ! Aerosol Optical Depth
114	REAL_B :: PALBD5(JP_LON,JP_SW)
115	REAL_B :: PALBP5(JP_LON,JP_SW)
116	!
117	REAL_B :: PAPH5(JP_LON,JP_LEVP1)
118	REAL_B :: PAP5(JP_LON,JP_LEV)
119	!
120	REAL_B :: PCCO25
121	REAL_B :: PCLFR5(JP_LON,JP_LEV)
122	REAL_B :: PDP5(JP_LON,JP_LEV)
123	REAL_B :: PEMIS5(JP_LON)
124	REAL_B :: PEMIW5(JP_LON)
125	REAL_B :: PLSM5(JP_LON)
126	REAL_B :: PMU05(JP_LON)
127	REAL_B :: POZON5(JP_LON,JP_LEV)
128	REAL_B :: PQ5(JP_LON,JP_LEV)
129	!
130	REAL_B :: PQIWP5(JP_LON,JP_LEV)
131	REAL_B :: PQLWP5(JP_LON,JP_LEV) ! Dropplets Concentration
132	REAL_B :: PSQIW5(JP_LON,JP_LEV) ! Ice Crystals Concentration
133	REAL_B :: PSQLW5(JP_LON,JP_LEV) !
134	REAL_B :: PQS5(JP_LON,JP_LEV)
135	REAL_B :: PQRAIN5(JP_LON,JP_LEV)
136	REAL_B :: PRAINT5(JP_LON,JP_LEV)
137	REAL_B :: PRLVRI5(JP_LON,JP_LEV)
138	REAL_B :: PRLVRL5(JP_LON,JP_LEV)
139	REAL_B :: PTH5(JP_LON,JP_LEVP1)
140	REAL_B :: PT5(JP_LON,JP_LEV)
141	REAL_B :: PTS5(JP_LON)
142	REAL_B :: PNBAS5(JP_LON)
143	REAL_B :: PNTOP5(JP_LON)
144	!
145	REAL_B :: PEMIT5(JP_LON)
146	REAL_B :: PFCT5(JP_LON,JP_LEVP1)
147	REAL_B :: PFLT5(JP_LON,JP_LEVP1)
148	REAL_B :: PFCS5(JP_LON,JP_LEVP1)
149	REAL_B :: PFLS5(JP_LON,JP_LEVP1)
150	REAL_B :: PFRSOD5(JP_LON)
151	REAL_B :: PSUDU5(JP_LON)
152	REAL_B :: PUVDF5(JP_LON)
153	REAL_B :: PPARF5(JP_LON)
154	REAL_B :: PFDCT5(JP_LON,JP_LEVP1)
155	REAL_B :: PFUCT5(JP_LON,JP_LEVP1)
156	REAL_B :: PFDLT5(JP_LON,JP_LEVP1)
157	REAL_B :: PFULT5(JP_LON,JP_LEVP1)
158	REAL_B :: PFDCS5(JP_LON,JP_LEVP1)
159	REAL_B :: PFUCS5(JP_LON,JP_LEVP1)
160	REAL_B :: PFDLS5(JP_LON,JP_LEVP1)
161	REAL_B :: PFULS5(JP_LON,JP_LEVP1)
162	!
163	REAL_B :: ZTAU5 (JP_LON,JP_SW,JP_LEV) ! Cloud Optical Depth
164	REAL_B :: ZTAUI5(JP_LON) ! Cloud Optical Depth (vert.int.)
165	!
166	REAL_B :: ASWBOX(JP_LON,100)
167	REAL_B :: OLRBOX(JP_LON,100)
168	REAL_B :: SLWBOX(JP_LON,100)
169	REAL_B :: SSWBOX(JP_LON,100)
170	REAL_B :: TAUBOX(JP_LON,100)
171	REAL_B :: CLDBOX(JP_LON,100,JP_LEV)
172
173	! For Use in SUCLD
174	! ^^^^^^^^^^^^^^^^
175	REAL_B :: ZETAH(JP_LEVP1)
176
177
178
179	! Local Variables
180	! ----------------
181
182	REAL_B :: RTIMTR , ZTHETOZ , ZANGOZC
183	REAL_B :: Zone_t ! Time Zone [hr]
184	REAL_B :: qcloud ! Cloud Particles Concentration [g/kg]
185	REAL_B :: fcloud ! Cloud Fraction [%]
186	REAL_B :: LWUpwd ! Surface Upward Longwave Radiation [W/m2]
187	REAL_B :: Emi_Cl ! Cloud Emissivity (diagnostic) [-]
188
189	INTEGER_M :: i , j , ikl ,k
190	INTEGER_M :: JL , JK , JAER ,JNU
191	INTEGER_M :: KULOUT , NINDAT , NSSSSS ,KPRTLEV
192	INTEGER_M :: IYR , MONTH , IDAY ,IMINUT
193	INTEGER_M :: KPRINT , SKSHIFT
194
195
196
197
198	! Load External Functions
199	! =======================
200
201	#include "fctast.h"
202	#include "fcttim.h"
203	#include "fcttre.h"
204
205
206	KPRTLEV= 1
207	KPRINT = 1
208	SKSHIFT= 0
209
210
211
212
213	! OUTPUT for DEBUGGING
214	! ====================
215
216	! #DB kio = 1
217	! #DB kjo = 1
218
219
220
221
222	! Date & Time
223	! ===========
224
225	NINDAT = min(yearTU,2004)10000+mon_TU100+Day_TU ! Date in the form yyyyMMdd
226	NSSSSS = HourTU * 3600+minuTU* 60+sec_TU ! Nb of second since day Begin
227
228	! VER v
229	write(6,*) ' NINDAT: ',NINDAT
230	write(6,*) ' NSSSSS: ',NSSSSS
231	! VER ^
232	IYR = NAA(NINDAT)
233	MONTH = NMM(NINDAT)
234	IDAY = NDD(NINDAT)
235	RTIMTR = RTIME(IYR,MONTH,IDAY,NSSSSS)
236	IMINUT = INT(FLOAT(NSSSSS)/60.)
237
238
239
240
241	! Basic Initialization
242	! ====================
243
244	! Dimensions (auxiliary variables)
245	! --------------------------------
246
247	KIDIA = 1 ! DO'NT CHANGE
248	KFDIA = JP_LON ! Nb Columns
249	KTDIA = 1 !
250	KLON = JP_LON ! Nb Columns
251	KLEV = JP_LEV ! Nb Levels
252	KMODE = JP_MODE ! Used in Planck Fcts Specification
253	KAER = JP_AER !
254
255	DO ikl = 1 , kcolp
256	k2ii(ikl) = ii__AP(ikl)
257	k2jj(ikl) = jj__AP(ikl)
258	ENDDO
259
260	! Nb of Solar Spectral Intervals
261	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
262	KSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6)
263	NSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6)
264	NTSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6)
265
266	KBOX = 0 ! \VER
267	NBOX = 1 ! \VER
268
269	ILWRAD = 1 ! 0: Morcrette, 1991 operational before 20000627
270	! 1: Mlawer et al., 1997 now ECMWF-operational
271	! 2: Morcrette, 1991 original as in ERA-15'
272
273	NDUMP = 3 ! No Print
274	! NDUMP = 2 ! 1D Results
275	! NDUMP = 1 ! Debug
276	! NDUMP = 0 ! ALL
277	KULOUT = 6 ! Output Device for SUCST
278
279
280
281
282	! Radiation: Global (Time dependant) Parameters
283	! =============================================
284
285	PRII05 = RI0/(dST_UA*dST_UA) ! INSOLATION (dST_UA: Distance Soleil-Terre [UA])
286	PCCO25 = 360.E-06*44./29. ! CONCENTRATION IN CO2 (PA/PA)
287
288
289
290
291	! Surface Properties
292	! ==================
293
294	! Surface Albedo
295	! --------------
296
297	DO jl=1,KLON
298	ikl = min(jl,kcolp)
299	i = ii__AP(ikl)
300	j = jj__AP(ikl)
301	DO jnu=1,KSW
302	PALBD5(JL,JNU) = Alb_SV_gpt(jl)
303	PALBP5(JL,JNU) = Alb_SV_gpt(jl)
304	ENDDO
305
306	! Surface Emissivity
307	! ------------------
308
309	PEMIS5(JL) = EmisSV_gpt(jl)
310	PEMIW5(JL) = EmisSV_gpt(jl)
311
312
313	! Land/sea Mask (1.=land)
314	! -------------
315
316	PLSM5 (JL) = 1 - MaskSV_gpt(jl)
317
318
319	! Cosine (Solar zenithal Distance)
320	! --------------------------------
321
322	PMU05 (JL) = csz_S0(ikl)
323
324
325
326
327	! Atmospheric Thermodynamics (Time and Space dependant)
328	! =====================================================
329
330	! Pressure
331	! --------
332
333	! Martin control
334	!PRINT*,'sigma(:)=',sigma(:)
335	!PRINT*,'sigmi(:)=',sigmi(:)
336	! Martin control
337
338	JK=1+KLEV
339	PAPH5 (JL,JK) = (psa_DY(ikl) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa]
340	DO JK=1,KLEV
341	PAPH5 (JL,JK) = (psa_DY(ikl) * sigma(JK) + pt__DY) * 1000. ! Pressure (Layer) [Pa]
342	PAP5 (JL,JK) = (psa_DY(ikl) * sigmi(JK) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa]
343	PDP5 (JL,JK) = psa_DY(ikl) dsigmi(JK) 1000. ! Pressure (Layer Thickness)[Pa]
344
345
346	! Water Species Distributions
347	! --------------------------------
348
349	PQ5 (JL,JK) = qv__DY(ikl,JK) ! Water Vapor Concentr. [kg/kg]
350	IF (RTi_qi_and_qs) THEN
351	PQIWP5 (JL,JK) = qi__CM(ikl,JK) &! Ice Crystals Concentr. [kg/kg]
352	& + (1.-min(1.,exp((Ta__DY(ikl,JK)-258.15)*0.1))) &! AND
353	& * ( qs__CM(ikl,JK) *0.33 ) ! Snow Particl.Concentr. [kg/kg]
354	ELSE !
355	PQIWP5 (JL,JK) = qi__CM(ikl,JK) ! Ice Crystals Concentr. [kg/kg]
356	END IF
357	PQIWP5 (JL,JK) = max(0.,PQIWP5(JL, JK)-1.E-9) ! Ice Crystals Concentr. [kg/kg]
358
359	PQLWP5 (JL,JK) = max(0.,qw__CM(ikl,JK)-1.E-9) ! Dropplet Concentr. [kg/kg]
360
361	PQS5 (JL,JK) = qvswCM(ikl,JK) ! Saturat. % Water [kg/kg]
362	PQRAIN5(JL,JK) = qr__CM(ikl,JK) ! Drops Concentr. [kg/kg]
363	PRAINT5(JL,JK) = 0. ! \VER
364	PRLVRI5(JL,JK) = 0. ! e-mail J.-J.M. 20031203
365	PSQIW5 (JL,JK) = 1. ! exp(-PRLVRI5(JL,JK))
366	PRLVRL5(JL,JK) = 0. ! e-mail J.-J.M. 20031203
367	PSQLW5 (JL,JK) = 1. ! exp(-PRLVRL5(JL,JK))
368
369
370	! Cloud Fraction
371	! --------------
372
373	IF (CFrCEP) THEN
374	PCLFR5 (JL,JK) = (PQIWP5(JL,JK)+PQLWP5(JL,JK)) &! ECMWF Paramet.
375	& /(FraQws * PQS5(JL,JK)) ! (VERY Crude)
376	PCLFR5 (JL,JK) = min( _ONE_ ,PCLFR5(JL,JK)) !
377	PCLFR5 (JL,JK) = max(1.0E-3 ,PCLFR5(JL,JK)) &! no small values
378	& *max(_ZERO_,sign(_ONE_,PQIWP5(JL,JK)+PQLWP5(JL,JK) &!
379	& -2.E-9_JPRB)) !
380	CFraCM (ikl,JK) = PCLFR5(JL,JK) !
381	ELSE
382	PCLFR5 (JL,JK) = CFraCM(ikl,JK) ! Cloud Fraction from CMiPhy [-]
383	END IF
384	! write(4,4) JL,JK,PQLWP5(JL,JK),PQIWP5(JL,JK) &
385	! & , PQS5(JL,JK) &
386	! & ,CFraCM(JL,JK),PCLFR5(JL,JK)
387	!4 format(2i6,' Cloud Liq.W.= ', f9.6,5x &
388	! & ,' Cloud Sol.W.= ', f9.6,5x &
389	! & ,' Satur.W.Vap.= ', f9.6,5x &
390	! & ,' Cloud Fract.= ',2f9.6)
391
392	! Temperature Distribution
393	! -------------------------------
394
395	PT5 (JL,JK) = Ta__DY(ikl,JK)
396	PTH5 (JL,JK) = 0.5 * (Ta__DY(ikl,JK)+Ta__DY(ikl,max(1,JK-1)))
397	END DO
398	PTH5 (JL,KLEV+1) = Ta__DY(ikl,mzpp)
399	PTS5 (JL) = Ta__DY(ikl,mzpp)
400
401
402	! Convective Layer
403	! ----------------
404
405	PNBAS5 (JL) = 1. ! \VER
406	PNTOP5 (JL) = 1. ! \VER
407	ENDDO
408
409
410
411
412	! Assignation (Climatologies, Time dependant)
413	! ================================================
414
415	! Aerosols Optical Thickness Horizontal Distribution (model grid
416	! -------------------------------------------------- independant)
417
418	! *******
419	CALL SUECAEC ( NINDAT, IMINUT ) ! TEGEN ET AL. (1997, JGR 102,
420	! ******* ! pp23895-23915)
421
422
423	! Aerosols Optical Thickness Vertical Distribution
424	! --------------------------------------------------
425	! *******
426
427
428	! Martin modification for MAR-LMDZ:
429	DO jk=1,klev+1
430	ZETAH(jk)=PAPH5(1,jk)/PAPH5(1,klev+1)
431	ENDDO
432	! Martin Control
433	!Print*, 'Dans Atm_RT_RUN:'
434	!PRINT*,'ZETAH=',ZETAH
435	!PRINT*,'=KLEV',KLEV
436	! Martin Control
437
438	! Martin Control
439
440	CALL SUAERV &
441	& ( KLEV ,ZETAH &
442	& , CVDAES ,CVDAEL ,CVDAEU ,CVDAED &
443	& , RCTRBGA,RCVOBGA,RCSTBGA,RCAEOPS,RCAEOPL,RCAEOPU &
444	& , RCAEOPD,RCTRPT ,RCAEADK,RCAEADM,RCAEROS &
445	& )
446	! *******
447
448
449	! O3
450	! --
451
452	! Fortuin-Langematz O3 climatology
453	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
454	! *******
455	CALL SUECOZC ( NINDAT , IMINUT )
456	! *******
457
458	! ECMWF Geleyn O3 Climatology
459	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
460	ZTHETOZ=RTETA( RTIMTR )
461	ZANGOZC= REL( ZTHETOZ ) - 1.7535
462
463	! *******
464	CALL SUECOZO ( ZANGOZC )
465	! *******
466
467
468
469
470	! Interpolation on the MAR Grid
471	! =============================
472
473	DO JL=1,KLON
474	ikl=min(JL,kcolp)
475	PGELAM5(JL)= lon__r(ikl)
476	PGEMU5(JL)=SIN(lat__r(ikl))
477	PCLON5(JL)=COS(lon__r(ikl))
478	PSLON5(JL)=SIN(lon__r(ikl))
479	END DO
480
481	! ******
482	CALL RADACA &
483	&( KIDIA , KLON , KLON , KTDIA , KLEV &
484	&, PAPH5 , PGELAM5, PGEMU5, PCLON5, PSLON5, PTH5 &
485	&, ZAER5 , ZOZON5 &
486	& )
487	! ******
488
489
490	! OLD ECMWF O3 Climatology
491	! --------------------------------
492
493	IF (NOZOCL.EQ.1 .OR. NOZOCL.EQ.3) THEN
494	DO JK=1,KLEV
495	DO JL=KIDIA,KFDIA
496	POZON5(JL,JK) = ZOZON5(JL,JK)
497	ENDDO
498	ENDDO
499	END IF
500
501
502	! FORTUIN LANGEMATZ O3 Climatology
503	! --------------------------------
504
505	IF (NOZOCL.EQ.2 .OR. NOZOCL.EQ.4) THEN
506
507	! ******
508	CALL RADOZC ( KIDIA ,KLON , KLON , KTDIA, KLEV &
509	&, KPRINT,KLON , SKSHIFT, PAPH5, PGEMU5, ZOZON5)
510	! ******
511
512	DO JK=1,KLEV
513	DO JL=KIDIA,KFDIA
514	POZON5(JL,JK) = ZOZON5(JL,JK)
515	ENDDO
516	ENDDO
517
518	END IF
519
520
521	! AEROSOLS
522	! --------
523
524	IF (NOZOCL.EQ.1 .OR. NOZOCL.EQ.2) THEN
525	DO jk=1,klev
526	DO jaer=1,KAER
527	DO jl=KIDIA,KFDIA
528	PAER5(JL,JAER,JK)= ZAER5(JL,JAER,JK)
529	ENDDO
530	ENDDO
531	ENDDO
532	END IF
533
534
535	! NO AEROSOLS
536	! -----------
537
538	IF (NOZOCL.GT.2) THEN
539	DO jk=1,klev
540	DO jaer=1,KAER
541	DO jl=KIDIA,KFDIA
542	PAER5(JL,JAER,JK)= ZEPAER
543	ENDDO
544	ENDDO
545	ENDDO
546	END IF
547
548
549	! SECURITY CHECK ON AEROSOL AMOUNTS
550	! ---------------------------------
551
552	DO JK=1,KLEV
553	DO JAER=1,KAER
554	DO JL=KIDIA,KFDIA
555	PAER5(JL,JAER,JK)=MAX(ZEPAER,PAER5(JL,JAER,JK))
556	ENDDO
557	ENDDO
558	ENDDO
559
560
561
562
563	! Transmission to MAR Variables
564	! =============================
565
566	DO JL=1,KLON
567	ikl=min(JL,kcolp)
568
569	DO JK=1,KLEV
570	O3__RT(ikl,jk ) = ZOZON5(JL,JK) ! O3 Concentr.
571	END DO
572
573	DO JK=1,KLEV
574	DO JAER=1,KAER
575	AersRT(ikl,jk,jaer) = PAER5(JL,JAER,JK) ! Aerosol Optical Thickness
576	END DO
577	END DO
578
579	END DO
580
581
582
583
584	! Solar and IR Transfer through the Atmosphere
585	! ============================================
586
587
588	! VER v
589	! STOP 'Fin momentanee'
590	! VER ^
591	! ******
592	CALL RADLSW &
593	& ( KIDIA , KFDIA , KLON , KTDIA , KLEV , KMODE , KAER, &
594	& KBOX , NBOX &
595	& , NDUMP , ILWRAD &
596	& , PRII05 &
597	& , PAER5 , PALBD5, PALBP5, PAPH5 , PAP5 &
598	& , PCCO25, PCLFR5, PDP5 , PEMIS5, PEMIW5 , PLSM5 , PMU05, &
599	& POZON5 &
600	& , PQ5 , PQIWP5, PQLWP5, PSQIW5, PSQLW5 , PQS5 , PQRAIN5, &
601	& PRAINT5 &
602	& , PRLVRI5,PRLVRL5,PTH5 , PT5 , PTS5 , PNBAS5, PNTOP5 &
603	& , PEMIT5, PFCT5 , PFLT5 , PFCS5 , PFLS5 , PFRSOD5, PSUDU5, &
604	& PUVDF5, PPARF5 &
605	& , PFDCT5, PFUCT5, PFDLT5, PFULT5, PFDCS5 , PFUCS5, PFDLS5, &
606	& PFULS5 &
607	& , ZTAU5 , ZTAUI5 &
608	& , ASWBOX, OLRBOX, SLWBOX, SSWBOX, TAUBOX , CLDBOX &
609	! #DB& , k2ii,k2jj &
610	& )
611	! ******
612
613
614
615
616	! Radiative Fluxes Distributions
617	! ================================
618
619	DO JL=1,KLON
620	ikl = min(JL,kcolp)
621	DO JK=1,KLEV+1
622	FIRn_c (ikl,jk) = PFCT5 (JL,JK) ! CLEAR-SKY LW NET FLUXES [W/m2]
623	FIRn_t (ikl,jk) = PFLT5 (JL,JK) ! TOTAL-SKY LW NET FLUXES [W/m2]
624	FSOn_c (ikl,jk) = PFCS5 (JL,JK) ! CLEAR-SKY SW NET FLUXES [W/m2]
625	FSOn_t (ikl,jk) = PFLS5 (JL,JK) ! TOTAL-SKY SW NET FLUXES [W/m2]
626	END DO
627
628
629
630
631	! Cloud Optical Depth
632	! ===================
633
634	DO JK=1,KLEV
635	kj = KLEV + 1 -JK !
636	ODCzRT (ikl,kj) = ZTAU5(JL, 1,JK) ! Cloud Optical Depth
637	DO nAe=1,naero !
638	ODAzRT (ikl,jk) = ODAzRT(ikl,jk ) + PAER5(JL,nAe,JK) ! Aeros.Optical Depth
639	END DO !
640	END DO !
641	!
642	ODC_RT (ikl ) = ZTAUI5(JL) ! Cloud Optical Depth (vert.integr.,
643	! 1st interval)
644	ODA_RT (ikl ) = 0. !
645	DO JK=1,KLEV !
646	ODA_RT (ikl ) = ODA_RT(ikl) + ODAzRT(ikl,jk) ! Aeros.Optical Depth
647	END DO
648
649
650
651
652	! SURFACE RADIATIVE CHARACTERISTICS (SW)
653	! ======================================
654
655	FSOs_t(ikl) = PFRSOD5(JL) ! TOTAL-SKY SRF SW DOWNWARD FLUX [W/m2]
656	FSOdir(ikl) = PSUDU5(JL) ! SOLAR RADIANCE IN SUN'S DIRECT. [W/m2]
657	FSOsUV(ikl) = PUVDF5(JL) ! SURFAC.DOWNWARD U.V. RADIATION [W/m2]
658	FSOeff(ikl) = PPARF5(JL) ! PHOTOSYNTHET. ACTIVE RADIATION [W/m2]
659
660
661
662
663	! SURFACE RADIATIVE CHARACTERISTICS (LW)
664	! ======================================
665	! EmisSV_gpt(jl ) = PEMIT5(JL) ! TOTAL LW EMISSIVITY \VER
666
667	END DO
668
669
670
671
672	! Grid Point Dependant Variables <-- Atm_RT "Vector"Variables
673	! ==============================================================
674
675	DO ikl = 1,kcolp
676
677	i = ii__AP(ikl)
678	j = jj__AP(ikl)
679
680	! OutgoingLongWave Radiation Fluxes
681	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
682	OLR_RT (ikl) =-FIRn_t(ikl,1 ) ! Atm Top LongWave Heat Flux (+) ( Upward)
683
684	! Surface Downward Radiative Fluxes
685	! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
686	SWDsRT (ikl) = FSOs_t(ikl ) ! Surface ShrtWave Heat Flux (+) (Downward)
687	SWAsRT (ikl) = FSOs_t(ikl )*(1.-Alb_SV_gpt(ikl)) ! Surface ShrtWave Heat Flux (+) (Absorbed)
688	LWDsRT (ikl) = FIRn_t(ikl,mzpp) &!
689	& + Ta__DY(ikl,mzpp)* Ta__DY(ikl,mzpp) &!
690	& Ta__DY(ikl,mzpp) Ta__DY(ikl,mzpp) &!
691	& StefBo EmisSV_gpt(ikl) !
692
693	! Cloud Fraction
694	! ^^^^^^^^^^^^^^^^
695	ClouRT (ikl) = 0.0
696	DO k = 1,mzp
697	ClouRT (ikl) = max(CFraCM(ikl,k) , ClouRT(ikl))
698
699	! Radiative Heating
700	! ^^^^^^^^^^^^^^^^^
701	LWdTRT (ikl,k) = - ( FIRn_t(ikl,k+1) - FIRn_t(ikl,k) ) &!
702	& * Grav_F / ( CpdAir 1.e3 psa_DY(ikl) *dsigmi(k)) !
703	SWdTRT (ikl,k) = - ( FSOn_t(ikl,k+1) - FSOn_t(ikl,k) ) &!
704	& * Grav_F / ( CpdAir 1.e3 psa_DY(ikl) *dsigmi(k)) !
705
706	dpktRT (ikl,k) = ( LWdTRT(ikl,k) + SWdTRT(ikl,k) ) / ExnrDY(ikl,k)
707	LWdTRT (ikl,k) = LWdTRT(ikl,k) * 86400.
708	SWdTRT (ikl,k) = SWdTRT(ikl,k) * 86400.
709
710	END DO
711
712	END DO
713
714
715
716
717
718	! OUTPUT
719	! ======
720
721	! OUTPUT for Analysis
722	! -------------------
723
724	IF (iklOUT.GT.0) THEN
725
726	ikl = iklOUT
727	i = ii__AP(iklOUT)
728	j = jj__AP(iklOUT)
729	Zone_t = lon__h(ikl) - 12.
730
731	write(4,401)Day_TU,Mon_TU,HourTU ,minuTU, &
732	& Zone_t , i ,j
733	401 format(//,' +-- Radiative Heat Fluxes --+', &
734	& i4,'/',i2,i4,':',i2,' h.LT (',f4.0')', &
735	& ' (i,j) = (',i3,',',i3,')', &
736	& //,' \| Altitud \| Pressur.\| Temper.\| Ozone \| W.Vapor\|', &
737	& ' Clouds \| Clouds \| Opt.D \| Aer.OD. \| So Warm.\|', &
738	& ' Emiss.\| IR Cool.\| IR NetF.\|', &
739	& /,' \| [km] \| [hPa] \| [K] \| [cmSTP] \| [g/kg] \|', &
740	& ' [g/kg] \| [%] \| [-] \| [-] \| [K/day] \|', &
741	& ' [-] \| [K/day] \| [W/m2] \|', &
742	& /,' +---------+---------+--------+---------+--------+', &
743	& '--------+--------+--------+---------+---------+', &
744	& '-------+---------+---------+')
745
746	write(4,404) pt__DY*1.e+1 &
747	& , OLR_RT(ikl)
748	404 format( &
749	& ' \| SOMMET \|',f8.2,' \|', 7x ,' \|', 8x ,' \|'&
750	& , 3( 7x ,' \|'), 7x ,' \|', 8x ,' \|', 8x ,' \|' &
751	& , 6x ,' \|', 8x ,' \|',f8.1,' \|'&
752	& ,/,' +---------+---------+--------+---------+--------+', &
753	& '--------+--------+--------+---------+---------+', &
754	& '-------+---------+---------+')
755
756
757	DO k =1,mzp
758
759	qcloud = 1.e+3 *(qw__CM(ikl,k)+qi__CM(ikl,k))
760	fcloud = 1.e+2 * CFraCM(ikl,k)
761	Emi_Cl = 1.-exp(-qcloud 0.5 (Z___DY(ikl,max(1,k-1))-Z___DY(ikl,k+1)) &
762	& * sigma(k)* psa_DY(ikl) / (287.*Ta__DY(ikl,k )))
763
764	write(4,402) 1.e-3Z___DY(ikl,k),PAP5 (ikl,k)1.e-2 &
765	& ,Ta__DY(ikl,k) ,O3__RT(ikl,k) &
766	& ,qv__DY(ikl,k)*1.e3,qcloud ,fcloud &
767	& ,ODCzRT(ikl,k) ,ODAzRT(ikl,k),SWdTRT(ikl,k) &
768	& ,Emi_Cl ,LWdTRT(ikl,k) &
769	& ,FIRn_t(ikl,k)
770	402 format(' \| ', f7.3,' \|' ,f8.2,' \|',f7.2,' \|',e8.2,' \|',&
771	& 2(f7.3,' \|'),2(f7.2,' \|'),e8.2,' \|',f8.4,' \|' &
772	& , f6.3,' \|',f8.2,' \|',f8.1,' \|')
773
774	END DO
775
776
777	LWUpwd = Ta__DY(ikl,mzpp)* Ta__DY(ikl,mzpp) &!
778	& Ta__DY(ikl,mzpp) Ta__DY(ikl,mzpp) &!
779	& StefBo EmisSV_gpt( ikl) !
780
781	write(4,403) 1.e+1*psa_DY(ikl) &
782	& ,Ta__DY(ikl,mzpp) &
783	& ,ODC_RT(ikl ) ,ODA_RT( ikl),FSOs_t(ikl) &
784	& ,FIRn_t(ikl,mzpp) &
785	& ,Alb_SV_gpt(ikl),SWAsRT(ikl) &
786	& ,EmisSV_gpt(ikl),LWDsRT(ikl) &
787	& ,LWUpwd
788	403 format( &
789	& ' +---------+---------+--------+---------+--------+', &
790	& '--------+--------+--------+---------+---------+', &
791	& '-------+---------+---------+', &
792	& /,' \| AIR-SOL \|',f8.2,' \|',f7.2,' \|', 8x ,' \|'&
793	& , 3( 7x ,' \|'), f7.2,' \|',e8.2,' \|',f8.1,' \|' &
794	& , 6x ,' \|', 8x ,' \|',f8.1,' \|'&
795	& , /,' \| SOL \|', 8x ,' \|', 7x ,' \|', 8x ,' \|'&
796	& , 3( 7x ,' \|'), 7x ,' \|',f8.2,' \|',f8.1,' \|' &
797	& , f6.3,' \|',f8.1,' \|',f8.1,' \|')
798
799	END IF ! (iklOUT.GT.0)
800
801
802	! OUTPUT for Debugging
803	! --------------------
804
805	! #DB jkjllw=0
806	! #DB DO JL=1,KLON
807	! #DB lijio =0
808	! #DB ikl = min(JL,kcolp)
809	! #DB DO JK=1,KLEV
810	!! write(6,*) k2ii(JL),k2jj(JL),jl,jk,' FIRn_t: ', PFLT5(jl,jk)
811	!! write(6,*) k2ii(JL),k2jj(JL),jl,jk,' FSOn_t: ', PFLS5(jl,jk)
812	! #DB IF ( PFLT5(jl,jk).GT. 500..OR. PFLS5(jl,jk).GT. 500. .OR. &
813	! #DB& PFLT5(jl,jk).LT.-500..OR. PFLS5(jl,jk).LT.-500. .OR. &
814	! #DB& (k2ii(jl).EQ.kio.AND.k2jj(jl).EQ.kjo)) lijio=1
815	! #DB END DO
816	! #DB IF (lijio.EQ.1) THEN
817	! #DB DO JK=1,KLEV
818	! #DB IF (mod(jkjllw,20).EQ.0) &
819	! #DB& write(6,600)
820	! #DB 600 format('IN PHYrad2CEP: Radiative Fluxes ',/ &
821	! #DB& ,' i j JL JK',9x,'Ta',9x,'Qv',9x,'Qi',9x,'Qw' &
822	! #DB& ,9x,'O3',8x,'CLD',8x,'COD',8x,'AOD',8x,'SOn',8x,'IRn')
823	! #DB jkjllw=jkjllw+1
824	! #DB write(6,601) k2ii(JL),k2jj(JL),JL,JK &
825	! #DB& ,Ta__DY(ikl,JK),PQ5 (jk,jl) &
826	! #DB& ,PQIWP5(JL,JK) ,PQLWP5(JL,JK) &
827	! #DB& ,O3__RT(ikl,jk),CFraCM(ikl,JK) &
828	! #DB& ,ODCzRT(ikl,jk),ODAzRT(ikl,jk) &
829	! #DB& ,FSOn_t(ikl,jk),FIRn_t(ikl,jk)
830	! #DB 601 format(4i5,10e11.3)
831	! #DB END DO
832	! #DB ENDIF
833	!
834	! #DB END DO
835
836
837
838
839	return
840	end subroutine Atm_RT_RUN

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format