1 : C LIRAVS SOURCE FANDEUR 14/01/08 21:15:08 7902 2 : 3 : SUBROUTINE LIRAVS 4 : 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C 7 : C BUT: Lecture des données provenant de AVS sous forme de 8 : C fichier UCD (Unstructured Cell Data) ASCII. Les données 9 : C sont logées dans une table qui est renvoyée comme 10 : C résultat. 11 : C 12 : C Auteur : Michel Bulik 13 : C Septembre 1994 14 : C 15 : C Appelé par : LIREFI 16 : C 17 : C FA7902 Modifications ordre des noeuds pour TE10 18 : C (2014/01) Ajout lecture commentaires entete du fichier 19 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 20 : 21 : IMPLICIT INTEGER(I-N) 22 : IMPLICIT REAL*8(A-H,O-Z) 23 : 24 : -INC CCOPTIO 25 : -INC CCREDLE 26 : 27 : -INC SMCOORD 28 : -INC SMELEME 29 : -INC SMTABLE 30 : -INC SMCHAML 31 : -INC SMCHPOI 32 : 33 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 34 : 35 : SEGMENT LISTMA 36 : POINTEUR PTMA(NBSZEL).MELEME 37 : INTEGER MATER(NBSZEL) 38 : INTEGER TYPDEL(NBSZEL) 39 : INTEGER NUMEMA(NOMBEL) 40 : INTEGER NUMELE(NOMBEL) 41 : ENDSEGMENT 42 : 43 : C 44 : C Description du segment LISTMA (LISTe des MAillages) 45 : C 46 : C Paramètres : NBSZEL - NomBre de Sous Zones ELémentaires 47 : C NOMBEL - NOMBre total des ELéments 48 : C 49 : C Tableaux : PTMA - PoinTeurs sur des MAillages élémentaires 50 : C MATER - numéros des MATERiaux des sous-zones 51 : C TYPDEL - TYPes Des ELéments des sous-zones (=ITYPEL) 52 : C NUMEMA - NUMEros des MAillages auquels appartiennent 53 : C les éléments (1..NBSZEL) 54 : C NUMELE - le NUMéro de l'ELEment dans sa sous zone 55 : C 56 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 57 : 58 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 59 : 60 : SEGMENT LISTCO 61 : CHARACTER*4 LESNOM(NBCOMP) 62 : REAL*8 LESCOM(NBDELE,NBCOMP) 63 : ENDSEGMENT 64 : 65 : C 66 : C Description du segment LISTCO (LISTe des COmposantes du MCHAML) 67 : C 68 : C Paramètres : NBCOMP - le NomBre des COMPosantes 69 : C NBDELE - le NomBre D'ELEments 70 : C 71 : C Tableaux : LESNOM - LES NOMs des composantes (j'ai mis exprès 4 72 : C et non 8 à cause de problèmes + tard) 73 : C LESCOM - LES COMposantes elles memes 74 : C 75 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 76 : 77 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 78 : 79 : SEGMENT LISGRC 80 : INTEGER LESGRC(NBGRCO) 81 : ENDSEGMENT 82 : 83 : C 84 : C Description du segment LISGRC (LISTe des GRoupes de Composantes) 85 : C 86 : C Paramètres : NBGRCO - le NomBre de GRoupes de COmposantes 87 : C 88 : C Tableaux : LESGRC - LES GRoupes des Composantes 89 : C 90 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 91 : 92 : CHARACTER*8 MTYPEL 93 : C ... Tableau où on stocke temporairement les connectivités lues ... 94 : INTEGER ICONNT(20) 95 : 96 : C ... Conversion MAJUSCULE/minuscule 97 : CHARACTER*26 MINU,MAJU 98 : 99 : C ... Tableaux de conversion de connectivités (IC) ... 100 : DIMENSION ICPOI1( 1) 101 : DIMENSION ICSEG2( 2) 102 : DIMENSION ICSEG3( 3) 103 : DIMENSION ICTRI3( 3) 104 : DIMENSION ICTRI6( 6) 105 : DIMENSION ICQUA4( 4) 106 : DIMENSION ICQUA8( 8) 107 : DIMENSION ICCUB8( 8) 108 : DIMENSION ICCU20(20) 109 : DIMENSION ICPRI6( 6) 110 : DIMENSION ICPR15(15) 111 : DIMENSION ICTET4( 4) 112 : DIMENSION ICTE10(10) 113 : DIMENSION ICPYR5( 5) 114 : DIMENSION ICPY13(13) 115 : 116 : DATA ICPOI1 / 1/ 117 : DATA ICSEG2 / 1, 2/ 118 : DATA ICSEG3 / 1, 3, 2/ 119 : DATA ICTRI3 / 1, 2, 3/ 120 : DATA ICTRI6 / 1, 4, 2, 5, 3, 6/ 121 : DATA ICQUA4 / 1, 2, 3, 4/ 122 : DATA ICQUA8 / 1, 5, 2, 6, 3, 7, 4, 8/ 123 : DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/ 124 : DATA ICCU20 / 1, 9, 2,10, 3,11, 4,12,17,18, 125 : & 19,20, 5,13, 6,14, 7,15, 8,16/ 126 : DATA ICPRI6 / 1, 2, 3, 4, 5, 6/ 127 : DATA ICPR15 / 1, 7, 2, 8, 3, 9,14,13,15, 4, 128 : & 10, 5,11, 6,12/ 129 : DATA ICTET4 / 1, 2, 3, 4/ 130 : DATA ICTE10 / 1, 5, 2, 8, 3, 6, 7,10, 9, 4/ 131 : DATA ICPYR5 / 2, 3, 4, 5, 1/ 132 : DATA ICPY13 / 2,10, 3,11, 4,12, 5,13, 6, 7, 133 : & 8, 9, 1/ 134 : 135 : DATA MINU / 'abcdefghijklmnopqrstuvwxyz' / 136 : DATA MAJU / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' / 137 : 138 : C ... Sauvetage de la lecture ... 138 : call inired(sredle) 139 : 140 : IF(IDIM.EQ.0) IDIM=3 141 : LISTMA=0 142 : 143 : C ... Création de la table de sortie ... 143 : CALL CRTABL(MTABLE) 144 : 145 : C ... Lecture de la première ligne ... 146 : 9010 CONTINUE 147 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 148 : C ... On saute les lignes de commentaires qui n'existent qu'en entete ... 149 : IF (TEXT(1:1).EQ.'#') GOTO 9010 150 : 3000 FORMAT(A256) 151 : CNONF77 READ(LIGNE,*,ERR=9999) NBNPTS,NBELTS,NBCONO,NBCOEL,NBCOGL 152 : NRAN=0 153 : ICOUR=256 154 : IFINAN=257 154 : CALL REDLEC(sredle) 155 : IF(IRE.EQ.1) THEN 156 : NBNPTS=NFIX 157 : ELSE 158 : GOTO 9999 159 : ENDIF 160 : 160 : CALL REDLEC(sredle) 161 : IF(IRE.EQ.1) THEN 162 : NBELTS=NFIX 163 : ELSE 164 : GOTO 9999 165 : ENDIF 166 : 166 : CALL REDLEC(sredle) 167 : IF(IRE.EQ.1) THEN 168 : NBCONO=NFIX 169 : ELSE 170 : GOTO 9999 171 : ENDIF 172 : 172 : CALL REDLEC(sredle) 173 : IF(IRE.EQ.1) THEN 174 : NBCOEL=NFIX 175 : ELSE 176 : GOTO 9999 177 : ENDIF 178 : 178 : CALL REDLEC(sredle) 179 : IF(IRE.EQ.1) THEN 180 : NBCOGL=NFIX 181 : ELSE 182 : GOTO 9999 183 : ENDIF 184 : 185 : CDEBUG write(ioimp,*) 'NBNPTS = ',NBNPTS 186 : CDEBUG write(ioimp,*) 'NBELTS = ',NBELTS 187 : CDEBUG write(ioimp,*) 'NBCONO = ',NBCONO 188 : CDEBUG write(ioimp,*) 'NBCOEL = ',NBCOEL 189 : 190 : C ... Lecture des coordonnées ... 191 : SEGACT MCOORD 192 : NBANC=XCOOR(/1)/(IDIM+1) 193 : NBNOUV=NBANC+NBNPTS 194 : NBPTS=NBNOUV 195 : SEGADJ MCOORD 196 : NDEBB=NBANC+1 197 : NBC=IDIM+1 198 : DO 3020 J=NDEBB,NBNOUV 199 : READ (IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 200 : IF (TEXT(1:1).EQ.'#') GOTO 9999 201 : CMB ... AVS donne toujours 3 coordonnées ... 202 : CNONF77 READ (LIGNE,*,ERR=9999) IKK,(XCOOR((J-1)*NBC+I),I=1,3) 203 : NRAN=0 204 : ICOUR=256 205 : IFINAN=257 205 : CALL REDLEC(sredle) 206 : IF(IRE.EQ.1) THEN 207 : IKK=NFIX 208 : ELSE 209 : GOTO 9999 210 : ENDIF 211 : 212 : DO 3015 I=1,3 212 : CALL REDLEC(sredle) 213 : IF(IRE.EQ.1.OR.IRE.EQ.2) THEN 214 : XCOOR((J-1)*NBC+I)=FLOT 215 : ELSE 216 : GOTO 9999 217 : ENDIF 218 : 3015 CONTINUE 219 : 220 : CMB ... Ici on remet les densités à 0, si IDIM==2, ceci écrasera la troisième 221 : CMB composante lue dans le fichier ... 222 : XCOOR(J*NBC)=0.D0 223 : 3020 CONTINUE 224 : 225 : CDEBUG write(ioimp,*) 'Lecture des noeuds terminée' 226 : 227 : C ... Préparation du support des champs de vitesses (composé des POI1) ... 228 : IPT2=0 229 : NBELEM=NBNPTS 230 : NBNN=1 231 : NBSOUS=0 232 : NBREF=0 233 : SEGINI IPT2 234 : IPT2.ITYPEL=1 235 : DO 3025 I=NBANC+1,NBANC+NBNPTS 236 : IPT2.NUM(1,I-NBANC)=I 237 : c* IPT2.ICOLOR(I-NBANC)=0 238 : 3025 CONTINUE 238 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'MAILSUPP',.FALSE.,0, 239 : & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT2) 240 : SEGDES IPT2 241 : 242 : CDEBUG write(ioimp,*) 'Préparation du support du CHPOINT terminée' 243 : 244 : C ... Lecture du maillage ... 245 : NBSZEL=0 246 : NOMBEL=NBELTS 247 : SEGINI LISTMA 248 : 249 : DO 3030 I=1,NBELTS 250 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 251 : IF (TEXT(1:1).EQ.'#') GOTO 9999 252 : CNONF77 READ(LIGNE,*,ERR=9999) INUMEL,INUMAT,MTYPEL 253 : NRAN=0 254 : ICOUR=256 255 : IFINAN=257 255 : CALL REDLEC(sredle) 256 : IF(IRE.EQ.1) THEN 257 : INUMEL=NFIX 258 : ELSE 259 : GOTO 9999 260 : ENDIF 261 : 261 : CALL REDLEC(sredle) 262 : IF(IRE.EQ.1) THEN 263 : INUMAT=NFIX 264 : ELSE 265 : GOTO 9999 266 : ENDIF 267 : 267 : CALL REDLEC(sredle) 268 : IF(IRE.EQ.3) THEN 269 : DO 3031 IAUX=1, NCAR 270 : IRAL=INDEX(MAJU,MOT(IAUX:IAUX)) 271 : IF (IRAL.NE.0) MOT(IAUX:IAUX)=MINU(IRAL:IRAL) 272 : 3031 CONTINUE 273 : MTYPEL=MOT(1:NCAR) 274 : ELSE 275 : GOTO 9999 276 : ENDIF 277 : 278 : IF (MTYPEL.EQ.'pt ') THEN 279 : 280 : CNONF77 READ(LIGNE,*,END=9999) INUMEL,INUMAT,MTYPEL, 281 : CNONF77 & ICONNT(1) 281 : CALL REDLEC(sredle) 282 : IF(IRE.EQ.1) THEN 283 : ICONNT(1)=NFIX 284 : ELSE 285 : GOTO 9999 286 : ENDIF 287 : 288 : ITELAC=1 288 : CALL EMPELE(I,ITELAC,INUMAT,ICPOI1,LISTMA,ICONNT) 289 : GOTO 3030 290 : 291 : ELSE IF(MTYPEL.EQ.'line ') THEN 292 : 293 : CNONF77 READ(LIGNE,*,END=5299) INUMEL,INUMAT,MTYPEL, 294 : CNONF77 & (ICONNT(J),J=1,3) 295 : 296 : NBENT=0 297 : DO 5250 J=1,3 297 : CALL REDLEC(sredle) 298 : IF(IRE.EQ.1) THEN 299 : ICONNT(J)=NFIX 300 : ELSE 301 : GOTO 5299 302 : ENDIF 303 : NBENT=J 304 : 5250 CONTINUE 305 : 306 : C ... C'est un SEG3 ... 307 : ITELAC=3 307 : CALL EMPELE(I,ITELAC,INUMAT,ICSEG3,LISTMA,ICONNT) 308 : GOTO 3030 309 : C ... C'est un SEG2 ... 310 : 5299 IF(NBENT.NE.2) GOTO 9999 311 : ITELAC=2 311 : CALL EMPELE(I,ITELAC,INUMAT,ICSEG2,LISTMA,ICONNT) 312 : GOTO 3030 313 : 314 : ELSE IF(MTYPEL.EQ.'tri ') THEN 315 : 316 : CNONF77 READ(LIGNE,*,END=5399) INUMEL,INUMAT,MTYPEL, 317 : CNONF77 & (ICONNT(J),J=1,6) 318 : 319 : NBENT=0 320 : DO 5350 J=1,6 320 : CALL REDLEC(sredle) 321 : IF(IRE.EQ.1) THEN 322 : ICONNT(J)=NFIX 323 : ELSE 324 : GOTO 5399 325 : ENDIF 326 : NBENT=J 327 : 5350 CONTINUE 328 : 329 : C ... C'est un TRI6 ... 330 : ITELAC=6 330 : CALL EMPELE(I,ITELAC,INUMAT,ICTRI6,LISTMA,ICONNT) 331 : GOTO 3030 332 : C ... C'est un TRI3 ... 333 : 5399 IF(NBENT.NE.3) GOTO 9999 334 : ITELAC=4 334 : CALL EMPELE(I,ITELAC,INUMAT,ICTRI3,LISTMA,ICONNT) 335 : GOTO 3030 336 : 337 : ELSE IF(MTYPEL.EQ.'quad ') THEN 338 : 339 : CNONF77 READ(LIGNE,*,END=5499) INUMEL,INUMAT,MTYPEL, 340 : CNONF77 & (ICONNT(J),J=1,8) 341 : 342 : NBENT=0 343 : DO 5450 J=1,8 343 : CALL REDLEC(sredle) 344 : IF(IRE.EQ.1) THEN 345 : ICONNT(J)=NFIX 346 : ELSE 347 : GOTO 5499 348 : ENDIF 349 : NBENT=J 350 : 5450 CONTINUE 351 : 352 : C ... C'est un QUA8 ... 353 : ITELAC=10 353 : CALL EMPELE(I,ITELAC,INUMAT,ICQUA8,LISTMA,ICONNT) 354 : GOTO 3030 355 : C ... C'est un QUA4 ... 356 : 5499 IF(NBENT.NE.4) GOTO 9999 357 : ITELAC=8 357 : CALL EMPELE(I,ITELAC,INUMAT,ICQUA4,LISTMA,ICONNT) 358 : GOTO 3030 359 : 360 : ELSE IF(MTYPEL.EQ.'tet ') THEN 361 : 362 : CNONF77 READ(LIGNE,*,END=5599) INUMEL,INUMAT,MTYPEL, 363 : CNONF77 & (ICONNT(J),J=1,10) 364 : 365 : NBENT=0 366 : DO 5550 J=1,10 366 : CALL REDLEC(sredle) 367 : IF(IRE.EQ.1) THEN 368 : ICONNT(J)=NFIX 369 : ELSE 370 : GOTO 5599 371 : ENDIF 372 : NBENT=J 373 : 5550 CONTINUE 374 : 375 : C ... C'est un TE10 ... 376 : ITELAC=24 376 : CALL EMPELE(I,ITELAC,INUMAT,ICTE10,LISTMA,ICONNT) 377 : GOTO 3030 378 : C ... C'est un TET4 ... 379 : 5599 IF(NBENT.NE.4) GOTO 9999 380 : ITELAC=23 380 : CALL EMPELE(I,ITELAC,INUMAT,ICTET4,LISTMA,ICONNT) 381 : GOTO 3030 382 : 383 : ELSE IF(MTYPEL.EQ.'pyr ') THEN 384 : 385 : CNONF77 READ(LIGNE,*,END=5699) INUMEL,INUMAT,MTYPEL, 386 : CNONF77 & (ICONNT(J),J=1,13) 387 : 388 : NBENT=0 389 : DO 5650 J=1,13 389 : CALL REDLEC(sredle) 390 : IF(IRE.EQ.1) THEN 391 : ICONNT(J)=NFIX 392 : ELSE 393 : GOTO 5699 394 : ENDIF 395 : NBENT=J 396 : 5650 CONTINUE 397 : 398 : C ... C'est un PY13 ... 399 : ITELAC=26 399 : CALL EMPELE(I,ITELAC,INUMAT,ICPY13,LISTMA,ICONNT) 400 : GOTO 3030 401 : C ... C'est un PYR5 ... 402 : 5699 IF(NBENT.NE.5) GOTO 9999 403 : ITELAC=25 403 : CALL EMPELE(I,ITELAC,INUMAT,ICPYR5,LISTMA,ICONNT) 404 : GOTO 3030 405 : 406 : ELSE IF(MTYPEL.EQ.'prism ') THEN 407 : 408 : CNONF77 READ(LIGNE,*,END=5799) INUMEL,INUMAT,MTYPEL, 409 : CNONF77 & (ICONNT(J),J=1,15) 410 : 411 : NBENT=0 412 : DO 5750 J=1,15 412 : CALL REDLEC(sredle) 413 : IF(IRE.EQ.1) THEN 414 : ICONNT(J)=NFIX 415 : ELSE 416 : GOTO 5799 417 : ENDIF 418 : NBENT=J 419 : 5750 CONTINUE 420 : 421 : C ... C'est un PR15 ... 422 : ITELAC=17 422 : CALL EMPELE(I,ITELAC,INUMAT,ICPR15,LISTMA,ICONNT) 423 : GOTO 3030 424 : C ... C'est un PRI6 ... 425 : 5799 IF(NBENT.NE.6) GOTO 9999 426 : ITELAC=16 426 : CALL EMPELE(I,ITELAC,INUMAT,ICPRI6,LISTMA,ICONNT) 427 : GOTO 3030 428 : 429 : ELSE IF(MTYPEL.EQ.'hex ') THEN 430 : 431 : CNONF77 READ(LIGNE,*,END=5899) INUMEL,INUMAT,MTYPEL, 432 : CNONF77 & (ICONNT(J),J=1,20) 433 : 434 : NBENT=0 435 : DO 5850 J=1,20 435 : CALL REDLEC(sredle) 436 : IF(IRE.EQ.1) THEN 437 : ICONNT(J)=NFIX 438 : ELSE 439 : GOTO 5899 440 : ENDIF 441 : NBENT=J 442 : 5850 CONTINUE 443 : 444 : C ... C'est un CU20 ... 445 : ITELAC=15 445 : CALL EMPELE(I,ITELAC,INUMAT,ICCU20,LISTMA,ICONNT) 446 : GOTO 3030 447 : C ... C'est un CUB8 ... 448 : 5899 IF(NBENT.NE.8) GOTO 9999 449 : ITELAC=14 449 : CALL EMPELE(I,ITELAC,INUMAT,ICCUB8,LISTMA,ICONNT) 450 : GOTO 3030 451 : 452 : ELSE 453 : 454 : MOTERR(1:8)=MTYPEL 454 : CALL ERREUR(702) 455 : GOTO 9000 456 : 457 : ENDIF 458 : 3030 CONTINUE 459 : 460 : NBSZEL = LISTMA.MATER(/1) 461 : 462 : CDEBUG WRITE(IOIMP,*) 'Maillage lu' 463 : CDEBUG WRITE(IOIMP,*) ' NBSZEL = ',NBSZEL 464 : 465 : C ... On décale les connectivités ... 466 : DO 3035 K=1,NBSZEL 467 : IPT5=LISTMA.PTMA(K) 468 : SEGACT IPT5*MOD 469 : NBNN=IPT5.NUM(/1) 470 : NBELEM=IPT5.NUM(/2) 471 : DO 3036 I=1,NBNN 472 : DO 3036 J=1,NBELEM 473 : IPT5.NUM(I,J)=IPT5.NUM(I,J)+NBANC 474 : 3036 CONTINUE 475 : SEGDES IPT5 476 : 3035 CONTINUE 477 : 478 : CDEBUG WRITE(IOIMP,*) 'Connectivités décalées' 479 : 480 : C ... Création du chapeau des sous-maillages ... 481 : IF (NBSZEL.EQ.1) THEN 482 : MELEME = LISTMA.PTMA(1) 483 : ELSE 484 : MELEME=0 485 : NBELEM=0 486 : NBNN=0 487 : NBSOUS=NBSZEL 488 : NBREF=1 489 : SEGINI MELEME 490 : ITYPEL=0 491 : LISREF(1)=IPT2 492 : DO 3032 I=1,NBSZEL 493 : LISOUS(I)=LISTMA.PTMA(I) 494 : 3032 CONTINUE 495 : SEGDES MELEME 496 : ENDIF 497 : 498 : CDEBUG WRITE(IOIMP,*) 'Chapeau des maillages créé' 499 : 499 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LEMAILLA',.FALSE.,0, 500 : & 'MAILLAGE',0,0.d0,' ',.FALSE.,MELEME) 501 : 502 : C ... On met les sous maillages dans une sous table indicée par leur numéros ... 502 : CALL CRTABL(MTAB1) 502 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'SOUMAILA',.FALSE.,0, 503 : & 'TABLE ',0,0.d0,' ',.FALSE.,MTAB1) 504 : DO 3033 I=1,NBSZEL 505 : IPT8=LISTMA.PTMA(I) 505 : CALL ECCTAB(MTAB1,'ENTIER ',I,0.d0,' ',.FALSE.,0, 506 : & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT8) 507 : 3033 CONTINUE 508 : 509 : CDEBUG WRITE(IOIMP,*) 'Maillages mis dans la table' 510 : 511 : C ... Lecture du CHPOINT ... 512 : 513 : IF(NBCONO.GT.0) THEN 514 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 515 : IF (TEXT(1:1).EQ.'#') GOTO 9999 516 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO 517 : NRAN=0 518 : ICOUR=256 519 : IFINAN=257 519 : CALL REDLEC(sredle) 520 : IF(IRE.EQ.1) THEN 521 : NBGRCO=NFIX 522 : ELSE 523 : GOTO 9999 524 : ENDIF 525 : SEGINI LISGRC 526 : 527 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO) 528 : DO 3034 I=1,NBGRCO 528 : CALL REDLEC(sredle) 529 : IF(IRE.EQ.1) THEN 530 : LESGRC(I)=NFIX 531 : ELSE 532 : GOTO 9999 533 : ENDIF 534 : 3034 CONTINUE 535 : 536 : CDEBUG write(IOIMP,*) NBGRCO,(LESGRC(I),I=1,NBGRCO) 537 : 538 : NAT=1 539 : NSOUPO=1 540 : MCHPOI=0 541 : SEGINI MCHPOI 542 : MTYPOI=' ' 543 : MOCHDE=' ' 544 : & //' ' 545 : JATTRI(1)=1 546 : IFOPOI=IFOUR 547 : NC=NBCONO 548 : SEGINI MSOUPO 549 : IPCHP(1)=MSOUPO 550 : K = 0 551 : DO 3079 I=1,NBGRCO 552 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 553 : IF (TEXT(1:1).EQ.'#') GOTO 9999 554 : DO 3077 J=1,LESGRC(I) 555 : K = K + 1 556 : CNONF77 READ(LIGNE,*,END=3076) NOCOMP(K) 557 : CNONF77 3076 CONTINUE 558 : NRAN=0 559 : ICOUR=256 560 : IFINAN=257 560 : CALL REDLEC(sredle) 561 : IF(IRE.EQ.3) THEN 562 : NOCOMP(K)=MOT(1:NCAR) 563 : CDEBUG write(ioimp,*) 'Composante N° ',J,' = ',NOCOMP(K) 564 : ELSE 565 : GOTO 9999 566 : ENDIF 567 : C ... Attention à la virgule qui n'est pas considérée comme un 568 : C séparateur par REDLEC ... 569 : DO 3075 INUMC=1,4 570 : IF(NOCOMP(K)(INUMC:INUMC).EQ.',') THEN 571 : NOCOMP(K)(INUMC:4)=' ' 572 : GOTO 3076 573 : ENDIF 574 : 3075 CONTINUE 575 : 3076 CONTINUE 576 : IF(LESGRC(I).GT.1) THEN 577 : IKK=LEN(NOCOMP(K)) 577 : CALL AJNUME(NOCOMP(K),IKK,J) 578 : ENDIF 579 : 3077 CONTINUE 580 : C ... Attention !!! Les noms des composantes des champs scalaires risquent de ne pas etre uniques 581 : C si la différence se trouve au délà du 4ème caractère !!! ... 582 : 3079 CONTINUE 583 : SEGSUP LISGRC 584 : IGEOC=IPT2 585 : DO 3080 I=1,NC 586 : NOHARM(I)=0 587 : 3080 CONTINUE 588 : N=NBNPTS 589 : SEGINI MPOVAL 590 : IPOVAL=MPOVAL 591 : DO 3090 I=1,N 592 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 593 : IF (TEXT(1:1).EQ.'#') GOTO 9999 594 : CDEBUG write(ioimp,*) 'Ligne avec les composantes N°',I,' lue' 595 : CNONF77 READ(LIGNE,*,ERR=9999) IKK,(VPOCHA(I,J),J=1,NC) 596 : NRAN=0 597 : ICOUR=256 598 : IFINAN=257 598 : CALL REDLEC(sredle) 599 : IF(IRE.EQ.1) THEN 600 : IKK=NFIX 601 : ELSE 602 : GOTO 9999 603 : ENDIF 604 : DO 30901 J=1,NC 604 : CALL REDLEC(sredle) 605 : IF(IRE.EQ.1.OR.IRE.EQ.2) THEN 606 : VPOCHA(I,J)=FLOT 607 : ELSE 608 : GOTO 9999 609 : ENDIF 610 : 30901 CONTINUE 611 : 3090 CONTINUE 611 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LECHPOIN',.FALSE.,0, 612 : & 'CHPOINT ',0,0.d0,' ',.FALSE.,MCHPOI) 613 : SEGDES MPOVAL 614 : SEGDES MSOUPO 615 : SEGDES MCHPOI 616 : ENDIF 617 : 618 : CDEBUG WRITE(IOIMP,*) 'CHPOINT lu' 619 : 620 : C ... Lecture du champ par élément à NBCOEL composantes ... 621 : 622 : IF(NBCOEL.GT.0) THEN 623 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 624 : IF (TEXT(1:1).EQ.'#') GOTO 9999 625 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO 626 : NRAN=0 627 : ICOUR=256 628 : IFINAN=257 628 : CALL REDLEC(sredle) 629 : IF(IRE.EQ.1) THEN 630 : NBGRCO=NFIX 631 : ELSE 632 : GOTO 9999 633 : ENDIF 634 : SEGINI LISGRC 635 : 636 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO) 637 : DO 3091 I=1,NBGRCO 637 : CALL REDLEC(sredle) 638 : IF(IRE.EQ.1) THEN 639 : LESGRC(I)=NFIX 640 : ELSE 641 : GOTO 9999 642 : ENDIF 643 : 3091 CONTINUE 644 : 645 : C ... On lit les noms et les valeurs des composantes ... 646 : NBCOMP=NBCOEL 647 : NBDELE=NBELTS 648 : SEGINI LISTCO 649 : K = 0 650 : DO 3038 I=1,NBGRCO 651 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 652 : IF (TEXT(1:1).EQ.'#') GOTO 9999 653 : DO 3037 J=1,LESGRC(I) 654 : K = K + 1 655 : CNONF77 READ(LIGNE,*,END=3099) LESNOM(K) 656 : CNONF77 3099 CONTINUE 657 : NRAN=0 658 : ICOUR=256 659 : IFINAN=257 659 : CALL REDLEC(sredle) 660 : IF(IRE.EQ.3) THEN 661 : LESNOM(K)=MOT(1:NCAR) 662 : ELSE 663 : GOTO 9999 664 : ENDIF 665 : C ... Attention à la virgule qui n'est pas considérée comme un 666 : C séparateur par REDLEC ... 667 : DO 3092 INUMC=1,MIN(4,NCAR) 668 : IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN 669 : LESNOM(K)(INUMC:MIN(4,NCAR))=' ' 670 : GOTO 3093 671 : ENDIF 672 : 3092 CONTINUE 673 : 3093 CONTINUE 674 : IF(LESGRC(I).GT.1) THEN 675 : IKK=LEN(LESNOM(K)) 675 : CALL AJNUME(LESNOM(K),IKK,J) 676 : ENDIF 677 : 3037 CONTINUE 678 : 3038 CONTINUE 679 : SEGSUP LISGRC 680 : DO 3039 I=1,NBELTS 681 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 682 : IF (TEXT(1:1).EQ.'#') GOTO 9999 683 : CNONF77 READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL) 684 : NRAN=0 685 : ICOUR=256 686 : IFINAN=257 686 : CALL REDLEC(sredle) 687 : IF(IRE.EQ.1) THEN 688 : IKK=NFIX 689 : ELSE 690 : GOTO 9999 691 : ENDIF 692 : DO 30391 J=1,NBCOEL 692 : CALL REDLEC(sredle) 693 : IF(IRE.EQ.1.OR.IRE.EQ.2) THEN 694 : LESCOM(I,J)=FLOT 695 : ELSE 696 : GOTO 9999 697 : ENDIF 698 : 30391 CONTINUE 699 : 3039 CONTINUE 700 : 701 : C ... On prépare la structure des données ... 702 : MCHELM=0 703 : L1=16 704 : N1=NBSZEL 705 : N3=6 706 : SEGINI MCHELM 707 : TITCHE='CARACTERISTIQUES' 708 : IFOCHE=IFOUR 709 : DO 3040 I=1,N1 710 : CONCHE(I)=' ' 711 : IMACHE(I)=LISTMA.PTMA(I) 712 : INFCHE(I,1)=0 713 : INFCHE(I,2)=0 714 : INFCHE(I,3)=0 715 : INFCHE(I,4)=0 716 : INFCHE(I,5)=0 717 : INFCHE(I,6)=2 718 : MCHAML=0 719 : N2=NBCOEL 720 : SEGINI MCHAML 721 : ICHAML(I)=MCHAML 722 : DO 3041 J=1,N2 723 : NOMCHE(J)=LESNOM(J) 724 : TYPCHE(J)='REAL*8 ' 725 : MELVAL=0 726 : N1PTEL=1 727 : IPT9=LISTMA.PTMA(I) 728 : SEGACT IPT9 729 : N1EL=IPT9.NUM(/2) 730 : SEGDES IPT9 731 : N2PTEL=0 732 : N2EL=0 733 : SEGINI MELVAL 734 : IELVAL(J)=MELVAL 735 : 3041 CONTINUE 736 : 3040 CONTINUE 737 : C ... On n'a pas désactivé de segments MCHAML et MELVAL, ce sera fait + tard ... 738 : 739 : C ... Le transfert du LESCOM aux VELCHE correspondants ... 740 : DO 3045 I=1,NBCOEL 741 : DO 3045 J=1,NBELTS 742 : IKK=LISTMA.NUMEMA(J) 743 : MCHAM1=ICHAML(IKK) 744 : MELVA1=MCHAM1.IELVAL(I) 745 : MELVA1.VELCHE(1,LISTMA.NUMELE(J))=LESCOM(J,I) 746 : 3045 CONTINUE 747 : 747 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,'LEMCHAML',.FALSE.,0, 748 : & 'MCHAML ',0,0.d0,' ',.FALSE.,MCHELM) 749 : 750 : C ... A la fin on désactive le MCHAML avec les dépendances ... 751 : DO 3046 I=1,NBSZEL 752 : MCHAM1=ICHAML(I) 753 : DO 3047 J=1,NBCOEL 754 : MELVA1=MCHAM1.IELVAL(J) 755 : SEGDES MELVA1 756 : 3047 CONTINUE 757 : SEGDES MCHAM1 758 : 3046 CONTINUE 759 : SEGDES MCHELM 760 : SEGSUP LISTCO 761 : ENDIF 762 : 763 : CDEBUG WRITE(IOIMP,*) 'MCHAML lu' 764 : 765 : C ... Lecture des composantes globales ... 766 : 767 : IF(NBCOGL.GT.0) THEN 768 : 769 : C ... Le nombre de groupes de composantes ... 770 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 771 : IF (TEXT(1:1).EQ.'#') GOTO 9999 772 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO 773 : NRAN=0 774 : ICOUR=256 775 : IFINAN=257 775 : CALL REDLEC(sredle) 776 : IF(IRE.EQ.1) THEN 777 : NBGRCO=NFIX 778 : ELSE 779 : GOTO 9999 780 : ENDIF 781 : C ... permet d'initialiser LISGRC ... 782 : SEGINI LISGRC 783 : 784 : C ... que l'on remplit par la suite ... 785 : CNONF77 READ(LIGNE,*,ERR=9999) NBGRCO,(LESGRC(I),I=1,NBGRCO) 786 : DO 3191 I=1,NBGRCO 786 : CALL REDLEC(sredle) 787 : IF(IRE.EQ.1) THEN 788 : LESGRC(I)=NFIX 789 : ELSE 790 : GOTO 9999 791 : ENDIF 792 : 3191 CONTINUE 793 : 794 : C ... ensuite on lit les noms des composantes ... 795 : NBCOMP=NBCOGL 796 : NBDELE=1 797 : SEGINI LISTCO 798 : K = 0 799 : DO 3138 I=1,NBGRCO 800 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 801 : IF (TEXT(1:1).EQ.'#') GOTO 9999 802 : DO 3137 J=1,LESGRC(I) 803 : K = K + 1 804 : CNONF77 READ(LIGNE,*,END=3099) LESNOM(K) 805 : CNONF77 3099 CONTINUE 806 : NRAN=0 807 : ICOUR=256 808 : IFINAN=257 808 : CALL REDLEC(sredle) 809 : IF(IRE.EQ.3) THEN 810 : LESNOM(K)=MOT(1:NCAR) 811 : ELSE 812 : GOTO 9999 813 : ENDIF 814 : C ... Attention à la virgule qui n'est pas considérée comme un 815 : C séparateur par REDLEC ... 816 : DO 3192 INUMC=1,MIN(4,NCAR) 817 : IF(LESNOM(K)(INUMC:INUMC).EQ.',') THEN 818 : LESNOM(K)(INUMC:MIN(4,NCAR))=' ' 819 : GOTO 3193 820 : ENDIF 821 : 3192 CONTINUE 822 : 3193 CONTINUE 823 : C ... en leur ajoutant (si besoin est) leur N° dans le groupe ... 824 : IF(LESGRC(I).GT.1) THEN 825 : IKK=LEN(LESNOM(K)) 825 : CALL AJNUME(LESNOM(K),IKK,J) 826 : ENDIF 827 : 3137 CONTINUE 828 : 3138 CONTINUE 829 : SEGSUP LISGRC 830 : 831 : C ... Puis, on on lit les composantes elles-mêmes ... 832 : READ(IOCAR,3000,ERR=9999,END=9999) TEXT(1:256) 833 : IF (TEXT(1:1).EQ.'#') GOTO 9999 834 : CNONF77 READ(LIGNE,*,END=9999) IKK,(LESCOM(I,J),J=1,NBCOEL) 835 : NRAN=0 836 : ICOUR=256 837 : IFINAN=257 837 : CALL REDLEC(sredle) 838 : IF(IRE.EQ.1) THEN 839 : IKK=NFIX 840 : ELSE 841 : GOTO 9999 842 : ENDIF 843 : DO 31391 J=1,NBCOGL 843 : CALL REDLEC(sredle) 844 : IF(IRE.EQ.1.OR.IRE.EQ.2) THEN 845 : LESCOM(1,J)=FLOT 846 : ELSE 847 : GOTO 9999 848 : ENDIF 849 : 31391 CONTINUE 850 : 851 : C ... À la fin on les met dans la table ... 852 : DO 31392 J=1,NBCOGL 853 : MTYPEL(1:4) = LESNOM(J) 854 : VALFLO = LESCOM(1,J) 854 : CALL ECCTAB(MTABLE, 855 : & 'MOT ',0, 0.d0,MTYPEL(1:4),.FALSE.,0, 856 : & 'FLOTTANT',0,VALFLO, ' ',.FALSE.,0) 857 : 31392 CONTINUE 858 : SEGSUP LISTCO 859 : 860 : ENDIF 861 : 862 : C ... Sortie de la table ... 862 : CALL ECROBJ('TABLE ',MTABLE) 863 : SEGDES MTABLE 864 : 865 : C ... Fin du traitement du fichier AVS ... 866 : GOTO 9000 867 : 868 : 9999 CONTINUE 868 : CALL ERREUR(703) 869 : 870 : 9000 CONTINUE 871 : IF(LISTMA.NE.0) THEN 872 : SEGSUP LISTMA 873 : ENDIF 874 : segsup sredle 875 : 876 : RETURN 877 : END 878 : 879 :
© Cast3M 2003 - All rights reserved.
Disclaimer