source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/radlsw.F90 @ 5308

Last change on this file since 5308 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 41.9 KB
RevLine 
[3331]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
505        ZRADLP(JL)=PREF_LIQ(JL,IKL)
506    ENDIF 
507
508! ===========================================================
509! ___________________________________________________________
510
511! rain drop from          : unused as ZRAINT is 0.
512!    ZRADRD(JL)=500.0_JPRB*ZRAINT(JL)**0.22_JPRB
513!    IF (ZFLWP(JL).GT.0.) THEN
514!      ZRADRD(JL)=ZRADLP(JL)+ZRADRD(JL)
515!    ENDIF   
516
517  ENDDO
518  DO JL = KIDIA,KFDIA
519
520! diagnosing the ice particle effective radius/diameter
521
522!- ice particle effective radius =f(T) from Liou and Ou (1994)
523 
524    IF (PT(JL,IKL) < RTICE) THEN
525      ZTEMPC=PT(JL,IKL)-RTT
526    ELSE
527      ZTEMPC=RTICE-RTT
528    ENDIF
529    ZRADIP(JL)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
530      & 0.0012_JPRB))   
531
532    IF (NRADIP == 0) THEN
533!-- fixed 40 micron effective radius
534      ZRADIP(JL)= 40.0_JPRB
535      ZDESR(JL) = ZDefRe * ZRADIP(JL)
536     
537    ELSEIF (NRADIP == 1) THEN
538
539!-- old formulation based on Liou & Ou (1994) temperature (40-130microns)   
540      ZRADIP(JL)=MAX(ZRADIP(JL),40.0_JPRB)
541      ZDESR(JL) = ZDefRe * ZRADIP(JL)
542     
543    ELSEIF (NRADIP == 2) THEN 
544!-- formulation following Jakob, Klein modifications to ice content   
545      ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB)
546      ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB)
547      ZDESR(JL)= ZDefRe * ZRADIP(JL)
548 
549    ELSEIF (NRADIP == 3  ) THEN
550 
551!- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999)
552! revised by Sun (2001)
553      IF (ZIWC(JL) > 0.0_JPRB ) THEN
554        ZTEMPC = PT(JL,IKL)-83.15_JPRB
555        ZTCELS = PT(JL,IKL)-RTT
556        ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS
557! Sun, 2001 (corrected from Sun & Rikus, 1999)
558        ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB
559        ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB
560        ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
561!-new        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 30.0_JPRB), 155.0_JPRB)
562        ZDESR(JL) = MIN ( MAX( ZDESR(JL), 45.0_JPRB), 350.0_JPRB)
563        ZRADIP(JL)= ZRefDe * ZDESR(JL)
564      ELSE
565!        ZDESR(JL) = 92.5_JPRB
566        ZDESR(JL) = 80.0_JPRB
567        ZRADIP(JL)= ZRefDe * ZDESR(JL)
568      ENDIF 
569 
570    ELSEIF (NRADIP == 4  ) THEN
571! one uses the cloud droplet radius from newmicro
572! IKL or JK ?? - I think IKL but needs to be verified
573        ZRADIP(JL)=PREF_ICE(JL,IKL)
574    ENDIF 
575   
576  ENDDO
577
578!          2.3    CLOUD SHORTWAVE OPTICAL PROPERTIES
579!                 ----------------------------------
580
581!   -------------------------
582! --+ SW OPTICAL PARAMETERS +  Water clouds after Fouquart (1987)
583!   -------------------------  Ice clouds (Ebert, Curry, 1992)
584
585  DO JSW=1,NSW
586    DO JL = KIDIA,KFDIA
587      ZTOL=0.0_JPRB
588      ZGL =0.0_JPRB
589      ZOL =0.0_JPRB
590      ZTOI=0.0_JPRB
591      ZGI =0.0_JPRB
592      ZOI =0.0_JPRB
593      ZTOR=0.0_JPRB
594      ZGR =0.0_JPRB
595      ZOR =0.0_JPRB
596      IF (ZFLWP(JL)+ZFIWP(JL)+ZFRWP(JL) > 2.0_JPRB * REPSCW ) THEN
597        IF (ZFLWP(JL) >= REPSCW ) THEN
598          IF (NLIQOPT /= 0 ) THEN
599!-- SW: Slingo, 1989
600            ZTOL = ZFLWP(JL)*(RASWCA(JSW)+RASWCB(JSW)/ZRADLP(JL))
601            ZGL  = RASWCE(JSW)+RASWCF(JSW)*ZRADLP(JL)
602            ZOL  = 1. - RASWCC(JSW)-RASWCD(JSW)*ZRADLP(JL)
603          ELSE         
604!-- SW: Fouquart, 1991
605            ZTOL = ZFLWP(JL)*(RYFWCA(JSW)+RYFWCB(JSW)/ZRADLP(JL))
606            ZGL  = RYFWCF(JSW)
607!            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL)
608!-- NB: RSWINHF is there simply for making the CY29R2 branch bit compatible with
609! the previous. Should be cleaned when RRTM_SW becomes active
610            ZOL  = RYFWCC(JSW)-RYFWCD(JSW)*EXP(-RYFWCE(JSW)*ZTOL*RSWINHF)
611          ENDIF
612        ENDIF
613
614        IF (ZFIWP(JL) >= REPSCW ) THEN
615          IF (NICEOPT <= 1) THEN
616!-- SW: Ebert-Curry         
617            ZTOI = ZFIWP(JL)*(REBCUA(JSW)+REBCUB(JSW)/ZRADIP(JL))
618            ZGI  = REBCUE(JSW)+REBCUF(JSW)*ZRADIP(JL)
619            ZOI  = 1.0_JPRB - REBCUC(JSW)-REBCUD(JSW)*ZRADIP(JL)
620           
621          ELSEIF (NICEOPT == 2) THEN 
622!-- SW: Fu-Liou 1993
623            Z1RADI = 1.0_JPRB / ZDESR(JL)
624            ZBETAI = RFLAA0(JSW)+Z1RADI* RFLAA1(JSW)
625            ZTOI = ZFIWP(JL) * ZBETAI
626            ZOMGI= RFLBB0(JSW)+ZRADIP(JL)*(RFLBB1(JSW) + ZRADIP(JL) &
627             & *(RFLBB2(JSW)+ZRADIP(JL)* RFLBB3(JSW) ))             
628            ZOI  = 1.0_JPRB - ZOMGI
629            ZOMGP= RFLCC0(JSW)+ZRADIP(JL)*(RFLCC1(JSW) + ZRADIP(JL) &
630             & *(RFLCC2(JSW)+ZRADIP(JL)* RFLCC3(JSW) ))   
631            ZFDEL= RFLDD0(JSW)+ZRADIP(JL)*(RFLDD1(JSW) + ZRADIP(JL) &
632             & *(RFLDD2(JSW)+ZRADIP(JL)* RFLDD3(JSW) ))   
633            ZGI  = ((1.0_JPRB -ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) / 3.0_JPRB
634           
635          ELSEIF (NICEOPT == 3) THEN 
636!-- SW: Fu 1996
637            Z1RADI = 1.0_JPRB / ZDESR(JL)
638            ZBETAI = RFUAA0(JSW)+Z1RADI* RFUAA1(JSW)
639            ZTOI = ZFIWP(JL) * ZBETAI
640            ZOMGI= RFUBB0(JSW)+ZDESR(JL)*(RFUBB1(JSW) + ZDESR(JL) &
641             &   *(RFUBB2(JSW)+ZDESR(JL)* RFUBB3(JSW) ))           
642            ZOI  = 1.0_JPRB - ZOMGI
643            ZGI  = RFUCC0(JSW)+ZDESR(JL)*(RFUCC1(JSW) + ZDESR(JL) &
644             &   *(RFUCC2(JSW)+ZDESR(JL)* RFUCC3(JSW) ))
645            ZGI  = MIN(1.0_JPRB, ZGI)
646     
647          ENDIF
648        ENDIF
649
650!        IF (ZFRWP(JL) >= REPSCW ) THEN
651!          ZTOR= ZFRWP(JL)*0.003_JPRB * ZRAINT(JL)**(-0.22_JPRB)         
652!          ZOR = 1.0_JPRB - RROMA(JSW)*ZRAINT(JL)**RROMB(JSW)
653!          ZGR = RRASY(JSW)
654!        ENDIF   
655
656!  - MIX of WATER and ICE CLOUDS
657        ZTAUMX= ZTOL + ZTOI + ZTOR
658        ZOMGMX= ZTOL*ZOL + ZTOI*ZOI + ZTOR*ZOR
659        ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI + ZTOR*ZOR*ZGR
660
661        ZASYMX= ZASYMX/ZOMGMX
662        ZOMGMX= ZOMGMX/ZTAUMX
663
664! --- SW FINAL CLOUD OPTICAL PARAMETERS
665
666        ZCLDSW(JL,JK)  = PCLFR(JL,IKL)
667        ZTAU(JL,JSW,JK)  = ZTAUMX
668        ZOMEGA(JL,JSW,JK)= ZOMGMX
669        ZCG(JL,JSW,JK)   = ZASYMX
670      ENDIF
671    ENDDO
672  ENDDO
673
674  IF(LLDEBUG) THEN
675   call writefield_phy("radlsw_ztau",ztau(:,1,:),klev)
676  ENDIF
677
678!          2.4    CLOUD LONGWAVE OPTICAL PROPERTIES FOR EC-OPE
679!                 --------------------------------------------
680
681!   -------------------------
682! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Smith and Shi (1992)
683!   -------------------------  Ice clouds (Ebert, Curry, 1992)
684
685  IF (.NOT.LRRTM) THEN
686
687    DO JL = KIDIA,KFDIA
688      ZALFICE(JL)=0.0_JPRB
689      ZGAMICE(JL)=0.0_JPRB
690      ZBICE(JL)=0.0_JPRB
691      ZTICE(JL)=(PT(JL,IKL)-TSTAND)/TSTAND
692      IF (NICEOPT == 1) THEN
693        ZBICFU(JL)=1.0_JPRB
694      ELSE
695        ZBICFU(JL)=0.0_JPRB
696      ENDIF
697      ZKICFU(JL)=0.0_JPRB
698    ENDDO
699   
700    DO JNU= 1,NSIL
701      DO JL = KIDIA,KFDIA
702        ZRES(JL)  = XP(1,JNU)+ZTICE(JL)*(XP(2,JNU)+ZTICE(JL)*(XP(3,&
703         & JNU)&
704         & +ZTICE(JL)*(XP(4,JNU)+ZTICE(JL)*(XP(5,JNU)+ZTICE(JL)*(XP(6,&
705         & JNU)&
706         & ))))) 
707        ZBICE(JL) = ZBICE(JL) + ZRES(JL)
708        ZGAMICE(JL) = ZGAMICE(JL) + REBCUI(JNU)*ZRES(JL)
709        ZALFICE(JL) = ZALFICE(JL) + REBCUJ(JNU)*ZRES(JL)
710      ENDDO
711    ENDDO
712   
713!-- Fu et al. (1998) with M'91 LW scheme   
714    IF (NICEOPT == 2 .OR. NICEOPT == 3) THEN
715      DO JRTM=1,16
716        DO JL=KIDIA,KFDIA
717          IF (PT(JL,IKL) < 160.0_JPRB) THEN
718            INDLAY=1
719            ZTBLAY =PT(JL,IKL)-160.0_JPRB
720          ELSEIF (PT(JL,IKL) < 339.0_JPRB ) THEN
721            INDLAY=PT(JL,IKL)-159.0_JPRB
722            INDLAY=MAX(INDLAY,1)
723            ZTBLAY =PT(JL,IKL)-INT(PT(JL,IKL))
724          ELSE
725            INDLAY=180
726            ZTBLAY =PT(JL,IKL)-339.0_JPRB
727          ENDIF
728          ZADDPLK = TOTPLNK(INDLAY+1,JRTM)-TOTPLNK(INDLAY,JRTM)
729          ZPLANCK = DELWAVE(JRTM) * (TOTPLNK(INDLAY,JRTM) + ZTBLAY*ZADDPLK)
730          ZBICFU(JL) = ZBICFU(JL) + ZPLANCK
731       
732          IF (ZIWC(JL) > 0.0_JPRB ) THEN
733            ZRATIO =  1.0_JPRB / ZDESR(JL)
734            IF (NICEOPT == 2) THEN
735! ice cloud spectral emissivity a la Fu & Liou (1993)
736              ZMABSD = RFULIO(JRTM,1) + ZRATIO &
737               & *(RFULIO(JRTM,2) + ZRATIO*RFULIO(JRTM,3)) 
738         
739! ice cloud spectral emissivity a la Fu et al (1998)
740            ELSEIF (NICEOPT == 3) THEN
741              ZMABSD = RFUETA(JRTM,1) + ZRATIO &
742               & *(RFUETA(JRTM,2) + ZRATIO*RFUETA(JRTM,3)) 
743            ENDIF
744            ZKICFU(JL) = ZKICFU(JL)+ ZMABSD*ZPLANCK
745          ENDIF 
746        ENDDO
747      ENDDO
748    ENDIF
749   
750    DO JL = KIDIA,KFDIA
751      ZGAMICE(JL) = ZGAMICE(JL) / ZBICE(JL)
752      ZALFICE(JL) = ZALFICE(JL) / ZBICE(JL)
753      ZKICFU(JL)  = ZKICFU(JL) / ZBICFU(JL)
754     
755      IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
756
757        IF (NLIQOPT == 0) THEN
758! water cloud emissivity a la Smith & Shi (1992)
759          ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
760          ZMSALD= 0.158_JPRB*ZMULTL
761          ZMSALU= 0.130_JPRB*ZMULTL
762         
763        ELSE
764! water cloud emissivity a la Savijarvi (1997)
765          ZMSALU= 0.2441_JPRB-0.0105_JPRB*ZRADLP(JL)
766          ZMSALD= 1.2154_JPRB*ZMSALU
767         
768        ENDIF 
769         
770        IF (NICEOPT == 0) THEN         
771! ice cloud emissivity a la Smith & Shi (1992)
772          ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
773          ZMSAID= 0.113_JPRB*ZMULTI
774          ZMSAIU= 0.093_JPRB*ZMULTI
775
776        ELSEIF (NICEOPT == 1) THEN
777! ice cloud emissivity a la Ebert & Curry (1992)
778          ZMSAID= 1.66_JPRB*(ZALFICE(JL)+ZGAMICE(JL)/ZRADIP(JL))
779          ZMSAIU= ZMSAID
780         
781        ELSEIF (NICEOPT == 2 .OR. NICEOPT == 3) THEN 
782! ice cloud emissivity a la Fu & Liou (1993) or Fu et al. (1998)
783          ZMSAID= 1.66_JPRB*ZKICFU(JL)
784          ZMSAIU= ZMSAID         
785        ENDIF
786       
787        IF (NINHOM == 1) THEN
788          ZZFLWP= ZFLWP(JL) * RLWINHF
789          ZZFIWP= ZFIWP(JL) * RLWINHF
790        ELSE
791          ZZFLWP= ZFLWP(JL)
792          ZZFIWP= ZFIWP(JL)
793        ENDIF
794
795! effective cloudiness accounting for condensed water
796        ZCLDLD(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALD*ZZFLWP-ZMSAID* &
797         & ZZFIWP)) 
798        ZCLDLU(JL,JK) = PCLFR(JL,IKL)*(1.0_JPRB-EXP(-ZMSALU*ZZFLWP-ZMSAIU* &
799         & ZZFIWP)) 
800      ENDIF
801    ENDDO
802
803  ELSE
804
805!          2.5    CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM
806!                 ------------------------------------------
807
808!   -------------------------
809! --+ LW OPTICAL PARAMETERS +  Water (and Ice) from Savijarvi (1998)
810!   -------------------------  Ice clouds (Ebert, Curry, 1992)
811
812! No need for a fixed diffusivity factor, accounted for spectrally below
813! The detailed spectral structure does not require defining upward and
814! downward effective optical properties
815
816    DO JRTM=1,16
817      DO JL = KIDIA,KFDIA
818        ZTAUCLD(JL,JK,JRTM) = 0.0_JPRB
819        ZMSALD = 0.0_JPRB
820        ZMSAID = 0.0_JPRB
821       
822        IF (ZFLWP(JL)+ZFIWP(JL) > REPSCW) THEN
823   
824          IF (NLIQOPT == 0 .OR. NLIQOPT >= 3 ) THEN
825! water cloud total emissivity a la Smith and Shi (1992)
826            ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLP(JL)
827            ZRSALD= 0.144_JPRB*ZMULTL / 1.66_JPRB
828           
829          ELSEIF (NLIQOPT == 1) THEN
830! water cloud spectral emissivity a la Savijarvi (1997)
831            ZRSALD= RHSAVI(JRTM,1) + ZRADLP(JL)&
832             & *(RHSAVI(JRTM,2) + ZRADLP(JL)*RHSAVI(JRTM,3)) 
833             
834          ELSEIF (NLIQOPT == 2) THEN
835! water cloud spectral emissivity a la Lindner and Li (2000)
836            Z1RADL = 1.0_JPRB / ZRADLP(JL)
837            ZEXTCF = RLILIA(JRTM,1)+ZRADLP(JL)*RLILIA(JRTM,2)+ Z1RADL*&
838             & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*&
839             & RLILIA(JRTM,5) )) 
840            Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) &
841             & + ZRADLP(JL) *(RLILIB(JRTM,3) + ZRADLP(JL)*RLILIB(JRTM,4) )
842            ZRSALD = Z1MOMG * ZEXTCF
843          ENDIF 
844         
845          IF (NICEOPT == 0) THEN
846! ice cloud spectral emissivity a la Smith & Shi (1992)
847            ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIP(JL)
848            ZRSAID= 0.103_JPRB*ZMULTI / 1.66_JPRB
849           
850          ELSEIF (NICEOPT == 1) THEN
851! ice cloud spectral emissivity a la Ebert-Curry (1992)
852            ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIP(JL)
853           
854          ELSEIF (NICEOPT == 2) THEN
855! ice cloud spectral emissivity a la Fu & Liou (1993)
856            Z1RADI = 1.0_JPRB / ZDESR(JL)
857            ZRSAID = RFULIO(JRTM,1) + Z1RADI &
858             & *(RFULIO(JRTM,2) + Z1RADI * RFULIO(JRTM,3)) 
859             
860          ELSEIF (NICEOPT == 3) THEN
861! ice cloud spectral emissivity a la Fu et al (1998) including
862! parametrisation for LW scattering effect 
863            Z1RADI = 1.0_JPRB / ZDESR(JL)
864            ZRSAIE = RFUETA(JRTM,1) + Z1RADI &
865             &*(RFUETA(JRTM,2) + Z1RADI * RFUETA(JRTM,3))
866            ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESR(JL)*( RFUETB(JRTM,2) +ZDESR(JL)*( RFUETB(JRTM,3) +ZDESR(JL)* RFUETB(JRTM,4))))
867            ZRSAIG = RFUETC(JRTM,1) +ZDESR(JL)*( RFUETC(JRTM,2) +ZDESR(JL)*( RFUETC(JRTM,3) +ZDESR(JL)* RFUETC(JRTM,4)))
868            ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) )
869            ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE
870          ENDIF   
871         
872          ZTAUD = ZRSALD*ZFLWP(JL)+ZRSAID*ZFIWP(JL)
873
874! Diffusivity correction within clouds a la Savijarvi
875          IF (LDIFFC) THEN
876            ZDIFFD=MIN(MAX(1.517_JPRB-0.156_JPRB*LOG(ZTAUD) , 1.0_JPRB), &
877             &     2.0_JPRB)
878          ELSE
879            ZDIFFD=1.66_JPRB
880          ENDIF
881
882          ZTAUCLD(JL,JK,JRTM) = ZTAUD*ZDIFFD
883        ENDIF
884       
885      ENDDO
886    ENDDO
887
888  ENDIF
889
890ENDDO
891
892NUAER = NUA
893NTRAER = NTRA
894
895!     ------------------------------------------------------------------
896!
897!          2.6    SCALING OF OPTICAL THICKNESS
898!                 SPECTRALLY, ACCOUNTING FOR VERTICAL VARIABILITY
899
900JEXPLR=NLAYINH
901JXPLDN=2*JEXPLR+1
902
903IF (NINHOM == 1) THEN
904!-- simple scaling a la Tiedtke (1996) with RSWINHF in SW and RLWINHF in LW
905  DO JSW=1,NSW
906    DO JK=1,KLEV
907      DO JL=KIDIA,KFDIA
908        ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK) * RSWINHF
909      ENDDO
910    ENDDO
911  ENDDO
912
913  DO JRTM=1,16
914    DO JK=1,KLEV
915      DO JL=KIDIA,KFDIA
916        ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM) * RLWINHF
917      ENDDO
918    ENDDO
919  ENDDO
920
921ELSEIF (JEXPLR /= 0) THEN
922  DO JSW=1,NSW
923    DO JK=1,KLEV
924      DO JL=KIDIA,KFDIA
925        ZSQUAR(JL,JK)=0.0_JPRB
926        ZVARIA(JL,JK)=1.0_JPRB
927      ENDDO
928    ENDDO
929!-- range should be defined from Hogan & Illingworth
930    DO JK=1+JEXPLR,KLEV-JEXPLR
931      DO JL=KIDIA,KFDIA
932!        ZAVDP(JL)=0.0_JPRB
933        ZAVTO(JL)=0.0_JPRB
934        ZSQTO(JL)=0.0_JPRB
935      ENDDO
936      DO JKI=JK-JEXPLR,JK+JEXPLR
937        IKI=KLEV+1-JKI
938        DO JL=KIDIA,KFDIA
939!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
940          ZAVTO(JL)=ZAVTO(JL)+ZTAU(JL,JSW,JKI)
941        ENDDO
942      ENDDO
943      DO JL=KIDIA,KFDIA
944!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
945        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
946      ENDDO
947      DO JKI=JK-JEXPLR,JK+JEXPLR
948        IKI=KLEV+1-JKI
949        DO JL=KIDIA,KFDIA
950!          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)/PDP(JL,IKI)-ZAVTO(JL))**2
951          ZSQTO(JL)=ZSQTO(JL)+(ZTAU(JL,JSW,JKI)-ZAVTO(JL))**2
952        ENDDO
953      ENDDO
954      DO JL=KIDIA,KFDIA
955        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
956        IF (ZAVTO(JL) > 0.0_JPRB) THEN
957          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
958          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
959        ELSE
960          ZVARIA(JL,JK)=0.0_JPRB
961          ZSQUAR(JL,JK)=1.0_JPRB
962        ENDIF
963
964!-- scaling a la Barker
965        IF (NINHOM ==2) THEN
966          ZTAU(JL,JSW,JK)=ZTAU(JL,JSW,JK)*ZSQUAR(JL,JK)
967
968!-- scaling a la Cairns et al.
969        ELSEIF (NINHOM == 3) THEN
970          ZVI=ZVARIA(JL,JK)
971          ZTAU(JL,JSW,JK)  = ZTAU(JL,JSW,JK)/(1.0_JPRB+ZVI)
972          ZOMEGA(JL,JSW,JK)= ZOMEGA(JL,JSW,JK) &
973            &   /(1.0_JPRB + ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK) ) )
974          ZCG(JL,JSW,JK)   = ZCG(JL,JSW,JK) &
975            & *(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK))) &
976            & /(1.0_JPRB+ZVI*(1.0_JPRB-ZOMEGA(JL,JSW,JK)*ZCG(JL,JSW,JK)))
977        ENDIF
978      ENDDO
979!      JL=KIDIA
980!      print 9261,JSW,JK,ZTAU(JL,JSW,JK),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
9819261   format(1x,'Varia1 ',2I3,7F10.4)
982    ENDDO
983  ENDDO
984
985
986  DO JRTM=1,16
987    DO JK=1,KLEV
988      DO JL=KIDIA,KFDIA
989        ZSQUAR(JL,JK)=0.0_JPRB
990        ZVARIA(JL,JK)=1.0_JPRB
991      ENDDO
992    ENDDO
993!-- range to be defined from Hogan & Illingworth
994    DO JK=1+JEXPLR,KLEV-JEXPLR
995      DO JL=KIDIA,KFDIA
996!        ZAVDP(JL)=0.0_JPRB
997        ZAVTO(JL)=0.0_JPRB
998        ZSQTO(JL)=0.0_JPRB
999      ENDDO
1000      DO JKI=JK-JEXPLR,JK+JEXPLR
1001        IKI=KLEV+1-JKI
1002        DO JL=KIDIA,KFDIA
1003!          ZAVDP(JL)=ZAVDP(JL)+PDP(JL,IKI)/RG
1004          ZAVTO(JL)=ZAVTO(JL)+ZTAUCLD(JL,JKI,JRTM)
1005        ENDDO
1006      ENDDO
1007      DO JL=KIDIA,KFDIA
1008!        ZAVTO(JL)=ZAVTO(JL)/ZAVDP(JL)
1009        ZAVTO(JL)=ZAVTO(JL)/JXPLDN
1010      ENDDO
1011      DO JKI=JK-JEXPLR,JK+JEXPLR
1012        IKI=KLEV+1-JKI
1013        DO JL=KIDIA,KFDIA
1014!          ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)/PDP(JL,IKI)-ZAVTO(JL))**2
1015            ZSQTO(JL)=ZSQTO(JL)+(ZTAUCLD(JL,JKI,JRTM)-ZAVTO(JL))**2
1016        ENDDO
1017      ENDDO
1018      DO JL=KIDIA,KFDIA
1019        ZSQTO(JL)=SQRT(ZSQTO(JL)/(JXPLDN*(JXPLDN-1)))
1020        IF (ZAVTO(JL) > 0.0_JPRB) THEN
1021          ZVARIA(JL,JK)=(ZSQTO(JL)/ZAVTO(JL))**2
1022          ZSQUAR(JL,JK)=EXP(-ZVARIA(JL,JK))
1023        ELSE
1024          ZVARIA(JL,JK)=0.0_JPRB
1025          ZSQUAR(JL,JK)=1.0_JPRB
1026        ENDIF
1027
1028!-- scaling a la Barker
1029        IF (NINHOM ==2) THEN
1030          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)*ZSQUAR(JL,JK)
1031
1032!-- scaling a la Cairns et al.
1033        ELSEIF (NINHOM == 3) THEN
1034          ZVI=ZVARIA(JL,JK)
1035          ZTAUCLD(JL,JK,JRTM)=ZTAUCLD(JL,JK,JRTM)/(1.0_JPRB+ZVI)
1036        ENDIF
1037      ENDDO
1038!      JL=KIDIA
1039!      print 9262,JRTM,JK,ZTAUCLD(JL,JK,JRTM),ZAVTO(JL),ZSQTO(JL),ZVARIA(JL,JK),ZSQUAR(JL,JK)
10409262   format(1x,'Varia2 ',2I3,7F10.4)
1041    ENDDO
1042  ENDDO
1043ENDIF
1044
1045
1046
1047!     ------------------------------------------------------------------
1048!
1049!*         2.7    DIFFUSIVITY FACTOR OR SATELLITE VIEWING ANGLE
1050!                 ---------------------------------------------
1051
1052DO JL = KIDIA,KFDIA
1053  ZVIEW(JL) = DIFF
1054ENDDO
1055
1056!     ------------------------------------------------------------------
1057
1058!*         3.     CALL LONGWAVE RADIATION CODE
1059!                 ----------------------------
1060
1061!*         3.1    FULL LONGWAVE RADIATION COMPUTATIONS
1062!                 ------------------------------------
1063
1064!print *,'RADLSW: LPHYLIN, LRRTM',LPHYLIN, LRRTM
1065IF (.NOT.LPHYLIN) THEN
1066  IF ( .NOT. LRRTM) THEN
1067
1068    CALL LW &
1069     & ( KIDIA , KFDIA , KLON  , KLEV , KMODE,&
1070     & PCCO2 , ZCLDLD, ZCLDLU,&
1071     & PDP   , ZDT0  , ZEMIS , ZEMIW,&
1072     & ZPMB  , POZON , ZTL,&
1073     & PAER  , ZTAVE , ZVIEW , PQ,&
1074     & ZEMIT , PFLUX , PFLUC &
1075     & ) 
1076!   print *,'RADLSW: apres CALL LW'
1077    IF(LLDEBUG) THEN
1078    call writefield_phy('radlsw_flux1',PFLUX(:,1,:),klev+1)
1079    call writefield_phy('radlsw_flux2',PFLUX(:,2,:),klev+1)
1080    call writefield_phy('radlsw_fluc1',PFLUC(:,1,:),klev+1)
1081    call writefield_phy('radlsw_fluc2',PFLUC(:,2,:),klev+1)
1082    ENDIF
1083
1084  ELSE
1085
1086!*         3.2    FULL LONGWAVE RADIATION COMPUTATIONS - RRTM
1087!                 ------------------------------------   ----
1088
1089!  i)  pass ZOZN (ozone mass mixing ratio) to RRTM; remove pressure
1090!      weighting applied to POZON in driverMC (below)
1091!  ii) pass ZEMIS and ZEMIW to RRTM; return ZEMIT from RRTM
1092!  iii)pass ZTAUCLD, cloud optical depths (water+ice) to RRTM,
1093!      computed from equations above
1094!  iv) pass ECRT arrays to RRTM arrays in interface routine ECRTATM
1095!      in module rrtm_ecrt.f
1096
1097    DO JL = KIDIA,KFDIA
1098      DO JK = 1, KLEV
1099        ZOZN(JL,JK) = POZON(JL,JK)/PDP(JL,JK)
1100      ENDDO
1101    ENDDO
1102
1103!   print *,'RADLSW: avant CALL RRTM_RRTM_140GP,PAP=',PAP(1,:)
1104    CALL RRTM_RRTM_140GP &
1105     & ( KIDIA , KFDIA , KLON  , KLEV,&
1106     & PAER  , PAPH  , PAP,&
1107     & PTS   , PTH   , PT,&
1108     & ZEMIS , ZEMIW,&
1109     & PQ    , PCCO2 , ZOZN  ,&
1110     & ZCLDSW  , ZTAUCLD,&
1111     & PTAU_LW,&
1112     & ZEMIT , PFLUX , PFLUC , ZTCLEAR )
1113!   print *,'RADLSW: apres CALL RRTM_RRTM_140GP'
1114
1115  ENDIF
1116ELSE
1117  ZEMIT (:)   = 0.0_JPRB
1118  PFLUX(:,:,:)= 0.0_JPRB
1119  PFLUC(:,:,:)= 0.0_JPRB
1120! print *,'RADLSW: ZEMIT,PFLUX et PFLUC = 0'
1121ENDIF
1122
1123!     ------------------------------------------------------------------
1124
1125!*         4.     CALL SHORTWAVE RADIATION CODE
1126!                 -----------------------------
1127
1128ZRMUZ=0.0_JPRB
1129DO JL = KIDIA,KFDIA
1130  ZRMUZ = MAX (ZRMUZ, ZMU0(JL))
1131ENDDO
1132
1133IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1134  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1135  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1136  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1137  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1138  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1139  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1140  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1141  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1142  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1143  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1144  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1145  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1146  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1147  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1148ENDIF
1149
1150IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1151  WRITE(NULOUT,'(4E15.8)') PRII0,PCCO2,ZPSOL(KIDIA),ZMU0(KIDIA)
1152  WRITE(NULOUT,'("ZALBD ",6E15.8)') (ZALBD(KIDIA,JSW),JSW=1,NSW)
1153  WRITE(NULOUT,'("ZALBP ",6E15.8)') (ZALBP(KIDIA,JSW),JSW=1,NSW)
1154  WRITE(NULOUT,'("PQ    ",10E12.5)') (PQ(KIDIA,JK),JK=1,KLEV)
1155  WRITE(NULOUT,'("PQS   ",10E12.5)') (PQS(KIDIA,JK),JK=1,KLEV)
1156  WRITE(NULOUT,'("PDP   ",10E12.5)') (PDP(KIDIA,JK),JK=1,KLEV)
1157  WRITE(NULOUT,'("ZPMB  ",10E12.5)') (ZPMB(KIDIA,JK),JK=1,KLEV+1)
1158  WRITE(NULOUT,'("ZTAVE ",10E12.5)') (ZTAVE(KIDIA,JK),JK=1,KLEV)
1159  WRITE(NULOUT,'("ZCLDSW",10E12.5)') (ZCLDSW(KIDIA,JK),JK=1,KLEV)
1160  WRITE(NULOUT,'("ZTAU  ",10E12.5)') ((ZTAU(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1161  WRITE(NULOUT,'("ZCG   ",10E12.5)') ((ZCG(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1162  WRITE(NULOUT,'("ZOMEGA",10E12.5)') ((ZOMEGA(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1163  WRITE(NULOUT,'("ZOZ   ",10E12.5)') (ZOZ(KIDIA,JK),JK=1,KLEV)
1164  WRITE(NULOUT,'("PAER  ",10E12.5)') ((PAER(KIDIA,JSW,JK),JK=1,KLEV),JSW=1,NSW)
1165ENDIF
1166CALL SW &
1167 & ( KIDIA , KFDIA , KLON  , KLEV  , KAER,&
1168 & PRII0 , PCCO2 , ZPSOL , ZALBD , ZALBP , PQ   , PQS,&
1169 & ZMU0  , ZCG   , ZCLDSW, PDP   , ZOMEGA, ZOZ  , ZPMB,&
1170 & ZTAU  , ZTAVE , PAER,&
1171 & PFSDN , PFSUP , PFSCDN, PFSCUP,&
1172 & ZFSDNN, ZFSDNV, ZFSUPN, ZFSUPV,&
1173 & ZFCDNN, ZFCDNV, ZFCUPN, ZFCUPV,&
1174 & ZSUDU , ZUVDF , ZPARF ,ZPARCF, ZDIFFS, ZDIRFS, &
1175 & LRDUST,PPIZA_DST,PCGA_DST,PTAUREL_DST&
1176   & )
1177PFSDNV=ZFSDNV
1178PFSDNN=ZFSDNN
1179IF (SIZE(PSFSWDIR,2)>1) THEN
1180  PSFSWDIR= ZDIRFS
1181  PSFSWDIF= ZDIFFS
1182ELSE
1183  PSFSWDIR (:,1) = ZFSDNV(:) + ZFSDNN(:)
1184  PSFSWDIF (:,:) = 0.
1185ENDIF
1186
1187IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1188  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1189  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1190  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1191  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1192  LEDBUG=.FALSE.
1193ENDIF
1194IF (NSTEP == 0 .AND. LEDBUG .AND. ZMU0(KIDIA) > 0.0_JPRB) THEN
1195  WRITE(NULOUT,'("ZFSDWN",10E12.5)') (ZFSDWN(KIDIA,JK),JK=1,KLEV)
1196  WRITE(NULOUT,'("ZFSUP ",10E12.5)') (ZFSUP (KIDIA,JK),JK=1,KLEV)
1197  WRITE(NULOUT,'("ZFCDWN",10E12.5)') (ZFCDWN(KIDIA,JK),JK=1,KLEV)
1198  WRITE(NULOUT,'("ZFCUP ",10E12.5)') (ZFCUP (KIDIA,JK),JK=1,KLEV)
1199  LEDBUG=.FALSE.
1200ENDIF
1201!     ------------------------------------------------------------------
1202
1203!*         5.     FILL UP THE MODEL NET LW AND SW RADIATIVE FLUXES
1204!                 ------------------------------------------------
1205
1206DO JKL = 1 , KLEV+1
1207  JK = KLEV+1 + 1 - JKL
1208  DO JL = KIDIA,KFDIA
1209    PFLS(JL,JKL) = ZFSDWN(JL,JK) - ZFSUP(JL,JK)
1210    PFLT(JL,JKL) = - PFLUX(JL,1,JK) - PFLUX(JL,2,JK)
1211    PFCS(JL,JKL) = ZFCDWN(JL,JK) - ZFCUP(JL,JK)
1212    PFCT(JL,JKL) = - PFLUC(JL,1,JK) - PFLUC(JL,2,JK)
1213  ENDDO
1214ENDDO
1215
1216DO JL = KIDIA,KFDIA
1217  PFRSOD(JL)=ZFSDWN(JL,1)
1218  PEMIT (JL)=ZEMIT (JL)
1219  PSUDU (JL)=ZSUDU (JL)
1220  PUVDF (JL)=ZUVDF (JL)
1221  PPARF (JL)=ZPARF (JL)
1222  PPARCF(JL)=ZPARCF(JL)
1223  PTINCF(JL)=PRII0 * ZMU0(JL)
1224ENDDO
1225!print 9501,(PUVDF(JL),JL=KIDIA,KFDIA)
12269501 format(1x,'RADLSW PUVDF: ',30f6.1)
1227!print 9502,(PPARF(JL),JL=KIDIA,KFDIA)
12289502 format(1x,'RADLSW PPARF: ',30f6.1)
1229
1230!     --------------------------------------------------------------
1231
1232IF (LHOOK) CALL DR_HOOK('RADLSW',1,ZHOOK_HANDLE)
1233END SUBROUTINE RADLSW
1234
1235
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
Note: See TracBrowser for help on using the repository browser.