1 : C RLENSO SOURCE CHAT 05/01/13 03:01:40 5004 2 : SUBROUTINE RLENSO(MELFL,MELFP,MELSOM,MLEPOI) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : RLENSO 8 : C 9 : C DESCRIPTION : Appelle par GRADI2 10 : C 11 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 12 : C 13 : C AUTEUR : A. BECCANTINI 14 : C 15 : C************************************************************************ 16 : C 17 : C 18 : C Inputs: 19 : C MELFL : facel of domaine table 20 : C MELFP : facep of domaine table 21 : C MELSOM : sommet of the domaine table 22 : C 23 : C Outputs: 24 : C MLEPOI : list of integers. 25 : C MLEPOI.LECT(I) is the pointer of the list of integers 26 : C MLENTI which contains the neighbors of the i-th sommet 27 : C point. 28 : C 29 : C 30 : C 31 : C**** Variables de COOPTIO 32 : C 33 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 34 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 35 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 36 : C & ,IECHO, IIMPI, IOSPI 37 : C & ,IDIM 38 : C & ,MCOORD 39 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 40 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 41 : C & ,NORINC,NORVAL,NORIND,NORVAD 42 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 43 : CC 44 : IMPLICIT INTEGER(I-N) 45 : INTEGER NSOMM, NBSOUS, NBELEM, NBNO 46 : & , IELEM, NGF, NGF1, INOEU, NGS1, NLS1, ISOUS 47 : & , IELEMF, NGC1, NGC2, NELT, NELTT, I1 48 : C 49 : -INC SMELEME 50 : INTEGER JG 51 : -INC SMLENTI 52 : -INC CCOPTIO 53 : C 54 : POINTEUR MELSOM.MELEME, MELFL.MELEME, MELFP.MELEME, MELFP1.MELEME 55 : & ,MLESOM.MLENTI, MLEFP.MLENTI, MTOUC.MLENTI, MTOUC2.MLENTI 56 : & ,MLEPOI.MLENTI 57 : C 58 : C**** Le MELEME SOMMET 59 : C 59 : CALL KRIPAD(MELSOM,MLESOM) 60 : C 61 : C MLESOM: numerotation globale -> locale 62 : C 63 : C**** En KRIPAD 64 : C SEGACT MELSOM 65 : C SEGINI MLESOM 66 : C 67 : NSOMM = MELSOM.NUM(/2) 68 : JG=NSOMM 69 : SEGINI MTOUC 70 : SEGINI MTOUC2 71 : C MTOUC.LECT(NLS1) = estimation of the number of neighbors for NLS1 72 : C MTOUC2.LECT(NLS1) = how many times NLS1 is touched 73 : C 74 : SEGACT MELFP 75 : C 76 : C**** En 2D MELFP est un maillage elementaire 77 : C En 3D pas à priori 78 : C -> MLEFP contains the list of LISOUS 79 : C 80 : NBSOUS=MELFP.LISOUS(/1) 81 : C NBSOUS=0 fais un peux chier! 82 : JG=MAX(NBSOUS,1) 83 : SEGINI MLEFP 84 : IF(NBSOUS .EQ. 0)THEN 85 : MLEFP.LECT(1)=MELFP 86 : ELSE 87 : DO ISOUS=1,NBSOUS,1 88 : MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS) 89 : ENDDO 90 : ENDIF 91 : SEGDES MELFP 92 : C 93 : SEGACT MELFL 94 : NBSOUS=MELFL.LISOUS(/1) 95 : IF(NBSOUS .NE. 0)THEN 96 : WRITE(IOIMP,*) 'FACEL = ???' 97 : WRITE(IOIMP,*) 'Subroutine rlenso.eso' 97 : CALL ERREUR(5) 98 : GOTO 9999 99 : ENDIF 100 : C 101 : IELEMF=0 102 : NBSOUS=MLEFP.LECT(/1) 103 : DO ISOUS = 1, NBSOUS, 1 104 : MELFP1=MLEFP.LECT(ISOUS) 105 : SEGACT MELFP1 106 : NBELEM=MELFP1.NUM(/2) 107 : NBNO=MELFP1.NUM(/1) - 1 108 : C 109 : C The first ISOUS of 'FACEP' has NBELEM elements which contain 110 : C NBNO sommets and one point face. Each time a 'sommet' point is 111 : C touched, there are at most two neighbors of him. 112 : C 113 : DO IELEM = 1, NBELEM,1 114 : IELEMF=IELEMF+1 115 : NGF=MELFP1.NUM(NBNO+1,IELEM) 116 : NGF1=MELFL.NUM(2,IELEMF) 117 : IF(NGF .NE. NGF1)THEN 118 : WRITE(IOIMP,*) 'FACEL = ???' 119 : WRITE(IOIMP,*) 'Subroutine rlenso.eso' 119 : CALL ERREUR(5) 120 : GOTO 9999 121 : ENDIF 122 : C 123 : C Loop involving the sommet noeuds of the element of 124 : C FACEP 125 : C 126 : DO INOEU = 1, NBNO, 1 127 : NGS1 = MELFP1.NUM(INOEU,IELEM) 128 : NLS1 = MLESOM.LECT(NGS1) 129 : MTOUC2.LECT(NLS1)=MTOUC2.LECT(NLS1)+1 130 : ENDDO 131 : ENDDO 132 : ENDDO 133 : C 134 : C**** MTOUC2.LECT(NLS1) says us how many times NLS1 is touched 135 : C Apart from the first interface, normally each 136 : C interface adds just one new neighbor and not two. 137 : C I create NSOMM MLENTI which contain the list of neighbors. 138 : C MLEPOI contains the number of their pointers 139 : C 140 : JG=NSOMM 141 : SEGINI MLEPOI 142 : DO INOEU=1,NSOMM,1 143 : JG=MTOUC2.LECT(INOEU)+1 144 : SEGINI MLENTI 145 : C MTOUC.LECT(INOEU) says how many places are in each MLENTI 146 : MTOUC.LECT(INOEU)=JG 147 : MLEPOI.LECT(INOEU)=MLENTI 148 : MTOUC2.LECT(INOEU)=0 149 : ENDDO 150 : C 151 : IELEMF=0 152 : NBSOUS=MLEFP.LECT(/1) 153 : DO ISOUS = 1, NBSOUS, 1 154 : MELFP1=MLEFP.LECT(ISOUS) 155 : NBELEM=MELFP1.NUM(/2) 156 : NBNO=MELFP1.NUM(/1) - 1 157 : C 158 : C The first ISOUS of 'FACEP' has NBELEM elements which contain 159 : C NBNO sommets and one point face. Each time a 'sommet' point is 160 : C touched, there are at most two neighbors of him. As already 161 : C mentioned, normally each interface adds just one new neighbor 162 : C and not two. 163 : C 164 : DO IELEM = 1, NBELEM,1 165 : IELEMF=IELEMF+1 166 : NGF=MELFP1.NUM(NBNO+1,IELEM) 167 : NGF1=MELFL.NUM(2,IELEMF) 168 : NGC1=MELFL.NUM(1,IELEMF) 169 : NGC2=MELFL.NUM(3,IELEMF) 170 : IF(NGC1 .NE. NGC2)THEN 171 : C 172 : C************* Internal face 173 : C 174 : C Loop involving the sommet noeuds of the element of 175 : C FACEP 176 : C 177 : DO INOEU = 1, NBNO, 1 178 : NGS1 = MELFP1.NUM(INOEU,IELEM) 179 : NLS1 = MLESOM.LECT(NGS1) 180 : C 181 : C**************** POINT NGC1: does it already belong to the list? 182 : C 183 : C NELT says how many neighbors are already in 184 : C MLEPOI.LECT(NLS1) 185 : C NELTT is the dimension of MLEPOI.LECT(NLS1) 186 : C 187 : NELT=MTOUC2.LECT(NLS1) 188 : NELTT=MTOUC.LECT(NLS1) 189 : MLENTI = MLEPOI.LECT(NLS1) 190 : DO I1 = 1, NELT, 1 191 : IF(MLENTI.LECT(I1).EQ.NGC1) GOTO 1 192 : ENDDO 193 : C 194 : C**************** It does not 195 : C 196 : IF(NELT .LT. NELTT)THEN 197 : MTOUC2.LECT(NLS1)=NELT+1 198 : MLENTI.LECT(NELT+1)=NGC1 199 : NELT=NELT+1 200 : ELSE 201 : C******************* Dimension of MLENTI too little 202 : NELT=NELT+1 203 : NELTT= NELTT+1 204 : JG=NELTT 205 : SEGADJ MLENTI 206 : MTOUC2.LECT(NLS1)=JG 207 : MTOUC.LECT(NLS1)=JG 208 : MLENTI.LECT(JG)=NGC1 209 : ENDIF 210 : C 211 : C**************** It does not 212 : C 213 : 1 CONTINUE 214 : C 215 : C**************** The same for NGC2 216 : C 217 : DO I1 = 1, NELT, 1 218 : IF(MLENTI.LECT(I1).EQ.NGC2) GOTO 2 219 : ENDDO 220 : C 221 : C**************** The point does not already belong to this element 222 : C 223 : IF(NELT .LT. NELTT)THEN 224 : MTOUC2.LECT(NLS1)=NELT+1 225 : MLENTI.LECT(NELT+1)=NGC2 226 : ELSE 227 : C 228 : C******************* Dimension of MLENTI too little 229 : C 230 : JG=NELTT+1 231 : SEGADJ MLENTI 232 : MTOUC2.LECT(NLS1)=JG 233 : MTOUC.LECT(NLS1)=JG 234 : MLENTI.LECT(JG)=NGC2 235 : ENDIF 236 : C 237 : C**************** The point already belongs to this element 238 : C Nothing to do 239 : C 240 : 2 CONTINUE 241 : ENDDO 242 : ELSE 243 : C 244 : C************* Boundary face 245 : C 246 : C Loop involving the sommet noeuds of the element of 247 : C FACEP 248 : C 249 : DO INOEU = 1, NBNO, 1 250 : NGS1 = MELFP1.NUM(INOEU,IELEM) 251 : NLS1 = MLESOM.LECT(NGS1) 252 : NELT=MTOUC2.LECT(NLS1) 253 : NELTT=MTOUC.LECT(NLS1) 254 : MLENTI = MLEPOI.LECT(NLS1) 255 : C 256 : C**************** POINT NGF cannot belongs to the list 257 : C 258 : IF(NELT .LT. NELTT)THEN 259 : MTOUC2.LECT(NLS1)=NELT+1 260 : MLENTI.LECT(NELT+1)=NGF 261 : NELT=NELT+1 262 : ELSE 263 : C******************* Dimension of MLENTI too little 264 : NELT=NELT+1 265 : NELTT= NELTT+1 266 : JG=NELTT 267 : SEGADJ MLENTI 268 : MTOUC2.LECT(NLS1)=JG 269 : MTOUC.LECT(NLS1)=JG 270 : MLENTI.LECT(JG)=NGF 271 : ENDIF 272 : C 273 : C**************** What about NGC1? 274 : C 275 : DO I1 = 1, NELT, 1 276 : IF(MLENTI.LECT(I1).EQ.NGC1) GOTO 3 277 : ENDDO 278 : C 279 : C**************** The point does not already belong to this element 280 : C 281 : IF(NELT .LT. NELTT)THEN 282 : MTOUC2.LECT(NLS1)=NELT+1 283 : MLENTI.LECT(NELT+1)=NGC1 284 : ELSE 285 : C 286 : C******************* Dimension of MLENTI too little 287 : C 288 : JG=NELTT+1 289 : SEGADJ MLENTI 290 : MTOUC2.LECT(NLS1)=JG 291 : MTOUC.LECT(NLS1)=JG 292 : MLENTI.LECT(JG)=NGC1 293 : ENDIF 294 : C 295 : C**************** The point already belongs to this element 296 : C Nothing to do 297 : C 298 : 3 CONTINUE 299 : ENDDO 300 : ENDIF 301 : ENDDO 302 : SEGDES MELFP1 303 : ENDDO 304 : C 305 : C**** We eliminate the 0 into the MLENTI of 306 : C MLEPOI.LECT(NL sommet) 307 : C 308 : DO INOEU=1,NSOMM,1 309 : MLENTI=MLEPOI.LECT(INOEU) 310 : NELT=MTOUC2.LECT(INOEU) 311 : NELTT=MTOUC.LECT(INOEU) 312 : DO I1=(NELT+1),NELTT,1 313 : IF(MLENTI.LECT(I1) .NE. 0)THEN 314 : C 315 : C************* There is an error somewhere 316 : C 317 : WRITE(IOIMP,*) 'Subroutine rlenso.eso' 317 : CALL ERREUR(5) 318 : GOTO 9999 319 : ENDIF 320 : ENDDO 321 : JG=NELT 322 : SEGADJ MLENTI 323 : SEGDES MLENTI 324 : ENDDO 325 : C 326 : C**** Test 327 : C 328 : C DO INOEU=1,NSOMM,1 329 : C MLENTI=MLEPOI.LECT(INOEU) 330 : C NELT=MLENTI.LECT(/1) 331 : C write (*,*) 'ngs =', MELSOM.NUM(1,INOEU) 332 : C write (*,*) (mlenti.lect(i2),i2=1,nelt) 333 : C ENDDO 334 : C 335 : SEGSUP MTOUC 336 : SEGSUP MTOUC2 337 : C 338 : SEGSUP MLESOM 339 : SEGDES MELSOM 340 : C 341 : SEGSUP MLEFP 342 : C 343 : SEGDES MELFL 344 : SEGDES MLEPOI 345 : C 346 : 9999 RETURN 347 : END 348 : 349 : 350 : 351 :
© Cast3M 2003 - All rights reserved.
Disclaimer