GCC Code Coverage Report


Directory: ./
File: rad/srtm_srtm_224gp_mcica.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 88 0.0%
Branches: 0 46 0.0%

Line Branch Exec Source
1 SUBROUTINE SRTM_SRTM_224GP_MCICA &
2 & ( KIDIA , KFDIA , KLON , KLEV , KSW , KCOLS , KCLDLY ,&
3 & PAER , PALBD , PALBP , PAPH , PAP , &
4 & PTS , PTH , PT ,&
5 & PQ , PCCO2 , POZN , PRMU0 ,&
6 & PFRCL , PTAUC , PASYC , POMGC ,&
7 & PFSUX , PFSUC &
8 & )
9
10 !-- interface to RRTM_SW
11 ! JJMorcrette 030225
12 ! JJMorcrette 20050110 McICA version
13
14 USE PARKIND1 ,ONLY : JPIM ,JPRB
15 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
16
17 USE PARSRTM , ONLY : JPLAY
18 !MPL/IM 20160915 on prend GES de phylmd USE YOERDI , ONLY : RCH4 , RN2O
19 USE YOERAD , ONLY : NAER
20 USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
21 USE YOMPHY3 , ONLY : RII0
22 USE YOMCST , ONLY : RI0
23
24 IMPLICIT NONE
25
26 !-- Input arguments
27
28 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
29 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
30 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
31 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
32 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
33 INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
34 INTEGER(KIND=JPIM),INTENT(IN) :: KCLDLY(KCOLS)
35
36 REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! top to bottom
37 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,KSW)
38 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,KSW)
39 REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
40 REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
41 REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON)
42 REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
43 REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
44 REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
45 REAL(KIND=JPRB) ,INTENT(IN) :: PCCO2
46 REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV)
47 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
48
49 REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
50 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
51 REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
52 REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
53
54 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUX(KLON,2,KLEV+1)
55 REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUC(KLON,2,KLEV+1)
56
57 !-- Output arguments
58
59 !-----------------------------------------------------------------------
60
61 !-- dummy integers
62
63 INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
64
65 INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
66
67 !-- dummy reals
68
69 REAL(KIND=JPRB) :: ZPZ(0:JPLAY) , ZTZ(0:JPLAY) , ZPAVEL(JPLAY) , ZTAVEL(JPLAY)
70 REAL(KIND=JPRB) :: ZCOLDRY(JPLAY) , ZCOLMOL(JPLAY) , ZWKL(35,JPLAY)
71 REAL(KIND=JPRB) :: ZCO2MULT(JPLAY), ZCOLCH4(JPLAY) , ZCOLCO2(JPLAY) , ZCOLH2O(JPLAY)
72 REAL(KIND=JPRB) :: ZCOLN2O(JPLAY) , ZCOLO2(JPLAY) , ZCOLO3(JPLAY)
73 REAL(KIND=JPRB) :: ZFORFAC(JPLAY) , ZFORFRAC(JPLAY), ZSELFFAC(JPLAY), ZSELFFRAC(JPLAY)
74 REAL(KIND=JPRB) :: ZFAC00(JPLAY) , ZFAC01(JPLAY) , ZFAC10(JPLAY) , ZFAC11(JPLAY)
75 REAL(KIND=JPRB) :: ZTBOUND , ZONEMINUS , ZRMU0 , ZADJI0
76 REAL(KIND=JPRB) :: ZALBD(KSW) , ZALBP(KSW)
77
78 REAL(KIND=JPRB) :: ZFRCL(KCOLS,JPLAY), ZTAUC(JPLAY,KCOLS), ZASYC(JPLAY,KCOLS), ZOMGC(JPLAY,KCOLS)
79 REAL(KIND=JPRB) :: ZTAUA(JPLAY,KSW), ZASYA(JPLAY,KSW), ZOMGA(JPLAY,KSW)
80
81 REAL(KIND=JPRB) :: ZBBCD(JPLAY+1), ZBBCU(JPLAY+1), ZBBFD(JPLAY+1), ZBBFU(JPLAY+1)
82 !REAL(KIND=JPRB) :: ZUVCD(JPLAY+1), ZUVCU(JPLAY+1), ZUVFD(JPLAY+1), ZUVFU(JPLAY+1)
83 !REAL(KIND=JPRB) :: ZVSCD(JPLAY+1), ZVSCU(JPLAY+1), ZVSFD(JPLAY+1), ZVSFU(JPLAY+1)
84 !REAL(KIND=JPRB) :: ZNICD(JPLAY+1), ZNICU(JPLAY+1), ZNIFD(JPLAY+1), ZNIFU(JPLAY+1)
85
86 INTEGER(KIND=JPIM) :: ILAYTROP, ILAYSWTCH, ILAYLOW
87 INTEGER(KIND=JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
88 INTEGER(KIND=JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
89
90 REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol)
91 REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol)
92 REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol)
93 REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol)
94 REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol)
95 REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol)
96 REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3
97 REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2
98 REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole)
99 REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/sec2)
100 REAL(KIND=JPRB) :: ZAMM
101
102 REAL(KIND=JPRB) :: RAMW ! Molecular weight of water vapor (g/mol)
103 REAL(KIND=JPRB) :: RAMCO2 ! Molecular weight of carbon dioxide (g/mol)
104 REAL(KIND=JPRB) :: RAMO ! Molecular weight of ozone (g/mol)
105 REAL(KIND=JPRB) :: RAMCH4 ! Molecular weight of methane (g/mol)
106 REAL(KIND=JPRB) :: RAMN2O ! Molecular weight of nitrous oxide (g/mol)
107
108 ! Atomic weights for conversion from mass to volume mixing ratios; these
109 ! are the same values used in ECRT to assure accurate conversion to vmr
110 data ZAMD / 28.970_JPRB /
111 data ZAMW / 18.0154_JPRB /
112 data ZAMCO2 / 44.011_JPRB /
113 data ZAMO / 47.9982_JPRB /
114 data ZAMCH4 / 16.043_JPRB /
115 data ZAMN2O / 44.013_JPRB /
116 data ZAMC11 / 137.3686_JPRB /
117 data ZAMC12 / 120.9140_JPRB /
118 data ZAVGDRO/ 6.02214E23_JPRB /
119 data ZGRAVIT/ 9.80665E02_JPRB /
120 data RAMW / 0.05550_JPRB /
121 data RAMCO2 / 0.02272_JPRB /
122 data RAMO / 0.02083_JPRB /
123 data RAMCH4 / 0.06233_JPRB /
124 data RAMN2O / 0.02272_JPRB /
125
126
127 REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
128
129 INTEGER(KIND=JPIM) :: IOVLP
130 REAL(KIND=JPRB) :: ZHOOK_HANDLE
131
132
133 INTERFACE
134 SUBROUTINE SRTM_SETCOEF&
135 & ( KLEV , KNMOL ,&
136 & PAVEL , PTAVEL , PZ , PTZ , PTBOUND ,&
137 & PCOLDRY , PWKL ,&
138 & KLAYTROP, KLAYSWTCH, KLAYLOW ,&
139 & PCO2MULT, PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLN2O , PCOLO2 , PCOLO3 ,&
140 & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
141 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
142 & KJP , KJT , KJT1&
143 & )
144 USE PARKIND1 ,ONLY : JPIM ,JPRB
145 USE PARSRTM , ONLY : JPLAY
146 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
147 INTEGER(KIND=JPIM) :: KNMOL
148 REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(JPLAY)
149 REAL(KIND=JPRB) ,INTENT(IN) :: PTAVEL(JPLAY)
150 REAL(KIND=JPRB) :: PZ(0:JPLAY)
151 REAL(KIND=JPRB) ,INTENT(IN) :: PTZ(0:JPLAY)
152 REAL(KIND=JPRB) ,INTENT(IN) :: PTBOUND
153 REAL(KIND=JPRB) ,INTENT(IN) :: PCOLDRY(JPLAY)
154 REAL(KIND=JPRB) ,INTENT(IN) :: PWKL(35,JPLAY)
155 INTEGER(KIND=JPIM),INTENT(OUT) :: KLAYTROP
156 INTEGER(KIND=JPIM),INTENT(OUT) :: KLAYSWTCH
157 INTEGER(KIND=JPIM),INTENT(OUT) :: KLAYLOW
158 REAL(KIND=JPRB) ,INTENT(OUT) :: PCO2MULT(JPLAY)
159 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLCH4(JPLAY)
160 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLCO2(JPLAY)
161 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLH2O(JPLAY)
162 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLMOL(JPLAY)
163 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLN2O(JPLAY)
164 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLO2(JPLAY)
165 REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLO3(JPLAY)
166 REAL(KIND=JPRB) ,INTENT(OUT) :: PFORFAC(JPLAY)
167 REAL(KIND=JPRB) ,INTENT(OUT) :: PFORFRAC(JPLAY)
168 INTEGER(KIND=JPIM),INTENT(OUT) :: KINDFOR(JPLAY)
169 REAL(KIND=JPRB) ,INTENT(OUT) :: PSELFFAC(JPLAY)
170 REAL(KIND=JPRB) ,INTENT(OUT) :: PSELFFRAC(JPLAY)
171 INTEGER(KIND=JPIM),INTENT(OUT) :: KINDSELF(JPLAY)
172 REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC00(JPLAY)
173 REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC01(JPLAY)
174 REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC10(JPLAY)
175 REAL(KIND=JPRB) ,INTENT(OUT) :: PFAC11(JPLAY)
176 INTEGER(KIND=JPIM),INTENT(OUT) :: KJP(JPLAY)
177 INTEGER(KIND=JPIM),INTENT(OUT) :: KJT(JPLAY)
178 INTEGER(KIND=JPIM),INTENT(OUT) :: KJT1(JPLAY)
179 END SUBROUTINE SRTM_SETCOEF
180 END INTERFACE
181 INTERFACE
182 SUBROUTINE SRTM_SPCVRT_MCICA&
183 & ( KLEV , KMOL , KSW , KCOLS , PONEMINUS,&
184 & PAVEL , PTAVEL , PZ , PTZ , PTBOUND , PALBD , PALBP,&
185 & PFRCL , PTAUC , PASYC , POMGC , PTAUA , PASYA , POMGA , PRMU0,&
186 & PCOLDRY , PWKL,&
187 & KLAYTROP, KLAYSWTCH, KLAYLOW ,&
188 & PCO2MULT, PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLN2O , PCOLO2 , PCOLO3 ,&
189 & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
190 & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
191 & KJP , KJT , KJT1 ,&
192 & PBBFD, PBBFU, PBBCD, PBBCU )
193 USE PARKIND1 ,ONLY : JPIM ,JPRB
194 USE PARSRTM , ONLY : JPLAY, JPB1, JPB2, JPGPT
195 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
196 INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
197 INTEGER(KIND=JPIM) :: KLEV
198 INTEGER(KIND=JPIM) :: KMOL
199 REAL(KIND=JPRB) :: PONEMINUS
200 REAL(KIND=JPRB) :: PAVEL(JPLAY)
201 REAL(KIND=JPRB) :: PTAVEL(JPLAY)
202 REAL(KIND=JPRB) :: PZ(0:JPLAY)
203 REAL(KIND=JPRB) :: PTZ(0:JPLAY)
204 REAL(KIND=JPRB) :: PTBOUND
205 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KSW)
206 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KSW)
207 REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KCOLS,JPLAY)
208 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(JPLAY,KCOLS)
209 REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(JPLAY,KCOLS)
210 REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(JPLAY,KCOLS)
211 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUA(JPLAY,KSW)
212 REAL(KIND=JPRB) ,INTENT(IN) :: PASYA(JPLAY,KSW)
213 REAL(KIND=JPRB) ,INTENT(IN) :: POMGA(JPLAY,KSW)
214 REAL(KIND=JPRB) :: PRMU0
215 REAL(KIND=JPRB) :: PCOLDRY(JPLAY)
216 REAL(KIND=JPRB) :: PWKL(35,JPLAY)
217 INTEGER(KIND=JPIM) :: KLAYTROP
218 INTEGER(KIND=JPIM) :: KLAYSWTCH
219 INTEGER(KIND=JPIM) :: KLAYLOW
220 REAL(KIND=JPRB) :: PCO2MULT(JPLAY)
221 REAL(KIND=JPRB) :: PCOLCH4(JPLAY)
222 REAL(KIND=JPRB) :: PCOLCO2(JPLAY)
223 REAL(KIND=JPRB) :: PCOLH2O(JPLAY)
224 REAL(KIND=JPRB) :: PCOLMOL(JPLAY)
225 REAL(KIND=JPRB) :: PCOLN2O(JPLAY)
226 REAL(KIND=JPRB) :: PCOLO2(JPLAY)
227 REAL(KIND=JPRB) :: PCOLO3(JPLAY)
228 REAL(KIND=JPRB) :: PFORFAC(JPLAY)
229 REAL(KIND=JPRB) :: PFORFRAC(JPLAY)
230 INTEGER(KIND=JPIM) :: KINDFOR(JPLAY)
231 REAL(KIND=JPRB) :: PSELFFAC(JPLAY)
232 REAL(KIND=JPRB) :: PSELFFRAC(JPLAY)
233 INTEGER(KIND=JPIM) :: KINDSELF(JPLAY)
234 REAL(KIND=JPRB) :: PFAC00(JPLAY)
235 REAL(KIND=JPRB) :: PFAC01(JPLAY)
236 REAL(KIND=JPRB) :: PFAC10(JPLAY)
237 REAL(KIND=JPRB) :: PFAC11(JPLAY)
238 INTEGER(KIND=JPIM) :: KJP(JPLAY)
239 INTEGER(KIND=JPIM) :: KJT(JPLAY)
240 INTEGER(KIND=JPIM) :: KJT1(JPLAY)
241 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFD(JPLAY+1)
242 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFU(JPLAY+1)
243 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCD(JPLAY+1)
244 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCU(JPLAY+1)
245 END SUBROUTINE SRTM_SPCVRT_MCICA
246 END INTERFACE
247 !MPL/IM 20160915 on prend GES de phylmd
248 ! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $
249 !
250 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
251 ! veillez \`a n'utiliser que des ! pour les commentaires
252 ! et \`a bien positionner les & des lignes de continuation
253 ! (les placer en colonne 6 et en colonne 73)
254 !
255 !..include cles_phys.h
256 !
257 INTEGER iflag_cycle_diurne
258 LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf
259 LOGICAL ok_limitvrai
260 LOGICAL ok_all_xml
261 LOGICAL ok_lwoff
262 INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
263 REAL co2_ppm, co2_ppm0, solaire
264 !FC
265 REAL Cd_frein
266 LOGICAL ok_suntime_rrtm
267 REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12
268 REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act
269 REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
270 !IM ajout CFMIP2/CMIP5
271 REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
272 REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per
273
274 !OM ---> correction du bilan d'eau global
275 !OM Correction sur precip KE
276 REAL cvl_corr
277 !OM Fonte calotte dans bilan eau
278 LOGICAL ok_lic_melt
279 !OB Depot de vapeur d eau sur la calotte pour le bilan eau
280 LOGICAL ok_lic_cond
281
282 !IM simulateur ISCCP
283 INTEGER top_height, overlap
284 !IM seuils cdrm, cdrh
285 REAL cdmmax, cdhmax
286 !IM param. stabilite s/ terres et en dehors
287 REAL ksta, ksta_ter, f_ri_cd_min
288 !IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
289 LOGICAL ok_kzmin
290 !IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif -
291 ! pour regler l albedo sur ocean
292 REAL pbl_lmixmin_alpha
293 REAL fmagic, pmagic
294 ! Hauteur (imposee) du contenu en eau du sol
295 REAL qsol0,albsno0,evap0
296 ! Frottement au sol (Cdrag)
297 Real f_cdrag_ter,f_cdrag_oce
298 REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce
299 REAL z0m_seaice,z0h_seaice
300 INTEGER iflag_gusts,iflag_z0_oce
301
302 ! Rugoro
303 Real f_rugoro,z0min
304
305 ! tau_gl : constante de rappel de la temperature a la surface de la glace
306 REAL tau_gl
307
308 !IM lev_histhf : niveau sorties 6h
309 !IM lev_histday : niveau sorties journalieres
310 !IM lev_histmth : niveau sorties mensuelles
311 !IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien
312 ! sur 17 niveaux de pression
313 INTEGER lev_histhf, lev_histday, lev_histmth
314 INTEGER lev_histdayNMC
315 Integer lev_histins, lev_histLES
316 !IM ok_histNMC : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
317 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
318 !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
319 LOGICAL ok_histNMC(3)
320 INTEGER levout_histNMC(3)
321 REAL freq_outNMC(3) , freq_calNMC(3)
322 CHARACTER(len=4) type_run
323 ! aer_type: pour utiliser un fichier constant dans readaerosol
324 CHARACTER(len=8) :: aer_type
325 LOGICAL ok_regdyn
326 REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
327 REAL ecrit_ins, ecrit_hf, ecrit_day
328 REAL ecrit_mth, ecrit_tra, ecrit_reg
329 REAL ecrit_LES
330 REAL freq_ISCCP, ecrit_ISCCP
331 REAL freq_COSP, freq_AIRS
332 LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
333 LOGICAL :: ok_airs
334 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
335 LOGICAL :: ok_chlorophyll
336 LOGICAL :: ok_strato
337 LOGICAL :: ok_hines, ok_gwd_rando
338 LOGICAL :: ok_qch4
339 LOGICAL :: ok_conserv_q
340 LOGICAL :: adjust_tropopause
341 LOGICAL :: ok_daily_climoz
342 ! flag to bypass or not the phytrac module
343 INTEGER :: iflag_phytrac
344
345 COMMON/clesphys/ &
346 ! REAL FIRST
347 & co2_ppm, solaire &
348 & , RCO2, RCH4, RN2O, RCFC11, RCFC12 &
349 & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act &
350 & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per &
351 & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
352 & , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per &
353 & , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha &
354 & , fmagic, pmagic &
355 & , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl &
356 & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce &
357 & , z0m_seaice,z0h_seaice &
358 & , freq_outNMC, freq_calNMC &
359 & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins &
360 & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS &
361 & , cvl_corr &
362 & , qsol0,albsno0,evap0 &
363 & , co2_ppm0 &
364 !FC
365 & , Cd_frein &
366 & , ecrit_LES &
367 & , ecrit_ins, ecrit_hf, ecrit_day &
368 & , ecrit_mth, ecrit_tra, ecrit_reg &
369 ! THEN INTEGER AND LOGICALS
370 & , top_height &
371 & , iflag_cycle_diurne, soil_model, new_oliq &
372 & , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad &
373 & , iflag_con, nbapp_cv, nbapp_wk &
374 & , iflag_ener_conserv &
375 & , ok_suntime_rrtm &
376 & , overlap &
377 & , ok_kzmin &
378 & , lev_histhf, lev_histday, lev_histmth &
379 & , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC &
380 & , ok_histNMC &
381 & , type_run, ok_regdyn, ok_cosp, ok_airs &
382 & , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP &
383 & , ip_ebil_phy &
384 & , iflag_gusts ,iflag_z0_oce &
385 & , ok_lic_melt, ok_lic_cond, aer_type &
386 & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 &
387 & , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo &
388 & , ok_chlorophyll,ok_conserv_q, adjust_tropopause &
389 & , ok_daily_climoz, ok_all_xml, ok_lwoff &
390 & , iflag_phytrac
391
392 save /clesphys/
393 !$OMP THREADPRIVATE(/clesphys/)
394
395 !-----------------------------------------------------------------------
396 !-- calculate information needed ny the radiative transfer routine
397
398 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
399 ZEPSEC = 1.E-06_JPRB
400 ZONEMINUS=1.0_JPRB - ZEPSEC
401 ZADJI0 = RII0 / RI0
402 !-- overlap: 1=max-ran, 2=maximum, 3=random
403 IOVLP=3
404
405 !print *,'Entering srtm_srtm_224gp_mcica'
406
407 ICLDATM = 1
408 INFLAG = 2
409 ICEFLAG = 3
410 I_LIQFLAG= 1
411 ITMOL = 6
412 I_NSTR = 2
413
414 DO JL = KIDIA, KFDIA
415 ZRMU0=PRMU0(JL)
416 IF (ZRMU0 > 0.0_JPRB) THEN
417
418 !- coefficients related to the cloud optical properties (original RRTM_SW)
419
420 ! print *,'just before SRTM_CLDPROP'
421
422 ! DO JK=1,KLEV
423 ! CLDFRAC(JK) = PFRCL (JL,JK)
424 ! CLDDAT1(JK) = PSCLA1(JL,JK)
425 ! CLDDAT2(JK) = PSCLA2(JL,JK)
426 ! CLDDAT3(JK) = PSCLA3(JL,JK)
427 ! CLDDAT4(JK) = PSCLA4(JL,JK)
428 ! DO JMOM=0,16
429 ! CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
430 ! ENDDO
431 ! print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
432 ! &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
433 9101 format(1x,'srtm_srtm_224gp Cld :',I3,f7.4,7E12.5)
434 ! ENDDO
435
436 ! CALL SRTM_CLDPROP &
437 ! &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
438 ! &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
439 ! &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
440 ! &)
441
442 !- coefficients for the temperature and pressure dependence of the
443 ! molecular absorption coefficients
444
445 DO J1=1,35
446 DO J2=1,KLEV
447 ZWKL(J1,J2)=0.0_JPRB
448 ENDDO
449 ENDDO
450
451 ZTBOUND=PTS(JL)
452 ZPZ(0) = paph(JL,klev+1)*0.01_JPRB
453 ZTZ(0) = pth (JL,klev+1)
454
455 ZCLEAR=1.0_JPRB
456 ZCLOUD=0.0_JPRB
457 ZTOTCC=0.0_JPRB
458 DO JK = 1, KLEV
459 ZPAVEL(JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
460 ZTAVEL(JK) = pt (JL,KLEV-JK+1)
461 ZPZ(JK) = paph(JL,KLEV-JK+1) *0.01_JPRB
462 ZTZ(JK) = pth (JL,KLEV-JK+1)
463 ZWKL(1,JK) = pq(JL,KLEV-JK+1) *ZAMD*RAMW
464 ZWKL(2,JK) = pcco2 *ZAMD*RAMCO2
465 ZWKL(3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*RAMO
466 ZWKL(4,JK) = rn2o *ZAMD*RAMN2O
467 ZWKL(6,JK) = rch4 *ZAMD*RAMCH4
468 ZAMM = (1-ZWKL(1,JK))*ZAMD + ZWKL(1,JK)*ZAMW
469 ZCOLDRY(JK) = (ZPZ(JK-1)-ZPZ(JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1+ZWKL(1,JK)))
470 ! print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
471 9200 format(1x,'SRTM ',I3,2F7.1,6E13.5)
472
473
474
475 ENDDO
476
477 ! print *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
478
479 DO IMOL=1,ITMOL
480 DO JK=1,KLEV
481 ZWKL(IMOL,JK)=ZCOLDRY(JK)* ZWKL(IMOL,JK)
482 ENDDO
483 ENDDO
484
485 ! print *,'just before SRTM_SETCOEF'
486
487 CALL SRTM_SETCOEF &
488 & ( KLEV , ITMOL,&
489 & ZPAVEL , ZTAVEL , ZPZ , ZTZ , ZTBOUND,&
490 & ZCOLDRY , ZWKL,&
491 & ILAYTROP, ILAYSWTCH, ILAYLOW,&
492 & ZCO2MULT, ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLN2O , ZCOLO2 , ZCOLO3,&
493 & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, &
494 & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,&
495 & JP , JT , JT1 &
496 & )
497
498 ! print *,'just after SRTM_SETCOEF'
499
500 !- call the radiation transfer routine
501
502 DO JSW=1,KSW
503 ZALBD(JSW)=PALBD(JL,JSW)
504 ZALBP(JSW)=PALBP(JL,JSW)
505 ENDDO
506
507 DO JSW=1,KCOLS
508 DO JK=1,KLEV
509 ZFRCL(JSW,JK) = PFRCL(JL,JSW,JK)
510 ZTAUC(JK,JSW) = PTAUC(JL,JSW,JK)
511 ZASYC(JK,JSW) = PASYC(JL,JSW,JK)
512 ZOMGC(JK,JSW) = POMGC(JL,JSW,JK)
513
514 !---- security: might have to be moved upstream to radlswr -------
515 ! IF(ZTAUC(JK,JSW) == 0._JPRB) ZFRCL(JSW,JK) = 0._JPRB
516 !-----------------------------------------------------------------
517
518
519 ! IF (ZFRCL(JSW,JK) /= 0._JPRB) THEN
520 ! print 9002,JSW,JK,ZFRCL(JSW,JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
521 9002 format(1x,'srtm_224gp_McICA ClOPropECmodel ',2I3,f8.4,3E12.5)
522 ! ENDIF
523 ENDDO
524 ENDDO
525
526 !- mixing of aerosols
527
528 ! print *,'Aerosol optical properties computations'
529 ! DO JSW=1,KSW
530 ! print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
531 9012 format(I3,(/,I3,3E13.5))
532 ! ENDDO
533
534 ! DO JK=1,KLEV
535 ! print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
536 9013 format(1x,I3,6E12.5)
537 ! ENDDO
538
539 IF (NAER == 0) THEN
540 DO JSW=1,KSW
541 DO JK=1,KLEV
542 ZTAUA(JK,JSW)= 0.0_JPRB
543 ZASYA(JK,JSW)= 0.0_JPRB
544 ZOMGA(JK,JSW)= 1.0_JPRB
545 ENDDO
546 ENDDO
547 ELSE
548 DO JSW=1,KSW
549 DO JK=1,KLEV
550 IK=KLEV+1-JK
551 ZTAUA(JK,JSW)=0.0_JPRB
552 ZASYA(JK,JSW)=0.0_JPRB
553 ZOMGA(JK,JSW)=0.0_JPRB
554 DO JAE=1,6
555 ZTAUA(JK,JSW)=ZTAUA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
556 ZOMGA(JK,JSW)=ZOMGA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
557 & *RSRPIZA(JSW,JAE)
558 ZASYA(JK,JSW)=ZASYA(JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
559 & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE)
560 ENDDO
561 IF (ZOMGA(JK,JSW) /= 0.0_JPRB) THEN
562 ZASYA(JK,JSW)=ZASYA(JK,JSW)/ZOMGA(JK,JSW)
563 ENDIF
564 IF (ZTAUA(JK,JSW) /= 0.0_JPRB) THEN
565 ZOMGA(JK,JSW)=ZOMGA(JK,JSW)/ZTAUA(JK,JSW)
566 ENDIF
567 ! print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
568 9003 format(1x,'Aerosols ',2I3,3F10.4)
569 ENDDO
570 ENDDO
571 ENDIF
572
573 DO JK=1,KLEV+1
574 ZBBCU(JK)=0.0_JPRB
575 ZBBCD(JK)=0.0_JPRB
576 ZBBFU(JK)=0.0_JPRB
577 ZBBFD(JK)=0.0_JPRB
578 ! ZUVCU(JK)=0.0_JPRB
579 ! ZUVCD(JK)=0.0_JPRB
580 ! ZUVFU(JK)=0.0_JPRB
581 ! ZUVFD(JK)=0.0_JPRB
582 ! ZVSCU(JK)=0.0_JPRB
583 ! ZVSCD(JK)=0.0_JPRB
584 ! ZVSFU(JK)=0.0_JPRB
585 ! ZVSFD(JK)=0.0_JPRB
586 ! ZNICU(JK)=0.0_JPRB
587 ! ZNICD(JK)=0.0_JPRB
588 ! ZNIFU(JK)=0.0_JPRB
589 ! ZNIFD(JK)=0.0_JPRB
590 ENDDO
591
592 ! print *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
593
594 CALL SRTM_SPCVRT_MCICA &
595 &( KLEV , ITMOL , KSW , KCOLS , ZONEMINUS,&
596 & ZPAVEL , ZTAVEL , ZPZ , ZTZ , ZTBOUND , ZALBD , ZALBP,&
597 & ZFRCL , ZTAUC , ZASYC , ZOMGC , ZTAUA , ZASYA , ZOMGA , ZRMU0,&
598 & ZCOLDRY , ZWKL ,&
599 & ILAYTROP, ILAYSWTCH, ILAYLOW,&
600 & ZCO2MULT, ZCOLCH4 , ZCOLCO2, ZCOLH2O , ZCOLMOL , ZCOLN2O, ZCOLO2 , ZCOLO3,&
601 & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
602 & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,&
603 & JP , JT , JT1 ,&
604 & ZBBFD , ZBBFU , ZBBCD , ZBBCU )
605
606 ! & ZBBFD , ZBBFU , ZUVFD , ZUVFU , ZVSFD , ZVSFU , ZNIFD , ZNIFU,&
607 ! & ZBBCD , ZBBCU , ZUVCD , ZUVCU , ZVSCD , ZVSCU , ZNICD , ZNICU &
608 ! & )
609
610 ! print *,'SRTM_SRTM_224GP before potential scaling'
611 ! IF (IOVLP == 3) THEN
612 ! DO JK=1,KLEV+1
613 !! print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
614 9004 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
615 ! PFSUC(JL,1,JK)=ZBBCU(JK)
616 ! PFSUC(JL,2,JK)=ZBBCD(JK)
617 ! PFSUX(JL,1,JK)=ZBBFU(JK)
618 ! PFSUX(JL,2,JK)=ZBBFD(JK)
619 ! ENDDO
620 ! ELSE
621 ! print *,'SRTM_SRTM_224GP after potential scaling'
622 DO JK=1,KLEV+1
623 PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK)
624 PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK)
625 PFSUX(JL,1,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFU(JK)+ZCLEAR*ZBBCU(JK) )
626 PFSUX(JL,2,JK)=ZADJI0 * ( (1.0_JPRB-ZCLEAR)*ZBBFD(JK)+ZCLEAR*ZBBCD(JK) )
627 !-- for testing only
628 PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JK)
629 PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JK)
630 PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JK)
631 PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JK)
632 ENDDO
633 ! ENDIF
634
635 ! DO JK=1,KLEV+1
636 ! print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
637 9005 format(1x,'Clear-sky and total fluxes U & D ',I3,4F10.3)
638 ! ENDDO
639
640 ELSE
641 DO JK=1,KLEV+1
642 PFSUC(JL,1,JK)=0.0_JPRB
643 PFSUC(JL,2,JK)=0.0_JPRB
644 PFSUX(JL,1,JK)=0.0_JPRB
645 PFSUX(JL,2,JK)=0.0_JPRB
646 ENDDO
647 ENDIF
648 ENDDO
649
650 !PRINT *,'OUT OF SRTM_224GP_MCICA'
651
652 !-----------------------------------------------------------------------
653 IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
654 END SUBROUTINE SRTM_SRTM_224GP_MCICA
655