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