LMDZ
srtm_spcvrt_mcica.F90
Go to the documentation of this file.
1 #ifdef RS6K
2 @process hot nostrict
3 #endif
4 SUBROUTINE srtm_spcvrt_mcica &
5  & ( klev , kmol , ksw , kcols , poneminus, &
6  & pavel , ptavel , pz , ptz , ptbound , palbd , palbp, &
7  & pfrcl , ptauc , pasyc , pomgc , ptaua , pasya , pomga , prmu0, &
8  & pcoldry , pwkl, &
9  & klaytrop, klayswtch, klaylow ,&
10  & pco2mult, pcolch4 , pcolco2 , pcolh2o , pcolmol , pcoln2o , pcolo2 , pcolo3 ,&
11  & pforfac , pforfrac , kindfor , pselffac, pselffrac, kindself ,&
12  & pfac00 , pfac01 , pfac10 , pfac11 ,&
13  & kjp , kjt , kjt1 ,&
14 !-- output arrays
15  & pbbfd, pbbfu, pbbcd, pbbcu )
16 
17 ! & PBBFD, PBBFU, PUVFD, PUVFU, PVSFD, PVSFU , PNIFD , PNIFU ,&
18 ! & PBBCD, PBBCU, PUVCD, PUVCU, PVSCD, PVSCU , PNICD , PNICU &
19 ! & )
20 
21 !**** *SRTM_SPCVRT* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
22 
23 ! PURPOSE.
24 ! --------
25 
26 ! THIS ROUTINE COMPUTES THE TWO-STREAM METHOD OF BARKER
27 
28 !** INTERFACE.
29 ! ----------
30 
31 ! *SRTM_SPCVRT_MCICA* IS CALLED FROM *SRTM_SRTM_224GP*
32 
33 ! IMPLICIT ARGUMENTS :
34 ! --------------------
35 
36 ! ==== INPUTS ===
37 ! ==== OUTPUTS ===
38 
39 ! METHOD.
40 ! -------
41 
42 ! EXTERNALS.
43 ! ----------
44 
45 ! *SWVRTQDR*
46 
47 ! REFERENCE.
48 ! ----------
49 
50 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
51 ! DOCUMENTATION
52 ! AUTHOR.
53 ! -------
54 ! from Howard Barker
55 ! JEAN-JACQUES MORCRETTE *ECMWF*
56 
57 ! MODIFICATIONS.
58 ! --------------
59 ! ORIGINAL : 03-02-27
60 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
61 ! JJMorcrette 20050110 McICA version
62 ! ------------------------------------------------------------------
63 
64 USE parkind1 ,ONLY : jpim ,jprb
65 USE yomhook ,ONLY : lhook, dr_hook
66 
67 USE parsrtm , ONLY : jplay, jpb1, jpb2, jpgpt
68 
69 USE yoesrtwn , ONLY : ngc
70 USE yoerdi , ONLY : repclc
71 
72 !USE YOERAD , ONLY : NSW
73 !USE YOERDU , ONLY : RCDAY
74 !USE YOESWN , ONLY : NTBANDS, NBANDS, NGS, NUV, NVS, RWGT, NDBUG
75 
76 IMPLICIT NONE
77 
78 ! ------------------------------------------------------------------
79 
80 !* 0.1 ARGUMENTS
81 ! ---------
82 
83 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
84 INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
85 
86 INTEGER(KIND=JPIM) :: KLEV ! UNDETERMINED INTENT
87 INTEGER(KIND=JPIM) :: KMOL ! Argument NOT used
88 !INTEGER(KIND=JPIM) :: KPT
89 
90 REAL(KIND=JPRB) :: PONEMINUS ! UNDETERMINED INTENT
91 REAL(KIND=JPRB) :: PAVEL(jplay) ! Argument NOT used
92 REAL(KIND=JPRB) :: PTAVEL(jplay) ! Argument NOT used
93 REAL(KIND=JPRB) :: PZ(0:jplay) ! Argument NOT used
94 REAL(KIND=JPRB) :: PTZ(0:jplay) ! Argument NOT used
95 REAL(KIND=JPRB) :: PTBOUND ! Argument NOT used
96 REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(ksw)
97 REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(ksw)
98 REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(kcols,jplay) ! bottom to top
99 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(jplay,kcols) ! bottom to top
100 REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(jplay,kcols) ! bottom to top
101 REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(jplay,kcols) ! bottom to top
102 REAL(KIND=JPRB) ,INTENT(IN) :: PTAUA(jplay,ksw) ! bottom to top
103 REAL(KIND=JPRB) ,INTENT(IN) :: PASYA(jplay,ksw) ! bottom to top
104 REAL(KIND=JPRB) ,INTENT(IN) :: POMGA(jplay,ksw) ! bottom to top
105 REAL(KIND=JPRB) :: PRMU0 ! UNDETERMINED INTENT
106 REAL(KIND=JPRB) :: PCOLDRY(jplay) ! Argument NOT used
107 REAL(KIND=JPRB) :: PWKL(35,jplay) ! Argument NOT used
108 INTEGER(KIND=JPIM) :: KLAYTROP ! UNDETERMINED INTENT
109 INTEGER(KIND=JPIM) :: KLAYSWTCH ! Argument NOT used
110 INTEGER(KIND=JPIM) :: KLAYLOW ! Argument NOT used
111 REAL(KIND=JPRB) :: PCO2MULT(jplay) ! Argument NOT used
112 REAL(KIND=JPRB) :: PCOLCH4(jplay) ! UNDETERMINED INTENT
113 REAL(KIND=JPRB) :: PCOLCO2(jplay) ! UNDETERMINED INTENT
114 REAL(KIND=JPRB) :: PCOLH2O(jplay) ! UNDETERMINED INTENT
115 REAL(KIND=JPRB) :: PCOLMOL(jplay) ! UNDETERMINED INTENT
116 REAL(KIND=JPRB) :: PCOLN2O(jplay) ! Argument NOT used
117 REAL(KIND=JPRB) :: PCOLO2(jplay) ! UNDETERMINED INTENT
118 REAL(KIND=JPRB) :: PCOLO3(jplay) ! UNDETERMINED INTENT
119 REAL(KIND=JPRB) :: PFORFAC(jplay) ! UNDETERMINED INTENT
120 REAL(KIND=JPRB) :: PFORFRAC(jplay) ! UNDETERMINED INTENT
121 INTEGER(KIND=JPIM) :: KINDFOR(jplay) ! UNDETERMINED INTENT
122 REAL(KIND=JPRB) :: PSELFFAC(jplay) ! UNDETERMINED INTENT
123 REAL(KIND=JPRB) :: PSELFFRAC(jplay) ! UNDETERMINED INTENT
124 INTEGER(KIND=JPIM) :: KINDSELF(jplay) ! UNDETERMINED INTENT
125 REAL(KIND=JPRB) :: PFAC00(jplay) ! UNDETERMINED INTENT
126 REAL(KIND=JPRB) :: PFAC01(jplay) ! UNDETERMINED INTENT
127 REAL(KIND=JPRB) :: PFAC10(jplay) ! UNDETERMINED INTENT
128 REAL(KIND=JPRB) :: PFAC11(jplay) ! UNDETERMINED INTENT
129 INTEGER(KIND=JPIM) :: KJP(jplay) ! UNDETERMINED INTENT
130 INTEGER(KIND=JPIM) :: KJT(jplay) ! UNDETERMINED INTENT
131 INTEGER(KIND=JPIM) :: KJT1(jplay) ! UNDETERMINED INTENT
132 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFD(jplay+1)
133 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFU(jplay+1)
134 !REAL(KIND=JPRB) :: PUVFD(JPLAY+1) ! Argument NOT used
135 !REAL(KIND=JPRB) :: PUVFU(JPLAY+1) ! Argument NOT used
136 !REAL(KIND=JPRB) :: PVSFD(JPLAY+1) ! Argument NOT used
137 !REAL(KIND=JPRB) :: PVSFU(JPLAY+1) ! Argument NOT used
138 !REAL(KIND=JPRB) :: PNIFD(JPLAY+1) ! Argument NOT used
139 !REAL(KIND=JPRB) :: PNIFU(JPLAY+1) ! Argument NOT used
140 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCD(jplay+1)
141 REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCU(jplay+1)
142 !REAL(KIND=JPRB) :: PUVCD(JPLAY+1) ! Argument NOT used
143 !REAL(KIND=JPRB) :: PUVCU(JPLAY+1) ! Argument NOT used
144 !REAL(KIND=JPRB) :: PVSCD(JPLAY+1) ! Argument NOT used
145 !REAL(KIND=JPRB) :: PVSCU(JPLAY+1) ! Argument NOT used
146 !REAL(KIND=JPRB) :: PNICD(JPLAY+1) ! Argument NOT used
147 !REAL(KIND=JPRB) :: PNICU(JPLAY+1) ! Argument NOT used
148 ! ------------------------------------------------------------------
149 
150 ! ------------
151 
152 LOGICAL :: LLRTCHK(jplay)
153 
154 REAL(KIND=JPRB) :: &
155  & ZCLEAR , ZCLOUD &
156  & , ZDBT(JPLAY+1) &
157  & , ZGCC(JPLAY) , ZGCO(JPLAY) &
158  & , ZOMCC(JPLAY) , ZOMCO(JPLAY) &
159  & , ZRDND(JPLAY+1), ZRDNDC(JPLAY+1)&
160  & , ZREF(JPLAY+1) , ZREFC(JPLAY+1) , ZREFO(JPLAY+1) &
161  & , ZREFD(JPLAY+1), ZREFDC(JPLAY+1), ZREFDO(JPLAY+1) &
162  & , ZRUP(JPLAY+1) , ZRUPD(JPLAY+1) &
163  & , ZRUPC(JPLAY+1), ZRUPDC(JPLAY+1)&
164  & , ZTAUC(JPLAY) , ZTAUO(JPLAY) &
165  & , ZTDBT(JPLAY+1) &
166  & , ZTRA(JPLAY+1) , ZTRAC(JPLAY+1) , ZTRAO(JPLAY+1) &
167  & , ZTRAD(JPLAY+1), ZTRADC(JPLAY+1), ZTRADO(JPLAY+1)
168 REAL(KIND=JPRB) :: &
169  & ZDBTC(JPLAY+1), ZTDBTC(JPLAY+1), ZINCFLX(JPGPT) &
170  & , ZINCF14(14) , ZINCTOT
171 
172 INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IKL, IW, JB, JG, JK, I_KMODTS
173 
174 REAL(KIND=JPRB) :: ZARG1, ZARG2, ZDBTMC, ZDBTMO, ZF, ZINCFLUX, ZWF
175 
176 !-- Output of SRTM_TAUMOLn routines
177 
178 REAL(KIND=JPRB) :: ZTAUG(jplay,16), ZTAUR(jplay,16), ZSFLXZEN(16)
179 
180 !-- Output of SRTM_VRTQDR routine
181 REAL(KIND=JPRB) :: &
182  & ZCD(JPLAY+1,JPGPT), ZCU(JPLAY+1,JPGPT) &
183  & , ZFD(JPLAY+1,JPGPT), ZFU(JPLAY+1,JPGPT)
184 REAL(KIND=JPRB) :: ZHOOK_HANDLE
185 
186 
187 #include "srtm_taumol16.intfb.h"
188 #include "srtm_taumol17.intfb.h"
189 #include "srtm_taumol18.intfb.h"
190 #include "srtm_taumol19.intfb.h"
191 #include "srtm_taumol20.intfb.h"
192 #include "srtm_taumol21.intfb.h"
193 #include "srtm_taumol22.intfb.h"
194 #include "srtm_taumol23.intfb.h"
195 #include "srtm_taumol24.intfb.h"
196 #include "srtm_taumol25.intfb.h"
197 #include "srtm_taumol26.intfb.h"
198 #include "srtm_taumol27.intfb.h"
199 #include "srtm_taumol28.intfb.h"
200 #include "srtm_taumol29.intfb.h"
201 #include "srtm_reftra.intfb.h"
202 #include "srtm_vrtqdr.intfb.h"
203 ! ------------------------------------------------------------------
204 IF (lhook) CALL dr_hook('SRTM_SPCVRT_MCICA',0,zhook_handle)
205 
206 !-- Two-stream model 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discret ordinates
207 ! KMODTS is set in SWREFTRA
208 !NDBUG=4
209 
210 ib1=jpb1
211 ib2=jpb2
212 !print *,'IB1, IB2, KSW, KMOL, KLEV: ', IB1,IB2,KSW,KMOL,KLEV
213 
214 iw=0
215 zincflux=0.0_jprb
216 zinctot=0.0_jprb
217 
218 jb=ib1-1
219 DO jb = ib1, ib2
220  ibm = jb-15
221  igt = ngc(ibm)
222  zincf14(ibm)=0.0_jprb
223 
224 ! print *,'=== spectral band === JB= ',JB,' ====== i.e. IBM= ',IBM,' with IGT= ',IGT
225 
226 !-- for each band, computes the gaseous and Rayleigh optical thickness
227 ! for all g-points within the band
228 
229  IF (jb == 16) THEN
230  CALL srtm_taumol16 &
231  & ( klev ,&
232  & pfac00 , pfac01 , pfac10 , pfac11 ,&
233  & kjp , kjt , kjt1 , poneminus,&
234  & pcolh2o , pcolch4 , pcolmol ,&
235  & klaytrop, pselffac , pselffrac, kindself, pforfac , pforfrac, kindfor ,&
236  & zsflxzen, ztaug , ztaur &
237  & )
238 ! print *,'After SRTM_TAUMOL16'
239 
240  ELSEIF (jb == 17) THEN
241  CALL srtm_taumol17 &
242  & ( klev ,&
243  & pfac00 , pfac01 , pfac10 , pfac11 ,&
244  & kjp , kjt , kjt1 , poneminus ,&
245  & pcolh2o , pcolco2 , pcolmol ,&
246  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
247  & zsflxzen, ztaug , ztaur &
248  & )
249 ! print *,'After SRTM_TAUMOL17'
250 
251  ELSEIF (jb == 18) THEN
252  CALL srtm_taumol18 &
253  & ( klev ,&
254  & pfac00 , pfac01 , pfac10 , pfac11 ,&
255  & kjp , kjt , kjt1 , poneminus ,&
256  & pcolh2o , pcolch4 , pcolmol ,&
257  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
258  & zsflxzen, ztaug , ztaur &
259  & )
260 ! print *,'After SRTM_TAUMOL18'
261 
262  ELSEIF (jb == 19) THEN
263  CALL srtm_taumol19 &
264  & ( klev ,&
265  & pfac00 , pfac01 , pfac10 , pfac11 ,&
266  & kjp , kjt , kjt1 , poneminus ,&
267  & pcolh2o , pcolco2 , pcolmol ,&
268  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
269  & zsflxzen, ztaug , ztaur &
270  & )
271 ! print *,'After SRTM_TAUMOL19'
272 
273  ELSEIF (jb == 20) THEN
274  CALL srtm_taumol20 &
275  & ( klev ,&
276  & pfac00 , pfac01 , pfac10 , pfac11 ,&
277  & kjp , kjt , kjt1 , poneminus ,&
278  & pcolh2o , pcolch4 , pcolmol ,&
279  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
280  & zsflxzen, ztaug , ztaur &
281  & )
282 ! print *,'After SRTM_TAUMOL20'
283 
284  ELSEIF (jb == 21) THEN
285  CALL srtm_taumol21 &
286  & ( klev ,&
287  & pfac00 , pfac01 , pfac10 , pfac11 ,&
288  & kjp , kjt , kjt1 , poneminus ,&
289  & pcolh2o , pcolco2 , pcolmol ,&
290  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
291  & zsflxzen, ztaug , ztaur &
292  & )
293 ! print *,'After SRTM_TAUMOL21'
294 
295  ELSEIF (jb == 22) THEN
296  CALL srtm_taumol22 &
297  & ( klev ,&
298  & pfac00 , pfac01 , pfac10 , pfac11 ,&
299  & kjp , kjt , kjt1 , poneminus ,&
300  & pcolh2o , pcolmol , pcolo2 ,&
301  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
302  & zsflxzen, ztaug , ztaur &
303  & )
304 ! print *,'After SRTM_TAUMOL22'
305 
306  ELSEIF (jb == 23) THEN
307  CALL srtm_taumol23 &
308  & ( klev ,&
309  & pfac00 , pfac01 , pfac10 , pfac11 ,&
310  & kjp , kjt , kjt1 , poneminus ,&
311  & pcolh2o , pcolmol ,&
312  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
313  & zsflxzen, ztaug , ztaur &
314  & )
315 ! print *,'After SRTM_TAUMOL23'
316 
317  ELSEIF (jb == 24) THEN
318  CALL srtm_taumol24 &
319  & ( klev ,&
320  & pfac00 , pfac01 , pfac10 , pfac11 ,&
321  & kjp , kjt , kjt1 , poneminus ,&
322  & pcolh2o , pcolmol , pcolo2 , pcolo3 ,&
323  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
324  & zsflxzen, ztaug , ztaur &
325  & )
326 ! print *,'After SRTM_TAUMOL24'
327 
328  ELSEIF (jb == 25) THEN
329 !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
330  CALL srtm_taumol25 &
331  & ( klev ,&
332  & pfac00 , pfac01 , pfac10 , pfac11 ,&
333  & kjp , kjt , kjt1 , poneminus ,&
334  & pcolh2o , pcolmol , pcolo3 ,&
335  & klaytrop ,&
336  & zsflxzen, ztaug , ztaur &
337  & )
338 ! print *,'After SRTM_TAUMOL25'
339 
340  ELSEIF (jb == 26) THEN
341 !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
342  CALL srtm_taumol26 &
343  & ( klev ,&
344  & pfac00 , pfac01 , pfac10 , pfac11 ,&
345  & kjp , kjt , kjt1 , poneminus ,&
346  & pcolh2o , pcolco2 , pcolmol ,&
347  & klaytrop, pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
348  & zsflxzen, ztaug , ztaur &
349  & )
350 ! print *,'After SRTM_TAUMOL26'
351 
352  ELSEIF (jb == 27) THEN
353 !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
354  CALL srtm_taumol27 &
355  & ( klev ,&
356  & pfac00 , pfac01 , pfac10 , pfac11 ,&
357  & kjp , kjt , kjt1 , poneminus ,&
358  & pcolmol , pcolo3 ,&
359  & klaytrop ,&
360  & zsflxzen, ztaug , ztaur &
361  & )
362 ! print *,'After SRTM_TAUMOL27'
363 
364  ELSEIF (jb == 28) THEN
365 !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
366  CALL srtm_taumol28 &
367  & ( klev ,&
368  & pfac00 , pfac01 , pfac10 , pfac11 ,&
369  & kjp , kjt , kjt1 , poneminus ,&
370  & pcolmol , pcolo2 , pcolo3 ,&
371  & klaytrop ,&
372  & zsflxzen, ztaug , ztaur &
373  & )
374 ! print *,'After SRTM_TAUMOL28'
375 
376  ELSEIF (jb == 29) THEN
377  CALL srtm_taumol29 &
378  & ( klev ,&
379  & pfac00 , pfac01 , pfac10 , pfac11 ,&
380  & kjp , kjt , kjt1 , poneminus ,&
381  & pcolh2o , pcolco2 , pcolmol ,&
382  & klaytrop , pselffac, pselffrac, kindself , pforfac, pforfrac, kindfor ,&
383  & zsflxzen , ztaug , ztaur &
384  & )
385 ! print *,'After SRTM_TAUMOL29'
386 
387  ENDIF
388 
389 ! IF (NDBUG.LE.3) THEN
390 ! print *,'Incident Solar Flux'
391 ! PRINT 9010,(ZSFLXZEN(JG),JG=1,16)
392  9010 format(1x,'SolFlx ',16f8.4)
393 ! print *,'Optical thickness for molecular absorption for JB= ',JB
394 ! DO JK=1,KLEV
395 ! PRINT 9011,JK,(ZTAUG(JK,JG),JG=1,16)
396  9011 format(1x,'TauGas ',i3,16e9.2)
397 ! ENDDO
398 ! print *,'Optical thickness for Rayleigh scattering for JB= ',JB
399 ! DO JK=1,KLEV
400 ! PRINT 9012,JK,(ZTAUR(JK,JG),JG=1,16)
401  9012 format(1x,'TauRay ',i3,16e9.2)
402 ! ENDDO
403 ! ENDIF
404 
405  DO jg=1,igt
406  iw=iw+1
407 
408 ! IF (NDBUG.LE.1) THEN
409 ! print *,' === JG= ',JG,' === for JB= ',JB,' with IW, IBM, JPLAY, KLEV=',IW,IBM,JPLAY,KLEV
410 ! ENDIF
411 ! IF (NDBUG.LE.3) THEN
412 ! print *,'Cloud optical properties for JB= ',JB
413 ! DO JK=1,KLEV
414 ! PRINT 9013,JK,PFRCL(IW,JK),PTAUC(JK,IW),POMGC(JK,IW),PASYC(JK,IW)
415  9013 format(1x,'Cloud optprop ',i3,f8.4,f8.3,2f8.5)
416 ! ENDDO
417 ! ENDIF
418 
419  zincflx(iw) =zsflxzen(jg)*prmu0
420  zincflux =zincflux+zsflxzen(jg)*prmu0
421  zinctot =zinctot+zsflxzen(jg)
422  zincf14(ibm)=zincf14(ibm)+zsflxzen(jg)
423 
424 !-- CALL to compute layer reflectances and transmittances for direct
425 ! and diffuse sources, first clear then cloudy.
426 ! Use direct/parallel albedo for direct radiation and diffuse albedo
427 ! otherwise.
428 
429 ! ZREFC(JK) direct albedo for clear
430 ! ZREFO(JK) direct albedo for cloud
431 ! ZREFDC(JK) diffuse albedo for clear
432 ! ZREFDO(JK) diffuse albedo for cloud
433 ! ZTRAC(JK) direct transmittance for clear
434 ! ZTRAO(JK) direct transmittance for cloudy
435 ! ZTRADC(JK) diffuse transmittance for clear
436 ! ZTRADO(JK) diffuse transmittance for cloudy
437 
438 ! ZREF(JK) direct reflectance
439 ! ZREFD(JK) diffuse reflectance
440 ! ZTRA(JK) direct transmittance
441 ! ZTRAD(JK) diffuse transmittance
442 
443 ! ZDBTC(JK) clear direct beam transmittance
444 ! ZDBTO(JK) cloudy direct beam transmittance
445 ! ZDBT(JK) layer mean direct beam transmittance
446 ! ZTDBT(JK) total direct beam transmittance at levels
447 
448 !-- clear-sky
449 !----- TOA direct beam
450  ztdbtc(1)=1._jprb
451 !----- surface values
452  zdbtc(klev+1) =0.0_jprb
453  ztrac(klev+1) =0.0_jprb
454  ztradc(klev+1)=0.0_jprb
455  zrefc(klev+1) =palbp(ibm)
456  zrefdc(klev+1)=palbd(ibm)
457  zrupc(klev+1) =palbp(ibm)
458  zrupdc(klev+1)=palbd(ibm)
459 
460 !-- total sky
461 !----- TOA direct beam
462  ztdbt(1)=1._jprb
463 !----- surface values
464  zdbt(klev+1) =0.0_jprb
465  ztra(klev+1) =0.0_jprb
466  ztrad(klev+1)=0.0_jprb
467  zref(klev+1) =palbp(ibm)
468  zrefd(klev+1)=palbd(ibm)
469  zrup(klev+1) =palbp(ibm)
470  zrupd(klev+1)=palbd(ibm)
471 ! if (NDBUG < 2) print *,'SWSPCTRL after 1 with JB,JG,IBM and IW= ',JB,JG,IBM,IW
472 
473 
474 !-- NB: a two-stream calculations from top to bottom, but RRTM_SW quantities
475 ! are given bottom to top (argh!)
476 ! Inputs for clouds and aerosols are bottom to top as inputs
477 
478  DO jk=1,klev
479  ikl=klev+1-jk
480 
481 !-- clear-sky optical parameters
482  llrtchk(jk)=.true.
483 
484 ! print 9000,JK,JG,IKL,ZTAUR(IKL,JG),ZTAUG(IKL,JG),PTAUC(IKL,IW)
485  9000 format(1x,'Cloud quantities ',3i4,3e12.5)
486 
487 !-- original
488 ! ZTAUC(JK)=ZTAUR(IKL,JG)+ZTAUG(IKL,JG)
489 ! ZOMCC(JK)=ZTAUR(IKL,JG)/ZTAUC(JK)
490 ! ZGCC (JK)=0.0001_JPRB
491 
492 !-- total sky optical parameters
493 ! ZTAUO(JK)=ZTAUR(IKL,JG)+ZTAUG(IKL,JG)+PTAUC(IKL,IW)
494 ! ZOMCO(JK)=PTAUC(IKL,IW)*POMGC(IKL,IW)+ZTAUR(IKL,JG)
495 ! ZGCO (JK)=(PTAUC(IKL,IW)*POMGC(IKL,IW)*PASYC(IKL,IW) &
496 ! & +ZTAUR(IKL,JG)*0.0001_JPRB)/ZOMCO(JK)
497 ! ZOMCO(JK)=ZOMCO(JK)/ZTAUO(JK)
498 
499 !-- clear-sky optical parameters including aerosols
500  ztauc(jk) = ztaur(ikl,jg) + ztaug(ikl,jg) + ptaua(ikl,ibm)
501  zomcc(jk) = ztaur(ikl,jg)*1.0_jprb + ptaua(ikl,ibm)*pomga(ikl,ibm)
502  zgcc(jk) = pasya(ikl,ibm)*pomga(ikl,ibm)*ptaua(ikl,ibm) / zomcc(jk)
503  zomcc(jk) = zomcc(jk) / ztauc(jk)
504 
505  ENDDO
506  DO jk=1,klev
507  ikl=klev+1-jk
508 !-- total sky optical parameters
509  ztauo(jk) = ztaur(ikl,jg) + ztaug(ikl,jg) + ptaua(ikl,ibm) + ptauc(ikl,iw)
510  zomco(jk) = ptaua(ikl,ibm)*pomga(ikl,ibm) + ptauc(ikl,iw)*pomgc(ikl,iw) &
511  & + ztaur(ikl,jg)*1.0_jprb
512  zgco(jk) = (ptauc(ikl,iw)*pomgc(ikl,iw)*pasyc(ikl,iw) &
513  & + ptaua(ikl,ibm)*pomga(ikl,ibm)*pasya(ikl,ibm)) &
514  & / zomco(jk)
515  zomco(jk) = zomco(jk) / ztauo(jk)
516 
517 ! if (NDBUG <2) THEN
518 ! print 9001,JK,JG,LRTCHK(JK),0.00,ZTAUC(JK),ZOMCC(JK),ZGCC(JK),ZTAUR(IKL,JG),ZTAUG(IKL,JG)
519  9001 format(1x,'clear :',2i3,l4,7(1x,e13.6))
520 ! print 9002,JK,JG,LRTCHK(JK),PFRCL(IW,IKL),ZTAUO(JK),ZOMCO(JK),ZGCO(JK) &
521 ! &,PTAUC(IKL,IW),POMGC(IKL,IW),PASYC(IKL,IW)
522  9002 format(1x,'total0:',2i3,l4,7(1x,e13.6))
523 ! end if
524  ENDDO
525 ! if (NDBUG < 2) print *,'SWSPCTRL after 2'
526 
527 !-- Delta scaling for clear-sky / aerosol optical quantities
528  DO jk=1,klev
529  zf=zgcc(jk)*zgcc(jk)
530  zwf=zomcc(jk)*zf
531  ztauc(jk)=(1._jprb-zwf)*ztauc(jk)
532  zomcc(jk)=(zomcc(jk)-zwf)/(1.0_jprb-zwf)
533  zgcc(jk)=(zgcc(jk)-zf)/(1.0_jprb-zf)
534  ENDDO
535 
536  CALL srtm_reftra ( klev, i_kmodts ,&
537  & llrtchk, zgcc , prmu0, ztauc , zomcc ,&
538  & zrefc , zrefdc, ztrac, ztradc )
539 ! if (NDBUG < 2) print *,'SWSPCTR after SWREFTRA for clear-sky'
540 
541 !-- Delta scaling for cloudy quantities
542  DO jk=1,klev
543  ikl=klev+1-jk
544  llrtchk(jk)=.false.
545  zf=zgco(jk)*zgco(jk)
546  zwf=zomco(jk)*zf
547  ztauo(jk)=(1._jprb-zwf)*ztauo(jk)
548  zomco(jk)=(zomco(jk)-zwf)/(1._jprb-zwf)
549  zgco(jk)=(zgco(jk)-zf)/(1._jprb-zf)
550  llrtchk(jk)=(pfrcl(iw,ikl) > repclc)
551 
552 ! if (NDBUG < 2) THEN
553 ! print 9003,JK,LRTCHK(JK),PFRCL(IW,IKL),ZTAUO(JK),ZOMCO(JK),ZGCO(JK) &
554 ! &,PTAUC(IKL,IW),POMGC(IKL,IW),PASYC(IKL,IW)
555  9003 format(1x,'totalD:',i3,l4,7(1x,e13.6))
556 ! end if
557 
558  ENDDO
559 ! if (NDBUG < 2) print *,'SWSPCTR after Delta scaling'
560 
561  CALL srtm_reftra ( klev, i_kmodts ,&
562  & llrtchk, zgco , prmu0, ztauo , zomco ,&
563  & zrefo , zrefdo, ztrao, ztrado )
564 ! if (NDBUG < 2) print *,'SWSPCTR after SWREFTRA for cloudy'
565 
566  DO jk=1,klev
567 
568 !-- combine clear and cloudy contributions for total sky
569 
570  ikl=klev+1-jk
571  zclear = 1.0_jprb - pfrcl(iw,ikl)
572  zcloud = pfrcl(iw,ikl)
573 
574  zref(jk) = zclear*zrefc(jk) + zcloud*zrefo(jk)
575  zrefd(jk)= zclear*zrefdc(jk)+ zcloud*zrefdo(jk)
576  ztra(jk) = zclear*ztrac(jk) + zcloud*ztrao(jk)
577  ztrad(jk)= zclear*ztradc(jk)+ zcloud*ztrado(jk)
578 
579 !-- direct beam transmittance
580  zarg1 = min( 200._jprb, ztauc(jk)/prmu0 )
581  zarg2 = min( 200._jprb, ztauo(jk)/prmu0 )
582 ! if (PRMU0 <= 0.05_JPRB ) THEN
583 ! print 9198,JB,IW,JK,PRMU0,ZTAUC(JK),ZTAUO(JK),PTAUC(IKL,IW),ZARG1,ZARG2,ZCLEAR,ZCLOUD,ZTDBT(JK),PFRCL(IW,IKL)
584 9198 format(1x,'Dbg:',3i4,10e13.6)
585 ! print 9198,KPT,JB,IW,JK,ZTAUC(JK),ZTAUO(JK),ZARG1,ZARG2,ZCLEAR,ZCLOUD,ZTDBT(JK),PFRCL(IW,IKL)
586 !9198 format(1x,'Dbg:',4I4,9E13.6)
587 ! endif
588  zdbtmc = exp(-zarg1 )
589  zdbtmo = exp(-zarg2 )
590  zdbt(jk) = zclear*zdbtmc+zcloud*zdbtmo
591  ztdbt(jk+1)= zdbt(jk)*ztdbt(jk)
592 
593 !-- clear-sky
594  zdbtc(jk) =zdbtmc
595  ztdbtc(jk+1)=zdbtc(jk)*ztdbtc(jk)
596 
597 
598  IF (prmu0 <= 0.05_jprb) THEN
599 ! if (NDBUG < 2) print 9200,JK,ZREFC(JK),ZREFDC(JK),ZTRAC(JK),ZTRADC(JK),ZDBTC(JK),ZTDBTC(JK+1)
600 ! if (NDBUG < 2) print 9199,JK,ZREF(JK),ZREFD(JK),ZTRA(JK),ZTRAD(JK),ZDBT(JK),ZTDBT(JK+1)
601 ! print 9200,JK,ZREFC(JK),ZREFDC(JK),ZTRAC(JK),ZTRADC(JK),ZDBTC(JK),ZTDBTC(JK+1),ZCLEAR,ZCLOUD,PRMU0
602 ! print 9199,JK,ZREF (JK),ZREFD (JK),ZTRA (JK),ZTRAD (JK),ZDBT (JK),ZTDBT (JK+1),ZTAUC(JK),ZTAUO(JK)
603  ENDIF
604  9199 format(1x,'Comb total:',i3,9e13.6)
605  9200 format(1x,'Comb clear:',i3,9e13.6)
606 
607  ENDDO
608 ! if (NDBUG < 2) print *,'SRTM_SPCVRT after combining clear and cloudy'
609 
610 !-- vertical quadrature producing clear-sky fluxes
611 
612 ! print *,'SRTM_SPCVRT after 3 before SRTM_VRTQDR clear'
613 
614  CALL srtm_vrtqdr ( klev, iw ,&
615  & zrefc, zrefdc, ztrac , ztradc ,&
616  & zdbtc, zrdndc, zrupc , zrupdc, ztdbtc ,&
617  & zcd , zcu )
618 
619 ! IF (NDBUG < 2) THEN
620 ! print *,'SRTM_SPCVRT out of SRTM_VRTQDR for clear IW=',IW
621 ! DO JK=1,KLEV+1
622 ! print 9201,JK,ZCD(JK,IW),ZCU(JK,IW)
623  9201 format(1x,'clear-sky contrib to fluxes',i3,2f12.4)
624 ! ENDDO
625 ! ENDIF
626 
627 !-- vertical quadrature producing cloudy fluxes
628 
629 ! print *,'SRTM_SPCVRT after 4 before SRTM_VRTQDR cloudy'
630 
631  CALL srtm_vrtqdr ( klev, iw ,&
632  & zref , zrefd , ztra , ztrad ,&
633  & zdbt , zrdnd , zrup , zrupd , ztdbt ,&
634  & zfd , zfu )
635 
636 ! IF (NDBUG < 2) THEN
637 ! print *,'SRTM_SPCVRT out of SRTM_VRTQDR for cloudy IW=',IW
638 ! DO JK=1,KLEV+1
639 ! print 9202,JK,ZFD(JK,IW),ZFU(JK,IW)
640  9202 format(1x,'cloudy sky contrib to fluxes',i3,2f12.4)
641 ! ENDDO
642 ! ENDIF
643 
644 !-- up and down-welling fluxes at levels
645  DO jk=1,klev+1
646 !-- accumulation of spectral fluxes
647  pbbfu(jk) = pbbfu(jk) + zincflx(iw)*zfu(jk,iw)
648  pbbfd(jk) = pbbfd(jk) + zincflx(iw)*zfd(jk,iw)
649  pbbcu(jk) = pbbcu(jk) + zincflx(iw)*zcu(jk,iw)
650  pbbcd(jk) = pbbcd(jk) + zincflx(iw)*zcd(jk,iw)
651 
652 ! to get NIR, visible and UV quantities
653 
654 ! PBBFU(JK)=PBBFU(JK)+RWGT(IW)*ZFU(JK,IW)
655 ! PBBFD(JK)=PBBFD(JK)+RWGT(IW)*ZFD(JK,IW)
656 ! PBBCU(JK)=PBBCU(JK)+RWGT(IW)*ZCU(JK,IW)
657 ! PBBCD(JK)=PBBCD(JK)+RWGT(IW)*ZCD(JK,IW)
658 ! IF (IW <= NUV) THEN
659 ! PUVFD(JK)=PUVFD(JK)+RWGT(IW)*ZFD(JK,IW)
660 ! PUVFU(JK)=PUVFU(JK)+RWGT(IW)*ZFU(JK,IW)
661 ! PUVCD(JK)=PUVCD(JK)+RWGT(IW)*ZCD(JK,IW)
662 ! PUVCU(JK)=PUVCU(JK)+RWGT(IW)*ZCU(JK,IW)
663 ! ELSE IF (IW == NUV+1 .AND. IW <= NVS) THEN
664 ! PVSFD(JK)=PVSFD(JK)+RWGT(IW)*ZFD(JK,IW)
665 ! PVSFU(JK)=PVSFU(JK)+RWGT(IW)*ZFU(JK,IW)
666 ! PVSCD(JK)=PVSCD(JK)+RWGT(IW)*ZCD(JK,IW)
667 ! PVSCU(JK)=PVSCU(JK)+RWGT(IW)*ZCU(JK,IW)
668 ! ELSE IF (IW > NVS) THEN
669 ! PNIFD(JK)=PNIFD(JK)+RWGT(IW)*ZFD(JK,IW)
670 ! PNIFU(JK)=PNIFU(JK)+RWGT(IW)*ZFU(JK,IW)
671 ! PNICD(JK)=PNICD(JK)+RWGT(IW)*ZCD(JK,IW)
672 ! PNICU(JK)=PNICU(JK)+RWGT(IW)*ZCU(JK,IW)
673 ! ENDIF
674 ! if (NDBUG < 2) then
675 !! if (JG.EQ.IGT) THEN
676 ! print 9206,JB,JG,JK,IW,PBBCU(JK),PBBCD(JK),PBBFU(JK),PBBFD(JK)
677  9206 format(1x,'fluxes up to:',3i3,i4,6e13.6)
678 ! end if
679  ENDDO
680 
681 ! if (NDBUG < 2) print *,'SRTM_SPCVRT end of JG=',JG,' for JB=',JB,' i.e. IW=',IW
682  ENDDO
683 !-- end loop on JG
684 
685 ! print *,' --- JB= ',JB,' with IB1, IB2= ',IB1,IB2
686 ENDDO
687 !-- end loop on JB
688 !if (NDBUG < 2) print *,'SRTM_SPCVRT about to come out'
689 !print *,'SRTM_SPCVRT about to come out'
690 
691 !DO IBM=1,14
692 ! print 9301,IBM,ZINCF14(IBM), ZINCTOT, ZINCF14(IBM)/ZINCTOT
693 9301 format(1x,'Incident Spectral Flux: ',i3,2e15.8,f12.8)
694 !ENDDO
695 
696 ! ------------------------------------------------------------------
697 IF (lhook) CALL dr_hook('SRTM_SPCVRT_MCICA',1,zhook_handle)
698 END SUBROUTINE srtm_spcvrt_mcica
srtm_taumol26
subroutine srtm_taumol26(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCO2, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol26.F90:9
parsrtm::jpb2
integer(kind=jpim), parameter jpb2
Definition: parsrtm.F90:25
srtm_reftra
subroutine srtm_reftra(KLEV, KMODTS, LDRTCHK, PGG, PRMUZ, PTAU, PW, PREF, PREFD, PTRA, PTRAD)
Definition: srtm_reftra.F90:10
srtm_taumol23
subroutine srtm_taumol23(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol23.F90:9
srtm_taumol19
subroutine srtm_taumol19(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCO2, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol19.F90:9
parsrtm::jplay
integer(kind=jpim), parameter jplay
Definition: parsrtm.F90:19
srtm_taumol25
subroutine srtm_taumol25(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLMOL, P_COLO3, K_LAYTROP, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol25.F90:9
srtm_taumol18
subroutine srtm_taumol18(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCH4, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol18.F90:9
srtm_taumol24
subroutine srtm_taumol24(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLMOL, P_COLO2, P_COLO3, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol24.F90:9
srtm_spcvrt_mcica
subroutine srtm_spcvrt_mcica(KLEV, KMOL, KSW, KCOLS, PONEMINUS,PAVEL, PTAVEL, PZ, PTZ, PTBOUND, PALBD, PALBP,PFRCL, PTAUC, PASYC, POMGC, PTAUA, PASYA, POMGA, PRMU0,PCOLDRY, PWKL,KLAYTROP, KLAYSWTCH, KLAYLOW,PCO2MULT, PCOLCH4, PCOLCO2, PCOLH2O, PCOLMOL, PCOLN2O, PCOLO2, PCOLO3,PFORFAC, PFORFRAC, KINDFOR, PSELFFAC, PSELFFRAC, KINDSELF,PFAC00, PFAC01, PFAC10, PFAC11,KJP, KJT, KJT1,
Definition: srtm_spcvrt_mcica.F90:15
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
srtm_taumol17
subroutine srtm_taumol17(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCO2, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol17.F90:9
yoerdi
Definition: yoerdi.F90:1
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
srtm_taumol22
subroutine srtm_taumol22(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLMOL, P_COLO2, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol22.F90:9
srtm_taumol29
subroutine srtm_taumol29(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCO2, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol29.F90:9
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
parsrtm::jpgpt
integer(kind=jpim), parameter jpgpt
Definition: parsrtm.F90:27
srtm_taumol27
subroutine srtm_taumol27(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLMOL, P_COLO3, K_LAYTROP, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol27.F90:9
x
!$Header!c c INCLUDE fxyprim h c c c Fonctions in line c c REAL fyprim REAL rj c c il faut la calculer avant d appeler ces fonctions c c c Fonctions a changer selon x(x) et y(y) choisis.c-----------------------------------------------------------------c c.....ici
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
srtm_taumol21
subroutine srtm_taumol21(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCO2, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol21.F90:9
srtm_taumol16
subroutine srtm_taumol16(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCH4, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol16.F90:9
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
srtm_vrtqdr
subroutine srtm_vrtqdr(KLEV, KW, PREF, PREFD, PTRA, PTRAD, PDBT, PRDND, PRUP, PRUPD, PTDBT, PFD, PFU)
Definition: srtm_vrtqdr.F90:10
srtm_taumol28
subroutine srtm_taumol28(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLMOL, P_COLO2, P_COLO3, K_LAYTROP, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol28.F90:9
yoerdi::repclc
real(kind=jprb) repclc
Definition: yoerdi.F90:21
srtm_taumol20
subroutine srtm_taumol20(KLEV, P_FAC00, P_FAC01, P_FAC10, P_FAC11, K_JP, K_JT, K_JT1, P_ONEMINUS, P_COLH2O, P_COLCH4, P_COLMOL, K_LAYTROP, P_SELFFAC, P_SELFFRAC, K_INDSELF, P_FORFAC, P_FORFRAC, K_INDFOR, P_SFLUXZEN, P_TAUG, P_TAUR)
Definition: srtm_taumol20.F90:9
yoesrtwn::ngc
integer(kind=jpim), dimension(14) ngc
Definition: yoesrtwn.F90:25
parsrtm::jpb1
integer(kind=jpim), parameter jpb1
Definition: parsrtm.F90:24