1 : C ELELE2 SOURCE CHAT 05/01/12 23:30:28 5004 2 : SUBROUTINE ELELE2(MCLAS,MCLPO1,MCENT,LEPOEL,ELNBEL,LEELEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : ELELE2 7 : C DESCRIPTION : On construit la liste séquentielle indexée d'éléments 8 : C LEELEL (type MLELEM). 9 : * NOCENT : indice du centre de l'élément considéré dans 10 : * MCENT 11 : * LEELEL.LESPOI(LEELEL.INDEX(NOCENT)) : 12 : * contient le numéro du centre de l'élément considéré 13 : * LEELEL.LESPOI(LEPOEL.INDEX(NOCENT)+1 14 : * -> LEPOEL.INDEX(NOCENT+1)-1) : 15 : * contient les numéro des points centre des éléments 16 : * qui ont un point de MCLPO1 en commun avec l'élément 17 : * considéré (!) 18 : * 19 : * ELNBEL est tel que ELNBEL(NOCENT) = nb d'éléments ayant au 20 : * moins un point de MCLPO1 21 : * en commun avec l'élément 22 : * dont l'indice du centre 23 : * dans MCENT est NOCENT. 24 : * ELNBEL est calculé dans la subroutine elenb2.eso 25 : * Il sert à dimensionner le tableau LESPOI et remplir 26 : * le tableau INDEX du segment LEELEL. 27 : C 28 : C LANGAGE : ESOPE 29 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 30 : C mél : gounand@semt2.smts.cea.fr 31 : C*********************************************************************** 32 : C APPELES : 33 : C APPELES (Outils) : - KRIPAD : MELEME -> (num. globale->locale), ERREUR 34 : C APPELES (E/S) : - 35 : C APPELES (BLAS) : - 36 : C APPELES (CALCUL) : - 37 : C*********************************************************************** 38 : C SYNTAXE GIBIANE : - 39 : C ENTREES : MCLAS (type MELEME) : maillage de classe de 40 : C points (sommet, face) par 41 : C élément (MMAIL,ELTFA) 42 : C MCLPO1 (type MELEME) : maillage de points 43 : C correspondant à MCLAS 44 : C MCENT (type MELEME) : un maillage de 45 : C points (dits 'centres') ayant le meme 46 : C nombre d'éléments que MCLAS et 47 : C servant à repérer les éléments de MCLAS. 48 : C ELNBEL (type MLENTI) : voir DESCRIPTION 49 : C 50 : C ENTREES/SORTIES : - 51 : C SORTIES : LEELEL (type MLELEM) : liste séquentielle indexée 52 : C d'éléments (cf. plus haut) 53 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 54 : C*********************************************************************** 55 : C VERSION : v1, 02/11/98, version initiale 56 : C HISTORIQUE : v1, 02/11/98, création 57 : C HISTORIQUE : v1, 10/04/00, ajout de qqc commentaire, A. BECCANTINI 58 : C HISTORIQUE : 59 : C*********************************************************************** 60 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 61 : C en cas de modification de ce sous-programme afin de faciliter 62 : C la maintenance ! 63 : C*********************************************************************** 64 : -INC CCOPTIO 65 : -INC SMELEME 66 : POINTEUR MCLAS.MELEME 67 : POINTEUR MCLPO1.MELEME 68 : POINTEUR MCENT.MELEME 69 : -INC SMLENTI 70 : POINTEUR ELNBEL.MLENTI 71 : POINTEUR KRIPO1.MLENTI 72 : * 73 : * Segment MLELEM 74 : * 75 : SEGMENT MLELEM 76 : INTEGER INDEX(NBL+1) 77 : INTEGER LESPOI(NBTPOI) 78 : ENDSEGMENT 79 : * 80 : * LISTE SEQUENTIELLE INDEXEE D'ELEMENTS 81 : * 82 : * NBL : NOMBRE D'ELEMENTS 83 : * NBTPOI : NOMBRE TOTAL DE POINTS REFERENCEES 84 : * INDEX(I) : INDICE DU 1ER POINT DU IEME ELEMENT 85 : * DANS LE TABLEAU LESPOI 86 : * LESPOI(INDEX(I) -> INDEX(I+1)-1) : NUMERO DES NOEUDS 87 : * DU IEME ELEMENT 88 : * 89 : POINTEUR LEPOEL.MLELEM 90 : POINTEUR LEELEL.MLELEM 91 : C 92 : C**** Variables de COOPTIO 93 : C 94 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 95 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 96 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 97 : C & ,IECHO, IIMPI, IOSPI 98 : C & ,IDIM 99 : C & ,MCOORD 100 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 101 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 102 : C & ,NORINC,NORVAL,NORIND,NORVAD 103 : C & ,NUCROU, IPSAUV 104 : C 105 : INTEGER NBSOUS,NOTYP,NBCENT,NELNB,NBL,NBTPOI,IDEPA 106 : & ,ICENT,INBSOU,NBELEM,NBPOEL,INBEL,INBPO,NOPOI1,NUMCEN 107 : & ,IBCOUR,ICOUR,INBL,IPOEL 108 : LOGICAL LFOUND 109 : * 110 : * Executable statements 111 : * 112 : SEGACT MCLPO1 113 : NBSOUS=MCLPO1.LISOUS(/1) 114 : NOTYP =MCLPO1.ITYPEL 115 : IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN 116 : MOTERR(1:40) = 'Subroutine elele2.eso ' 117 : WRITE(IOIMP,*) MOTERR(1:40) 118 : C 119 : C******* 'MCLPO1 must contain only POI1 elements' 120 : C Message d'erreur standard 121 : C 5 3 122 : C Erreur anormale.contactez votre support 123 : C 123 : CALL ERREUR(5) 124 : GOTO 9999 125 : ENDIF 126 : C In KRIPAD : SEGINI KRIPO1 126 : CALL KRIPAD(MCLPO1,KRIPO1) 127 : SEGDES MCLPO1 128 : SEGACT MCENT 129 : NBSOUS=MCENT.LISOUS(/1) 130 : NOTYP =MCENT.ITYPEL 131 : IF (NBSOUS.NE.0.OR.(NBSOUS.EQ.0.AND.NOTYP.NE.1)) THEN 132 : MOTERR(1:40) = 'Subroutine elele2.eso ' 133 : WRITE(IOIMP,*) MOTERR(1:40) 134 : C 135 : C******* 'MCLPO1 must contain only POI1 elements' 136 : C Message d'erreur standard 137 : C 5 3 138 : C Erreur anormale.contactez votre support 139 : C 139 : CALL ERREUR(5) 140 : GOTO 9999 141 : ENDIF 142 : NBCENT=MCENT.NUM(/2) 143 : SEGACT ELNBEL 144 : NELNB=ELNBEL.LECT(/1) 145 : IF (NELNB.NE.NBCENT) THEN 146 : MOTERR(1:40) = 'Subroutine elele2.eso ' 147 : WRITE(IOIMP,*) MOTERR(1:40) 148 : C 149 : C******* 'Dimension of MCENT and ELNBEL are not equal' 150 : C Message d'erreur standard 151 : C 5 3 152 : C Erreur anormale.contactez votre support 153 : C 153 : CALL ERREUR(5) 154 : GOTO 9999 155 : ENDIF 156 : C 157 : C On initialise le segment LEELEL (type MLELEM) 158 : C 159 : NBL=NBCENT 160 : NBTPOI=0 161 : SEGINI LEELEL 162 : IDEPA=1 163 : DO 1 INBL=1,NBL 164 : LEELEL.INDEX(INBL)=IDEPA 165 : IDEPA=IDEPA+1+ELNBEL.LECT(INBL) 166 : 1 CONTINUE 167 : LEELEL.INDEX(NBL+1)=IDEPA 168 : SEGDES ELNBEL 169 : NBTPOI=IDEPA-1 170 : SEGADJ LEELEL 171 : SEGACT LEPOEL 172 : * 173 : * Parcourons le maillage 174 : * 175 : SEGACT MCLAS 176 : NBSOUS=MCLAS.LISOUS(/1) 177 : IF (NBSOUS.EQ.0) NBSOUS=1 178 : ICENT=0 179 : DO 3 INBSOU=1,NBSOUS 180 : IF (NBSOUS.GT.1) THEN 181 : IPT1=MCLAS.LISOUS(INBSOU) 182 : SEGACT IPT1 183 : ELSE 184 : IPT1=MCLAS 185 : ENDIF 186 : NBPOEL=IPT1.NUM(/1) 187 : NBELEM=IPT1.NUM(/2) 188 : DO 32 INBEL=1,NBELEM 189 : ICENT=ICENT+1 190 : LEELEL.LESPOI(LEELEL.INDEX(ICENT))=MCENT.NUM(1,ICENT) 191 : ICOUR=LEELEL.INDEX(ICENT)+1 192 : DO 322 INBPO=1,NBPOEL 193 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 194 : IF (NOPOI1.EQ.0) THEN 195 : C 196 : C**************** 'Erreur grave MCLPO1 n''est pas' 197 : C 'le maillage de points correspondant' 198 : C 'à MCLAS.' 199 : C Message d'erreur standard 200 : C 5 3 201 : C Erreur anormale.contactez votre support 202 : C 203 : MOTERR(1:40) = 204 : $ 'Subroutine elele2.eso ' 205 : WRITE(IOIMP,*) MOTERR(1:40) 205 : CALL ERREUR(5) 206 : GOTO 9999 207 : ELSE 208 : DO 3222 IPOEL=LEPOEL.INDEX(NOPOI1)+1, 209 : $ LEPOEL.INDEX(NOPOI1+1)-1 210 : NUMCEN=LEPOEL.LESPOI(IPOEL) 211 : C 212 : C******************* Mise a jour de IBCOUR 213 : C 214 : IBCOUR=LEELEL.INDEX(ICENT) 215 : 32222 CONTINUE 216 : LFOUND=(NUMCEN.EQ.LEELEL.LESPOI(IBCOUR)) 217 : IF (.NOT.LFOUND.AND.(IBCOUR.LT.ICOUR)) THEN 218 : IBCOUR=IBCOUR+1 219 : GOTO 32222 220 : ENDIF 221 : IF (.NOT.LFOUND) THEN 222 : LEELEL.LESPOI(ICOUR)=NUMCEN 223 : ICOUR=ICOUR+1 224 : ENDIF 225 : 3222 CONTINUE 226 : ENDIF 227 : 322 CONTINUE 228 : 32 CONTINUE 229 : IF (NBSOUS.GT.1) SEGDES IPT1 230 : 3 CONTINUE 231 : SEGDES MCLAS 232 : SEGDES LEPOEL 233 : SEGDES LEELEL 234 : SEGDES MCENT 235 : SEGSUP KRIPO1 236 : * 237 : 9999 CONTINUE 238 : RETURN 239 : * 240 : * End of subroutine ELELE2 241 : * 242 : END 243 : 244 : 245 : 246 : 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer