Juan 29/06/2017:radiations.f90, Check if Pressure Decreasing with height <-> elsif...
[MNH-git_open_source-lfs.git] / src / MNH / radiations.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !-----------------------------------------------------------------
6 !    ########################
7      MODULE MODI_RADIATIONS   
8 !    ########################
9 !
10 INTERFACE 
11 !
12     SUBROUTINE RADIATIONS (OCLOSE_OUT,HFMFILE,HLUOUT,OCLEAR_SKY,OCLOUD_ONLY,&
13                KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW,   &
14                PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB,KSTATM, &
15                KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL,                         &
16                PDIR_ALB, PSCA_ALB, PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM,  &
17                PTHT, PRT, PPABST, POZON, PAER,PDST_WL, PAER_CLIM, PSVT,   &
18                PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF,PRHODREF, PZZ,   &
19                PRADEFF, PSWU, PSWD, PLWU, PLWD, PDTHRADSW, PDTHRADLW      )
20 !
21 LOGICAL, INTENT(IN)                  :: OCLOSE_OUT! flag indicating that a FM
22                                                   ! file is opened during this 
23                                                   ! time-step
24 CHARACTER(LEN=*), INTENT(IN)         :: HFMFILE   ! Name of the output
25                                                   ! FM-file
26 CHARACTER(LEN=*), INTENT(IN)         :: HLUOUT    ! Output-listing name for
27                                                   ! model n
28 LOGICAL, INTENT(IN)                  :: OCLOUD_ONLY! flag for the cloud column
29                                                    !    computations only
30 LOGICAL, INTENT(IN)                  :: OCLEAR_SKY ! 
31 INTEGER, INTENT(IN)                  :: KDLON   ! number of columns where the
32                                                 ! radiation calculations are
33                                                 !         performed
34 INTEGER, INTENT(IN)                  :: KFLEV   ! number of vertical levels
35                                                 !    where the radiation
36                                                 ! calculations are performed
37 INTEGER, INTENT(IN)                  :: KRAD_DIAG   ! index for the number of
38                                                     !  fields in the output
39 INTEGER, INTENT(IN)                  :: KFLUX   ! number of top and ground 
40                                                 ! fluxes for the ZFLUX array
41 INTEGER, INTENT(IN)                  :: KRAD    ! number of satellite radiances
42                                                 ! for the ZRAD and ZRADCS arrays
43 INTEGER, INTENT(IN)                  :: KAER    ! number of AERosol classes
44
45 INTEGER, INTENT(IN)                  :: KSWB    ! number of SW band  
46 INTEGER, INTENT(IN)                  :: KSTATM  ! index of the standard 
47                                                 ! atmosphere level just above
48                                                 !      the model top
49 INTEGER, INTENT(IN)                  :: KRAD_COLNBR ! factor by which the memory
50                                                     ! is splitted
51 !
52                                                !Choice of :             
53 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADL!cloud liquid effective radius calculation
54 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADI!cloud ice effective radius calculation
55 CHARACTER (LEN=*), INTENT (IN)       :: HOPWSW !cloud water SW optical properties   
56 CHARACTER (LEN=*), INTENT (IN)       :: HOPISW !ice water SW optical properties 
57 CHARACTER (LEN=*), INTENT (IN)       :: HOPWLW !cloud water LW optical properties
58 CHARACTER (LEN=*), INTENT (IN)       :: HOPILW !ice water  LW optical properties
59 REAL,              INTENT(IN)        :: PFUDG  ! subgrid cloud inhomogenity factor
60 !
61 REAL, DIMENSION(:,:),     INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
62 REAL,                     INTENT(IN) :: PCORSOL ! SOLar constant CORrection
63 REAL, DIMENSION(:,:),     INTENT(IN) :: PSEA    ! Land-sea mask
64 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
65 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
66 REAL, DIMENSION(:,:),     INTENT(IN) :: PEMIS   ! Surface IR EMISsivity
67 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PCLDFR  ! CLouD FRaction
68 REAL,                     INTENT(IN) :: PCCO2   ! CO2 content
69 REAL, DIMENSION(:,:),     INTENT(IN) :: PTSRAD  ! RADiative Surface Temperature
70 REAL, DIMENSION(:,:),     INTENT(IN) :: PSTATM  ! selected standard atmosphere
71 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PTHT    ! THeta at t
72 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT     ! moist variables at t
73 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PPABST  ! pressure at t
74 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT    ! scalar variable ( C2R2 and C1R3  particle) 
75 !
76 REAL, DIMENSION(:,:,:),   POINTER    :: POZON   ! OZON field from clim.
77 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER    ! AERosols optical thickness from clim. 
78 REAL, DIMENSION(:,:,:,:), POINTER    :: PDST_WL ! AERosols Extinction.by wavelength 
79 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER_CLIM    ! AERosols optical thickness from clim.                                                 ! note : the vertical dimension of 
80                                                 ! these fields include the "radiation levels"
81                                                 ! above domain top 
82 !
83 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PRHODREF ![kg/m3] air density
84 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PZZ      ![m] height of layers
85 !
86 INTEGER, DIMENSION(:,:), INTENT(INOUT)  :: KCLEARCOL_TM1 ! trace of cloud/clear col
87                                                          ! at the previous radiation step
88 !                                                 
89 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
90 REAL, DIMENSION(:,:),     INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
91 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect 
92 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse 
93 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWU ! upward SW Flux 
94 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWD ! downward SW Flux 
95 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWU ! upward LW Flux 
96 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWD ! downward LW Flux 
97 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADSW ! dthrad sw 
98 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADLW !  dthradsw
99 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PRADEFF ! effective radius
100 !
101 !
102 END SUBROUTINE RADIATIONS
103 !
104 END INTERFACE
105 !
106 END MODULE MODI_RADIATIONS  
107 !
108 !   #######################################################################
109     SUBROUTINE RADIATIONS (OCLOSE_OUT,HFMFILE,HLUOUT,OCLEAR_SKY,OCLOUD_ONLY,&
110                KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW,   &
111                PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB,KSTATM, &
112                KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL,                         &
113                PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM,   &
114                PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT,  &
115                PDTHRAD, PSRFLWD, PSRFSWD_DIR,PSRFSWD_DIF, PRHODREF, PZZ,  &
116                PRADEFF, PSWU, PSWD, PLWU,PLWD, PDTHRADSW, PDTHRADLW       )
117 !   #######################################################################
118 !
119 !!****  *RADIATIONS * - routine to call the SW and LW radiation calculations
120 !!
121 !!    PURPOSE
122 !!    -------
123 !!      The purpose of this routine is to prepare the temperature, water vapor
124 !!    liquid water, cloud fraction, ozone profiles for the ECMWF radiation
125 !!    calculations. There is a great number of available radiative fluxes in
126 !!    the output, but only the potential temperature radiative tendency and the
127 !!    SW and LW surface fluxes are provided in the output of the routine.
128 !!    Two simplified computations are available (switches OCLEAR_SKY and
129 !!    OCLOUD_ONLY). When OCLOUD_ONLY is .TRUE. the computations are performed
130 !!    for the cloudy columns only. Furthermore with OCLEAR_SKY being .TRUE.
131 !!    the clear sky columns are averaged and the computations are made for
132 !!    the cloudy columns plus a single ensemble-mean clear sky column.
133 !!
134 !!**  METHOD
135 !!    ------
136 !!      First the temperature, water vapor, liquid water, cloud fraction
137 !!    and  profile arrays are built using the current model fields and
138 !!    the standard atmosphere for the upper layer filling.
139 !!    The standard atmosphere is used between the levels IKUP and
140 !!    KFLEV where KFLEV is the number of vertical levels for the radiation 
141 !!    computations.    
142 !!    The aerosols optical thickness and the ozone fields come directly
143 !!    from ini_radiation step (climatlogies used) and are already defined for KFLEV. 
144 !!    Surface parameter ( albedo, emiss ) are also defined from current surface fields.
145 !!    In the case of clear-sky or cloud-only approximations, the cloudy
146 !!    columns are selected by testing the vertically integrated cloud fraction
147 !!    and the radiation computations are performed for these columns plus the
148 !!    mean clear-sky one. In addition, columns where cloud have disapeared are determined
149 !!    by saving cloud trace between radiation step and they are also recalculated
150 !!    in cloud only step. In all case, the sun position correponds to  the centered
151 !!    time between 2 full radiation steps (determined in physparam).
152 !!      Then the ECMWF radiation package is called and the radiative
153 !!    heating/cooling tendancies are reformatted in case of partial
154 !!    computations.  In case of "cloud-only approximation" the only cloudy
155 !!    column radiative fields are updated.
156 !!
157 !!    EXTERNAL
158 !!    --------
159 !!      Subroutine ECMWF_RADIATION_VERS2 : ECMWF interface calling radiation routines
160 !!
161 !!    IMPLICIT ARGUMENTS
162 !!    ------------------
163 !!      Module MODD_TIME : structure of TDTCUR
164 !!      Module MODD_CST  : constants
165 !!        XP00 : reference pressure
166 !!        XCPD : calorific capacity of dry air at constant pressure
167 !!        XRD  : gas constant for dry air
168 !!      Module MODD_PARAMETERS : parameters
169 !!        JPHEXT : Extra columns on the horizontal boundaries
170 !!        JPVEXT : Extra levels on the vertical boundaries
171 !!
172 !!    REFERENCE
173 !!    ---------
174 !!      Book2 of documentation ( routine RADIATIONS )
175 !!
176 !!    AUTHOR
177 !!    ------
178 !!      J.-P. Pinty      * Laboratoire d'Aerologie*
179 !!
180 !!    MODIFICATIONS
181 !!    -------------
182 !!      Original    26/02/95 
183 !!      J.Stein     20/12/95 add the array splitting in order to save memory
184 !!      J.-P. Pinty 19/11/96 change the splitted arrays, specific humidity
185 !!                           and add the ice phase
186 !!      J.Stein     22/06/97 use of the absolute pressure
187 !!      P.Jabouille 31/07/97 impose a zero humidity for dry simulation
188 !!      V.Masson    22/09/97 case of clear-sky approx. with no clear-sky column
189 !!      V.Masson    07/11/97 half level pressure defined from averaged Exner
190 !!                           function
191 !!      V.Masson    07/11/97 modification of junction between standard atm
192 !!                           and model for half level variables (top model
193 !!                           pressure and temperatures are used preferentially
194 !!                           to atm standard profile for the first point).
195 !!      P.Jabouille 24/08/98 impose positivity for ZQLAVE
196 !!      J.-P. Pinty 29/01/98 add storage for diagnostics
197 !!      J. Stein    18/07/99 add the ORAD_DIAG switch and keep inside the
198 !!                           subroutine the partial tendencies 
199 !!
200 !!      F.Solmon    04/03/01  MAJOR MODIFICATIONS, updated version of ECMWF radiation scheme
201 !!      P.Jabouille 05/05/03 bug in humidity conversion
202 !!      Y.Seity     25/08/03  KSWB=6 for SW direct and scattered surface 
203 !!                            downward fluxes used in surface scheme. 
204 !!      P. Tulet    01/20/05  climatologic SSA
205 !!      A. Grini    05/20/05  dust direct effect (optical properties)
206 !!      V.Masson, C.Lac 08/10 Correction of inversion of Diffuse and direct albedo
207 !!      B.Aouizerats 2010     Explicit aerosol optical properties
208 !!      C.Lac       11/2015   Correction on aerosols
209 !!      J.Escobar 30/03/2017  : Management of compilation of ECMWF_RAD in REAL*8 with MNH_REAL=R4
210 !!      J.Escobar 29/06/2017  : Check if Pressure Decreasing with height <-> elsif PB & STOP 
211 !-------------------------------------------------------------------------------
212 !
213 !*       0.    DECLARATIONS
214 !              ------------
215 !
216 USE PARKIND1 , ONLY : JPRB
217 USE MODE_FMWRIT
218 USE MODE_FM
219 USE MODE_ll
220 USE MODI_ECMWF_RADIATION_VERS2
221 USE YOESW    , ONLY : RTAUA    ,RPIZA    ,RCGA
222
223 !
224 USE MODD_TIME
225 USE MODD_CST
226 USE MODD_PARAMETERS
227 USE MODD_RAIN_ICE_DESCR
228 USE MODD_NSV, ONLY : NSV_C2R2,NSV_C2R2BEG,NSV_C2R2END, &
229                      NSV_C1R3,NSV_C1R3BEG,NSV_C1R3END, &
230                      NSV_DSTBEG, NSV_DSTEND, &
231                      NSV_AERBEG, NSV_AEREND, &
232                      NSV_SLTBEG, NSV_SLTEND
233 !
234 USE MODE_THERMO
235
236 USE MODD_DUST, ONLY: LDUST
237 USE MODD_SALT, ONLY: LSALT
238 USE MODD_CH_AEROSOL, ONLY: LORILAM
239 USE MODD_PARAM_RAD_n, ONLY: CAOP
240 USE MODE_DUSTOPT
241 USE MODE_SALTOPT
242 USE MODI_AEROOPT_GET
243 !
244 #ifdef MNH_PGI
245 USE MODE_PACK_PGI
246 #endif
247 !
248 USE MODI_SUM_ll , ONLY : GMINLOC_ll , MIN_ll
249 !  
250 IMPLICIT NONE
251 !
252 !*       0.1   DECLARATIONS OF DUMMY ARGUMENTS :
253 !
254 LOGICAL, INTENT(IN)                  :: OCLOSE_OUT! flag indicating that a FM
255                                                   ! file is opened during this 
256                                                   ! time-step
257 CHARACTER(LEN=*), INTENT(IN)         :: HFMFILE   ! Name of the output
258                                                   ! FM-file
259 CHARACTER(LEN=*), INTENT(IN)         :: HLUOUT    ! Output-listing name for
260                                                   ! model n
261 LOGICAL, INTENT(IN)                  :: OCLOUD_ONLY! flag for the cloud column
262                                                    !    computations only
263 LOGICAL, INTENT(IN)                  :: OCLEAR_SKY ! 
264 INTEGER, INTENT(IN)                  :: KDLON   ! number of columns where the
265                                                 ! radiation calculations are
266                                                 !       performed
267 INTEGER, INTENT(IN)                  :: KFLEV   ! number of vertical levels
268                                                 !    where the radiation
269                                                 ! calculations are performed
270 INTEGER, INTENT(IN)                  :: KRAD_DIAG  ! index for the number of
271                                                    !  fields in the output
272 INTEGER, INTENT(IN)                  :: KFLUX   ! number of top and ground 
273                                                 ! fluxes for the ZFLUX array
274 INTEGER, INTENT(IN)                  :: KRAD    ! number of satellite radiances
275                                                 ! for the ZRAD and ZRADCS arrays
276 INTEGER, INTENT(IN)                  :: KAER    ! number of AERosol classes
277
278 INTEGER, INTENT(IN)                  :: KSWB    ! number of SW band  
279 INTEGER, INTENT(IN)                  :: KSTATM  ! index of the standard 
280                                                 ! atmosphere level just above
281                                                 !      the model top
282 INTEGER, INTENT(IN)                  :: KRAD_COLNBR ! factor by which the memory
283                                                     ! is splitted
284                                                     !
285                                                !Choice of :             
286 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADL ! 
287 CHARACTER (LEN=*), INTENT (IN)       :: HEFRADI ! 
288 CHARACTER (LEN=*), INTENT (IN)       :: HOPWSW !cloud water SW optical properties   
289 CHARACTER (LEN=*), INTENT (IN)       :: HOPISW !ice water SW optical properties 
290 CHARACTER (LEN=*), INTENT (IN)       :: HOPWLW !cloud water LW optical properties
291 CHARACTER (LEN=*), INTENT (IN)       :: HOPILW !ice water  LW optical properties
292 REAL,               INTENT(IN)       :: PFUDG  ! subgrid cloud inhomogenity factor
293 REAL, DIMENSION(:,:),     INTENT(IN) :: PCOSZEN ! COS(zenithal solar angle)
294 REAL,                     INTENT(IN) :: PCORSOL ! SOLar constant CORrection
295 REAL, DIMENSION(:,:),     INTENT(IN) :: PSEA    ! Land-sea mask
296 !
297 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PDIR_ALB! Surface direct ALBedo
298 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PSCA_ALB! Surface diffuse ALBedo
299 REAL, DIMENSION(:,:),     INTENT(IN) :: PEMIS   ! Surface IR EMISsivity
300 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PCLDFR  ! CLouD FRaction
301 REAL,                     INTENT(IN) :: PCCO2   ! CO2 content
302 REAL, DIMENSION(:,:),     INTENT(IN) :: PTSRAD  ! RADiative Surface Temperature
303 REAL, DIMENSION(:,:),     INTENT(IN) :: PSTATM  ! selected standard atmosphere
304 !
305 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PTHT    ! THeta at t
306 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT     ! moist variables at t
307 REAL, DIMENSION(:,:,:),   INTENT(IN) :: PPABST  ! pressure at t
308 REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT    ! scalar variable ( C2R2 and C1R3  particle)
309 !
310 REAL, DIMENSION(:,:,:),   POINTER    :: POZON   ! OZONE field from clim.
311 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER    ! AERosols optical thickness from clim. 
312 REAL, DIMENSION(:,:,:,:), POINTER    :: PDST_WL    ! AERosols Extinction by wavelength . 
313 REAL, DIMENSION(:,:,:,:), POINTER    :: PAER_CLIM    ! AERosols optical thickness from clim.                                                 ! note : the vertical dimension of 
314                                                 ! these fields iclude the "radiation levels"
315                                                 !  above domain top.
316                                                 ! 
317                                                  
318 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PRHODREF ![kg/m3] air density
319 REAL, DIMENSION(:,:,:), INTENT(IN)   :: PZZ      ![m] height of layers
320
321 INTEGER, DIMENSION(:,:), INTENT(INOUT)  :: KCLEARCOL_TM1 ! trace of cloud/clear col
322                                                          ! at the previous radiation step
323 !                                                 
324 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PDTHRAD ! THeta RADiative Tendancy
325 REAL, DIMENSION(:,:),     INTENT(INOUT) :: PSRFLWD ! Downward SuRFace LW Flux
326 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIR ! Downward SuRFace SW Flux DIRect 
327 REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PSRFSWD_DIF ! Downward SuRFace SW Flux DIFfuse 
328 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWU ! upward SW Flux 
329 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PSWD ! downward SW Flux 
330 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWU ! upward LW Flux 
331 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PLWD ! downward LW Flux 
332 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADSW ! dthrad sw 
333 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PDTHRADLW !  dthradsw
334 REAL, DIMENSION(:,:,:),     INTENT(INOUT) :: PRADEFF ! effective radius
335 !
336 !
337 !*       0.2   DECLARATIONS OF LOCAL VARIABLES
338 !
339 LOGICAL                         :: GNOCL     ! .TRUE. when no cloud is present
340                                              !     with OCLEAR_SKY .TRUE.
341 LOGICAL                         :: GAOP      ! .TRUE. when CAOP='EXPL'
342 LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLOUD    ! .TRUE. for the cloudy columns
343 LOGICAL, DIMENSION(KFLEV,KDLON) :: GCLOUDT   ! transpose of the GCLOUD array
344 LOGICAL, DIMENSION(KDLON)       :: GCLEAR_2D ! .TRUE. for the clear-sky columns
345 LOGICAL, DIMENSION(KDLON,KFLEV) :: GCLEAR    ! .TRUE. for all the levels of the 
346                                              !                clear-sky columns
347 LOGICAL, DIMENSION(KDLON,KSWB)  :: GCLEAR_SWB! .TRUE. for all the bands of the  
348                                              !                clear-sky columns
349 INTEGER, DIMENSION(:), ALLOCATABLE :: ICLEAR_2D_TM1 !
350 !
351 INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JALBS! loop indices
352 !
353 INTEGER :: IIB           ! I index value of the first inner mass point
354 INTEGER :: IJB           ! J index value of the first inner mass point
355 INTEGER :: IKB           ! K index value of the first inner mass point
356 INTEGER :: IIE           ! I index value of the last inner mass point
357 INTEGER :: IJE           ! J index value of the last inner mass point
358 INTEGER :: IKE           ! K index value of the last inner mass point
359 INTEGER :: IKU           ! array size for the third  index
360 INTEGER :: IIJ           ! reformatted array index
361 INTEGER :: IKSTAE        ! level number of the STAndard atmosphere array
362 INTEGER :: IKUP          ! vertical level above which STAndard atmosphere data
363                          ! are filled in
364 !
365 INTEGER :: ICLEAR_COL    ! number of    clear-sky columns
366 INTEGER :: ICLOUD_COL    ! number of    cloudy    columns
367 INTEGER :: ICLOUD        ! number of levels corresponding of the cloudy columns
368 INTEGER :: IDIM          ! effective number of columns for which the radiation
369                          ! code is run
370 INTEGER :: INIR          ! index corresponding to NIR fisrt band (in SW)
371 !
372 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZTAVE    ! mean-layer temperature
373 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZTAVE_RAD    ! mean-layer temperature
374 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZPAVE    ! mean-layer pressure
375 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZPAVE_RAD    ! mean-layer pressure
376 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZQSAVE   ! saturation specific humidity
377 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZQVAVE   ! mean-layer specific humidity
378 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQLAVE   ! Liquid water KG/KG
379 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQRAVE   ! Rain water  KG/KG
380 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQIAVE   ! Ice water Kg/KG
381 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQLWC   ! liquid water content kg/m3
382 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQRWC   ! Rain water  content kg/m3
383 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZQIWC   ! ice water content  kg/m3
384 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCFAVE   ! mean-layer cloud fraction
385 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZO3AVE   ! mean-layer ozone content 
386 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZPRES_HL ! half-level pressure
387 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZT_HL    ! half-level temperature
388 REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE   :: ZDPRES   ! layer pressure thickness
389 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCCT_C2R2! Cloud water Concentarion (C2R2)
390 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCRT_C2R2! Rain water Concentarion (C2R2)
391 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCIT_C1R3! Ice water Concentarion (C2R2)
392 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAER     ! aerosol optical thickness
393 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZALBP    ! spectral surface albedo for direct radiations
394 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZALBD    ! spectral surface albedo for diffuse radiations 
395 REAL, DIMENSION (:),  ALLOCATABLE   :: ZEMIS    ! surface LW  emissivity 
396 REAL, DIMENSION (:), ALLOCATABLE    :: ZEMIW    ! surface LW  WINDOW emissivity
397 REAL(KIND=JPRB), DIMENSION(:), ALLOCATABLE     :: ZTS      ! reformatted surface PTSRAD array 
398 REAL, DIMENSION(:), ALLOCATABLE     :: ZLSM     ! reformatted land sea mask
399 REAL, DIMENSION(:),   ALLOCATABLE   :: ZRMU0    ! Reformatted ZMU0 array
400 REAL(KIND=JPRB)                     :: ZRII0    ! corrected solar constant
401 !
402 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTLW    ! LW temperature tendency
403 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDTSW    ! SW temperature tendency
404 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW_CS ! CLEAR-SKY LW NET FLUXES
405 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFLW    ! TOTAL LW NET FLUXES
406 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW_CS ! CLEAR-SKY SW NET FLUXES
407 REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFSW    ! TOTAL SW NET FLUXES
408 REAL, DIMENSION(:,:), ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR ! Top and 
409                                                             ! Ground radiative FLUXes
410 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN ! DowNward SW Flux profiles
411 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP   ! UPward   SW Flux profiles
412 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW      !          LW Flux profiles
413 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_CS ! LW Clear-Sky temp. tendency
414 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_CS ! SW Clear-Sky temp. tendency
415 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS ! Top and
416                                                   !  Ground Clear-Sky radiative FLUXes
417 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZSFSWDIR !surface SW direct flux
418 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZSFSWDIF !surface SW diffuse flux
419
420 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_VIS, ZPLAN_ALB_NIR
421                         ! PLANetary ALBedo in VISible, Near-InfraRed regions
422 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_VIS, ZPLAN_TRA_NIR
423                         ! PLANetary TRANsmission in VISible, Near-InfraRed regions
424 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_VIS, ZPLAN_ABS_NIR
425                         ! PLANetary ABSorption in VISible, Near-InfraRed regions
426 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWD, ZEFCL_LWU
427                         ! EFective  DOWNward and UPward LW nebulosity (equivalent emissivities)
428                         ! undefined if RRTM is used for LW
429 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLWP, ZFIWP
430                         ! Liquid and Ice Water Path
431 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADLP, ZRADIP
432                         ! Cloud liquid water and ice effective radius
433 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_RRTM, ZCLSW_TOTAL
434                         ! effective LW nebulosity ( RRTM case) 
435                         ! and SW CLoud fraction for mixed phase clouds
436 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL, ZOMEGA_TOTAL, ZCG_TOTAL
437                         ! effective optical thickness, single scattering albedo
438                         ! and asymetry factor for mixed phase clouds
439 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS
440                         ! Clear-Sky  DowNward and UPward   SW Flux profiles
441 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS
442                         ! Thicknes of the mesh
443 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDZ
444 !
445 REAL, DIMENSION(KDLON,KFLEV) :: ZZDTSW ! SW diabatic heating
446 REAL, DIMENSION(KDLON,KFLEV) :: ZZDTLW ! LW diabatic heating
447 REAL, DIMENSION(KDLON)       :: ZZTGVIS! SW surface flux in the VIS band
448 REAL, DIMENSION(KDLON)       :: ZZTGNIR! SW surface flux in the NIR band
449 REAL, DIMENSION(KDLON)       :: ZZTGIR ! LW surface flux in the IR bands
450 REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIR
451 !                                      ! SW direct surface flux   
452 REAL, DIMENSION(KDLON,SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIF
453 !                                      ! SW diffuse surface flux   
454 !
455 REAL, DIMENSION(KDLON)       :: ZCLOUD ! vertically integrated cloud fraction
456 !
457 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZEXNT ! Exner function
458 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2))    :: ZLWD    ! surface Downward LW flux
459 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIR ! surface
460 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PSRFSWD_DIR,3)) :: ZSWDDIF ! surface Downward SW diffuse flux
461 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZPIZAZ ! Aerosols SSA
462 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZTAUAZ ! Aerosols Optical Detph
463 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3),KSWB) :: ZCGAZ  ! Aerosols Asymetric factor
464 REAL :: ZZTGVISC    ! downward surface SW flux (VIS band) for clear_sky
465 REAL :: ZZTGNIRC    ! downward surface SW flux (NIR band) for clear_sky
466 REAL :: ZZTGIRC     ! downward surface LW flux for clear_sky
467 REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIRC
468 !                   ! downward surface SW direct flux for clear sky
469 REAL, DIMENSION(SIZE(PSRFSWD_DIR,3)) :: ZZSFSWDIFC
470 !                   ! downward surface SW diffuse flux for clear sky
471 REAL, DIMENSION(KFLEV) :: ZT_CLEAR  ! ensemble mean clear-sky temperature
472 REAL, DIMENSION(KFLEV) :: ZP_CLEAR  ! ensemble mean clear-sky temperature
473 REAL, DIMENSION(KFLEV) :: ZQV_CLEAR ! ensemble mean clear-sky specific humidity
474 REAL, DIMENSION(KFLEV) :: ZOZ_CLEAR ! ensemble mean clear-sky ozone
475 REAL, DIMENSION(KFLEV) :: ZHP_CLEAR ! ensemble mean clear-sky half-lev. pression
476 REAL, DIMENSION(KFLEV) :: ZHT_CLEAR ! ensemble mean clear-sky half-lev. temp.
477 REAL, DIMENSION(KFLEV) :: ZDP_CLEAR ! ensemble mean clear-sky pressure thickness
478 REAL, DIMENSION(KFLEV,KAER) :: ZAER_CLEAR  ! ensemble mean clear-sky aerosols optical thickness
479 REAL, DIMENSION(KSWB)       :: ZALBP_CLEAR ! ensemble mean clear-sky surface albedo (parallel)
480 REAL, DIMENSION(KSWB)       :: ZALBD_CLEAR ! ensemble mean clear-sky surface albedo (diffuse)
481 REAL                        :: ZEMIS_CLEAR ! ensemble mean clear-sky surface emissivity
482 REAL                        :: ZEMIW_CLEAR ! ensemble mean clear-sky LW window
483 REAL                        :: ZRMU0_CLEAR ! ensemble mean clear-sky MU0
484 REAL                        :: ZTS_CLEAR   ! ensemble mean clear-sky surface temperature.
485 REAL                        :: ZLSM_CLEAR  !  ensemble mean clear-sky land sea-mask  
486 !
487 !work arrays
488 REAL, DIMENSION(:),   ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
489 REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
490 LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
491 !
492 !  splitted arrays used to split the memory required by the ECMWF_radiation 
493 !  subroutine, the fields have the same meaning as their complete counterpart
494 !
495 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
496 REAL, DIMENSION(:),     ALLOCATABLE :: ZEMIS_SPLIT, ZEMIW_SPLIT
497 REAL, DIMENSION(:),     ALLOCATABLE :: ZRMU0_SPLIT
498 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZCFAVE_SPLIT
499 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZO3AVE_SPLIT
500 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZT_HL_SPLIT
501 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZPRES_HL_SPLIT
502 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZTAVE_SPLIT
503 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZPAVE_SPLIT
504 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAER_SPLIT
505 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZDPRES_SPLIT
506 REAL, DIMENSION(:),     ALLOCATABLE :: ZLSM_SPLIT
507 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZQVAVE_SPLIT
508 REAL(KIND=JPRB), DIMENSION(:,:),   ALLOCATABLE :: ZQSAVE_SPLIT
509 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQLAVE_SPLIT
510 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQIAVE_SPLIT
511 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQRAVE_SPLIT
512 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQRWC_SPLIT
513 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQLWC_SPLIT
514 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZQIWC_SPLIT
515 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDZ_SPLIT
516 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCCT_C2R2_SPLIT
517 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCRT_C2R2_SPLIT
518 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCIT_C1R3_SPLIT
519 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCCT_LIMA_SPLIT
520 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCRT_LIMA_SPLIT
521 REAL, DIMENSION(:,:), ALLOCATABLE   :: ZCIT_LIMA_SPLIT
522 REAL(KIND=JPRB), DIMENSION(:),     ALLOCATABLE :: ZTS_SPLIT
523 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZSFSWDIR_SPLIT
524 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZSFSWDIF_SPLIT
525 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFLW_CS_SPLIT
526 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFLW_SPLIT
527 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFSW_CS_SPLIT
528 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZNFSW_SPLIT
529 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_SPLIT
530 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_SPLIT
531 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_SPLIT
532 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_SPLIT
533 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP_SPLIT
534 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_SPLIT
535 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTLW_CS_SPLIT
536 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZDTSW_CS_SPLIT
537 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT
538 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_VIS_SPLIT
539 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ALB_NIR_SPLIT
540 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_VIS_SPLIT
541 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_TRA_NIR_SPLIT
542 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_VIS_SPLIT
543 REAL, DIMENSION(:),     ALLOCATABLE :: ZPLAN_ABS_NIR_SPLIT
544 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWD_SPLIT
545 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_LWU_SPLIT
546 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLWP_SPLIT
547 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFIWP_SPLIT
548 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADLP_SPLIT
549 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZRADIP_SPLIT
550 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZEFCL_RRTM_SPLIT
551 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZCLSW_TOTAL_SPLIT
552 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU_TOTAL_SPLIT
553 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOMEGA_TOTAL_SPLIT
554 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCG_TOTAL_SPLIT
555 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_DOWN_CS_SPLIT
556 REAL, DIMENSION(:,:),   ALLOCATABLE :: ZFLUX_SW_UP_CS_SPLIT
557 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFLUX_LW_CS_SPLIT
558 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_EQ_TMP        !Single scattering albedo of aerosols (lon,lat,lev,wvl)
559 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZIR        !Real part of the aerosol refractive index(lon,lat,lev,wvl)
560 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZII        !Imaginary part of the aerosol refractive index (lon,lat,lev,wvl)
561 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_EQ_TMP         !Assymetry factor aerosols            (lon,lat,lev,wvl)
562 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_EQ_TMP      !tau/tau_{550} aerosols               (lon,lat,lev,wvl)
563 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_DST_TMP        !Single scattering albedo of dust (lon,lat,lev,wvl)
564 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_DST_TMP         !Assymetry factor dust            (lon,lat,lev,wvl)
565 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_DST_TMP      !tau/tau_{550} dust               (lon,lat,lev,wvl)
566 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_AER_TMP        !Single scattering albedo of aerosol from ORILAM (lon,lat,lev,wvl)
567 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_AER_TMP         !Assymetry factor aerosol from ORILAM            (lon,lat,lev,wvl)
568 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_AER_TMP      !tau/tau_{550} aerosol from ORILAM               (lon,lat,lev,wvl)
569 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZPIZA_SLT_TMP        !Single scattering albedo of sea salt (lon,lat,lev,wvl)
570 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCGA_SLT_TMP         !Assymetry factor of sea salt            (lon,lat,lev,wvl)
571 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTAUREL_SLT_TMP      !tau/tau_{550} of sea salt               (lon,lat,lev,wvl)
572 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_AER      !tau/tau_{550} aerosol from ORILAM               (lon,lat,lev,wvl)
573 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_SLT      !tau/tau_{550} sea salt               (lon,lat,lev,wvl)
574 REAL, DIMENSION(:,:,:), ALLOCATABLE :: PAER_DST     !tau/tau_{550} dust               (lon,lat,lev,wvl)
575 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTAU550_EQ_TMP      !tau/tau_{550} aerosols               (lon,lat,lev,wvl)
576 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZPIZA_EQ            !Single scattering albedo of aerosols (points,lev,wvl)
577 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZCGA_EQ             !Assymetry factor aerosols            (points,lev,wvl)
578 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZTAUREL_EQ          !tau/tau_{550} aerosols               (points,lev,wvl)
579 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZPIZA_EQ_SPLIT      !Single scattering albedo of aerosols (points,lev,wvl)
580 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZCGA_EQ_SPLIT       !Assymetry factor aerosols            (points,lev,wvl)
581 REAL(KIND=JPRB), DIMENSION(:,:,:), ALLOCATABLE   :: ZTAUREL_EQ_SPLIT    !tau/tau_{550} aerosols               (points,lev,wvl)
582 REAL, DIMENSION(KFLEV,KSWB)           :: ZPIZA_EQ_CLEAR      !Single scattering albedo of aerosols (lev,wvl)
583 REAL, DIMENSION(KFLEV,KSWB)           :: ZCGA_EQ_CLEAR       !Assymetry factor aerosols            (lev,wvl)
584 REAL, DIMENSION(KFLEV,KSWB)           :: ZTAUREL_EQ_CLEAR    !tau/tau_{550} aerosols               (lev,wvl)
585 INTEGER                               :: WVL_IDX              !Counter for wavelength
586
587 !
588 INTEGER  :: JI_SPLIT          ! loop on the splitted array
589 INTEGER  :: INUM_CALL         ! number of CALL of the radiation scheme
590 INTEGER  :: IDIM_EFF          ! effective number of air-columns to compute
591 INTEGER  :: IDIM_RESIDUE      ! number of remaining air-columns to compute
592 INTEGER  :: IBEG, IEND        ! auxiliary indices
593 !
594 !
595 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
596      :: ZDTRAD_LW! LW temperature tendency
597 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
598      :: ZDTRAD_SW! SW temperature tendency
599 INTEGER             :: ILUOUT       ! Logical unit number for output-listing
600 INTEGER             :: IRESP        ! Return code of FM routines
601 INTEGER             :: IGRID        ! C-grid indicator in LFIFM file
602 INTEGER             :: ILENCH       ! Length of comment string in LFIFM file
603 CHARACTER (LEN=100) :: YCOMMENT     ! comment string in LFIFM file
604 CHARACTER (LEN=16)  :: YRECFM       ! Name of the desired field in LFIFM file
605 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2),SIZE(PDTHRAD,3)) &
606      :: ZSTORE_3D, ZSTORE_3D2! 3D work array for storage
607 REAL, DIMENSION(SIZE(PDTHRAD,1),SIZE(PDTHRAD,2)) &
608      :: ZSTORE_2D   ! 2D work array for storage!
609 INTEGER                         :: JBAND       ! Solar band index
610 CHARACTER (LEN=4), DIMENSION(KSWB) :: YBAND_NAME  ! Solar band name
611 CHARACTER (LEN=2)               :: YDIR        ! Type of the data field
612 !
613 INTEGER :: ISWB ! number of SW spectral bands (between radiations and surface schemes)
614 INTEGER :: JSWB ! loop on SW spectral bands
615 INTEGER :: JAE  ! loop on aerosol class
616 !
617 REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZDZPABST
618 REAL :: ZMINVAL
619 INTEGER, DIMENSION(3) :: IMINLOC
620 INTEGER :: IINFO_ll
621 !
622 !-------------------------------------------------------------------------
623 !-------------------------------------------------------------------------
624 !-------------------------------------------------------------------------
625 !
626 !*       1.    COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES
627 !              ----------------------------------------------
628 !
629 CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)  ! this definition must be coherent with
630                                       ! the one used in ini_radiations routine
631 IKU = SIZE(PTHT,3)
632 IKB = 1 + JPVEXT
633 IKE = IKU - JPVEXT
634 !
635 IKSTAE = SIZE(PSTATM,1)
636 IKUP   = IKE-JPVEXT+1
637
638 ISWB   = SIZE(PSRFSWD_DIR,3)
639 !
640 !-------------------------------------------------------------------------------
641 !*       1.1   CHECK PRESSURE DECREASING
642 !              -------------------------
643 ZDZPABST(:,:,1:IKU-1) = PPABST(:,:,1:IKU-1) - PPABST(:,:,2:IKU)
644 ZDZPABST(:,:,IKU) = ZDZPABST(:,:,IKU-1)
645 !
646 ZMINVAL=MIN_ll(ZDZPABST,IINFO_ll)
647 !
648 IF ( ZMINVAL <= 0.0 ) THEN
649    CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
650    IMINLOC=GMINLOC_ll( ZDZPABST )
651    WRITE(ILUOUT,*) ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST <= 0.0 '  
652    WRITE(ILUOUT,*) ' radiation :: ZDZPABST ', ZMINVAL,' located at ',   IMINLOC
653    CALL FLUSH(ILUOUT)
654    STOP ' radiation.f90 STOP :: SOMETHING WRONG WITH PRESSURE , ZDZPABST < 0.0  '
655 ENDIF 
656 !-------------------------------------------------------------------------------
657 !
658 !*       2.    INITIALIZES THE MEAN-LAYER VARIABLES
659 !              ------------------------------------
660 !
661 ZEXNT(:,:,:)= ( PPABST(:,:,:)/XP00 ) ** (XRD/XCPD)
662
663 ALLOCATE(ZTAVE(KDLON,KFLEV))
664 ALLOCATE(ZQVAVE(KDLON,KFLEV))
665 ALLOCATE(ZQLAVE(KDLON,KFLEV))
666 ALLOCATE(ZQIAVE(KDLON,KFLEV))
667 ALLOCATE(ZCFAVE(KDLON,KFLEV))
668 ALLOCATE(ZQRAVE(KDLON,KFLEV))
669 ALLOCATE(ZQLWC(KDLON,KFLEV))
670 ALLOCATE(ZQIWC(KDLON,KFLEV))
671 ALLOCATE(ZQRWC(KDLON,KFLEV))
672 ALLOCATE(ZDZ(KDLON,KFLEV))
673 !
674 ZQVAVE(:,:) = 0.0
675 ZQLAVE(:,:) = 0.0
676 ZQIAVE(:,:) = 0.0
677 ZQRAVE(:,:) = 0.0
678 ZCFAVE(:,:) = 0.0
679 ZQLWC(:,:) = 0.0
680 ZQIWC(:,:) = 0.0
681 ZQRWC(:,:) = 0.0
682 ZDZ(:,:)=0.0
683 !
684 !COMPUTE THE MESH SIZE
685 DO JK=IKB,IKE
686   JKRAD = JK-JPVEXT
687   DO JJ=IJB,IJE
688     DO JI=IIB,IIE
689       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
690       ZDZ(IIJ,JKRAD)  =  PZZ(JI,JJ,JK+1) - PZZ(JI,JJ,JK)
691       ZTAVE(IIJ,JKRAD)  = PTHT(JI,JJ,JK)*ZEXNT(JI,JJ,JK)
692     END DO
693   END DO
694 END DO
695 !
696 !  Check if the humidity mixing ratio is available
697 !
698 IF( SIZE(PRT(:,:,:,:),4) >= 1 ) THEN
699   DO JK=IKB,IKE
700     JKRAD = JK-JPVEXT
701     DO JJ=IJB,IJE
702       DO JI=IIB,IIE
703         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
704         ZQVAVE(IIJ,JKRAD) =MAX(0., PRT(JI,JJ,JK,1))
705       END DO
706     END DO
707   END DO
708 END IF
709 !
710 !  Check if the cloudwater mixing ratio is available
711 !
712 IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
713   DO JK=IKB,IKE
714     JKRAD = JK-JPVEXT
715     DO JJ=IJB,IJE
716       DO JI=IIB,IIE
717         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
718         ZQLAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2))
719         ZQLWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,2)*PRHODREF(JI,JJ,JK))
720         ZCFAVE(IIJ,JKRAD) = PCLDFR(JI,JJ,JK)
721       END DO
722     END DO
723   END DO
724 END IF
725 !
726 !  Check if the rainwater mixing ratio is available
727 !
728 IF( SIZE(PRT(:,:,:,:),4) >= 3 ) THEN
729   DO JK=IKB,IKE
730     JKRAD = JK-JPVEXT
731     DO JJ=IJB,IJE
732       DO JI=IIB,IIE
733         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
734         ZQRWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3)*PRHODREF(JI,JJ,JK))
735         ZQRAVE(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,3))
736       END DO
737     END DO
738   END DO
739 END IF
740 !
741 !  Check if the cloudice mixing ratio is available
742 !
743 IF( SIZE(PRT(:,:,:,:),4) >= 4 ) THEN
744   DO JK=IKB,IKE
745     JKRAD = JK-JPVEXT
746     DO JJ=IJB,IJE
747       DO JI=IIB,IIE
748         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
749         ZQIWC(IIJ,JKRAD) = MAX(0.,PRT(JI,JJ,JK,4)*PRHODREF(JI,JJ,JK))
750         ZQIAVE(IIJ,JKRAD) = MAX( PRT(JI,JJ,JK,4)-XRTMIN(4),0.0 )
751       END DO
752     END DO
753   END DO
754 END IF
755 !
756 !  Standard atmosphere extension
757 !
758 DO JK=IKUP,KFLEV
759   JK1 = (KSTATM-1)+(JK-IKUP)
760   JK2 = JK1+1
761   ZTAVE(:,JK)  = 0.5*( PSTATM(JK1,3)+PSTATM(JK2,3) )
762   ZQVAVE(:,JK) = 0.5*( PSTATM(JK1,5)/PSTATM(JK1,4)+   &
763                  PSTATM(JK2,5)/PSTATM(JK2,4)    )
764 END DO
765 !
766 !        2.1 pronostic water concentation fields (C2R2 coupling) 
767 !
768 IF( NSV_C2R2 /= 0 ) THEN
769   ALLOCATE (ZCCT_C2R2(KDLON, KFLEV))
770   ALLOCATE (ZCRT_C2R2(KDLON, KFLEV))
771   ZCCT_C2R2(:, :) = 0.
772   ZCRT_C2R2 (:,:) = 0.
773   DO JK=IKB,IKE
774     JKRAD = JK-JPVEXT
775     DO JJ=IJB,IJE
776       DO JI=IIB,IIE
777         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
778         ZCCT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+1))
779         ZCRT_C2R2 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C2R2BEG+2))
780       END DO
781     END DO
782   END DO
783 ELSE 
784   ALLOCATE (ZCCT_C2R2(0,0))
785   ALLOCATE (ZCRT_C2R2(0,0))
786 END IF
787 !
788 IF( NSV_C1R3 /= 0 ) THEN
789   ALLOCATE (ZCIT_C1R3(KDLON, KFLEV))
790   ZCIT_C1R3 (:,:) = 0.
791   DO JK=IKB,IKE
792     JKRAD = JK-JPVEXT
793     DO JJ=IJB,IJE
794       DO JI=IIB,IIE
795         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
796         ZCIT_C1R3 (IIJ,JKRAD) = MAX(0.,PSVT(JI,JJ,JK,NSV_C1R3BEG))
797       END DO
798     END DO
799   END DO
800 ELSE 
801   ALLOCATE (ZCIT_C1R3(0,0))
802 END IF
803 !
804 !-------------------------------------------------------------------------------
805 !
806 !*       3.    INITIALIZES THE HALF-LEVEL VARIABLES
807 !                  ------------------------------------
808 !
809 ALLOCATE(ZPRES_HL(KDLON,KFLEV+1))
810 ALLOCATE(ZT_HL(KDLON,KFLEV+1))
811 !
812 DO JK=IKB,IKE+1
813   JKRAD = JK-JPVEXT
814   DO JJ=IJB,IJE
815     DO JI=IIB,IIE
816       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
817       ZPRES_HL(IIJ,JKRAD) = XP00 * (0.5*(ZEXNT(JI,JJ,JK)+ZEXNT(JI,JJ,JK-1)))**(XCPD/XRD)
818     END DO
819   END DO
820 END DO
821 !
822 !  Standard atmosphere extension
823 !
824 !* begining at ikup+1 level allows to use a model domain higher than 50km
825 !
826 DO JK=IKUP+1,KFLEV+1
827   JK1 = (KSTATM-1)+(JK-IKUP)
828   ZPRES_HL(:,JK) = PSTATM(JK1,2)*100.0
829 END DO
830 !
831 !  Surface temperature at the first level
832 !  and surface radiative temperature
833 ALLOCATE(ZTS(KDLON))
834 !
835 DO JJ=IJB,IJE
836   DO JI=IIB,IIE
837     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
838     ZT_HL(IIJ,1) = PTSRAD(JI,JJ)
839     ZTS(IIJ) = PTSRAD(JI,JJ)
840   END DO
841 END DO
842 !
843 !  Temperature at half levels
844 !
845 ZT_HL(:,2:IKE-JPVEXT) = 0.5*(ZTAVE(:,1:IKE-JPVEXT-1)+ZTAVE(:,2:IKE-JPVEXT))
846 !
847 DO JJ=IJB,IJE
848   DO JI=IIB,IIE
849     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
850     ZT_HL(IIJ,IKE-JPVEXT+1)  =  0.5*PTHT(JI,JJ,IKE  )*ZEXNT(JI,JJ,IKE  ) &
851          + 0.5*PTHT(JI,JJ,IKE+1)*ZEXNT(JI,JJ,IKE+1)
852   END DO
853 END DO
854 !
855 !  Standard atmosphere extension
856 !
857 !* begining at ikup+1 level allows to use a model domain higher than 50km
858 !
859 DO JK=IKUP+1,KFLEV+1
860   JK1 = (KSTATM-1)+(JK-IKUP)
861   ZT_HL(:,JK) = PSTATM(JK1,3)
862 END DO
863 !
864 !mean layer pressure and layer differential pressure (from half level variables)
865 !
866 ALLOCATE(ZPAVE(KDLON,KFLEV))
867 ALLOCATE(ZDPRES(KDLON,KFLEV))
868 DO JKRAD=1,KFLEV
869   ZPAVE(:,JKRAD)=0.5*(ZPRES_HL(:,JKRAD)+ZPRES_HL(:,JKRAD+1))
870   ZDPRES(:,JKRAD)=ZPRES_HL(:,JKRAD)-ZPRES_HL(:,JKRAD+1)
871 END DO
872 !-----------------------------------------------------------------------
873 !*       4.    INITIALIZES THE AEROSOLS and OZONE PROFILES from climatlogy
874 !                  -------------------------------------------
875 !
876 !        4.1    AEROSOL optical thickness
877 !
878 IF (CAOP=='EXPL') THEN
879    GAOP = .TRUE.
880 ELSE
881    GAOP = .FALSE.
882 ENDIF
883 !
884 IF (CAOP=='EXPL') THEN
885    ALLOCATE(ZPIZA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
886    ALLOCATE(ZCGA_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
887    ALLOCATE(ZTAUREL_EQ_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
888
889    ALLOCATE(ZPIZA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
890    ALLOCATE(ZCGA_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
891    ALLOCATE(ZTAUREL_DST_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB)) 
892    ALLOCATE(PAER_DST(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
893
894    ALLOCATE(ZPIZA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
895    ALLOCATE(ZCGA_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
896    ALLOCATE(ZTAUREL_AER_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
897    ALLOCATE(PAER_AER(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
898
899    ALLOCATE(ZPIZA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
900    ALLOCATE(ZCGA_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
901    ALLOCATE(ZTAUREL_SLT_TMP(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3),KSWB))
902    ALLOCATE(PAER_SLT(SIZE(PAER,1),SIZE(PAER,2),SIZE(PAER,3)))
903    
904
905    ALLOCATE(ZII(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB))
906    ALLOCATE(ZIR(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),KSWB))
907
908   ZPIZA_EQ_TMP = 0.
909   ZCGA_EQ_TMP = 0.
910   ZTAUREL_EQ_TMP = 0.
911
912   ZPIZA_DST_TMP = 0.
913   ZCGA_DST_TMP = 0.
914   ZTAUREL_DST_TMP = 0
915
916   ZPIZA_SLT_TMP = 0.
917   ZCGA_SLT_TMP = 0.
918   ZTAUREL_SLT_TMP = 0
919
920   ZPIZA_AER_TMP = 0.
921   ZCGA_AER_TMP = 0.
922   ZTAUREL_AER_TMP = 0
923
924   PAER_DST=0.
925   PAER_SLT=0.
926   PAER_AER=0.
927   
928  IF (LORILAM) THEN
929    CALL AEROOPT_GET(                             &
930         PSVT(IIB:IIE,IJB:IJE,:,NSV_AERBEG:NSV_AEREND)        &  !I [ppp]  aerosols concentration
931         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
932         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
933         ,ZPIZA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of aerosols
934         ,ZCGA_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for aerosols
935         ,ZTAUREL_AER_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
936         ,PAER_AER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of aerosols at wvl=550nm
937         ,KSWB                                    &  !I |nbr] number of shortwave bands
938         ,ZIR(IIB:IIE,IJB:IJE,:,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
939         ,ZII(IIB:IIE,IJB:IJE,:,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
940         )
941  ENDIF
942  IF(LDUST) THEN
943    CALL DUSTOPT_GET(                             &
944         PSVT(IIB:IIE,IJB:IJE,:,NSV_DSTBEG:NSV_DSTEND)        &  !I [ppp] Dust scalar concentration
945         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
946         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
947         ,ZPIZA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of dust
948         ,ZCGA_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for dust
949         ,ZTAUREL_DST_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
950         ,PAER_DST(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of dust at wvl=550nm
951         ,KSWB                                    &  !I |nbr] number of shortwave bands
952         )
953    DO WVL_IDX=1,KSWB
954      PDST_WL(:,:,:,WVL_IDX) = ZTAUREL_DST_TMP(:,:,:,WVL_IDX)* PAER(:,:,:,3)             
955    ENDDO
956  ENDIF
957  IF(LSALT) THEN
958    CALL SALTOPT_GET(                             &
959         PSVT(IIB:IIE,IJB:IJE,:,NSV_SLTBEG:NSV_SLTEND)        &  !I [ppp] sea salt scalar concentration
960         ,PZZ(IIB:IIE,IJB:IJE,:)                   &  !I [m] height of layers
961         ,PRHODREF(IIB:IIE,IJB:IJE,:)              &  !I [kg/m3] density of air
962         ,ZPIZA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)   &  !O [-] single scattering albedo of sea salt
963         ,ZCGA_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:)    &  !O [-] assymetry factor for sea salt
964         ,ZTAUREL_SLT_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,:) &  !O [-] opt.depth(wvl=lambda)/opt.depth(wvl=550nm)
965         ,PAER_SLT(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT)            &  !O [-] optical depth of sea salt at wvl=550nm
966         ,KSWB                                    &  !I |nbr] number of shortwave bands
967         )
968
969  ENDIF
970
971
972  ZTAUREL_EQ_TMP(:,:,:,:)=ZTAUREL_DST_TMP(:,:,:,:)+ZTAUREL_AER_TMP(:,:,:,:)+ZTAUREL_SLT_TMP(:,:,:,:)
973  
974 !PAER(:,:,:,3)=PAER_AER(:,:,:)+PAER_SLT(:,:,:)+PAER_DST(:,:,:)
975  PAER(:,:,:,2)=PAER_SLT(:,:,:)
976  PAER(:,:,:,3)=PAER_DST(:,:,:)
977  PAER(:,:,:,4)=PAER_AER(:,:,:)
978
979
980  WHERE (ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0)
981   ZPIZA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)+&
982                     ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)+&
983                     ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:))/&
984                     ZTAUREL_EQ_TMP(:,:,:,:) 
985  END WHERE
986  WHERE ((ZTAUREL_EQ_TMP(:,:,:,:).GT.0.0).AND.(ZPIZA_EQ_TMP(:,:,:,:).GT.0.0))
987   ZCGA_EQ_TMP(:,:,:,:)=(ZPIZA_DST_TMP(:,:,:,:)*ZTAUREL_DST_TMP(:,:,:,:)*ZCGA_DST_TMP(:,:,:,:)+&
988                    ZPIZA_AER_TMP(:,:,:,:)*ZTAUREL_AER_TMP(:,:,:,:)*ZCGA_AER_TMP(:,:,:,:)+&
989                    ZPIZA_SLT_TMP(:,:,:,:)*ZTAUREL_SLT_TMP(:,:,:,:)*ZCGA_SLT_TMP(:,:,:,:))/&
990                    (ZTAUREL_EQ_TMP(:,:,:,:)*ZPIZA_EQ_TMP(:,:,:,:))
991  END WHERE
992
993  ZTAUREL_EQ_TMP(:,:,:,:)=max(1.E-8,ZTAUREL_EQ_TMP(:,:,:,:))
994  ZCGA_EQ_TMP(:,:,:,:)=max(1.E-8,ZCGA_EQ_TMP(:,:,:,:))
995  ZPIZA_EQ_TMP(:,:,:,:)=max(1.E-8,ZPIZA_EQ_TMP(:,:,:,:))
996  PAER(:,:,:,3)=max(1.E-8,PAER(:,:,:,3))
997  ZPIZA_EQ_TMP(:,:,:,:)=min(0.99,ZPIZA_EQ_TMP(:,:,:,:))
998
999
1000 ENDIF      
1001 !
1002 ! Computes SSA, optical depth and assymetry factor for clear sky (aerosols)
1003 ZTAUAZ(:,:,:,:) = 0.
1004 ZPIZAZ(:,:,:,:) = 0.
1005 ZCGAZ(:,:,:,:)  = 0.
1006 DO WVL_IDX=1,KSWB
1007  DO JAE=1,KAER
1008       !Special optical properties for dust
1009       IF (CAOP=='EXPL'.AND.(JAE==3)) THEN
1010       !Ponderation of aerosol optical in case of explicit optical factor
1011       !ti
1012         ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
1013                                                  PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * &
1014                                        ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) 
1015       !wi*ti
1016         ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)= ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
1017                                   PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)                * &
1018                                   ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
1019                                   ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
1020       !wi*ti*gi
1021         ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) + &
1022                                  PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)                * &
1023                                  ZTAUREL_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX) * &
1024                                  ZPIZA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)   * &
1025                                  ZCGA_EQ_TMP(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,WVL_IDX)
1026       ELSE
1027
1028       !Ponderation of aerosol optical properties 
1029       !ti
1030         ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
1031              PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) * RTAUA(WVL_IDX,JAE)
1032       !wi*ti
1033         ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)=ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)+&
1034                                                PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE) *&
1035                                         RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)
1036       !wi*ti*gi
1037         ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) =  ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) +&
1038                                                PAER(IIB:IIE,IJB:IJE,IKB-JPVEXT:IKE-JPVEXT,JAE)   *&
1039                         RTAUA(WVL_IDX,JAE)*RPIZA(WVL_IDX,JAE)*RCGA(WVL_IDX,JAE)
1040            ENDIF
1041  ENDDO
1042 ! assymetry factor:
1043
1044 ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZCGAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)  / &
1045                                    ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
1046 ! SSA:
1047 ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) = ZPIZAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX) / &
1048                                     ZTAUAZ(IIB:IIE,IJB:IJE,IKB:IKE,WVL_IDX)
1049 ENDDO
1050 !
1051
1052 !
1053 ALLOCATE(ZAER(KDLON,KFLEV,KAER))
1054 ! Aerosol classes
1055 ! 1=Continental   2=Maritime   3=Desert     4=Urban     5=Volcanic 6=Stratos.Bckgnd
1056 DO JJ=IJB,IJE
1057    DO JI=IIB,IIE
1058       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1059       ZAER (IIJ,:,:) = PAER_CLIM  (JI,JJ,:,:)
1060    END DO
1061 END DO
1062 IF ((CAOP=='EXPL') .AND. LDUST ) THEN
1063   DO JJ=IJB,IJE
1064     DO JI=IIB,IIE
1065       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1066       ZAER (IIJ,:,3) = PAER  (JI,JJ,:,3)
1067     END DO
1068   END DO
1069 END IF
1070 IF ((CAOP=='EXPL') .AND. LSALT ) THEN
1071   DO JJ=IJB,IJE
1072     DO JI=IIB,IIE
1073       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1074       ZAER (IIJ,:,2) = PAER  (JI,JJ,:,2)
1075     END DO
1076   END DO
1077 END IF
1078 IF ((CAOP=='EXPL') .AND. LORILAM ) THEN
1079   DO JJ=IJB,IJE
1080     DO JI=IIB,IIE
1081       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1082       ZAER (IIJ,:,4) = PAER  (JI,JJ,:,4)
1083     END DO
1084   END DO
1085 END IF
1086 !
1087 ALLOCATE(ZPIZA_EQ(KDLON,KFLEV,KSWB))
1088 ALLOCATE(ZCGA_EQ(KDLON,KFLEV,KSWB))
1089 ALLOCATE(ZTAUREL_EQ(KDLON,KFLEV,KSWB))
1090 IF(CAOP=='EXPL')THEN
1091     !Transform from vector of type #lon #lat #lev #wvl
1092     !to vectors of type #points, #levs, #wavelengths
1093   DO JJ=IJB,IJE
1094   DO JI=IIB,IIE
1095     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1096     ZPIZA_EQ(IIJ,:,:) = ZPIZA_EQ_TMP(JI,JJ,:,:)
1097     ZCGA_EQ(IIJ,:,:)= ZCGA_EQ_TMP(JI,JJ,:,:)
1098     ZTAUREL_EQ(IIJ,:,:)=ZTAUREL_EQ_TMP(JI,JJ,:,:)
1099   END DO
1100   END DO
1101   DEALLOCATE(ZPIZA_EQ_TMP)
1102   DEALLOCATE(ZCGA_EQ_TMP)
1103   DEALLOCATE(ZTAUREL_EQ_TMP)
1104   DEALLOCATE(ZPIZA_DST_TMP)
1105   DEALLOCATE(ZCGA_DST_TMP)
1106   DEALLOCATE(ZTAUREL_DST_TMP)  
1107   DEALLOCATE(ZPIZA_AER_TMP)
1108   DEALLOCATE(ZCGA_AER_TMP)
1109   DEALLOCATE(ZTAUREL_AER_TMP)
1110   DEALLOCATE(ZPIZA_SLT_TMP)
1111   DEALLOCATE(ZCGA_SLT_TMP)
1112   DEALLOCATE(ZTAUREL_SLT_TMP)
1113   DEALLOCATE(PAER_DST)
1114   DEALLOCATE(PAER_AER)
1115   DEALLOCATE(PAER_SLT)
1116   DEALLOCATE(ZIR)
1117   DEALLOCATE(ZII)
1118 END IF
1119
1120
1121 !
1122 !      4.2   OZONE content 
1123 !
1124 ALLOCATE(ZO3AVE(KDLON,KFLEV))
1125 !
1126 DO JJ=IJB,IJE
1127   DO JI=IIB,IIE
1128     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1129     ZO3AVE(IIJ,:)  = POZON (JI,JJ,:)           
1130   END DO
1131 END DO
1132 !
1133 !-------------------------------------------------------------------------------
1134 !
1135 !*       5.    CALLS THE E.C.M.W.F. RADIATION CODE
1136 !                  -----------------------------------
1137 !
1138 !
1139 !*       5.1   INITIALIZES 2D AND SURFACE FIELDS
1140 !
1141 ALLOCATE(ZRMU0(KDLON))
1142 ALLOCATE(ZLSM(KDLON))
1143
1144 ALLOCATE(ZALBP(KDLON,KSWB))
1145 ALLOCATE(ZALBD(KDLON,KSWB))
1146 !
1147 ALLOCATE(ZEMIS(KDLON))
1148 ALLOCATE(ZEMIW(KDLON))
1149 !
1150 DO JJ=IJB,IJE
1151   DO JI=IIB,IIE
1152     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1153     ZEMIS(IIJ)   = PEMIS(JI,JJ)
1154     ZRMU0(IIJ)    = PCOSZEN(JI,JJ)
1155     ZLSM(IIJ)     = 1.0 - PSEA(JI,JJ)  
1156   END DO
1157 END DO  
1158 !
1159 ! spectral albedo
1160 !
1161 IF ( SIZE(PDIR_ALB,3)==1 ) THEN
1162   DO JJ=IJB,IJE
1163     DO JI=IIB,IIE
1164       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1165       !  sw direct and diffuse albedos
1166       ZALBP(IIJ,:)  = PDIR_ALB(JI,JJ,1)
1167       ZALBD(IIJ,:)  = PSCA_ALB(JI,JJ,1)
1168       !
1169     END DO
1170   END DO
1171 ELSE  
1172   DO JK=1, SIZE(PDIR_ALB,3)
1173     DO JJ=IJB,IJE
1174       DO JI=IIB,IIE
1175          IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1176          !  sw direct and diffuse albedos
1177          ZALBP(IIJ,JK)  = PDIR_ALB(JI,JJ,JK)
1178          ZALBD(IIJ,JK)  = PSCA_ALB(JI,JJ,JK)
1179        ENDDO
1180      END DO
1181    ENDDO  
1182 END IF
1183 !
1184 !
1185 ! LW emissivity
1186 ZEMIW(:)= ZEMIS(:)
1187 !
1188 !solar constant
1189 ZRII0= PCORSOL*XI0
1190 !
1191 !
1192 !
1193 !*       5.2   ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
1194 !
1195 !  Performs the horizontal average of the fields when no cloud
1196 !
1197 ZCLOUD(:) = SUM( ZCFAVE(:,:),DIM=2 )
1198 !
1199 ! MODIF option CLLY      
1200 ALLOCATE ( ICLEAR_2D_TM1(KDLON) )
1201 !
1202 DO JJ=IJB,IJE
1203   DO JI=IIB,IIE
1204     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1205     ICLEAR_2D_TM1(IIJ) = KCLEARCOL_TM1(JI,JJ)
1206   END DO
1207 END DO
1208 !
1209 IF(OCLOUD_ONLY .OR. OCLEAR_SKY) THEN
1210   !
1211   GCLEAR_2D(:) = .TRUE.
1212   WHERE( (ZCLOUD(:) > 0.0) .OR. (ICLEAR_2D_TM1(:)==0) )
1213     GCLEAR_2D(:) = .FALSE.
1214   END WHERE
1215   !
1216   !
1217   ICLEAR_COL = COUNT( GCLEAR_2D(:) )  ! number of clear sky columns
1218   !
1219
1220   IF( ICLEAR_COL == KDLON ) THEN ! No cloud case so only the mean clear-sky
1221     GCLEAR_2D(1) = .FALSE.       !           column is selected
1222     ICLEAR_COL = KDLON-1
1223     GNOCL = .TRUE.
1224   ELSE
1225     GNOCL = .FALSE.
1226   END IF
1227
1228   GCLEAR(:,:) = SPREAD( GCLEAR_2D(:),DIM=2,NCOPIES=KFLEV )
1229   ICLOUD_COL = KDLON - ICLEAR_COL     ! number of  cloudy   columns
1230 !
1231   IF( ICLEAR_COL /=0 ) THEN ! at least one clear-sky column exists
1232     ZT_CLEAR(:)  = SUM( ZTAVE(:,:) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1233     ZP_CLEAR(:)  = SUM( ZPAVE(:,:) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1234     ZQV_CLEAR(:) = SUM( ZQVAVE(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1235     ZOZ_CLEAR(:) = SUM( ZO3AVE(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1236     ZDP_CLEAR(:) = SUM( ZDPRES(:,:),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1237     DO JK1=1,KAER
1238       ZAER_CLEAR(:,JK1) = SUM( ZAER(:,:,JK1),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1239     END DO
1240     !Get an average value for the clear column
1241     IF(CAOP=='EXPL')THEN
1242        DO WVL_IDX=1,KSWB
1243           ZPIZA_EQ_CLEAR(:,WVL_IDX) = SUM( ZPIZA_EQ(:,:,WVL_IDX), DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1244           ZCGA_EQ_CLEAR(:,WVL_IDX) = SUM( ZCGA_EQ(:,:,WVL_IDX),DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1245           ZTAUREL_EQ_CLEAR(:,WVL_IDX) = SUM( ZTAUREL_EQ(:,:,WVL_IDX),DIM=1,MASK=GCLEAR(:,:))/FLOAT(ICLEAR_COL)
1246        ENDDO
1247     ENDIF
1248     
1249     !
1250     ZHP_CLEAR(1:KFLEV) =SUM( ZPRES_HL(:,1:KFLEV),DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1251     ZHT_CLEAR(1:KFLEV)  = SUM( ZT_HL(:,1:KFLEV) ,DIM=1,MASK=GCLEAR(:,:) )/FLOAT(ICLEAR_COL)
1252     ! 
1253     GCLEAR_SWB(:,:) = SPREAD(GCLEAR_2D(:),DIM=2,NCOPIES=KSWB)
1254     ZALBP_CLEAR(:) = SUM( ZALBP(:,:),DIM=1,MASK=GCLEAR_SWB(:,:) ) &
1255          / FLOAT(ICLEAR_COL)
1256     ZALBD_CLEAR(:) = SUM( ZALBD(:,:),DIM=1,MASK=GCLEAR_SWB(:,:) ) &
1257          / FLOAT(ICLEAR_COL)
1258     !
1259     ZEMIS_CLEAR  = SUM( ZEMIS(:),DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1260     ZEMIW_CLEAR  = SUM( ZEMIW(:),DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1261     ZRMU0_CLEAR  = SUM( ZRMU0(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1262     ZTS_CLEAR    = SUM( ZTS(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)
1263     ZLSM_CLEAR   = SUM( ZLSM(:) ,DIM=1,MASK=GCLEAR_2D(:)) / FLOAT(ICLEAR_COL)  
1264 !
1265   ELSE ! the first column is chosen, without physical meaning: it will not be
1266     ! unpacked after the call to the radiation ecmwf routine
1267     ZT_CLEAR(:)  = ZTAVE(1,:)
1268     ZP_CLEAR(:)  = ZPAVE(1,:)
1269     ZQV_CLEAR(:) = ZQVAVE(1,:)
1270     ZOZ_CLEAR(:) = ZO3AVE(1,:)
1271     ZDP_CLEAR(:) = ZDPRES(1,:)
1272     ZAER_CLEAR(:,:) = ZAER(1,:,:)
1273     IF(CAOP=='EXPL')THEN
1274        ZPIZA_EQ_CLEAR(:,:)=ZPIZA_EQ(1,:,:)
1275        ZCGA_EQ_CLEAR(:,:)=ZCGA_EQ(1,:,:)
1276        ZTAUREL_EQ_CLEAR(:,:)=ZTAUREL_EQ(1,:,:)
1277     ENDIF
1278 !
1279     ZHP_CLEAR(1:KFLEV)  = ZPRES_HL(1,1:KFLEV)
1280     ZHT_CLEAR(1:KFLEV)  = ZT_HL(1,1:KFLEV)
1281     ZALBP_CLEAR(:) = ZALBP(1,:)
1282     ZALBD_CLEAR(:) = ZALBD(1,:)
1283 !
1284     ZEMIS_CLEAR  = ZEMIS(1)
1285     ZEMIW_CLEAR  = ZEMIW(1) 
1286     ZRMU0_CLEAR  = ZRMU0(1)
1287     ZTS_CLEAR    = ZTS(1) 
1288     ZLSM_CLEAR   = ZLSM(1)  
1289   END IF
1290   !
1291   GCLOUD(:,:) = .NOT.GCLEAR(:,:) ! .true. where the column is cloudy
1292   GCLOUDT(:,:)=TRANSPOSE(GCLOUD(:,:))
1293   ICLOUD = ICLOUD_COL*KFLEV
1294   ALLOCATE(ZWORK1(ICLOUD))
1295   ALLOCATE(ZWORK2(ICLOUD+KFLEV)) !  allocation for the KFLEV levels of 
1296                                  !  the ICLOUD cloudy columns
1297                                  !  and of the single clear_sky one
1298   !
1299   ! temperature profiles
1300   !
1301   ZWORK1(:) = PACK( TRANSPOSE(ZTAVE(:,:)),MASK=GCLOUDT(:,:) )
1302   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1303   ZWORK2(ICLOUD+1:)= ZT_CLEAR(1:)      !   and the single clear_sky one
1304   DEALLOCATE(ZTAVE)
1305   ALLOCATE(ZTAVE(ICLOUD_COL+1,KFLEV))
1306   ZTAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1307   !
1308   ! vapor mixing ratio profiles
1309   !
1310   ZWORK1(:) = PACK( TRANSPOSE(ZQVAVE(:,:)),MASK=GCLOUDT(:,:) )
1311   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1312   ZWORK2(ICLOUD+1:)= ZQV_CLEAR(1:)      !   and the single clear_sky one
1313   DEALLOCATE(ZQVAVE)
1314   ALLOCATE(ZQVAVE(ICLOUD_COL+1,KFLEV))
1315   ZQVAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1316   !
1317   ! mesh size 
1318   !
1319   ZWORK1(:) = PACK( TRANSPOSE(ZDZ(:,:)),MASK=GCLOUDT(:,:) )
1320   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1321   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1322   DEALLOCATE(ZDZ)
1323   ALLOCATE(ZDZ(ICLOUD_COL+1,KFLEV))
1324   ZDZ(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1325   !
1326   !
1327   ! liquid water mixing ratio profiles
1328   !
1329   ZWORK1(:) = PACK( TRANSPOSE(ZQLAVE(:,:)),MASK=GCLOUDT(:,:) )
1330   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1331   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1332   DEALLOCATE(ZQLAVE)
1333   ALLOCATE(ZQLAVE(ICLOUD_COL+1,KFLEV))
1334   ZQLAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1335   !
1336   !rain 
1337   !
1338   ZWORK1(:) = PACK( TRANSPOSE(ZQRAVE(:,:)),MASK=GCLOUDT(:,:) )
1339   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1340   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1341   DEALLOCATE(ZQRAVE)
1342   ALLOCATE(ZQRAVE(ICLOUD_COL+1,KFLEV))
1343   ZQRAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1344   ! 
1345   ! ice water mixing ratio profiles
1346   !
1347   ZWORK1(:) = PACK( TRANSPOSE(ZQIAVE(:,:)),MASK=GCLOUDT(:,:) )
1348   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1349   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1350   DEALLOCATE(ZQIAVE)
1351   ALLOCATE(ZQIAVE(ICLOUD_COL+1,KFLEV))
1352   ZQIAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1353   !
1354   !
1355   ! liquid water mixing ratio profiles
1356   !
1357   ZWORK1(:) = PACK( TRANSPOSE(ZQLWC(:,:)),MASK=GCLOUDT(:,:) )
1358   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1359   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1360   DEALLOCATE(ZQLWC)
1361   ALLOCATE(ZQLWC(ICLOUD_COL+1,KFLEV))
1362   ZQLWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1363   !
1364   !rain 
1365   !
1366   ZWORK1(:) = PACK( TRANSPOSE(ZQRWC(:,:)),MASK=GCLOUDT(:,:) )
1367   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1368   ZWORK2(ICLOUD+1:)= 0.0              !   and the single clear_sky one
1369   DEALLOCATE(ZQRWC)
1370   ALLOCATE(ZQRWC(ICLOUD_COL+1,KFLEV))
1371   ZQRWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1372   ! 
1373   ! ice water mixing ratio profiles
1374   !
1375   ZWORK1(:) = PACK( TRANSPOSE(ZQIWC(:,:)),MASK=GCLOUDT(:,:) )
1376   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1377   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1378   DEALLOCATE(ZQIWC)
1379   ALLOCATE(ZQIWC(ICLOUD_COL+1,KFLEV))
1380   ZQIWC(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1381   !
1382   !
1383   ! cloud fraction profiles
1384   !
1385   ZWORK1(:) = PACK( TRANSPOSE(ZCFAVE(:,:)),MASK=GCLOUDT(:,:) )
1386   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1387   ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1388   DEALLOCATE(ZCFAVE)
1389   ALLOCATE(ZCFAVE(ICLOUD_COL+1,KFLEV))
1390   ZCFAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1391   !
1392   ! C2R2 water particle concentration
1393   !
1394   IF ( SIZE(ZCCT_C2R2) > 0 )  THEN
1395     ZWORK1(:) = PACK( TRANSPOSE(ZCCT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
1396     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1397     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1398     DEALLOCATE(ZCCT_C2R2)
1399     ALLOCATE(ZCCT_C2R2(ICLOUD_COL+1,KFLEV))
1400     ZCCT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1401   ENDIF
1402   IF ( SIZE (ZCRT_C2R2) > 0 )  THEN
1403     ZWORK1(:) = PACK( TRANSPOSE(ZCRT_C2R2(:,:)),MASK=GCLOUDT(:,:) )
1404     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1405     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1406     DEALLOCATE(ZCRT_C2R2)
1407     ALLOCATE(ZCRT_C2R2(ICLOUD_COL+1,KFLEV))
1408     ZCRT_C2R2 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1409   ENDIF
1410   IF ( SIZE (ZCIT_C1R3) > 0)  THEN
1411     ZWORK1(:) = PACK( TRANSPOSE(ZCIT_C1R3(:,:)),MASK=GCLOUDT(:,:) )
1412     ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1413     ZWORK2(ICLOUD+1:)= 0.0      !   and the single clear_sky one
1414     DEALLOCATE(ZCIT_C1R3)
1415     ALLOCATE(ZCIT_C1R3(ICLOUD_COL+1,KFLEV))
1416     ZCIT_C1R3 (:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1417   ENDIF
1418   !
1419   ! ozone content profiles
1420   !
1421   ZWORK1(:) = PACK( TRANSPOSE(ZO3AVE(:,:)),MASK=GCLOUDT(:,:) )
1422   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1423   ZWORK2(ICLOUD+1:)= ZOZ_CLEAR(1:)    !   and the single clear_sky one
1424   DEALLOCATE(ZO3AVE)
1425   ALLOCATE(ZO3AVE(ICLOUD_COL+1,KFLEV))
1426   ZO3AVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1427   !
1428   ZWORK1(:) = PACK( TRANSPOSE(ZPAVE(:,:)),MASK=GCLOUDT(:,:) )
1429   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1430   ZWORK2(ICLOUD+1:)= ZP_CLEAR(1:)     !   and the single clear_sky one
1431   DEALLOCATE(ZPAVE)
1432   ALLOCATE(ZPAVE(ICLOUD_COL+1,KFLEV))
1433   ZPAVE(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1434   !
1435   !pressure thickness
1436   !
1437   ZWORK1(:) = PACK( TRANSPOSE(ZDPRES(:,:)),MASK=GCLOUDT(:,:) )
1438   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD) ! fills the ICLOUD_COL cloudy columns
1439   ZWORK2(ICLOUD+1:)= ZDP_CLEAR(1:)    !   and the single clear_sky one
1440   DEALLOCATE(ZDPRES)
1441   ALLOCATE(ZDPRES(ICLOUD_COL+1,KFLEV))
1442   ZDPRES(:,:) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1443   !
1444   !aerosols
1445   !
1446   ALLOCATE(ZWORK1AER(ICLOUD,KAER))
1447   ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KAER))
1448   DO JK=1,KAER
1449     ZWORK1AER(:,JK) = PACK( TRANSPOSE(ZAER(:,:,JK)),MASK=GCLOUDT(:,:) )
1450     ZWORK2AER(1:ICLOUD,JK)=ZWORK1AER(:,JK)
1451     ZWORK2AER(ICLOUD+1:,JK)=ZAER_CLEAR(:,JK)
1452   END DO
1453   DEALLOCATE(ZAER)
1454   ALLOCATE(ZAER(ICLOUD_COL+1,KFLEV,KAER))
1455   DO JK=1,KAER
1456     ZAER(:,:,JK) = TRANSPOSE( RESHAPE( ZWORK2AER(:,JK),(/KFLEV,ICLOUD_COL+1/) ) )
1457   END DO
1458   DEALLOCATE (ZWORK1AER)
1459   DEALLOCATE (ZWORK2AER)
1460   !
1461   IF(CAOP=='EXPL')THEN
1462      ALLOCATE(ZWORK1AER(ICLOUD,KSWB))        !New vector with value for all cld. points
1463      ALLOCATE(ZWORK2AER(ICLOUD+KFLEV,KSWB))  !New vector with value for all cld.points + 1 clr column
1464      !Single scattering albedo
1465      DO WVL_IDX=1,KSWB
1466         ZWORK1AER(:,WVL_IDX) = PACK( TRANSPOSE(ZPIZA_EQ(:,:,WVL_IDX)),MASK=GCLOUDT(:,:) )
1467         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1468         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZPIZA_EQ_CLEAR(:,WVL_IDX)
1469      ENDDO
1470      DEALLOCATE(ZPIZA_EQ)
1471      ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1472      DO WVL_IDX=1,KSWB
1473         ZPIZA_EQ(:,:,WVL_IDX) = TRANSPOSE( RESHAPE( ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/) ) )
1474      ENDDO
1475      !Assymetry factor
1476      DO WVL_IDX=1,KSWB
1477         ZWORK1AER(:,WVL_IDX) = PACK(TRANSPOSE(ZCGA_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
1478         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1479         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZCGA_EQ_CLEAR(:,WVL_IDX)
1480      ENDDO
1481      DEALLOCATE(ZCGA_EQ)
1482      ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1483      DO WVL_IDX=1,KSWB
1484         ZCGA_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
1485      ENDDO
1486      !Relative wavelength-distributed optical depth
1487      DO WVL_IDX=1,KSWB
1488         ZWORK1AER(:,WVL_IDX) =  PACK(TRANSPOSE(ZTAUREL_EQ(:,:,WVL_IDX)), MASK=GCLOUDT(:,:))
1489         ZWORK2AER(1:ICLOUD,WVL_IDX) = ZWORK1AER(:,WVL_IDX)
1490         ZWORK2AER(ICLOUD+1:,WVL_IDX) = ZTAUREL_EQ_CLEAR(:,WVL_IDX)
1491      ENDDO
1492      DEALLOCATE(ZTAUREL_EQ)
1493      ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1494      DO WVL_IDX=1,KSWB
1495         ZTAUREL_EQ(:,:,WVL_IDX) = TRANSPOSE(RESHAPE(ZWORK2AER(:,WVL_IDX),(/KFLEV,ICLOUD_COL+1/)))
1496      ENDDO
1497      DEALLOCATE(ZWORK1AER)
1498      DEALLOCATE(ZWORK2AER)
1499   ELSE
1500      DEALLOCATE(ZPIZA_EQ)
1501      ALLOCATE(ZPIZA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1502      DEALLOCATE(ZCGA_EQ)
1503      ALLOCATE(ZCGA_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1504      DEALLOCATE(ZTAUREL_EQ)
1505      ALLOCATE(ZTAUREL_EQ(ICLOUD_COL+1,KFLEV,KSWB))
1506   ENDIF !Check on LDUST
1507   
1508   ! half-level variables
1509   !
1510   ZWORK1(:) = PACK( TRANSPOSE(ZPRES_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
1511   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD)  ! fills the ICLOUD_COL cloudy columns
1512   ZWORK2(ICLOUD+1:)= ZHP_CLEAR(1:)     !   and the single clear_sky one
1513   DEALLOCATE(ZPRES_HL)
1514   ALLOCATE(ZPRES_HL(ICLOUD_COL+1,KFLEV+1))
1515   ZPRES_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1516   ZPRES_HL(:,KFLEV+1) = PSTATM(IKSTAE,2)*100.0
1517   !
1518   ZWORK1(:) = PACK( TRANSPOSE(ZT_HL(:,1:KFLEV)),MASK=GCLOUDT(:,:) )
1519   ZWORK2(1:ICLOUD) = ZWORK1(1:ICLOUD)  ! fills the ICLOUD_COL cloudy columns
1520   ZWORK2(ICLOUD+1:)= ZHT_CLEAR(1:)     !   and the single clear_sky one
1521   DEALLOCATE(ZT_HL)
1522   ALLOCATE(ZT_HL(ICLOUD_COL+1,KFLEV+1))
1523   ZT_HL(:,1:KFLEV) = TRANSPOSE( RESHAPE( ZWORK2(:),(/KFLEV,ICLOUD_COL+1/) ) )
1524   ZT_HL(:,KFLEV+1) = PSTATM(IKSTAE,3)
1525   !
1526   ! surface fields
1527   !
1528   ALLOCATE(ZWORK3(ICLOUD_COL))
1529   ALLOCATE(ZWORK4(ICLOUD_COL,KSWB))
1530   ALLOCATE(ZWORK(KDLON))
1531   DO JALBS=1,KSWB
1532     ZWORK(:)  = ZALBP(:,JALBS)
1533     ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
1534     ZWORK4(:,JALBS) = ZWORK3(:)
1535   END DO
1536   DEALLOCATE(ZALBP)
1537   ALLOCATE(ZALBP(ICLOUD_COL+1,KSWB))
1538   ZALBP(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)
1539   ZALBP(ICLOUD_COL+1,:) = ZALBP_CLEAR(:)
1540   !
1541   DO JALBS=1,KSWB
1542     ZWORK(:)  = ZALBD(:,JALBS)
1543     ZWORK3(:) = PACK( ZWORK(:),MASK=.NOT.GCLEAR_2D(:) )
1544     ZWORK4(:,JALBS) = ZWORK3(:)
1545   END DO
1546   DEALLOCATE(ZALBD)
1547   ALLOCATE(ZALBD(ICLOUD_COL+1,KSWB))
1548   ZALBD(1:ICLOUD_COL,:) = ZWORK4(1:ICLOUD_COL,:)  
1549   ZALBD(ICLOUD_COL+1,:) = ZALBD_CLEAR(:)  
1550   !
1551   DEALLOCATE(ZWORK4)
1552   !
1553   ZWORK3(:) = PACK( ZEMIS(:),MASK=.NOT.GCLEAR_2D(:) )
1554   DEALLOCATE(ZEMIS)
1555   ALLOCATE(ZEMIS(ICLOUD_COL+1))
1556   ZEMIS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1557   ZEMIS(ICLOUD_COL+1) = ZEMIS_CLEAR
1558   !
1559   !
1560   ZWORK3(:) = PACK( ZEMIW(:),MASK=.NOT.GCLEAR_2D(:) )
1561   DEALLOCATE(ZEMIW)
1562   ALLOCATE(ZEMIW(ICLOUD_COL+1))
1563   ZEMIW(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1564   ZEMIW(ICLOUD_COL+1) = ZEMIW_CLEAR
1565   ! 
1566   !
1567   ZWORK3(:) = PACK( ZRMU0(:),MASK=.NOT.GCLEAR_2D(:) )
1568   DEALLOCATE(ZRMU0)
1569   ALLOCATE(ZRMU0(ICLOUD_COL+1))
1570   ZRMU0(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1571   ZRMU0(ICLOUD_COL+1) = ZRMU0_CLEAR
1572   !
1573   ZWORK3(:) = PACK( ZLSM(:),MASK=.NOT.GCLEAR_2D(:) )
1574   DEALLOCATE(ZLSM)
1575   ALLOCATE(ZLSM(ICLOUD_COL+1))
1576   ZLSM(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1577   ZLSM (ICLOUD_COL+1)= ZLSM_CLEAR
1578   ! 
1579   ZWORK3(:) = PACK( ZTS(:),MASK=.NOT.GCLEAR_2D(:) )
1580   DEALLOCATE(ZTS)
1581   ALLOCATE(ZTS(ICLOUD_COL+1))
1582   ZTS(1:ICLOUD_COL) = ZWORK3(1:ICLOUD_COL)
1583   ZTS(ICLOUD_COL+1) = ZTS_CLEAR
1584   !
1585   DEALLOCATE(ZWORK1)
1586   DEALLOCATE(ZWORK2)
1587   DEALLOCATE(ZWORK3)
1588   DEALLOCATE(ZWORK)
1589   !  
1590   IDIM = ICLOUD_COL +1
1591 !
1592 ELSE
1593   !
1594   !*       5.3   RADIATION COMPUTATIONS FOR THE FULL COLUMN NUMBER (KDLON)
1595   !
1596   IDIM = KDLON
1597 END IF
1598 !
1599 ! initialisation of cloud trace for the next radiation time step
1600 WHERE ( ZCLOUD(:) <= 0.0 )
1601   ICLEAR_2D_TM1(:) = 1
1602 ELSEWHERE
1603   ICLEAR_2D_TM1(:) = 0
1604 END WHERE
1605 !
1606 DO JJ=IJB,IJE
1607   DO JI=IIB,IIE
1608     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
1609     KCLEARCOL_TM1(JI,JJ) = ICLEAR_2D_TM1(IIJ)
1610   END DO
1611 END DO
1612
1613 !
1614 !*       5.4  VERTICAL grid modification(up-down) for compatibility with ECMWF 
1615 !             radiation vertical grid. ALLOCATION of the outputs.  
1616 !            
1617 !             
1618 ALLOCATE (ZWORK_GRID(SIZE(ZPRES_HL,1),KFLEV+1))
1619 !
1620 !half level pressure
1621 ZWORK_GRID(:,:)=ZPRES_HL(:,:)
1622 DO JKRAD=1, KFLEV+1
1623   JK1=(KFLEV+1)+1-JKRAD
1624   ZPRES_HL(:,JKRAD) = ZWORK_GRID(:,JK1)
1625 END DO
1626 !
1627 !half level temperature
1628 ZWORK_GRID(:,:)=ZT_HL(:,:)
1629 DO  JKRAD=1, KFLEV+1
1630   JK1=(KFLEV+1)+1-JKRAD
1631   ZT_HL(:,JKRAD)=ZWORK_GRID(:,JK1)
1632 END DO
1633 !
1634 DEALLOCATE(ZWORK_GRID)
1635 !
1636 !mean layer variables
1637 !-------------------------------------
1638 ALLOCATE(ZWORK_GRID(SIZE(ZTAVE,1),KFLEV))
1639 !
1640 !mean layer temperature
1641 ZWORK_GRID(:,:)=ZTAVE(:,:)
1642 DO JKRAD=1, KFLEV
1643   JK1=KFLEV+1-JKRAD
1644   ZTAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1645 END DO
1646 !
1647 !mean layer pressure
1648 ZWORK_GRID(:,:)=ZPAVE(:,:)
1649 DO JKRAD=1, KFLEV
1650   JK1=KFLEV+1-JKRAD
1651   ZPAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1652 END DO
1653 !
1654 !mean layer pressure thickness
1655 ZWORK_GRID(:,:)=ZDPRES(:,:)
1656 DO JKRAD=1, KFLEV
1657   JK1=KFLEV+1-JKRAD
1658   ZDPRES(:,JKRAD)=ZWORK_GRID(:,JK1)
1659 END DO
1660 !
1661 !mesh size
1662 ZWORK_GRID(:,:)=ZDZ(:,:)
1663 DO JKRAD=1, KFLEV
1664   JK1=KFLEV+1-JKRAD
1665   ZDZ(:,JKRAD)=ZWORK_GRID(:,JK1)
1666 END DO
1667
1668 !mean layer cloud fraction
1669 ZWORK_GRID(:,:)=ZCFAVE(:,:)
1670 DO JKRAD=1, KFLEV
1671   JK1=KFLEV+1-JKRAD
1672   ZCFAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1673 END DO
1674 !
1675 !mean layer water vapor mixing ratio
1676 ZWORK_GRID(:,:)=ZQVAVE(:,:)
1677 DO JKRAD=1, KFLEV
1678   JK1=KFLEV+1-JKRAD
1679   ZQVAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1680 END DO
1681 !
1682 !ice
1683 ZWORK_GRID(:,:)=ZQIAVE(:,:)
1684 DO JKRAD=1, KFLEV
1685   JK1=KFLEV+1-JKRAD
1686   ZQIAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1687 END DO
1688 !
1689 !liquid water
1690 ZWORK_GRID(:,:)=ZQLAVE(:,:)
1691 DO JKRAD=1, KFLEV
1692   JK1=KFLEV+1-JKRAD
1693   ZQLAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1694 END DO
1695
1696
1697 !rain water
1698 ZWORK_GRID(:,:)=ZQRAVE(:,:)
1699 DO JKRAD=1, KFLEV
1700   JK1=KFLEV+1-JKRAD
1701   ZQRAVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1702 END DO
1703 !
1704 !ice water content
1705 ZWORK_GRID(:,:)=ZQIWC(:,:)
1706 DO JKRAD=1, KFLEV
1707   JK1=KFLEV+1-JKRAD
1708   ZQIWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1709 END DO
1710 !
1711 !liquid water content
1712 ZWORK_GRID(:,:)=ZQLWC(:,:)
1713 DO JKRAD=1, KFLEV
1714   JK1=KFLEV+1-JKRAD
1715   ZQLWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1716 END DO
1717
1718
1719 !rain water content
1720 ZWORK_GRID(:,:)=ZQRWC(:,:)
1721 DO JKRAD=1, KFLEV
1722   JK1=KFLEV+1-JKRAD
1723   ZQRWC(:,JKRAD)=ZWORK_GRID(:,JK1)
1724 END DO
1725
1726
1727 !C2R2 water particle concentration
1728 !
1729 IF (SIZE(ZCCT_C2R2) > 0) THEN
1730   ZWORK_GRID(:,:)=ZCCT_C2R2(:,:)
1731   DO JKRAD=1, KFLEV
1732     JK1=KFLEV+1-JKRAD
1733     ZCCT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
1734   END DO
1735 END IF
1736 IF (SIZE(ZCRT_C2R2) > 0) THEN
1737   ZWORK_GRID(:,:)=ZCRT_C2R2(:,:)
1738   DO JKRAD=1, KFLEV
1739     JK1=KFLEV+1-JKRAD
1740     ZCRT_C2R2(:,JKRAD)=ZWORK_GRID(:,JK1)
1741   END DO
1742 END IF
1743 IF (SIZE(ZCIT_C1R3) > 0) THEN
1744   ZWORK_GRID(:,:)=ZCIT_C1R3(:,:)
1745   DO JKRAD=1, KFLEV
1746     JK1=KFLEV+1-JKRAD
1747     ZCIT_C1R3(:,JKRAD)=ZWORK_GRID(:,JK1)
1748   END DO
1749 END IF
1750 !
1751 !ozone content 
1752 ZWORK_GRID(:,:)=ZO3AVE(:,:)
1753 DO JKRAD=1, KFLEV
1754   JK1=KFLEV+1-JKRAD
1755   ZO3AVE(:,JKRAD)=ZWORK_GRID(:,JK1)
1756 END DO
1757 !
1758 !aerosol optical depth 
1759 DO JI=1,KAER
1760   ZWORK_GRID(:,:)=ZAER(:,:,JI)
1761   DO JKRAD=1, KFLEV
1762     JK1=KFLEV+1-JKRAD
1763     ZAER(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1764   END DO
1765 END DO
1766 IF (CAOP=='EXPL') THEN
1767 !TURN MORE FIELDS UPSIDE DOWN...
1768 !Dust single scattering albedo
1769 DO JI=1,KSWB
1770    ZWORK_GRID(:,:)=ZPIZA_EQ(:,:,JI)
1771    DO JKRAD=1,KFLEV
1772       JK1=KFLEV+1-JKRAD
1773       ZPIZA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1774    ENDDO
1775 ENDDO
1776 !Dust asymmetry factor
1777 DO JI=1,KSWB
1778    ZWORK_GRID(:,:)=ZCGA_EQ(:,:,JI)
1779    DO JKRAD=1,KFLEV
1780       JK1=KFLEV+1-JKRAD
1781       ZCGA_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1782    ENDDO
1783 ENDDO
1784 DO JI=1,KSWB
1785    ZWORK_GRID(:,:)=ZTAUREL_EQ(:,:,JI)
1786    DO JKRAD=1,KFLEV
1787       JK1=KFLEV+1-JKRAD
1788       ZTAUREL_EQ(:,JKRAD,JI)=ZWORK_GRID(:,JK1)
1789    ENDDO
1790 ENDDO 
1791
1792 END IF
1793
1794 !
1795 DEALLOCATE(ZWORK_GRID)
1796 !
1797 !mean layer saturation specific humidity
1798 !
1799 ALLOCATE(ZQSAVE(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
1800 !
1801 WHERE (ZTAVE(:,:) > XTT)
1802   ZQSAVE(:,:) = QSATW_2D(ZTAVE, ZPAVE)
1803 ELSEWHERE
1804   ZQSAVE(:,:) = QSATI_2D(ZTAVE, ZPAVE)
1805 END WHERE
1806 !
1807 ! allocations for the radiation code outputs
1808 !
1809 ALLOCATE(ZDTLW(IDIM,KFLEV))
1810 ALLOCATE(ZDTSW(IDIM,KFLEV))
1811 ALLOCATE(ZFLUX_TOP_GND_IRVISNIR(IDIM,KFLUX))
1812 ALLOCATE(ZSFSWDIR(IDIM,ISWB))
1813 ALLOCATE(ZSFSWDIF(IDIM,ISWB))
1814 ALLOCATE(ZDTLW_CS(IDIM,KFLEV))
1815 ALLOCATE(ZDTSW_CS(IDIM,KFLEV))
1816 ALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS(IDIM,KFLUX))
1817 !
1818 !
1819 ALLOCATE(ZFLUX_LW(IDIM,2,KFLEV+1))
1820 ALLOCATE(ZFLUX_SW_DOWN(IDIM,KFLEV+1))
1821 ALLOCATE(ZFLUX_SW_UP(IDIM,KFLEV+1))
1822 ALLOCATE(ZRADLP(IDIM,KFLEV))
1823 IF( KRAD_DIAG >= 1) THEN
1824   ALLOCATE(ZNFLW(IDIM,KFLEV+1))
1825   ALLOCATE(ZNFSW(IDIM,KFLEV+1))
1826 ELSE
1827   ALLOCATE(ZNFLW(0,0))
1828   ALLOCATE(ZNFSW(0,0))
1829 END IF
1830
1831 IF( KRAD_DIAG >= 2) THEN
1832   ALLOCATE(ZFLUX_SW_DOWN_CS(IDIM,KFLEV+1))
1833   ALLOCATE(ZFLUX_SW_UP_CS(IDIM,KFLEV+1))
1834   ALLOCATE(ZFLUX_LW_CS(IDIM,2,KFLEV+1))
1835   ALLOCATE(ZNFLW_CS(IDIM,KFLEV+1))
1836   ALLOCATE(ZNFSW_CS(IDIM,KFLEV+1))
1837 ELSE
1838   ALLOCATE(ZFLUX_SW_DOWN_CS(0,0))
1839   ALLOCATE(ZFLUX_SW_UP_CS(0,0))
1840   ALLOCATE(ZFLUX_LW_CS(0,0,0))
1841   ALLOCATE(ZNFSW_CS(0,0))
1842   ALLOCATE(ZNFLW_CS(0,0))
1843 END IF
1844 !
1845 IF( KRAD_DIAG >= 3) THEN
1846   ALLOCATE(ZPLAN_ALB_VIS(IDIM))
1847   ALLOCATE(ZPLAN_ALB_NIR(IDIM))
1848   ALLOCATE(ZPLAN_TRA_VIS(IDIM))
1849   ALLOCATE(ZPLAN_TRA_NIR(IDIM))
1850   ALLOCATE(ZPLAN_ABS_VIS(IDIM))
1851   ALLOCATE(ZPLAN_ABS_NIR(IDIM))
1852 ELSE
1853   ALLOCATE(ZPLAN_ALB_VIS(0))
1854   ALLOCATE(ZPLAN_ALB_NIR(0))
1855   ALLOCATE(ZPLAN_TRA_VIS(0))
1856   ALLOCATE(ZPLAN_TRA_NIR(0))
1857   ALLOCATE(ZPLAN_ABS_VIS(0))
1858   ALLOCATE(ZPLAN_ABS_NIR(0))
1859 END IF
1860 !
1861 IF( KRAD_DIAG >= 4) THEN
1862   ALLOCATE(ZEFCL_RRTM(IDIM,KFLEV))
1863   ALLOCATE(ZCLSW_TOTAL(IDIM,KFLEV))
1864   ALLOCATE(ZTAU_TOTAL(IDIM,KSWB,KFLEV))
1865   ALLOCATE(ZOMEGA_TOTAL(IDIM,KSWB,KFLEV))
1866   ALLOCATE(ZCG_TOTAL(IDIM,KSWB,KFLEV))
1867   ALLOCATE(ZEFCL_LWD(IDIM,KFLEV))
1868   ALLOCATE(ZEFCL_LWU(IDIM,KFLEV))
1869   ALLOCATE(ZFLWP(IDIM,KFLEV))
1870   ALLOCATE(ZFIWP(IDIM,KFLEV))  
1871   ALLOCATE(ZRADIP(IDIM,KFLEV)) 
1872 ELSE
1873   ALLOCATE(ZEFCL_RRTM(0,0))
1874   ALLOCATE(ZCLSW_TOTAL(0,0))
1875   ALLOCATE(ZTAU_TOTAL(0,0,0))
1876   ALLOCATE(ZOMEGA_TOTAL(0,0,0))
1877   ALLOCATE(ZCG_TOTAL(0,0,0))
1878   ALLOCATE(ZEFCL_LWD(0,0))
1879   ALLOCATE(ZEFCL_LWU(0,0))
1880   ALLOCATE(ZFLWP(0,0))
1881   ALLOCATE(ZFIWP(0,0))
1882   ALLOCATE(ZRADIP(0,0))
1883 END IF
1884 !
1885 !*       5.6   CALLS THE ECMWF_RADIATION ROUTINES
1886 !
1887 !  mixing ratio -> specific humidity conversion
1888 !
1889
1890 ZQVAVE(:,:) = ZQVAVE(:,:) / (1.+ZQVAVE(:,:))
1891 !
1892 IF( IDIM <= KRAD_COLNBR ) THEN 
1893 !
1894 ! there is less than KRAD_COLNBR verticals to be considered therefore
1895 ! no split of the arrays is performed
1896 !
1897  ALLOCATE(ZTAVE_RAD(SIZE(ZTAVE,1),SIZE(ZTAVE,2)))
1898  ALLOCATE(ZPAVE_RAD(SIZE(ZPAVE,1),SIZE(ZPAVE,2)))
1899  ZTAVE_RAD = ZTAVE
1900  ZPAVE_RAD = ZPAVE
1901   CALL ECMWF_RADIATION_VERS2  ( IDIM ,KFLEV, KRAD_DIAG, KAER,     &      
1902        ZDZ,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG,      &
1903        ZRII0, ZAER , ZALBD, ZALBP, ZPRES_HL, ZPAVE_RAD,               &
1904        PCCO2, ZCFAVE, ZDPRES, ZEMIS, ZEMIW, ZLSM, ZRMU0,          &
1905        ZO3AVE , ZQVAVE, ZQIAVE ,ZQIWC,ZQLAVE,ZQLWC, ZQSAVE, ZQRAVE,  ZQRWC,  &
1906        ZT_HL,ZTAVE_RAD, ZTS, ZCCT_C2R2, ZCRT_C2R2, ZCIT_C1R3,         &
1907        ZNFLW_CS, ZNFLW, ZNFSW_CS,ZNFSW,                           &
1908        ZDTLW, ZDTSW, ZFLUX_TOP_GND_IRVISNIR,                      &
1909        ZSFSWDIR, ZSFSWDIF,                                        &
1910        ZFLUX_SW_DOWN, ZFLUX_SW_UP, ZFLUX_LW ,                     &
1911        ZDTLW_CS, ZDTSW_CS, ZFLUX_TOP_GND_IRVISNIR_CS,             &
1912        ZFLUX_SW_DOWN_CS, ZFLUX_SW_UP_CS, ZFLUX_LW_CS,             &           
1913        ZPLAN_ALB_VIS,ZPLAN_ALB_NIR, ZPLAN_TRA_VIS, ZPLAN_TRA_NIR, &
1914        ZPLAN_ABS_VIS, ZPLAN_ABS_NIR,ZEFCL_LWD, ZEFCL_LWU,         &
1915        ZFLWP, ZFIWP,ZRADLP, ZRADIP,ZEFCL_RRTM,  ZCLSW_TOTAL,  ZTAU_TOTAL,  &
1916        ZOMEGA_TOTAL,ZCG_TOTAL,                                    &
1917        GAOP, ZPIZA_EQ,ZCGA_EQ,ZTAUREL_EQ                       )
1918  DEALLOCATE(ZTAVE_RAD,ZPAVE_RAD)
1919 ELSE
1920 !
1921 ! the splitting of the arrays will be performed
1922 !
1923   INUM_CALL = CEILING( FLOAT( IDIM ) / FLOAT( KRAD_COLNBR ) )
1924   IDIM_RESIDUE = IDIM
1925 !
1926   DO JI_SPLIT = 1 , INUM_CALL
1927     IDIM_EFF = MIN( IDIM_RESIDUE,KRAD_COLNBR )
1928     !
1929     IF( JI_SPLIT == 1 .OR. JI_SPLIT == INUM_CALL ) THEN       
1930       ALLOCATE(  ZALBP_SPLIT(IDIM_EFF,KSWB))
1931       ALLOCATE(  ZALBD_SPLIT(IDIM_EFF,KSWB))  
1932       ALLOCATE(  ZEMIS_SPLIT(IDIM_EFF))
1933       ALLOCATE(  ZEMIW_SPLIT(IDIM_EFF))
1934       ALLOCATE(  ZRMU0_SPLIT(IDIM_EFF))
1935       ALLOCATE(  ZCFAVE_SPLIT(IDIM_EFF,KFLEV))
1936       ALLOCATE(  ZO3AVE_SPLIT(IDIM_EFF,KFLEV))
1937       ALLOCATE(  ZT_HL_SPLIT(IDIM_EFF,KFLEV+1))
1938       ALLOCATE(  ZPRES_HL_SPLIT(IDIM_EFF,KFLEV+1))
1939       ALLOCATE(  ZDZ_SPLIT(IDIM_EFF,KFLEV))
1940       ALLOCATE(  ZQLAVE_SPLIT(IDIM_EFF,KFLEV))
1941       ALLOCATE(  ZQIAVE_SPLIT(IDIM_EFF,KFLEV))
1942       ALLOCATE(  ZQRAVE_SPLIT(IDIM_EFF,KFLEV))
1943       ALLOCATE(  ZQLWC_SPLIT(IDIM_EFF,KFLEV))
1944       ALLOCATE(  ZQIWC_SPLIT(IDIM_EFF,KFLEV))
1945       ALLOCATE(  ZQRWC_SPLIT(IDIM_EFF,KFLEV))
1946       ALLOCATE(  ZQVAVE_SPLIT(IDIM_EFF,KFLEV))
1947       ALLOCATE(  ZTAVE_SPLIT(IDIM_EFF,KFLEV))
1948       ALLOCATE(  ZPAVE_SPLIT(IDIM_EFF,KFLEV))
1949       ALLOCATE(  ZAER_SPLIT( IDIM_EFF,KFLEV,KAER))
1950       ALLOCATE( ZPIZA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1951       ALLOCATE( ZCGA_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1952       ALLOCATE( ZTAUREL_EQ_SPLIT(IDIM_EFF,KFLEV,KSWB))
1953       ALLOCATE(  ZDPRES_SPLIT(IDIM_EFF,KFLEV))
1954       ALLOCATE(  ZLSM_SPLIT(IDIM_EFF))
1955       ALLOCATE(  ZQSAVE_SPLIT(IDIM_EFF,KFLEV))
1956       ALLOCATE(  ZTS_SPLIT(IDIM_EFF))
1957       ! output pronostic       
1958       ALLOCATE(  ZDTLW_SPLIT(IDIM_EFF,KFLEV))
1959       ALLOCATE(  ZDTSW_SPLIT(IDIM_EFF,KFLEV))
1960       ALLOCATE(  ZFLUX_TOP_GND_IRVISNIR_SPLIT(IDIM_EFF,KFLUX))
1961       ALLOCATE(  ZSFSWDIR_SPLIT(IDIM_EFF,ISWB))
1962       ALLOCATE(  ZSFSWDIF_SPLIT(IDIM_EFF,ISWB))
1963       ALLOCATE(  ZDTLW_CS_SPLIT(IDIM_EFF,KFLEV))
1964       ALLOCATE(  ZDTSW_CS_SPLIT(IDIM_EFF,KFLEV))
1965       ALLOCATE(  ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(IDIM_EFF,KFLUX))
1966 !
1967       ALLOCATE(  ZFLUX_LW_SPLIT(IDIM_EFF,2,KFLEV+1))
1968       ALLOCATE(  ZFLUX_SW_DOWN_SPLIT(IDIM_EFF,KFLEV+1))
1969       ALLOCATE(  ZFLUX_SW_UP_SPLIT(IDIM_EFF,KFLEV+1))
1970       ALLOCATE(  ZRADLP_SPLIT(IDIM_EFF,KFLEV))
1971       IF(KRAD_DIAG >=1) THEN
1972         ALLOCATE(  ZNFSW_SPLIT(IDIM_EFF,KFLEV+1))
1973         ALLOCATE(  ZNFLW_SPLIT(IDIM_EFF,KFLEV+1))
1974       ELSE
1975         ALLOCATE(  ZNFSW_SPLIT(0,0))
1976         ALLOCATE(  ZNFLW_SPLIT(0,0))
1977       END IF
1978 !
1979       IF( KRAD_DIAG >= 2) THEN      
1980         ALLOCATE(  ZFLUX_SW_DOWN_CS_SPLIT(IDIM_EFF,KFLEV+1))
1981         ALLOCATE(  ZFLUX_SW_UP_CS_SPLIT(IDIM_EFF,KFLEV+1))
1982         ALLOCATE(  ZFLUX_LW_CS_SPLIT(IDIM_EFF,2,KFLEV+1))
1983         ALLOCATE(   ZNFSW_CS_SPLIT(IDIM_EFF,KFLEV+1))
1984         ALLOCATE(   ZNFLW_CS_SPLIT(IDIM_EFF,KFLEV+1))
1985       ELSE
1986         ALLOCATE(  ZFLUX_SW_DOWN_CS_SPLIT(0,0))
1987         ALLOCATE(  ZFLUX_SW_UP_CS_SPLIT(0,0))
1988         ALLOCATE(  ZFLUX_LW_CS_SPLIT(0,0,0))
1989         ALLOCATE(  ZNFSW_CS_SPLIT(0,0))
1990         ALLOCATE(  ZNFLW_CS_SPLIT(0,0))
1991       END IF
1992 !
1993       IF( KRAD_DIAG >= 3) THEN
1994         ALLOCATE(  ZPLAN_ALB_VIS_SPLIT(IDIM_EFF))
1995         ALLOCATE(  ZPLAN_ALB_NIR_SPLIT(IDIM_EFF))
1996         ALLOCATE(  ZPLAN_TRA_VIS_SPLIT(IDIM_EFF))
1997         ALLOCATE(  ZPLAN_TRA_NIR_SPLIT(IDIM_EFF))
1998         ALLOCATE(  ZPLAN_ABS_VIS_SPLIT(IDIM_EFF))
1999         ALLOCATE(  ZPLAN_ABS_NIR_SPLIT(IDIM_EFF))
2000       ELSE
2001         ALLOCATE(  ZPLAN_ALB_VIS_SPLIT(0))
2002         ALLOCATE(  ZPLAN_ALB_NIR_SPLIT(0))
2003         ALLOCATE(  ZPLAN_TRA_VIS_SPLIT(0))
2004         ALLOCATE(  ZPLAN_TRA_NIR_SPLIT(0))
2005         ALLOCATE(  ZPLAN_ABS_VIS_SPLIT(0))
2006         ALLOCATE(  ZPLAN_ABS_NIR_SPLIT(0))
2007       END IF
2008 !
2009       IF( KRAD_DIAG >= 4) THEN
2010         ALLOCATE(  ZEFCL_RRTM_SPLIT(IDIM_EFF,KFLEV))
2011         ALLOCATE(  ZCLSW_TOTAL_SPLIT(IDIM_EFF,KFLEV))
2012         ALLOCATE(  ZTAU_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
2013         ALLOCATE(  ZOMEGA_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
2014         ALLOCATE(  ZCG_TOTAL_SPLIT(IDIM_EFF,KSWB,KFLEV))
2015         ALLOCATE(  ZEFCL_LWD_SPLIT(IDIM_EFF,KFLEV))
2016         ALLOCATE(  ZEFCL_LWU_SPLIT(IDIM_EFF,KFLEV))
2017         ALLOCATE(  ZFLWP_SPLIT(IDIM_EFF,KFLEV))
2018         ALLOCATE(  ZFIWP_SPLIT(IDIM_EFF,KFLEV))
2019         ALLOCATE(  ZRADIP_SPLIT(IDIM_EFF,KFLEV))
2020       ELSE
2021         ALLOCATE(  ZEFCL_RRTM_SPLIT(0,0))
2022         ALLOCATE(  ZCLSW_TOTAL_SPLIT(0,0))
2023         ALLOCATE(  ZTAU_TOTAL_SPLIT(0,0,0))
2024         ALLOCATE(  ZOMEGA_TOTAL_SPLIT(0,0,0))
2025         ALLOCATE(  ZCG_TOTAL_SPLIT(0,0,0))
2026         ALLOCATE(  ZEFCL_LWD_SPLIT(0,0))
2027         ALLOCATE(  ZEFCL_LWU_SPLIT(0,0))
2028         ALLOCATE(  ZFLWP_SPLIT(0,0))
2029         ALLOCATE(  ZFIWP_SPLIT(0,0))
2030         ALLOCATE(  ZRADIP_SPLIT(0,0))
2031       END IF
2032 !
2033 ! C2R2 coupling
2034 !
2035       IF (SIZE (ZCCT_C2R2) > 0)  THEN
2036         ALLOCATE (ZCCT_C2R2_SPLIT(IDIM_EFF,KFLEV))
2037       ELSE
2038         ALLOCATE (ZCCT_C2R2_SPLIT(0,0))
2039       END IF
2040 !
2041       IF (SIZE (ZCRT_C2R2) > 0)  THEN
2042         ALLOCATE (ZCRT_C2R2_SPLIT(IDIM_EFF,KFLEV))
2043       ELSE
2044         ALLOCATE (ZCRT_C2R2_SPLIT(0,0))
2045       END IF
2046 !
2047       IF (SIZE (ZCIT_C1R3) > 0)  THEN
2048         ALLOCATE (ZCIT_C1R3_SPLIT(IDIM_EFF,KFLEV))
2049       ELSE
2050         ALLOCATE (ZCIT_C1R3_SPLIT(0,0))
2051       END IF
2052     END IF
2053
2054 ! fill the splitted arrays with their values taken from the full arrays 
2055 !
2056     IBEG = IDIM-IDIM_RESIDUE+1
2057     IEND = IBEG+IDIM_EFF-1
2058 !
2059     ZALBP_SPLIT(:,:) = ZALBP( IBEG:IEND ,:)
2060     ZALBD_SPLIT(:,:) = ZALBD( IBEG:IEND ,:)
2061     ZEMIS_SPLIT(:) = ZEMIS ( IBEG:IEND )
2062     ZEMIW_SPLIT(:) = ZEMIW ( IBEG:IEND )
2063     ZRMU0_SPLIT(:)    = ZRMU0 ( IBEG:IEND )
2064     ZCFAVE_SPLIT(:,:) = ZCFAVE( IBEG:IEND ,:)
2065     ZO3AVE_SPLIT(:,:) = ZO3AVE( IBEG:IEND ,:)
2066     ZT_HL_SPLIT(:,:)    = ZT_HL( IBEG:IEND ,:)
2067     ZPRES_HL_SPLIT(:,:) = ZPRES_HL( IBEG:IEND ,:)
2068     ZQLAVE_SPLIT(:,:) = ZQLAVE( IBEG:IEND , :)
2069     ZDZ_SPLIT(:,:) = ZDZ( IBEG:IEND , :)
2070     ZQIAVE_SPLIT(:,:) = ZQIAVE( IBEG:IEND ,:)
2071     ZQRAVE_SPLIT (:,:) = ZQRAVE (IBEG:IEND ,:)
2072     ZQLWC_SPLIT(:,:) = ZQLWC( IBEG:IEND , :)
2073     ZQIWC_SPLIT(:,:) = ZQIWC( IBEG:IEND ,:)
2074     ZQRWC_SPLIT(:,:) = ZQRWC (IBEG:IEND ,:)
2075     ZQVAVE_SPLIT(:,:) = ZQVAVE( IBEG:IEND ,:)
2076     ZTAVE_SPLIT(:,:)  = ZTAVE ( IBEG:IEND ,:)
2077     ZPAVE_SPLIT(:,:)  = ZPAVE ( IBEG:IEND ,:)
2078     ZAER_SPLIT (:,:,:)  = ZAER  ( IBEG:IEND ,:,:)
2079     IF(CAOP=='EXPL')THEN
2080        ZPIZA_EQ_SPLIT(:,:,:)=ZPIZA_EQ(IBEG:IEND,:,:)
2081        ZCGA_EQ_SPLIT(:,:,:)=ZCGA_EQ(IBEG:IEND,:,:)
2082        ZTAUREL_EQ_SPLIT(:,:,:)=ZTAUREL_EQ(IBEG:IEND,:,:)
2083     ENDIF
2084     ZDPRES_SPLIT(:,:)  = ZDPRES (IBEG:IEND ,:)
2085     ZLSM_SPLIT (:)    = ZLSM (IBEG:IEND)
2086     ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
2087     ZTS_SPLIT (:) = ZTS (IBEG:IEND)
2088 !
2089 ! C2R2 concentrations
2090     IF (SIZE (ZCCT_C2R2) > 0)  ZCCT_C2R2_SPLIT(:,:) = ZCCT_C2R2 (IBEG:IEND ,:)
2091     IF (SIZE (ZCRT_C2R2) > 0)  ZCRT_C2R2_SPLIT(:,:) = ZCRT_C2R2 (IBEG:IEND ,:)  
2092     IF (SIZE (ZCIT_C1R3) > 0)  ZCIT_C1R3_SPLIT(:,:) = ZCIT_C1R3 (IBEG:IEND ,:)
2093 !
2094 !  CALL the ECMWF radiation with the splitted array
2095 !
2096    CALL ECMWF_RADIATION_VERS2  ( IDIM_EFF , KFLEV, KRAD_DIAG, KAER,              &    
2097          ZDZ_SPLIT,HEFRADL,HEFRADI,HOPWSW, HOPISW, HOPWLW, HOPILW,PFUDG,                    &
2098          ZRII0, ZAER_SPLIT , ZALBD_SPLIT, ZALBP_SPLIT, ZPRES_HL_SPLIT,            &
2099          ZPAVE_SPLIT,PCCO2, ZCFAVE_SPLIT, ZDPRES_SPLIT, ZEMIS_SPLIT, ZEMIW_SPLIT, &
2100          ZLSM_SPLIT, ZRMU0_SPLIT,ZO3AVE_SPLIT , ZQVAVE_SPLIT, ZQIAVE_SPLIT ,ZQIWC_SPLIT,      & 
2101          ZQLAVE_SPLIT,ZQLWC_SPLIT,ZQSAVE_SPLIT, ZQRAVE_SPLIT,ZQRWC_SPLIT,  ZT_HL_SPLIT,      &
2102          ZTAVE_SPLIT, ZTS_SPLIT, ZCCT_C2R2_SPLIT,ZCRT_C2R2_SPLIT,ZCIT_C1R3_SPLIT, & 
2103          ZNFLW_CS_SPLIT, ZNFLW_SPLIT, ZNFSW_CS_SPLIT,ZNFSW_SPLIT,                 &          
2104          ZDTLW_SPLIT, ZDTSW_SPLIT, ZFLUX_TOP_GND_IRVISNIR_SPLIT,                  &
2105          ZSFSWDIR_SPLIT, ZSFSWDIF_SPLIT,                                          &
2106          ZFLUX_SW_DOWN_SPLIT, ZFLUX_SW_UP_SPLIT, ZFLUX_LW_SPLIT ,                 &
2107          ZDTLW_CS_SPLIT, ZDTSW_CS_SPLIT, ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT,         &
2108          ZFLUX_SW_DOWN_CS_SPLIT, ZFLUX_SW_UP_CS_SPLIT, ZFLUX_LW_CS_SPLIT,         & 
2109          ZPLAN_ALB_VIS_SPLIT,ZPLAN_ALB_NIR_SPLIT, ZPLAN_TRA_VIS_SPLIT,            &
2110          ZPLAN_TRA_NIR_SPLIT, ZPLAN_ABS_VIS_SPLIT, ZPLAN_ABS_NIR_SPLIT,           &
2111          ZEFCL_LWD_SPLIT, ZEFCL_LWU_SPLIT, ZFLWP_SPLIT,ZFIWP_SPLIT,               &
2112          ZRADLP_SPLIT,ZRADIP_SPLIT,ZEFCL_RRTM_SPLIT, ZCLSW_TOTAL_SPLIT,           &
2113          ZTAU_TOTAL_SPLIT,ZOMEGA_TOTAL_SPLIT, ZCG_TOTAL_SPLIT,                    &
2114          GAOP,ZPIZA_EQ_SPLIT,ZCGA_EQ_SPLIT,ZTAUREL_EQ_SPLIT  )
2115
2116 !
2117 ! fill the full output arrays with the splitted arrays
2118 !
2119     ZDTLW( IBEG:IEND ,:)  =  ZDTLW_SPLIT(:,:)  
2120     ZDTSW( IBEG:IEND ,:)  =  ZDTSW_SPLIT(:,:) 
2121     ZFLUX_TOP_GND_IRVISNIR( IBEG:IEND ,:)=  ZFLUX_TOP_GND_IRVISNIR_SPLIT(:,:) 
2122     ZSFSWDIR (IBEG:IEND,:)  = ZSFSWDIR_SPLIT(:,:)
2123     ZSFSWDIF (IBEG:IEND,:)  = ZSFSWDIF_SPLIT(:,:)
2124 !
2125     ZDTLW_CS( IBEG:IEND ,:) =  ZDTLW_CS_SPLIT(:,:)
2126     ZDTSW_CS( IBEG:IEND ,:) =  ZDTSW_CS_SPLIT(:,:)
2127     ZFLUX_TOP_GND_IRVISNIR_CS( IBEG:IEND ,:) =                     &
2128          ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT(:,:)
2129     ZFLUX_LW( IBEG:IEND ,:,:)    =  ZFLUX_LW_SPLIT(:,:,:) 
2130     ZFLUX_SW_DOWN( IBEG:IEND ,:) =  ZFLUX_SW_DOWN_SPLIT(:,:)
2131     ZFLUX_SW_UP( IBEG:IEND ,:)   =  ZFLUX_SW_UP_SPLIT(:,:)
2132     ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
2133     IF( OCLOSE_OUT ) THEN
2134       IF( KRAD_DIAG >= 1) THEN
2135         ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
2136         ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
2137         IF( KRAD_DIAG >= 2) THEN
2138           ZFLUX_SW_DOWN_CS( IBEG:IEND ,:) = ZFLUX_SW_DOWN_CS_SPLIT(:,:)
2139           ZFLUX_SW_UP_CS( IBEG:IEND ,:)   = ZFLUX_SW_UP_CS_SPLIT(:,:)
2140           ZFLUX_LW_CS( IBEG:IEND ,:,:)    = ZFLUX_LW_CS_SPLIT(:,:,:)
2141           ZNFLW_CS(IBEG:IEND ,:)= ZNFLW_CS_SPLIT(:,:)
2142           ZNFSW_CS(IBEG:IEND ,:)= ZNFSW_CS_SPLIT(:,:)
2143           IF( KRAD_DIAG >= 3) THEN
2144             ZPLAN_ALB_VIS( IBEG:IEND ) = ZPLAN_ALB_VIS_SPLIT(:)
2145             ZPLAN_ALB_NIR( IBEG:IEND ) = ZPLAN_ALB_NIR_SPLIT(:)
2146             ZPLAN_TRA_VIS( IBEG:IEND ) = ZPLAN_TRA_VIS_SPLIT(:)
2147             ZPLAN_TRA_NIR( IBEG:IEND ) = ZPLAN_TRA_NIR_SPLIT(:)
2148             ZPLAN_ABS_VIS( IBEG:IEND ) = ZPLAN_ABS_VIS_SPLIT(:)
2149             ZPLAN_ABS_NIR( IBEG:IEND ) = ZPLAN_ABS_NIR_SPLIT(:)          
2150             IF( KRAD_DIAG >= 4) THEN
2151               ZEFCL_LWD( IBEG:IEND ,:) = ZEFCL_LWD_SPLIT(:,:)
2152               ZEFCL_LWU( IBEG:IEND ,:)   = ZEFCL_LWU_SPLIT(:,:)
2153               ZFLWP( IBEG:IEND ,:) = ZFLWP_SPLIT(:,:)
2154               ZFIWP( IBEG:IEND ,:) = ZFIWP_SPLIT(:,:)
2155               ZRADIP( IBEG:IEND ,:) = ZRADIP_SPLIT(:,:)
2156               ZEFCL_RRTM( IBEG:IEND ,:) = ZEFCL_RRTM_SPLIT(:,:)
2157               ZCLSW_TOTAL( IBEG:IEND ,:) = ZCLSW_TOTAL_SPLIT(:,:)
2158               ZTAU_TOTAL( IBEG:IEND ,:,:)  = ZTAU_TOTAL_SPLIT(:,:,:)
2159               ZOMEGA_TOTAL( IBEG:IEND ,:,:)= ZOMEGA_TOTAL_SPLIT(:,:,:)
2160               ZCG_TOTAL( IBEG:IEND ,:,:)   = ZCG_TOTAL_SPLIT(:,:,:)                
2161             END IF
2162           END IF
2163         END IF
2164       END IF
2165     END IF
2166 !
2167     IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
2168 !
2169 ! desallocation of the splitted arrays
2170 !
2171     IF( JI_SPLIT >= INUM_CALL-1 ) THEN
2172       DEALLOCATE(  ZALBP_SPLIT )
2173       DEALLOCATE(  ZALBD_SPLIT )  
2174       DEALLOCATE(  ZEMIS_SPLIT  )
2175       DEALLOCATE(  ZEMIW_SPLIT  )
2176       DEALLOCATE(  ZRMU0_SPLIT      )
2177       DEALLOCATE(  ZCFAVE_SPLIT     )
2178       DEALLOCATE(  ZO3AVE_SPLIT     )
2179       DEALLOCATE(  ZT_HL_SPLIT      )
2180       DEALLOCATE(  ZPRES_HL_SPLIT   )
2181       DEALLOCATE(  ZDZ_SPLIT     )
2182       DEALLOCATE(  ZQLAVE_SPLIT     )
2183       DEALLOCATE(  ZQIAVE_SPLIT     )
2184       DEALLOCATE(  ZQVAVE_SPLIT     )
2185       DEALLOCATE(  ZTAVE_SPLIT      )
2186       DEALLOCATE(  ZPAVE_SPLIT      )
2187       DEALLOCATE(  ZAER_SPLIT       )
2188       DEALLOCATE(  ZDPRES_SPLIT     )
2189       DEALLOCATE(  ZLSM_SPLIT       )
2190       DEALLOCATE(  ZQSAVE_SPLIT     )
2191       DEALLOCATE(  ZQRAVE_SPLIT  )
2192       DEALLOCATE(  ZQLWC_SPLIT     )
2193       DEALLOCATE(  ZQRWC_SPLIT     )
2194       DEALLOCATE(  ZQIWC_SPLIT     )
2195       DEALLOCATE(   ZCCT_C2R2_SPLIT  )
2196       DEALLOCATE(   ZCRT_C2R2_SPLIT  )
2197       DEALLOCATE(   ZCIT_C1R3_SPLIT  )
2198       DEALLOCATE(  ZTS_SPLIT    )
2199       DEALLOCATE(   ZNFLW_CS_SPLIT)
2200       DEALLOCATE(   ZNFLW_SPLIT)
2201       DEALLOCATE(   ZNFSW_CS_SPLIT)
2202       DEALLOCATE(   ZNFSW_SPLIT)
2203       DEALLOCATE(ZDTLW_SPLIT)
2204       DEALLOCATE(ZDTSW_SPLIT)
2205       DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_SPLIT)
2206       DEALLOCATE(ZSFSWDIR_SPLIT)
2207       DEALLOCATE(ZSFSWDIF_SPLIT)
2208       DEALLOCATE(ZFLUX_SW_DOWN_SPLIT)
2209       DEALLOCATE(ZFLUX_SW_UP_SPLIT)
2210       DEALLOCATE(ZFLUX_LW_SPLIT)
2211       DEALLOCATE(ZDTLW_CS_SPLIT)
2212       DEALLOCATE(ZDTSW_CS_SPLIT)
2213       DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS_SPLIT)
2214       DEALLOCATE(ZPLAN_ALB_VIS_SPLIT)
2215       DEALLOCATE(ZPLAN_ALB_NIR_SPLIT)
2216       DEALLOCATE(ZPLAN_TRA_VIS_SPLIT)
2217       DEALLOCATE(ZPLAN_TRA_NIR_SPLIT)
2218       DEALLOCATE(ZPLAN_ABS_VIS_SPLIT)
2219       DEALLOCATE(ZPLAN_ABS_NIR_SPLIT)
2220       DEALLOCATE(ZEFCL_LWD_SPLIT)
2221       DEALLOCATE(ZEFCL_LWU_SPLIT)
2222       DEALLOCATE(ZFLWP_SPLIT)
2223       DEALLOCATE(ZRADLP_SPLIT)
2224       DEALLOCATE(ZRADIP_SPLIT)
2225       DEALLOCATE(ZFIWP_SPLIT)
2226       DEALLOCATE(ZEFCL_RRTM_SPLIT)
2227       DEALLOCATE(ZCLSW_TOTAL_SPLIT)
2228       DEALLOCATE(ZTAU_TOTAL_SPLIT)
2229       DEALLOCATE(ZOMEGA_TOTAL_SPLIT)
2230       DEALLOCATE(ZCG_TOTAL_SPLIT)
2231       DEALLOCATE(ZFLUX_SW_DOWN_CS_SPLIT)
2232       DEALLOCATE(ZFLUX_SW_UP_CS_SPLIT)
2233       DEALLOCATE(ZFLUX_LW_CS_SPLIT)
2234       DEALLOCATE(ZPIZA_EQ_SPLIT)
2235       DEALLOCATE(ZCGA_EQ_SPLIT)
2236       DEALLOCATE(ZTAUREL_EQ_SPLIT)
2237     END IF
2238   END DO
2239 END IF
2240
2241 !
2242 DEALLOCATE(ZTAVE)
2243 DEALLOCATE(ZPAVE)
2244 DEALLOCATE(ZQVAVE)
2245 DEALLOCATE(ZQLAVE)
2246 DEALLOCATE(ZDZ)
2247 DEALLOCATE(ZQIAVE)
2248 DEALLOCATE(ZCFAVE)
2249 DEALLOCATE(ZPRES_HL)
2250 DEALLOCATE(ZT_HL)
2251 DEALLOCATE(ZRMU0) 
2252 DEALLOCATE(ZLSM)
2253 DEALLOCATE(ZQSAVE)
2254 DEALLOCATE(ZAER)
2255 DEALLOCATE(ZPIZA_EQ)
2256 DEALLOCATE(ZCGA_EQ)
2257 DEALLOCATE(ZTAUREL_EQ)
2258 DEALLOCATE(ZDPRES)
2259 DEALLOCATE(ZCCT_C2R2)
2260 DEALLOCATE(ZCRT_C2R2)
2261 DEALLOCATE(ZCIT_C1R3)
2262 !
2263 DEALLOCATE(ZTS)
2264 DEALLOCATE(ZALBP)
2265 DEALLOCATE(ZALBD)
2266 DEALLOCATE(ZEMIS)
2267 DEALLOCATE(ZEMIW)
2268 DEALLOCATE(ZQRAVE)
2269 DEALLOCATE(ZQLWC)
2270 DEALLOCATE(ZQIWC)
2271 DEALLOCATE(ZQRWC)
2272 DEALLOCATE(ICLEAR_2D_TM1)
2273 !
2274 !*       5.6   UNCOMPRESSES THE OUTPUT FIELD IN CASE OF 
2275 !                      CLEAR-SKY APPROXIMATION
2276 !
2277 IF(OCLEAR_SKY .OR. OCLOUD_ONLY) THEN
2278   ALLOCATE(ZWORK1(ICLOUD))
2279   ALLOCATE(ZWORK2(ICLOUD+KFLEV)) !       allocation for the KFLEV levels of 
2280   ALLOCATE(ZWORK4(KFLEV,KDLON))
2281   ZWORK2(:) = PACK( TRANSPOSE(ZDTLW(:,:)),MASK=.TRUE. )
2282 !
2283   DO JK=1,KFLEV
2284     ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
2285   END DO
2286   ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
2287   ZZDTLW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:)   &
2288        ,FIELD=ZWORK4(:,:) ) )
2289   !
2290   ZWORK2(:) = PACK( TRANSPOSE(ZDTSW(:,:)),MASK=.TRUE. )
2291   DO JK=1,KFLEV
2292     ZWORK4(JK,:) = ZWORK2(ICLOUD+JK)
2293   END DO
2294   ZWORK1(1:ICLOUD) = ZWORK2(1:ICLOUD)
2295   ZZDTSW(:,:) = TRANSPOSE( UNPACK( ZWORK1(:),MASK=GCLOUDT(:,:)   &
2296        ,FIELD=ZWORK4(:,:) ) )
2297   !
2298   DEALLOCATE(ZWORK1)
2299   DEALLOCATE(ZWORK2)
2300   DEALLOCATE(ZWORK4)
2301   !
2302   ZZTGVISC   = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,5)
2303   !
2304   ZZTGVIS(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,5),MASK=.NOT.GCLEAR_2D(:), &
2305        FIELD=ZZTGVISC  )
2306   ZZTGNIRC   = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,6)
2307   !
2308   ZZTGNIR(:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,6),MASK=.NOT.GCLEAR_2D(:), &
2309        FIELD=ZZTGNIRC )
2310   ZZTGIRC    = ZFLUX_TOP_GND_IRVISNIR(ICLOUD_COL+1,4)
2311   !
2312   ZZTGIR (:) = UNPACK( ZFLUX_TOP_GND_IRVISNIR(:,4),MASK=.NOT.GCLEAR_2D(:), &
2313        FIELD=ZZTGIRC  )
2314   !
2315   DO JSWB=1,ISWB
2316     ZZSFSWDIRC(JSWB) = ZSFSWDIR (ICLOUD_COL+1,JSWB)
2317     !
2318     ZZSFSWDIR(:,JSWB) =  UNPACK(ZSFSWDIR (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
2319          FIELD= ZZSFSWDIRC(JSWB)  ) 
2320     !
2321     ZZSFSWDIFC(JSWB) = ZSFSWDIF (ICLOUD_COL+1,JSWB)
2322     !
2323     ZZSFSWDIF(:,JSWB) =  UNPACK(ZSFSWDIF (:,JSWB),MASK=.NOT.GCLEAR_2D(:), &
2324          FIELD= ZZSFSWDIFC(JSWB)  )
2325   END DO
2326 !
2327 !  No cloud case
2328 !
2329   IF( GNOCL ) THEN
2330           IF (SIZE(ZZDTLW,1)>1) THEN
2331              ZZDTLW(1,:)= ZZDTLW(2,:)
2332           ENDIF
2333           IF (SIZE(ZZDTSW,1)>1) THEN
2334              ZZDTSW(1,:)= ZZDTSW(2,:)
2335           ENDIF
2336     ZZTGVIS(1) = ZZTGVISC
2337     ZZTGNIR(1) = ZZTGNIRC
2338     ZZTGIR(1)  = ZZTGIRC
2339     ZZSFSWDIR(1,:) =  ZZSFSWDIRC(:)
2340     ZZSFSWDIF(1,:) =  ZZSFSWDIFC(:)
2341   END IF
2342 ELSE
2343   ZZDTLW(:,:) = ZDTLW(:,:)
2344   ZZDTSW(:,:) = ZDTSW(:,:)
2345   ZZTGVIS(:)  = ZFLUX_TOP_GND_IRVISNIR(:,5)
2346   ZZTGNIR(:)  = ZFLUX_TOP_GND_IRVISNIR(:,6)
2347   ZZTGIR(:)   = ZFLUX_TOP_GND_IRVISNIR(:,4)
2348   ZZSFSWDIR(:,:) =  ZSFSWDIR(:,:)
2349   ZZSFSWDIF(:,:) =  ZSFSWDIF(:,:) 
2350 END IF
2351 !
2352 DEALLOCATE(ZDTLW)
2353 DEALLOCATE(ZDTSW)
2354 DEALLOCATE(ZSFSWDIR)
2355 DEALLOCATE(ZSFSWDIF)
2356 !
2357 !-------------------------------------------------------------------------------
2358 !
2359 !*       6.    COMPUTES THE RADIATIVE SOURCES AND THE DOWNWARD SURFACE FLUXES
2360 !              --------------------------------------------------------------
2361 !
2362 !  Computes the SW and LW radiative tendencies
2363 !  note : tendencies in K/s for MNH   
2364 !
2365 ZDTRAD_LW(:,:,:)=0.0
2366 ZDTRAD_SW(:,:,:)=0.0
2367 DO JK=IKB,IKE
2368   JKRAD= JK-JPVEXT
2369   DO JJ=IJB,IJE
2370     DO JI=IIB,IIE
2371       IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2372       ZDTRAD_LW(JI,JJ,JK) = ZZDTLW(IIJ,JKRAD)/XDAY
2373       ZDTRAD_SW(JI,JJ,JK) = ZZDTSW(IIJ,JKRAD)/XDAY      
2374     END DO
2375   END DO
2376 END DO
2377 !
2378 !  Computes the downward SW and LW surface fluxes + diffuse and direct contribution
2379 !
2380 ZLWD(:,:)=0.
2381 ZSWDDIR(:,:,:)=0.
2382 ZSWDDIF(:,:,:)=0.
2383 !
2384 DO JJ=IJB,IJE
2385   DO JI=IIB,IIE
2386     IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2387     ZLWD(JI,JJ) = ZZTGIR(IIJ)
2388     ZSWDDIR(JI,JJ,:) = ZZSFSWDIR (IIJ,:)
2389     ZSWDDIF(JI,JJ,:) = ZZSFSWDIF (IIJ,:)
2390   END DO
2391 END DO
2392 !
2393 !final  THETA_radiative tendency and surface fluxes 
2394 !
2395 IF(OCLOUD_ONLY) THEN
2396   !
2397   ZWORKL(:,:) = SUM(PCLDFR(:,:,:),DIM=3) > 0.0
2398   DO JK = IKB,IKE
2399     WHERE( ZWORKL(:,:) )
2400       PDTHRAD(:,:,JK) = (ZDTRAD_LW(:,:,JK)+ZDTRAD_SW(:,:,JK))/ZEXNT(:,:,JK)
2401     ENDWHERE
2402   END DO
2403   !
2404   WHERE( ZWORKL(:,:) )
2405     PSRFLWD(:,:) = ZLWD(:,:)
2406   ENDWHERE
2407   DO JSWB=1,ISWB
2408     WHERE( ZWORKL(:,:) )
2409       PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
2410       PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
2411     END WHERE
2412   END DO
2413 ELSE
2414   PDTHRAD(:,:,:) = (ZDTRAD_LW(:,:,:)+ZDTRAD_SW(:,:,:))/ZEXNT(:,:,:)
2415   PDTHRADSW(:,:,:) = ZDTRAD_SW(:,:,:)/ZEXNT(:,:,:)
2416   PDTHRADLW(:,:,:) = ZDTRAD_LW(:,:,:)/ZEXNT(:,:,:)
2417   PSRFLWD(:,:) = ZLWD(:,:)
2418   DO JSWB=1,ISWB
2419     PSRFSWD_DIR (:,:,JSWB) = ZSWDDIR(:,:,JSWB)
2420     PSRFSWD_DIF (:,:,JSWB) = ZSWDDIF(:,:,JSWB)
2421   END DO
2422 !
2423 !sw and lw fluxes 
2424 !
2425   DO JK=IKB,IKE
2426    JKRAD = JK - JPVEXT
2427    DO JJ=IJB,IJE
2428     DO JI=IIB,IIE
2429           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2430           PSWU(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
2431           PSWD(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
2432           PLWU(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
2433           PLWD(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
2434     END DO
2435    END DO
2436   END DO
2437 !!!effective radius
2438   DO JK=IKB,IKE
2439    JKRAD = JK - JPVEXT
2440    DO JJ=IJB,IJE
2441     DO JI=IIB,IIE
2442           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2443           PRADEFF(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
2444     END DO
2445    END DO
2446   END DO
2447 END IF
2448 !
2449 !
2450 !-------------------------------------------------------------------------------
2451 !
2452 !*       7.    STORE SOME ADDITIONNAL RADIATIVE FIELDS
2453 !              ---------------------------------------
2454 !
2455 IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
2456   ZSTORE_3D(:,:,:) = 0.0
2457   ZSTORE_3D2(:,:,:) = 0.0
2458   ZSTORE_2D(:,:)   = 0.0
2459   !
2460   IF( KRAD_DIAG >= 1) THEN
2461     !
2462     CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
2463     WRITE(UNIT=ILUOUT,FMT='(/," STORE ADDITIONNAL RADIATIVE FIELDS:", &
2464          & " KRAD_DIAG=",I1,/)') KRAD_DIAG
2465     DO JK=IKB,IKE
2466       JKRAD = JK - JPVEXT
2467       DO JJ=IJB,IJE
2468         DO JI=IIB,IIE
2469           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2470           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN(IIJ,JKRAD)
2471         END DO
2472       END DO
2473     END DO
2474     YDIR='XY'
2475     YRECFM   = 'SWF_DOWN'
2476     YCOMMENT = 'X_Y_Z_SWF_DOWN (W/M2)'
2477     IGRID    = 1
2478     ILENCH   = LEN(YCOMMENT)
2479     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2480 !
2481     DO JK=IKB,IKE
2482       JKRAD = JK - JPVEXT
2483       DO JJ=IJB,IJE
2484         DO JI=IIB,IIE
2485           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2486           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP(IIJ,JKRAD)
2487         END DO
2488       END DO
2489     END DO
2490     YRECFM   = 'SWF_UP'
2491     YCOMMENT = 'X_Y_Z_SWF_UP (W/M2)'
2492     IGRID    = 1
2493     ILENCH   = LEN(YCOMMENT)
2494     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2495 !
2496     DO JK=IKB,IKE
2497       JKRAD = JK - JPVEXT
2498       DO JJ=IJB,IJE
2499         DO JI=IIB,IIE
2500           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2501           ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW(IIJ,2,JKRAD)
2502         END DO
2503       END DO
2504     END DO
2505     YRECFM   = 'LWF_DOWN'
2506     YCOMMENT = 'X_Y_Z_LWF_DOWN (W/M2)'
2507     IGRID    = 1
2508     ILENCH   = LEN(YCOMMENT)
2509     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2510 !
2511     DO JK=IKB,IKE
2512       JKRAD = JK - JPVEXT
2513       DO JJ=IJB,IJE
2514         DO JI=IIB,IIE
2515           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2516           ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW(IIJ,1,JKRAD)
2517         END DO
2518       END DO
2519     END DO
2520     YRECFM   = 'LWF_UP'
2521     YCOMMENT = 'X_Y_Z_LWF_UP (W/M2)'
2522     IGRID    = 1
2523     ILENCH   = LEN(YCOMMENT)
2524     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2525 !
2526     DO JK=IKB,IKE
2527       JKRAD = JK - JPVEXT
2528       DO JJ=IJB,IJE
2529         DO JI=IIB,IIE
2530           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2531           ZSTORE_3D(JI,JJ,JK) = ZNFLW(IIJ,JKRAD)
2532         END DO
2533       END DO
2534     END DO
2535     YRECFM   = 'LWF_NET'
2536     YCOMMENT = 'X_Y_Z_LWF_NET (W/M2)'
2537     IGRID    = 1
2538     ILENCH   = LEN(YCOMMENT)
2539     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2540 !
2541     DO JK=IKB,IKE
2542       JKRAD = JK - JPVEXT
2543       DO JJ=IJB,IJE
2544         DO JI=IIB,IIE
2545           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2546           ZSTORE_3D(JI,JJ,JK) = ZNFSW(IIJ,JKRAD)
2547         END DO
2548       END DO
2549     END DO
2550     YRECFM   = 'SWF_NET'
2551     YCOMMENT = 'X_Y_Z_SWF_NET (W/M2)'
2552     IGRID    = 1
2553     ILENCH   = LEN(YCOMMENT)
2554     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2555 !
2556     DO JK=IKB,IKE
2557       DO JJ=IJB,IJE
2558         DO JI=IIB,IIE
2559           ZSTORE_3D(JI,JJ,JK) = ZDTRAD_LW (JI,JJ,JK)*XDAY
2560         END DO
2561       END DO
2562     END DO
2563     YRECFM   = 'DTRAD_LW'
2564     YCOMMENT = 'X_Y_Z_DTRAD_LW (K/DAY)'
2565     IGRID    = 1
2566     ILENCH   = LEN(YCOMMENT)
2567     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2568 !
2569     DO JK=IKB,IKE
2570       DO JJ=IJB,IJE
2571         DO JI=IIB,IIE
2572           ZSTORE_3D(JI,JJ,JK) = ZDTRAD_SW (JI,JJ,JK)*XDAY
2573         END DO
2574       END DO
2575     END DO
2576     YRECFM   = 'DTRAD_SW'
2577     YCOMMENT = 'X_Y_Z_DTRAD_SW (K/DAY)'
2578     IGRID    = 1
2579     ILENCH   = LEN(YCOMMENT)
2580     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2581 !
2582     DO JJ=IJB,IJE
2583       DO JI=IIB,IIE
2584         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2585         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,5)
2586       END DO
2587     END DO
2588     YRECFM   = 'RADSWD_VIS'
2589     YCOMMENT = 'X_Y_RADSWD_VIS'
2590     IGRID    = 1
2591     ILENCH   = LEN(YCOMMENT)
2592     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2593 !
2594     DO JJ=IJB,IJE
2595       DO JI=IIB,IIE
2596         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2597         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,6)
2598       END DO
2599     END DO
2600     YRECFM   = 'RADSWD_NIR'
2601     YCOMMENT = 'X_Y_Z_RADSWD_NIR'
2602     IGRID    = 1
2603     ILENCH   = LEN(YCOMMENT)
2604     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2605     !
2606     DO JJ=IJB,IJE
2607       DO JI=IIB,IIE
2608         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2609         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR(IIJ,4)
2610       END DO
2611     END DO
2612     YRECFM   = 'RADLWD'
2613     YCOMMENT = 'X_Y_RADLWD'
2614     IGRID    = 1
2615     ILENCH   = LEN(YCOMMENT)
2616     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2617   END IF
2618   !
2619   !
2620   IF( KRAD_DIAG >= 2) THEN
2621     DO JK=IKB,IKE
2622       JKRAD = JK - JPVEXT
2623       DO JJ=IJB,IJE
2624         DO JI=IIB,IIE
2625           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2626           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_DOWN_CS(IIJ,JKRAD)
2627         END DO
2628       END DO
2629     END DO
2630     YDIR='XY'
2631     YRECFM   = 'SWF_DOWN_CS'
2632     YCOMMENT = 'X_Y_Z_SWF_DOWN_CS (W/M2)'
2633     IGRID    = 1
2634     ILENCH   = LEN(YCOMMENT)
2635     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2636     !
2637     DO JK=IKB,IKE
2638       JKRAD = JK - JPVEXT
2639       DO JJ=IJB,IJE
2640         DO JI=IIB,IIE
2641           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2642           ZSTORE_3D(JI,JJ,JK) = ZFLUX_SW_UP_CS(IIJ,JKRAD)
2643         END DO
2644       END DO
2645     END DO
2646     YRECFM   = 'SWF_UP_CS'
2647     YCOMMENT = 'X_Y_Z_SWF_UP_CS (W/M2)'
2648     IGRID    = 1
2649     ILENCH   = LEN(YCOMMENT)
2650     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2651     !
2652     DO JK=IKB,IKE
2653       JKRAD = JK - JPVEXT
2654       DO JJ=IJB,IJE
2655         DO JI=IIB,IIE
2656           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2657           ZSTORE_3D(JI,JJ,JK) = -ZFLUX_LW_CS(IIJ,2,JKRAD)
2658         END DO
2659       END DO
2660     END DO
2661     YRECFM   = 'LWF_DOWN_CS'
2662     YCOMMENT = 'X_Y_Z_LWF_DOWN (W/M2)'
2663     IGRID    = 1
2664     ILENCH   = LEN(YCOMMENT)
2665     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2666     !
2667     DO JK=IKB,IKE
2668       JKRAD = JK - JPVEXT
2669       DO JJ=IJB,IJE
2670         DO JI=IIB,IIE
2671           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2672           ZSTORE_3D(JI,JJ,JK) = ZFLUX_LW_CS(IIJ,1,JKRAD)
2673         END DO
2674       END DO
2675     END DO
2676     YRECFM   = 'LWF_UP_CS'
2677     YCOMMENT = 'X_Y_Z_LWF_UP_CS (W/M2)'
2678     IGRID    = 1
2679     ILENCH   = LEN(YCOMMENT)
2680     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2681     !
2682     DO JK=IKB,IKE
2683       JKRAD = JK - JPVEXT
2684       DO JJ=IJB,IJE
2685         DO JI=IIB,IIE
2686           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2687           ZSTORE_3D(JI,JJ,JK) = ZNFLW_CS(IIJ,JKRAD)
2688         END DO
2689       END DO
2690     END DO
2691     YRECFM   = 'LWF_NET_CS'
2692     YCOMMENT = 'X_Y_Z_SWF_NET_CS (W/M2)'
2693     IGRID    = 1
2694     ILENCH   = LEN(YCOMMENT)
2695     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2696     !
2697     DO JK=IKB,IKE
2698       JKRAD = JK - JPVEXT
2699       DO JJ=IJB,IJE
2700         DO JI=IIB,IIE
2701           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2702           ZSTORE_3D(JI,JJ,JK) = ZNFSW_CS(IIJ,JKRAD)
2703         END DO
2704       END DO
2705     END DO
2706     YRECFM   = 'SWF_NET_CS'
2707     YCOMMENT = 'X_Y_Z_SWF_NET_CS (W/M2)'
2708     IGRID    = 1
2709     ILENCH   = LEN(YCOMMENT)
2710     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2711     !
2712     DO JK=IKB,IKE
2713       JKRAD = JK-JPVEXT
2714       DO JJ=IJB,IJE
2715         DO JI=IIB,IIE
2716           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2717           ZSTORE_3D(JI,JJ,JK) = ZDTSW_CS(IIJ,JKRAD) 
2718         END DO
2719       END DO
2720     END DO
2721     YRECFM   = 'DTRAD_SW_CS'
2722     YCOMMENT = 'X_Y_Z_DTRAD_SW_CS (K/DAY)'
2723     IGRID    = 1
2724     ILENCH   = LEN(YCOMMENT)
2725     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2726     !
2727     DO JK=IKB,IKE
2728       JKRAD = JK-JPVEXT
2729       DO JJ=IJB,IJE
2730         DO JI=IIB,IIE
2731           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2732           ZSTORE_3D(JI,JJ,JK) = ZDTLW_CS(IIJ,JKRAD) 
2733         END DO
2734       END DO
2735     END DO
2736     YRECFM   = 'DTRAD_LW_CS'
2737     YCOMMENT = 'X_Y_Z_DTRAD_LW_CS (K/DAY)'
2738     IGRID    = 1
2739     ILENCH   = LEN(YCOMMENT)
2740     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2741     !
2742     DO JJ=IJB,IJE
2743       DO JI=IIB,IIE
2744         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2745         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,5)
2746       END DO
2747     END DO
2748     YRECFM   = 'RADSWD_VIS_CS'
2749     YCOMMENT = 'X_Y_RADSWD_VIS_CS'
2750     IGRID    = 1
2751     ILENCH   = LEN(YCOMMENT)
2752     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2753     !
2754     DO JJ=IJB,IJE
2755       DO JI=IIB,IIE
2756         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2757         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,6)
2758       END DO
2759     END DO
2760     YRECFM   = 'RADSWD_NIR_CS'
2761     YCOMMENT = 'X_Y_RADSWD_NIR_CS'
2762     IGRID    = 1
2763     ILENCH   = LEN(YCOMMENT)
2764     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2765     !
2766     DO JJ=IJB,IJE
2767       DO JI=IIB,IIE
2768         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2769         ZSTORE_2D(JI,JJ) = ZFLUX_TOP_GND_IRVISNIR_CS(IIJ,4)
2770       END DO
2771     END DO
2772     YRECFM   = 'RADLWD_CS'
2773     YCOMMENT = 'X_Y_RADLWD_CS'
2774     IGRID    = 1
2775     ILENCH   = LEN(YCOMMENT)
2776     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2777   END IF
2778   !
2779   !
2780   IF( KRAD_DIAG >= 3) THEN
2781     DO JJ=IJB,IJE
2782       DO JI=IIB,IIE
2783         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2784         ZSTORE_2D(JI,JJ) = ZPLAN_ALB_VIS(IIJ)
2785       END DO
2786     END DO
2787     YRECFM   = 'PLAN_ALB_VIS'
2788     YCOMMENT = 'X_Y_PLAN_ALB_VIS'
2789     IGRID    = 1
2790     ILENCH   = LEN(YCOMMENT)
2791     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2792     !
2793     DO JJ=IJB,IJE
2794       DO JI=IIB,IIE
2795         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2796         ZSTORE_2D(JI,JJ) = ZPLAN_ALB_NIR(IIJ)
2797       END DO
2798     END DO
2799     YRECFM   = 'PLAN_ALB_NIR'
2800     YCOMMENT = 'X_Y_PLAN_ALB_NIR'
2801     IGRID    = 1
2802     ILENCH   = LEN(YCOMMENT)
2803     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2804     !
2805     DO JJ=IJB,IJE
2806       DO JI=IIB,IIE
2807         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2808         ZSTORE_2D(JI,JJ) = ZPLAN_TRA_VIS(IIJ)
2809       END DO
2810     END DO
2811     YRECFM   = 'PLAN_TRA_VIS'
2812     YCOMMENT = 'X_Y_PLAN_TRA_VIS'
2813     IGRID    = 1
2814     ILENCH   = LEN(YCOMMENT)
2815     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2816     !
2817     DO JJ=IJB,IJE
2818       DO JI=IIB,IIE
2819         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2820         ZSTORE_2D(JI,JJ) = ZPLAN_TRA_NIR(IIJ)
2821       END DO
2822     END DO
2823     YRECFM   = 'PLAN_TRA_NIR'
2824     YCOMMENT = 'X_Y_PLAN_TRA_NIR'
2825     IGRID    = 1
2826     ILENCH   = LEN(YCOMMENT)
2827     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2828     !
2829     DO JJ=IJB,IJE
2830       DO JI=IIB,IIE
2831         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2832         ZSTORE_2D(JI,JJ) = ZPLAN_ABS_VIS(IIJ)
2833       END DO
2834     END DO
2835     YRECFM   = 'PLAN_ABS_VIS'
2836     YCOMMENT = 'X_Y_PLAN_ABS_VIS'
2837     IGRID    = 1
2838     ILENCH   = LEN(YCOMMENT)
2839     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2840     !
2841     DO JJ=IJB,IJE
2842       DO JI=IIB,IIE
2843         IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2844         ZSTORE_2D(JI,JJ) = ZPLAN_ABS_NIR(IIJ)
2845       END DO
2846     END DO
2847     YRECFM   = 'PLAN_ABS_NIR'
2848     YCOMMENT = 'X_Y_PLAN_ABS_NIR'
2849     IGRID    = 1
2850     ILENCH   = LEN(YCOMMENT)
2851     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_2D,IGRID,ILENCH,YCOMMENT,IRESP)
2852     !
2853     !
2854   END IF
2855 !
2856 !
2857   IF( KRAD_DIAG >= 4) THEN
2858     DO JK=IKB,IKE
2859       JKRAD = JK - JPVEXT
2860       DO JJ=IJB,IJE
2861         DO JI=IIB,IIE
2862           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2863           ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWD(IIJ,JKRAD)
2864         END DO
2865       END DO
2866     END DO
2867     YRECFM   = 'EFNEB_DOWN'
2868     YCOMMENT = 'X_Y_Z_EFNEB_DOWN'
2869     IGRID    = 1
2870     ILENCH   = LEN(YCOMMENT)
2871     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2872     !
2873     DO JK=IKB,IKE
2874       JKRAD = JK - JPVEXT
2875       DO JJ=IJB,IJE
2876         DO JI=IIB,IIE
2877           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2878           ZSTORE_3D(JI,JJ,JK) = ZEFCL_LWU(IIJ,JKRAD)
2879         END DO
2880       END DO
2881     END DO
2882     YRECFM   = 'EFNEB_UP'
2883     YCOMMENT = 'X_Y_Z_EFNEB_UP'
2884     IGRID    = 1
2885     ILENCH   = LEN(YCOMMENT)
2886     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2887     !
2888     DO JK=IKB,IKE
2889       JKRAD = JK - JPVEXT
2890       DO JJ=IJB,IJE
2891         DO JI=IIB,IIE
2892           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2893           ZSTORE_3D(JI,JJ,JK) = ZFLWP(IIJ,JKRAD)
2894         END DO
2895       END DO
2896     END DO
2897     YRECFM   = 'FLWP'
2898     YCOMMENT = 'X_Y_Z_FLWP'
2899     IGRID    = 1
2900     ILENCH   = LEN(YCOMMENT)
2901     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2902     !
2903     DO JK=IKB,IKE
2904       JKRAD = JK - JPVEXT
2905       DO JJ=IJB,IJE
2906         DO JI=IIB,IIE
2907           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2908           ZSTORE_3D(JI,JJ,JK) = ZFIWP(IIJ,JKRAD)
2909         END DO
2910       END DO
2911     END DO
2912     YRECFM   = 'FIWP'
2913     YCOMMENT = 'X_Y_Z_FIWP'
2914     IGRID    = 1
2915     ILENCH   = LEN(YCOMMENT)
2916     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2917   !
2918     DO JK=IKB,IKE
2919       JKRAD = JK - JPVEXT
2920       DO JJ=IJB,IJE
2921         DO JI=IIB,IIE
2922           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2923           ZSTORE_3D(JI,JJ,JK) = ZRADLP(IIJ,JKRAD)
2924         END DO
2925       END DO
2926     END DO
2927     YRECFM   = 'EFRADL'
2928     YCOMMENT = 'X_Y_Z_RAD_microm'
2929     IGRID    = 1
2930     ILENCH   = LEN(YCOMMENT)
2931     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2932  
2933     DO JK=IKB,IKE
2934       JKRAD = JK - JPVEXT
2935       DO JJ=IJB,IJE
2936         DO JI=IIB,IIE
2937           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2938           ZSTORE_3D(JI,JJ,JK) = ZRADIP(IIJ,JKRAD)
2939         END DO
2940       END DO
2941     END DO
2942     YRECFM   = 'EFRADI'
2943     YCOMMENT = 'X_Y_Z_RAD_microm'
2944     IGRID    = 1
2945     ILENCH   = LEN(YCOMMENT)
2946     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2947  !
2948     DO JK=IKB,IKE
2949       JKRAD = JK - JPVEXT
2950       DO JJ=IJB,IJE
2951         DO JI=IIB,IIE
2952           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2953           ZSTORE_3D(JI,JJ,JK) = ZCLSW_TOTAL(IIJ,JKRAD)
2954         END DO
2955       END DO
2956     END DO
2957     YRECFM   = 'SW_NEB'
2958     YCOMMENT = 'X_Y_Z_SW_NEB'
2959     IGRID    = 1
2960     ILENCH   = LEN(YCOMMENT)
2961     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2962     !
2963     DO JK=IKB,IKE
2964       JKRAD = JK - JPVEXT
2965       DO JJ=IJB,IJE
2966         DO JI=IIB,IIE
2967           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
2968           ZSTORE_3D(JI,JJ,JK) = ZEFCL_RRTM(IIJ,JKRAD)
2969         END DO
2970       END DO
2971     END DO
2972     YRECFM   = 'RRTM_LW_NEB'
2973     YCOMMENT = 'X_Y_Z_LW_NEB'
2974     IGRID    = 1
2975     ILENCH   = LEN(YCOMMENT)
2976     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
2977     !
2978     ! spectral bands
2979     IF (KSWB==6) THEN
2980       INIR = 4
2981     ELSE
2982       INIR = 2
2983     END IF
2984
2985     DO JBAND=1,INIR-1
2986       WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'VIS', JBAND
2987     END DO
2988     DO JBAND= INIR, KSWB
2989       WRITE(YBAND_NAME(JBAND),'(A3,I1)') 'NIR', JBAND
2990     END DO
2991 !
2992     DO JBAND=1,KSWB
2993       YRECFM   = 'ODAER_'//YBAND_NAME(JBAND)
2994       YCOMMENT = 'X_Y_Z_OD_'//YBAND_NAME(JBAND)
2995       IGRID    = 1
2996       ILENCH   = LEN(YCOMMENT)
2997       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZTAUAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
2998       YRECFM   = 'SSAAER_'//YBAND_NAME(JBAND)
2999       YCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
3000       IGRID    = 1
3001       ILENCH   = LEN(YCOMMENT)
3002       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZPIZAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
3003       YRECFM   = 'GAER_'//YBAND_NAME(JBAND)
3004       YCOMMENT = 'X_Y_Z_G_'//YBAND_NAME(JBAND)
3005       IGRID    = 1
3006       ILENCH   = LEN(YCOMMENT)
3007       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZCGAZ(:,:,:,JBAND),IGRID,ILENCH,YCOMMENT,IRESP)
3008     ENDDO
3009
3010     DO JBAND=1,KSWB
3011       DO JK=IKB,IKE
3012         JKRAD = JK - JPVEXT
3013         DO JJ=IJB,IJE
3014           DO JI=IIB,IIE
3015             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3016             ZSTORE_3D(JI,JJ,JK) = ZTAU_TOTAL(IIJ,JBAND,JKRAD)
3017           END DO
3018         END DO
3019       END DO
3020       YRECFM   = 'OTH_'//YBAND_NAME(JBAND)
3021       YCOMMENT = 'X_Y_Z_OTH_'//YBAND_NAME(JBAND)
3022       IGRID    = 1
3023       ILENCH   = LEN(YCOMMENT)
3024       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3025       !
3026       DO JK=IKB,IKE
3027         JKRAD = JK - JPVEXT
3028         DO JJ=IJB,IJE
3029           DO JI=IIB,IIE
3030             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3031             ZSTORE_3D(JI,JJ,JK) = ZOMEGA_TOTAL(IIJ,JBAND,JKRAD)
3032           END DO
3033         END DO
3034       END DO
3035       YRECFM   = 'SSA_'//YBAND_NAME(JBAND)
3036       YCOMMENT = 'X_Y_Z_SSA_'//YBAND_NAME(JBAND)
3037       IGRID    = 1
3038       ILENCH   = LEN(YCOMMENT)
3039       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3040       !
3041       DO JK=IKB,IKE
3042         JKRAD = JK - JPVEXT
3043         DO JJ=IJB,IJE
3044           DO JI=IIB,IIE
3045             IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3046             ZSTORE_3D(JI,JJ,JK) = ZCG_TOTAL(IIJ,JBAND,JKRAD)
3047           END DO
3048         END DO
3049       END DO
3050       YRECFM   = 'ASF_'//YBAND_NAME(JBAND)
3051       YCOMMENT = 'X_Y_Z_ASF_'//YBAND_NAME(JBAND)
3052       IGRID    = 1
3053       ILENCH   = LEN(YCOMMENT)
3054       CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3055     END DO
3056   END IF
3057   !
3058   !
3059   IF (KRAD_DIAG >= 5)   THEN
3060 !
3061 ! OZONE and AER optical thickness climato  entering the ecmwf_radiation_vers2
3062 ! note the vertical grid is re-inversed for graphic !   
3063     DO JK=IKB,IKE
3064       JKRAD = KFLEV+1 - JK + JPVEXT               
3065       DO JJ=IJB,IJE
3066         DO JI=IIB,IIE 
3067           IIJ = 1 + (JI-IIB) + (IIE-IIB+1)*(JJ-IJB)
3068           ZSTORE_3D(JI,JJ,JK) = ZO3AVE(IIJ, JKRAD)
3069         END DO
3070       END DO
3071     END DO
3072     YDIR='XY'
3073     YRECFM   = 'O3CLIM'
3074     YCOMMENT = 'X_Y_Z_O3 Pa/Pa'
3075     IGRID    = 1
3076     ILENCH   = LEN(YCOMMENT)
3077     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D,IGRID,ILENCH,YCOMMENT,IRESP)
3078
3079 !cumulated optical thickness of aerosols
3080 !cumul begin from the top of the domain, not from the TOA !      
3081 !
3082 !land 
3083     DO JK=IKB,IKE
3084       JKRAD = JK - JPVEXT
3085       DO JJ=IJB,IJE
3086         DO JI=IIB,IIE
3087           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,1)
3088         END DO
3089       END DO
3090     END DO
3091 !
3092     ZSTORE_2D (:,:) = 0.
3093     DO JK=IKB,IKE
3094       JK1=IKE-JK+IKB 
3095       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3096       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3097     END DO
3098     YDIR='XY'
3099     YRECFM   = 'CUM_AER_LAND'
3100     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3101     IGRID    = 1
3102     ILENCH   = LEN(YCOMMENT)
3103     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3104 !
3105 ! sea
3106     DO JK=IKB,IKE
3107       JKRAD = JK - JPVEXT
3108       DO JJ=IJB,IJE
3109         DO JI=IIB,IIE
3110           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,2)
3111         END DO
3112       END DO
3113     END DO
3114 !sum
3115     ZSTORE_2D (:,:) = 0.
3116     DO JK=IKB,IKE
3117       JK1=IKE-JK+IKB 
3118       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3119       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3120     END DO
3121 !
3122     YDIR='XY'
3123     YRECFM   = 'CUM_AER_SEA'
3124     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3125     IGRID    = 1
3126     ILENCH   = LEN(YCOMMENT)
3127     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3128 !
3129 ! desert
3130     DO JK=IKB,IKE
3131       JKRAD = JK - JPVEXT
3132       DO JJ=IJB,IJE
3133         DO JI=IIB,IIE
3134           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,3)
3135         END DO
3136       END DO
3137     END DO
3138 !sum     
3139     ZSTORE_2D (:,:) = 0.
3140     DO JK=IKB,IKE
3141       JK1=IKE-JK+IKB 
3142       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3143       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3144     END DO
3145 !    
3146     YDIR='XY'
3147     YRECFM   = 'CUM_AER_DES'
3148     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3149     IGRID    = 1
3150     ILENCH   = LEN(YCOMMENT)
3151     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3152 !
3153 ! urban
3154     DO JK=IKB,IKE
3155       JKRAD = JK - JPVEXT
3156       DO JJ=IJB,IJE
3157         DO JI=IIB,IIE
3158           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,4)
3159         END DO
3160       END DO
3161     END DO
3162 !sum      
3163     ZSTORE_2D (:,:) = 0.
3164     DO JK=IKB,IKE
3165       JK1=IKE-JK+IKB 
3166       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3167       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3168     END DO
3169 !
3170     YDIR='XY'
3171     YRECFM   = 'CUM_AER_URB'
3172     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3173     IGRID    = 1
3174     ILENCH   = LEN(YCOMMENT)
3175     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3176 !
3177 ! Volcanoes
3178     DO JK=IKB,IKE
3179       JKRAD = JK - JPVEXT
3180       DO JJ=IJB,IJE
3181         DO JI=IIB,IIE
3182           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,5)
3183         END DO
3184       END DO
3185     END DO
3186 !sum         
3187     ZSTORE_2D (:,:) = 0.
3188     DO JK=IKB,IKE
3189       JK1=IKE-JK+IKB 
3190       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3191       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3192     END DO
3193 !
3194     YDIR='XY'
3195     YRECFM   = 'CUM_AER_VOL'
3196     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3197     IGRID    = 1
3198     ILENCH   = LEN(YCOMMENT)
3199     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3200 !
3201 ! stratospheric background
3202     DO JK=IKB,IKE
3203       JKRAD = JK - JPVEXT
3204       DO JJ=IJB,IJE
3205         DO JI=IIB,IIE
3206           ZSTORE_3D(JI,JJ,JK) = PAER(JI,JJ,JKRAD,6)
3207         END DO
3208       END DO
3209     END DO
3210 !sum      
3211     ZSTORE_2D (:,:) = 0.
3212     DO JK=IKB,IKE
3213       JK1=IKE-JK+IKB 
3214       ZSTORE_2D(:,:) = ZSTORE_2D(:,:) + ZSTORE_3D(:,:,JK1)
3215       ZSTORE_3D2(:,:,JK1) = ZSTORE_2D(:,:)  
3216     END DO
3217 !
3218     YDIR='XY'
3219     YRECFM   = 'CUM_AER_STRB'
3220     YCOMMENT = 'X_Y_Z_CUM_AER_OPT' 
3221     IGRID    = 1
3222     ILENCH   = LEN(YCOMMENT)
3223     CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,YDIR,ZSTORE_3D2,IGRID,ILENCH,YCOMMENT,IRESP)
3224   ENDIF
3225 END IF
3226 !
3227
3228 DEALLOCATE(ZNFLW_CS)
3229 DEALLOCATE(ZNFLW)
3230 DEALLOCATE(ZNFSW_CS)
3231 DEALLOCATE(ZNFSW)
3232 DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR)
3233 DEALLOCATE(ZFLUX_SW_DOWN)
3234 DEALLOCATE(ZFLUX_SW_UP)
3235 DEALLOCATE(ZFLUX_LW)
3236 DEALLOCATE(ZDTLW_CS)
3237 DEALLOCATE(ZDTSW_CS)
3238 DEALLOCATE(ZFLUX_TOP_GND_IRVISNIR_CS)
3239 DEALLOCATE(ZPLAN_ALB_VIS)
3240 DEALLOCATE(ZPLAN_ALB_NIR)
3241 DEALLOCATE(ZPLAN_TRA_VIS)
3242 DEALLOCATE(ZPLAN_TRA_NIR)
3243 DEALLOCATE(ZPLAN_ABS_VIS)
3244 DEALLOCATE(ZPLAN_ABS_NIR)
3245 DEALLOCATE(ZEFCL_LWD)
3246 DEALLOCATE(ZEFCL_LWU)
3247 DEALLOCATE(ZFLWP)
3248 DEALLOCATE(ZFIWP)
3249 DEALLOCATE(ZRADLP)
3250 DEALLOCATE(ZRADIP)
3251 DEALLOCATE(ZEFCL_RRTM)
3252 DEALLOCATE(ZCLSW_TOTAL)
3253 DEALLOCATE(ZTAU_TOTAL)
3254 DEALLOCATE(ZOMEGA_TOTAL)
3255 DEALLOCATE(ZCG_TOTAL)
3256 DEALLOCATE(ZFLUX_SW_DOWN_CS)
3257 DEALLOCATE(ZFLUX_SW_UP_CS)
3258 DEALLOCATE(ZFLUX_LW_CS)
3259 DEALLOCATE(ZO3AVE)
3260 !
3261 !-------------------------------------------------------------------------------
3262 !
3263 END SUBROUTINE RADIATIONS
3264