source: LMDZ6/trunk/libf/phylmd/ecrad.v1.5.1/srtm_srtm_224gp_mcica.F90.or @ 5134

Last change on this file since 5134 was 3908, checked in by idelkadi, 4 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 15.1 KB
Line 
1SUBROUTINE SRTM_SRTM_224GP_MCICA &
2 & ( KIDIA, KFDIA, KLON , KLEV , KSW  , KCOLS , KCLDLY ,&
3 &   PAER , PALBD, PALBP, PAPH , PAP  , PAERTAUS, PAERASYS, PAEROMGS ,&
4 &   PTS  , PTH  , PT   ,&
5 &   PQ   , PCO2 , PCH4 , PN2O , PNO2 , POZN  , PRMU0 ,&
6 &   PFRCL, PTAUC, PASYC, POMGC,&
7 &   PFSUX, PFSUC, PFUVF, PFUVC, PPARF, PPARCF, PSUDU ,&
8 &   PFDIR, PCDIR, PFDIF, PCDIF, PSwDiffuseBand, PSwDirectBand, RII0) 
9
10!----compiled for Cray with -h nopaattern----
11
12!-- interface to RRTM_SW
13!     JJMorcrette 030225
14!     JJMorcrette 20050110  McICA version
15!     JJMorcrette 20070614  bug-fix for solar duration
16!     JJMorcrette 20071015  3D fields of CO2, CH4, N2O and NO2
17!     D.Salmond  31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
18!     JJMorcrette 20091201  Total and clear-sky downward direct flux
19!     PBechtold+NSemane  09-Jul-2012 Gravity
20!     R J Hogan   20140627  Passing through PSwDn*SurfBand
21
22USE PARKIND1 , ONLY : JPIM, JPRB
23USE YOMHOOK  , ONLY : LHOOK, DR_HOOK
24USE YOMCST   , ONLY : RG, RI0
25USE YOERAD   , ONLY : NSW, NAER, LApproxSwUpdate
26USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
27USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL
28!USE YOMPHY3  , ONLY : RII0
29USE YOMDYNCORE,ONLY : RPLRG
30USE YOM_YGFL , ONLY : YGFL
31
32IMPLICIT NONE
33
34!-- Input arguments
35
36INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
37INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
38INTEGER(KIND=JPIM),INTENT(IN)    :: KSW 
39INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
40INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
41INTEGER(KIND=JPIM),INTENT(IN)    :: KCOLS
42INTEGER(KIND=JPIM),INTENT(IN)    :: KCLDLY(KCOLS)
43
44REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)    ! top to bottom
45REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERTAUS(KLON,KLEV,14), PAERASYS(KLON,KLEV,14), PAEROMGS(KLON,KLEV,14)
46REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: PCO2(KLON,KLEV), PCH4(KLON,KLEV)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: PN2O(KLON,KLEV), PNO2(KLON,KLEV)
56REAL(KIND=JPRB)   ,INTENT(IN)    :: POZN(KLON,KLEV)
57REAL(KIND=JPRB)   ,INTENT(IN)    :: PRMU0(KLON)
58
59REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
60REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
61REAL(KIND=JPRB)   ,INTENT(IN)    :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
62REAL(KIND=JPRB)   ,INTENT(IN)    :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
63
64!-- Output arguments
65
66REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUX(KLON,2,KLEV+1)
67REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUC(KLON,2,KLEV+1)
68REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFUVF(KLON), PFUVC(KLON), PPARF(KLON), PPARCF(KLON)
69REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KLON)
70REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDIF(KLON,KLEV+1), PCDIF(KLON,KLEV+1)
71REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFDIR(KLON,KLEV+1), PCDIR(KLON,KLEV+1)
72
73! Surface diffuse and direct downwelling shortwave flux in each
74! shortwave albedo band, used in RADINTG to update the surface fluxes
75! accounting for high-resolution albedo information
76REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDiffuseBand(KLON,NSW)
77REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSwDirectBand (KLON,NSW)
78
79REAL(KIND=JPRB)   ,INTENT(IN)    :: RII0
80!-----------------------------------------------------------------------
81
82!-- dummy integers
83
84INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
85
86INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW, JB
87
88!-- dummy reals
89
90REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV)   , ZPAVEL(KIDIA:KFDIA,KLEV)
91REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
92REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV) , ZCOLMOL(KIDIA:KFDIA,KLEV) , ZWKL(KIDIA:KFDIA,35,KLEV)
93REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV) , ZCOLCO2(KIDIA:KFDIA,KLEV)
94REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
95REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV)  , ZCOLO3(KIDIA:KFDIA,KLEV)
96REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV) , ZFORFRAC(KIDIA:KFDIA,KLEV), ZSELFFAC(KIDIA:KFDIA,KLEV)
97REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
98REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV)  , ZFAC01(KIDIA:KFDIA,KLEV)  , ZFAC10(KIDIA:KFDIA,KLEV)
99REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
100REAL(KIND=JPRB) :: ZONEMINUS(KIDIA:KFDIA)    , ZRMU0(KIDIA:KFDIA) , ZADJI0
101REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW)    , ZALBP(KIDIA:KFDIA,KSW)   
102
103REAL(KIND=JPRB) :: ZFRCL(KIDIA:KFDIA,KCOLS,KLEV), ZTAUC(KIDIA:KFDIA,KLEV,KCOLS), &
104                 & ZASYC(KIDIA:KFDIA,KLEV,KCOLS)
105REAL(KIND=JPRB) :: ZOMGC(KIDIA:KFDIA,KLEV,KCOLS)
106REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,KLEV,KSW), ZASYA(KIDIA:KFDIA,KLEV,KSW), ZOMGA(KIDIA:KFDIA,KLEV,KSW)
107REAL(KIND=JPRB) :: ZFUVF(KIDIA:KFDIA), ZFUVC(KIDIA:KFDIA), ZPARF(KIDIA:KFDIA), ZPARCF(KIDIA:KFDIA), ZSUDU(KIDIA:KFDIA)
108
109REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,KLEV+1), ZBBCU(KIDIA:KFDIA,KLEV+1), ZBBFD(KIDIA:KFDIA,KLEV+1), &
110                 & ZBBFU(KIDIA:KFDIA,KLEV+1)
111REAL(KIND=JPRB) :: ZBBFDIR(KIDIA:KFDIA,KLEV+1),ZBBCDIR(KIDIA:KFDIA,KLEV+1)
112
113! As PSw*Band but dimensioned KIDIA:KFDIA
114REAL(KIND=JPRB) :: ZSwDiffuseBand(KIDIA:KFDIA,NSW)
115REAL(KIND=JPRB) :: ZSwDirectBand (KIDIA:KFDIA,NSW)
116
117INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
118INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV), INDSELF(KIDIA:KFDIA,KLEV)
119INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV), JT(KIDIA:KFDIA,KLEV), JT1(KIDIA:KFDIA,KLEV)
120
121REAL(KIND=JPRB) :: ZAMD                  ! Effective molecular weight of dry air (g/mol)
122REAL(KIND=JPRB) :: ZAMW                  ! Molecular weight of water vapor (g/mol)
123REAL(KIND=JPRB) :: ZAMCO2                ! Molecular weight of carbon dioxide (g/mol)
124REAL(KIND=JPRB) :: ZAMO                  ! Molecular weight of ozone (g/mol)
125REAL(KIND=JPRB) :: ZAMCH4                ! Molecular weight of methane (g/mol)
126REAL(KIND=JPRB) :: ZAMN2O                ! Molecular weight of nitrous oxide (g/mol)
127REAL(KIND=JPRB) :: ZAMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
128REAL(KIND=JPRB) :: ZAMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
129REAL(KIND=JPRB) :: ZAVGDRO               ! Avogadro's number (molecules/mole)
130REAL(KIND=JPRB) :: ZGRAVIT               ! Gravitational acceleration (cm/sec2)
131REAL(KIND=JPRB) :: ZAMM(KIDIA:KFDIA)
132
133REAL(KIND=JPRB) :: ZRAMW                  ! Molecular weight of water vapor (g/mol)
134REAL(KIND=JPRB) :: ZRAMCO2                ! Molecular weight of carbon dioxide (g/mol)
135REAL(KIND=JPRB) :: ZRAMO                  ! Molecular weight of ozone (g/mol)
136REAL(KIND=JPRB) :: ZRAMCH4                ! Molecular weight of methane (g/mol)
137REAL(KIND=JPRB) :: ZRAMN2O                ! Molecular weight of nitrous oxide (g/mol)
138
139! Atomic weights for conversion from mass to volume mixing ratios; these
140!  are the same values used in ECRT to assure accurate conversion to vmr
141data ZAMD   /  28.970_JPRB    /
142data ZAMW   /  18.0154_JPRB   /
143data ZAMCO2 /  44.011_JPRB    /
144data ZAMO   /  47.9982_JPRB   /
145data ZAMCH4 /  16.043_JPRB    /
146data ZAMN2O /  44.013_JPRB    /
147data ZAMC11 / 137.3686_JPRB   /
148data ZAMC12 / 120.9140_JPRB   /
149data ZAVGDRO/ 6.02214E23_JPRB /
150data ZRAMW   /  0.05550_JPRB   /
151data ZRAMCO2 /  0.02272_JPRB   /
152data ZRAMO   /  0.02083_JPRB   /
153data ZRAMCH4 /  0.06233_JPRB    /
154data ZRAMN2O /  0.02272_JPRB    /
155
156
157!REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZTOTCC
158REAL(KIND=JPRB) :: ZEPSEC
159
160INTEGER(KIND=JPIM) :: IOVLP, IC, ICOUNT, INDEX(KIDIA:KFDIA)
161REAL(KIND=JPRB) :: ZHOOK_HANDLE
162
163
164#include "srtm_setcoef.intfb.h"
165#include "srtm_spcvrt_mcica.intfb.h"
166
167
168!-----------------------------------------------------------------------
169!-- calculate information needed ny the radiative transfer routine
170
171ASSOCIATE(NFLEVG=>KLEV, &
172 & NACTAERO=>YGFL%NACTAERO)
173IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
174ZGRAVIT =(RG/RPLRG)*1.E2_JPRB
175ZEPSEC  = 1.E-06_JPRB
176ZONEMINUS=1.0_JPRB -  ZEPSEC
177ZADJI0 = RII0 / RI0
178!-- overlap: 1=max-ran, 2=maximum, 3=random   N.B.: irrelevant in McICA version
179IOVLP=3
180
181IC=0
182DO JL = KIDIA, KFDIA
183  IF (PRMU0(JL) > 0.0_JPRB) THEN
184    IC=IC+1
185    INDEX(IC)=JL
186  ENDIF
187ENDDO
188ICOUNT=IC
189
190ICLDATM  = 1
191INFLAG   = 2
192ICEFLAG  = 3
193I_LIQFLAG= 1
194ITMOL    = 7
195I_NSTR   = 2
196
197DO JSW=1,KCOLS
198  DO JK=1,KLEV
199    DO JL = KIDIA, KFDIA
200      ZFRCL(JL,JSW,JK) = PFRCL(JL,JSW,JK)
201      ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK)
202      ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK)
203      ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK)
204    ENDDO
205  ENDDO
206ENDDO
207
208ZRMU0(KIDIA:KFDIA)=PRMU0(KIDIA:KFDIA)
209PFUVF(KIDIA:KFDIA)=0._JPRB
210PFUVC(KIDIA:KFDIA)=0._JPRB
211PPARF(KIDIA:KFDIA)=0._JPRB
212PPARCF(KIDIA:KFDIA)=0._JPRB
213
214!- coefficients related to the cloud optical properties (original RRTM_SW)
215
216!- coefficients for the temperature and pressure dependence of the
217! molecular absorption coefficients
218
219DO J1=1,35
220  DO J2=1,KLEV
221    DO IC=1,ICOUNT
222      JL=INDEX(IC)
223      ZWKL(JL,J1,J2)=0.0_JPRB
224    ENDDO
225  ENDDO
226ENDDO
227
228DO IC=1,ICOUNT
229  JL=INDEX(IC)
230  ZPZ(JL,0) = paph(JL,klev+1)*0.01_JPRB
231ENDDO
232
233!ZCLEAR=1.0_JPRB
234!ZCLOUD=0.0_JPRB
235!ZTOTCC=0.0_JPRB
236
237DO JK = 1, KLEV
238  DO IC=1,ICOUNT
239    JL=INDEX(IC)
240    ZPAVEL(JL,JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
241    ZTAVEL(JL,JK) = pt (JL,KLEV-JK+1)
242    ZPZ(JL,JK)    = paph(JL,KLEV-JK+1) *0.01_JPRB
243    ZWKL(JL,1,JK) = pq(JL,KLEV-JK+1)  *ZAMD*ZRAMW
244    ZWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD*ZRAMCO2
245    ZWKL(JL,3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*ZRAMO
246    ZWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD*ZRAMN2O
247    ZWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD*ZRAMCH4
248!O2 volume mixing ratio
249    ZWKL(JL,7,JK) = 0.20944_JPRB
250    ZAMM(JL) = (1-ZWKL(JL,1,JK))*ZAMD + ZWKL(JL,1,JK)*ZAMW
251    ZCOLDRY(JL,JK) = (ZPZ(JL,JK-1)-ZPZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM(JL)*(1+ZWKL(JL,1,JK)))
252  ENDDO
253ENDDO
254
255DO IMOL=1,ITMOL
256  DO JK=1,KLEV
257    DO IC=1,ICOUNT
258      JL=INDEX(IC)
259      ZWKL(JL,IMOL,JK)=ZCOLDRY(JL,JK)* ZWKL(JL,IMOL,JK)
260    ENDDO
261  ENDDO
262ENDDO
263
264CALL SRTM_SETCOEF &
265 & ( KIDIA , KFDIA    , KLEV,&
266 & ZPAVEL  , ZTAVEL,&
267 & ZCOLDRY , ZWKL,&
268 & ILAYTROP,&
269 & ZCOLCH4  , ZCOLCO2 , ZCOLH2O , ZCOLMOL  , ZCOLO2 , ZCOLO3,&
270 & ZFORFAC , ZFORFRAC , INDFOR  , ZSELFFAC, ZSELFFRAC, INDSELF, &
271 & ZFAC00  , ZFAC01   , ZFAC10  , ZFAC11,&
272 & JP      , JT       , JT1     , ZRMU0  &
273 & ) 
274
275!- call the radiation transfer routine
276
277DO JSW=1,KSW
278  DO IC=1,ICOUNT
279    JL=INDEX(IC)
280    ZALBD(JL,JSW)=PALBD(JL,JSW)
281    ZALBP(JL,JSW)=PALBP(JL,JSW)
282  ENDDO
283ENDDO
284
285!- mixing of aerosols
286
287IF (NAER == 0) THEN
288  DO JSW=1,KSW
289    DO JK=1,KLEV
290      DO IC=1,ICOUNT
291        JL=INDEX(IC)
292        ZTAUA(JL,JK,JSW)= 0.0_JPRB
293        ZASYA(JL,JK,JSW)= 0.0_JPRB
294        ZOMGA(JL,JK,JSW)= 1.0_JPRB
295      ENDDO
296    ENDDO
297  ENDDO
298ELSE
299
300!- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays
301
302  IF (LAERRRTM) THEN
303    IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN
304      DO JSW=1,KSW
305        DO JK=1,KLEV
306          IK=KLEV-JK+1
307          DO IC=1,ICOUNT
308            JL=INDEX(IC)
309            ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)
310            ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)
311            ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)
312          ENDDO
313        ENDDO
314      ENDDO
315
316    ELSEIF (.NOT.LAERCSTR) THEN
317      DO JSW=1,KSW
318        DO JK=1,KLEV
319          IK=KLEV-JK+1
320          DO IC=1,ICOUNT
321            JL=INDEX(IC)
322            ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)
323            ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)
324            ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)*RSRASYA(JSW,6)
325            IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
326              ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
327            ENDIF
328            IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
329              ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
330            ENDIF
331          ENDDO
332        ENDDO
333      ENDDO
334    ENDIF
335
336  ELSE
337
338!- Otherwise, fill RRTM aerosol arrays with operational ECMWF aerosols,
339!  do the mixing and distribute over the 14 spectral intervals
340
341    DO JSW=1,KSW
342      DO JK=1,KLEV
343        DO IC=1,ICOUNT
344          JL=INDEX(IC)
345          IK=KLEV+1-JK
346          ZTAUA(JL,JK,JSW)=0.0_JPRB
347          ZASYA(JL,JK,JSW)=0.0_JPRB
348          ZOMGA(JL,JK,JSW)=0.0_JPRB
349!CDIR UNROLL=6
350          DO JAE=1,6
351            ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
352            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
353             & *RSRPIZA(JSW,JAE) 
354            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
355             & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE) 
356          ENDDO
357          IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
358            ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
359          ENDIF
360          IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
361            ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
362          ENDIF
363        ENDDO
364      ENDDO
365    ENDDO
366  ENDIF
367ENDIF
368
369DO JK=1,KLEV+1
370  DO IC=1,ICOUNT
371    JL=INDEX(IC)
372    ZBBCU(JL,JK)=0.0_JPRB
373    ZBBCD(JL,JK)=0.0_JPRB
374    ZBBFU(JL,JK)=0.0_JPRB
375    ZBBFD(JL,JK)=0.0_JPRB
376    ZBBFDIR(JL,JK)=0.0_JPRB
377    ZBBCDIR(JL,JK)=0.0_JPRB
378  ENDDO
379ENDDO
380
381DO IC=1,ICOUNT
382  JL=INDEX(IC)
383  ZFUVF(JL)=0.0_JPRB
384  ZFUVC(JL)=0.0_JPRB
385  ZPARF(JL)=0.0_JPRB
386  ZPARCF(JL)=0.0_JPRB     
387  ZSUDU(JL)=0.0_JPRB
388ENDDO
389
390CALL SRTM_SPCVRT_MCICA &
391 &( KIDIA  , KFDIA    , KLEV   , KSW    , KCOLS  , ZONEMINUS,&
392 & ZALBD   , ZALBP,&
393 & ZFRCL   , ZTAUC    , ZASYC  , ZOMGC  ,&
394 & ZTAUA   , ZASYA   , ZOMGA , ZRMU0,&
395 & ILAYTROP,&
396 & ZCOLCH4 , ZCOLCO2  , ZCOLH2O, ZCOLMOL , ZCOLO2   , ZCOLO3,&
397 & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
398 & ZFAC00  , ZFAC01   , ZFAC10 , ZFAC11  ,&
399 & JP      , JT       , JT1    ,&
400 & ZBBFD   , ZBBFU    , ZBBCD  , ZBBCU , ZFUVF , ZFUVC, ZPARF, ZPARCF, ZSUDU,&
401 & ZBBFDIR , ZBBCDIR  , ZSwDiffuseBand, ZSwDirectBand)
402
403DO JK=1,KLEV+1
404  DO IC=1,ICOUNT
405    JL=INDEX(IC)
406    PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK)
407    PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK)
408    PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JL,JK)
409    PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JL,JK)
410    PFDIR(JL,JK)  =ZADJI0 * ZBBFDIR(JL,JK)
411    PCDIR(JL,JK)  =ZADJI0 * ZBBCDIR(JL,JK)
412    PFDIF(JL,JK)  =PFSUX(JL,2,JK)-PFDIR(JL,JK)
413    PCDIF(JL,JK)  =PFSUC(JL,2,JK)-PCDIR(JL,JK)
414  ENDDO
415ENDDO
416
417IF (LApproxSwUpdate) THEN
418  DO JB=1,NSW
419    DO IC=1,ICOUNT
420      JL=INDEX(IC)
421      PSwDiffuseBand(JL,JB) = ZADJI0 * ZSwDiffuseBand(JL,JB)
422      PSwDirectBand (JL,JB) = ZADJI0 * ZSwDirectBand (JL,JB)
423    ENDDO
424  ENDDO
425ENDIF
426
427DO IC=1,ICOUNT
428  JL=INDEX(IC)
429  PFUVF(JL) =ZADJI0 * ZFUVF(JL)
430  PFUVC(JL) =ZADJI0 * ZFUVC(JL)
431  PPARF(JL) =ZADJI0 * ZPARF(JL)
432  PPARCF(JL)=ZADJI0 * ZPARCF(JL)
433  PSUDU(JL) =ZADJI0 * ZSUDU(JL)
434ENDDO
435
436DO JK=1,KLEV+1
437  DO IC=1,ICOUNT
438    JL=INDEX(IC)
439    IF (PRMU0(JL) <= 0.0_JPRB) THEN
440      PFSUC(JL,1,JK)=0.0_JPRB
441      PFSUC(JL,2,JK)=0.0_JPRB
442      PFSUX(JL,1,JK)=0.0_JPRB
443      PFSUX(JL,2,JK)=0.0_JPRB
444      PFDIR(JL,JK)  =0.0_JPRB
445      PCDIR(JL,JK)  =0.0_JPRB
446    ENDIF
447  ENDDO
448ENDDO
449DO IC=1,ICOUNT
450  JL=INDEX(IC)
451  IF (PRMU0(JL) <= 0.0_JPRB) THEN
452    PFUVF(JL) =0.0_JPRB
453    PFUVC(JL) =0.0_JPRB
454    PPARF(JL) =0.0_JPRB
455    PPARCF(JL)=0.0_JPRB
456    PSUDU(JL)=0.0_JPRB
457  ENDIF
458ENDDO
459
460!-----------------------------------------------------------------------
461IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
462END ASSOCIATE
463END SUBROUTINE SRTM_SRTM_224GP_MCICA
Note: See TracBrowser for help on using the repository browser.