Juan 2/05/2016 : bug in use of global/local bounds for call of BIKHARDT
[MNH-git_open_source-lfs.git] / src / MNH / spawn_surf2_rain.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 !--------------- special set of characters for RCS information
7 !-----------------------------------------------------------------
8 ! $Source$ $Revision$
9 ! MASDEV4_7 spawn 2007/03/22 18:43:45
10 !-----------------------------------------------------------------
11 !###########################
12 MODULE MODI_SPAWN_SURF2_RAIN
13 !###########################
14 !
15 INTERFACE
16 !
17       SUBROUTINE SPAWN_SURF2_RAIN (KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,    &
18                               PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D,           &
19                               PACPRR,PINPRS,PACPRS,                            &
20                               PINPRG,PACPRG,PINPRH,PACPRH,                     &
21                               HSONFILE,KIUSON,KJUSON,                          &
22                               KIB2,KJB2,KIE2,KJE2,                             &
23                               KIB1,KJB1,KIE1,KJE1                              )
24 !
25 !
26 IMPLICIT NONE
27 !
28 INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
29 INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
30 INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
31 INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
32 !
33 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRC,PACPRC   ! Precipitations
34 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRR,PACPRR   ! Precipitations
35 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D,PEVAP3D  ! Rain precipitation
36                                                        ! and evaporation fluxes
37 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRS,PACPRS   ! Precipitations
38 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRG,PACPRG   ! Precipitations
39 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRH,PACPRH   ! Precipitations
40 !
41            ! Arguments for spawning with 2 input files (father+son1)
42 CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
43 INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON    ! upper dimensions of the
44 INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON    !input FM-file SON
45 INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
46 INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
47 INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
48 INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
49 END SUBROUTINE SPAWN_SURF2_RAIN
50 !
51 END INTERFACE
52 !
53 END MODULE MODI_SPAWN_SURF2_RAIN
54 !
55 !
56 !     #########################################################################
57       SUBROUTINE SPAWN_SURF2_RAIN (KXOR,KYOR,KXEND,KYEND,KDXRATIO,KDYRATIO,    &
58                               PINPRC,PACPRC,PINPRR,PINPRR3D,PEVAP3D,           &
59                               PACPRR,PINPRS,PACPRS,                            &
60                               PINPRG,PACPRG,PINPRH,PACPRH,                     &
61                               HSONFILE,KIUSON,KJUSON,                          &
62                               KIB2,KJB2,KIE2,KJE2,                             &
63                               KIB1,KJB1,KIE1,KJE1                              )
64 !     #########################################################################
65 !
66 !!****  *SPAWN_SURF2_RAIN * - subroutine to interpolate surface precipitations
67 !
68 !!    PURPOSE
69 !!    -------
70 !!
71 !!      The surface precipitations are interpolated from the model 1, to 
72 !!    initialize the model 2.
73 !!
74 !!**  METHOD
75 !!    ------
76 !!
77 !!      The model 2 variables are transmitted by argument (P or K prefixes),
78 !!    while the ones of model 1 are declared through calls to MODD_... 
79 !!    (X or N prefixes)
80 !!
81 !!
82 !!    EXTERNAL
83 !!    --------
84 !!
85 !!      Routine BIKHARDT2     : to perform horizontal interpolations
86 !!
87 !! 
88 !!    IMPLICIT ARGUMENTS
89 !!    ------------------ 
90 !!
91 !!
92 !!    REFERENCE
93 !!    ---------
94 !!
95 !!       Book1 of the documentation
96 !!      
97 !!
98 !!    AUTHOR
99 !!    ------
100 !!
101 !!       P. Jabouille     * METEO-FRANCE *
102 !!
103 !!    MODIFICATIONS
104 !!    -------------
105 !!
106 !!      Original     19/07/04 after surface externalisation
107 !!      Modification 07/07/05 (D.Barbary) spawn with 2 input files (father+son1)
108 !!      Modification    20/05/06 Remove Clark and Farley interpolation
109 !!      Modification    2014 (M.Faivre)
110 !!      J.Escobar 2/05/2016 : bug in use of global/local bounds for call of BIKHARDT
111 !!-------------------------------------------------------------------------------
112 !
113 !*       0.     DECLARATIONS
114 !               ------------
115 USE MODD_LBC_n,   ONLY : LBC_MODEL
116 USE MODD_PRECIP_n,ONLY : PRECIP_MODEL
117 USE MODD_BIKHARDT_n
118 USE MODD_LUNIT_n, ONLY : CLUOUT
119 USE MODD_FIELD_n, ONLY : XTHT
120 USE MODD_CONF,    ONLY : CCONF,CPROGRAM
121 !
122 USE MODI_BIKHARDT         ! Interface modules
123 !
124 USE MODE_MODELN_HANDLER
125 !
126 USE MODI_READ_PRECIP_FIELD
127 !
128 !
129 IMPLICIT NONE
130 !
131 !
132 !*       0.1   Declarations of dummy arguments :
133 !
134
135 INTEGER,   INTENT(IN)  :: KXOR,KXEND !  horizontal position (i,j) of the ORigin and END  
136 INTEGER,   INTENT(IN)  :: KYOR,KYEND ! of the model 2 domain, relative to model 1
137 INTEGER,   INTENT(IN)  :: KDXRATIO   !  x and y-direction Resolution ratio
138 INTEGER,   INTENT(IN)  :: KDYRATIO   ! between model 2 and model 1
139 !
140 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRC,PACPRC   ! Precipitations
141 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRR,PACPRR   ! Precipitations
142 REAL, DIMENSION(:,:,:), INTENT(OUT) :: PINPRR3D,PEVAP3D  ! Rain precipitation
143                                                        ! and evaporation fluxes
144 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRS,PACPRS   ! Precipitations
145 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRG,PACPRG   ! Precipitations
146 REAL, DIMENSION(:,:),   INTENT(OUT) :: PINPRH,PACPRH   ! Precipitation!
147 ! Arguments for spawning with 2 input files (father+son1)
148 CHARACTER (LEN=*), OPTIONAL, INTENT(IN) :: HSONFILE  ! name of the input FM-file SON
149 INTEGER,           OPTIONAL, INTENT(IN) :: KIUSON    ! upper dimensions of the
150 INTEGER,           OPTIONAL, INTENT(IN) :: KJUSON    !input FM-file SON
151 INTEGER,           OPTIONAL, INTENT(IN) :: KIB2,KJB2 ! indexes for common
152 INTEGER,           OPTIONAL, INTENT(IN) :: KIE2,KJE2 !domain in model2
153 INTEGER,           OPTIONAL, INTENT(IN) :: KIB1,KJB1 !and in
154 INTEGER,           OPTIONAL, INTENT(IN) :: KIE1,KJE1 !SON
155 !
156 !*       0.2    Declarations of local variables for print on FM file
157 !
158 CHARACTER (LEN=2)   :: YMETHOD   ! Interpolation method ('BI', 'CF')
159 INTEGER             :: IMI
160 ! Variables for spawning with 2 input files (father+son1)
161 REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRC1, ZACPRC1,    &
162                                      ZINPRR1, ZACPRR1,    &
163                                      ZINPRS1, ZACPRS1,    &
164                                      ZINPRG1, ZACPRG1,    &
165                                      ZINPRH1, ZACPRH1
166                                          ! Instant and cumul of ground
167                                          ! precipitation fields of Rain,
168                                          !    Snow, Graupel and Hail
169                                          ! For SON1
170 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZINPRR3D1, ZEVAP3D1
171 CHARACTER (LEN=4):: YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT ! READ,INIT or SKIP variable
172 INTEGER             :: ILU                        ! vertical size of arrays
173 !
174 INTEGER             :: IDIMX,IDIMY
175 !-------------------------------------------------------------------------------
176 !
177 !*       1.    PROLOGUE:
178 !              ---------
179
180 IMI = GET_CURRENT_MODEL_INDEX()
181 ILU=SIZE(XTHT,3)
182 IF (IMI /= 2) CALL GOTO_MODEL(2)
183 !*       1.1   computes dimensions of arrays and other indices
184 !
185 !
186 !*       1.2   Interpolation method
187 !
188 YMETHOD='BI'
189 !
190 !-------------------------------------------------------------------------------
191 !
192 !*       3.    INITIALIZATION OF THE SURFACE VARIABLES OF MODEL 2:
193 !              --------------------------------------------------
194 !
195 IF (KDXRATIO == 1 .AND. KDYRATIO == 1 ) THEN
196 !
197 !*       3.1   special case of spawning - no change of resolution :
198 !
199   IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
200     PINPRC(:,:) = PRECIP_MODEL(1)%XINPRC(KXOR:KXEND,KYOR:KYEND)
201     PACPRC(:,:) = PRECIP_MODEL(1)%XACPRC(KXOR:KXEND,KYOR:KYEND)
202   END IF
203 !
204   IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
205     PINPRR(:,:) = PRECIP_MODEL(1)%XINPRR(KXOR:KXEND,KYOR:KYEND)
206     PINPRR3D(:,:,:) = PRECIP_MODEL(1)%XINPRR3D(KXOR:KXEND,KYOR:KYEND,:)
207     PEVAP3D(:,:,:) = PRECIP_MODEL(1)%XEVAP3D(KXOR:KXEND,KYOR:KYEND,:)
208     PACPRR(:,:) = PRECIP_MODEL(1)%XACPRR(KXOR:KXEND,KYOR:KYEND)
209   END IF
210 !
211   IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
212     PINPRS(:,:) = PRECIP_MODEL(1)%XINPRS(KXOR:KXEND,KYOR:KYEND)
213     PACPRS(:,:) = PRECIP_MODEL(1)%XACPRS(KXOR:KXEND,KYOR:KYEND)
214   END IF
215 !
216   IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
217     PINPRG(:,:) = PRECIP_MODEL(1)%XINPRG(KXOR:KXEND,KYOR:KYEND)
218     PACPRG(:,:) = PRECIP_MODEL(1)%XACPRG(KXOR:KXEND,KYOR:KYEND)
219   END IF
220 !
221   IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
222     PINPRH(:,:) = PRECIP_MODEL(1)%XINPRH(KXOR:KXEND,KYOR:KYEND)
223     PACPRH(:,:) = PRECIP_MODEL(1)%XACPRH(KXOR:KXEND,KYOR:KYEND)
224   END IF
225 !
226 !
227 !-------------------------------------------------------------------------------
228 !
229 ELSE
230 !
231 !*       3.2  general case - change of resolution :
232 !             -----------------------------------
233 !
234 !*       3.2.1   Bikhardt interpolation
235 !
236 !
237   IF ( YMETHOD == 'BI' ) THEN
238 !
239     IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
240       IDIMX = SIZE(PRECIP_MODEL(1)%XINPRC,1)
241       IDIMY = SIZE(PRECIP_MODEL(1)%XINPRC,2)
242       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
243                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
244                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
245                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRC,PINPRC)
246       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
247                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
248                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
249                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRC,PACPRC)
250      PINPRC(:,:)=MAX(0.,PINPRC(:,:))
251      PACPRC(:,:)=MAX(0.,PACPRC(:,:))
252     END IF
253 !
254     IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
255       IDIMX = SIZE(PRECIP_MODEL(1)%XINPRR,1)
256       IDIMY = SIZE(PRECIP_MODEL(1)%XINPRR,2)
257       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
258                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
259                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
260                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRR,PINPRR)
261       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
262                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
263                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
264                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRR3D,PINPRR3D)
265       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
266                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
267                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
268                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XEVAP3D,PEVAP3D)
269       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
270                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
271                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
272                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRR,PACPRR)
273      PINPRR(:,:)=MAX(0.,PINPRR(:,:))
274      PINPRR3D(:,:,:)=MAX(0.,PINPRR3D(:,:,:))
275      PEVAP3D(:,:,:)=MAX(0.,PEVAP3D(:,:,:))
276      PACPRR(:,:)=MAX(0.,PACPRR(:,:))
277     END IF
278 !
279     IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
280       IDIMX = SIZE(PRECIP_MODEL(1)%XINPRS,1)
281       IDIMY = SIZE(PRECIP_MODEL(1)%XINPRS,2)
282       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
283                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
284                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
285                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRS,PINPRS)
286       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
287                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
288                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
289                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRS,PACPRS)
290      PINPRS(:,:)=MAX(0.,PINPRS(:,:))
291      PACPRS(:,:)=MAX(0.,PACPRS(:,:))
292     END IF
293 !
294     IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
295       IDIMX = SIZE(PRECIP_MODEL(1)%XINPRG,1)
296       IDIMY = SIZE(PRECIP_MODEL(1)%XINPRG,2)
297       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
298                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
299                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
300                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRG,PINPRG)
301       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
302                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
303                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
304                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRG,PACPRG)
305      PINPRG(:,:)=MAX(0.,PINPRG(:,:))
306      PACPRG(:,:)=MAX(0.,PACPRG(:,:))
307     END IF
308 !
309     IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
310       IDIMX = SIZE(PRECIP_MODEL(1)%XINPRH,1)
311       IDIMY = SIZE(PRECIP_MODEL(1)%XINPRH,2)
312       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
313                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
314                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
315                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XINPRH,PINPRH)
316       CALL BIKHARDT(XBMX1,XBMX2,XBMX3,XBMX4,XBMY1,XBMY2,XBMY3,XBMY4, &
317                     XBFX1,XBFX2,XBFX3,XBFX4,XBFY1,XBFY2,XBFY3,XBFY4, &
318                     2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1,       &
319                     LBC_MODEL(1)%CLBCX,LBC_MODEL(1)%CLBCY,PRECIP_MODEL(1)%XACPRH,PACPRH)
320      PINPRH(:,:)=MAX(0.,PINPRH(:,:))
321      PACPRH(:,:)=MAX(0.,PACPRH(:,:))
322     END IF
323 !
324   END IF
325 !
326 !-------------------------------------------------------------------------------
327 !
328 END IF
329 !
330 !*       3.3  Informations from model SON1
331 !             ----------------------------
332 !
333 IF (PRESENT(HSONFILE)) THEN
334   IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
335     ALLOCATE(ZINPRC1(KIUSON,KJUSON))
336     ALLOCATE(ZACPRC1(KIUSON,KJUSON))
337     YGETRRT='READ'
338   ELSE
339     ALLOCATE(ZINPRC1(0,0))
340     ALLOCATE(ZACPRC1(0,0))
341     YGETRRT='SKIP'
342   END IF
343   IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
344     ALLOCATE(ZINPRR1(KIUSON,KJUSON))
345     ALLOCATE(ZINPRR3D1(KIUSON,KJUSON,ILU))
346     ALLOCATE(ZEVAP3D1(KIUSON,KJUSON,ILU))
347     ALLOCATE(ZACPRR1(KIUSON,KJUSON))
348     YGETRRT='READ'
349   ELSE
350     ALLOCATE(ZINPRR1(0,0))
351     ALLOCATE(ZINPRR3D1(0,0,0))
352     ALLOCATE(ZEVAP3D1(0,0,0))
353     ALLOCATE(ZACPRR1(0,0))
354     YGETRRT='SKIP'
355   END IF
356   IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
357     ALLOCATE(ZINPRS1(KIUSON,KJUSON))
358     ALLOCATE(ZACPRS1(KIUSON,KJUSON))
359     YGETRST='READ'
360   ELSE
361     ALLOCATE(ZINPRS1(0,0))
362     ALLOCATE(ZACPRS1(0,0))
363     YGETRST='SKIP'
364   END IF
365   IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
366     ALLOCATE(ZINPRG1(KIUSON,KJUSON))
367     ALLOCATE(ZACPRG1(KIUSON,KJUSON))
368     YGETRGT='READ'
369   ELSE
370     ALLOCATE(ZINPRG1(0,0))
371     ALLOCATE(ZACPRG1(0,0))
372     YGETRGT='SKIP'
373   END IF
374   IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
375     ALLOCATE(ZINPRH1(KIUSON,KJUSON))
376     ALLOCATE(ZACPRH1(KIUSON,KJUSON))
377     YGETRHT='READ'
378   ELSE
379     ALLOCATE(ZINPRH1(0,0))
380     ALLOCATE(ZACPRH1(0,0))
381     YGETRHT='SKIP'
382   END IF
383   CALL READ_PRECIP_FIELD(HSONFILE,CLUOUT,CPROGRAM,CCONF,                          &
384                          YGETRCT,YGETRRT,YGETRST,YGETRGT,YGETRHT,                 &
385                          ZINPRC1,ZACPRC1,ZINPRR1,ZINPRR3D1,ZEVAP3D1,              &
386                          ZACPRR1,ZINPRS1,ZACPRS1,                                 &
387                          ZINPRG1,ZACPRG1,ZINPRH1,ZACPRH1                          )
388   IF (SIZE(PRECIP_MODEL(1)%XINPRC) /= 0 ) THEN
389     PINPRC(KIB2:KIE2,KJB2:KJE2) = ZINPRC1(KIB1:KIE1,KJB1:KJE1)
390     PACPRC(KIB2:KIE2,KJB2:KJE2) = ZACPRC1(KIB1:KIE1,KJB1:KJE1)
391   END IF
392   DEALLOCATE(ZINPRC1)
393   DEALLOCATE(ZACPRC1)
394   IF (SIZE(PRECIP_MODEL(1)%XINPRR) /= 0 ) THEN
395     PINPRR(KIB2:KIE2,KJB2:KJE2) = ZINPRR1(KIB1:KIE1,KJB1:KJE1)
396     PINPRR3D(KIB2:KIE2,KJB2:KJE2,:) = ZINPRR3D1(KIB1:KIE1,KJB1:KJE1,:)
397     PEVAP3D(KIB2:KIE2,KJB2:KJE2,:) = ZEVAP3D1(KIB1:KIE1,KJB1:KJE1,:)
398     PACPRR(KIB2:KIE2,KJB2:KJE2) = ZACPRR1(KIB1:KIE1,KJB1:KJE1)
399   END IF
400   DEALLOCATE(ZINPRR1)
401   DEALLOCATE(ZINPRR3D1)
402   DEALLOCATE(ZEVAP3D1)
403   DEALLOCATE(ZACPRR1)
404   IF (SIZE(PRECIP_MODEL(1)%XINPRS) /= 0 ) THEN
405     PINPRS(KIB2:KIE2,KJB2:KJE2) = ZINPRS1(KIB1:KIE1,KJB1:KJE1)
406     PACPRS(KIB2:KIE2,KJB2:KJE2) = ZACPRS1(KIB1:KIE1,KJB1:KJE1)
407   END IF
408   DEALLOCATE(ZINPRS1)
409   DEALLOCATE(ZACPRS1)
410   IF (SIZE(PRECIP_MODEL(1)%XINPRG) /= 0 ) THEN
411     PINPRG(KIB2:KIE2,KJB2:KJE2) = ZINPRG1(KIB1:KIE1,KJB1:KJE1)
412     PACPRG(KIB2:KIE2,KJB2:KJE2) = ZACPRG1(KIB1:KIE1,KJB1:KJE1)
413   END IF
414   DEALLOCATE(ZINPRG1)
415   DEALLOCATE(ZACPRG1)
416   IF (SIZE(PRECIP_MODEL(1)%XINPRH) /= 0 ) THEN
417     PINPRH(KIB2:KIE2,KJB2:KJE2) = ZINPRH1(KIB1:KIE1,KJB1:KJE1)
418     PACPRH(KIB2:KIE2,KJB2:KJE2) = ZACPRH1(KIB1:KIE1,KJB1:KJE1)
419   END IF
420   DEALLOCATE(ZINPRH1)
421   DEALLOCATE(ZACPRH1)
422 END IF
423 !
424 !
425 !-------------------------------------------------------------------------------
426 !
427 END SUBROUTINE SPAWN_SURF2_RAIN