1 : C LIRUNV SOURCE FANDEUR 11/08/10 21:15:18 7075 2 : 3 : C======================================================================= 4 : C Appele par : LIREFI 5 : C======================================================================= 6 : 7 : SUBROUTINE LIRUNV 8 : 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : 12 : -INC CCOPTIO 13 : -INC CCREDLE 14 : -INC CCGEOME 15 : 16 : -INC SMCOORD 17 : -INC SMELEME 18 : -INC SMLENTI 19 : SEGMENT MLINOE.MLENTI,MLINO2.MLENTI,MLIEL2.MLENTI 20 : -INC SMTABLE 21 : 22 : C= Nombre de caracteres sur une ligne lue (cf. etiquette 1000) 23 : PARAMETER (NCARMAX = 80 , NCARFIN = NCARMAX+1) 24 : C= Unite logique du fichier d'impression au format UNV I-Deas/NX(TM) 25 : PARAMETER (IUUNV=67) 26 : CHARACTER*256 FicUnv 27 : 28 : PARAMETER (INCJG = 10000) 29 : 30 : PARAMETER (NEFUNV=86, NEFBIM=8, NEFPOI=1) 31 : INTEGER LEFUNV(NEFUNV), LEFGEO(NEFUNV), 32 : & LEFBIM(NEFBIM), LEFPOI(NEFPOI) 33 : DATA LEFUNV / 11, 21, 22, 23, 24, 31, 32, 41, 42, 43, 34 : & 44, 45, 46, 51, 52, 53, 54, 55, 56, 61, 35 : & 62, 63, 64, 65, 66, 71, 72, 73, 74, 75, 36 : & 76, 81, 82, 84, 85, 91, 92, 93, 94, 95, 37 : & 96, 101, 102, 103, 104, 105, 106, 111, 112, 113, 38 : & 114, 115, 116, 117, 118, 121, 122, 136, 137, 138, 39 : & 139, 141, 142, 151, 152, 161, 171, 172, 181, 191, 40 : & 192, 193, 194, 195, 196, 201, 202, 203, 204, 208, 41 : & 212, 213, 221, 222, 231, 232 / 42 : DATA LEFGEO / 2, 2, 2, 0, 3, 0, 0, 4, 6, 0, 43 : & 8, 10, 0, 4, 6, 0, 8, 10, 0, 4, 44 : & 6, 0, 8, 10, 0, 8, 6, 0, 4, 10, 45 : & 0, 4, 6, 8, 10, 4, 6, 0, 8, 10, 46 : & 0, 16, 17, 0, 14, 15, 0, 23, 16, 17, 47 : & 0, 14, 15, 0, 24, 2, 0, 0, 0, 0, 48 : & 0, 0, 0, 0, 0, 1, 2, 3, 0, 0, 49 : & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50 : & 0, 0, 0, 0, 0, 0 / 51 : DATA LEFBIM / 11, 21, 22, 23, 24, 31, 32, 121 / 52 : DATA LEFPOI / 161 / 53 : 54 : SEGMENT MLIELT 55 : INTEGER IELEM(JGEL,4) 56 : ENDSEGMENT 57 : 58 : SEGMENT MLISEF 59 : INTEGER ITYPE(JGEF,5) 60 : ENDSEGMENT 61 : 62 : SEGMENT MLIMAI 63 : POINTEUR PTMAI(JGMAI).MELEME 64 : INTEGER TYMAI(JGMAI) 65 : ENDSEGMENT 66 : 67 : SEGMENT MLIPHY 68 : INTEGER NUMPHY(JGPHY) 69 : CHARACTER*40 NOMPHY(JGPHY) 70 : POINTEUR PTPHY(JGPHY).MELEME 71 : ENDSEGMENT 72 : 73 : SEGMENT MLIPEG 74 : INTEGER NUMPEG(JGPEG,4) 75 : CHARACTER*40 NOMPEG(JGPEG) 76 : POINTEUR PTPEG(JGPEG).MELEME 77 : ENDSEGMENT 78 : 79 : EXTERNAL LONG 80 : 81 : CHARACTER*8 mot_z 82 : CHARACTER*40 nom_z 83 : LOGICAL b_z 84 : 85 : C... Format de lecture 86 : 1000 FORMAT(A80) 87 : C* 1003 FORMAT(2x,d23.16,2x,d23.16,2x,d23.16) 88 : C* 1004 FORMAT(2x,i8) 89 : C* 1005 FORMAT(4x,a2) 90 : C* 1010 FORMAT(8(i10)) 91 : 92 : C... Lecture des arguments (obligatoires) 93 : C= Lecture du nom du fichier de donnees au format UNV de I-Deas/NX(TM) 93 : CALL LIRCHA(FicUnv,1,IRETOU) 94 : IF (IERR.NE.0) RETURN 95 : 96 : C... Initialisation de la table de sortie 96 : CALL CRTABL(MATAB) 97 : i_z = 0 98 : r_z = 0. 99 : b_z = .FALSE. 100 : mot_z = ' ' 101 : nom_z = ' ' 102 : C... Segment de lecture d'une ligne ... 103 : SEGINI,sredle 104 : SEPARA=.FALSE. 105 : MOT=' ' 106 : NRAN=0 107 : ICOUR=0 108 : C... Changement de dimension (si necessaire) 109 : iOK=0 110 : IDIMI=IDIM 111 : IDIMF=3 112 : C* SEGACT,MCOORD*MOD 113 : NBANC=XCOOR(/1)/(IDIMI+1) 114 : IF (IDIMF.NE.IDIMI) THEN 114 : CALL ECRENT(IDIMF) 114 : CALL ECRCHA('DIME') 114 : CALL OPTION(1) 115 : IF (IERR.NE.0) GOTO 990 116 : WRITE(IOIMP,*) 117 : WRITE(IOIMP,*) 'Passage en DIMEsion 3' 118 : ENDIF 119 : idimp1=IDIM+1 120 : C... Par defaut, on affiche erreur Cast3m numero 424 121 : iOK=424 122 : l=LONG(FicUnv) 123 : MOTERR(1:l)=FicUnv(1:l) 124 : INTERR(1)=0 125 : CLOSE(UNIT=IUUNV,ERR=990) 126 : WRITE(IOIMP,*) 127 : WRITE(IOIMP,*) 'Ouverture du fichier I-Deas/NX (TM)' 128 : OPEN(UNIT=IUUNV,STATUS='OLD',FILE=FicUnv(1:l), 129 : & IOSTAT=IOS,FORM='FORMATTED') 130 : C... Traitement des erreurs d ouverture des fichiers 131 : IF (IOS.NE.0) THEN 132 : iOK=599 133 : INTERR(1)=IOS 134 : GOTO 990 135 : ENDIF 136 : C... Quelques initialisations 137 : NBNPTS=0 138 : NBELTS=0 139 : NBEFLU=0 140 : NBMAIS=0 141 : NBPHYS=0 142 : NBPEGR=0 143 : MLINOE=0 144 : MLINO2=0 145 : MLIELT=0 146 : MLIEL2=0 147 : MLISEF=0 148 : MLIMAI=0 149 : MLIPHY=0 150 : MLIPEG=0 151 : 152 : C... Lecture des lignes du fichier ... 153 : I_BLOC=0 154 : C... Recherche de l'indicateur "-1" en debut de bloc 155 : WRITE(IOIMP,*) 156 : WRITE(IOIMP,*) 'LECTURE DES DATASET' 157 : 10 CONTINUE 158 : READ(IUUNV,1000,ERR=991,END=100) TEXT 159 : NRAN=0 160 : ICOUR=NCARMAX 161 : IFINAN=NCARFIN 161 : CALL REDLEC(sredle) 162 : IF (IRE.NE.1) GOTO 10 163 : IF (NFIX.NE.-1) GOTO 10 164 : I_BLOC=1-I_BLOC 165 : IF (I_BLOC.EQ.0) GOTO 10 166 : C... Lecture de la cle 167 : READ(IUUNV,1000,ERR=991,END=100) TEXT 168 : NRAN=0 169 : ICOUR=NCARMAX 170 : IFINAN=NCARFIN 170 : CALL REDLEC(sredle) 171 : IF (IRE.NE.1) THEN 172 : WRITE(IOIMP,*) 'ERREUR : Numero du DATASET non trouve' 173 : iOK=21 174 : GOTO 991 175 : ENDIF 176 : IF (NFIX.EQ. 151) GOTO 151 177 : IF (NFIX.EQ. 164) GOTO 164 178 : IF (NFIX.EQ.2411) GOTO 2411 179 : IF (NFIX.EQ.2412) GOTO 2412 180 : IF (NFIX.EQ.2470) GOTO 2470 181 : IF (NFIX.EQ.2477) GOTO 2477 182 : WRITE(IOIMP,*) 'ATTENTION : DATASET ',NFIX,' ignore' 183 : GOTO 10 184 : 185 : C... Lecture de l'entete 186 : 151 CONTINUE 187 : WRITE(IOIMP,*) '-> LECTURE du DATASET 151' 188 : DO i = 1, 7 189 : READ(IUUNV,1000,ERR=991,END=991) TEXT 190 : IF (i.EQ.3) THEN 191 : * WRITE(IOIMP,*) 'TEXT(1:LONG(TEXT)) 192 : ELSE IF (i.EQ.6) THEN 193 : WRITE(IOIMP,*) ' Programme = ',TEXT(1:LONG(TEXT)) 194 : ENDIF 195 : ENDDO 196 : C... Fin du bloc 197 : READ(IUUNV,1000,ERR=991,END=991) TEXT 198 : I_BLOC=1-I_BLOC 199 : WRITE(IOIMP,*) '<- Lecture du DATASET 151 terminee' 200 : GOTO 10 201 : 202 : C... Lecture de l'entete 203 : 164 CONTINUE 204 : WRITE(IOIMP,*) '-> LECTURE du DATASET 164' 205 : C* READ(IUUNV,1000,ERR=991,END=991) TEXT 206 : READ(IUUNV,1640,ERR=991,END=991) i,TEXT,i 207 : 1640 FORMAT(I10,A20,I10) 208 : WRITE(IOIMP,*) ' Systeme d unite utilise = ',TEXT(1:LONG(TEXT)) 209 : C* WRITE(IOIMP,*) ' Facteurs de conversion d unite' 210 : NBVPR = 4 211 : NBLIG = 0 212 : DO i=1, NBVPR 213 : IF (NBLIG.EQ.3) NBLIG = 0 214 : NBLIG = NBLIG + 1 215 : IF (NBLIG.EQ.1) THEN 216 : READ(IUUNV,1000,ERR=991,END=991) TEXT 217 : C* NRAN=0 218 : C* ICOUR=NCARMAX 219 : C* IFINAN=NCARFIN 220 : ENDIF 220 : C* CALL REDLEC(sredle) 221 : ENDDO 222 : C... Fin du bloc 223 : READ(IUUNV,1000,ERR=991,END=991) TEXT 224 : I_BLOC=1-I_BLOC 225 : WRITE(IOIMP,*) '<- Lecture du DATASET 164 terminee' 226 : GOTO 10 227 : 228 : C Lecture des noeuds : numero, coordonnees (densite mise a zero) 229 : 2411 CONTINUE 230 : WRITE(IOIMP,*) '-> LECTURE du DATASET 2411' 231 : JG=INCJG 232 : SEGINI,MLINOE 233 : NBPTS=NBANC+JG 234 : SEGADJ,MCOORD 235 : NUMIN=100000000 236 : NUMAX=0 237 : 12411 CONTINUE 238 : C... Lecture des informations liees au noeud (RECORD 1) 239 : READ(IUUNV,1000,ERR=991,END=991) TEXT 240 : NRAN=0 241 : ICOUR=NCARMAX 242 : IFINAN=NCARFIN 242 : CALL REDLEC(sredle) 243 : IF (IRE.NE.1) THEN 244 : iOK=8 245 : GOTO 991 246 : ENDIF 247 : C. Fin du bloc ? 248 : IF (NFIX.EQ.-1) GOTO 22411 249 : IF (NFIX.EQ.0) THEN 250 : iOK=8 251 : GOTO 991 252 : ENDIF 253 : NBNPTS=NBNPTS+1 254 : IF (NBNPTS.GT.JG) THEN 255 : JG=JG+INCJG 256 : SEGADJ,MLINOE 257 : NBPTS=NBANC+JG 258 : SEGADJ,MCOORD 259 : ENDIF 260 : MLINOE.LECT(NBNPTS)=NFIX 261 : NUMIN=MIN(NUMIN,NFIX) 262 : NUMAX=MAX(NUMAX,NFIX) 263 : C... Lecture des coordonnees (RECORD 2) 264 : READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT 265 : NRAN=0 266 : ICOUR=NCARMAX 267 : IFINAN=NCARFIN 268 : j=(NBANC+NBNPTS-1)*idimp1 269 : DO k=1,IDIMF 269 : CALL REDLEC(sredle) 270 : IF (IRE.NE.1.AND.IRE.NE.2) THEN 271 : iOK=661 272 : GOTO 991 273 : ENDIF 274 : IF (IRE.EQ.1) THEN 275 : XCOOR(j+k)=NFIX 276 : ELSE 277 : XCOOR(j+k)=FLOT 278 : ENDIF 279 : ENDDO 280 : XCOOR(j+idimp1)=0. 281 : GOTO 12411 282 : C... Fin du bloc 283 : 22411 CONTINUE 284 : WRITE(IOIMP,*) ' Nombre de noeuds lus :',NBNPTS 285 : WRITE(IOIMP,*) ' Numero du noeud min. :',NUMIN 286 : WRITE(IOIMP,*) ' Numero du noeud max. :',NUMAX 287 : IF (NBNPTS.NE.JG) THEN 288 : JG=NBNPTS 289 : SEGADJ,MLINOE 290 : NBPTS=NBANC+JG 291 : SEGADJ,MCOORD 292 : ENDIF 293 : I_BLOC=1-I_BLOC 294 : WRITE(IOIMP,*) '<- Lecture du DATASET 2411 terminee' 295 : GOTO 10 296 : 297 : C... Lecture des elements 298 : 2412 CONTINUE 299 : WRITE(IOIMP,*) '-> LECTURE du DATASET 2412' 300 : JGEF = 50 301 : SEGINI,MLISEF 302 : JGEL = INCJG 303 : SEGINI,MLIELT 304 : NUMIN = 100000000 305 : NUMAX = 0 306 : 12412 CONTINUE 307 : C... Lecture des informations liees a l'element (RECORD 1) 308 : READ(IUUNV,1000,ERR=991,END=991) TEXT 309 : NRAN=0 310 : ICOUR=NCARMAX 311 : IFINAN=NCARFIN 312 : DO i=1,6 312 : CALL REDLEC(sredle) 313 : IF (IRE.NE.1) THEN 314 : iOK=8 315 : GOTO 991 316 : ENDIF 317 : IF (i.EQ.1) THEN 318 : IF (NFIX.EQ.-1) GOTO 22412 319 : NUMELT=NFIX 320 : ELSE IF (i.EQ.2) THEN 321 : NUMEF=NFIX 322 : ELSE IF (i.EQ.3) THEN 323 : NUMPP=NFIX 324 : C* ELSE IF (i.EQ.4) THEN 325 : C* NUMMP=NFIX 326 : C* ELSE IF (i.EQ.5) THEN 327 : C* NUMCO=NFIX 328 : ELSE IF (i.EQ.6) THEN 329 : NBNOE=NFIX 330 : ENDIF 331 : ENDDO 331 : CALL PLACE2(LEFBIM,NEFBIM,IRETOU,NUMEF) 332 : C... Lecture des informations d un element type "BEAM" 333 : C... Pour l'instant pas de traitement de ces informations 334 : IF (IRETOU.NE.0) THEN 335 : READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT 336 : ENDIF 337 : NBELTS=NBELTS+1 338 : IF (NBELTS.GT.JGEL) THEN 339 : JGEL=JGEL+INCJG 340 : SEGADJ,MLIELT 341 : ENDIF 342 : NUMIN=MIN(NUMIN,NUMELT) 343 : NUMAX=MAX(NUMAX,NUMELT) 344 : DO i=1,NBEFLU 345 : IF (NUMEF.EQ.ITYPE(i,1)) GOTO 24120 346 : ENDDO 347 : NBEFLU = NBEFLU+1 348 : ITYPE(NBEFLU,1) = NUMEF 349 : ITYPE(NBEFLU,2) = NBNOE 350 : JG = 1*NBNOE 351 : SEGINI,MLENTI 352 : ITYPE(NBEFLU,5) = MLENTI 353 : i = NBEFLU 354 : 24120 CONTINUE 355 : IF (NBNOE.NE.ITYPE(i,2)) THEN 356 : write(IOIMP,*) 'Erreur NUMEF/NBNOE',NBELTS,NUMELT 357 : ENDIF 358 : NBELEF=ITYPE(i,3)+1 359 : ITYPE(i,3)=NBELEF 360 : MLENTI=ITYPE(i,5) 361 : JG=LECT(/1) 362 : NBNOEF=NBELEF*NBNOE 363 : IF (NBNOEF.GT.JG) THEN 364 : JG=JG+INCJG 365 : SEGADJ,MLENTI 366 : ENDIF 367 : NBNOEF=NBNOEF-NBNOE 368 : IELEM(NBELTS,1)=NUMELT 369 : IELEM(NBELTS,2)=NUMPP 370 : IELEM(NBELTS,3)=i 371 : IELEM(NBELTS,4)=NBELEF 372 : C... Lecture des noeuds de l'element (RECORD 2) 373 : j=0 374 : DO k=NBNOEF+1,NBNOEF+NBNOE 375 : j=j+1 376 : IF (j.EQ.1) THEN 377 : READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT 378 : NRAN=0 379 : ICOUR=NCARMAX 380 : IFINAN=NCARFIN 381 : ENDIF 381 : CALL REDLEC(sredle) 382 : IF (IRE.NE.1) THEN 383 : iOK=661 384 : GOTO 991 385 : ENDIF 386 : LECT(k)=NFIX 387 : IF (j.EQ.8) j=0 388 : ENDDO 389 : GOTO 12412 390 : C... Fin du bloc 391 : 22412 CONTINUE 392 : WRITE(IOIMP,*) ' Nombre d elements lus :',NBELTS 393 : WRITE(IOIMP,*) ' Numero d element min. :',NUMIN 394 : WRITE(IOIMP,*) ' Numero d element max. :',NUMAX 395 : WRITE(IOIMP,*) ' Nombre de types EF lus :',NBEFLU 396 : IF (NBELTS.NE.JGEL) THEN 397 : JGEL=NBELTS 398 : SEGADJ,MLIELT 399 : ENDIF 400 : I_BLOC=1-I_BLOC 401 : WRITE(IOIMP,*) '<- Lecture du DATASET 2412 terminee' 402 : GOTO 10 403 : 404 : C Lecture des proprietes physiques 405 : 2470 CONTINUE 406 : WRITE(IOIMP,*) '-> LECTURE du DATASET 2470' 407 : JGPHY=50 408 : SEGINI,MLIPHY 409 : 12470 CONTINUE 410 : C... Lecture des donnees/proprietes physiques (RECORD 1) 411 : READ(IUUNV,1000,ERR=991,END=991) TEXT 412 : NRAN=0 413 : ICOUR=NCARMAX 414 : IFINAN=NCARFIN 415 : DO i=1,3 415 : CALL REDLEC(sredle) 416 : IF (IRE.NE.1) THEN 417 : iOK=8 418 : GOTO 991 419 : ENDIF 420 : IF (i.EQ.1) THEN 421 : IF (NFIX.EQ.-1) GOTO 22470 422 : NUMPH=NFIX 423 : C* ELSE IF (i.EQ.2) THEN 424 : C* IDPHT=NFIX 425 : ELSE IF (i.EQ.3) THEN 426 : NBPHT=NFIX 427 : ENDIF 428 : ENDDO 429 : NBPHYS=NBPHYS+1 430 : IF (NBPHYS.GT.JGPHY) THEN 431 : JGPHY=JGPHY+50 432 : SEGADJ,MLIPHY 433 : ENDIF 434 : NUMPHY(NBPHYS)=NUMPH 435 : C... Lecture du nom de la propriete (RECORD 2) 436 : READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT 437 : NOMPHY(NBPHYS)=TEXT(1:LONG(TEXT)) 438 : C... Lecture des valeurs de chaque propriete physique (RECORD 3 et 4) 439 : C... Pour l'instant : pas de traitement de ces valeurs 440 : DO i = 1, NBPHT 441 : READ(IUUNV,1000,ERR=991,END=991) TEXT 442 : NRAN=0 443 : ICOUR=NCARMAX 444 : IFINAN=NCARFIN 445 : DO j=1,3 445 : CALL REDLEC(sredle) 446 : IF (IRE.NE.1) THEN 447 : iOK=8 448 : GOTO 991 449 : ENDIF 450 : IF (j.EQ.1) THEN 451 : C* NUMPR=NFIX 452 : ELSE IF (j.EQ.2) THEN 453 : IDTPR=NFIX 454 : ELSE IF (j.EQ.3) THEN 455 : NBVPR=NFIX 456 : ENDIF 457 : ENDDO 458 : NBLIG=0 459 : IF (IDTPR.EQ.1) THEN 460 : NBLIG = ((NBVPR-1) / 8) + 1 461 : ELSE IF (IDTPR.EQ.2) THEN 462 : NBLIG = ((NBVPR-1) / 5) + 1 463 : ELSE IF (IDTPR.EQ.3) THEN 464 : NBLIG = ((NBVPR-1) / 80) + 1 465 : ENDIF 466 : DO j=1,NBLIG 467 : READ(IUUNV,1000,ERR=991,END=991) TEXT 468 : ENDDO 469 : ENDDO 470 : GOTO 12470 471 : C... Fin du bloc 472 : 22470 CONTINUE 473 : WRITE(IOIMP,*) ' Nombre de proprietes lues :',NBPHYS 474 : DO i=1,NBPHYS 475 : j=LONG(NOMPHY(i)) 476 : WRITE(IOIMP,FMT='(3X,I2,3H = ,A)') NUMPHY(i),NOMPHY(i)(1:j) 477 : ENDDO 478 : IF (NBPHYS.NE.JGPHY) THEN 479 : JGPHY=NBPHYS 480 : SEGADJ,MLIPHY 481 : ENDIF 482 : I_BLOC=1-I_BLOC 483 : WRITE(IOIMP,*) '<- Lecture du DATASET 2470 terminee' 484 : GOTO 10 485 : 486 : C Lecture des groupes (d'elements) "permanents" 487 : 2477 CONTINUE 488 : WRITE(IOIMP,*) '-> LECTURE du DATASET 2477' 489 : NBPEGP = 0 490 : NBPEGE = 0 491 : JGPEG=50 492 : SEGINI,MLIPEG 493 : 12477 CONTINUE 494 : C... Lecture des donnees... (RECORD 1) 495 : READ(IUUNV,1000,ERR=991,END=991) TEXT 496 : NRAN=0 497 : ICOUR=NCARMAX 498 : IFINAN=NCARFIN 499 : DO i = 1, 8 499 : CALL REDLEC(sredle) 500 : IF (IRE.NE.1) THEN 501 : iOK=8 502 : GOTO 991 503 : ENDIF 504 : IF (i.EQ.1) THEN 505 : IF (NFIX.EQ.-1) GOTO 22477 506 : NUMPH = NFIX 507 : ELSE IF (i.EQ.8) THEN 508 : NBPHT = NFIX 509 : ENDIF 510 : ENDDO 511 : NBPEGR = NBPEGR+1 512 : IF (NBPEGR.GT.JGPEG) THEN 513 : JGPEG = JGPEG+50 514 : SEGADJ,MLIPEG 515 : ENDIF 516 : NUMPEG(NBPEGR,1) = NUMPH 517 : JG = NBPHT 518 : SEGINI,MLENTI 519 : NUMPEG(NBPEGR,2) = MLENTI 520 : C... Lecture du nom du groupe (RECORD 2) 521 : READ(IUUNV,FMT=1000,ERR=991,END=991) TEXT 522 : NOMPEG(NBPEGR)=TEXT(1:LONG(TEXT)) 523 : C... Lecture de chaque entite du groupe 524 : kelt = 0 525 : knoe = NBPHT+1 526 : DO i = 1, NBPHT 527 : IF (MOD(i,2).EQ.1) THEN 528 : READ(IUUNV,1000,ERR=991,END=991) TEXT 529 : NRAN=0 530 : ICOUR=NCARMAX 531 : IFINAN=NCARFIN 532 : ENDIF 533 : DO j=1,4 533 : CALL REDLEC(sredle) 534 : IF (IRE.NE.1) THEN 535 : iOK=8 536 : GOTO 991 537 : ENDIF 538 : IF (j.EQ.1) THEN 539 : IDPTR=NFIX 540 : ELSE IF (j.EQ.2) THEN 541 : NUMPR=NFIX 542 : ENDIF 543 : ENDDO 544 : C... On ne conserve que les noeuds (POI1) et les elements 545 : IF (IDPTR.EQ.7) THEN 546 : knoe = knoe - 1 547 : LECT(knoe) = NUMPR 548 : ELSE IF (IDPTR.EQ.8) THEN 549 : kelt = kelt + 1 550 : LECT(k) = NUMPR 551 : ENDIF 552 : ENDDO 553 : knoe = NBPHT+1 - knoe 554 : NUMPEG(NBPEGR,3) = knoe 555 : NUMPEG(NBPEGR,4) = kelt 556 : IF (knoe.GT.0) NBPEGP = NBPEGP+1 557 : IF (kelt.GT.0) NBPEGE = NBPEGE+1 558 : IF (knoe.EQ.0 .AND. kelt.EQ.0) THEN 559 : NBPEGR = NBPEGR-1 560 : SEGSUP,MLENTI 561 : ENDIF 562 : GOTO 12477 563 : C... Fin du bloc 564 : 22477 CONTINUE 565 : WRITE(IOIMP,*) ' Nombre de groupes conserves :',NBPEGR 566 : DO i = 1, NBPEGR 567 : j = LONG(NOMPEG(i)) 568 : WRITE(IOIMP,FMT='(3X,I2,3H = ,A)') NUMPEG(i,1),NOMPEG(i)(1:j) 569 : ENDDO 570 : IF (NBPEGR.NE.JGPEG) THEN 571 : JGPEG = NBPEGR 572 : SEGADJ,MLIPEG 573 : ENDIF 574 : I_BLOC = 1-I_BLOC 575 : WRITE(IOIMP,*) '<- Lecture du DATASET 2477 terminee' 576 : GOTO 10 577 : 578 : C= Fin normale de la lecture 579 : 100 CONTINUE 580 : WRITE(IOIMP,*) 'FIN LECTURE DES DATASET' 581 : 582 : C= Traitement des differents DATASET lus 583 : 584 : C= Creation d'une liste croissante des noeuds selon leur numero lu 585 : C= Creation d'un maillage de POI1 contenant tous les noeuds lus 586 : C* Mettre une option pour creer ce maillage ? 587 : IF (MLINOE.NE.0) THEN 588 : NBNN=1 589 : NBELEM=NBNPTS 590 : NBSOUS=0 591 : NBREF=0 592 : SEGINI,MELEME 593 : ITYPEL=1 594 : DO i=1,NBNPTS 595 : NUM(1,i)=i+NBANC 596 : ENDDO 597 : SEGDES,MELEME 597 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'NOEUDS',b_z, i_z , 598 : & 'MAILLAGE',i_z,r_z, mot_z ,b_z,MELEME) 599 : JG = NBNPTS 600 : SEGINI,MLINO2 601 : MLINO2.LECT(1)=1 602 : DO i=2,NBNPTS 603 : INOE = MLINOE.LECT(i) 604 : DO j=i-1,1,-1 605 : JNO2 = MLINO2.LECT(j) 606 : JNOE = MLINOE.LECT(JNO2) 607 : IF (JNOE.LE.INOE) GOTO 101 608 : MLINO2.LECT(j+1) = JNO2 609 : ENDDO 610 : 101 CONTINUE 611 : MLINO2.LECT(j+1) = i 612 : ENDDO 613 : ENDIF 614 : C= Creation du maillage contenant l'ensemble des elements lus ayant 615 : C= une correspondance dans Cast3m 616 : IF (MLIELT.NE.0) THEN 617 : IF (MLINOE.EQ.0) THEN 618 : WRITE(IOIMP,*) 'ERREUR : DATASET 2411 non lu' 619 : iOK = 21 620 : GOTO 991 621 : ENDIF 622 : JGMAI = NBEFLU 623 : SEGINI,MLIMAI 624 : NBSOUS=0 625 : NBREF=0 626 : NBMAIS=0 627 : icoul=0 628 : DO i = 1, NBEFLU 629 : NUMEF = ITYPE(i,1) 630 : C* IF (NUMEF.LE.0) GOTO 110 630 : CALL PLACE2(LEFUNV,NEFUNV,IRETOU,NUMEF) 631 : IF (IRETOU.EQ.0) THEN 632 : WRITE(IOIMP,*) 'FE ID non reconnu : ',NUMEF 633 : GOTO 110 634 : ENDIF 635 : IF (LEFGEO(IRETOU).EQ.0) THEN 636 : WRITE(IOIMP,*) NUMEF,' sans correspondance dans C3M' 637 : GOTO 110 638 : ENDIF 639 : NBNN =ITYPE(i,2) 640 : NBELEM=ITYPE(i,3) 641 : MLENTI=ITYPE(i,5) 642 : icoul = icoul + 1 643 : IF (icoul.EQ.16) icoul=icoul-15 644 : NBMAIS=NBMAIS+1 645 : C* ITYPE(i,1)=LEFGEO(IRETOU) 646 : ITYPE(i,4)=NBMAIS 647 : SEGINI,PTMAI(NBMAIS) 648 : IPT1=PTMAI(NBMAIS) 649 : IPT1.ITYPEL=LEFGEO(IRETOU) 650 : TYMAI(NBMAIS)=LEFGEO(IRETOU) 651 : NBNOEL=0 652 : DO j = 1, NBELEM 653 : DO k = 1, NBNN 654 : INOE = LECT(NBNOEL+k) 655 : lInf = 1 656 : lSup = NBNPTS 657 : 111 CONTINUE 658 : IF (lInf.GT.lSup) THEN 659 : WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 4211' 660 : iOK=21 661 : GOTO 991 662 : ENDIF 663 : lMil = (lInf+lSup)/2 664 : l = MLINO2.LECT(lMil) 665 : JNOE = MLINOE.LECT(l) 666 : IF (INOE.EQ.JNOE) THEN 667 : GOTO 112 668 : ELSE IF (INOE.LT.JNOE) THEN 669 : lSup = lMil - 1 670 : ELSE 671 : lInf = lMil + 1 672 : ENDIF 673 : GOTO 111 674 : 112 CONTINUE 675 : IPT1.NUM(k,j) = NBANC+l 676 : LECT(NBNOEL+k) = NBANC+l 677 : ENDDO 678 : IPT1.ICOLOR(j)=icoul 679 : NBNOEL=NBNOEL+NBNN 680 : ENDDO 681 : SEGDES,PTMAI(NBMAIS) 682 : 110 CONTINUE 683 : MLENTI = ITYPE(i,5) 684 : SEGDES,MLENTI 685 : ENDDO 686 : IF (JGMAI.NE.NBMAIS) THEN 687 : JGMAI=NBMAIS 688 : SEGADJ,MLIMAI 689 : ENDIF 690 : IF (NBMAIS.EQ.0) THEN 691 : WRITE(IOIMP,*) 'Pas de maillage au sens Cast3m' 691 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'MAILLAGE',b_z,i_z, 692 : & 'MOT ',i_z,r_z, 'VIDE' ,b_z,i_z) 693 : ELSE 694 : nom_z(1:5) = '@ ' 695 : DO i = 1, NBMAIS 696 : IPT1=PTMAI(i) 697 : j =TYMAI(i) 698 : nom_z(2:5) = NOMS(j)(1:4) 698 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z(1:5),b_z,i_z , 699 : & 'MAILLAGE',i_z,r_z, mot_z ,b_z,IPT1) 700 : ENDDO 701 : IF (NBMAIS.EQ.1) THEN 702 : IPT2=PTMAI(1) 703 : ELSE 704 : NBSOUS=NBMAIS 705 : NBREF =0 706 : NBNN =0 707 : NBELEM=0 708 : SEGINI,IPT2 709 : DO i = 1, NBSOUS 710 : IPT2.LISOUS(i)=PTMAI(i) 711 : ENDDO 712 : SEGDES,IPT2 713 : ENDIF 713 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,'MAILLAGE',b_z,i_z , 714 : & 'MAILLAGE',i_z,r_z, mot_z ,b_z,IPT2) 715 : ENDIF 716 : ENDIF 717 : C= Creation des maillages (groupes d'elements) associes a chaque 718 : C= propriete physique lue (elements avec une correspondance dans Cast3m) 719 : IF (MLIPHY.NE.0) THEN 720 : IF (MLIELT.EQ.0) THEN 721 : WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu' 722 : iOK = 21 723 : GOTO 991 724 : ENDIF 725 : IF (NBMAIS.EQ.0) THEN 726 : WRITE(IOIMP,*) 'Pas de GROUPE associe aux proprietes' 727 : ELSE 728 : JG=NBMAIS 729 : SEGINI,MLENTI,MLENT1 730 : DO j=1,NBMAIS 731 : SEGACT,PTMAI(j) 732 : ENDDO 733 : icoul = 1 734 : DO i = 1, NBPHYS 735 : NUMPP = NUMPHY(i) 736 : PTPHY(i) = 0 737 : DO j=1,NBMAIS 738 : LECT(j)=0 739 : MLENT1.LECT(j)=0 740 : ENDDO 741 : DO j=1,NBELTS 742 : IF (IELEM(j,2).EQ.NUMPP) THEN 743 : k = ITYPE(IELEM(j,3),4) 744 : IF (k.NE.0) LECT(k)=LECT(k)+1 745 : ENDIF 746 : ENDDO 747 : NMAIPH=0 748 : NBSOUS=0 749 : NBREF =0 750 : DO j=1,NBMAIS 751 : NBELEM=LECT(j) 752 : IF (NBELEM.NE.0) THEN 753 : NMAIPH=NMAIPH+1 754 : IPT1=PTMAI(j) 755 : NBNN=IPT1.NUM(/1) 756 : SEGINI,MELEME 757 : ITYPEL=IPT1.ITYPEL 758 : DO k=1,NBELEM 759 : ICOLOR(k)=icoul 760 : ENDDO 761 : LECT(j)=MELEME 762 : ENDIF 763 : ENDDO 764 : IF (NMAIPH.EQ.0) GOTO 120 765 : DO j=1,NBELTS 766 : IF (IELEM(j,2).EQ.NUMPP) THEN 767 : k = ITYPE(IELEM(j,3),4) 768 : IF (k.NE.0) THEN 769 : IPT1 =PTMAI(k) 770 : MELEME=LECT(k) 771 : NBNN = NUM(/1) 772 : iel1 = IELEM(j,4) 773 : iel2 = MLENT1.LECT(k)+1 774 : DO l=1,NBNN 775 : NUM(l,iel2)=IPT1.NUM(l,iel1) 776 : ENDDO 777 : MLENT1.LECT(k) = iel2 778 : ENDIF 779 : ENDIF 780 : ENDDO 781 : DO j=1,NBMAIS 782 : MELEME=LECT(j) 783 : IF (MELEME.NE.0) SEGDES,MELEME 784 : ENDDO 785 : IF (NMAIPH.EQ.1) THEN 786 : DO j=1,NBMAIS 787 : MELEME=LECT(j) 788 : IF (MELEME.NE.0) PTPHY(i)=MELEME 789 : ENDDO 790 : ELSE 791 : NBNN=0 792 : NBREF=0 793 : NBSOUS=NMAIPH 794 : SEGINI,MELEME 795 : ISOUS=0 796 : DO j=1,NBMAIS 797 : IPT1=LECT(j) 798 : IF (IPT1.NE.0) THEN 799 : ISOUS=ISOUS+1 800 : LISOUS(ISOUS)=IPT1 801 : ENDIF 802 : ENDDO 803 : SEGDES,MELEME 804 : PTPHY(i)=MELEME 805 : ENDIF 806 : icoul = icoul + 1 807 : IF (icoul.EQ.16) icoul=icoul-15 808 : 120 CONTINUE 809 : ENDDO 810 : SEGSUP,MLENTI,MLENT1 811 : DO j=1,NBMAIS 812 : SEGDES,PTMAI(j) 813 : ENDDO 814 : DO i = 1, NBPHYS 815 : IPT1=PTPHY(i) 816 : IF (IPT1.NE.0) THEN 817 : nom_z = NOMPHY(i) 817 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z,b_z,i_z, 818 : & 'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1) 819 : ENDIF 820 : ENDDO 821 : ENDIF 822 : ENDIF 823 : C= Creation des groupes de noeuds ou d'elements ("permanents") 824 : C= Pour permettre la lecture d'"anciens" fichiers UNV... 825 : IF (MLIPEG.NE.0) THEN 826 : IF (MLIELT.EQ.0) THEN 827 : WRITE(IOIMP,*) 'ERREUR : DATASET 2412 non lu' 828 : iOK = 21 829 : GOTO 991 830 : ENDIF 831 : C= Creation d'une liste croissante des elements selon leur numero lu 832 : C= (uniquement s'il y des elements dans les groupes "permanents") 833 : IF (NBPEGE.NE.0) THEN 834 : JG = NBELTS 835 : SEGINI,MLIEL2 836 : MLIEL2.LECT(1) = 1 837 : DO i = 2, NBELTS 838 : INOE = IELEM(i,1) 839 : DO j = i-1, 1, -1 840 : JNO2 = MLIEL2.LECT(j) 841 : JNOE = IELEM(JNO2,1) 842 : IF (JNOE.LE.INOE) GOTO 130 843 : MLIEL2.LECT(j+1) = JNO2 844 : ENDDO 845 : 130 CONTINUE 846 : MLIEL2.LECT(j+1) = i 847 : ENDDO 848 : ENDIF 849 : C* 850 : icoul = 1 851 : JG = NBEFLU 852 : SEGINI,MLENT1 853 : DO i = 1, NBPEGR 854 : DO j = 1, NBEFLU 855 : MLENT1.LECT(j) = 0 856 : ENDDO 857 : c* NUMPH = NUMPEG(i,1) 858 : MLENTI = NUMPEG(i,2) 859 : knoe = NUMPEG(i,3) 860 : kelt = NUMPEG(i,4) 861 : NBMAIS = 0 862 : MELPOI = 0 863 : IF (knoe.EQ.0) GOTO 133 864 : NBMAIS = NBMAIS + 1 865 : NBNN = 1 866 : NBELEM = knoe 867 : NBREF = 0 868 : NBSOUS = 0 869 : SEGINI,MELEME 870 : ITYPEL = 1 871 : NBPHT = LECT(/1) - knoe 872 : DO k = 1, knoe 873 : INOE = LECT(NBPHT+k) 874 : lInf = 1 875 : lSup = NBNPTS 876 : 131 CONTINUE 877 : IF (lInf.GT.lSup) THEN 878 : WRITE(IOIMP,*) 'ERREUR : Noeud',INOE,'pas dans 4211' 879 : iOK = 21 880 : GOTO 991 881 : ENDIF 882 : lMil = (lInf+lSup)/2 883 : l = MLINO2.LECT(lMil) 884 : JNOE = MLINOE.LECT(l) 885 : IF (INOE.EQ.JNOE) THEN 886 : GOTO 132 887 : ELSE IF (INOE.LT.JNOE) THEN 888 : lSup = lMil - 1 889 : ELSE 890 : lInf = lMil + 1 891 : ENDIF 892 : GOTO 131 893 : 132 CONTINUE 894 : NUM(k,1) = NBANC+l 895 : ICOLOR(k) = icoul 896 : ENDDO 897 : SEGDES,MELEME 898 : MELPOI = MELEME 899 : 133 CONTINUE 900 : IF (kelt.EQ.0) GOTO 137 901 : DO k = 1, kelt 902 : INOE = LECT(k) 903 : lInf = 1 904 : lSup = NBELTS 905 : 134 CONTINUE 906 : IF (lInf.GT.lSup) THEN 907 : WRITE(IOIMP,*) 'ERREUR : Element',INOE,'pas dans 4212' 908 : iOK = 21 909 : GOTO 991 910 : ENDIF 911 : lMil = (lInf+lSup)/2 912 : l = MLIEL2.LECT(lMil) 913 : JNOE = IELEM(l,1) 914 : IF (INOE.EQ.JNOE) THEN 915 : GOTO 135 916 : ELSE IF (INOE.LT.JNOE) THEN 917 : lSup = lMil - 1 918 : ELSE 919 : lInf = lMil + 1 920 : ENDIF 921 : GOTO 134 922 : 135 CONTINUE 923 : LECT(k) = l 924 : JNOE = IELEM(l,3) 925 : MLENT1.LECT(JNOE) = MLENT1.LECT(JNOE) + 1 926 : ENDDO 927 : NBREF = 0 928 : NBSOUS = 0 929 : DO j = 1, NBEFLU 930 : NBELEM = MLENT1.LECT(j) 931 : IF (NBELEM.EQ.0) GOTO 136 932 : NBMAIS = NBMAIS + 1 933 : NUMEF = ITYPE(j,1) 934 : NBNN = ITYPE(j,2) 935 : IPT1 = PTMAI(ITYPE(j,4)) 936 : SEGACT,IPT1 937 : SEGINI,MELEME 938 : ITYPEL = IPT1.ITYPEL 939 : iel2 = 0 940 : DO k = 1, kelt 941 : JNOE = LECT(k) 942 : IF (IELEM(JNOE,3).EQ.NUMEF) THEN 943 : iel1 = IELEM(JNOE,4) 944 : iel2 = iel2 + 1 945 : DO l = 1, NBNN 946 : NUM(l,iel2) = IPT1.NUM(l,iel1) 947 : ENDDO 948 : ICOLOR(iel2) = icoul 949 : ENDIF 950 : ENDDO 951 : SEGDES,IPT1,MELEME 952 : MLENT1.LECT(j) = MELEME 953 : 136 CONTINUE 954 : ENDDO 955 : 137 CONTINUE 956 : IF (NBMAIS.EQ.1) THEN 957 : IPT2 = MELEME 958 : ELSE 959 : NBNN = 0 960 : NBELEM = 0 961 : NBREF = 0 962 : NBSOUS = NBMAIS 963 : SEGINI,IPT2 964 : ISOUS = 1 965 : IF (knoe.NE.0) THEN 966 : IPT2.LISOUS(ISOUS) = MELPOI 967 : ISOUS = ISOUS + 1 968 : ENDIF 969 : DO j = 1, NBEFLU 970 : IPT1 = MLENT1.LECT(j) 971 : IF (IPT1.NE.0) THEN 972 : ISOUS = ISOUS + 1 973 : IPT2.LISOUS(ISOUS) = IPT1 974 : ENDIF 975 : ENDDO 976 : SEGDES,IPT2 977 : ENDIF 978 : PTPEG(i) = IPT2 979 : icoul = icoul + 1 980 : IF (icoul.EQ.16) icoul = icoul-15 981 : ENDDO 982 : 983 : DO i = 1, NBPEGR 984 : IPT1 = PTPEG(i) 985 : IF (IPT1.NE.0) THEN 986 : nom_z = NOMPEG(i) 986 : CALL ECCTAB(MATAB,'MOT ',i_z,r_z,nom_z,b_z,i_z, 987 : & 'MAILLAGE',i_z,r_z,mot_z,b_z,IPT1) 988 : ENDIF 989 : ENDDO 990 : 991 : ENDIF 992 : 993 : C= Ecriture de la TABLE contenant les donnees lues ! 994 : iOK = 0 994 : CALL ECROBJ('TABLE ',MATAB) 995 : 996 : C= Menage et traitement des erreurs 997 : 991 CONTINUE 998 : CLOSE(UNIT=IUUNV) 999 : 1000 : IF (MLINOE.NE.0) SEGSUP,MLINOE 1001 : IF (MLINO2.NE.0) SEGSUP,MLINO2 1002 : IF (MLIELT.NE.0) SEGSUP,MLIELT 1003 : IF (MLIEL2.NE.0) SEGSUP,MLIEL2 1004 : IF (MLISEF.NE.0) THEN 1005 : DO i = 1, NBEFLU 1006 : MLENTI = ITYPE(i,5) 1007 : SEGSUP,MLENTI 1008 : ENDDO 1009 : SEGSUP,MLISEF 1010 : ENDIF 1011 : IF (MLIMAI.NE.0) SEGSUP,MLIMAI 1012 : IF (MLIPHY.NE.0) SEGSUP,MLIPHY 1013 : IF (MLIPEG.NE.0) THEN 1014 : DO i = 1, NUMPEG(/1) 1015 : MLENTI = NUMPEG(i,2) 1016 : IF (MLENTI.NE.0) SEGSUP,MLENTI 1017 : ENDDO 1018 : SEGSUP,MLIPEG 1019 : ENDIF 1020 : 990 CONTINUE 1021 : SEGSUP,sredle 1022 : MTABLE=MATAB 1023 : SEGDES,MTABLE 1024 : 1025 : C= Traitement des erreurs 1026 : IF (iOK.NE.0 .OR. IERR.NE.0) THEN 1026 : IF (iOK.NE.0) CALL ERREUR(iOK) 1027 : SEGSUP,MTABLE 1028 : ENDIF 1029 : 1030 : WRITE(IOIMP,*) 1031 : RETURN 1032 : END 1033 : 1034 : 1035 :
© Cast3M 2003 - All rights reserved.
Disclaimer