Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

Atm_RT_RUN.F90 @ 3428

Last change on this file since 3428 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

Rev	Line
[2089]	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