Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / load_expr.f90
1 !     ######spl
2       SUBROUTINE LOAD_EXPR(KIND,HCARIN)
3 !     ################################
4 !
5 !!****  *LOAD_FMTAXES* - 
6 !!
7 !!    PURPOSE
8 !!    -------
9 !       Analyser l'expression a mutiplier ou diviser (actuellement un  
10 !       processus) et le charger en memoire pour le calcul ulterieur
11 !
12 !!**  METHOD
13 !!    ------
14 !!     
15 !!     N.A.
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!      None
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!      Module
24 !!
25 !!      Module
26 !!
27 !!    REFERENCE
28 !!    ---------
29 !!
30 !!
31 !!    AUTHOR
32 !!    ------
33 !!      J. Duron    * Laboratoire d'Aerologie *
34 !!
35 !!
36 !!    MODIFICATIONS
37 !!    -------------
38 !!      Original       02/07/01
39 !!      Updated   PM   
40 !-------------------------------------------------------------------------------
41 !
42 !*       0.    DECLARATIONS
43 !              ------------
44 !
45 USE MODD_EXPR
46 USE MODN_NCAR
47 USE MODD_FILES_DIACHRO
48 USE MODD_ALLOC_FORDIACHRO
49 USE MODD_SEVERAL_RECORDS
50
51 IMPLICIT NONE
52 !
53 !*       0.1   Dummy arguments
54 !              ---------------
55
56 INTEGER          :: KIND
57 CHARACTER(LEN=*) :: HCARIN
58 !
59 !*       0.1   Local variables
60 !              ---------------
61 CHARACTER(LEN=LEN(HCARIN)) :: YCARIN
62 CHARACTER(LEN=20) :: YTEM
63 CHARACTER(LEN=16) :: YGROUP
64 CHARACTER(LEN=1) :: YSTAR
65 INTEGER,SAVE     :: INDEXPR, ILEN, IPARG, IPARD, IETOILE,IMULT
66 INTEGER,SAVE     :: IEGAL, J,JM, IP, IPR
67 INTEGER          :: INDPLUS, INDMINUS
68 REAL,SAVE        :: ZCONSTANTE
69 ! !------------------------------------------------------------------------------
70 !*********************************************
71 ! Cas RM*EXPRx (RM/EXPRx) et *EXPRx= (/EXPRx=)
72 !*********************************************
73 IF(KIND == 0)THEN
74   INDEXPR=INDEX(HCARIN,'RM*')
75   IF(INDEXPR /= 0)THEN
76 ! RM*EXPRx
77 !!!!!!!!!!
78     IF(HCARIN == 'RM*EXPR1')THEN
79       IF(ALLOCATED(XEXPR1))DEALLOCATE(XEXPR1)
80     ELSE IF(HCARIN == 'RM*EXPR2')THEN
81       IF(ALLOCATED(XEXPR2))DEALLOCATE(XEXPR2)
82     ELSE IF(HCARIN == 'RM*EXPR3')THEN
83       IF(ALLOCATED(XEXPR3))DEALLOCATE(XEXPR3)
84     ELSE IF(HCARIN == 'RM*EXPR4')THEN
85       IF(ALLOCATED(XEXPR4))DEALLOCATE(XEXPR4)
86     ELSE IF(HCARIN == 'RM*EXPR5')THEN
87       IF(ALLOCATED(XEXPR5))DEALLOCATE(XEXPR5)
88     ELSE IF(HCARIN == 'RM*EXPR6')THEN
89       IF(ALLOCATED(XEXPR6))DEALLOCATE(XEXPR6)
90     ELSE IF(HCARIN == 'RM*EXPR7')THEN
91       IF(ALLOCATED(XEXPR7))DEALLOCATE(XEXPR7)
92     ELSE IF(HCARIN == 'RM*EXPR8')THEN
93       IF(ALLOCATED(XEXPR8))DEALLOCATE(XEXPR8)
94     ELSE IF(HCARIN == 'RM*EXPR9')THEN
95       IF(ALLOCATED(XEXPR9))DEALLOCATE(XEXPR9)
96     ENDIF
97   ELSE
98     INDEXPR=INDEX(HCARIN,'RM/')
99     IF(INDEXPR /= 0)THEN
100 ! RM/EXPRx
101 !!!!!!!!!!
102       IF(HCARIN == 'RM/EXPR1')THEN
103         IF(ALLOCATED(XDEXPR1))DEALLOCATE(XDEXPR1)
104       ELSE IF(HCARIN == 'RM/EXPR2')THEN
105         IF(ALLOCATED(XDEXPR2))DEALLOCATE(XDEXPR2)
106       ELSE IF(HCARIN == 'RM/EXPR3')THEN
107         IF(ALLOCATED(XDEXPR3))DEALLOCATE(XDEXPR3)
108       ELSE IF(HCARIN == 'RM/EXPR4')THEN
109         IF(ALLOCATED(XDEXPR4))DEALLOCATE(XDEXPR4)
110       ELSE IF(HCARIN == 'RM/EXPR5')THEN
111         IF(ALLOCATED(XDEXPR5))DEALLOCATE(XDEXPR5)
112       ELSE IF(HCARIN == 'RM/EXPR6')THEN
113         IF(ALLOCATED(XDEXPR6))DEALLOCATE(XDEXPR6)
114       ELSE IF(HCARIN == 'RM/EXPR7')THEN
115         IF(ALLOCATED(XDEXPR7))DEALLOCATE(XDEXPR7)
116       ELSE IF(HCARIN == 'RM/EXPR8')THEN
117         IF(ALLOCATED(XDEXPR8))DEALLOCATE(XDEXPR8)
118       ELSE IF(HCARIN == 'RM/EXPR9')THEN
119         IF(ALLOCATED(XDEXPR9))DEALLOCATE(XDEXPR9)
120       ENDIF
121     ELSE
122 ! *EXPRx= ou /EXPRx=
123 !!!!!!!!!!!!!!!!!!!!
124 ! *EXPRx=
125 !!!!!!!!!
126 ! /EXPRx=
127 !!!!!!!!!
128       YCARIN(1:LEN(YCARIN))=' '
129       INDEXPR=INDEX(HCARIN,'*EXPR')
130
131       IF(INDEXPR == 0)THEN
132         INDEXPR=INDEX(HCARIN,'/EXPR')
133         YSTAR='*'
134       ELSE
135         YSTAR='*'
136       ENDIF
137
138         INDEXPR=INDEX(HCARIN,'=')
139         IEGAL=INDEX(HCARIN,'=')
140 ! Extraction du champ
141         YCARIN=HCARIN(INDEXPR+1:LEN_TRIM(HCARIN))
142         YCARIN=ADJUSTL(YCARIN)
143         ILEN=LEN_TRIM(YCARIN)
144 ! Eventuelle constante a * ou +
145         IPARG=INDEX(YCARIN,'(')
146 ! Eventuel autre champ a - ou +
147         INDPLUS= INDEX(YCARIN,'_PLUS_')
148         INDMINUS= INDEX(YCARIN,'_MINUS_')
149         YTEM(1:LEN(YTEM))=' '
150
151         IF(IPARG /= 0)THEN
152           IPARD=INDEX(YCARIN,')')
153           IETOILE=INDEX(YCARIN(IPARG:IPARD),YSTAR)
154           ZCONSTANTE=0
155           IF(IETOILE /= 0)THEN
156 ! Multiplication par une constante
157             IMULT=2
158             READ(YCARIN(IETOILE+IPARG:IPARD-1),*)ZCONSTANTE
159             YTEM(1:IPARG-1)=YCARIN(1:IPARG-1)
160             YTEM(IPARG:IPARG+ILEN-IPARD)=YCARIN(IPARD+1:ILEN)
161           ELSE
162 ! Addition d'une constante
163             IMULT=1
164             READ(YCARIN(IPARG+1:IPARD-1),*)ZCONSTANTE
165             YTEM(1:IPARG-1)=YCARIN(1:IPARG-1)
166             YTEM(IPARG:IPARG+ILEN-IPARD)=YCARIN(IPARD+1:ILEN)
167           ENDIF
168         ELSE IF(INDPLUS /= 0)THEN
169           IMULT=0
170 ! Addition d'un autre champ
171           YTEM(1:INDPLUS-1)=YCARIN(1:INDPLUS-1)
172         ELSE IF(INDMINUS /= 0)THEN
173           IMULT=0
174 ! Soustraction d'un autre champ
175           YTEM(1:INDMINUS-1)=YCARIN(1:INDMINUS-1)
176         ELSE
177 ! Pas de cste
178           IMULT=0
179           YTEM(1:ILEN)=YCARIN(1:ILEN)
180         ENDIF
181         YTEM=ADJUSTL(YTEM)
182         print *,' ** load_expr IMULT,zconstante YTEM ',IMULT,zconstante,YTEM
183         ILEN=LEN_TRIM(YTEM)
184         INDEXPR=INDEX(YTEM,'_P_')
185         YGROUP(1:LEN(YGROUP))=' '
186         IF(INDEXPR == 0)THEN
187           YGROUP=YTEM(1:ILEN)
188         ELSE
189           YGROUP=YTEM(1:INDEXPR-1)
190         ENDIF
191         YGROUP=ADJUSTL(YGROUP)
192         IF(INDEXPR == 0)THEN
193           IP=1
194         ELSE
195         READ(YTEM(INDEXPR+3:ILEN),*)IP
196         ENDIF
197         DO J=1,NBFILES
198           IF(NUMFILES(J) == NUMFILECUR)THEN
199             JM=J
200           ENDIF
201         ENDDO
202         CALL VERIF_GROUP(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
203         IF(LPBREAD)THEN
204           LPBREAD=.FALSE.
205           print *, ' ** load_expr PB avec le nom du groupe ',YGROUP
206           IF(ALLOCATED(XVAR))THEN
207             CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
208           ENDIF
209           RETURN
210         ENDIF
211         IF(LGROUP)THEN
212           CALL READ_DIACHRO(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
213         ENDIF
214         IF(IP > SIZE(XVAR,6))THEN
215           print *, ' ** load_expr PB avec le numero de processus :',IP, &
216           ' > au nb de processus du groupe: ',SIZE(XVAR,6),'. Corrigez.'
217           IF(ALLOCATED(XVAR))THEN
218             CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
219           ENDIF
220           RETURN
221         ENDIF
222         ILEN=LEN_TRIM(YCARIN)
223         IF(HCARIN(1:6) == '*EXPR1')THEN
224           IF(ALLOCATED(XEXPR1))DEALLOCATE(XEXPR1)
225           ALLOCATE(XEXPR1(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
226           SIZE(XVAR,4),SIZE(XVAR,5),1))
227           CALL LOAD_EXPRX(XEXPR1)
228         ELSE IF(HCARIN(1:6) == '*EXPR2')THEN
229           IF(ALLOCATED(XEXPR2))DEALLOCATE(XEXPR2)
230           ALLOCATE(XEXPR2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
231           SIZE(XVAR,4),SIZE(XVAR,5),1))
232           CALL LOAD_EXPRX(XEXPR2)
233         ELSE IF(HCARIN(1:6) == '*EXPR3')THEN
234           IF(ALLOCATED(XEXPR3))DEALLOCATE(XEXPR3)
235           ALLOCATE(XEXPR3(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
236           SIZE(XVAR,4),SIZE(XVAR,5),1))
237           CALL LOAD_EXPRX(XEXPR3)
238         ELSE IF(HCARIN(1:6) == '*EXPR4')THEN
239           IF(ALLOCATED(XEXPR4))DEALLOCATE(XEXPR4)
240           ALLOCATE(XEXPR4(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
241           SIZE(XVAR,4),SIZE(XVAR,5),1))
242           CALL LOAD_EXPRX(XEXPR4)
243         ELSE IF(HCARIN(1:6) == '*EXPR5')THEN
244           IF(ALLOCATED(XEXPR5))DEALLOCATE(XEXPR5)
245           ALLOCATE(XEXPR5(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
246           SIZE(XVAR,4),SIZE(XVAR,5),1))
247           CALL LOAD_EXPRX(XEXPR5)
248         ELSE IF(HCARIN(1:6) == '*EXPR6')THEN
249           IF(ALLOCATED(XEXPR6))DEALLOCATE(XEXPR6)
250           ALLOCATE(XEXPR6(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
251           SIZE(XVAR,4),SIZE(XVAR,5),1))
252           CALL LOAD_EXPRX(XEXPR6)
253         ELSE IF(HCARIN(1:6) == '*EXPR7')THEN
254           IF(ALLOCATED(XEXPR7))DEALLOCATE(XEXPR7)
255           ALLOCATE(XEXPR7(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
256           SIZE(XVAR,4),SIZE(XVAR,5),1))
257           CALL LOAD_EXPRX(XEXPR7)
258         ELSE IF(HCARIN(1:6) == '*EXPR8')THEN
259           IF(ALLOCATED(XEXPR8))DEALLOCATE(XEXPR8)
260           ALLOCATE(XEXPR8(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
261           SIZE(XVAR,4),SIZE(XVAR,5),1))
262           XEXPR8(:,:,:,:,:,1)=XVAR(:,:,:,:,:,IP)
263           CALL LOAD_EXPRX(XEXPR8)
264         ELSE IF(HCARIN(1:6) == '*EXPR9')THEN
265           IF(ALLOCATED(XEXPR9))DEALLOCATE(XEXPR9)
266           ALLOCATE(XEXPR9(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
267           SIZE(XVAR,4),SIZE(XVAR,5),1))
268           CALL LOAD_EXPRX(XEXPR9)
269 !
270         ELSE IF(HCARIN(1:6) == '/EXPR1')THEN
271           IF(ALLOCATED(XDEXPR1))DEALLOCATE(XDEXPR1)
272           ALLOCATE(XDEXPR1(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
273           SIZE(XVAR,4),SIZE(XVAR,5),1))
274           CALL LOAD_EXPR1X(XDEXPR1)
275         ELSE IF(HCARIN(1:6) == '/EXPR2')THEN
276           IF(ALLOCATED(XDEXPR2))DEALLOCATE(XDEXPR2)
277           ALLOCATE(XDEXPR2(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
278           SIZE(XVAR,4),SIZE(XVAR,5),1))
279           CALL LOAD_EXPR1X(XDEXPR2)
280         ELSE IF(HCARIN(1:6) == '/EXPR3')THEN
281           IF(ALLOCATED(XDEXPR3))DEALLOCATE(XDEXPR3)
282           ALLOCATE(XDEXPR3(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
283           SIZE(XVAR,4),SIZE(XVAR,5),1))
284           CALL LOAD_EXPR1X(XDEXPR3)
285         ELSE IF(HCARIN(1:6) == '/EXPR4')THEN
286           IF(ALLOCATED(XDEXPR4))DEALLOCATE(XDEXPR4)
287           ALLOCATE(XDEXPR4(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
288           SIZE(XVAR,4),SIZE(XVAR,5),1))
289           CALL LOAD_EXPR1X(XDEXPR4)
290         ELSE IF(HCARIN(1:6) == '/EXPR5')THEN
291           IF(ALLOCATED(XDEXPR5))DEALLOCATE(XDEXPR5)
292           ALLOCATE(XDEXPR5(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
293           SIZE(XVAR,4),SIZE(XVAR,5),1))
294           CALL LOAD_EXPR1X(XDEXPR5)
295         ELSE IF(HCARIN(1:6) == '/EXPR6')THEN
296           IF(ALLOCATED(XDEXPR6))DEALLOCATE(XDEXPR6)
297           ALLOCATE(XDEXPR6(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
298           SIZE(XVAR,4),SIZE(XVAR,5),1))
299           CALL LOAD_EXPR1X(XDEXPR6)
300         ELSE IF(HCARIN(1:6) == '/EXPR7')THEN
301           IF(ALLOCATED(XDEXPR7))DEALLOCATE(XDEXPR7)
302           ALLOCATE(XDEXPR7(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
303           SIZE(XVAR,4),SIZE(XVAR,5),1))
304           CALL LOAD_EXPR1X(XDEXPR7)
305         ELSE IF(HCARIN(1:6) == '/EXPR8')THEN
306           IF(ALLOCATED(XDEXPR8))DEALLOCATE(XDEXPR8)
307           ALLOCATE(XDEXPR8(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
308           SIZE(XVAR,4),SIZE(XVAR,5),1))
309           CALL LOAD_EXPR1X(XDEXPR8)
310         ELSE IF(HCARIN(1:6) == '/EXPR9')THEN
311           IF(ALLOCATED(XDEXPR9))DEALLOCATE(XDEXPR9)
312           ALLOCATE(XDEXPR9(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),&
313           SIZE(XVAR,4),SIZE(XVAR,5),1))
314           CALL LOAD_EXPR1X(XDEXPR9)
315         ENDIF
316
317     ENDIF
318   ENDIF
319 ELSE
320 !*********************
321 ! Cas *EXPRx (/EXPRx)
322 !*********************
323   IF(HCARIN == '*EXPR1')THEN
324     DO IPR=1,SIZE(XVAR,6)
325      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
326        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR1(:,:,:,:,:,1)
327      ENDWHERE
328     ENDDO
329   ELSE IF(HCARIN == '*EXPR2')THEN
330     DO IPR=1,SIZE(XVAR,6)
331      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
332        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR2(:,:,:,:,:,1)
333      ENDWHERE
334     ENDDO
335   ELSE IF(HCARIN == '*EXPR3')THEN
336     DO IPR=1,SIZE(XVAR,6)
337      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
338        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR3(:,:,:,:,:,1)
339      ENDWHERE
340     ENDDO
341   ELSE IF(HCARIN == '*EXPR4')THEN
342     DO IPR=1,SIZE(XVAR,6)
343      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
344        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR4(:,:,:,:,:,1)
345      ENDWHERE
346     ENDDO
347   ELSE IF(HCARIN == '*EXPR5')THEN
348     DO IPR=1,SIZE(XVAR,6)
349      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
350        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR5(:,:,:,:,:,1)
351      ENDWHERE
352     ENDDO
353   ELSE IF(HCARIN == '*EXPR6')THEN
354     DO IPR=1,SIZE(XVAR,6)
355      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
356        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR6(:,:,:,:,:,1)
357      ENDWHERE
358     ENDDO
359   ELSE IF(HCARIN == '*EXPR7')THEN
360     DO IPR=1,SIZE(XVAR,6)
361      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
362        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR7(:,:,:,:,:,1)
363      ENDWHERE
364     ENDDO
365   ELSE IF(HCARIN == '*EXPR8')THEN
366     DO IPR=1,SIZE(XVAR,6)
367      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
368        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR8(:,:,:,:,:,1)
369      ENDWHERE
370     ENDDO
371   ELSE IF(HCARIN == '*EXPR9')THEN
372     DO IPR=1,SIZE(XVAR,6)
373      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
374        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XEXPR9(:,:,:,:,:,1)
375      ENDWHERE
376     ENDDO
377
378   ELSE IF(HCARIN == '/EXPR1')THEN
379     DO IPR=1,SIZE(XVAR,6)
380      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL .AND. XDEXPR1(:,:,:,:,:,1) /= XSPVAL)
381        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR1(:,:,:,:,:,1)
382      ELSEWHERE
383        XVAR(:,:,:,:,:,IPR)=XSPVAL
384     ENDWHERE
385     ENDDO
386   ELSE IF(HCARIN == '/EXPR2')THEN
387     DO IPR=1,SIZE(XVAR,6)
388      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
389        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR2(:,:,:,:,:,1)
390      ENDWHERE
391     ENDDO
392   ELSE IF(HCARIN == '/EXPR3')THEN
393     DO IPR=1,SIZE(XVAR,6)
394      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
395        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR3(:,:,:,:,:,1)
396      ENDWHERE
397     ENDDO
398   ELSE IF(HCARIN == '/EXPR4')THEN
399     DO IPR=1,SIZE(XVAR,6)
400      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
401        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR4(:,:,:,:,:,1)
402      ENDWHERE
403     ENDDO
404   ELSE IF(HCARIN == '/EXPR5')THEN
405     DO IPR=1,SIZE(XVAR,6)
406      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
407        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR5(:,:,:,:,:,1)
408      ENDWHERE
409     ENDDO
410   ELSE IF(HCARIN == '/EXPR6')THEN
411     DO IPR=1,SIZE(XVAR,6)
412      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
413        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR6(:,:,:,:,:,1)
414      ENDWHERE
415     ENDDO
416   ELSE IF(HCARIN == '/EXPR7')THEN
417     DO IPR=1,SIZE(XVAR,6)
418      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
419        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR7(:,:,:,:,:,1)
420      ENDWHERE
421     ENDDO
422   ELSE IF(HCARIN == '/EXPR8')THEN
423     DO IPR=1,SIZE(XVAR,6)
424      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
425        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR8(:,:,:,:,:,1)
426      ENDWHERE
427     ENDDO
428   ELSE IF(HCARIN == '/EXPR9')THEN
429     DO IPR=1,SIZE(XVAR,6)
430      WHERE(XVAR(:,:,:,:,:,IPR) /= XSPVAL)
431        XVAR(:,:,:,:,:,IPR)=XVAR(:,:,:,:,:,IPR)*XDEXPR9(:,:,:,:,:,1)
432      ENDWHERE
433     ENDDO
434   ENDIF
435 ENDIF
436 RETURN
437
438 CONTAINS
439        SUBROUTINE LOAD_EXPRX(PEXPR)
440 REAL,DIMENSION(:,:,:,:,:,:) :: PEXPR
441 REAL :: ZFAC
442
443 PEXPR(:,:,:,:,:,1)=XVAR(:,:,:,:,:,IP)
444 CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
445
446 IF(IMULT == 2)PEXPR=PEXPR*ZCONSTANTE
447 IF(IMULT == 1)PEXPR=PEXPR+ZCONSTANTE
448
449 IF(INDPLUS/=0 .OR. INDMINUS/=0) THEN
450   IF (INDPLUS/=0) THEN
451     YGROUP=YCARIN(INDPLUS+6:ILEN)
452     ZFAC=1.
453   ELSE IF (INDMINUS/=0) THEN
454     YGROUP=YCARIN(INDPLUS+7:ILEN)
455     ZFAC=-1.
456   END IF
457   CALL VERIF_GROUP(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
458   IF(LPBREAD)THEN
459     LPBREAD=.FALSE.
460     print *, ' ** load_expr PB avec le nom du groupe dans exprx',YGROUP
461     IF(ALLOCATED(XVAR)) CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
462     RETURN
463   ENDIF
464   IF(LGROUP)THEN
465     CALL READ_DIACHRO(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
466   ENDIF
467   IF(IP > SIZE(XVAR,6))THEN
468     print *, ' ** load_expr PB avec le numero de processus :',IP, &
469              ' > au nb de processus du groupe: ',SIZE(XVAR,6),'. Corrigez.'
470     IF(ALLOCATED(XVAR)) CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
471     RETURN
472   ENDIF
473   WHERE( (PEXPR(:,:,:,:,:,1) == XSPVAL) .OR. &
474          (XVAR (:,:,:,:,:,IP) == XSPVAL)       )
475     PEXPR(:,:,:,:,:,1)= XSPVAL
476   ELSEWHERE
477     PEXPR(:,:,:,:,:,1)=PEXPR(:,:,:,:,:,1)+ZFAC*XVAR(:,:,:,:,:,IP)
478   ENDWHERE
479   CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
480 ENDIF
481
482 END SUBROUTINE LOAD_EXPRX
483
484        SUBROUTINE LOAD_EXPR1X(PEXPR)
485 REAL,DIMENSION(:,:,:,:,:,:) :: PEXPR
486 REAL :: ZFAC
487
488 PEXPR(:,:,:,:,:,1)=XVAR(:,:,:,:,:,IP)
489 CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
490
491 IF(IMULT == 2)THEN
492   WHERE(PEXPR /= XSPVAL)
493     PEXPR=PEXPR*ZCONSTANTE
494   ENDWHERE
495 ELSEIF(IMULT == 1)THEN
496   WHERE(XDEXPR1 /= XSPVAL)
497     PEXPR=PEXPR+ZCONSTANTE
498   ENDWHERE
499 ENDIF
500
501 IF(INDPLUS/=0 .OR. INDMINUS/=0) THEN
502   IF (INDPLUS/=0) THEN
503     YGROUP=YCARIN(INDPLUS+6:ILEN)
504     ZFAC=1.
505   ELSE IF (INDMINUS/=0) THEN
506     YGROUP=YCARIN(INDPLUS+7:ILEN)
507     ZFAC=-1.
508   END IF
509   CALL VERIF_GROUP(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
510   IF(LPBREAD)THEN
511     LPBREAD=.FALSE.
512     print *, ' ** load_expr PB avec le nom du groupe dans expr1x',YGROUP
513     IF(ALLOCATED(XVAR)) CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
514     RETURN
515   ENDIF
516   IF(LGROUP)THEN
517     CALL READ_DIACHRO(CFILEDIAS(JM),CLUOUTDIAS(JM),YGROUP)
518   ENDIF
519   IF(IP > SIZE(XVAR,6))THEN
520     print *, ' ** load_expr PB avec le numero de processus :',IP, &
521              ' > au nb de processus du groupe: ',SIZE(XVAR,6),'. Corrigez.'
522     IF(ALLOCATED(XVAR)) CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
523     RETURN
524   ENDIF
525   WHERE( (PEXPR(:,:,:,:,:,1) == XSPVAL) .OR. &
526          (XVAR (:,:,:,:,:,IP) == XSPVAL)       )
527     PEXPR(:,:,:,:,:,1)= XSPVAL
528   ELSEWHERE
529     PEXPR(:,:,:,:,:,1)=PEXPR(:,:,:,:,:,1)+ZFAC*XVAR(:,:,:,:,:,IP)
530   ENDWHERE
531   CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
532 ENDIF
533
534 WHERE(PEXPR(:,:,:,:,:,1) /= XSPVAL .AND. PEXPR(:,:,:,:,:,1) /= 0.)
535   PEXPR(:,:,:,:,:,1)=1./PEXPR(:,:,:,:,:,1)
536 ELSEWHERE
537   PEXPR(:,:,:,:,:,1)=XSPVAL
538 ENDWHERE
539 END SUBROUTINE LOAD_EXPR1X
540
541 END SUBROUTINE LOAD_EXPR 
542