1 : C ELCONT SOURCE CHAT 05/01/12 23:29:58 5004 2 : SUBROUTINE ELCONT(MFACEL,MFACEP,MCONT,MCCEN) 3 : C 4 : C*********************************************************************** 5 : C NOM : ELCONT 6 : C DESCRIPTION : Construit les MELEME contenant les faces dont les éléments 7 : C 1 et 3 de FACEL sont égaux (faces du contour). 8 : C LANGAGE : ESOPE 9 : C AUTEUR : Régis MOREL (CEA/DRN/DMT/SEMT/LTMF) 10 : C 11 : C*********************************************************************** 12 : C APPELES : - 13 : C APPELES (E/S) : - 14 : C APPELES (BLAS) : - 15 : C APPELES (CALCUL) : - 16 : C*********************************************************************** 17 : C SYNTAXE GIBIANE : - 18 : C 19 : C ENTREES : MFACEL (type MELEME) : maillage de points 20 : C centre-face-centre 21 : C 22 : C MFACEP (type MELEME) : maillage des points 23 : C sommets des faces 24 : C 25 : C ENTREES/SORTIES : - 26 : C SORTIES : MCONT (type MELEME) : maillage des faces du 27 : C contour . 28 : C Le dernier noeud contient 29 : C le centre de face 30 : C 31 : C MCCEN (type MELEME) : maillage des centres de 32 : C ces faces. 33 : C 34 : C CODE RETOUR (IRET) : - 35 : C*********************************************************************** 36 : C VERSION : v1, 23/04/99, version initiale 37 : C HISTORIQUE : v1, 23/04/99, création 38 : C HISTORIQUE : v1, 07/04/2000 Ajout commentaire et petites modifs 39 : C HISTORIQUE : 40 : C*********************************************************************** 41 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 42 : C en cas de modification de ce sous-programme afin de faciliter 43 : C la maintenance ! 44 : C*********************************************************************** 45 : IMPLICIT INTEGER(I-N) 46 : -INC CCOPTIO 47 : -INC SMELEME 48 : POINTEUR MCONT.MELEME 49 : POINTEUR MCCEN.MELEME 50 : POINTEUR MFACEL.MELEME 51 : POINTEUR MFACEP.MELEME 52 : C 53 : C**** Variables de COOPTIO 54 : C 55 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 56 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 57 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 58 : C & ,IECHO, IIMPI, IOSPI 59 : C & ,IDIM 60 : C & ,MCOORD 61 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 62 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 63 : C & ,NORINC,NORVAL,NORIND,NORVAD 64 : C & ,NUCROU, IPSAUV 65 : C 66 : INTEGER NCONT,I,NBF,ITOT,JTOT,NCD,NCG,J,K,NFACE1,NFACE2 67 : & ,ICONT, NBELEM, NBFACP, NBNN, NBREF, NBSOUS 68 : C 69 : C On commence par parcourir FACEL pour savoir combien d'éléments 70 : C il y aura dans MCCEN 71 : C 72 : SEGACT MFACEL 73 : IF (MFACEL.LISOUS(/1).NE.0) THEN 74 : MOTERR(1:40) = 'Problème de connectvité FACEL ' 75 : WRITE(IOIMP,*) MOTERR(1:40) 75 : CALL ERREUR(5) 76 : GOTO 9999 77 : ENDIF 78 : NCONT=0 79 : NBF = MFACEL.NUM(/2) 80 : DO 10 I = 1,NBF 81 : NCG = MFACEL.NUM(1,I) 82 : NCD = MFACEL.NUM(3,I) 83 : IF (NCG.EQ.NCD) NCONT=NCONT+1 84 : 10 CONTINUE 85 : C 86 : C On crée le MELEME MCCEN (centres de faces sur les bords) 87 : C 88 : NBELEM = NCONT 89 : NBNN=1 90 : NBSOUS=0 91 : NBREF=0 92 : SEGINI MCCEN 93 : ICONT=0 94 : DO 20 I = 1,NBF 95 : NCG = MFACEL.NUM(1,I) 96 : NCD = MFACEL.NUM(3,I) 97 : IF (NCG.EQ.NCD) THEN 98 : ICONT=ICONT+1 99 : MCCEN.NUM(1,ICONT)= MFACEL.NUM(2,I) 100 : ENDIF 101 : 20 CONTINUE 102 : SEGDES MCCEN 103 : C 104 : CAB: A mon avis, la creation de MCEN est inutile; 105 : C En plus, on pouvais le créer dans la boucle suivant! 106 : C 107 : C 108 : C On va maintenant boucler sur chaque sous-reference de MFACEP 109 : C On suppose ici que MFACEP et MFACEL soient ordonnées dans la meme facon! 110 : C 111 : SEGACT MFACEP 112 : NBSOUS = MFACEP.LISOUS(/1) 113 : IF (NBSOUS.EQ.0) THEN 114 : NBNN = MFACEP.NUM(/1) 115 : NBELEM = NCONT 116 : NBREF=0 117 : SEGINI MCONT 118 : MCONT.ITYPEL=MFACEP.ITYPEL 119 : ICONT=0 120 : DO 21 I=1,NBF 121 : NCG = MFACEL.NUM(1,I) 122 : NCD = MFACEL.NUM(3,I) 123 : NFACE1 = MFACEL.NUM(2,I) 124 : NFACE2 = MFACEP.NUM(NBNN,I) 125 : IF(NFACE2 .NE. NFACE1)THEN 126 : MOTERR(1:40) = 'Problème de connectivité FACEL ou FACEP.' 127 : WRITE(IOIMP,*) MOTERR(1:40) 127 : CALL ERREUR(5) 128 : GOTO 9999 129 : ENDIF 130 : IF (NCG.EQ.NCD) THEN 131 : ICONT=ICONT+1 132 : DO 22 J=1,NBNN 133 : MCONT.NUM(J,ICONT)= MFACEP.NUM(J,I) 134 : 22 CONTINUE 135 : ENDIF 136 : 21 CONTINUE 137 : SEGDES MCONT 138 : ELSE 139 : NBNN=0 140 : NBELEM=0 141 : NBREF=0 142 : C 143 : C******* NBFACP = NBSOUS de MFACEP 144 : C N.B. On peut avoir NBSOUS de FACEP != NBSOUS de MCONT 145 : C Mais pour l'instant on impose NBSOUS de MCONT = NBSOUS de FACEP 146 : C 147 : NBFACP=NBSOUS 148 : SEGINI MCONT 149 : ITOT=0 150 : JTOT=0 151 : DO 30 K=1,NBFACP 152 : IPT1 = MFACEP.LISOUS(K) 153 : SEGACT IPT1 154 : C 155 : C On compte le nombre d'éléments du contour dans cette sous-référence 156 : C On le stocke dans NCONT 157 : C 158 : NBF = IPT1.NUM(/2) 159 : NBNN = IPT1.NUM(/1) 160 : NCONT=0 161 : DO 40 I = 1,NBF 162 : ITOT=ITOT+1 163 : NCG = MFACEL.NUM(1,ITOT) 164 : NCD = MFACEL.NUM(3,ITOT) 165 : IF (NCG.EQ.NCD) NCONT=NCONT+1 166 : 40 CONTINUE 167 : C 168 : C Maintenant, si NCONT > 0, on peut créer la sousreference correspondante de MCONT 169 : C 170 : IF(NCONT .GT. 0)THEN 171 : NBELEM=NCONT 172 : NBNN = IPT1.NUM(/1) 173 : NBREF=0 174 : SEGINI IPT2 175 : MCONT.LISOUS(K)=IPT2 176 : IPT2.ITYPEL = IPT1.ITYPEL 177 : ICONT=0 178 : DO 50 I = 1,NBF 179 : JTOT=JTOT+1 180 : NCG = MFACEL.NUM(1,JTOT) 181 : NCD = MFACEL.NUM(3,JTOT) 182 : NFACE1 = MFACEL.NUM(2,JTOT) 183 : NFACE2 = MFACEP.NUM(NBNN,JTOT) 184 : IF(NFACE2 .NE. NFACE1)THEN 185 : MOTERR(1:40) = 186 : $ 'Problème de connectivité FACEL ou FACEP.' 187 : WRITE(IOIMP,*) MOTERR(1:40) 187 : CALL ERREUR(5) 188 : GOTO 9999 189 : ENDIF 190 : IF (NCG.EQ.NCD) THEN 191 : ICONT=ICONT+1 192 : DO 60 J=1,NBNN 193 : IPT2.NUM(J,ICONT)=IPT1.NUM(J,I) 194 : 60 CONTINUE 195 : ENDIF 196 : 50 CONTINUE 197 : ELSE 198 : C 199 : C**************** Le maillage elementare n'a pas elts de bord! 200 : C 201 : NBSOUS = NBSOUS - 1 202 : SEGADJ MCONT 203 : ENDIF 204 : SEGDES IPT2 205 : SEGDES IPT1 206 : 30 CONTINUE 207 : SEGDES MCONT 208 : ENDIF 209 : SEGDES MFACEP 210 : SEGDES MFACEL 211 : 9999 RETURN 212 : END 213 : 214 : 215 : 216 : 217 : 218 : 219 : 220 : 221 : 222 : 223 :
© Cast3M 2003 - All rights reserved.
Disclaimer