C LIRFEM SOURCE KK2000 13/11/29 21:15:01 7871 SUBROUTINE LIRFEM CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C BUT: Lecture des données provenant de HyperMesh sous forme de C fichier FEM (ASCII). Les données sont logées dans une table C qui est renvoyée comme résultat. C C Auteur : Clément BERTHINIER C Novembre 2013 C C Liste des Corrections : C 26/11/2013 C Clément B. : Anomalie lors de l'import de coordonnées corrigée C C Appelé par : LIREFI C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) LOGICAL DEBCB LOGICAL PRECID C Définition des COMMON utiles -INC CCOPTIO -INC CCREDLE -INC CCGEOME C Définition des OBJETS utiles C SMCOORD : à ne jamais désactiver contenant les coordonnées des points C SMELEME : objet MAILLAGE C SMTABLE : objet TABLE -INC SMCOORD -INC SMELEME -INC SMTABLE C*********************************************************************** C Définition des différents segments et de leur contenu C*********************************************************************** SEGMENT MLINOE C JGNOLO : ID du noeud dans la numérotation LOCALE C JGNOLU : ID du noeud lu dans le fichier C INOC3M : Numéro du noeud dans la numérotation absolue de Cast3M C INOEHM : Numéro du JGième noeud lu dans le fichier .fem C ICORNO : Correspondance depuis la numérotation lue vers la numérotation LOCALE des noeuds INTEGER INOC3M(JGNOLO) INTEGER INOEHM(JGNOLO) INTEGER ICORNO(JGNOLU) ENDSEGMENT SEGMENT MLIELE C JGELLO : ID de l'élément dans la numérotation LOCALE C JGELLU : ID de l'élément lu dans le fichier C JELCON : Nombre total connectivité lues C IELCON : Ou aller lire le début de la connectivité dans ICONTO C IELNBN : Nombre de noeuds de connectivité à lire dans ICONTO C IELTYP : Type de l'élément lu pour Cast3M C IELPRO : ID de la propriété dans HM (Valeur lue pour IVALU = 2) C IELCOM : ID du component dans HM dans lequel est rangé cet élément C ICONTO : Tableau dans lequel sont placées toutes les connectivités les unes après les autres C ICOREL : Correspondance depuis la numérotation LOCALE vers la numérotation lue des ELEMENTS INTEGER IELCON(JGELLU) INTEGER IELNBN(JGELLU) INTEGER IELTYP(JGELLU) INTEGER IELPRO(JGELLU) INTEGER IELCOM(JGELLU) INTEGER ICONTO(JELCON) INTEGER ICOREL(JGELLO) ENDSEGMENT SEGMENT MELEQU C Dans ce tableau dynamique sera stoquée la place dans NOMS (voir bdata.eso) des éléments équivalents Cast3M INTEGER IELEQU(NBGEOM) ENDSEGMENT C Segment contenant tout ce qui sera utile pour définir un component au sens HM SEGMENT MCOMP C JGCOLO : Indice du composant dans la numérotation LOCALE C JGCOLU : ID lu dans le fichier C NBGEOM : Nombre de types d'éléments relu dans HM C NAMECO : Nom des components C ICOULC : Couleur des components C NBTYPE : Nombre de types d'éléments dans le component + le nombre total de sous type (NBSOUS) C NBELCO : Nombre d'éléments de chaque type dans le component (NBELEM) C NBELC2 : Nombre d'éléments de chaque type dans le component a mesure qu'ils sont triés (à la fin) 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 C ICOCOR : Correspondance entre la numérotation LOCALE et HM des components CHARACTER*40 NAMECO(JGCOLU) INTEGER ICOULC(JGCOLU) INTEGER NBTYPE(JGCOLU,NBGEOM+1) INTEGER NBELCO(JGCOLU,NBGEOM) INTEGER NBELC2(JGCOLU,NBGEOM) INTEGER NPOINT(JGCOLU,NBGEOM+1) INTEGER ICOCOR(JGCOLO) ENDSEGMENT C*********************************************************************** C Définition des DATA et déclarations diverses C*********************************************************************** C Unite logique du fichier d'impression au format .fem et nom du fichier PARAMETER (IUFEM=67) C Déclaration des chaines de caractères utiles CHARACTER*256 FicFem CHARACTER*80 LIGNE CHARACTER*4 COLO4 CHARACTER*8 MOTCL8 CHARACTER*8 COLO8 CHARACTER*9 COLO9 CHARACTER*16 COLO16 CHARACTER*17 COLO17 CHARACTER*40 COLO39 CHARACTER*80 COLO80 C Liste des mots clé non Géométrique en début de ligne d'un fichier .fem PARAMETER (NBNGEO=3) CHARACTER*8 NGTYPE(NBNGEO) DATA NGTYPE / '$HMMOVE ', & '$HMNAME ', & '$HWCOLOR' / C Liste des mots clé non Géométrique en début de ligne d'un fichier .fem PARAMETER (NBREPR=3) CHARACTER*8 NREPRI(NBREPR) DATA NREPRI / '+ ', & '* ', & '$ ' / C Liste des mots clé de Géométrie en début de ligne d'un fichier .fem PARAMETER (NBGEOM=16) CHARACTER*8 GETYPE(NBGEOM) DATA GETYPE / 'GRID ','GRID* ', & 'RBE2 ','RBE3 ', & 'CTRIA3 ','CTRIA6 ', & 'CQUAD4 ','CQUAD8 ', & 'CTETRA ','CTETRA10', & 'CPYRA ','CPYRA13 ', & 'CPENTA ','CPENTA15', & 'CHEXA ','CHEXA20 ' / CHARACTER*4 GELEQU(NBGEOM) DATA GELEQU / 'POI1','POI1', & 'SEG2','SEG3', & 'TRI3','TRI6', & 'QUA4','QUA8', & 'TET4','TE10', & 'PYR5','PY13', & 'PRI6','PR15', & 'CUB8','CU20' / C Data indiquant le nombre de noeud de connectivité INTEGER GECONN(NBGEOM) DATA GECONN / 1,1 , & 2,3 , & 3,6 , & 4,8 , & 4,10, & 5,13, & 6,15, & 8,20 / C Data permettrant de mettre le bon ordre dans la connectivité des éléments C Le facteur 20 de ce DATA vient du fait que l'élément le plus C Complexe a une connectivité à 20 éléments (CU20 ou HEXA 2nd Ordre) INTEGER IORDCO(NBGEOM*20) DATA IORDCO / & 1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , POI1 & 1,0,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , POI1 & 1,2,0,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG2 & 3,1,2,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , SEG3 & 1,2,3,0 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI3 & 1,4,2,5 ,3,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TRI6 & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA4 & 1,5,2,6 ,3,7 ,4 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , QUA8 & 1,2,3,4 ,0,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TET4 & 1,5,2,6 ,3,7 ,8 ,9 ,10,4 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , TE10 & 1,2,3,4 ,5,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PYR5 & 2,7,3,8 ,4,9 ,1 ,6 ,11,12,13,10,5 ,0 ,0 ,0 ,0,0 ,0,0 , PY13 & 1,2,3,4 ,5,6 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , PRI6 & 1,7,2,8 ,3,9 ,10,11,12,4 ,13,5 ,14,6 ,15,0 ,0,0 ,0,0 , PR15 & 1,2,3,4 ,5,6 ,7 ,8 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0,0 ,0,0 , CUB8 & 1,9,2,10,3,11,4 ,12,13,14,15,16,5 ,17,6 ,18,7,19,8,20 / CU20 PARAMETER (LONOBJ=1+NBGEOM+1) INTEGER NOBJ(LONOBJ) C NOBJ( 1 ) : Nbr d'objets géométriques différents lus C NOBJ( n ) : Nombre d'objets géométriques de chaque type Lus C NOBJ(end) : Nombre d'éléments lu au total C Option de Débuggage par Clément BERTHINIER DEBCB = .TRUE. C DEBCB = .FALSE. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C IF (DEBCB) THEN C WRITE(IOIMP,*)'Entree dans la Subroutine LIRFEM ' C ENDIF C Création de la table VIDE de sortie M=0 SEGINI,MTABLE C Format de lecture d'un fichier .fem C 10 fois 8 caractères par ligne en simple précision C 5 fois 16 caractères par ligne en double précision 1000 FORMAT(A80) C Initialisation des Segments MLINOE = 0 MLIELE = 0 MELEQU = 0 MCOMP = 0 C Initialisations autres INCJGN = 5000 INCJGE = 5000 INCJCO = 5000 INCCOM = 10 IRETO1 = 0 IRETO2 = 0 IRETO3 = 0 IRETO4 = 0 IVALU = 0 IDLU = 0 IDLU0 = 0 IDLU1 = 0 IDCOMP = 0 IDTYPE = 0 IDELEM = 0 IDCONN = 0 IDCOCA = 0 IDCOLU = 0 IDMAIL = 0 INDICE = 0 JNDICE = 0 ICOL = 0 ITEST = 0 IADD = 0 IPT1 = 0 IPT2 = 0 IMAXNO = 0 IMAXEL = 0 IMAXCO = 0 LCOL = 0 NCOLOL = 0 NBCONN = 0 NBCOMP = 0 NBLIGN = 0 NBNPTS = 0 NELTOT = 0 XNCJG = 2.0D0 PRECID = .FALSE. C Tableau NOBJ initialisé à 0 DO 1 INDICE = 1, LONOBJ NOBJ(INDICE)=0 1 CONTINUE C Lecture des arguments : Nom du fichier à lire (toto.fem) CALL LIRCHA(FicFem,1,IRETO1) IF (IERR.NE.0) RETURN C IF (DEBCB) THEN C WRITE(IOIMP,*)'Fichier en entree : ',FicFem C ENDIF C Segment de lecture d'une ligne ... SEGINI,sredle SEPARA=.FALSE. MOT=' ' C Par defaut, Erreur Cast3M numero 424 C Erreur 424 : Problème %i1 en ouvrant le fichier : %m1:40 iOK=424 L=LEN(FicFem) MOTERR(1:L)=FicFem(1:L) INTERR(1)=0 C Ouverture du fichier .fem CLOSE(UNIT=IUFEM,ERR=990) OPEN(UNIT=IUFEM,STATUS='OLD',FILE=FicFem(1:L), & IOSTAT=IOS,FORM='FORMATTED') C Traitement des erreurs d'ouverture des fichiers IF (IOS.NE.0) THEN INTERR(1)=IOS IF (DEBCB) THEN WRITE(IOIMP,*) 'Fichier introuvable : ',FicFem ENDIF GOTO 990 ELSE iOK=0 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Ouverture OK du fichier FEM' C ENDIF C Changement de dimension (si necessaire) iOK=0 IDIMI=IDIM IDIMF=3 NBANC=XCOOR(/1)/(IDIMI+1) IF (IDIMF.NE.IDIMI) THEN CALL ECRENT(IDIMF) CALL ECRCHA('DIME') CALL OPTION(1) IF (IERR.NE.0) GOTO 990 WRITE(IOIMP,*) 'Passage en DIMEnsion 3' ENDIF idimp1=IDIM+1 ENDIF C Initialisation des segments JGNOLO=INCJGN JGNOLU = 1 SEGINI,MLINOE JGELLU=INCJGE JGELLO=INCJGE JELCON=INCJCO SEGINI,MLIELE SEGINI,MELEQU JGCOLO=INCCOM JGCOLU=INCCOM SEGINI,MCOMP NBPTS=NBANC+JGNOLO SEGADJ,MCOORD C Remplissage du tableau d'entier représentant la place dans NOMS (Type d'élément selon CastM3) C La taille de NOMS est spécifiée maximum égale à 100 dans CCGEOME.INC DO 9 INDICE = 1, NBGEOM COLO4=GELEQU(INDICE) CALL PLACE(NOMS,100,IRETO3,COLO4) IELEQU(INDICE)=IRETO3 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'INDICE : ',INDICE C WRITE(IOIMP,*) 'IRETO3 : ',IRETO3 C ENDIF 9 CONTINUE C Lecture du fichier d'entrée C IF (DEBCB) THEN C WRITE(IOIMP,*) 'LECTURE DU FICHIER' C IF (DEBCB) THEN 10 CONTINUE C Lecture de la ligne complete (80 caracteres) READ(IUFEM,1000,ERR=989,END=100) LIGNE NBLIGN = NBLIGN + 1 C A FAIRE C Coder la lecture de la version de la ligne 3 : sur les 63 premiers cacactères suivants C $$ Generated using HyperMesh-Optistruct Template Version : 12.0 C Pour déterminer la version de HyperMesh qui a codé ce fichier C Premier mot de la ligne COLO8=LIGNE(1:LEN(COLO8)) C Largeur des colonnes à lire par défaut en Simple Précision PRECID = .FALSE. C Recherche si balise de suite d'instruction CALL PLACE(NREPRI,NBREPR,IRETO4,COLO8) IF (IRETO4.NE.0) THEN IF (IRETO4.EQ.2) THEN PRECID = .TRUE. ENDIF GOTO 12 ENDIF C Recherche dans le DATA des mots-clés non géométriques CALL PLACE(NGTYPE,NBNGEO,IRETO2,COLO8) IF (IRETO2.NE.0) THEN IVALU = 0 ENDIF C Recherche dans le DATA des éléments géométriques CALL PLACE(GETYPE,NBGEOM,IRETO1,COLO8) IF (IRETO1.NE.0) THEN IF (IRETO1.EQ.2) THEN PRECID = .TRUE. ENDIF IVALU = 0 C Si le type rencontré n'avait pas été rencontré alors j'incrémente le nombre d'objet de ce type IF ( NOBJ(1+IRETO1).EQ.0) THEN NOBJ(1) = NOBJ(1) + 1 ENDIF C Incrémente le nombre total d'éléments lus dans la dernière case de NOBJ IF (IRETO1.GT.2) THEN NOBJ(LONOBJ) = NOBJ(LONOBJ) + 1 ENDIF NOBJ(1+IRETO1) = NOBJ(1+IRETO1)+1 NBNPTS = NOBJ(2)+NOBJ(3) NELTOT = NOBJ(LONOBJ) ENDIF 12 CONTINUE C Détermination du Format de Lecture des colonnes IF (PRECID) THEN NCOLOL = 4 LCOL = LEN(COLO16) ELSE NCOLOL = 9 LCOL = LEN(COLO8) ENDIF C Boucle pour lire les Colonnes qui suivent : DO 11 ICOL = 1, NCOLOL IDCOL = LEN(COLO8) + 1 + (ICOL - 1) * LCOL IFCOL = IDCOL + LCOL C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDCOL : ',IDCOL C WRITE(IOIMP,*) 'IFCOL : ',IFCOL C WRITE(IOIMP,*) 'LCOL : ',LCOL C ENDIF TEXT = LIGNE(IDCOL:IFCOL) IF (PRECID) THEN COLO16 = LIGNE(IDCOL:IFCOL) ELSE COLO8 = LIGNE(IDCOL:IFCOL) ENDIF ICOUR = LCOL IFINAN= ICOUR+1 C Correction à la volée d'une caractéristique du format .fem le 'E' n'est pas toujours mis pour les puissances négatives IF ((IRETO1.EQ.1).AND.(IVALU.GE.1)) THEN C Cas de la lecture des coordonnées d'un noeud simple precision IF(COLO8(1:1).EQ.'-')THEN IADD = 1 ELSE IADD = 0 ENDIF DO 15 ICHARA = 1+IADD, LCOL IF((COLO8(ICHARA:ICHARA).EQ.'-').AND. & (COLO8(ICHARA-1:ICHARA-1).NE.'e').AND. & (COLO8(ICHARA-1:ICHARA-1).NE.'E').AND. & (COLO8(ICHARA-1:ICHARA-1).NE.'d').AND. & (COLO8(ICHARA-1:ICHARA-1).NE.'D').AND. & (COLO8(ICHARA-1:ICHARA-1).NE.' '))THEN COLO9 =COLO8(1:ICHARA-1)//'E-'//COLO8(ICHARA+1:LCOL) TEXT = COLO9 ICOUR =LEN(COLO9) IFINAN=ICOUR+1 C WRITE(IOIMP,*) 'Nouvelle COLO9 : ',COLO9 goto 15 ENDIF 15 CONTINUE ELSEIF ((IRETO1.EQ.2).AND.(IVALU.GE.1)) THEN C Cas de la lecture des coordonnées d'un noeud double precision IF(COLO16(1:1).EQ.'-')THEN IADD = 1 ELSE IADD = 0 ENDIF DO 16 ICHARA = 1+IADD, LCOL IF((COLO16(ICHARA:ICHARA).EQ.'-').AND. & (COLO16(ICHARA-1:ICHARA-1).NE.'e').AND. & (COLO16(ICHARA-1:ICHARA-1).NE.'E').AND. & (COLO16(ICHARA-1:ICHARA-1).NE.'d').AND. & (COLO16(ICHARA-1:ICHARA-1).NE.'D').AND. & (COLO16(ICHARA-1:ICHARA-1).NE.' '))THEN COLO17 =COLO16(1:ICHARA-1)//'E-'// & COLO16(ICHARA+1:LCOL) TEXT = COLO17 ICOUR = LEN(COLO17) IFINAN=ICOUR+1 C WRITE(IOIMP,*) 'Nouvelle COLO17 : ',COLO17 goto 16 ENDIF 16 CONTINUE ENDIF NRAN = 0 CALL REDLEC(sredle) C Poursuite dans le cas ou quelque chose a été lue IF (IRE.NE.0) THEN IVALU = IVALU + 1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'TEXT :',TEXT(1:ICOUR) C WRITE(IOIMP,*) 'IVALU :',IVALU C IF (IRE.EQ.1) THEN C WRITE(IOIMP,*) 'Entier Lu :',NFIX C ENDIF C IF (IRE.EQ.2) THEN C WRITE(IOIMP,*) 'Flottant Lu :',FLOT C ENDIF C ENDIF C*********************************************************************** C Traitement des des coordonnées des Noeuds C*********************************************************************** IF ((IRETO1.EQ.1).OR.(IRETO1.EQ.2)) THEN C Ajustement du segment MCOORD IF (NBNPTS.GT.JGNOLO) THEN INCJGN = INT(DBLE(INCJGN) * XNCJG) JGNOLO = JGNOLO + INCJGN NBPTS = JGNOLO + NBANC SEGADJ,MLINOE SEGADJ,MCOORD C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Segment MCOORD Ajuste' C WRITE(IOIMP,*) 'INCJGN : ',INCJGN C WRITE(IOIMP,*) ' JGNOLO : ',JGNOLO C WRITE(IOIMP,*) 'NBPTS : ',NBPTS C ENDIF ENDIF j=(NBANC+NBNPTS-1)*idimp1 C Lecture du numéro du noeud (TYPE ENTIER) IF (IVALU.EQ.1) THEN C Prévoir erreur si pas entier lu INOC3M(NBNPTS)=NBANC+NBNPTS INOEHM(NBNPTS)=NFIX IMAXNO=MAX(IMAXNO,NFIX) C Ajustement du segment MLINOE pour le tableau ICORNO(JGNOLU) IF(IMAXNO.GT.JGNOLU) THEN INCJGN = INT(DBLE(INCJGN) * XNCJG) JGNOLU = IMAXNO + INCJGN SEGADJ,MLINOE ENDIF ICORNO(NFIX)=NBNPTS C Lecture des 3 Coordonnées qui suivent le numéro du noeud (TYPE FLOT) ELSEIF((IVALU.GT.1).AND.(IVALU.LE.4)) THEN IF (IRE.EQ.1) THEN XCOOR(j+(IVALU-1))=NFIX C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Entier Lu :',NFIX C WRITE(IOIMP,*) 'ICOL-3 :',ICOL-3 C WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1 C ENDIF ELSEIF (IRE.EQ.2) THEN XCOOR(j+(IVALU-1))=FLOT C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Flottant Lu :',FLOT C WRITE(IOIMP,*) 'ICOL-3 :',ICOL-3 C WRITE(IOIMP,*) 'IVALU-1 :',IVALU-1 C ENDIF ENDIF ELSEIF (IVALU.GT.4) THEN WRITE(IOIMP,*) 'ERREUR, IVALU > 4 pour des Coordonnées' ENDIF C La densité n'a pas d'équivalent dans Hyper Mesh, elle est à 0.D0 par défaut C XCOOR(j+idimp1)=REAL(0.D0) C*********************************************************************** C Traitement des ELEMENTS et de leur CONNECTIVITE C*********************************************************************** ELSEIF (IRETO1.GE.2) THEN C Ajustement du segment MLIELE IF(NELTOT.GT.JGELLO) THEN INCJGE = INT(DBLE(INCJGE) * XNCJG) JGELLO = NELTOT + INCJGE SEGADJ,MLIELE ENDIF IF (IVALU.EQ.1) THEN C Lecture de l'ID de l'élément IDLU = NFIX C Enregistrement de la correspondance ICOREL(NELTOT)=IDLU IMAXEL=MAX(IMAXEL,IDLU) C Ajustement du segment MLIELE IF (IMAXEL.GT.JGELLU) THEN INCJGE = INT(DBLE(INCJGE) * XNCJG) JGELLU = IMAXEL + INCJGE SEGADJ,MLIELE ENDIF IELTYP(IDLU) = IRETO1 C IF(DEBCB) THEN C WRITE(IOIMP,*) 'IDLU',IELTYP(IDLU),'IRETO1',IRETO1 C ENDIF ELSEIF (IRE.EQ.1) THEN IF (IRETO1.EQ.3) THEN C Cas particulier des RBE2 IF (IVALU.EQ.3) THEN 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) C Je ne m'occupe pour l'instant que des supports géométriques des éléments C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8 C ENDIF ELSE NBCONN = NBCONN + 1 IF (IVALU.EQ.2) THEN C Enregistrer ou débute la lecture de la connectivité IELCON(IDLU)=NBCONN ENDIF C Ajustement du segment MLIELE IF (NBCONN.GT.JELCON) THEN INCJGE = INT(DBLE(INCJGE) * XNCJG) JELCON = NBCONN + INCJGE SEGADJ,MLIELE ENDIF C Enregistrer la connectivité de l'élément ICONTO(NBCONN)=NFIX IELNBN(IDLU)=IELNBN(IDLU)+1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IVALU:',IVALU C WRITE(IOIMP,*) 'REB2 Connectivite :',NFIX C ENDIF ENDIF ELSEIF (IRETO1.EQ.4) THEN C Cas particulier des RBE3 IF ((IVALU.EQ.3).OR.(IVALU.EQ.4).OR.(IVALU.EQ.5)) THEN 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) C Je ne m'occupe pour l'instant que des supports géométriques des éléments C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Degres bloques RBE2',COLO8 C ENDIF ELSE NBCONN = NBCONN + 1 IF (IVALU.EQ.2) THEN C Enregistrer ou débute la lecture de la connectivité IELCON(IDLU)=NBCONN ENDIF C Ajustement du segment MLIELE IF (NBCONN.GT.JELCON) THEN INCJGE = INT(DBLE(INCJGE) * XNCJG) JELCON = NBCONN + INCJGE SEGADJ,MLIELE ENDIF C Enregistrer la connectivité de l'élément ICONTO(NBCONN)=NFIX IELNBN(IDLU)=IELNBN(IDLU)+1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IVALU:',IVALU C WRITE(IOIMP,*) 'REB3 Connectivite :',NFIX C ENDIF ENDIF ELSE C Cas de tous les autres éléments IF (IVALU.EQ.2) THEN C Lecture de la Property à laquelle appartient l'élément IELPRO(IDLU)=NFIX ELSE NBCONN = NBCONN + 1 IF (IVALU.EQ.3) THEN C Enregistrer ou débute la lecture de la connectivité IELCON(IDLU)=NBCONN ENDIF C Ajustement du segment MLIELE IF (NBCONN.GT.JELCON) THEN INCJGE = INT(DBLE(INCJGE) * XNCJG) JELCON = NBCONN + INCJGE SEGADJ,MLIELE ENDIF C Enregistrer la connectivité de l'élément ICONTO(NBCONN)=NFIX IELNBN(IDLU)=IELNBN(IDLU)+1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IVALU:',IVALU C WRITE(IOIMP,*) 'Entier Lu :',NFIX C WRITE(IOIMP,*) 'IELNBN(IDLU):',IELNBN(IDLU), C & 'IDLU:',IDLU C ENDIF C Détection d'éléments d'ordre 2 par le nombre de noeuds dans la connectivité C Pour [IRETO1 >= 9] Exception car les éléments ont des noms identiques pour HM... IF ((IRETO1.GE.9).AND. & (IELNBN(IDLU).EQ.GECONN(IRETO1+1))) THEN IELTYP(IDLU) = IRETO1+1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDLU:',IDLU, C & 'Ordre 2 IELTYP(IDLU):',IELTYP(IDLU) C ENDIF NOBJ(1+IRETO1) = NOBJ(1+IRETO1)-1 NOBJ(1+IRETO1+1) = NOBJ(1+IRETO1+1)+1 ENDIF ENDIF ENDIF ENDIF C*********************************************************************** C Répartition des éléments dans les Components adéquats C*********************************************************************** ELSEIF (IRETO2.EQ.1) THEN IF (IVALU.EQ.1) THEN IDCOMP = NFIX IMAXCO = MAX(IMAXCO,IDCOMP) C Ajustement du segment MCOMP IF (IDCOMP.GT.JGCOLU) THEN INCCOM = INT(DBLE(INCCOM) * XNCJG) JGCOLU = IDCOMP + INCCOM SEGADJ,MCOMP C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 1' C WRITE(IOIMP,*) 'JGCOLU',JGCOLU C ENDIF ENDIF C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDCOMP',IDCOMP C ENDIF ELSE IF (COLO8.EQ.'THRU ') THEN IDLU0 = IDELEM C IF (DEBCB) THEN C WRITE(IOIMP,*) 'MOTLU:',COLO8,':' C WRITE(IOIMP,*) 'IDLU0: ',IDLU0 C ENDIF ELSE IF (IRE.EQ.1) THEN IF (IDLU0.NE.0) THEN IDLU1 = NFIX C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDLU1: ',IDLU1 C ENDIF C BOUCLE entre (IDLU0+1) et IDLU1 (IDLU0 a déjà été traité au premier passage ) C Enregistrement de l'ID du component auquel appartient l'element C du type de l'élément lu C du nombre de type d'éléments dans le component et quels types sont présents C du nombre d'élément de chaque type dans le component DO IDELEM=(IDLU0+1),IDLU1 IELCOM(IDELEM) = IDCOMP IDTYPE = IELTYP(IDELEM) IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN NBTYPE(IDCOMP,IDTYPE) = 1 NBTYPE(IDCOMP,NBGEOM+1) = & NBTYPE(IDCOMP,NBGEOM+1) + 1 ENDIF NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE)+1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDELEM THRU',IDELEM, C & 'IDCOMP',IDCOMP, C & 'IDTYPE',IDTYPE, C & 'NBNO ',GECONN(IDTYPE) C ENDIF ENDDO C Remise à zéro de IDLU0 IDLU0 = 0 ELSE C Enregistrement de l'ID du component auquel appartient l'element C du type de l'élément lu C du nombre de type d'éléments dans le component et quels types sont présents C du nombre d'élément de chaque type dans le component IDELEM = NFIX IELCOM(IDELEM) = IDCOMP IDTYPE = IELTYP(IDELEM) IF (NBELCO(IDCOMP,IDTYPE).EQ.0) THEN NBTYPE(IDCOMP,IDTYPE) = 1 NBTYPE(IDCOMP,NBGEOM+1) = & NBTYPE(IDCOMP,NBGEOM+1) + 1 ENDIF NBELCO(IDCOMP,IDTYPE) = NBELCO(IDCOMP,IDTYPE) + 1 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDELEM THRU',IDELEM, C & 'IDCOMP',IDCOMP, C & 'IDTYPE',IDTYPE, C & 'NBNO ',GECONN(IDTYPE) C ENDIF ENDIF ENDIF ENDIF ENDIF C*********************************************************************** C Traitement des noms C*********************************************************************** ELSEIF (IRETO2.EQ.2) THEN IF (IVALU.EQ.1) THEN C Lecture du deuxième mot clé MOTCL8 = COLO8 IF (MOTCL8.EQ.'COMP ') THEN C Incrémentation du nombre de COMPONENT NBCOMP = NBCOMP + 1 C Ajustement du segment MCOMP IF (NBCOMP.GT.JGCOLO) THEN INCCOM = INT(DBLE(INCCOM) * XNCJG) JGCOLO = NBCOMP + INCCOM SEGADJ,MCOMP ENDIF ENDIF C Lecture de d'ID ELSEIF (IVALU.EQ.2) THEN IDLU = NFIX IF (MOTCL8.EQ.'COMP ') THEN IMAXCO = MAX(IMAXCO,IDLU) C Ajustement du segment MCOMP IF (IDLU.GT.JGCOLU) THEN INCCOM = INT(DBLE(INCCOM) * XNCJG) JGCOLU = IDLU + INCCOM SEGADJ,MCOMP C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 2' C WRITE(IOIMP,*) 'JGCOLU',JGCOLU C ENDIF ENDIF ICOCOR(NBCOMP)=IDLU C IF (DEBCB) THEN C WRITE(IOIMP,*) 'ID lu noms :',IDLU,'LIGNE : ',NBLIGN C ENDIF ENDIF C Lecture du MOT représentant le nom du COMPONENT ELSEIF (IVALU.EQ.3) THEN COLO80 = LIGNE(IDCOL+1:80) C Retrait de la double côte représentant la fin du nom lu DO 320 INDICE=2,LEN(COLO80) IF ((COLO80(INDICE:INDICE)).EQ.'"') THEN COLO80 = COLO80(1:INDICE-1) ENDIF 320 CONTINUE IF (MOTCL8.EQ.'COMP ') THEN NAMECO(IDLU) = COLO80 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'NAMECO(IDLU):',NAMECO(IDLU) C & ,':','LIGNE : ',NBLIGN C ENDIF ENDIF ENDIF C*********************************************************************** C Traitement des couleurs C*********************************************************************** ELSEIF (IRETO2.EQ.3) THEN IF (IVALU.EQ.1) THEN C Lecture du deuxième mot clé MOTCL8 = COLO8 C Lecture de d'ID ELSEIF (IVALU.EQ.2) THEN IDLU = NFIX C IF (DEBCB) THEN C WRITE(IOIMP,*) 'ID lu couleurs :',IDLU C ENDIF C Lecture de l'entier représentant la couleur ELSEIF (IVALU.EQ.3) THEN IF (MOTCL8.EQ.' COMP ') THEN C Cas du sous mot clé ' COMP ' ICOULC(IDLU) = NFIX C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Couleur lue :',NFIX C ENDIF ENDIF ENDIF ENDIF ENDIF 11 CONTINUE C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IVALU :',IVALU C ENDIF GOTO 10 100 CONTINUE C*********************************************************************** C Fermeture du fichier en lecture C*********************************************************************** C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Fermeture du fichier en lecture' C ENDIF CLOSE(UNIT=IUFEM,ERR=990) C Ajustement des segments à la fin JGNOLO=NBNPTS JGNOLU=IMAXNO NBPTS=NBANC+JGNOLO SEGADJ,MLINOE SEGADJ,MCOORD JGELLU = IMAXEL JGELLO = NELTOT JELCON = NBCONN SEGADJ,MLIELE JGCOLO = NBCOMP JGCOLU = IMAXCO SEGADJ,MCOMP C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Ajustement du segment MCOMP 4' C WRITE(IOIMP,*) 'JGCOLU',JGCOLU C WRITE(IOIMP,*) 'JGCOLO',JGCOLO C WRITE(IOIMP,*) 'Segment MCOORD Ajuste FIN' C WRITE(IOIMP,*) ' JGNOLO : ',JGNOLO C WRITE(IOIMP,*) 'NBPTS : ',NBPTS C WRITE(IOIMP,*) 'NBCOMP = ',NBCOMP CC Affichage des nombre d'objets lus selon leur Type : C DO 111 INDICE = 1, LONOBJ C IF(INDICE.EQ.1) THEN C WRITE(IOIMP,*) 'Objets Geom :', C & NOBJ(INDICE) C ELSEIF (INDICE.LT.LONOBJ) THEN C WRITE(IOIMP,*) 'Nombre de ',GETYPE(INDICE-1),' :', C & NOBJ(INDICE) C ELSE C WRITE(IOIMP,*) 'Elements total :', C & NOBJ(INDICE) C ENDIF C 111 CONTINUE C ENDIF C*********************************************************************** C Création du tableau des pointeurs qui vont accueillir les MELEME C De chaque COMPONENT pour chaque TYPE d'élément lu C*********************************************************************** C IF (DEBCB) THEN C WRITE(IOIMP,*) 'NBCOMP',NBCOMP C ENDIF DO 210 INDICE = 1, NBCOMP IDCOMP = ICOCOR(INDICE) NBSOUS = NBTYPE(IDCOMP,NBGEOM+1) C IF (DEBCB) THEN C WRITE(IOIMP,*) C WRITE(IOIMP,*) 'IDCOMP :',IDCOMP C WRITE(IOIMP,*) 'NBSOUS',NBSOUS C ENDIF IF (NBSOUS.GT.0) THEN C Construction des pointeurs des MELEME : OBJETS GEOMETRIQUES SIMPLE DO 211 IDTYPE = 1,NBGEOM IF (NBELCO(IDCOMP,IDTYPE).GT.0) THEN IPT2 = 0 NBSOUS = 0 NBREF = 0 NBNN = GECONN(IDTYPE) NBELEM = NBELCO(IDCOMP,IDTYPE) SEGINI,IPT2 IPT2.ITYPEL = IELEQU(IDTYPE) C Enregistrement dans un tableau du numéro de pointeur vers le MELEME non renseigné NPOINT(IDCOMP,IDTYPE) = IPT2 SEGDES,IPT2 C IF (DEBCB) THEN C WRITE(IOIMP,*) 'IDTYPE :',IDTYPE C WRITE(IOIMP,*) 'NBNN :',GECONN(IDTYPE) C WRITE(IOIMP,*) 'NB_ELEM :',NBELCO(IDCOMP,IDTYPE) C WRITE(IOIMP,*) 'Pointeur:',IPT2 C ENDIF ENDIF 211 CONTINUE ENDIF 210 CONTINUE C IF (DEBCB) THEN C WRITE(IOIMP,*) C WRITE(IOIMP,*) 'Passage 1' C ENDIF C*********************************************************************** C Relecture de tous les éléments du maillage C pour les placer dans le bon MELEME SIMPLE C*********************************************************************** DO 220 INDICE = 1,NELTOT IDELEM = ICOREL(INDICE) NBNN = IELNBN(IDELEM) IDCONN = IELCON(IDELEM) IDCOMP = IELCOM(IDELEM) IDTYPE = IELTYP(IDELEM) C On incrémente le nombre d'élément placés dans le MELEME NBELC2(IDCOMP,IDTYPE) = NBELC2(IDCOMP,IDTYPE) + 1 IELEME = NBELC2(IDCOMP,IDTYPE) IDMAIL = NPOINT(IDCOMP,IDTYPE) C IF (DEBCB) THEN C WRITE(IOIMP,*) C WRITE(IOIMP,*) 'INDICE :',INDICE C WRITE(IOIMP,*) 'IDELEM :',IDELEM C WRITE(IOIMP,*) 'IDCOMP:',IDCOMP C WRITE(IOIMP,*) 'IDTYPE:',IDTYPE C WRITE(IOIMP,*) 'NBNN :',NBNN C WRITE(IOIMP,*) 'IELEME:',IELEME C WRITE(IOIMP,*) 'IDMAIL:',IDMAIL C ENDIF C Rechargement du pointeur du bon MELEME à remplir IPT2 = IDMAIL SEGACT,IPT2*MOD C IPT2.ICOLOR(IELEME) = ICOULC(IDCOMP) IPT2.ICOLOR(IELEME) = 0 DO 221 JNDICE = 1,NBNN C Reconstitution de la connectivité dans l'ordre Cast3M ITEST = IORDCO(20* (IDTYPE-1) + JNDICE) IDCOLU = ICONTO(IDCONN+(ITEST-1)) IDCOCA = ICORNO(IDCOLU)+NBANC IPT2.NUM(JNDICE,IELEME) = IDCOCA C IF (DEBCB) THEN C WRITE(IOIMP,*) 'ITEST',ITEST C WRITE(IOIMP,*) 'ConLU :',IDCOLU,'ConC3M:',IDCOCA C ENDIF 221 CONTINUE SEGDES,IPT2 220 CONTINUE C IF (DEBCB) THEN C WRITE(IOIMP,*) C WRITE(IOIMP,*) 'Passage 2' C ENDIF C*********************************************************************** C Création des maillages COMPLEXES composés des MELEME SIMPLES C*********************************************************************** DO 230 IDCOMP = 1,NBCOMP IDCOLU = ICOCOR(IDCOMP) COLO39 = NAMECO(IDCOLU) NBSOUS = NBTYPE(IDCOLU,NBGEOM+1) C IF (DEBCB) THEN C WRITE(IOIMP,*) C WRITE(IOIMP,*) 'IDCOLU',IDCOLU,'NBSOUS',NBSOUS C ENDIF ICOMPT = 0 DO 231 IDTYPE = 1,NBGEOM C Parcours du tableau des MELEME SIMPLES IF (NBSOUS.EQ.0) THEN C Création d'un MELEME SIMPLE vide IPT1 = 0 NBNN = 1 NBELEM = 0 NBSOUS = 0 NBREF = 0 SEGINI,IPT1 ELSEIF (NBSOUS.EQ.1) THEN IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN C Création d'un MELEME SIMPLE à partir du premier pointeur de MELEME SIMPLE rencontré (le seul en théorie car NBSOUS=1) IPT1=NPOINT(IDCOLU,IDTYPE) SEGACT,IPT1 ENDIF ELSE IF (NBTYPE(IDCOLU,IDTYPE).EQ.1) THEN IF (NPOINT(IDCOLU,NBGEOM+1).EQ.0) THEN C Création Initiale du MELEME COMPLEXE IPT1 = 0 NBREF = 0 NBNN = 0 NBELEM = 0 SEGINI,IPT1 NPOINT(IDCOLU,NBGEOM+1) = IPT1 ELSE C Chargement du MELEME COMPLEXE et complétion avec les MELEME SIMPLES rencontrés IPT1 = NPOINT(IDCOLU,NBGEOM+1) SEGACT,IPT1*MOD ENDIF ICOMPT = ICOMPT + 1 IPT1.LISOUS(ICOMPT)=NPOINT(IDCOLU,IDTYPE) C IF (DEBCB) THEN C WRITE(IOIMP,*) 'ICOMPT',ICOMPT,'IDTYPE',IDTYPE C WRITE(IOIMP,*) 'Pointeur:',NPOINT(IDCOLU,IDTYPE) C WRITE(IOIMP,*) 'IPT1',IPT1 C ENDIF ENDIF ENDIF 231 CONTINUE C Ecriture dans la table de Sortie du MELEME COMPLEXE CALL ECCTAB(MTABLE,'MOT ',0,0.d0,COLO39,.FALSE.,0, & 'MAILLAGE',0,0.d0,' ',.FALSE.,IPT1) SEGDES,IPT1 230 CONTINUE WRITE(IOIMP,*) C A la fin on passe au Label 991 pour le ménage final GOTO 991 989 CONTINUE IF (DEBCB) THEN WRITE(IOIMP,*) 'Erreur READ Wrong FORMAT (Lbl 989) : ' ENDIF CLOSE(UNIT=IUFEM,ERR=990) C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Fermeture OK du fichier FEM' C ENDIF GOTO 991 990 CONTINUE IF (DEBCB) THEN WRITE(IOIMP,*) 'Erreur OPEN/CLOSE (Lbl 990) : ' ENDIF GOTO 991 991 CONTINUE C Traitement des erreurs IF (iOK.NE.0 .OR. IERR.NE.0) THEN IF (DEBCB) THEN WRITE(IOIMP,*)'Sortie ERREUR de la Subroutine LIRFEM' ENDIF IF (iOK.NE.0) CALL ERREUR(iOK) ELSE C IF (DEBCB) THEN C WRITE(IOIMP,*)'Sortie Normale de la Subroutine LIRFEM' C ENDIF ENDIF C*********************************************************************** C Sortie de la table résultat C*********************************************************************** C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Sortie de la TABLE résultat' C ENDIF CALL ECROBJ('TABLE ',MTABLE) C*********************************************************************** C Un peu de ménage dans la mémoire C*********************************************************************** C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Menage dans la mémoire' C ENDIF SEGSUP,SREDLE SEGSUP,MLINOE SEGSUP,MLIELE SEGSUP,MELEQU SEGSUP,MCOMP SEGDES,MTABLE C IF (DEBCB) THEN C WRITE(IOIMP,*) 'Sortie Normale de lirfem.eso' C ENDIF RETURN END