source: LMDZ5/trunk/libf/phylmd/rrtm/radlsw.F90 @ 2031

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

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

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