1      SUBROUTINE LIISO2S(BIDON,IRC)
2C
3      INCLUDE 'com_coor.f'
4      INCLUDE 'com_faces.f'
5      INCLUDE 'com_options.f'
6      REAL*8 V1
7      DIMENSION BIDON(*),BIDON2(2)
8      INTEGER   IBIDON(2)
9      LOGICAL*4 LA
10      EQUIVALENCE (BIDON2,IBIDON)
11C
12      IF (ILANG.EQ.0) THEN
13        PRINT*,'*** Comparaison de deux fichiers de r�sultats ***'
14      ELSE
15        PRINT*,'*** Data file comparison ***'
16      ENDIF
17C
18 1000 IF (ILANG.EQ.0) THEN
19        CALL LIFICHTAB
20     &('Nom du premier fichier de valeurs (return -> abandon) ?'
21     &     ,0,NOM_ISO,LONISO,0)
22      ELSE
23        CALL LIFICHTAB
24     &('Name of the first data file (return -> cancel) ?'
25     &     ,0,NOM_ISO,LONISO,0)
26      ENDIF
27      IF (LONISO.LT.0) THEN
28        IRC = -1
29        RETURN
30      ENDIF
31Cfj      IF (NOM_ISO(LONISO:LONISO).EQ.CHAR(9)
32Cfj     &.OR.NOM_ISO(LONISO:LONISO).EQ.CHAR(27)) THEN
33Cfj        IF (LONISO.EQ.1) THEN
34Cfj          PRINT*,'Les fichiers presents :'
35Cfj          CALL EXEC('ls')
36Cfj        ELSE
37Cfj          CALL EXEC('ls '//NOM_ISO(1:LONISO-1)//'*')
38Cfj        ENDIF
39Cfj        PRINT*,' '
40Cfj        GOTO 1000
41Cfj      ENDIF
42      INQUIRE(FILE=NOM_ISO(1:LONISO),EXIST=LA)
43CC      OPEN (2,FILE=NOM_ISO(1:LONISO),STATUS='OLD',IOSTAT=IERR)
44CC      IF (IERR.NE.0) THEN
45      IF (.NOT.LA) THEN
46        IF (ILANG.EQ.0) THEN
47          PRINT*,'---> On n''a pas trouv� '//NOM_ISO(1:LONISO)
48          PRINT*,
49     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
50        ELSE
51          PRINT*,'---> I did not find '//NOM_ISO(1:LONISO)
52          PRINT*,
53     &'---> To display the file list, type <esc> then <return>'
54        ENDIF
55        GOTO 1000
56      ELSE
57        IF (ISTDOUT.EQ.0) THEN
58          CALL testtypebin(2,NOM_ISO(1:LONISO)//CHAR(0),8,IARCH1
59     &                    ,1-2*ILANG)
60        ELSE
61          CALL testtypebin(2,NOM_ISO(1:LONISO)//CHAR(0),8,IARCH1,0)
62        ENDIF
63        IF (IARCH1.LT.0) THEN
64          OPEN(2,FILE=NOM_ISO(1:LONISO),STATUS='OLD',IOSTAT=IERR)
65          IF (IERR.NE.0) THEN
66            IF (ILANG.EQ.0) THEN
67              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
68              PRINT*,
69     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
70            ELSE
71              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
72              PRINT*,
73     &'---> To display the file list, type <esc> then <return>'
74            ENDIF
75            GOTO 1000
76          ENDIF
77          CALL LITITRE(2,NUMNP2,IERR)
78        ELSEIF(IARCH.EQ.1) THEN
79          CALL ouvrebin(2,NOM_ISO(1:LONISO)//CHAR(0),0,IRC)
80          CALL litrecbin(2,BIDON2,LLL,0)
81          IF (LLL.NE.8) THEN
82            IF (ILANG.EQ.0) THEN
83              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
84              PRINT*,
85     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
86            ELSE
87              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
88              PRINT*,
89     &'---> To display the file list, type <esc> then <return>'
90            ENDIF
91            CLOSE(2)
92            GOTO 1000
93          ENDIF
94          NUMNP2 =  IBIDON(1)
95        ELSE
96          OPEN(2,FILE=NOM_ISO(1:LONISO),STATUS='OLD'
97     &         ,FORM='UNFORMATTED',IOSTAT=IERR)
98          IF (IERR.NE.0) THEN
99            IF (ILANG.EQ.0) THEN
100              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
101              PRINT*,
102     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
103            ELSE
104              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
105              PRINT*,
106     &'---> To display the file list, type <esc> then <return>'
107            ENDIF
108            GOTO 1000
109          ENDIF
110          READ(2) NUMNP2
111        ENDIF
112      ENDIF
113      LONC1 = LONISO
114      NOM_C1(1:LONC1) = NOM_ISO(1:LONISO)
115 1001 IF (ILANG.EQ.0) THEN
116        CALL LIFICHTAB
117     &('Nom du second fichier de valeurs (return -> abandon) ?'
118     &       ,0,NOM_ISO,LONISO,0)
119      ELSE
120        CALL LIFICHTAB
121     &('Name of the second data file (return -> cancel) ?'
122     &     ,0,NOM_ISO,LONISO,0)
123      ENDIF
124      IF (LONISO.LT.0) THEN
125        IRC = -2
126        RETURN
127      ENDIF
128Cfj      IF (NOM_ISO(LONISO:LONISO).EQ.CHAR(9)
129Cfj     &.OR.NOM_ISO(LONISO:LONISO).EQ.CHAR(27)) THEN
130Cfj        IF (LONISO.EQ.1) THEN
131Cfj          PRINT*,'Les fichiers presents :'
132Cfj          CALL EXEC('ls')
133Cfj        ELSE
134Cfj          CALL EXEC('ls '//NOM_ISO(1:LONISO-1)//'*')
135Cfj        ENDIF
136Cfj        PRINT*,' '
137Cfj        GOTO 1001
138Cfj      ENDIF
139      INQUIRE(FILE=NOM_ISO(1:LONISO),EXIST=LA)
140CC      OPEN (3,FILE=NOM_ISO(1:LONISO),STATUS='OLD',IOSTAT=IERR)
141CC      IF (IERR.NE.0) THEN
142      IF (.NOT.LA) THEN
143        IF (ILANG.EQ.0) THEN
144          PRINT*,'---> On n''a pas trouv� '//NOM_ISO(1:LONISO)
145          PRINT*,
146     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
147        ELSE
148          PRINT*,'---> I did not find '//NOM_ISO(1:LONISO)
149          PRINT*,
150     &'---> To display the file list, type <esc> then <return>'
151        ENDIF
152        GOTO 1001
153      ELSE
154        IF (ISTDOUT.EQ.0) THEN
155          CALL testtypebin(3,NOM_ISO(1:LONISO)//CHAR(0),8,IARCH2
156     &                    ,1-2*ILANG)
157        ELSE
158          CALL testtypebin(3,NOM_ISO(1:LONISO)//CHAR(0),8,IARCH2,0)
159        ENDIF
160        IF (IARCH2.LT.0) THEN
161          OPEN(3,FILE=NOM_ISO(1:LONISO),STATUS='OLD',IOSTAT=IERR)
162          IF (IERR.NE.0) THEN
163            IF (ILANG.EQ.0) THEN
164              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
165              PRINT*,
166     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
167            ELSE
168              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
169              PRINT*,
170     &'---> To display the file list, type <esc> then <return>'
171            ENDIF
172            GOTO 1001
173          ENDIF
174          CALL LITITRE(3,NUMNP3,IERR)
175        ELSEIF(IARCH.EQ.1) THEN
176          CALL ouvrebin(3,NOM_ISO(1:LONISO)//CHAR(0),0,IRC)
177          CALL litrecbin(3,BIDON2,LLL,0)
178          IF (LLL.NE.8) THEN
179            IF (ILANG.EQ.0) THEN
180              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
181              PRINT*,
182     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
183            ELSE
184              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
185              PRINT*,
186     &'---> To display the file list, type <esc> then <return>'
187            ENDIF
188            CLOSE(3)
189            GOTO 1001
190          ENDIF
191          NUMNP3 =  IBIDON(1)
192        ELSE
193          OPEN(3,FILE=NOM_ISO(1:LONISO),STATUS='OLD'
194     &          ,FORM='UNFORMATTED',IOSTAT=IERR)
195          IF (IERR.NE.0) THEN
196            IF (ILANG.EQ.0) THEN
197              PRINT*,'---> Mauvais fichier : '//NOM_ISO(1:LONISO)
198              PRINT*,
199     &'---> Pour voir la liste des fichiers, tapez <esc> puis <return>'
200            ELSE
201              PRINT*,'---> Bad file '//NOM_ISO(1:LONISO)
202              PRINT*,
203     &'---> To display the file list, type <esc> then <return>'
204            ENDIF
205            GOTO 1001
206          ENDIF
207          READ(3) NUMNP3
208        ENDIF
209      ENDIF
210      IRC = 0
211      IFISO   = 1
212      LONC2 = LONISO
213      NOM_C2(1:LONC2) = NOM_ISO(1:LONISO)
214C
215      ICENTR = 0
216      IF ((NUMNP2.EQ.NF.AND.NUMNP3.EQ.NF).OR.
217     &    (NUMNP2.EQ.NEL.AND.NUMNP3.EQ.NEL)) THEN
218        ICENTR = 1
219      ELSEIF(MIN(NUMNP2,NUMNP3).LT.NUMNP) THEN
220        IF (ILANG.EQ.0) THEN
221          PRINT*,'*** Fichiers pas compatibles. Il faut',NUMNP,
222     &         ' noeuds et je n''en trouve que',MIN(NUMNP2,NUMNP3)
223        ELSE
224          PRINT*,'*** Non-compatible files. you need',NUMNP,
225     &         ' nodes and I only find',MIN(NUMNP2,NUMNP3)
226        ENDIF
227        GOTO 1000
228      ELSEIF(MAX(NUMNP2,NUMNP3).GT.NUMNP) THEN
229        IF (ILANG.EQ.0) THEN
230          PRINT*,'Bizarre :',NUMNP,' noeuds et'
231     &         ,MAX(NUMNP2,NUMNP3),' valeurs'
232        ELSE
233          PRINT*,'Strange:',NUMNP,' nodes and'
234     &         ,MAX(NUMNP2,NUMNP3),' values'
235        ENDIF
236      ENDIF
237      IF (ICENTR.EQ.0) THEN
238        IF (ILANG.EQ.0) THEN
239          PRINT*,'Les valeurs lues sont prises aux noeuds'
240        ELSE
241          PRINT*,'Node datas'
242        ENDIF
243        IF (ISO.EQ.3) ISO = 1
244        ICENTRISO = 0
245      ELSE
246        IF (ILANG.EQ.0) THEN
247          PRINT*,'Les valeurs lues sont prises aux centres des cellules'
248        ELSE
249          PRINT*,'Piecewise constant datas'
250        ENDIF
251      ENDIF
252      IF (ILANG.EQ.0) THEN
253        PRINT*,'Types de comparaison possibles :'
254        PRINT*,'   0 : Ecart absolu       --> (x1-x2)'
255        PRINT*,'   1 : Ecart relatif      --> (1-x2/x1)'
256        PRINT*,'   2 : abs(Ecart absolu)  --> |x1-x2|'
257        PRINT*,'   3 : abs(Ecart relatif) --> |1-x2/x1|'
258        CALL LIENTIER('Option de comparaison ?',0,IREP)
259      ELSE
260        PRINT*,'Comparison types available:'
261        PRINT*,'   0 : Absolute difference --> (x1-x2)'
262        PRINT*,'   1 : relative difference --> (1-x2/x1)'
263        PRINT*,'   2 : abs(absolute diff)  --> |x1-x2|'
264        PRINT*,'   3 : abs(relative diff)   --> |1-x2/x1|'
265        CALL LIENTIER('Comparison option?',0,IREP)
266      ENDIF
267      IREP = MAX(0,MIN(3,IREP))
268      IF (IREP.EQ.0) THEN
269        IF (ILANG.EQ.0) THEN
270          NOM_ISO = '$Comparaison (abs)'
271          LONISO = 18
272        ELSE
273          NOM_ISO = '$Comparison (abs)'
274          LONISO = 17
275        ENDIF
276      ELSEIF(IREP.EQ.1) THEN
277        IF (ILANG.EQ.0) THEN
278          NOM_ISO = '$Comparaison (rel)'
279          LONISO = 18
280        ELSE
281          NOM_ISO = '$Comparison (rel)'
282          LONISO = 17
283        ENDIF
284      ELSEIF(IREP.EQ.2) THEN
285        IF (ILANG.EQ.0) THEN
286          NOM_ISO = '$abs(Comparaison abs)'
287          LONISO = 21
288        ELSE
289          NOM_ISO = '$abs(Comparison abs)'
290          LONISO = 20
291        ENDIF
292      ELSE
293        IF (ILANG.EQ.0) THEN
294          NOM_ISO = '$abs(Comparaison rel)'
295          LONISO = 21
296        ELSE
297          NOM_ISO = '$abs(Comparison rel)'
298          LONISO = 21
299        ENDIF
300      ENDIF
301C
302      VMIN = BIG
303      VMAX = -BIG
304      IFBIG = 0
305      IF (IARCH1.LT.0) THEN
306        DO I=1,NUMNP2
307          READ(2,*) V1
308          CALL TRONQUE(V1,BIDON(I),IFBIG)
309        ENDDO
310      ELSEIF(IARCH1.EQ.1) THEN
311        CALL litrecbin(2,BIDON,LLL,0)
312      ELSE
313        READ(2) (BIDON(I),I=1,NUMNP2)
314      ENDIF
315      IF (IARCH2.LT.0) THEN
316        DO I=1,NUMNP3
317          READ(3,*) V1
318          CALL TRONQUE(V1,BIDON(I+NUMNP2),IFBIG)
319        ENDDO
320      ELSEIF(IARCH2.EQ.1) THEN
321        CALL litrecbin(3,BIDON(1+NUMNP2),LLL,0)
322      ELSE
323        READ(3) (BIDON(I+NUMNP2),I=1,NUMNP3)
324      ENDIF
325      IF (ICENTR.EQ.0) THEN
326        IF (IREP.EQ.0.OR.IREP.EQ.2) THEN
327          DO I=1,NUMNP
328            VALX(I) = BIDON(I) - BIDON(I+NUMNP2)
329            IF (IREP.EQ.2) VALX(I) = ABS(VALX(I))
330            VMIN = MIN(VMIN,VALX(I))
331            VMAX = MAX(VMAX,VALX(I))
332          ENDDO
333        ELSE
334          DO I=1,NUMNP
335            VM = BIDON(I)
336            IF (VM.NE.0.) THEN
337              VALX(I) = (BIDON(I) - BIDON(I+NUMNP2))/VM
338            ELSE
339              VALX(I) = BIDON(I) - BIDON(I+NUMNP2)
340            ENDIF
341            IF (IREP.NE.1) VALX(I) = ABS(VALX(I))
342            VMIN = MIN(VMIN,VALX(I))
343            VMAX = MAX(VMAX,VALX(I))
344          ENDDO
345        ENDIF
346      ELSE
347        DO I=1,NUMNP
348          ITOUCH(I) = 0
349          VALX(I) = 0.
350        ENDDO
351        VM = 1.
352        IF (NUMNP2.EQ.NF) THEN
353          DO I=1,NF
354            IF (IREP.EQ.1.OR.IREP.EQ.3) VM = BIDON(I)
355            IF (VM.NE.0.) THEN
356              VALF(5,I) = (BIDON(I) - BIDON(I+NUMNP2))/VM
357            ELSE
358              VALF(5,I) = BIDON(I) - BIDON(I+NUMNP2)
359            ENDIF
360            IF (IREP.EQ.2.OR.IREP.EQ.3) VALF(5,I) = ABS(VALF(5,I))
361          ENDDO
362        ELSE
363          IF (NDSEL.EQ.9) THEN
364            J = 1
365            DO I=1,NEL
366              IF (IREP.EQ.1.OR.IREP.EQ.3) VM = BIDON(I)
367              IF (VM.NE.0.) THEN
368                VALF(5,J) = (BIDON(I) - BIDON(I+NUMNP2))/VM
369              ELSE
370                VALF(5,J) = BIDON(I) - BIDON(I+NUMNP2)
371              ENDIF
372              IF (IREP.EQ.2.OR.IREP.EQ.3) VALF(5,J) = ABS(VALF(5,J))
373              VALF(5,J+1) = VALF(5,J)
374              VALF(5,J+2) = VALF(5,J)
375              VALF(5,J+3) = VALF(5,J)
376              J = J+4
377              II = (I-1)*NDSEL
378              DO K=1,NDSEL
379                N = NODEL(II+K)
380                VALX(N) = VALX(N) + VALF(5,J)
381                ITOUCH(N) = ITOUCH(N) + 1
382              ENDDO
383            ENDDO
384          ELSE
385            JJMIN = 1
386            DO I=1,NEL
387              IF (IREP.EQ.1.OR.IREP.EQ.3) VM = BIDON(I)
388              IF (VM.NE.0.) THEN
389                BID = (BIDON(I) - BIDON(I+NUMNP2))/VM
390              ELSE
391                BID = BIDON(I) - BIDON(I+NUMNP2)
392              ENDIF
393              IF (IREP.EQ.2.OR.IREP.EQ.3) BID = ABS(BID)
394              IF (ITAB(I).GT.0) THEN
395                VALF(5,ITAB(I)) = BID
396              ELSEIF(ITAB(I).LT.0) THEN
397                IIII = 0
398                JMIN = JJMIN
399                DO J=JMIN,NF
400                  IF (NNUMFA(J).EQ.I) THEN
401                    IIII = IIII+1
402                    VALF(5,J) = BID
403                    IF (IIII.EQ.-ITAB(I)) GOTO 1111
404                  ENDIF
405                ENDDO
406              ENDIF
407 1111         CONTINUE
408              II = (I-1)*NDSEL
409              DO K=1,NDSEL
410                N = NODEL(II+K)
411                VALX(N) = VALX(N) + BID
412                ITOUCH(N) = ITOUCH(N) + 1
413              ENDDO
414            ENDDO
415          ENDIF
416        ENDIF
417        DO I=1,NF
418          DO K=1,NDS
419            N = NFAC(K,I)
420            VALX(N) = VALX(N) + VALF(5,I)
421            VMIN = MIN(VMIN,VALF(5,I))
422            VMAX = MAX(VMAX,VALF(5,I))
423            ITOUCH(N) = ITOUCH(N) + 1
424          ENDDO
425        ENDDO
426        DO I=1,NUMNP
427          IF (ITOUCH(I).GT.0) VALX(I) = VALX(I)/REAL(ITOUCH(I))
428        ENDDO
429      ENDIF
430      CLOSE(2)
431      CLOSE(3)
432      IF (IFBIG.NE.0) THEN
433        IF (ILANG.EQ.0) THEN
434          PRINT*,IFBIG,' valeurs tronqu�es'
435        ELSE
436          PRINT*,IFBIG,' values truncated'
437        ENDIF
438      ENDIF
439      DO I=1,NF4
440        IF (I.GT.3*NF) THEN
441          VALF(5,I) = VALF(5,I-3*NF)
442        ELSEIF(I.GT.2*NF) THEN
443          VALF(5,I) = VALF(5,I-2*NF)
444        ELSEIF(I.GT.NF) THEN
445          VALF(5,I) = VALF(5,I-NF)
446        ENDIF
447        DO K=1,NDS
448          VALF(K,I) = VALX( NFAC(K,I) )
449        ENDDO
450      ENDDO
451      VMIN0 = VMIN
452      VMAX0 = VMAX
453      CALL METLEGNEW
454      ISOBID = 0
455C
456      END
457