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