1 : C RLEXFI SOURCE CHAT 05/01/13 03:03:03 5004 2 : SUBROUTINE RLEXFI(MLESCF,MATCOE,MLEFSC,MACOE1,MLEFC,MACOE2) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : RLEXFI 8 : C 9 : C DESCRIPTION : Appelle par GRADIA 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 Inputs: 18 : C 19 : C MLESCF : list of SOMMET points and their CENTRE neighbors 20 : C 21 : C MATCOE : coeff. for linear exact reconstruction of MLESCF 22 : C 23 : C MLEFSC : list of FACES points and their neighbors (CENTRE and SOMMET 24 : C points) 25 : C 26 : C MACOE1 : coeff. for linear exact reconstruction of MLEFSC 27 : C 28 : C Output 29 : C 30 : C MLEFC : list of FACES points and their neighbors (CENTRE points only) 31 : C 32 : C MACOE2 : coeff. for linear exact reconstruction of MLEFC 33 : C 34 : C 35 : C**** Variables de COOPTIO 36 : C 37 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 38 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 39 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 40 : C & ,IECHO, IIMPI, IOSPI 41 : C & ,IDIM 42 : CC & ,MCOORD 43 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 44 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 45 : C & ,NORINC,NORVAL,NORIND,NORVAD 46 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 47 : C 48 : IMPLICIT INTEGER(I-N) 49 : -INC CCOPTIO 50 : -INC SMCOORD 51 : INTEGER JG 52 : -INC SMLENTI 53 : POINTEUR MLECEN.MLENTI, MLESOM.MLENTI, MCLEAR.MLENTI 54 : -INC SMLREEL 55 : POINTEUR MLRCOE.MLREEL 56 : C 57 : INTEGER NBL, NBTPOI 58 : SEGMENT MLELEM 59 : INTEGER INDEX(NBL+1) 60 : INTEGER LESPOI(NBTPOI) 61 : ENDSEGMENT 62 : POINTEUR MLESCF.MLELEM,MLEFSC.MLELEM, MLEFC.MLELEM 63 : C 64 : INTEGER N1,N2 65 : SEGMENT MATRIX 66 : REAL*8 MAT(N1,N2) 67 : ENDSEGMENT 68 : POINTEUR MATCOE.MATRIX, MACOE1.MATRIX, MACOE2.MATRIX 69 : C 70 : INTEGER NSOM, IPOS, IPOS1, NMAXVS, IELEM, NFAC, NGS, NMAXVF, I1 71 : & , NGF, IPOSF, NVOIF, NCEN, NGP, NLS, IPOSP, IPOSP1 72 : & , NVOI, I2 , IPOSV, NGC, NLC 73 : REAL*8 ERRO, VAL 74 : C 75 : C**** MLESCF = MLELEM sommet-centres voisins 76 : C NMAXVS = nombre max de voisins aux sommets 77 : C 78 : SEGACT MLESCF 79 : NSOM=MLESCF.INDEX(/1)-1 80 : IPOS1=MLESCF.INDEX(1) 81 : C 82 : C**** N.B. Le sommet n'a pas de voisins si il 83 : C appartient aux CL 84 : C 85 : NMAXVS=1 86 : DO IELEM = 1, NSOM, 1 87 : IPOS=IPOS1 88 : IPOS1=MLESCF.INDEX(1+IELEM) 89 : NMAXVS=MAX(NMAXVS,(IPOS1-IPOS-1)) 90 : ENDDO 91 : C 92 : C**** MLEFSC = MLELEM face (sommets-centres) voisins 93 : C NMAXVF = nombre max de voisins sommets aux faces 94 : C (N.B: dedans MLEFSC, un/deux points sont des points centres) 95 : C 96 : SEGACT MLEFSC 97 : NFAC=MLEFSC.INDEX(/1)-1 98 : IPOS1=MLEFSC.INDEX(1) 99 : NMAXVF=0 100 : DO IELEM = 1, NSOM, 1 101 : IPOS=IPOS1 102 : IPOS1=MLEFSC.INDEX(1+IELEM) 103 : NMAXVF=MAX(NMAXVF,(IPOS1-IPOS-1)) 104 : ENDDO 105 : C 106 : NBL=NFAC 107 : NBTPOI=NFAC*(NMAXVS*NMAXVF)+NFAC 108 : C 109 : C**** NBTPOI iper sur-dimensionné 110 : C 111 : SEGINI MLEFC 112 : N1=IDIM 113 : N2=NBTPOI 114 : SEGINI MACOE2 115 : C 116 : C 117 : C**** MLECEN.MLENTI = position du centre NGC dedans un elt 118 : C face -centres 119 : C 120 : C MCLEAR = liste des points centres (pour nettoyer MLECEN) 121 : C 122 : C 123 : C MLESOM = position du sommet dedans MLESCF 124 : C 125 : JG=MCOORD.XCOOR(/1)/(IDIM+1) 126 : SEGINI MLECEN 127 : SEGINI MLESOM 128 : C 129 : DO IELEM=1,NSOM,1 130 : IPOS=MLESCF.INDEX(IELEM) 131 : NGS=MLESCF.LESPOI(IPOS) 132 : MLESOM.LECT(NGS)=IELEM 133 : ENDDO 134 : C 135 : JG=NMAXVS*NMAXVF 136 : SEGINI MCLEAR 137 : C 138 : C**** On crée MLRCOE: 139 : C 140 : C IPOS = MLESCF.INDEX(NLS) 141 : C IPOS1 = MLESCF.INDEX(NLS+1) 142 : C NGS = MLESCF.LESPOI(IPOS) 143 : C 144 : C 145 : C**** N.B. If MATCOE is expressed in the absolute frame 146 : C 147 : C VAL_NGS = \sum_{J=IPOS+1,IPOS1-1) (MATCOE.MAT(1,J) + 148 : C MATCOE.MAT(2,J) * X_NGS + MATCOE.MAT(3,J) * YNGS) 149 : C * VAL_J 150 : C 151 : C MLRCOE.PROG(J) = (MATCOE.MAT(1,J) + 152 : C MATCOE.MAT(2,J) * X_NGS + MATCOE.MAT(3,J) * YNGS) 153 : C 154 : C If MATCOE is expressed in the relative frame 155 : C 156 : C MLRCOE.PROG(J) = MATCOE.MAT(1,J) 157 : C 158 : SEGACT MATCOE 159 : N2=MATCOE.MAT(/2) 160 : NBTPOI=MLESCF.LESPOI(/1) 161 : IF(N2 .NE. NBTPOI)THEN 162 : WRITE(IOIMP,*) 'Subroutine rlexfi.eso' 162 : CALL ERREUR(5) 163 : GOTO 9999 164 : ENDIF 165 : C 166 : JG=N2 167 : SEGINI MLRCOE 168 : IPOS1=MLESCF.INDEX(1) 169 : DO IELEM=1,NSOM,1 170 : IPOS=IPOS1 171 : IPOS1=MLESCF.INDEX(1+IELEM) 172 : NGS=MLESCF.LESPOI(IPOS) 173 : MLRCOE.PROG(IPOS)=MATCOE.MAT(1,IPOS) 174 : C 175 : C******* N.B. IPOS+1 peut etre plus grand que IPOS1-1 176 : C En ce cas, pas de boucle 177 : C 178 : DO I1 = (IPOS+1),(IPOS1-1),1 179 : MLRCOE.PROG(I1)=MATCOE.MAT(1,I1) 180 : ENDDO 181 : ENDDO 182 : C 183 : C**** On detrui MATCOE 184 : C On rempli MACOE2.MAT 185 : C MLEFC.MELEME : face - (voisins de type centre 186 : C + sommets appartenant 187 : C aux c.l.) 188 : C 189 : SEGSUP MATCOE 190 : SEGACT MACOE1 191 : C 192 : IPOS1=MLEFSC.INDEX(1) 193 : IPOSF=1 194 : MLEFC.INDEX(1)=IPOSF 195 : DO IELEM=1,NFAC,1 196 : IPOS=IPOS1 197 : IPOS1=MLEFSC.INDEX(1+IELEM) 198 : NGF=MLEFSC.LESPOI(IPOS) 199 : IPOSF=MLEFC.INDEX(IELEM) 200 : MLEFC.LESPOI(IPOSF)=NGF 201 : C 202 : C******* NGF a de voisins en MLEFSC.MLELEM: 203 : C a) de type centre (un ou deux) 204 : C b) de type sommet 205 : C 206 : NVOIF=0 207 : NCEN=0 208 : C 209 : C******* NVOIF = nombre de voisins de NGF dedans 210 : C MLEFC.MLELEM 211 : C NCEN = nombre de voisins de type CENTRE de NGF dedans 212 : C MLEFC.MLELEM 213 : C 214 : C 215 : C******* Boucle sur le voisins de NGF en MLEFSC.MLELEM 216 : C 217 : DO I1=(IPOS+1),(IPOS1-1),1 218 : NGP=MLEFSC.LESPOI(I1) 219 : NLS=MLESOM.LECT(NGP) 220 : C 221 : C********** Deux possibilité: 222 : C NLS > 0 -> NGP est un point sommet 223 : C Dans ce cas NLS=position de NGP 224 : C dedans MLESCF.MLELEM 225 : C NLS = 0 -> NGP est un point centre 226 : C 227 : IF(NLS.GT.0)THEN 228 : IPOSP=MLESCF.INDEX(NLS) 229 : IPOSP1=MLESCF.INDEX(NLS+1) 230 : NVOI=IPOSP1-IPOSP-1 231 : IF(NVOI.EQ.0)THEN 232 : C 233 : C**************** Le point sommet NGP n'a pas de voisins 234 : C Donc il appartient aux c.l. 235 : C 236 : C Sa position dedans MLEFSC est I1 237 : C Sa position dedans MLESCF est IPOSP 238 : C 239 : ERRO=ABS(MLRCOE.PROG(IPOSP) - 1.0D0) 240 : IF(ERRO .GT. 1.0D-6)THEN 241 : WRITE(IOIMP,*) 'Subroutine rlexfi.eso' 241 : CALL ERREUR(5) 242 : GOTO 9999 243 : ENDIF 244 : NVOIF=NVOIF+1 245 : IPOSV=IPOSF+NVOIF 246 : MLEFC.LESPOI(IPOSV)=NGP 247 : MACOE2.MAT(1,IPOSV)=MACOE1.MAT(2,I1) 248 : MACOE2.MAT(2,IPOSV)=MACOE1.MAT(3,I1) 249 : IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)= 250 : & MACOE1.MAT(4,I1) 251 : ELSEIF(NVOI.GT.0)THEN 252 : C 253 : C**************** Boucle sur les voisins du point sommet NGP 254 : C dedans MLESCF.MLELEM 255 : C 256 : DO I2 = (IPOSP+1),(IPOSP1-1),1 257 : VAL=MLRCOE.PROG(I2) 258 : NGC=MLESCF.LESPOI(I2) 259 : NLC=MLECEN.LECT(NGC) 260 : C 261 : C******************* NLC = position de NGC dans la structure 262 : C NGF - se voisins en MLEFC.MLELEM 263 : C 264 : IF(NLC .EQ. 0)THEN 265 : C 266 : C********************** Nouveau voisin centre 267 : C 268 : NVOIF=NVOIF+1 269 : NCEN=NCEN+1 270 : MCLEAR.LECT(NCEN)=NGC 271 : MLECEN.LECT(NGC)=NVOIF 272 : IPOSV=IPOSF+NVOIF 273 : MLEFC.LESPOI(IPOSV)=NGC 274 : ELSE 275 : IPOSV=IPOSF+NLC 276 : ENDIF 277 : C 278 : C******************* I1 est la position du point sommet NGP dedans 279 : C MLEFSC.MLELEM, i.e. 280 : C MLEFSC.LESPOI(I1)=NGP 281 : C 282 : MACOE2.MAT(1,IPOSV)=MACOE2.MAT(1,IPOSV)+ 283 : & (MACOE1.MAT(2,I1)*VAL) 284 : MACOE2.MAT(2,IPOSV)=MACOE2.MAT(2,IPOSV)+ 285 : & (MACOE1.MAT(3,I1)*VAL) 286 : IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)= 287 : & MACOE2.MAT(3,IPOSV)+ 288 : & (MACOE1.MAT(4,I1)*VAL) 289 : ENDDO 290 : ELSEIF(NVOI.LT.0)THEN 291 : WRITE(IOIMP,*) 'Subroutine rlexfi.eso' 291 : CALL ERREUR(5) 292 : GOTO 9999 293 : ENDIF 294 : C 295 : ELSEIF(NLS.EQ.0)THEN 296 : C 297 : C************* NGP est un point centre 298 : C I1 = position de NGP dedans MLEFSC 299 : C i.e. MLEFSC.LESPOI(I1)=NGP 300 : C 301 : NLC=MLECEN.LECT(NGP) 302 : IF(NLC .EQ. 0)THEN 303 : C 304 : C******************* Nouveau point centre 305 : C 306 : NVOIF=NVOIF+1 307 : NCEN=NCEN+1 308 : MCLEAR.LECT(NCEN)=NGP 309 : MLECEN.LECT(NGP)=NVOIF 310 : IPOSV=IPOSF+NVOIF 311 : MLEFC.LESPOI(IPOSV)=NGP 312 : ELSE 313 : IPOSV=IPOSF+NLC 314 : ENDIF 315 : MACOE2.MAT(1,IPOSV)=MACOE2.MAT(1,IPOSV)+ 316 : & MACOE1.MAT(2,I1) 317 : MACOE2.MAT(2,IPOSV)=MACOE2.MAT(2,IPOSV)+ 318 : & MACOE1.MAT(3,I1) 319 : IF(IDIM.EQ.3) MACOE2.MAT(3,IPOSV)= 320 : & MACOE2.MAT(3,IPOSV)+ 321 : & MACOE1.MAT(4,I1) 322 : ELSEIF(NLS.LT.0)THEN 323 : WRITE(IOIMP,*) 'Subroutine rlexfi.eso' 323 : CALL ERREUR(5) 324 : GOTO 9999 325 : ENDIF 326 : C 327 : C******* Fin boucle sur le voisins de NGF en MLEFSC.MLELEM 328 : C 329 : ENDDO 330 : C 331 : MLEFC.INDEX(IELEM+1)=IPOSF+NVOIF+1 332 : C 333 : C******* Nettoyage de MCLEAR et MLECEN 334 : C 335 : DO I1 = 1, NCEN , 1 336 : NGC=MCLEAR.LECT(I1) 337 : MLECEN.LECT(NGC)=0 338 : MCLEAR.LECT(I1)=0 339 : ENDDO 340 : C 341 : ENDDO 342 : NBTPOI=MLEFC.INDEX(NFAC+1)-1 343 : N2 = NBTPOI 344 : C 345 : SEGADJ MLEFC 346 : SEGADJ MACOE2 347 : SEGDES MLEFC 348 : SEGDES MACOE2 349 : C 350 : C**** On detrui tous les objet qui ne servent plus 351 : C 352 : SEGSUP MLEFSC 353 : SEGSUP MLESCF 354 : SEGSUP MATCOE 355 : SEGSUP MLRCOE 356 : SEGSUP MLESOM 357 : SEGSUP MLECEN 358 : SEGSUP MCLEAR 359 : C 360 : 9999 RETURN 361 : END 362 : 363 : 364 : 365 : 366 : 367 : 368 : 369 : 370 : 371 : 372 :
© Cast3M 2003 - All rights reserved.
Disclaimer