source: LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/srtm_srtm_224gp.F90 @ 5441

Last change on this file since 5441 was 5160, checked in by abarral, 5 months ago

Put .h into modules
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Author Date Id Revi
File size: 14.2 KB
Line 
1
2! $Id: srtm_srtm_224gp.F90 5160 2024-08-03 12:56:58Z fhourdin $
3
4SUBROUTINE SRTM_SRTM_224GP &
5        & (KIDIA, KFDIA, KLON, KLEV, KSW, KOVLP, &
6        &   PAER, PALBD, PALBP, PAPH, PAP, &
7        &   PTS, PTH, PT, &
8        &   PQ, PCCO2, POZN, PRMU0, &
9        &   PFRCL, PTAUC, PASYC, POMGC, &
10        &   PALBT, PFSUX, PFSUC &
11        &)
12
13  !-- interface to RRTM_SW
14  !     JJMorcrette 030225
15
16  USE PARKIND1, ONLY: JPIM, JPRB
17  USE YOMHOOK, ONLY: LHOOK, DR_HOOK
18
19  USE PARSRTM, ONLY: JPLAY
20  !USE YOERDI   , ONLY : RCH4   , RN2O
21  USE YOERAD, ONLY: NAER
22  USE YOESRTAER, ONLY: RSRTAUA, RSRPIZA, RSRASYA
23  USE YOMPHY3, ONLY: RII0
24  USE YOMCST, ONLY: RI0
25  USE lmdz_clesphys
26
27  IMPLICIT NONE
28
29  !-- Input arguments
30
31  INTEGER(KIND = JPIM), INTENT(IN) :: KLON
32  INTEGER(KIND = JPIM) :: KLEV! UNDETERMINED INTENT
33  INTEGER(KIND = JPIM) :: KSW! UNDETERMINED INTENT
34  INTEGER(KIND = JPIM), INTENT(IN) :: KIDIA
35  INTEGER(KIND = JPIM), INTENT(IN) :: KFDIA
36  INTEGER(KIND = JPIM), INTENT(IN) :: KOVLP
37  REAL(KIND = JPRB), INTENT(IN) :: PAER(KLON, 6, KLEV)    ! top to bottom
38  REAL(KIND = JPRB), INTENT(IN) :: PALBD(KLON, KSW)
39  REAL(KIND = JPRB), INTENT(IN) :: PALBP(KLON, KSW)
40  REAL(KIND = JPRB), INTENT(IN) :: PAPH(KLON, KLEV + 1)
41  REAL(KIND = JPRB), INTENT(IN) :: PAP(KLON, KLEV)
42  REAL(KIND = JPRB), INTENT(IN) :: PTS(KLON)
43  REAL(KIND = JPRB), INTENT(IN) :: PTH(KLON, KLEV + 1)
44  REAL(KIND = JPRB), INTENT(IN) :: PT(KLON, KLEV)
45  REAL(KIND = JPRB), INTENT(IN) :: PQ(KLON, KLEV)
46  REAL(KIND = JPRB), INTENT(IN) :: PCCO2
47  REAL(KIND = JPRB), INTENT(IN) :: POZN(KLON, KLEV)
48  REAL(KIND = JPRB), INTENT(IN) :: PRMU0(KLON)
49  REAL(KIND = JPRB), INTENT(IN) :: PFRCL(KLON, KLEV)     ! bottom to top
50  REAL(KIND = JPRB), INTENT(IN) :: PTAUC(KLON, KSW, KLEV) ! bottom to top
51  REAL(KIND = JPRB), INTENT(IN) :: PASYC(KLON, KSW, KLEV) ! bottom to top
52  REAL(KIND = JPRB), INTENT(IN) :: POMGC(KLON, KSW, KLEV) ! bottom to top
53  REAL(KIND = JPRB) :: PALBT(KLON, KSW) ! Argument NOT used
54  REAL(KIND = JPRB), INTENT(OUT) :: PFSUX(KLON, 2, KLEV + 1)
55  REAL(KIND = JPRB), INTENT(OUT) :: PFSUC(KLON, 2, KLEV + 1)
56  !INTEGER_M :: KMOL, KCLDATM, KNFLAG, KCEFLAG, KIQFLAG, KSTR
57
58  !-- Output arguments
59
60  !-----------------------------------------------------------------------
61
62  !-- dummy integers
63
64  INTEGER(KIND = JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, I_NMOL, I_NSTR
65
66  INTEGER(KIND = JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW
67
68  !-- dummy reals
69
70  REAL(KIND = JPRB) :: Z_PZ(0:JPLAY), Z_TZ(0:JPLAY), Z_PAVEL(JPLAY), Z_TAVEL(JPLAY)
71  REAL(KIND = JPRB) :: Z_COLDRY(JPLAY), Z_COLMOL(JPLAY), Z_WKL(35, JPLAY)
72  REAL(KIND = JPRB) :: Z_CO2MULT(JPLAY), Z_COLCH4(JPLAY), Z_COLCO2(JPLAY), Z_COLH2O(JPLAY)
73  REAL(KIND = JPRB) :: Z_COLN2O(JPLAY), Z_COLO2(JPLAY), Z_COLO3(JPLAY)
74  REAL(KIND = JPRB) :: Z_FORFAC(JPLAY), Z_FORFRAC(JPLAY), Z_SELFFAC(JPLAY), Z_SELFFRAC(JPLAY)
75  REAL(KIND = JPRB) :: Z_FAC00(JPLAY), Z_FAC01(JPLAY), Z_FAC10(JPLAY), Z_FAC11(JPLAY)
76  REAL(KIND = JPRB) :: Z_TBOUND, Z_ONEMINUS, ZRMU0, ZADJI0
77  REAL(KIND = JPRB) :: ZALBD(KSW), ZALBP(KSW), ZFRCL(JPLAY)
78  REAL(KIND = JPRB) :: ZTAUC(JPLAY, KSW), ZASYC(JPLAY, KSW), ZOMGC(JPLAY, KSW)
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) :: I_LAYTROP, I_LAYSWTCH, I_LAYLOW
87  INTEGER(KIND = JPIM) :: INDFOR(JPLAY), INDSELF(JPLAY)
88  INTEGER(KIND = JPIM) :: JP(JPLAY), JT(JPLAY), JT1(JPLAY)
89
90  REAL(KIND = JPRB) :: Z_AMD                  ! Effective molecular weight of dry air (g/mol)
91  REAL(KIND = JPRB) :: Z_AMW                  ! Molecular weight of water vapor (g/mol)
92  REAL(KIND = JPRB) :: Z_AMCO2                ! Molecular weight of carbon dioxide (g/mol)
93  REAL(KIND = JPRB) :: Z_AMO                  ! Molecular weight of ozone (g/mol)
94  REAL(KIND = JPRB) :: Z_AMCH4                ! Molecular weight of methane (g/mol)
95  REAL(KIND = JPRB) :: Z_AMN2O                ! Molecular weight of nitrous oxide (g/mol)
96  REAL(KIND = JPRB) :: Z_AMC11                ! Molecular weight of CFC11 (g/mol) - CFCL3
97  REAL(KIND = JPRB) :: Z_AMC12                ! Molecular weight of CFC12 (g/mol) - CF2CL2
98  REAL(KIND = JPRB) :: Z_AVGDRO               ! Avogadro's number (molecules/mole)
99  REAL(KIND = JPRB) :: Z_GRAVIT               ! Gravitational acceleration (cm/sec2)
100  REAL(KIND = JPRB) :: Z_AMM
101
102  ! Atomic weights for conversion from mass to volume mixing ratios; these
103  !  are the same values used in ECRT to assure accurate conversion to vmr
104  data Z_AMD   /  28.970_JPRB    /
105  data Z_AMW   /  18.0154_JPRB   /
106  data Z_AMCO2 /  44.011_JPRB    /
107  data Z_AMO   /  47.9982_JPRB   /
108  data Z_AMCH4 /  16.043_JPRB    /
109  data Z_AMN2O /  44.013_JPRB    /
110  data Z_AMC11 / 137.3686_JPRB   /
111  data Z_AMC12 / 120.9140_JPRB   /
112  data Z_AVGDRO/ 6.02214E23_JPRB /
113  data Z_GRAVIT/ 9.80665E02_JPRB /
114
115  REAL(KIND = JPRB) :: ZCLEAR, ZCLOUD, ZEPSEC, ZTOTCC
116
117  INTEGER(KIND = JPIM) :: IOVLP
118  REAL(KIND = JPRB) :: ZHOOK_HANDLE
119
120
121#include "srtm_setcoef.intfb.h"
122#include "srtm_spcvrt.intfb.h"
123
124
125  !-----------------------------------------------------------------------
126  !-- calculate information needed ny the radiative transfer routine
127
128  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 0, ZHOOK_HANDLE)
129  ZEPSEC = 1.E-06_JPRB
130  Z_ONEMINUS = 1.0_JPRB - ZEPSEC
131  ZADJI0 = RII0 / RI0
132  !-- overlap: 1=max-ran, 2=maximum, 3=random
133  IOVLP = 3
134
135  !PRINT *,'Entering srtm_srtm_224gp'
136
137  ICLDATM = 1
138  INFLAG = 2
139  ICEFLAG = 3
140  I_LIQFLAG = 1
141  I_NMOL = 6
142  I_NSTR = 2
143
144  DO JL = KIDIA, KFDIA
145    ZRMU0 = PRMU0(JL)
146    IF (ZRMU0 > 0.0_JPRB) THEN
147
148      !- coefficients related to the cloud optical properties (original RRTM_SW)
149
150      !  PRINT *,'just before SRTM_CLDPROP'
151
152      !  DO JK=1,KLEV
153      !    CLDFRAC(JK) = PFRCL (JL,JK)
154      !    CLDDAT1(JK) = PSCLA1(JL,JK)
155      !    CLDDAT2(JK) = PSCLA2(JL,JK)
156      !    CLDDAT3(JK) = PSCLA3(JL,JK)
157      !    CLDDAT4(JK) = PSCLA4(JL,JK)
158      !    DO JMOM=0,16
159      !      CLDDATMOM(JMOM,JK)=PSCLMOM(JL,JMOM,JK)
160      !    ENDDO
161      !    print 9101,JK,CLDFRAC(JK),CLDDAT1(JK),CLDDAT2(JK),CLDDAT3(JK)&
162      !    &,CLDDAT4(JK),(CLDDATMOM(JMOM,JK),JMOM=0,NSTR)
163      9101 format(1x, 'srtm_srtm_224gp Cld :', I3, f7.4, 7E12.5)
164      !  ENDDO
165
166      !  CALL SRTM_CLDPROP &
167      !    &( KLEV, ICLDATM, INFLAG, ICEFLAG, LIQFLAG, NSTR &
168      !    &, CLDFRAC, CLDDAT1, CLDDAT2, CLDDAT3, CLDDAT4, CLDDATMOM &
169      !    &, TAUCLDORIG, TAUCLOUD, SSACLOUD, XMOM &
170      !    &)
171
172      !- coefficients for the temperature and pressure dependence of the
173      ! molecular absorption coefficients
174
175      DO J1 = 1, 35
176        DO J2 = 1, KLEV
177          Z_WKL(J1, J2) = 0.0_JPRB
178        ENDDO
179      ENDDO
180
181      Z_TBOUND = PTS(JL)
182      Z_PZ(0) = paph(JL, klev + 1) / 100._JPRB
183      Z_TZ(0) = pth (JL, klev + 1)
184
185      ZCLEAR = 1.0_JPRB
186      ZCLOUD = 0.0_JPRB
187      ZTOTCC = 0.0_JPRB
188      DO JK = 1, KLEV
189        Z_PAVEL(JK) = pap(JL, KLEV - JK + 1) / 100._JPRB
190        Z_TAVEL(JK) = pt (JL, KLEV - JK + 1)
191        Z_PZ(JK) = paph(JL, KLEV - JK + 1) / 100._JPRB
192        Z_TZ(JK) = pth (JL, KLEV - JK + 1)
193        Z_WKL(1, JK) = pq(JL, KLEV - JK + 1) * Z_AMD / Z_AMW
194        Z_WKL(2, JK) = pcco2 * Z_AMD / Z_AMCO2
195        Z_WKL(3, JK) = pozn(JL, KLEV - JK + 1) * Z_AMD / Z_AMO
196        Z_WKL(4, JK) = rn2o * Z_AMD / Z_AMN2O
197        Z_WKL(6, JK) = rch4 * Z_AMD / Z_AMCH4
198        Z_AMM = (1 - Z_WKL(1, JK)) * Z_AMD + Z_WKL(1, JK) * Z_AMW
199        Z_COLDRY(JK) = (Z_PZ(JK - 1) - Z_PZ(JK)) * 1.E3_JPRB * Z_AVGDRO / (Z_GRAVIT * Z_AMM * (1 + Z_WKL(1, JK)))
200        !    print 9200,JK,PAVEL(JK),TAVEL(JK),(WKL(JA,JK),JA=1,4),WKL(6,JK),COLDRY(JK)
201        9200 format(1x, 'SRTM ', I3, 2F7.1, 6E13.5)
202
203        IF (KOVLP == 1) THEN
204          ZCLEAR = ZCLEAR * (1.0_JPRB - MAX(PFRCL(JL, JK), ZCLOUD)) &
205                  & / (1.0_JPRB - MIN(ZCLOUD, 1.0_JPRB - ZEPSEC))
206          ZCLOUD = PFRCL(JL, JK)
207          ZTOTCC = 1.0_JPRB - ZCLEAR
208        ELSEIF (KOVLP == 2) THEN
209          ZCLOUD = MAX(ZCLOUD, PFRCL(JL, JK))
210          ZCLEAR = 1.0_JPRB - ZCLOUD
211          ZTOTCC = ZCLOUD
212        ELSEIF (KOVLP == 3) THEN
213          ZCLEAR = ZCLEAR * (1.0_JPRB - PFRCL(JL, JK))
214          ZCLOUD = 1.0_JPRB - ZCLEAR
215          ZTOTCC = ZCLOUD
216        ENDIF
217
218      ENDDO
219
220      !  PRINT *,'ZTOTCC ZCLEAR : ',ZTOTCC,' ',ZCLEAR
221
222      DO IMOL = 1, I_NMOL
223        DO JK = 1, KLEV
224          Z_WKL(IMOL, JK) = Z_COLDRY(JK) * Z_WKL(IMOL, JK)
225        ENDDO
226      ENDDO
227
228      !    IF (ZTOTCC == 0.0_JPRB) THEN
229      !      DO JK=1,KLEV
230      !        ZFRCL(JK)=0.0_JPRB
231      !      ENDDO
232      !    ELSE
233      !      DO JK=1,KLEV
234      !        ZFRCL(JK)=PFRCL(JL,JK)/ZTOTCC
235      !      ENDDO
236      !    ENDIF
237
238      !  PRINT *,'just before SRTM_SETCOEF'
239
240      ZFRCL(1:KLEV) = PFRCL(JL, 1:KLEV)
241      ZCLEAR = 0._JPRB
242      ZCLOUD = 1._JPRB
243
244      CALL SRTM_SETCOEF &
245              & (KLEV, I_NMOL, &
246              & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, &
247              & Z_COLDRY, Z_WKL, &
248              & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, &
249              & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, &
250              & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, &
251              & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, &
252              & JP, JT, JT1     &
253              &)
254
255      !  PRINT *,'just after SRTM_SETCOEF'
256
257      !- call the radiation transfer routine
258
259      DO JSW = 1, KSW
260        ZALBD(JSW) = PALBD(JL, JSW)
261        ZALBP(JSW) = PALBP(JL, JSW)
262        DO JK = 1, KLEV
263          ZTAUC(JK, JSW) = PTAUC(JL, JSW, JK)
264          ZASYC(JK, JSW) = PASYC(JL, JSW, JK)
265          ZOMGC(JK, JSW) = POMGC(JL, JSW, JK)
266          !      print 9002,JSW,JK,ZFRCL(JK),ZTAUC(JK,JSW),ZASYC(JK,JSW),ZOMGC(JK,JSW)
267          9002  format(1x, 'srtm_224gp ClOPropECmodel ', 2I3, f8.4, 3E12.5)
268        ENDDO
269      ENDDO
270
271      !- mixing of aerosols
272
273      !  PRINT *,'Aerosol optical properties computations'
274      !  DO JSW=1,KSW
275      !    print 9012,JSW,(JAE,RSRTAUA(JSW,JAE),RSRPIZA(JSW,JAE),RSRASYA(JSW,JAE),JAE=1,6)
276      9012 format(I3, (/, I3, 3E13.5))
277      !  ENDDO
278
279      !  DO JK=1,KLEV
280      !    print 9013,JK,(PAER(JL,JAE,JK),JAE=1,6)
281      9013 format(1x, I3, 6E12.5)
282      !  ENDDO
283
284      IF (NAER == 0) THEN
285        DO JSW = 1, KSW
286          DO JK = 1, KLEV
287            ZTAUA(JK, JSW) = 0.0_JPRB
288            ZASYA(JK, JSW) = 0.0_JPRB
289            ZOMGA(JK, JSW) = 1.0_JPRB
290          ENDDO
291        ENDDO
292      ELSE
293        DO JSW = 1, KSW
294          DO JK = 1, KLEV
295            IK = KLEV + 1 - JK
296            ZTAUA(JK, JSW) = 0.0_JPRB
297            ZASYA(JK, JSW) = 0.0_JPRB
298            ZOMGA(JK, JSW) = 0.0_JPRB
299            DO JAE = 1, 6
300              ZTAUA(JK, JSW) = ZTAUA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK)
301              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
302                      & * RSRPIZA(JSW, JAE)
303              ZASYA(JK, JSW) = ZASYA(JK, JSW) + RSRTAUA(JSW, JAE) * PAER(JL, JAE, IK) &
304                      & * RSRPIZA(JSW, JAE) * RSRASYA(JSW, JAE)
305            ENDDO
306            IF (ZOMGA(JK, JSW) /= 0.0_JPRB) THEN
307              ZASYA(JK, JSW) = ZASYA(JK, JSW) / ZOMGA(JK, JSW)
308            ENDIF
309            IF (ZTAUA(JK, JSW) /= 0.0_JPRB) THEN
310              ZOMGA(JK, JSW) = ZOMGA(JK, JSW) / ZTAUA(JK, JSW)
311            ENDIF
312            !      print 9003,JSW,JK,ZTAUA(JK,JSW),ZOMGA(JK,JSW),ZASYA(JK,JSW)
313            9003  format(1x, 'Aerosols ', 2I3, 3F10.4)
314          ENDDO
315        ENDDO
316      ENDIF
317
318      DO JK = 1, KLEV + 1
319        ZBBCU(JK) = 0.0_JPRB
320        ZBBCD(JK) = 0.0_JPRB
321        ZBBFU(JK) = 0.0_JPRB
322        ZBBFD(JK) = 0.0_JPRB
323        ZUVCU(JK) = 0.0_JPRB
324        ZUVCD(JK) = 0.0_JPRB
325        ZUVFU(JK) = 0.0_JPRB
326        ZUVFD(JK) = 0.0_JPRB
327        ZVSCU(JK) = 0.0_JPRB
328        ZVSCD(JK) = 0.0_JPRB
329        ZVSFU(JK) = 0.0_JPRB
330        ZVSFD(JK) = 0.0_JPRB
331        ZNICU(JK) = 0.0_JPRB
332        ZNICD(JK) = 0.0_JPRB
333        ZNIFU(JK) = 0.0_JPRB
334        ZNIFD(JK) = 0.0_JPRB
335      ENDDO
336
337      !  PRINT *,'just before calling STRM_SPCVRT for JL=',JL,' and ZRMU0=',ZRMU0
338
339      CALL SRTM_SPCVRT &
340              & (KLEV, I_NMOL, KSW, Z_ONEMINUS, &
341              & Z_PAVEL, Z_TAVEL, Z_PZ, Z_TZ, Z_TBOUND, ZALBD, ZALBP, &
342              & ZFRCL, ZTAUC, ZASYC, ZOMGC, ZTAUA, ZASYA, ZOMGA, ZRMU0, &
343              & Z_COLDRY, Z_WKL, &
344              & I_LAYTROP, I_LAYSWTCH, I_LAYLOW, &
345              & Z_CO2MULT, Z_COLCH4, Z_COLCO2, Z_COLH2O, Z_COLMOL, Z_COLN2O, Z_COLO2, Z_COLO3, &
346              & Z_FORFAC, Z_FORFRAC, INDFOR, Z_SELFFAC, Z_SELFFRAC, INDSELF, &
347              & Z_FAC00, Z_FAC01, Z_FAC10, Z_FAC11, &
348              & JP, JT, JT1, &
349              & ZBBFD, ZBBFU, ZUVFD, ZUVFU, ZVSFD, ZVSFU, ZNIFD, ZNIFU, &
350              & ZBBCD, ZBBCU, ZUVCD, ZUVCU, ZVSCD, ZVSCU, ZNICD, ZNICU &
351              &)
352
353      !  PRINT *,'SRTM_SRTM_224GP before potential scaling'
354      !    IF (IOVLP == 3) THEN
355      !      DO JK=1,KLEV+1
356      !!      print 9004,JK,ZBBCU(JK),ZBBCD(JK),ZBBFU(JK),ZBBFD(JK)
357      9004 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
358      !        PFSUC(JL,1,JK)=ZBBCU(JK)
359      !        PFSUC(JL,2,JK)=ZBBCD(JK)
360      !        PFSUX(JL,1,JK)=ZBBFU(JK)
361      !        PFSUX(JL,2,JK)=ZBBFD(JK)
362      !      ENDDO
363      !    ELSE
364      !    PRINT *,'SRTM_SRTM_224GP after potential scaling'
365      DO JK = 1, KLEV + 1
366        PFSUC(JL, 1, JK) = ZADJI0 * ZBBCU(JK)
367        PFSUC(JL, 2, JK) = ZADJI0 * ZBBCD(JK)
368        PFSUX(JL, 1, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFU(JK) + ZCLEAR * ZBBCU(JK))
369        PFSUX(JL, 2, JK) = ZADJI0 * ((1.0_JPRB - ZCLEAR) * ZBBFD(JK) + ZCLEAR * ZBBCD(JK))
370      ENDDO
371      !    ENDIF
372
373      !  DO JK=1,KLEV+1
374      !    print 9005,JK,PFSUC(JL,1,JK),PFSUC(JL,2,JK),PFSUX(JL,1,JK),PFSUX(JL,2,JK)
375      9005 format(1x, 'Clear-sky and total fluxes U & D ', I3, 4F10.3)
376      !  ENDDO
377
378    ELSE
379      DO JK = 1, KLEV + 1
380        PFSUC(JL, 1, JK) = 0.0_JPRB
381        PFSUC(JL, 2, JK) = 0.0_JPRB
382        PFSUX(JL, 1, JK) = 0.0_JPRB
383        PFSUX(JL, 2, JK) = 0.0_JPRB
384      ENDDO
385    ENDIF
386  ENDDO
387
388  !PRINT *,'OUT OF SRTM_224GP'
389
390  !-----------------------------------------------------------------------
391  IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP', 1, ZHOOK_HANDLE)
392END SUBROUTINE SRTM_SRTM_224GP
393
Note: See TracBrowser for help on using the repository browser.