1 : C LE2MEL SOURCE CHAT 05/01/13 01:14:20 5004 2 : SUBROUTINE LE2MEL(MLELEM,MELEME,IMPR,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : LE2MEL 7 : C DESCRIPTION : Construit un MELEME d'éléments POLY à 8 : C partir d'une liste séquentielle indexée d'éléments 9 : C voir le segment MLELEM 10 : C En gros, on regroupe les éléments qui ont le meme 11 : C nombre de points. 12 : C 13 : C LANGAGE : ESOPE 14 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 15 : C mél : gounand@semt2.smts.cea.fr 16 : C*********************************************************************** 17 : C APPELES : - 18 : C APPELES (E/S) : ECROBJ, PRLIST (opérateur 'LIST') 19 : C APPELES (BLAS) : - 20 : C APPELES (CALCUL) : - 21 : C APPELE PAR : POIELE, ELPOEL 22 : C*********************************************************************** 23 : C SYNTAXE GIBIANE : - 24 : C ENTREES : MLELEM (type MLELEM) : liste séquentielle 25 : C indexée d'éléments 26 : C ENTREES/SORTIES : - 27 : C SORTIES : MELEME ( " MELEME) : maillage de POLY 28 : C associé aux entrées. 29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 30 : C*********************************************************************** 31 : C VERSION : v1, 08/10/98, version initiale 32 : C HISTORIQUE : v1, 08/10/98, création 33 : C HISTORIQUE : 34 : C HISTORIQUE : 35 : C*********************************************************************** 36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 37 : C en cas de modification de ce sous-programme afin de faciliter 38 : C la maintenance ! 39 : C*********************************************************************** 40 : -INC CCOPTIO 41 : -INC SMELEME 42 : -INC SMLENTI 43 : POINTEUR PONBEL.MLENTI 44 : POINTEUR MTYPL.MLENTI 45 : * 46 : * Segment MLELEM 47 : * 48 : SEGMENT MLELEM 49 : INTEGER INDEX(NBL+1) 50 : INTEGER LESPOI(NBTPOI) 51 : ENDSEGMENT 52 : * 53 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 54 : * 55 : * NBL : NOMBRE D'ELEMENTS 56 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 57 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 58 : * DANS LE TABLEAU LESPOI 59 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 60 : * DU IEME ELEMENT 61 : * 62 : INTEGER IMPR,IRET 63 : INTEGER MAXPOI,NTYPL 64 : * 65 : * Executable statements 66 : * 67 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans le2mel.eso' 68 : SEGACT MLELEM 69 : NBL=INDEX(/1)-1 70 : * 71 : * On construit le tableau temporaire PONBEL tel que : 72 : * PONBEL(I) : NOMBRE DE POINTS DU IEME ELEMENT DE MLELEM 73 : * 74 : * On calcule aussi le maximum du nombre de points des éléments de 75 : * MLELEM. 76 : * 77 : JG=NBL 78 : SEGINI PONBEL 79 : MAXPOI=0 80 : DO 1 INBL=1,NBL 81 : PONBEL.LECT(INBL)=INDEX(INBL+1)-INDEX(INBL) 82 : MAXPOI=MAX(MAXPOI,PONBEL.LECT(INBL)) 83 : 1 CONTINUE 84 : * 85 : * Maintenant on détermine le nombre de sous-objets (LISOUS) 86 : * que devra comporter MELEME, cad le nombre de type d'éléments 87 : * différents (distingués par le nombre de noeuds) 88 : * MTYPL(NONOEU) contient le nombre d'éléments de MLELEM ayant 89 : * NONOEU noeuds (éventuellement nul). 90 : * NTYPL contient le nombre de type d'éléments différents 91 : * à créer. 92 : * 93 : JG=MAXPOI 94 : SEGINI MTYPL 95 : DO 2 INBL=1,NBL 96 : NONOEU=PONBEL.LECT(INBL) 97 : MTYPL.LECT(NONOEU)=MTYPL.LECT(NONOEU)+1 98 : 2 CONTINUE 99 : NTYPL=0 100 : DO 3 IMAXPO=1,MAXPOI 101 : IF (MTYPL.LECT(IMAXPO).NE.0) NTYPL=NTYPL+1 102 : 3 CONTINUE 103 : * 104 : * On construit le MELEME en distinguant le cas NTYPL=1... 105 : * 106 : IF (NTYPL.EQ.1) THEN 107 : NBSOUS=0 108 : NBNN=MAXPOI 109 : NBELEM=NBL 110 : NBREF=0 111 : SEGINI MELEME 112 : * Type d'élément : POLY (cf. bdata.eso) 113 : ITYPEL=32 114 : DO 5 INBEL=1,NBL 115 : IDELEM=INDEX(INBEL)-1 116 : DO 52 INBNN=1,MAXPOI 117 : NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN) 118 : 52 CONTINUE 119 : 5 CONTINUE 120 : SEGDES MELEME 121 : ELSE 122 : NBSOUS=NTYPL 123 : NBNN=0 124 : NBELEM=0 125 : NBREF=0 126 : SEGINI MELEME 127 : NBNOEU=0 128 : DO 7 INBSO=1,NTYPL 129 : * On cherche le nombre de noeuds du type d'éléments suivant 130 : NBNOEU=NBNOEU+1 131 : 72 CONTINUE 132 : IF (MTYPL.LECT(NBNOEU).EQ.0) THEN 133 : NBNOEU=NBNOEU+1 134 : GOTO 72 135 : ENDIF 136 : NBSOUS=0 137 : * On stockera le sommet en premier 138 : NBNN=NBNOEU 139 : NBELEM=MTYPL.LECT(NBNOEU) 140 : NBREF=0 141 : SEGINI IPT1 142 : IPT1.ITYPEL=32 143 : IELEM=0 144 : DO 74 INBEL=1,NBELEM 145 : IELEM=IELEM+1 146 : 742 CONTINUE 147 : IF (PONBEL.LECT(IELEM).NE.NBNOEU) THEN 148 : IELEM=IELEM+1 149 : GOTO 742 150 : ENDIF 151 : IDELEM=INDEX(IELEM)-1 152 : DO 744 INBNN=1,NBNN 153 : IPT1.NUM(INBNN,INBEL)=LESPOI(IDELEM+INBNN) 154 : 744 CONTINUE 155 : 74 CONTINUE 156 : SEGDES IPT1 157 : MELEME.LISOUS(INBSO)=IPT1 158 : 7 CONTINUE 159 : SEGDES MELEME 160 : ENDIF 161 : SEGSUP MTYPL 162 : SEGDES MLELEM 163 : SEGDES PONBEL 164 : IF (IMPR.GT.2) THEN 165 : WRITE(IOIMP,*) 'On a créé MELEME=',MELEME 166 : IF (IMPR.GT.3) THEN 166 : CALL ECROBJ('MAILLAGE',MELEME) 166 : CALL PRLIST 167 : ENDIF 168 : ENDIF 169 : * 170 : * Normal termination 171 : * 172 : IRET=0 173 : RETURN 174 : * 175 : * Format handling 176 : * 177 : 4000 FORMAT (A,'(1..',I8,')') 178 : 5000 FORMAT (8(1X,I8)) 179 : * 180 : * Error handling 181 : * 182 : 9999 CONTINUE 183 : IRET=1 184 : WRITE(IOIMP,*) 'An error was detected in subroutine le2mel' 185 : RETURN 186 : * 187 : * End of subroutine LE2MEL 188 : * 189 : END 190 : 191 : 192 : 193 :
© Cast3M 2003 - All rights reserved.
Disclaimer