1 : C LIRFEM SOURCE KK2000 13/11/29 21:15:01 7871 2 : SUBROUTINE LIRFEM 3 : 4 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C 6 : C BUT: Lecture des données provenant de HyperMesh sous forme de 7 : C fichier FEM (ASCII). Les données sont logées dans une table 8 : C qui est renvoyée comme résultat. 9 : C 10 : C Auteur : Clément BERTHINIER 11 : C Novembre 2013 12 : C 13 : C Liste des Corrections : 14 : C 26/11/2013 15 : C Clément B. : Anomalie lors de l'import de coordonnées corrigée 16 : C 17 : C Appelé par : LIREFI 18 : C 19 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 20 : 21 : 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : LOGICAL DEBCB 25 : LOGICAL PRECID 26 : 27 : C Définition des COMMON utiles 28 : -INC CCOPTIO 29 : -INC CCREDLE 30 : -INC CCGEOME 31 : 32 : C Définition des OBJETS utiles 33 : C SMCOORD : à ne jamais désactiver contenant les coordonnées des points 34 : C SMELEME : objet MAILLAGE 35 : C SMTABLE : objet TABLE 36 : -INC SMCOORD 37 : -INC SMELEME 38 : -INC SMTABLE 39 : 40 : 41 : C*********************************************************************** 42 : C Définition des différents segments et de leur contenu 43 : C*********************************************************************** 44 : SEGMENT MLINOE 45 : C JGNOLO : ID du noeud dans la numérotation LOCALE 46 : C JGNOLU : ID du noeud lu dans le fichier 47 : C INOC3M : Numéro du noeud dans la numérotation absolue de Cast3M 48 : C INOEHM : Numéro du JGième noeud lu dans le fichier .fem 49 : C ICORNO : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds 50 : INTEGER INOC3M(JGNOLO) 51 : INTEGER INOEHM(JGNOLO) 52 : INTEGER ICORNO(JGNOLU) 53 : ENDSEGMENT 54 : 55 : SEGMENT MLIELE 56 : C JGELLO : ID de l'élément dans la numérotation LOCALE 57 : C JGELLU : ID de l'élément lu dans le fichier 58 : C JELCON : Nombre total connectivité lues 59 : C IELCON : Ou aller lire le début de la connectivité dans ICONTO 60 : C IELNBN : Nombre de noeuds de connectivité à lire dans ICONTO 61 : C IELTYP : Type de l'élément lu pour Cast3M 62 : C IELPRO : ID de la propriété dans HM (Valeur lue pour IVALU = 2) 63 : C IELCOM : ID du component dans HM dans lequel est rangé cet élément 64 : C ICONTO : Tableau dans lequel sont placées toutes les connectivités les unes après les autres 65 : C ICOREL : Correspondance depuis la numérotation LOCALE vers la numérotation lue des ELEMENTS 66 : INTEGER IELCON(JGELLU) 67 : INTEGER IELNBN(JGELLU) 68 : INTEGER IELTYP(JGELLU) 69 : INTEGER IELPRO(JGELLU) 70 : INTEGER IELCOM(JGELLU) 71 : INTEGER ICONTO(JELCON) 72 : INTEGER ICOREL(JGELLO) 73 : ENDSEGMENT 74 : 75 : 76 : SEGMENT MELEQU 77 : C Dans ce tableau dynamique sera stoquée la place dans NOMS (voir bdata.eso) des éléments équivalents Cast3M 78 : INTEGER IELEQU(NBGEOM) 79 : ENDSEGMENT 80 : 81 : C Segment contenant tout ce qui sera utile pour définir un component au sens HM 82 : SEGMENT MCOMP 83 : C JGCOLO : Indice du composant dans la numérotation LOCALE 84 : C JGCOLU : ID lu dans le fichier 85 : C NBGEOM : Nombre de types d'éléments relu dans HM 86 : C NAMECO : Nom des components 87 : C ICOULC : Couleur des components 88 : C NBTYPE : Nombre de types d'éléments dans le component + le nombre total de sous type (NBSOUS) 89 : C NBELCO : Nombre d'éléments de chaque type dans le component (NBELEM) 90 : C NBELC2 : Nombre d'éléments de chaque type dans le component a mesure qu'ils sont triés (à la fin) 91 : C NPOINT : Liste des pointeurs vers les MELEME simples de chaque component, l'indice NBGEOM+1 représente un pointeur de MELEME COMPLEXE au cas échéant 92 : C ICOCOR : Correspondance entre la numérotation LOCALE et HM des components 93 : CHARACTER*40 NAMECO(JGCOLU) 94 : INTEGER ICOULC(JGCOLU) 95 : INTEGER NBTYPE(JGCOLU,NBGEOM+1) 96 : INTEGER NBELCO(JGCOLU,NBGEOM) 97 : INTEGER NBELC2(JGCOLU,NBGEOM) 98 : INTEGER NPOINT(JGCOLU,NBGEOM+1) 99 : INTEGER ICOCOR(JGCOLO) 100 : ENDSEGMENT 101 : 102 : C*********************************************************************** 103 : C Définition des DATA et déclarations diverses 104 : C*********************************************************************** 105 : 106 : C Unite logique du fichier d'impression au format .fem et nom du fichier 107 : PARAMETER (IUFEM=67) 108 : 109 : C Déclaration des chaines de caractères utiles 110 : CHARACTER*256 FicFem 111 : CHARACTER*80 LIGNE 112 : CHARACTER*4 COLO4 113 : CHARACTER*8 MOTCL8 114 : CHARACTER*8 COLO8 115 : CHARACTER*9 COLO9 116 : CHARACTER*16 COLO16 117 : CHARACTER*17 COLO17 118 : CHARACTER*40 COLO39 119 : CHARACTER*80 COLO80 120 : 121 : C Liste des mots clé non Géométrique en début de ligne d'un fichier .fem 122 : PARAMETER (NBNGEO=3) 123 : CHARACTER*8 NGTYPE(NBNGEO) 124 : DATA NGTYPE / '$HMMOVE ', 125 : & '$HMNAME ', 126 : & '$HWCOLOR' / 127 : 128 : C Liste des mots clé non Géométrique en début de ligne d'un fichier .fem 129 : PARAMETER (NBREPR=3) 130 : CHARACTER*8 NREPRI(NBREPR) 131 : DATA NREPRI / '+ ', 132 : & '* ', 133 : & '$ ' / 134 : 135 : C Liste des mots clé de Géométrie en début de ligne d'un fichier .fem 136 : PARAMETER (NBGEOM=16) 137 : 138 : CHARACTER*8 GETYPE(NBGEOM) 139 : DATA GETYPE / 'GRID ','GRID* ', 140 : & 'RBE2 ','RBE3 ', 141 : & 'CTRIA3 ','CTRIA6 ', 142 : & 'CQUAD4 ','CQUAD8 ', 143 : & 'CTETRA ','CTETRA10', 144 : & 'CPYRA ','CPYRA13 ', 145 : & 'CPENTA ','CPENTA15', 146 : & 'CHEXA ','CHEXA20 ' / 147 : 148 : CHARACTER*4 GELEQU(NBGEOM) 149 : DATA GELEQU / 'POI1','POI1', 150 : & 'SEG2','SEG3', 151 : & 'TRI3','TRI6', 152 : & 'QUA4','QUA8', 153 : & 'TET4','TE10', 154 : & 'PYR5','PY13', 155 : & 'PRI6','PR15', 156 : & 'CUB8','CU20' / 157 : 158 : C Data indiquant le nombre de noeud de connectivité 159 : INTEGER GECONN(NBGEOM) 160 : DATA GECONN / 1,1 , 161 : & 2,3 , 162 : & 3,6 , 163 : & 4,8 , 164 : & 4,10, 165 : & 5,13, 166 : & 6,15, 167 : & 8,20 / 168 : 169 : 170 : C Data permettrant de mettre le bon ordre dans la connectivité des éléments 171 : C Le facteur 20 de ce DATA vient du fait que l'élément le plus 172 : C Complexe a une connectivité à 20 éléments (CU20 ou HEXA 2nd Ordre) 173 : INTEGER IORDCO(NBGEOM*20) 174 : DATA IORDCO / 175 : & 1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , POI1 176 : & 1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , POI1 177 : & 1,2,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG2 178 : & 3,1,2,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG3 179 : & 1,2,3,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI3 180 : & 1,4,2,5 ,3,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI6 181 : & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA4 182 : & 1,5,2,6 ,3,7 ,4 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA8 183 : & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TET4 184 : & 1,5,2,6 ,3,7 ,8 ,9 ,10,4 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TE10 185 : & 1,2,3,4 ,5,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PYR5 186 : & 2,7,3,8 ,4,9 ,1 ,6 ,11,12,13,10,5 ,0 ,0 ,0 ,0,0 ,0,0 , PY13 187 : & 1,2,3,4 ,5,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PRI6 188 : & 1,7,2,8 ,3,9 ,10,11,12,4 ,13,5 ,14,6 ,15,0 ,0,0 ,0,0 , PR15 189 : & 1,2,3,4 ,5,6 ,7 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , CUB8 190 : & 1,9,2,10,3,11,4 ,12,13,14,15,16,5 ,17,6 ,18,7,19,8,20 / CU20 191 : 192 : PARAMETER (LONOBJ=1+NBGEOM+1) 193 : INTEGER NOBJ(LONOBJ) 194 : C NOBJ( 1 ) : Nbr d'objets géométriques différents lus 195 : C NOBJ( n ) : Nombre d'objets géométriques de chaque type Lus 196 : C NOBJ(end) : Nombre d'éléments lu au total 197 : 198 : C Option de Débuggage par Clément BERTHINIER 199 : DEBCB = .TRUE. 200 : C DEBCB = .FALSE. 201 : 202 : 203 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 204 : C IF (DEBCB) THEN 205 : C WRITE(IOIMP,*)'Entree dans la Subroutine LIRFEM ' 206 : C ENDIF 207 : 208 : C Création de la table VIDE de sortie 209 : M=0 210 : SEGINI,MTABLE 211 : 212 : C Format de lecture d'un fichier .fem 213 : C 10 fois 8 caractères par ligne en simple précision 214 : C 5 fois 16 caractères par ligne en double précision 215 : 216 : 1000 FORMAT(A80) 217 : 218 : C Initialisation des Segments 219 : MLINOE = 0 220 : MLIELE = 0 221 : MELEQU = 0 222 : MCOMP = 0 223 : 224 : C Initialisations autres 225 : INCJGN = 5000 226 : INCJGE = 5000 227 : INCJCO = 5000 228 : INCCOM = 10 229 : IRETO1 = 0 230 : IRETO2 = 0 231 : IRETO3 = 0 232 : IRETO4 = 0 233 : IVALU = 0 234 : IDLU = 0 235 : IDLU0 = 0 236 : IDLU1 = 0 237 : IDCOMP = 0 238 : IDTYPE = 0 239 : IDELEM = 0 240 : IDCONN = 0 241 : IDCOCA = 0 242 : IDCOLU = 0 243 : IDMAIL = 0 244 : INDICE = 0 245 : JNDICE = 0 246 : ICOL = 0 247 : ITEST = 0 248 : IADD = 0 249 : 250 : IPT1 = 0 251 : IPT2 = 0 252 : 253 : IMAXNO = 0 254 : IMAXEL = 0 255 : IMAXCO = 0 256 : 257 : LCOL = 0 258 : NCOLOL = 0 259 : NBCONN = 0 260 : NBCOMP = 0 261 : NBLIGN = 0 262 : NBNPTS = 0 263 : NELTOT = 0 264 : 265 : XNCJG = 2.0D0 266 : 267 : PRECID = .FALSE. 268 : 269 : 270 : C Tableau NOBJ initialisé à 0 271 : DO 1 INDICE = 1, LONOBJ 272 : NOBJ(INDICE)=0 273 : 1 CONTINUE 274 : 275 : C Lecture des arguments : Nom du fichier à lire (toto.fem) 275 : CALL LIRCHA(FicFem,1,IRETO1) 276 : IF (IERR.NE.0) RETURN 277 : 278 : C IF (DEBCB) THEN 279 : C WRITE(IOIMP,*)'Fichier en entree : ',FicFem 280 : C ENDIF 281 : 282 : C Segment de lecture d'une ligne ... 283 : SEGINI,sredle 284 : SEPARA=.FALSE. 285 : MOT=' ' 286 : 287 : 288 : C Par defaut, Erreur Cast3M numero 424 289 : C Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40 290 : iOK=424 291 : L=LEN(FicFem) 292 : MOTERR(1:L)=FicFem(1:L) 293 : INTERR(1)=0 294 : 295 : C Ouverture du fichier .fem 296 : CLOSE(UNIT=IUFEM,ERR=990) 297 : OPEN(UNIT=IUFEM,STATUS='OLD',FILE=FicFem(1:L), 298 : & IOSTAT=IOS,FORM='FORMATTED') 299 : 300 : C Traitement des erreurs d'ouverture des fichiers 301 : IF (IOS.NE.0) THEN 302 : INTERR(1)=IOS 303 : IF (DEBCB) THEN 304 : WRITE(IOIMP,*) 'Fichier introuvable : ',FicFem 305 : ENDIF 306 : GOTO 990 307 : ELSE 308 : iOK=0 309 : C IF (DEBCB) THEN 310 : C WRITE(IOIMP,*) 'Ouverture OK du fichier FEM' 311 : C ENDIF 312 : 313 : C Changement de dimension (si necessaire) 314 : iOK=0 315 : IDIMI=IDIM 316 : IDIMF=3 317 : NBANC=XCOOR(/1)/(IDIMI+1) 318 : IF (IDIMF.NE.IDIMI) THEN 318 : CALL ECRENT(IDIMF) 318 : CALL ECRCHA('DIME') 318 : CALL OPTION(1) 319 : IF (IERR.NE.0) GOTO 990 320 : WRITE(IOIMP,*) 'Passage en DIMEnsion 3' 321 : ENDIF 322 : idimp1=IDIM+1 323 : 324 : ENDIF 325 : 326 : C Initialisation des segments 327 : JGNOLO=INCJGN 328 : JGNOLU = 1 329 : SEGINI,MLINOE 330 : 331 : JGELLU=INCJGE 332 : JGELLO=INCJGE 333 : JELCON=INCJCO 334 : SEGINI,MLIELE 335 : 336 : SEGINI,MELEQU 337 : 338 : JGCOLO=INCCOM 339 : JGCOLU=INCCOM 340 : SEGINI,MCOMP 341 : 342 : NBPTS=NBANC+JGNOLO 343 : SEGADJ,MCOORD 344 : 345 : 346 : 347 : C Remplissage du tableau d'entier représentant la place dans NOMS (Type d'élément selon CastM3) 348 : C La taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC 349 : DO 9 INDICE = 1, NBGEOM 350 : COLO4=GELEQU(INDICE) 350 : CALL PLACE(NOMS,100,IRETO3,COLO4) 351 : IELEQU(INDICE)=IRETO3 352 : C IF (DEBCB) THEN 353 : C WRITE(IOIMP,*) 'INDICE : ',INDICE 354 : C WRITE(IOIMP,*) 'IRETO3 : ',IRETO3 355 : C ENDIF 356 : 9 CONTINUE 357 : C Lecture du fichier d'entrée 358 : C IF (DEBCB) THEN 359 : C WRITE(IOIMP,*) 'LECTURE DU FICHIER' 360 : C IF (DEBCB) THEN 361 : 362 : 10 CONTINUE 363 : C Lecture de la ligne complete (80 caracteres) 364 : READ(IUFEM,1000,ERR=989,END=100) LIGNE 365 : NBLIGN = NBLIGN + 1 366 : 367 : C A FAIRE 368 : C Coder la lecture de la version de la ligne 3 : sur les 63 premiers cacactères suivants 369 : C $$ Generated using HyperMesh-Optistruct Template Version : 12.0 370 : C Pour déterminer la version de HyperMesh qui a codé ce fichier 371 : 372 : C Premier mot de la ligne 373 : COLO8=LIGNE(1:LEN(COLO8)) 374 : 375 : C Largeur des colonnes à lire par défaut en Simple Précision 376 : PRECID = .FALSE. 377 : 378 : C Recherche si balise de suite d'instruction 378 : CALL PLACE(NREPRI,NBREPR,IRETO4,COLO8) 379 : IF (IRETO4.NE.0) THEN 380 : IF (IRETO4.EQ.2) THEN 381 : PRECID = .TRUE. 382 : ENDIF 383 : GOTO 12 384 : ENDIF 385 : 386 : C Recherche dans le DATA des mots-clés non géométriques 386 : CALL PLACE(NGTYPE,NBNGEO,IRETO2,COLO8) 387 : IF (IRETO2.NE.0) THEN 388 : IVALU = 0 389 : ENDIF 390 : 391 : C Recherche dans le DATA des éléments géométriques 391 : CALL PLACE(GETYPE,NBGEOM,IRETO1,COLO8) 392 : IF (IRETO1.NE.0) THEN 393 : IF (IRETO1.EQ.2) THEN 394 : PRECID = .TRUE. 395 : ENDIF 396 : IVALU = 0 397 : 398 : C Si le type rencontré n'avait pas été rencontré alors j'incrémente le nombre d'objet de ce type 399 : IF ( NOBJ(1+IRETO1).EQ.0) THEN 400 : NOBJ(1) = NOBJ(1) + 1 401 : ENDIF 402 : 403 : C Incrémente le nombre total d'éléments lus dans la dernière case de NOBJ 404 : IF (IRETO1.GT.2) THEN 405 : NOBJ(LONOBJ) = NOBJ(LONOBJ) + 1 406 : ENDIF 407 : 408 : NOBJ(1+IRETO1) = NOBJ(1+IRETO1)+1 409 : NBNPTS = NOBJ(2)+NOBJ(3) 410 : NELTOT = NOBJ(LONOBJ) 411 : ENDIF 412 : 413 : 12 CONTINUE 414 : 415 : C Détermination du Format de Lecture des colonnes 416 : IF (PRECID) THEN 417 : NCOLOL = 4 418 : LCOL = LEN(COLO16) 419 : ELSE 420 : NCOLOL = 9 421 : LCOL = LEN(COLO8) 422 : ENDIF 423 : 424 : C Boucle pour lire les Colonnes qui suivent : 425 : DO 11 ICOL = 1, NCOLOL 426 : IDCOL = LEN(COLO8) + 1 + (ICOL - 1) * LCOL 427 : IFCOL = IDCOL + LCOL 428 : C IF (DEBCB) THEN 429 : C WRITE(IOIMP,*) 'IDCOL : ',IDCOL 430 : C WRITE(IOIMP,*) 'IFCOL : ',IFCOL 431 : C WRITE(IOIMP,*) 'LCOL : ',LCOL 432 : C ENDIF 433 : 434 : TEXT = LIGNE(IDCOL:IFCOL) 435 : IF (PRECID) THEN 436 : COLO16 = LIGNE(IDCOL:IFCOL) 437 : ELSE 438 : COLO8 = LIGNE(IDCOL:IFCOL) 439 : ENDIF 440 : 441 : ICOUR = LCOL 442 : IFINAN= ICOUR+1 443 : 444 : C Correction à la volée d'une caractéristique du format .fem le 'E' n'est pas toujours mis pour les puissances négatives 445 : IF ((IRETO1.EQ.1).AND.(IVALU.GE.1)) THEN 446 : C Cas de la lecture des coordonnées d'un noeud simple precision 447 : IF(COLO8(1:1).EQ.'-')THEN 448 : IADD = 1 449 : ELSE 450 : IADD = 0 451 : ENDIF 452 : 453 : DO 15 ICHARA = 1+IADD, LCOL 454 : IF((COLO8(ICHARA:ICHARA).EQ.'-').AND. 455 : & (COLO8(ICHARA-1:ICHARA-1).NE.'e').AND. 456 : & (COLO8(ICHARA-1:ICHARA-1).NE.'E').AND. 457 : & (COLO8(ICHARA-1:ICHARA-1).NE.'d').AND. 458 : & (COLO8(ICHARA-1:ICHARA-1).NE.'D').AND. 459 : & (COLO8(ICHARA-1:ICHARA-1).NE.' '))THEN 460 : COLO9 =COLO8(1:ICHARA-1)//'E-'//COLO8(ICHARA+1:LCOL) 461 : TEXT = COLO9 462 : ICOUR =LEN(COLO9) 463 : IFINAN=ICOUR+1 464 : C WRITE(IOIMP,*) 'Nouvelle COLO9 : ',COLO9 465 : goto 15 466 : ENDIF 467 : 15 CONTINUE 468 : ELSEIF ((IRETO1.EQ.2).AND.(IVALU.GE.1)) THEN 469 : C Cas de la lecture des coordonnées d'un noeud double precision 470 : IF(COLO16(1:1).EQ.'-')THEN 471 : IADD = 1 472 : ELSE 473 : IADD = 0 474 : ENDIF 475 : 476 : DO 16 ICHARA = 1+IADD, LCOL 477 : IF((COLO16(ICHARA:ICHARA).EQ.'-').AND. 478 : & (COLO16(ICHARA-1:ICHARA-1).NE.'e').AND. 479 : & (COLO16(ICHARA-1:ICHARA-1).NE.'E').AND. 480 : & (COLO16(ICHARA-1:ICHARA-1).NE.'d').AND. 481 : & (COLO16(ICHARA-1:ICHARA-1).NE.'D').AND. 482 : & (COLO16(ICHARA-1:ICHARA-1).NE.' '))THEN 483 : COLO17 =COLO16(1:ICHARA-1)//'E-'// 484 : & COLO16(ICHARA+1:LCOL) 485 : TEXT = COLO17 486 : ICOUR = LEN(COLO17) 487 : IFINAN=ICOUR+1 488 : C WRITE(IOIMP,*) 'Nouvelle COLO17 : ',COLO17 489 : goto 16 490 : ENDIF 491 : 16 CONTINUE 492 : ENDIF 493 : 494 : NRAN = 0 494 : CALL REDLEC(sredle) 495 : 496 : C Poursuite dans le cas ou quelque chose a été lue 497 : IF (IRE.NE.0) THEN 498 : IVALU = IVALU + 1 499 : 500 : C IF (DEBCB) THEN 501 : C WRITE(IOIMP,*) 'TEXT :',TEXT(1:ICOUR) 502 : C WRITE(IOIMP,*) 'IVALU :',IVALU 503 : C IF (IRE.EQ.1) THEN 504 : C WRITE(IOIMP,*) 'Entier Lu :',NFIX 505 : C ENDIF 506 : C IF (IRE.EQ.2) THEN 507 : C WRITE(IOIMP,*) 'Flottant Lu :',FLOT 508 : C ENDIF 509 : C ENDIF 510 : 511 : 512 : C*********************************************************************** 513 : C Traitement des des coordonnées des Noeuds 514 : C*********************************************************************** 515 : IF ((IRETO1.EQ.1).OR.(IRETO1.EQ.2)) THEN 516 : C Ajustement du segment MCOORD 517 : IF (NBNPTS.GT.JGNOLO) THEN 518 : INCJGN = INT(DBLE(INCJGN) * XNCJG) 519 : JGNOLO = JGNOLO + INCJGN 520 : NBPTS = JGNOLO + NBANC 521 : SEGADJ,MLINOE 522 : SEGADJ,MCOORD 523 : C IF (DEBCB) THEN 524 : C WRITE(IOIMP,*) 'Segment MCOORD Ajuste' 525 : C WRITE(IOIMP,*) 'INCJGN : ',INCJGN 526 : C WRITE(IOIMP,*) ' JGNOLO : ',JGNOLO 527 : C WRITE(IOIMP,*) 'NBPTS : ',NBPTS 528 : C ENDIF 529 : ENDIF 530 : 531 : j=(NBANC+NBNPTS-1)*idimp1 532 : 533 : C Lecture du numéro du noeud (TYPE ENTIER) 534 : IF (IVALU.EQ.1) THEN 535 : C Prévoir erreur si pas entier lu 536 : INOC3M(NBNPTS)=NBANC+NBNPTS 537 : INOEHM(NBNPTS)=NFIX 538 : IMAXNO=MAX(IMAXNO,NFIX) 539 : 540 : C Ajustement du segment MLINOE pour le tableau ICORNO(JGNOLU) 541 : IF(IMAXNO.GT.JGNOLU) THEN 542 : INCJGN = INT(DBLE(INCJGN) * XNCJG) 543 : JGNOLU = IMAXNO + INCJGN 544 : SEGADJ,MLINOE 545 : ENDIF 546 : ICORNO(NFIX)=NBNPTS 547 : 548 : C Lecture des 3 Coordonnées qui suivent le numéro du noeud (TYPE FLOT) 549 : ELSEIF((IVALU.GT.1).AND.(IVALU.LE.4)) THEN 550 : IF (IRE.EQ.1) THEN 551 : XCOOR(j+(IVALU-1))=NFIX 552 : C IF (DEBCB) THEN 553 : C WRITE(IOIMP,*) 'Entier Lu :',NFIX 554 : C WRITE(IOIMP,*) 'ICOL-3 :',ICOL-3 555 : C WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1 556 : C ENDIF 557 : ELSEIF (IRE.EQ.2) THEN 558 : XCOOR(j+(IVALU-1))=FLOT 559 : C IF (DEBCB) THEN 560 : C WRITE(IOIMP,*) 'Flottant Lu :',FLOT 561 : C WRITE(IOIMP,*) 'ICOL-3 :',ICOL-3 562 : C WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1 563 : C ENDIF 564 : ENDIF 565 : ELSEIF (IVALU.GT.4) THEN 566 : WRITE(IOIMP,*) 'ERREUR, IVALU > 4 pour des Coordonnées' 567 : ENDIF 568 : C La densité n'a pas d'équivalent dans Hyper Mesh, elle est à 0.D0 par défaut 569 : C XCOOR(j+idimp1)=REAL(0.D0) 570 : 571 : 572 : C*********************************************************************** 573 : C Traitement des ELEMENTS et de leur CONNECTIVITE 574 : C*********************************************************************** 575 : ELSEIF (IRETO1.GE.2) THEN 576 : C Ajustement du segment MLIELE 577 : IF(NELTOT.GT.JGELLO) THEN 578 : INCJGE = INT(DBLE(INCJGE) * XNCJG) 579 : JGELLO = NELTOT + INCJGE 580 : SEGADJ,MLIELE 581 : ENDIF 582 : 583 : IF (IVALU.EQ.1) THEN 584 : C Lecture de l'ID de l'élément 585 : IDLU = NFIX 586 : 587 : C Enregistrement de la correspondance 588 : ICOREL(NELTOT)=IDLU 589 : 590 : IMAXEL=MAX(IMAXEL,IDLU) 591 : C Ajustement du segment MLIELE 592 : IF (IMAXEL.GT.JGELLU) THEN 593 : INCJGE = INT(DBLE(INCJGE) * XNCJG) 594 : JGELLU = IMAXEL + INCJGE 595 : SEGADJ,MLIELE 596 : ENDIF 597 : 598 : IELTYP(IDLU) = IRETO1 599 : 600 : C IF(DEBCB) THEN 601 : C WRITE(IOIMP,*) 'IDLU',IELTYP(IDLU),'IRETO1',IRETO1 602 : C ENDIF 603 : 604 : ELSEIF (IRE.EQ.1) THEN 605 : IF (IRETO1.EQ.3) THEN 606 : C Cas particulier des RBE2 607 : IF (IVALU.EQ.3) THEN 608 : C Pour l'instant cette données n'est pas utilisée (C'est déjà de la mise en donnée Elément Finis) 609 : C Je ne m'occupe pour l'instant que des supports géométriques des éléments 610 : C IF (DEBCB) THEN 611 : C WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8 612 : C ENDIF 613 : ELSE 614 : NBCONN = NBCONN + 1 615 : IF (IVALU.EQ.2) THEN 616 : C Enregistrer ou débute la lecture de la connectivité 617 : IELCON(IDLU)=NBCONN 618 : ENDIF 619 : C Ajustement du segment MLIELE 620 : IF (NBCONN.GT.JELCON) THEN 621 : INCJGE = INT(DBLE(INCJGE) * XNCJG) 622 : JELCON = NBCONN + INCJGE 623 : SEGADJ,MLIELE 624 : ENDIF 625 : 626 : C Enregistrer la connectivité de l'élément 627 : ICONTO(NBCONN)=NFIX 628 : IELNBN(IDLU)=IELNBN(IDLU)+1 629 : C IF (DEBCB) THEN 630 : C WRITE(IOIMP,*) 'IVALU:',IVALU 631 : C WRITE(IOIMP,*) 'REB2 Connectivite :',NFIX 632 : C ENDIF 633 : ENDIF 634 : 635 : ELSEIF (IRETO1.EQ.4) THEN 636 : C Cas particulier des RBE3 637 : IF ((IVALU.EQ.3).OR.(IVALU.EQ.4).OR.(IVALU.EQ.5)) THEN 638 : C Pour l'instant ces données ne sont pas utilisées (C'est déjà de la mise en donnée Elément Finis) 639 : C Je ne m'occupe pour l'instant que des supports géométriques des éléments 640 : C IF (DEBCB) THEN 641 : C WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8 642 : C ENDIF 643 : ELSE 644 : NBCONN = NBCONN + 1 645 : IF (IVALU.EQ.2) THEN 646 : C Enregistrer ou débute la lecture de la connectivité 647 : IELCON(IDLU)=NBCONN 648 : ENDIF 649 : C Ajustement du segment MLIELE 650 : IF (NBCONN.GT.JELCON) THEN 651 : INCJGE = INT(DBLE(INCJGE) * XNCJG) 652 : JELCON = NBCONN + INCJGE 653 : SEGADJ,MLIELE 654 : ENDIF 655 : 656 : C Enregistrer la connectivité de l'élément 657 : ICONTO(NBCONN)=NFIX 658 : IELNBN(IDLU)=IELNBN(IDLU)+1 659 : C IF (DEBCB) THEN 660 : C WRITE(IOIMP,*) 'IVALU:',IVALU 661 : C WRITE(IOIMP,*) 'REB3 Connectivite :',NFIX 662 : C ENDIF 663 : ENDIF 664 : ELSE 665 : C Cas de tous les autres éléments 666 : IF (IVALU.EQ.2) THEN 667 : C Lecture de la Property à laquelle appartient l'élément 668 : IELPRO(IDLU)=NFIX 669 : 670 : ELSE 671 : NBCONN = NBCONN + 1 672 : IF (IVALU.EQ.3) THEN 673 : C Enregistrer ou débute la lecture de la connectivité 674 : IELCON(IDLU)=NBCONN 675 : ENDIF 676 : 677 : C Ajustement du segment MLIELE 678 : IF (NBCONN.GT.JELCON) THEN 679 : INCJGE = INT(DBLE(INCJGE) * XNCJG) 680 : JELCON = NBCONN + INCJGE 681 : SEGADJ,MLIELE 682 : ENDIF 683 : 684 : C Enregistrer la connectivité de l'élément 685 : ICONTO(NBCONN)=NFIX 686 : IELNBN(IDLU)=IELNBN(IDLU)+1 687 : C IF (DEBCB) THEN 688 : C WRITE(IOIMP,*) 'IVALU:',IVALU 689 : C WRITE(IOIMP,*) 'Entier Lu :',NFIX 690 : C WRITE(IOIMP,*) 'IELNBN(IDLU):',IELNBN(IDLU), 691 : C & 'IDLU:',IDLU 692 : C ENDIF 693 : 694 : C Détection d'éléments d'ordre 2 par le nombre de noeuds dans la connectivité 695 : C Pour [IRETO1 >= 9] Exception car les éléments ont des noms identiques pour HM... 696 : IF ((IRETO1.GE.9).AND. 697 : & (IELNBN(IDLU).EQ.GECONN(IRETO1+1))) THEN 698 : IELTYP(IDLU) = IRETO1+1 699 : C IF (DEBCB) THEN 700 : C WRITE(IOIMP,*) 'IDLU:',IDLU, 701 : C & 'Ordre 2 IELTYP(IDLU):',IELTYP(IDLU) 702 : C ENDIF 703 : NOBJ(1+IRETO1) = NOBJ(1+IRETO1)-1 704 : NOBJ(1+IRETO1+1) = NOBJ(1+IRETO1+1)+1 705 : ENDIF 706 : ENDIF 707 : ENDIF 708 : ENDIF 709 : 710 : C*********************************************************************** 711 : C Répartition des éléments dans les Components adéquats 712 : C*********************************************************************** 713 : ELSEIF (IRETO2.EQ.1) THEN 714 : IF (IVALU.EQ.1) THEN 715 : IDCOMP = NFIX 716 : IMAXCO = MAX(IMAXCO,IDCOMP) 717 : C Ajustement du segment MCOMP 718 : IF (IDCOMP.GT.JGCOLU) THEN 719 : INCCOM = INT(DBLE(INCCOM) * XNCJG) 720 : JGCOLU = IDCOMP + INCCOM 721 : SEGADJ,MCOMP 722 : C IF (DEBCB) THEN 723 : C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 1' 724 : C WRITE(IOIMP,*) 'JGCOLU',JGCOLU 725 : C ENDIF 726 : ENDIF 727 : C IF (DEBCB) THEN 728 : C WRITE(IOIMP,*) 'IDCOMP',IDCOMP 729 : C ENDIF 730 : ELSE 731 : IF (COLO8.EQ.'THRU ') THEN 732 : IDLU0 = IDELEM 733 : C IF (DEBCB) THEN 734 : C WRITE(IOIMP,*) 'MOTLU:',COLO8,':' 735 : C WRITE(IOIMP,*) 'IDLU0: ',IDLU0 736 : C ENDIF 737 : ELSE 738 : IF (IRE.EQ.1) THEN 739 : IF (IDLU0.NE.0) THEN 740 : IDLU1 = NFIX 741 : C IF (DEBCB) THEN 742 : C WRITE(IOIMP,*) 'IDLU1: ',IDLU1 743 : C ENDIF 744 : 745 : C BOUCLE entre (IDLU0+1) et IDLU1 (IDLU0 a déjà été traité au premier passage ) 746 : C Enregistrement de l'ID du component auquel appartient l'element 747 : C du type de l'élément lu 748 : C du nombre de type d'éléments dans le component et quels types sont présents 749 : C du nombre d'élément de chaque type dans le component 750 : DO IDELEM=(IDLU0+1),IDLU1 751 : IELCOM(IDELEM) = IDCOMP 752 : IDTYPE = IELTYP(IDELEM) 753 : IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN 754 : NBTYPE(IDCOMP,IDTYPE) = 1 755 : NBTYPE(IDCOMP,NBGEOM+1) = 756 : & NBTYPE(IDCOMP,NBGEOM+1) + 1 757 : ENDIF 758 : NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE)+1 759 : 760 : C IF (DEBCB) THEN 761 : C WRITE(IOIMP,*) 'IDELEM THRU',IDELEM, 762 : C & 'IDCOMP',IDCOMP, 763 : C & 'IDTYPE',IDTYPE, 764 : C & 'NBNO ',GECONN(IDTYPE) 765 : C ENDIF 766 : ENDDO 767 : 768 : C Remise à zéro de IDLU0 769 : IDLU0 = 0 770 : 771 : ELSE 772 : C Enregistrement de l'ID du component auquel appartient l'element 773 : C du type de l'élément lu 774 : C du nombre de type d'éléments dans le component et quels types sont présents 775 : C du nombre d'élément de chaque type dans le component 776 : IDELEM = NFIX 777 : IELCOM(IDELEM) = IDCOMP 778 : IDTYPE = IELTYP(IDELEM) 779 : IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN 780 : NBTYPE(IDCOMP,IDTYPE) = 1 781 : NBTYPE(IDCOMP,NBGEOM+1) = 782 : & NBTYPE(IDCOMP,NBGEOM+1) + 1 783 : ENDIF 784 : NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE) + 1 785 : 786 : C IF (DEBCB) THEN 787 : C WRITE(IOIMP,*) 'IDELEM THRU',IDELEM, 788 : C & 'IDCOMP',IDCOMP, 789 : C & 'IDTYPE',IDTYPE, 790 : C & 'NBNO ',GECONN(IDTYPE) 791 : C ENDIF 792 : ENDIF 793 : ENDIF 794 : ENDIF 795 : ENDIF 796 : 797 : C*********************************************************************** 798 : C Traitement des noms 799 : C*********************************************************************** 800 : ELSEIF (IRETO2.EQ.2) THEN 801 : IF (IVALU.EQ.1) THEN 802 : C Lecture du deuxième mot clé 803 : MOTCL8 = COLO8 804 : 805 : IF (MOTCL8.EQ.'COMP ') THEN 806 : C Incrémentation du nombre de COMPONENT 807 : NBCOMP = NBCOMP + 1 808 : C Ajustement du segment MCOMP 809 : IF (NBCOMP.GT.JGCOLO) THEN 810 : INCCOM = INT(DBLE(INCCOM) * XNCJG) 811 : JGCOLO = NBCOMP + INCCOM 812 : SEGADJ,MCOMP 813 : ENDIF 814 : ENDIF 815 : 816 : C Lecture de d'ID 817 : ELSEIF (IVALU.EQ.2) THEN 818 : IDLU = NFIX 819 : 820 : IF (MOTCL8.EQ.'COMP ') THEN 821 : IMAXCO = MAX(IMAXCO,IDLU) 822 : C Ajustement du segment MCOMP 823 : IF (IDLU.GT.JGCOLU) THEN 824 : INCCOM = INT(DBLE(INCCOM) * XNCJG) 825 : JGCOLU = IDLU + INCCOM 826 : SEGADJ,MCOMP 827 : C IF (DEBCB) THEN 828 : C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 2' 829 : C WRITE(IOIMP,*) 'JGCOLU',JGCOLU 830 : C ENDIF 831 : ENDIF 832 : ICOCOR(NBCOMP)=IDLU 833 : C IF (DEBCB) THEN 834 : C WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN 835 : C ENDIF 836 : ENDIF 837 : 838 : C Lecture du MOT représentant le nom du COMPONENT 839 : ELSEIF (IVALU.EQ.3) THEN 840 : COLO80 = LIGNE(IDCOL+1:80) 841 : 842 : C Retrait de la double côte représentant la fin du nom lu 843 : DO 320 INDICE=2,LEN(COLO80) 844 : IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN 845 : COLO80 = COLO80(1:INDICE-1) 846 : ENDIF 847 : 320 CONTINUE 848 : 849 : IF (MOTCL8.EQ.'COMP ') THEN 850 : NAMECO(IDLU) = COLO80 851 : C IF (DEBCB) THEN 852 : C WRITE(IOIMP,*) 'NAMECO(IDLU):',NAMECO(IDLU) 853 : C & ,':','LIGNE : ',NBLIGN 854 : C ENDIF 855 : ENDIF 856 : ENDIF 857 : 858 : C*********************************************************************** 859 : C Traitement des couleurs 860 : C*********************************************************************** 861 : ELSEIF (IRETO2.EQ.3) THEN 862 : IF (IVALU.EQ.1) THEN 863 : C Lecture du deuxième mot clé 864 : MOTCL8 = COLO8 865 : 866 : C Lecture de d'ID 867 : ELSEIF (IVALU.EQ.2) THEN 868 : IDLU = NFIX 869 : C IF (DEBCB) THEN 870 : C WRITE(IOIMP,*) 'ID lu couleurs :',IDLU 871 : C ENDIF 872 : 873 : C Lecture de l'entier représentant la couleur 874 : ELSEIF (IVALU.EQ.3) THEN 875 : IF (MOTCL8.EQ.' COMP ') THEN 876 : C Cas du sous mot clé ' COMP ' 877 : ICOULC(IDLU) = NFIX 878 : C IF (DEBCB) THEN 879 : C WRITE(IOIMP,*) 'Couleur lue :',NFIX 880 : C ENDIF 881 : ENDIF 882 : ENDIF 883 : ENDIF 884 : ENDIF 885 : 11 CONTINUE 886 : 887 : C IF (DEBCB) THEN 888 : C WRITE(IOIMP,*) 'IVALU :',IVALU 889 : C ENDIF 890 : 891 : GOTO 10 892 : 893 : 100 CONTINUE 894 : 895 : C*********************************************************************** 896 : C Fermeture du fichier en lecture 897 : C*********************************************************************** 898 : C IF (DEBCB) THEN 899 : C WRITE(IOIMP,*) 'Fermeture du fichier en lecture' 900 : C ENDIF 901 : CLOSE(UNIT=IUFEM,ERR=990) 902 : 903 : C Ajustement des segments à la fin 904 : JGNOLO=NBNPTS 905 : JGNOLU=IMAXNO 906 : NBPTS=NBANC+JGNOLO 907 : SEGADJ,MLINOE 908 : SEGADJ,MCOORD 909 : 910 : JGELLU = IMAXEL 911 : JGELLO = NELTOT 912 : JELCON = NBCONN 913 : SEGADJ,MLIELE 914 : 915 : JGCOLO = NBCOMP 916 : JGCOLU = IMAXCO 917 : SEGADJ,MCOMP 918 : C IF (DEBCB) THEN 919 : C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 4' 920 : C WRITE(IOIMP,*) 'JGCOLU',JGCOLU 921 : C WRITE(IOIMP,*) 'JGCOLO',JGCOLO 922 : C WRITE(IOIMP,*) 'Segment MCOORD Ajuste FIN' 923 : C WRITE(IOIMP,*) ' JGNOLO : ',JGNOLO 924 : C WRITE(IOIMP,*) 'NBPTS : ',NBPTS 925 : C WRITE(IOIMP,*) 'NBCOMP = ',NBCOMP 926 : CC Affichage des nombre d'objets lus selon leur Type : 927 : C DO 111 INDICE = 1, LONOBJ 928 : C IF(INDICE.EQ.1) THEN 929 : C WRITE(IOIMP,*) 'Objets Geom :', 930 : C & NOBJ(INDICE) 931 : C ELSEIF (INDICE.LT.LONOBJ) THEN 932 : C WRITE(IOIMP,*) 'Nombre de ',GETYPE(INDICE-1),' :', 933 : C & NOBJ(INDICE) 934 : C ELSE 935 : C WRITE(IOIMP,*) 'Elements total :', 936 : C & NOBJ(INDICE) 937 : C ENDIF 938 : C 111 CONTINUE 939 : C ENDIF 940 : 941 : 942 : 943 : C*********************************************************************** 944 : C Création du tableau des pointeurs qui vont accueillir les MELEME 945 : C De chaque COMPONENT pour chaque TYPE d'élément lu 946 : C*********************************************************************** 947 : C IF (DEBCB) THEN 948 : C WRITE(IOIMP,*) 'NBCOMP',NBCOMP 949 : C ENDIF 950 : DO 210 INDICE = 1, NBCOMP 951 : IDCOMP = ICOCOR(INDICE) 952 : NBSOUS = NBTYPE(IDCOMP,NBGEOM+1) 953 : C IF (DEBCB) THEN 954 : C WRITE(IOIMP,*) 955 : C WRITE(IOIMP,*) 'IDCOMP :',IDCOMP 956 : C WRITE(IOIMP,*) 'NBSOUS',NBSOUS 957 : C ENDIF 958 : IF (NBSOUS.GT.0) THEN 959 : C Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE 960 : DO 211 IDTYPE = 1,NBGEOM 961 : IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN 962 : IPT2 = 0 963 : NBSOUS = 0 964 : NBREF = 0 965 : NBNN = GECONN(IDTYPE) 966 : NBELEM = NBELCO(IDCOMP,IDTYPE) 967 : SEGINI,IPT2 968 : IPT2.ITYPEL = IELEQU(IDTYPE) 969 : 970 : C Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné 971 : NPOINT(IDCOMP,IDTYPE) = IPT2 972 : SEGDES,IPT2 973 : 974 : C IF (DEBCB) THEN 975 : C WRITE(IOIMP,*) 'IDTYPE :',IDTYPE 976 : C WRITE(IOIMP,*) 'NBNN :',GECONN(IDTYPE) 977 : C WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE) 978 : C WRITE(IOIMP,*) 'Pointeur:',IPT2 979 : C ENDIF 980 : ENDIF 981 : 211 CONTINUE 982 : ENDIF 983 : 210 CONTINUE 984 : 985 : C IF (DEBCB) THEN 986 : C WRITE(IOIMP,*) 987 : C WRITE(IOIMP,*) 'Passage 1' 988 : C ENDIF 989 : 990 : 991 : C*********************************************************************** 992 : C Relecture de tous les éléments du maillage 993 : C pour les placer dans le bon MELEME SIMPLE 994 : C*********************************************************************** 995 : DO 220 INDICE = 1,NELTOT 996 : IDELEM = ICOREL(INDICE) 997 : NBNN = IELNBN(IDELEM) 998 : IDCONN = IELCON(IDELEM) 999 : IDCOMP = IELCOM(IDELEM) 1000 : IDTYPE = IELTYP(IDELEM) 1001 : 1002 : C On incrémente le nombre d'élément placés dans le MELEME 1003 : NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1 1004 : IELEME = NBELC2(IDCOMP,IDTYPE) 1005 : IDMAIL = NPOINT(IDCOMP,IDTYPE) 1006 : 1007 : C IF (DEBCB) THEN 1008 : C WRITE(IOIMP,*) 1009 : C WRITE(IOIMP,*) 'INDICE :',INDICE 1010 : C WRITE(IOIMP,*) 'IDELEM :',IDELEM 1011 : C WRITE(IOIMP,*) 'IDCOMP:',IDCOMP 1012 : C WRITE(IOIMP,*) 'IDTYPE:',IDTYPE 1013 : C WRITE(IOIMP,*) 'NBNN :',NBNN 1014 : C WRITE(IOIMP,*) 'IELEME:',IELEME 1015 : C WRITE(IOIMP,*) 'IDMAIL:',IDMAIL 1016 : C ENDIF 1017 : 1018 : C Rechargement du pointeur du bon MELEME à remplir 1019 : IPT2 = IDMAIL 1020 : SEGACT,IPT2*MOD 1021 : C IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP) 1022 : IPT2.ICOLOR(IELEME) = 0 1023 : 1024 : DO 221 JNDICE = 1,NBNN 1025 : C Reconstitution de la connectivité dans l'ordre Cast3M 1026 : ITEST = IORDCO(20* (IDTYPE-1) + JNDICE) 1027 : IDCOLU = ICONTO(IDCONN+(ITEST-1)) 1028 : IDCOCA = ICORNO(IDCOLU)+NBANC 1029 : IPT2.NUM(JNDICE,IELEME) = IDCOCA 1030 : 1031 : C IF (DEBCB) THEN 1032 : C WRITE(IOIMP,*) 'ITEST',ITEST 1033 : C WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA 1034 : C ENDIF 1035 : 221 CONTINUE 1036 : SEGDES,IPT2 1037 : 220 CONTINUE 1038 : 1039 : C IF (DEBCB) THEN 1040 : C WRITE(IOIMP,*) 1041 : C WRITE(IOIMP,*) 'Passage 2' 1042 : C ENDIF 1043 : 1044 : 1045 : 1046 : C*********************************************************************** 1047 : C Création des maillages COMPLEXES composés des MELEME SIMPLES 1048 : C*********************************************************************** 1049 : DO 230 IDCOMP = 1,NBCOMP 1050 : IDCOLU = ICOCOR(IDCOMP) 1051 : COLO39 = NAMECO(IDCOLU) 1052 : NBSOUS = NBTYPE(IDCOLU,NBGEOM+1) 1053 : C IF (DEBCB) THEN 1054 : C WRITE(IOIMP,*) 1055 : C WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS 1056 : C ENDIF 1057 : 1058 : ICOMPT = 0 1059 : DO 231 IDTYPE = 1,NBGEOM 1060 : C Parcours du tableau des MELEME SIMPLES 1061 : 1062 : IF (NBSOUS.EQ.0) THEN 1063 : C Création d'un MELEME SIMPLE vide 1064 : IPT1 = 0 1065 : NBNN = 1 1066 : NBELEM = 0 1067 : NBSOUS = 0 1068 : NBREF = 0 1069 : SEGINI,IPT1 1070 : ELSEIF (NBSOUS.EQ.1) THEN 1071 : IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN 1072 : C Création d'un MELEME SIMPLE à partir du premier pointeur de MELEME SIMPLE rencontré (le seul en théorie car NBSOUS=1) 1073 : IPT1=NPOINT(IDCOLU,IDTYPE) 1074 : SEGACT,IPT1 1075 : ENDIF 1076 : ELSE 1077 : IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN 1078 : IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN 1079 : C Création Initiale du MELEME COMPLEXE 1080 : IPT1 = 0 1081 : NBREF = 0 1082 : NBNN = 0 1083 : NBELEM = 0 1084 : SEGINI,IPT1 1085 : NPOINT(IDCOLU,NBGEOM+1) = IPT1 1086 : ELSE 1087 : C Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés 1088 : IPT1 = NPOINT(IDCOLU,NBGEOM+1) 1089 : SEGACT,IPT1*MOD 1090 : ENDIF 1091 : 1092 : ICOMPT = ICOMPT + 1 1093 : IPT1.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE) 1094 : C IF (DEBCB) THEN 1095 : C WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE 1096 : C WRITE(IOIMP,*) 'Pointeur:',NPOINT(IDCOLU,IDTYPE) 1097 : C WRITE(IOIMP,*) 'IPT1',IPT1 1098 : C ENDIF 1099 : ENDIF 1100 : ENDIF 1101 : 231 CONTINUE 1102 : 1103 : C Ecriture dans la table de Sortie du MELEME COMPLEXE 1103 : CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO39,.FALSE.,0, 1104 : & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT1) 1105 : SEGDES,IPT1 1106 : 230 CONTINUE 1107 : 1108 : WRITE(IOIMP,*) 1109 : 1110 : 1111 : C A la fin on passe au Label 991 pour le ménage final 1112 : GOTO 991 1113 : 1114 : 1115 : 989 CONTINUE 1116 : 1117 : IF (DEBCB) THEN 1118 : WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : ' 1119 : ENDIF 1120 : 1121 : CLOSE(UNIT=IUFEM,ERR=990) 1122 : C IF (DEBCB) THEN 1123 : C WRITE(IOIMP,*) 'Fermeture OK du fichier FEM' 1124 : C ENDIF 1125 : GOTO 991 1126 : 1127 : 1128 : 990 CONTINUE 1129 : 1130 : IF (DEBCB) THEN 1131 : WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : ' 1132 : ENDIF 1133 : GOTO 991 1134 : 1135 : 1136 : 991 CONTINUE 1137 : 1138 : C Traitement des erreurs 1139 : IF (iOK.NE.0 .OR. IERR.NE.0) THEN 1140 : IF (DEBCB) THEN 1141 : WRITE(IOIMP,*)'Sortie ERREUR de la Subroutine LIRFEM' 1142 : ENDIF 1142 : IF (iOK.NE.0) CALL ERREUR(iOK) 1143 : ELSE 1144 : C IF (DEBCB) THEN 1145 : C WRITE(IOIMP,*)'Sortie Normale de la Subroutine LIRFEM' 1146 : C ENDIF 1147 : ENDIF 1148 : 1149 : C*********************************************************************** 1150 : C Sortie de la table résultat 1151 : C*********************************************************************** 1152 : C IF (DEBCB) THEN 1153 : C WRITE(IOIMP,*) 'Sortie de la TABLE résultat' 1154 : C ENDIF 1154 : CALL ECROBJ('TABLE ',MTABLE) 1155 : 1156 : C*********************************************************************** 1157 : C Un peu de ménage dans la mémoire 1158 : C*********************************************************************** 1159 : C IF (DEBCB) THEN 1160 : C WRITE(IOIMP,*) 'Menage dans la mémoire' 1161 : C ENDIF 1162 : SEGSUP,SREDLE 1163 : SEGSUP,MLINOE 1164 : SEGSUP,MLIELE 1165 : SEGSUP,MELEQU 1166 : SEGSUP,MCOMP 1167 : SEGDES,MTABLE 1168 : 1169 : C IF (DEBCB) THEN 1170 : C WRITE(IOIMP,*) 'Sortie Normale de lirfem.eso' 1171 : C ENDIF 1172 : RETURN 1173 : 1174 : END 1175 : 1176 :
© Cast3M 2003 - All rights reserved.
Disclaimer