source: LMDZ6/trunk/libf/phylmd/rrtm/radlsw.F90 @ 3592

Last change on this file since 3592 was 3539, checked in by jbmadeleine, 5 years ago

petite verif dans rrtm
  • 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
File size: 42.0 KB
Line 
1SUBROUTINE RADLSW &
2 & ( KIDIA, KFDIA , KLON , KLEV  , KMODE, KAER,&
3 & PRII0,&
4 & PAER , PALBD , PALBP, PAPH , PAP,&
5 & PCCNL, PCCNO,&
6 & PCCO2, PCLFR , PDP  , PEMIS, PEMIW , PLSM , PMU0, POZON,&
7 & PQ   , PQIWP , PQLWP, PQS  , PQRAIN, PRAINT,&
8 & PTH  , PT    , PTS  , PNBAS, PNTOP,&
9 & PREF_LIQ, PREF_ICE,&
10 & PEMIT, PFCT  , PFLT , PFCS , PFLS,&
11 & PFRSOD,PSUDU , PUVDF, PPARF, PPARCF, PTINCF,&
12 & PSFSWDIR, PSFSWDIF,PFSDNN,PFSDNV ,& 
13 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST,&
14 & PTAU_LW,&
15 & PFLUX,PFLUC,PFSDN ,PFSUP , PFSCDN , PFSCUP)
16
17use write_field_phy
18
19!**** *RADLSW* - INTERFACE TO ECMWF LW AND SW RADIATION SCHEMES
20
21!     PURPOSE.
22!     --------
23!           CONTROLS RADIATION COMPUTATIONS
24
25!**   INTERFACE.
26!     ----------
27
28!        EXPLICIT ARGUMENTS :
29!        --------------------
30! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
31! PALBD  : (KLON,NSW)        ; SURF. SW ALBEDO FOR DIFFUSE RADIATION
32! PALBP  : (KLON,NSW)        ; SURF. SW ALBEDO FOR PARALLEL RADIATION
33! PAPH   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
34! PAP    : (KLON,KLEV)       ; FULL LEVEL PRESSURE
35! PCCNL  : (KLON)            ; CCN CONCENTRATION OVER LAND
36! PCCNO  : (KLON)            ; CCN CONCENTRATION OVER OCEAN
37! PCCO2  :                   ; CONCENTRATION IN CO2 (KG/KG)
38! PCLFR  : (KLON,KLEV)       ; CLOUD FRACTIONAL COVER
39! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
40! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
41! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
42! PLSM   : (KLON)            ; LAND-SEA MASK
43! PMU0   : (KLON)            ; SOLAR ANGLE
44! PNBAS  : (KLON)            ; INDEX OF BASE OF CONVECTIVE LAYER
45! PNTOP  : (KLON)            ; INDEX OF TOP OF CONVECTIVE LAYER
46! POZON  : (KLON,KLEV)       ; OZONE AMOUNT in LAYER (KG/KG*PA)
47! PQ     : (KLON,KLEV)       ; SPECIFIC HUMIDITY KG/KG
48! PQIWP  : (KLON,KLEV)       ; SOLID  WATER KG/KG
49! PQLWP  : (KLON,KLEV)       ; LIQUID WATER KG/KG
50! PQS    : (KLON,KLEV)       ; SATURATION WATER VAPOR  KG/KG
51! PQRAIN : (KLON,KLEV)       ; RAIN WATER KG/KG
52! PRAINT : (KLON,KLEV)       ; RAIN RATE (m/s)
53! PTH    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
54! PT     : (KLON,KLEV)       ; FULL LEVEL TEMPERATURE
55! PTS    : (KLON)            ; SURFACE TEMPERATURE
56! LDDUST                     ; Dust properties switch
57! PPIZA_DST  : (KPROMA,KLEV,NSW); Single scattering albedo of dust
58! PCGA_DST   : (KPROMA,KLEV,NSW); Assymetry factor for dust
59! PTAUREL_DST: (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
60! PTAU_LW  (KPROMA,KLEV,NLW); LW Optical depth of aerosols
61! PREF_LIQ (KPROMA,KLEV)        ; Liquid droplet radius (um)
62! PREF_ICE (KPROMA,KLEV)        ; Ice crystal radius (um)
63!     ==== OUTPUTS ===
64! PFCT   : (KLON,KLEV+1)     ; CLEAR-SKY LW NET FLUXES
65! PFLT   : (KLON,KLEV+1)     ; TOTAL LW NET FLUXES
66! PFCS   : (KLON,KLEV+1)     ; CLEAR-SKY SW NET FLUXES
67! PFLS   : (KLON,KLEV+1)     ; TOTAL SW NET FLUXES
68! PFRSOD : (KLON)            ; TOTAL-SKY SURFACE SW DOWNWARD FLUX
69! PEMIT  : (KLON)            ; SURFACE TOTAL LONGWAVE EMISSIVITY
70! PSUDU  : (KLON)            ; SOLAR RADIANCE IN SUN'S DIRECTION
71! PPARF  : (KLON)            ; PHOTOSYNTHETICALLY ACTIVE RADIATION
72! PUVDF  : (KLON)            ; UV(-B) RADIATION
73! PPARCF : (KLON)            ; CLEAR-SKY PHOTOSYNTHETICALLY ACTIVE RADIATION
74! PTINCF : (KLON)            ; TOA INCIDENT SOLAR RADIATION
75! Ajout flux LW et SW montants et descendants, et ciel clair (MPL 19.12.08)
76! PFLUX  : (KLON,2,KLEV+1)   ; LW total sky flux (1=up, 2=down)
77! PFLUC  : (KLON,2,KLEV+1)   ; LW clear sky flux (1=up, 2=down)
78! PFSDN(KLON,KLEV+1)         ; SW total sky flux down
79! PFSUP(KLON,KLEV+1)         ; SW total sky flux up
80! PFSCDN(KLON,KLEV+1)        ; SW clear sky flux down
81! PFSCUP(KLON,KLEV+1)        ; SW clear sky flux up
82
83
84
85!        IMPLICIT ARGUMENTS :   NONE
86!        --------------------
87
88!     METHOD.
89!     -------
90!        SEE DOCUMENTATION
91
92!     EXTERNALS.
93!     ----------
94
95!     REFERENCE.
96!     ----------
97!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
98
99!     AUTHORS.
100!     --------
101!        J.-J. MORCRETTE         *ECMWF*
102
103!     MODIFICATIONS.
104!     --------------
105!        ORIGINAL : 88-02-04
106!        J.-J. MORCRETTE 94-11-15 DIRECT/DIFFUSE SURFACE ALBEDO
107!        08/96: J.-J. Morcrette/Ph. Dandin: tests of eff. radius param.
108!        9909 : JJMorcrette effect.radius + inhomogeneity factors
109!        JJMorcrette 990128 : sunshine duration
110!        JJMorcrette : 990831 RRTM-140gp
111!        JJMorcrette : 010112 Sun-Rikus ice particle Diameter
112!        JJMorcrette : 010301 cleaning liq/ice cloud optical properties
113!        JJMorcrette : 011005 CCN --> Re liquid water clouds
114!        JJMorcrette : 011108 Safety checks
115!        JJMorcrette : 011108 Safety checks
116!        DJSalmond   : 020211 Check before R-To-R
117!        JJMorcrette : 020901 PAR & UV
118!        M.Hamrud      01-Oct-2003 CY28 Cleaning
119!        JJMorcrette : 050402 New sets of optical properties (NB: inactive)
120!        Y.Seity       04-11-18 : add 4 arguments for AROME externalized surface
121!        Y.Seity       05-10-10 : add 3 optional arg. for dust SW properties
122!        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
123!-----------------------------------------------------------------------
124
125USE PARKIND1  ,ONLY : JPIM     ,JPRB
126USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
127
128USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
129!USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
130! NSW mis dans .def MPL 20140211
131USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO, LDIFFC, &
132 & NRADIP , NRADLP , NICEOPT, NLIQOPT, NINHOM ,NLAYINH ,&
133 & RCCNLND, RCCNSEA, RLWINHF, RSWINHF, RRe2De ,& 
134 & LEDBUG 
135USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
136USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD   ,&
137 & RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC   ,&
138 & REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ   ,&
139 & REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0   ,&
140 & RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3   ,&
141 & RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0   ,&
142 & RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RFUETB   ,RFUETC  ,RASWCA   ,&
143 & RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF   ,&
144 & RFUAA0   ,RFUAA1   ,RFUBB0   ,RFUBB1   ,RFUBB2   ,&
145 & RFUBB3   ,RFUCC0   ,RFUCC1   ,RFUCC2   ,RFUCC3   ,&
146 & RLILIA   ,RLILIB 
147USE YOERDU        , ONLY : NUAER    ,NTRAER   ,REPLOG   ,REPSC    ,REPSCW   ,DIFF
148!USE YOETHF        , ONLY : RTICE
149USE YOEPHLI       , ONLY : LPHYLIN
150USE YOERRTWN      , ONLY :                     DELWAVE   ,TOTPLNK   
151
152USE YOMLUN_IFSAUX , ONLY : NULOUT
153USE YOMCT3        , ONLY : NSTEP
154
155IMPLICIT NONE
156
157include "clesphys.h"
158!!include "clesrrtm.h"
159include "YOETHF.h"
160INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
161INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
162INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
163INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
164INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE
165INTEGER(KIND=JPIM),INTENT(IN)    :: KAER
166REAL(KIND=JPRB)   ,INTENT(IN)    :: PRII0
167REAL(KIND=JPRB)   ,INTENT(IN)    :: PAER(KLON,6,KLEV)
168REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,NSW)
169REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,NSW)
170REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
171REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
172REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNL(KLON)
173REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNO(KLON)
174REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2
175REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KLON,KLEV)
176REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
177REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
178REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
179REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON)
180REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON)
181REAL(KIND=JPRB)   ,INTENT(IN)    :: POZON(KLON,KLEV)
182REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
183REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KLON,KLEV)
184REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KLON,KLEV)
185REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON,KLEV)
186REAL(KIND=JPRB)                  :: PQRAIN(KLON,KLEV) ! Argument NOT used
187REAL(KIND=JPRB)                  :: PRAINT(KLON,KLEV) ! Argument NOT used
188REAL(KIND=JPRB)   ,INTENT(IN)    :: PTH(KLON,KLEV+1)
189REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
190REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
191REAL(KIND=JPRB)   ,INTENT(IN)    :: PNBAS(KLON)
192REAL(KIND=JPRB)   ,INTENT(IN)    :: PNTOP(KLON)
193LOGICAL           ,INTENT(IN)    :: LRDUST
194REAL(KIND=JPRB)   ,INTENT(IN)    :: PPIZA_DST(KLON,KLEV,NSW)
195REAL(KIND=JPRB)   ,INTENT(IN)    :: PCGA_DST(KLON,KLEV,NSW)
196REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUREL_DST(KLON,KLEV,NSW)
197!--C.Kleinschmitt
198REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU_LW(KLON,KLEV,NLW)
199!--end
200REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_LIQ(KLON,KLEV)
201REAL(KIND=JPRB)   ,INTENT(IN)    :: PREF_ICE(KLON,KLEV)
202REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON)
203REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCT(KLON,KLEV+1)
204REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLT(KLON,KLEV+1)
205REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCS(KLON,KLEV+1)
206REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLS(KLON,KLEV+1)
207REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSOD(KLON)
208REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUDU(KLON)
209REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVDF(KLON)
210REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARF(KLON)
211REAL(KIND=JPRB)   ,INTENT(OUT)   :: PPARCF(KLON), PTINCF(KLON)
212REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIR(KLON,NSW)
213REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFSWDIF(KLON,NSW)
214REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNN(KLON)
215REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDNV(KLON)
216REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
217REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
218REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSDN(KLON,KLEV+1)   ! SW total sky flux down
219REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSUP(KLON,KLEV+1)   ! SW total sky flux up
220REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCDN(KLON,KLEV+1)  ! SW clear sky flux down
221REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFSCUP(KLON,KLEV+1)  ! SW clear sky flux up
222
223
224!     -----------------------------------------------------------------
225
226!*       0.1   ARGUMENTS.
227!              ----------
228!     ==== COMPUTED IN RADLSW ===
229!     -----------------------------------------------------------------
230
231!*       0.2   LOCAL ARRAYS.
232!              -------------
233!     -----------------------------------------------------------------
234
235!-- ARRAYS FOR LOCAL VARIABLES -----------------------------------------
236
237INTEGER(KIND=JPIM) :: IBAS(KLON)     , ITOP(KLON)
238
239REAL(KIND=JPRB) ::&
240 & ZALBD(KLON,NSW)    , ZALBP(KLON,NSW)&
241 & , ZCG(KLON,NSW,KLEV) , ZOMEGA(KLON,NSW,KLEV)&
242 & , ZTAU (KLON,NSW,KLEV) &
243 & , ZTAUCLD(KLON,KLEV,16), ZTCLEAR(KLON) 
244REAL(KIND=JPRB) ::&
245 & ZCLDLD(KLON,KLEV)  , ZCLDLU(KLON,KLEV)&
246 & , ZCLDSW(KLON,KLEV)  , ZCLD0(KLON,KLEV)&
247 & , ZDT0(KLON)        &
248 & , ZEMIS(KLON)        , ZEMIW(KLON)&
249 & , ZFIWP(KLON)        , ZFLWP(KLON)      , ZFRWP(KLON)&
250 & , ZIWC(KLON)         , ZLWC(KLON)&
251 !cc            , ZRWC(KLON)
252 & , ZMU0(KLON)         , ZOZ(KLON,KLEV)   , ZOZN(KLON,KLEV)&
253 & , ZPMB(KLON,KLEV+1)  , ZPSOL(KLON)&
254 & , ZTAVE (KLON,KLEV)  , ZTL(KLON,KLEV+1)&
255 & , ZVIEW(KLON) 
256REAL(KIND=JPRB) ::&
257 & ZFCDWN(KLON,KLEV+1), ZFCUP(KLON,KLEV+1)&
258 & , ZFSDWN(KLON,KLEV+1), ZFSUP(KLON,KLEV+1)&
259 & , ZFSUPN(KLON)       , ZFSUPV(KLON)&
260 & , ZFCUPN(KLON)       , ZFCUPV(KLON)&
261 & , ZFSDNN(KLON)       , ZFSDNV(KLON)&
262 & , ZFCDNN(KLON)       , ZFCDNV(KLON)& 
263 & , ZDIRFS(KLON,NSW)   , ZDIFFS(KLON,NSW) 
264REAL(KIND=JPRB) ::&
265 & ZALFICE(KLON)      , ZGAMICE(KLON)     , ZBICE(KLON)   , ZDESR(KLON)&
266 & , ZRADIP(KLON)       , ZRADLP(KLON)     &
267 !cc           , ZRADRD(KLON)
268 & , ZRAINT(KLON)       , ZRES(KLON)&
269 & , ZTICE(KLON)        , ZEMIT(KLON),  ZBICFU(KLON)&
270 & , ZKICFU(KLON)
271REAL(KIND=JPRB) :: ZSUDU(KLON)   , ZPARF(KLON)       , ZUVDF(KLON), ZPARCF(KLON)
272INTEGER(KIND=JPIM) :: IKL, JK, JKL, JKLP1, JKP1, JL, JNU, JRTM, JSW, INDLAY
273
274REAL(KIND=JPRB) :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR, ZIWGKG, ZLWGKG,&
275 & ZMSAID, ZMSAIU, ZMSALD, ZMSALU, ZRSAIA, ZRSAID, ZRSAIE, ZRSAIF, ZRSAIG, ZRSALD, &
276 & ZMULTI, ZMULTL, ZOI   , ZOL, &
277 & ZOMGMX, ZOR, ZRMUZ, ZRWGKG, ZTAUD, ZTAUMX, ZTEMPC, &
278 & ZTOI, ZTOL, ZTOR, ZZFIWP, ZZFLWP, ZDPOG, ZPODT 
279
280REAL(KIND=JPRB) :: ZALND, ZASEA, ZD, ZDEN, ZNTOT, ZNUM, ZRATIO, Z1RADI, &
281 & Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZTCELS, ZFSR, ZAIWC, &
282 & ZBIWC, ZTBLAY, ZADDPLK, ZPLANCK, ZEXTCF, Z1MOMG, &
283 & ZDefRe, ZRefDe, ZVI , ZMABSD
284
285!REAL(KIND=JPRB) :: ZAVDP(KLON), ZAVTO(KLON), ZSQTO(KLON)
286REAL(KIND=JPRB) :: ZAVTO(KLON), ZSQTO(KLON)
287REAL(KIND=JPRB) :: ZSQUAR(KLON,KLEV), ZVARIA(KLON,KLEV)
288INTEGER(KIND=JPIM) :: IKI, JKI, JEXPLR, JXPLDN
289LOGICAL         :: LLDEBUG
290
291
292REAL(KIND=JPRB) :: ZHOOK_HANDLE
293
294#include "lw.intfb.h"
295#include "rrtm_rrtm_140gp.intfb.h"
296#include "sw.intfb.h"
297
298!     -----------------------------------------------------------------
299
300!*         1.     SET-UP INPUT QUANTITIES FOR RADIATION
301!                 -------------------------------------
302
303IF (LHOOK) CALL DR_HOOK('RADLSW',0,ZHOOK_HANDLE)
304
305LLDEBUG=.FALSE.
306ZRefDe = RRe2De
307ZDefRe = 1.0_JPRB / ZRefDe
308
309DO JL = KIDIA,KFDIA
310  ZFCUP(JL,KLEV+1) = 0.0_JPRB
311  ZFCDWN(JL,KLEV+1) = REPLOG
312  ZFSUP(JL,KLEV+1) = 0.0_JPRB
313  ZFSDWN(JL,KLEV+1) = REPLOG
314  PFLUX(JL,1,KLEV+1) = 0.0_JPRB
315  PFLUX(JL,2,KLEV+1) = 0.0_JPRB
316  PFLUC(JL,1,KLEV+1) = 0.0_JPRB
317  PFLUC(JL,2,KLEV+1) = 0.0_JPRB
318  ZFSDNN(JL) = 0.0_JPRB
319  ZFSDNV(JL) = 0.0_JPRB
320  ZFCDNN(JL) = 0.0_JPRB
321  ZFCDNV(JL) = 0.0_JPRB
322  ZFSUPN(JL) = 0.0_JPRB
323  ZFSUPV(JL) = 0.0_JPRB
324  ZFCUPN(JL) = 0.0_JPRB
325  ZFCUPV(JL) = 0.0_JPRB
326  ZPSOL(JL) = PAPH(JL,KLEV+1)
327  ZPMB(JL,1) = ZPSOL(JL) / 100.0_JPRB
328  ZDT0(JL) = PTS(JL) - PTH(JL,KLEV+1)
329  PSUDU(JL) = 0.0_JPRB
330  PPARF(JL) = 0.0_JPRB
331  PPARCF(JL)= 0.0_JPRB
332  PUVDF(JL) = 0.0_JPRB
333  PSFSWDIR(JL,:)=0.0_JPRB
334  PSFSWDIF(JL,:)=0.0_JPRB
335  IBAS(JL) = INT ( 0.01_JPRB + PNBAS(JL) )
336  ITOP(JL) = INT ( 0.01_JPRB + PNTOP(JL) )
337ENDDO
338
339!*         1.1    INITIALIZE VARIOUS FIELDS
340!                 -------------------------
341
342DO JSW=1,NSW
343  DO JL = KIDIA,KFDIA
344    ZALBD(JL,JSW)=PALBD(JL,JSW)
345    ZALBP(JL,JSW)=PALBP(JL,JSW)
346  ENDDO
347ENDDO
348DO JL = KIDIA,KFDIA
349  ZEMIS(JL)  =PEMIS(JL)
350  ZEMIW(JL)  =PEMIW(JL)
351  ZMU0(JL)   =PMU0(JL)
352ENDDO
353
354DO JK = 1 , KLEV
355  JKP1 = JK + 1
356  JKL = KLEV+ 1 - JK
357  JKLP1 = JKL + 1
358  DO JL = KIDIA,KFDIA
359    ZPMB(JL,JK+1)=PAPH(JL,JKL)/100.0_JPRB
360
361!-- ZOZ in cm.atm for SW scheme   
362    ZOZ(JL,JK)   = POZON(JL,JKL) * 46.6968_JPRB / RG
363
364    ZCLD0(JL,JK) = 0.0_JPRB
365    ZFCUP(JL,JK) = 0.0_JPRB
366    ZFCDWN(JL,JK) = 0.0_JPRB
367    ZFSUP(JL,JK) = 0.0_JPRB
368    ZFSDWN(JL,JK) = 0.0_JPRB
369    PFLUX(JL,1,JK) = 0.0_JPRB
370    PFLUX(JL,2,JK) = 0.0_JPRB
371    PFLUC(JL,1,JK) = 0.0_JPRB
372    PFLUC(JL,2,JK) = 0.0_JPRB
373  ENDDO
374ENDDO
375
376DO JK=1,KLEV
377  JKL=KLEV+1-JK
378  JKLP1=JKL+1
379  DO JL=KIDIA,KFDIA
380    ZTL(JL,JK)=PTH(JL,JKLP1)
381    ZTAVE(JL,JK)=PT(JL,JKL)
382  ENDDO
383ENDDO
384DO JL=KIDIA,KFDIA
385  ZTL(JL,KLEV+1)= PTH(JL,1)
386  ZPMB(JL,KLEV+1) = PAPH(JL,1)/100.0_JPRB
387ENDDO
388!***
389
390!     ------------------------------------------------------------------
391
392!*         2.     CLOUD AND AEROSOL PARAMETERS
393!                 ----------------------------
394
395DO JK = 1 , KLEV
396  IKL = KLEV + 1 - JK
397
398!          2.1    INITIALIZE OPTICAL PROPERTIES TO CLEAR SKY VALUES
399!                 -------------------------------------------------
400
401  DO JSW = 1,NSW
402    DO JL = KIDIA,KFDIA
403      ZTAU(JL,JSW,JK)  = 0.0_JPRB
404      ZOMEGA(JL,JSW,JK)= 1.0_JPRB
405      ZCG(JL,JSW,JK)   = 0.0_JPRB
406    ENDDO
407  ENDDO
408  DO JL = KIDIA,KFDIA
409    ZCLDSW(JL,JK)  = 0.0_JPRB
410    ZCLDLD(JL,JK)  = 0.0_JPRB
411    ZCLDLU(JL,JK)  = 0.0_JPRB
412  ENDDO
413
414!          2.2    CLOUD ICE AND LIQUID CONTENT AND PATH
415!                 -------------------------------------
416
417  DO JL = KIDIA,KFDIA
418
419! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
420    IF (PCLFR(JL,IKL) > REPSC ) THEN
421      ZLWGKG=MAX(PQLWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
422      ZIWGKG=MAX(PQIWP(JL,IKL)*1000.0_JPRB,0.0_JPRB)
423      ZLWGKG=ZLWGKG/PCLFR(JL,IKL)
424      ZIWGKG=ZIWGKG/PCLFR(JL,IKL)
425    ELSE
426      ZLWGKG=0.0_JPRB
427      ZIWGKG=0.0_JPRB
428    ENDIF
429    ZRWGKG=0.0_JPRB
430    ZRAINT(JL)=0.0_JPRB
431
432! --- RAIN LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
433!    IF (PRAINT(JL,IKL) >= REPSCW) THEN
434!      ZRWGKG=MAX(PQRAIN(JL,IKL)*1000., 0.0)
435!      ZRAINT(JL)=PRAINT(JL,IKL)*3600.*1000.
436!- no radiative effect of rain (for the moment)
437!      ZRWGKG=0.
438!      ZRAINT(JL)=0.
439! ===========================================================
440
441! Modifications Martin et al.
442!    ELSE
443!    ENDIF
444    ZDPOG=PDP(JL,IKL)/RG
445    ZFLWP(JL)= ZLWGKG*ZDPOG
446    ZFIWP(JL)= ZIWGKG*ZDPOG
447    ZFRWP(JL)= ZRWGKG*ZDPOG
448    ZPODT=PAP(JL,IKL)/(RD*PT(JL,IKL))
449    ZLWC(JL)=ZLWGKG*ZPODT
450    ZIWC(JL)=ZIWGKG*ZPODT
451!    ZRWC(JL)=ZRWGKG*ZPODT
452
453  ENDDO
454  DO JL = KIDIA,KFDIA
455! --- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES
456
457! very old parametrization as f(pressure)
458
459    IF (NRADLP == 0) THEN
460!-- very old parametrization as f(pressure) ERA-15
461      ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,IKL))*3.5_JPRB
462
463    ELSEIF (NRADLP == 1) THEN
464! simple distinction between land (10) and ocean (13) Zhang and Rossow
465      IF (PLSM(JL) < 0.5_JPRB) THEN
466        ZRADLP(JL)=13.0_JPRB
467      ELSE
468        ZRADLP(JL)=10.0_JPRB
469      ENDIF
470     
471    ELSEIF (NRADLP == 2) THEN
472!--  based on Martin et al., 1994, JAS
473      IF (PLSM(JL) < 0.5_JPRB) THEN
474        IF (LCCNO) THEN
475!          ZASEA=50.0_JPRB
476          ZASEA=PCCNO(JL)
477        ELSE 
478          ZASEA=RCCNSEA
479        ENDIF 
480        ZD=0.33_JPRB
481        ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
482      ELSE
483        IF (LCCNL) THEN
484!          ZALND=900.0_JPRB
485          ZALND=PCCNL(JL)
486        ELSE 
487          ZALND=RCCNLND
488        ENDIF 
489        ZD=0.43_JPRB
490        ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
491      ENDIF
492      ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
493      ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3
494      IF((ZNUM/ZDEN) > REPLOG)THEN
495        ZRADLP(JL)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN))
496        ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB)
497        ZRADLP(JL)=MIN(ZRADLP(JL),16.0_JPRB)
498      ELSE
499        ZRADLP(JL)=4.0_JPRB
500      ENDIF
501
502    ELSEIF (NRADLP == 3) THEN 
503! one uses the cloud droplet radius from newmicro
504! IKL or JK ?? - I think IKL but needs to be verified > ref_liq_i
505! (inverted) is used in the call of RECMWF_AERO in radlwsw_m.F90,
506! so everything is fine - JBM 6/2019
507        ZRADLP(JL)=PREF_LIQ(JL,IKL)
508    ENDIF 
509
510! ===========================================================
511! ___________________________________________________________
512
513! rain drop from          : unused as ZRAINT is 0.
514!    ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB
515!    IF (ZFLWP(JL).GT.0.) THEN
516!      ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL)
517!    ENDIF   
518
519  ENDDO
520  DO JL = KIDIA,KFDIA
521
522! diagnosing the ice particle effective radius/diameter
523
524!- ice particle effective radius =f(T) from Liou and Ou (1994)
525 
526    IF (PT(JL,IKL) < RTICE) THEN
527      ZTEMPC=PT(JL,IKL)-RTT
528    ELSE
529      ZTEMPC=RTICE-RTT
530    ENDIF
531    ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
532      & 0.0012_JPRB))   
533
534    IF (NRADIP == 0) THEN
535!-- fixed 40 micron effective radius
536      ZRADIP(JL)= 40.0_JPRB
537      ZDESR(JL) = ZDefRe * ZRADIP(JL)
538     
539    ELSEIF (NRADIP == 1) THEN
540
541!-- old formulation based on Liou & Ou (1994) temperature (40-130microns)   
542      ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB)
543      ZDESR(JL) = ZDefRe * ZRADIP(JL)
544     
545    ELSEIF (NRADIP == 2) THEN 
546!-- formulation following Jakob, Klein modifications to ice content   
547      ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB)
548      ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB)
549      ZDESR(JL)= ZDefRe * ZRADIP(JL)
550 
551    ELSEIF (NRADIP == 3  ) THEN
552 
553!- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999)
554! revised by Sun (2001)
555      IF (ZIWC(JL) > 0.0_JPRB ) THEN
556        ZTEMPC = PT(JL,IKL)-83.15_JPRB
557        ZTCELS = PT(JL,IKL)-RTT
558        ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS
559! Sun, 2001 (corrected from Sun & Rikus, 1999)
560        ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB
561        ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB
562        ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
563!-new        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB)
564        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB)
565        ZRADIP(JL)= ZRefDe * ZDESR(JL)
566      ELSE
567!        ZDESR(JL) = 92.5_JPRB
568        ZDESR(JL) = 80.0_JPRB
569        ZRADIP(JL)= ZRefDe * ZDESR(JL)
570      ENDIF 
571 
572    ELSEIF (NRADIP == 4  ) THEN
573! one uses the cloud droplet radius from newmicro
574! IKL or JK ?? - I think IKL but needs to be verified
575        ZRADIP(JL)=PREF_ICE(JL,IKL)
576    ENDIF 
577   
578  ENDDO
579
580!          2.3    CLOUD SHORTWAVE OPTICAL PROPERTIES
581!                 ----------------------------------
582
583!   -------------------------
584! --+ SW OPTICAL PARAMETERS +  Water clouds after Fouquart (1987)
585!   -------------------------  Ice clouds (Ebert, Curry, 1992)
586
587  DO JSW=1,NSW
588    DO JL = KIDIA,KFDIA
589      ZTOL=0.0_JPRB
590      ZGL =0.0_JPRB
591      ZOL =0.0_JPRB
592      ZTOI=0.0_JPRB
593      ZGI =0.0_JPRB
594      ZOI =0.0_JPRB
595      ZTOR=0.0_JPRB
596      ZGR =0.0_JPRB
597      ZOR =0.0_JPRB
598      IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN
599        IF (ZFLWP(JL) >= REPSCW ) THEN
600          IF (NLIQOPT /= 0 ) THEN
601!-- SW: Slingo, 1989
602            ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL))
603            ZGL  = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL)
604            ZOL  = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
605          ELSE         
606!-- SW: Fouquart, 1991
607            ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL))
608            ZGL  = RYFWCF(JSW)
609!            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL)
610!-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with
611! the previous. Should be cleaned when RRTM_SW becomes active
612            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF)
613          ENDIF
614        ENDIF
615
616        IF (ZFIWP(JL) >= REPSCW ) THEN
617          IF (NICEOPT <= 1) THEN
618!-- SW: Ebert-Curry         
619            ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL))
620            ZGI  = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL)
621            ZOI  = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL)
622           
623          ELSEIF (NICEOPT == 2) THEN 
624!-- SW: Fu-Liou 1993
625            Z1RADI = 1.0_JPRB / ZDESR(JL)
626            ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW)
627            ZTOI = ZFIWP(JL) * ZBETAI
628            ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) &
629             & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) ))             
630            ZOI  = 1.0_JPRB - ZOMGI
631            ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) &
632             & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) ))   
633            ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) &
634             & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) ))   
635            ZGI  = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB
636           
637          ELSEIF (NICEOPT == 3) THEN 
638!-- SW: Fu 1996
639            Z1RADI = 1.0_JPRB / ZDESR(JL)
640            ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW)
641            ZTOI = ZFIWP(JL) * ZBETAI
642            ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) &
643             &   *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) ))           
644            ZOI  = 1.0_JPRB - ZOMGI
645            ZGI  = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) &
646             &   *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) ))
647            ZGI  = MIN(1.0_JPRB, ZGI)
648     
649          ENDIF
650        ENDIF
651
652!        IF (ZFRWP(JL) >= REPSCW ) THEN
653!          ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB)         
654!          ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW)
655!          ZGR = RRASY(JSW)
656!        ENDIF   
657
658!  - MIX of WATER and ICE CLOUDS
659        ZTAUMX= ZTOL + ZTOI + ZTOR
660        ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR
661        ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR
662
663        ZASYMX= ZASYMX/ZOMGMX
664        ZOMGMX= ZOMGMX/ZTAUMX
665
666! --- SW FINAL CLOUD OPTICAL PARAMETERS
667
668        ZCLDSW(JL,JK)  = PCLFR(JL,IKL)
669        ZTAU(JL,JSW,JK)  = ZTAUMX
670        ZOMEGA(JL,JSW,JK)= ZOMGMX
671        ZCG(JL,JSW,JK)   = ZASYMX
672      ENDIF
673    ENDDO
674  ENDDO
675
676  IF(LLDEBUG) THEN
677   call writefield_phy("radlsw_ztau",ztau(:,1,:),klev)
678  ENDIF
679
680!          2.4    CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE
681!                 --------------------------------------------
682
683!   -------------------------
684! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Smith and Shi (1992)
685!   -------------------------  Ice clouds (Ebert, Curry, 1992)
686
687  IF (.NOT.LRRTM) THEN
688
689    DO JL = KIDIA,KFDIA
690      ZALFICE(JL)=0.0_JPRB
691      ZGAMICE(JL)=0.0_JPRB
692      ZBICE(JL)=0.0_JPRB
693      ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND
694      IF (NICEOPT == 1) THEN
695        ZBICFU(JL)=1.0_JPRB
696      ELSE
697        ZBICFU(JL)=0.0_JPRB
698      ENDIF
699      ZKICFU(JL)=0.0_JPRB
700    ENDDO
701   
702    DO JNU= 1,NSIL
703      DO JL = KIDIA,KFDIA
704        ZRES(JL)  = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,&
705         & JNU)&
706         & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,&
707         & JNU)&
708         & ))))) 
709        ZBICE(JL) = ZBICE(JL) + ZRES(JL)
710        ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL)
711        ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL)
712      ENDDO
713    ENDDO
714   
715!-- Fu et al. (1998) with M'91 LW scheme   
716    IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN
717      DO JRTM=1,16
718        DO JL=KIDIA,KFDIA
719          IF (PT(JL,IKL) < 160.0_JPRB) THEN
720            INDLAY=1
721            ZTBLAY =PT(JL,IKL)-160.0_JPRB
722          ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN
723            INDLAY=PT(JL,IKL)-159.0_JPRB
724            INDLAY=MAX(INDLAY,1)
725            ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL))
726          ELSE
727            INDLAY=180
728            ZTBLAY =PT(JL,IKL)-339.0_JPRB
729          ENDIF
730          ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM)
731          ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK)
732          ZBICFU(JL) = ZBICFU(JL) + ZPLANCK
733       
734          IF (ZIWC(JL) > 0.0_JPRB ) THEN
735            ZRATIO =  1.0_JPRB / ZDESR(JL)
736            IF (NICEOPT == 2) THEN
737! ice cloud spectral emissivity a la Fu & Liou (1993)
738              ZMABSD = RFULIO(JRTM,1) + ZRATIO &
739               & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) 
740         
741! ice cloud spectral emissivity a la Fu et al (1998)
742            ELSEIF (NICEOPT == 3) THEN
743              ZMABSD = RFUETA(JRTM,1) + ZRATIO &
744               & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3)) 
745            ENDIF
746            ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK
747          ENDIF 
748        ENDDO
749      ENDDO
750    ENDIF
751   
752    DO JL = KIDIA,KFDIA
753      ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL)
754      ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL)
755      ZKICFU(JL)  = ZKICFU(JL) / ZBICFU(JL)
756     
757      IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
758
759        IF (NLIQOPT == 0) THEN
760! water cloud emissivity a la Smith & Shi (1992)
761          ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
762          ZMSALD= 0.158_JPRB*ZMULTL
763          ZMSALU= 0.130_JPRB*ZMULTL
764         
765        ELSE
766! water cloud emissivity a la Savijarvi (1997)
767          ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL)
768          ZMSALD= 1.2154_JPRB*ZMSALU
769         
770        ENDIF 
771         
772        IF (NICEOPT == 0) THEN         
773! ice cloud emissivity a la Smith & Shi (1992)
774          ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
775          ZMSAID= 0.113_JPRB*ZMULTI
776          ZMSAIU= 0.093_JPRB*ZMULTI
777
778        ELSEIF (NICEOPT == 1) THEN
779! ice cloud emissivity a la Ebert & Curry (1992)
780          ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL))
781          ZMSAIU= ZMSAID
782         
783        ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN 
784! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998)
785          ZMSAID= 1.66_JPRB*ZKICFU(JL)
786          ZMSAIU= ZMSAID         
787        ENDIF
788       
789        IF (NINHOM == 1) THEN
790          ZZFLWP= ZFLWP(JL) * RLWINHF
791          ZZFIWP= ZFIWP(JL) * RLWINHF
792        ELSE
793          ZZFLWP= ZFLWP(JL)
794          ZZFIWP= ZFIWP(JL)
795        ENDIF
796
797! effective cloudiness accounting for condensed water
798        ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* &
799         & ZZFIWP)) 
800        ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* &
801         & ZZFIWP)) 
802      ENDIF
803    ENDDO
804
805  ELSE
806
807!          2.5    CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM
808!                 ------------------------------------------
809
810!   -------------------------
811! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Savijarvi (1998)
812!   -------------------------  Ice clouds (Ebert, Curry, 1992)
813
814! No need for a fixed diffusivity factor, accounted for spectrally below
815! The detailed spectral structure does not require defining upward and
816! downward effective optical properties
817
818    DO JRTM=1,16
819      DO JL = KIDIA,KFDIA
820        ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB
821        ZMSALD = 0.0_JPRB
822        ZMSAID = 0.0_JPRB
823       
824        IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
825   
826          IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN
827! water cloud total emissivity a la Smith and Shi (1992)
828            ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
829            ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB
830           
831          ELSEIF (NLIQOPT == 1) THEN
832! water cloud spectral emissivity a la Savijarvi (1997)
833            ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)&
834             & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) 
835             
836          ELSEIF (NLIQOPT == 2) THEN
837! water cloud spectral emissivity a la Lindner and Li (2000)
838            Z1RADL = 1.0_JPRB / ZRADLP(JL)
839            ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*&
840             & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*&
841             & RLILIA(JRTM,5) )) 
842            Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) &
843             & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) )
844            ZRSALD = Z1MOMG * ZEXTCF
845          ENDIF 
846         
847          IF (NICEOPT == 0) THEN
848! ice cloud spectral emissivity a la Smith & Shi (1992)
849            ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
850            ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB
851           
852          ELSEIF (NICEOPT == 1) THEN
853! ice cloud spectral emissivity a la Ebert-Curry (1992)
854            ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL)
855           
856          ELSEIF (NICEOPT == 2) THEN
857! ice cloud spectral emissivity a la Fu & Liou (1993)
858            Z1RADI = 1.0_JPRB / ZDESR(JL)
859            ZRSAID = RFULIO(JRTM,1) + Z1RADI &
860             & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3)) 
861             
862          ELSEIF (NICEOPT == 3) THEN
863! ice cloud spectral emissivity a la Fu et al (1998) including
864! parametrisation for LW scattering effect 
865            Z1RADI = 1.0_JPRB / ZDESR(JL)
866            ZRSAIE = RFUETA(JRTM,1) + Z1RADI &
867             &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3))
868            ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4))))
869            ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4)))
870            ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) )
871            ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE
872          ENDIF   
873         
874          ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL)
875
876! Diffusivity correction within clouds a la Savijarvi
877          IF (LDIFFC) THEN
878            ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), &
879             &     2.0_JPRB)
880          ELSE
881            ZDIFFD=1.66_JPRB
882          ENDIF
883
884          ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD
885        ENDIF
886       
887      ENDDO
888    ENDDO
889
890  ENDIF
891
892ENDDO
893
894NUAER = NUA
895NTRAER = NTRA
896
897!     ------------------------------------------------------------------
898!
899!          2.6    SCALING OF OPTICAL THICKNESS
900!                 SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY
901
902JEXPLR=NLAYINH
903JXPLDN=2*JEXPLR+1
904
905IF (NINHOM == 1) THEN
906!-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW
907  DO JSW=1,NSW
908    DO JK=1,KLEV
909      DO JL=KIDIA,KFDIA
910        ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF
911      ENDDO
912    ENDDO
913  ENDDO
914
915  DO JRTM=1,16
916    DO JK=1,KLEV
917      DO JL=KIDIA,KFDIA
918        ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF
919      ENDDO
920    ENDDO
921  ENDDO
922
923ELSEIF (JEXPLR /= 0) THEN
924  DO JSW=1,NSW
925    DO JK=1,KLEV
926      DO JL=KIDIA,KFDIA
927        ZSQUAR(JL,JK)=0.0_JPRB
928        ZVARIA(JL,JK)=1.0_JPRB
929      ENDDO
930    ENDDO
931!-- range should be defined from Hogan & Illingworth
932    DO JK=1+JEXPLR,KLEV-JEXPLR
933      DO JL=KIDIA,KFDIA
934!        ZAVDP(JL)=0.0_JPRB
935        ZAVTO(JL)=0.0_JPRB
936        ZSQTO(JL)=0.0_JPRB
937      ENDDO
938      DO JKI=JK-JEXPLR,JK+JEXPLR
939        IKI=KLEV+1-JKI
940        DO JL=KIDIA,KFDIA
941!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
942          ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI)
943        ENDDO
944      ENDDO
945      DO JL=KIDIA,KFDIA
946!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
947        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
948      ENDDO
949      DO JKI=JK-JEXPLR,JK+JEXPLR
950        IKI=KLEV+1-JKI
951        DO JL=KIDIA,KFDIA
952!          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2
953          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2
954        ENDDO
955      ENDDO
956      DO JL=KIDIA,KFDIA
957        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
958        IF (ZAVTO(JL) > 0.0_JPRB) THEN
959          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
960          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
961        ELSE
962          ZVARIA(JL,JK)=0.0_JPRB
963          ZSQUAR(JL,JK)=1.0_JPRB
964        ENDIF
965
966!-- scaling a la Barker
967        IF (NINHOM ==2) THEN
968          ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK)
969
970!-- scaling a la Cairns et al.
971        ELSEIF (NINHOM == 3) THEN
972          ZVI=ZVARIA(JL,JK)
973          ZTAU(JL,JSW,JK)  = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI)
974          ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) &
975            &   /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) )
976          ZCG(JL,JSW,JK)   = ZCG(JL,JSW,JK) &
977            & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) &
978            & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK)))
979        ENDIF
980      ENDDO
981!      JL=KIDIA
982!      print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
9839261   format(1x,'Varia1 ',2I3,7F10.4)
984    ENDDO
985  ENDDO
986
987
988  DO JRTM=1,16
989    DO JK=1,KLEV
990      DO JL=KIDIA,KFDIA
991        ZSQUAR(JL,JK)=0.0_JPRB
992        ZVARIA(JL,JK)=1.0_JPRB
993      ENDDO
994    ENDDO
995!-- range to be defined from Hogan & Illingworth
996    DO JK=1+JEXPLR,KLEV-JEXPLR
997      DO JL=KIDIA,KFDIA
998!        ZAVDP(JL)=0.0_JPRB
999        ZAVTO(JL)=0.0_JPRB
1000        ZSQTO(JL)=0.0_JPRB
1001      ENDDO
1002      DO JKI=JK-JEXPLR,JK+JEXPLR
1003        IKI=KLEV+1-JKI
1004        DO JL=KIDIA,KFDIA
1005!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
1006          ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM)
1007        ENDDO
1008      ENDDO
1009      DO JL=KIDIA,KFDIA
1010!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
1011        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
1012      ENDDO
1013      DO JKI=JK-JEXPLR,JK+JEXPLR
1014        IKI=KLEV+1-JKI
1015        DO JL=KIDIA,KFDIA
1016!          ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2
1017            ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2
1018        ENDDO
1019      ENDDO
1020      DO JL=KIDIA,KFDIA
1021        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
1022        IF (ZAVTO(JL) > 0.0_JPRB) THEN
1023          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
1024          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
1025        ELSE
1026          ZVARIA(JL,JK)=0.0_JPRB
1027          ZSQUAR(JL,JK)=1.0_JPRB
1028        ENDIF
1029
1030!-- scaling a la Barker
1031        IF (NINHOM ==2) THEN
1032          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK)
1033
1034!-- scaling a la Cairns et al.
1035        ELSEIF (NINHOM == 3) THEN
1036          ZVI=ZVARIA(JL,JK)
1037          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI)
1038        ENDIF
1039      ENDDO
1040!      JL=KIDIA
1041!      print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
10429262   format(1x,'Varia2 ',2I3,7F10.4)
1043    ENDDO
1044  ENDDO
1045ENDIF
1046
1047
1048
1049!     ------------------------------------------------------------------
1050!
1051!*         2.7    DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE
1052!                 ---------------------------------------------
1053
1054DO JL = KIDIA,KFDIA
1055  ZVIEW(JL) = DIFF
1056ENDDO
1057
1058!     ------------------------------------------------------------------
1059
1060!*         3.     CALL LONGWAVE RADIATION CODE
1061!                 ----------------------------
1062
1063!*         3.1    FULL LONGWAVE RADIATION COMPUTATIONS
1064!                 ------------------------------------
1065
1066!print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM
1067IF (.NOT.LPHYLIN) THEN
1068  IF ( .NOT. LRRTM) THEN
1069
1070    CALL LW &
1071     & ( KIDIA , KFDIA , KLON  , KLEV , KMODE,&
1072     & PCCO2 , ZCLDLD, ZCLDLU,&
1073     & PDP   , ZDT0  , ZEMIS , ZEMIW,&
1074     & ZPMB  , POZON , ZTL,&
1075     & PAER  , ZTAVE , ZVIEW , PQ,&
1076     & ZEMIT , PFLUX , PFLUC &
1077     & ) 
1078!   print *,'RADLSW: apres CALL LW'
1079    IF(LLDEBUG) THEN
1080    call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1)
1081    call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1)
1082    call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1)
1083    call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1)
1084    ENDIF
1085
1086  ELSE
1087
1088!*         3.2    FULL LONGWAVE RADIATION COMPUTATIONS - RRTM
1089!                 ------------------------------------   ----
1090
1091!  i)  pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure
1092!      weighting applied to POZON in driverMC (below)
1093!  ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM
1094!  iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM,
1095!      computed from equations above
1096!  iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM
1097!      in module rrtm_ecrt.f
1098
1099    DO JL = KIDIA,KFDIA
1100      DO JK = 1, KLEV
1101        ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK)
1102      ENDDO
1103    ENDDO
1104
1105!   print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:)
1106    CALL RRTM_RRTM_140GP &
1107     & ( KIDIA , KFDIA , KLON  , KLEV,&
1108     & PAER  , PAPH  , PAP,&
1109     & PTS   , PTH   , PT,&
1110     & ZEMIS , ZEMIW,&
1111     & PQ    , PCCO2 , ZOZN  ,&
1112     & ZCLDSW  , ZTAUCLD,&
1113     & PTAU_LW,&
1114     & ZEMIT , PFLUX , PFLUC , ZTCLEAR )
1115!   print *,'RADLSW: apres CALL RRTM_RRTM_140GP'
1116
1117  ENDIF
1118ELSE
1119  ZEMIT (:)   = 0.0_JPRB
1120  PFLUX(:,:,:)= 0.0_JPRB
1121  PFLUC(:,:,:)= 0.0_JPRB
1122! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0'
1123ENDIF
1124
1125!     ------------------------------------------------------------------
1126
1127!*         4.     CALL SHORTWAVE RADIATION CODE
1128!                 -----------------------------
1129
1130ZRMUZ=0.0_JPRB
1131DO JL = KIDIA,KFDIA
1132  ZRMUZ = MAX (ZRMUZ, ZMU0(JL))
1133ENDDO
1134
1135IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1136  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1137  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1138  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1139  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1140  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1141  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1142  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1143  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1144  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1145  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1146  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1147  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1148  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1149  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1150ENDIF
1151
1152IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1153  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1154  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1155  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1156  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1157  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1158  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1159  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1160  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1161  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1162  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1163  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1164  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1165  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1166  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1167ENDIF
1168CALL SW &
1169 & ( KIDIA , KFDIA , KLON  , KLEV  , KAER,&
1170 & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ   , PQS,&
1171 & ZMU0  , ZCG   , ZCLDSW, PDP   , ZOMEGA, ZOZ  , ZPMB,&
1172 & ZTAU  , ZTAVE , PAER,&
1173 & PFSDN , PFSUP , PFSCDN, PFSCUP,&
1174 & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,&
1175 & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,&
1176 & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, &
1177 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST&
1178   & )
1179PFSDNV=ZFSDNV
1180PFSDNN=ZFSDNN
1181IF (SIZE(PSFSWDIR,2)>1) THEN
1182  PSFSWDIR= ZDIRFS
1183  PSFSWDIF= ZDIFFS
1184ELSE
1185  PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:)
1186  PSFSWDIF (:,:) = 0.
1187ENDIF
1188
1189IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1190  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1191  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1192  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1193  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1194  LEDBUG=.FALSE.
1195ENDIF
1196IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1197  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1198  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1199  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1200  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1201  LEDBUG=.FALSE.
1202ENDIF
1203!     ------------------------------------------------------------------
1204
1205!*         5.     FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES
1206!                 ------------------------------------------------
1207
1208DO JKL = 1 , KLEV+1
1209  JK = KLEV+1 + 1 - JKL
1210  DO JL = KIDIA,KFDIA
1211    PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK)
1212    PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK)
1213    PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK)
1214    PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK)
1215  ENDDO
1216ENDDO
1217
1218DO JL = KIDIA,KFDIA
1219  PFRSOD(JL)=ZFSDWN(JL,1)
1220  PEMIT (JL)=ZEMIT (JL)
1221  PSUDU (JL)=ZSUDU (JL)
1222  PUVDF (JL)=ZUVDF (JL)
1223  PPARF (JL)=ZPARF (JL)
1224  PPARCF(JL)=ZPARCF(JL)
1225  PTINCF(JL)=PRII0 * ZMU0(JL)
1226ENDDO
1227!print 9501,(PUVDF(JL),JL=KIDIA,KFDIA)
12289501 format(1x,'RADLSW PUVDF: ',30f6.1)
1229!print 9502,(PPARF(JL),JL=KIDIA,KFDIA)
12309502 format(1x,'RADLSW PPARF: ',30f6.1)
1231
1232!     --------------------------------------------------------------
1233
1234IF (LHOOK) CALL DR_HOOK('RADLSW',1,ZHOOK_HANDLE)
1235END SUBROUTINE RADLSW
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
Note: See TracBrowser for help on using the repository browser.