source: LMDZ6/trunk/libf/phylmd/rrtm/srtm_srtm_224gp.F90 @ 3043

Last change on this file since 3043 was 2027, checked in by Laurent Fairhead, 11 years ago

Problèmes sur les concentrations de certains gaz

  1. Baek

Problems on some gases concentrations

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