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