Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / realloc_and_load.f90
1 !     ######spl
2       MODULE MODI_REALLOC_AND_LOAD
3 !     #############################
4 !
5 INTERFACE
6 !
7 SUBROUTINE REALLOC_AND_LOAD(HGROUP)
8 CHARACTER(LEN=*) :: HGROUP
9 END SUBROUTINE  REALLOC_AND_LOAD
10 !
11 END INTERFACE
12 END MODULE MODI_REALLOC_AND_LOAD
13 !     ######spl
14       SUBROUTINE REALLOC_AND_LOAD(HGROUP)
15 !     ###################################
16 !
17 !!****  *REALLOC_AND_LOAD* - 
18 !!
19 !!    PURPOSE
20 !!    -------
21 !      
22 !
23 !!**  METHOD
24 !!    ------
25 !!     
26 !!     N.A.
27 !!
28 !!    EXTERNAL
29 !!    --------
30 !!      None
31 !!
32 !!    IMPLICIT ARGUMENTS
33 !!    ------------------
34 !!      Module
35 !!
36 !!      Module
37 !!
38 !!    REFERENCE
39 !!    ---------
40 !!
41 !!
42 !!    AUTHOR
43 !!    ------
44 !!      J. Duron    * Laboratoire d'Aerologie *
45 !!
46 !!
47 !!    MODIFICATIONS
48 !!    -------------
49 !!      Original       24/11/95
50 !!      Updated   PM   02/12/94
51 !-------------------------------------------------------------------------------
52 !
53 !*       0.    DECLARATIONS
54 !              ------------
55 !
56 USE MODD_ALLOC_FORDIACHRO
57 USE MODD_FILES_DIACHRO
58 USE MODD_RESOLVCAR
59 USE MODD_TYPE_AND_LH
60 USE MODD_SEVERAL_RECORDS
61 USE MODI_VERIF_GROUP
62
63 IMPLICIT NONE
64 !
65 !*       0.1   Dummy arguments
66 !              ---------------
67 !
68 CHARACTER(LEN=*) :: HGROUP
69 !
70 !*       0.1   Local variables
71 !              ---------------
72
73 INTEGER          :: J,JME,JT
74 INTEGER          :: II, IJ, IK,IT, IN, IP, IT1, IT2, IL
75 INTEGER          :: IMODJ
76 INTEGER,DIMENSION(:),ALLOCATABLE,SAVE  :: IGRIDIA
77
78 REAL,DIMENSION(:,:,:,:,:,:),ALLOCATABLE  :: ZVAR, ZVAR2
79 REAL,DIMENSION(:,:,:),ALLOCATABLE  :: ZTRAJX, ZTRAJX2
80 REAL,DIMENSION(:,:,:),ALLOCATABLE  :: ZTRAJY, ZTRAJY2
81 REAL,DIMENSION(:,:,:),ALLOCATABLE  :: ZTRAJZ, ZTRAJZ2
82 REAL,DIMENSION(:,:),ALLOCATABLE    :: ZTRAJT, ZTRAJT2
83 REAL,DIMENSION(:,:),ALLOCATABLE    :: ZDATIME, ZDATIME2
84 REAL,DIMENSION(:,:,:,:,:,:),ALLOCATABLE  :: ZMASK, ZMASK2
85 CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE  :: YTITRE
86 CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE  :: YUNITE
87 CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE  :: YCOMMENT
88
89 !------------------------------------------------------------------------------
90 IF(ALLOCATED(XVAR))THEN
91   ALLOCATE(ZVAR(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
92                 SIZE(XVAR,5),SIZE(XVAR,6)))
93   ZVAR(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
94 ENDIF
95 IF(ALLOCATED(XTRAJT))THEN
96   ALLOCATE(ZTRAJT(SIZE(XTRAJT,1),SIZE(XTRAJT,2)))
97   ZTRAJT(:,:)=XTRAJT(:,:)
98 ENDIF
99 IF(ALLOCATED(XTRAJX))THEN
100   ALLOCATE(ZTRAJX(SIZE(XTRAJX,1),SIZE(XTRAJX,2),SIZE(XTRAJX,3)))
101   ZTRAJX(:,:,:)=XTRAJX(:,:,:)
102 ENDIF
103 IF(ALLOCATED(XTRAJY))THEN
104   ALLOCATE(ZTRAJY(SIZE(XTRAJY,1),SIZE(XTRAJY,2),SIZE(XTRAJY,3)))
105   ZTRAJY(:,:,:)=XTRAJY(:,:,:)
106 ENDIF
107 IF(ALLOCATED(XTRAJZ))THEN
108   ALLOCATE(ZTRAJZ(SIZE(XTRAJZ,1),SIZE(XTRAJZ,2),SIZE(XTRAJZ,3)))
109   ZTRAJZ(:,:,:)=XTRAJZ(:,:,:)
110 ENDIF
111 IF(ALLOCATED(XMASK))THEN
112   ALLOCATE(ZMASK(SIZE(XMASK,1),SIZE(XMASK,2),SIZE(XMASK,3),SIZE(XMASK,4), &
113                  SIZE(XMASK,5),SIZE(XMASK,6)))
114   ZMASK(:,:,:,:,:,:)=XMASK(:,:,:,:,:,:)
115 ENDIF
116 IF(ALLOCATED(NGRIDIA))THEN
117   ALLOCATE(IGRIDIA(SIZE(NGRIDIA)))
118   IGRIDIA(:)=NGRIDIA(:)
119 ENDIF
120 IF(ALLOCATED(CTITRE))THEN
121   ALLOCATE(YTITRE(SIZE(CTITRE)))
122   YTITRE=CTITRE
123 ENDIF
124 IF(ALLOCATED(CUNITE))THEN
125   ALLOCATE(YUNITE(SIZE(CUNITE)))
126   YUNITE=CUNITE
127 ENDIF
128 IF(ALLOCATED(CCOMMENT))THEN
129   ALLOCATE(YCOMMENT(SIZE(CCOMMENT)))
130   YCOMMENT=CCOMMENT
131 ENDIF
132 IF(ALLOCATED(XDATIME))THEN
133   ALLOCATE(ZDATIME(SIZE(XDATIME,1),SIZE(XDATIME,2)))
134   ZDATIME(:,:)=XDATIME(:,:)
135 ENDIF
136
137 CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
138
139 DO J=2,NBSIMULT
140
141   JME=NINDFILESIMULT(J)
142   CALL READ_FILEHEAD(JME,CFILEDIAS(JME),CLUOUTDIAS(JME))
143   CALL VERIF_GROUP(CFILEDIAS(JME),CLUOUTDIAS(JME),HGROUP)
144   IF(LPBREAD)THEN
145     EXIT
146   ENDIF
147   IF(LGROUP)THEN
148   CALL READ_DIACHRO(CFILEDIAS(JME),CLUOUTDIAS(JME),HGROUP)
149   ENDIF
150   IMODJ=MOD(J,2)
151
152   SELECT CASE(IMODJ)
153     CASE(0)
154       IF(ALLOCATED(XVAR))THEN
155         IT1=SIZE(ZVAR,4);IT2=SIZE(XVAR,4)
156         IT=IT1+IT2
157         ALLOCATE(ZVAR2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),IT, &
158                        SIZE(XVAR,5),SIZE(XVAR,6)))
159         ZVAR2(:,:,:,1:IT1,:,:)=ZVAR(:,:,:,1:IT1,:,:)
160         ZVAR2(:,:,:,IT1+1:IT,:,:)=XVAR(:,:,:,:,:,:)
161         DEALLOCATE(ZVAR)
162       ENDIF
163       IF(ALLOCATED(XTRAJT))THEN
164         ALLOCATE(ZTRAJT2(IT,SIZE(XTRAJT,2)))
165         ZTRAJT2(1:IT1,:)=ZTRAJT(1:IT1,:)
166         ZTRAJT2(IT1+1:IT,:)=XTRAJT(:,:)
167         DEALLOCATE(ZTRAJT)
168       ENDIF
169       IF(ALLOCATED(XTRAJX))THEN
170         ALLOCATE(ZTRAJX2(SIZE(XTRAJX,1),IT,SIZE(XTRAJX,3)))
171         IF (CTYPE=='SSOL') THEN
172           DO JT=1,IT1
173             ZTRAJX2(:,JT,:)=ZTRAJX(:,1,:)
174           END DO
175           DO JT=IT1+1,IT
176             ZTRAJX2(:,JT,:)=XTRAJX(:,1,:)
177           END DO
178         ELSE
179           ZTRAJX2(:,1:IT1,:)=ZTRAJX(:,1:IT1,:)
180           ZTRAJX2(:,IT1+1:IT,:)=XTRAJX(:,:,:)
181         ENDIF
182         DEALLOCATE(ZTRAJX)
183       ENDIF
184       IF(ALLOCATED(XTRAJY))THEN
185         ALLOCATE(ZTRAJY2(SIZE(XTRAJY,1),IT,SIZE(XTRAJY,3)))
186         IF (CTYPE=='SSOL') THEN
187           DO JT=1,IT1
188             ZTRAJY2(:,JT,:)=ZTRAJY(:,1,:)
189           END DO
190           DO JT=IT1+1,IT
191             ZTRAJY2(:,JT,:)=XTRAJY(:,1,:)
192           END DO
193         ELSE
194           ZTRAJY2(:,1:IT1,:)=ZTRAJY(:,1:IT1,:)
195           ZTRAJY2(:,IT1+1:IT,:)=XTRAJY(:,:,:)
196         ENDIF
197         DEALLOCATE(ZTRAJY)
198       ENDIF
199       IF(ALLOCATED(XTRAJZ))THEN
200         ALLOCATE(ZTRAJZ2(SIZE(XTRAJZ,1),IT,SIZE(XTRAJZ,3)))
201         IF (CTYPE=='SSOL') THEN
202           DO JT=1,IT1
203             ZTRAJZ2(:,JT,:)=ZTRAJZ(:,1,:)
204           END DO
205           DO JT=IT1+1,IT
206             ZTRAJZ2(:,JT,:)=XTRAJZ(:,1,:)
207           END DO
208         ELSE
209           ZTRAJZ2(:,1:IT1,:)=ZTRAJZ(:,1:IT1,:)
210           ZTRAJZ2(:,IT1+1:IT,:)=XTRAJZ(:,:,:)
211         ENDIF
212         DEALLOCATE(ZTRAJZ)
213       ENDIF
214       IF(ALLOCATED(XMASK))THEN
215         ALLOCATE(ZMASK2(SIZE(XMASK,1),SIZE(XMASK,2),SIZE(XMASK,3),IT, &
216                 SIZE(XMASK,5),SIZE(XMASK,6)))
217         ZMASK2(:,:,:,1:IT1,:,:)=ZMASK(:,:,:,1:IT1,:,:)
218         ZMASK2(:,:,:,IT1+1:IT,:,:)=XMASK(:,:,:,:,:,:)
219         DEALLOCATE(ZMASK)
220       ENDIF
221       IF(ALLOCATED(XDATIME))THEN
222         ALLOCATE(ZDATIME2(SIZE(XDATIME,1),IT))
223         ZDATIME2(:,1:IT1)=ZDATIME(:,1:IT1)
224         ZDATIME2(:,IT1+1:IT)=XDATIME(:,:)
225         DEALLOCATE(ZDATIME)
226       ENDIF
227 !     IF(ALLOCATED(CTITRE))THEN
228 !       ALLOCATE(YTITRE(SIZE(CTITRE)))
229 !       YTITRE=CTITRE
230 !     ENDIF
231 !     IF(ALLOCATED(CUNITE))THEN
232 !       ALLOCATE(YUNITE(SIZE(CUNITE)))
233 !       YUNITE=CUNITE
234 !     ENDIF
235 !     IF(ALLOCATED(CCOMMENT))THEN
236 !       ALLOCATE(YCOMMENT(SIZE(CCOMMENT)))
237 !       YCOMMENT=CCOMMENT
238 !     ENDIF
239
240     CASE DEFAULT
241
242       IF(ALLOCATED(XVAR))THEN
243         IT1=SIZE(ZVAR2,4);IT2=SIZE(XVAR,4)
244         IT=IT1+IT2
245
246         ALLOCATE(ZVAR(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),IT, &
247                 SIZE(XVAR,5),SIZE(XVAR,6)))
248         ZVAR(:,:,:,1:IT1,:,:)=ZVAR2(:,:,:,1:IT1,:,:)
249         ZVAR(:,:,:,IT1+1:IT,:,:)=XVAR(:,:,:,:,:,:)
250         DEALLOCATE(ZVAR2)
251       ENDIF
252       IF(ALLOCATED(XTRAJT))THEN
253         ALLOCATE(ZTRAJT(IT,SIZE(XTRAJT,2)))
254         ZTRAJT(1:IT1,:)=ZTRAJT2(1:IT1,:)
255         ZTRAJT(IT1+1:IT,:)=XTRAJT(:,:)
256         DEALLOCATE(ZTRAJT2)
257       ENDIF
258       IF(ALLOCATED(XTRAJX))THEN
259         ALLOCATE(ZTRAJX(SIZE(XTRAJX,1),IT,SIZE(XTRAJX,3)))
260         IF (CTYPE=='SSOL') THEN
261           DO JT=1,IT1
262             ZTRAJX(:,JT,:)=ZTRAJX2(:,1,:)
263           END DO
264           DO JT=IT1+1,IT
265             ZTRAJX(:,JT,:)=XTRAJX(:,1,:)
266           END DO
267         ELSE
268           ZTRAJX(:,1:IT1,:)=ZTRAJX2(:,1:IT1,:)
269           ZTRAJX(:,IT1+1:IT,:)=XTRAJX(:,:,:)
270         ENDIF
271         DEALLOCATE(ZTRAJX2)
272       ENDIF
273       IF(ALLOCATED(XTRAJY))THEN
274         ALLOCATE(ZTRAJY(SIZE(XTRAJY,1),IT,SIZE(XTRAJY,3)))
275         IF (CTYPE=='SSOL') THEN
276           DO JT=1,IT1
277             ZTRAJY(:,JT,:)=ZTRAJY2(:,1,:)
278           END DO
279           DO JT=IT1+1,IT
280             ZTRAJY(:,JT,:)=XTRAJY(:,1,:)
281           END DO
282         ELSE
283           ZTRAJY(:,1:IT1,:)=ZTRAJY2(:,1:IT1,:)
284           ZTRAJY(:,IT1+1:IT,:)=XTRAJY(:,:,:)
285         ENDIF
286         DEALLOCATE(ZTRAJY2)
287       ENDIF
288       IF(ALLOCATED(XTRAJZ))THEN
289         ALLOCATE(ZTRAJZ(SIZE(XTRAJZ,1),IT,SIZE(XTRAJZ,3)))
290         IF (CTYPE=='SSOL') THEN
291           DO JT=1,IT1
292             ZTRAJZ(:,JT,:)=ZTRAJZ2(:,1,:)
293           END DO
294           DO JT=IT1+1,IT
295             ZTRAJZ(:,JT,:)=XTRAJZ(:,1,:)
296           END DO
297         ELSE
298           ZTRAJZ(:,1:IT1,:)=ZTRAJZ2(:,1:IT1,:)
299           ZTRAJZ(:,IT1+1:IT,:)=XTRAJZ(:,:,:)
300         ENDIF
301         DEALLOCATE(ZTRAJZ2)
302       ENDIF
303       IF(ALLOCATED(XDATIME))THEN
304         ALLOCATE(ZDATIME(SIZE(XDATIME,1),IT))
305         ZDATIME(:,1:IT1)=ZDATIME2(:,1:IT1)
306         ZDATIME(:,IT1+1:IT)=XDATIME(:,:)
307         DEALLOCATE(ZDATIME2)
308       ENDIF
309       IF(ALLOCATED(XMASK))THEN
310         ALLOCATE(ZMASK(SIZE(XMASK,1),SIZE(XMASK,2),SIZE(XMASK,3),IT, &
311                 SIZE(XMASK,5),SIZE(XMASK,6)))
312         ZMASK(:,:,:,1:IT1,:,:)=ZMASK2(:,:,:,1:IT1,:,:)
313         ZMASK(:,:,:,IT1+1:IT,:,:)=XMASK(:,:,:,:,:,:)
314         DEALLOCATE(ZMASK2)
315       ENDIF
316
317   END SELECT
318
319   CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
320
321 ENDDO
322
323 IF(MOD(NBSIMULT,2) == 0)THEN
324   II=SIZE(ZVAR2,1); IJ=SIZE(ZVAR2,2); IK=SIZE(ZVAR2,3)
325 ! IF(ALLOCATED(XMASK))THEN
326   IF(CTYPE == 'MASK')THEN
327     II=SIZE(ZMASK2,1); IJ=SIZE(ZMASK2,2)
328   ENDIF
329   IT=SIZE(ZVAR2,4); IN=SIZE(ZVAR2,5); IP=SIZE(ZVAR2,6)
330 ELSE
331   II=SIZE(ZVAR,1); IJ=SIZE(ZVAR,2); IK=SIZE(ZVAR,3)
332 ! IF(ALLOCATED(XMASK))THEN
333   IF(CTYPE == 'MASK')THEN
334     II=SIZE(ZMASK,1); IJ=SIZE(ZMASK,2)
335   ENDIF
336   IT=SIZE(ZVAR,4); IN=SIZE(ZVAR,5); IP=SIZE(ZVAR,6)
337 ENDIF
338
339 CALL ALLOC_FORDIACHRO(II,IJ,IK,IT,IN,IP,1)
340
341 IF(MOD(NBSIMULT,2) == 0)THEN
342
343   IF(ALLOCATED(XVAR))THEN
344     XVAR(:,:,:,:,:,:)=ZVAR2(:,:,:,:,:,:)
345     DEALLOCATE(ZVAR2)
346   ENDIF
347   IF(ALLOCATED(XTRAJT))THEN
348     XTRAJT(:,:)=ZTRAJT2(:,:)
349     DEALLOCATE(ZTRAJT2)
350   ENDIF
351   IF(ALLOCATED(XTRAJX))THEN
352     IF (CTYPE=='SSOL') THEN
353       !SIZE(XTRAJX,2)=1
354       XTRAJX(:,1,:)=ZTRAJX2(:,1,:)
355     ELSE
356       XTRAJX(:,:,:)=ZTRAJX2(:,:,:)
357     ENDIF
358     DEALLOCATE(ZTRAJX2)
359   ENDIF
360   IF(ALLOCATED(XTRAJY))THEN
361     IF (CTYPE=='SSOL') THEN
362       XTRAJY(:,1,:)=ZTRAJY2(:,1,:)
363     ELSE
364       XTRAJY(:,:,:)=ZTRAJY2(:,:,:)
365     ENDIF
366     DEALLOCATE(ZTRAJY2)
367   ENDIF
368   IF(ALLOCATED(XTRAJZ))THEN
369    IF (CTYPE=='SSOL') THEN
370      XTRAJZ(:,1,:)=ZTRAJZ2(:,1,:)
371    ELSE
372      XTRAJZ(:,:,:)=ZTRAJZ2(:,:,:)
373    ENDIF
374    DEALLOCATE(ZTRAJZ2)
375   ENDIF
376   IF(ALLOCATED(XMASK))THEN
377     XMASK(:,:,:,:,:,:)=ZMASK2(:,:,:,:,:,:)
378     DEALLOCATE(ZMASK2)
379   ENDIF
380   IF(ALLOCATED(XDATIME))THEN
381     XDATIME(:,:)=ZDATIME2(:,:)
382     DEALLOCATE(ZDATIME2)
383   ENDIF
384
385 ELSE
386
387   IF(ALLOCATED(XVAR))THEN
388     XVAR(:,:,:,:,:,:)=ZVAR(:,:,:,:,:,:)
389     DEALLOCATE(ZVAR)
390   ENDIF
391   IF(ALLOCATED(XTRAJT))THEN
392     XTRAJT(:,:)=ZTRAJT(:,:)
393     DEALLOCATE(ZTRAJT)
394   ENDIF
395   IF(ALLOCATED(XTRAJX))THEN
396     IF (CTYPE=='SSOL') THEN
397       !SIZE(XTRAJX,2)=1
398       XTRAJX(:,1,:)=ZTRAJX(:,1,:)
399     ELSE
400       XTRAJX(:,:,:)=ZTRAJX(:,:,:)
401     ENDIF
402     DEALLOCATE(ZTRAJX)
403   ENDIF
404   IF(ALLOCATED(XTRAJY))THEN
405     IF (CTYPE=='SSOL') THEN
406       XTRAJY(:,1,:)=ZTRAJY(:,1,:)
407     ELSE
408       XTRAJY(:,:,:)=ZTRAJY(:,:,:)
409     ENDIF
410     DEALLOCATE(ZTRAJY)
411   ENDIF
412   IF(ALLOCATED(XTRAJZ))THEN
413     IF (CTYPE=='SSOL') THEN
414       XTRAJZ(:,1,:)=ZTRAJZ(:,1,:)
415     ELSE
416       XTRAJZ(:,:,:)=ZTRAJZ(:,:,:)
417     ENDIF
418     DEALLOCATE(ZTRAJZ)
419   ENDIF
420   IF(ALLOCATED(XMASK))THEN
421     XMASK(:,:,:,:,:,:)=ZMASK(:,:,:,:,:,:)
422     DEALLOCATE(ZMASK)
423   ENDIF
424   IF(ALLOCATED(XDATIME))THEN
425     XDATIME(:,:)=ZDATIME(:,:)
426     DEALLOCATE(ZDATIME)
427   ENDIF
428
429 ENDIF
430
431 ! Traitement du recouvrement
432 !
433 NBRECOUV=1
434 NRECOUV(1)=1
435 IL=1
436 DO J=2,SIZE(XTRAJT,1)
437   IF(XTRAJT(J,1) <= XTRAJT(J-1,1))THEN
438     NBRECOUV=NBRECOUV+1
439     IL=IL+1
440     NRECOUV(IL)=J-1
441     IL=IL+1
442     NRECOUV(IL)=J
443   ENDIF
444 ENDDO
445 IL=IL+1
446 NRECOUV(IL)=SIZE(XTRAJT,1)
447
448
449 IF(ALLOCATED(NGRIDIA))THEN
450   NGRIDIA(:)=IGRIDIA(:)
451   DEALLOCATE(IGRIDIA)
452 ENDIF
453 IF(ALLOCATED(CTITRE))THEN
454   CTITRE=YTITRE
455   DEALLOCATE(YTITRE)
456 ENDIF
457 IF(ALLOCATED(CUNITE))THEN
458   CUNITE=YUNITE
459   DEALLOCATE(YUNITE)
460 ENDIF
461 IF(ALLOCATED(CCOMMENT))THEN
462   CCOMMENT=YCOMMENT
463   DEALLOCATE(YCOMMENT)
464 ENDIF
465
466 RETURN
467 END SUBROUTINE REALLOC_AND_LOAD