1 : C DUALI2 SOURCE CHAT 05/01/12 22:58:38 5004 2 : C DUALISE LE RESULTAT DE SURF POUR LE MAILLAGE PAR POLYGONE 3 : C 4 : SUBROUTINE DUALI2(FER,XPRO,XPROJ1,IPT2,NUMELG,NDEB,NUMNP) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : LOGICAL PORDO 8 : SEGMENT /FER/(NFI(ITT),MAI(IPP),ITOUR) 9 : SEGMENT XPRO 10 : REAL*8 XPROJ(3,1) 11 : ENDSEGMENT 12 : POINTEUR XPROJ1.XPRO 13 : SEGMENT ILIST(NBNN) 14 : SEGMENT INB(NUMNP) 15 : -INC SMELEME 16 : POINTEUR POLY.MELEME, POLY1.MELEME 17 : * 18 : DO 84, NUCOT = 1, ITOUR 19 : * 20 : IDEB = MAI(NUCOT) 21 : IFIN = MAI(NUCOT+1)-1 22 : * 23 : DO 84, IP2 = IDEB, IFIN 24 : * 25 : 84 CONTINUE 26 : 27 : IAUX=XPRO 28 : XPRO=XPROJ1 29 : XPROJ1=IAUX 30 : SEGINI INB 31 : * ON CREE UN NOEUD AU CENTRE DE GRAVITE DE CHAQUE TRIANGLE 32 : DO 15 I=1,NUMELG 33 : * 34 : XPROJ(1,NDEB+I-1)=0. 35 : XPROJ(2,NDEB+I-1)=0. 36 : XPROJ(3,NDEB+I-1)=0. 37 : DO 10 J=1,3 38 : IP=IPT2.NUM(J,I) 39 : INB(IP)=INB(IP)+1 40 : XPROJ(1,NDEB+I-1)=XPROJ(1,NDEB+I-1)+XPROJ1.XPROJ(1,IP) 41 : XPROJ(2,NDEB+I-1)=XPROJ(2,NDEB+I-1)+XPROJ1.XPROJ(2,IP) 42 : XPROJ(3,NDEB+I-1)=XPROJ(3,NDEB+I-1)+XPROJ1.XPROJ(3,IP) 43 : 10 CONTINUE 44 : XPROJ(1,NDEB+I-1)=XPROJ(1,NDEB+I-1)/3 45 : XPROJ(2,NDEB+I-1)=XPROJ(2,NDEB+I-1)/3 46 : XPROJ(3,NDEB+I-1)=XPROJ(3,NDEB+I-1)/3 47 : 15 CONTINUE 48 : * ON CONSTRUIT LES ELEMENTS 49 : NBNN=0 50 : DO 20 IP=1,NUMNP 51 : NBNN=MAX(INB(IP),NBNN) 52 : INB(IP)=0 53 : 20 CONTINUE 54 : * 55 : SEGINI ILIST 56 : NBELEM=NUMNP 57 : NBSOUS=0 58 : NBREF=0 59 : SEGINI MELEME 60 : ITYPEL=32 61 : DO 35 I=1,NUMELG 62 : DO 30 J=1,3 63 : IP=IPT2.NUM(J,I) 64 : INB(IP)=INB(IP)+1 65 : NUM(INB(IP),IP)=I 66 : 30 CONTINUE 67 : 35 CONTINUE 68 : * 69 : NUMNP = NUMELG + NDEB - 1 70 : NUMELG = NBELEM 71 : * 72 : * MAINTENANT IL FAUT REPASSER LES ELEMENTS POUR METTRE LES NOEUDS 73 : * DANS LE BON SENS ET S'OCCUPER DES BORDS 74 : * 75 : DO 100 INT=1,NBELEM 76 : * 77 : * Ordonnancement 78 : * 79 : NUSP = 0 80 : PORDO = .FALSE. 81 : * 82 : * TANT QUE LE POLYGONE N'EST PAS ENTIEREMENT ORDONNEE 83 : * 84 : 50 CONTINUE 85 : * 86 : * Boucle sur tous les triangles voisins 87 : * 88 : DO 70 I=1,INB(INT) 89 : * 90 : ICT = NUM(I,INT) 91 : * 92 : * Boucle sur les sommets du triangle associé 93 : * 94 : DO 60 K=1,3 95 : IF (IPT2.NUM(K,ICT).EQ.INT) THEN 96 : * 97 : * C'est le centre du polygone 98 : * 99 : INT1 = IPT2.NUM(MOD(K,3)+1,ICT) 100 : INT2 = IPT2.NUM(MOD(K+1,3)+1,ICT) 101 : * 102 : IF (NUSP.EQ.0) THEN 103 : * 104 : * Pas encore de sommets mémorisés 105 : * 106 : IF (INT.LT.NDEB) THEN 107 : * 108 : * Le centre du polygone est sur le coté 109 : * 110 : INP3 = NUSOM(INT1, INT, FER, NDEB) 111 : INP4 = NUSOM(INT2, INT, FER, NDEB) 112 : * 113 : IF (INP3.NE.0) THEN 114 : * 115 : * Premier sommet du polygone 116 : * 117 : ILIST(1) = INP3 118 : ILIST(2) = ICT + NDEB - 1 119 : INTF = INT2 120 : NUSP = 2 121 : * 122 : IF (INP4.NE.0) THEN 123 : * 124 : * Le polygone est triangulaire 125 : * 126 : ILIST(3) = INP4 127 : PORDO = .TRUE. 128 : NUSP = 3 129 : * 130 : ENDIF 131 : * 132 : ELSEIF (INP4.NE.0) THEN 133 : * 134 : * Premier sommet du polygone 135 : * 136 : ILIST(1) = INP4 137 : ILIST(2) = ICT + NDEB - 1 138 : INTF = INT1 139 : NUSP = 2 140 : * 141 : ENDIF 142 : ELSE 143 : * 144 : * Le centre du polygone est au milieu de la surface 145 : * 146 : ILIST(1) = ICT + NDEB - 1 147 : INTD = INT1 148 : INTF = INT2 149 : NUSP = 1 150 : * 151 : ENDIF 152 : * 153 : ELSE 154 : * 155 : * Des noeuds sont deja memorisés 156 : * 157 : IF (INT1.EQ.INTF.OR.INT2.EQ.INTF) THEN 158 : * 159 : NUSP = NUSP+1 160 : ILIST (NUSP) = ICT + NDEB - 1 161 : * 162 : IF (INT1.EQ.INTF) THEN 163 : INTF = INT2 164 : ELSE IF (INT2.EQ.INTF) THEN 165 : INTF = INT1 166 : ENDIF 167 : * 168 : IF (INTF.EQ.INTD) THEN 169 : * 170 : * Polygone fermé 171 : * 172 : PORDO = .TRUE. 173 : * 174 : ENDIF 175 : * 176 : INP3 = NUSOM(INTF, INT, FER, NDEB) 177 : * 178 : IF (INP3.NE.0) THEN 179 : * 180 : * Le deux sommets sont voisins sur la frontiere 181 : * => on ferme le polygone 182 : * 183 : NUSP = NUSP+1 184 : ILIST (NUSP) = INP3 185 : PORDO = .TRUE. 186 : * 187 : ENDIF 188 : * 189 : ENDIF 190 : * 191 : ENDIF 192 : * 193 : ENDIF 194 : * 195 : 60 CONTINUE 196 : * 197 : 70 CONTINUE 198 : * 199 : IF (.NOT.PORDO) GOTO 50 200 : * 201 : * Stockage du maillage dans un segment MELEME 202 : * 203 : IF (INT.EQ.1) THEN 204 : * 205 : * Initialisation du pointeur chapeau du maillage 206 : * 207 : NBNN = 0 208 : NBELEM = 0 209 : NBREF = 0 210 : NBSOUS = 1 211 : SEGINI POLY1 212 : * 213 : ELSE 214 : * 215 : * Recherche si un polygone a NUSP cotés existe deja dans MELEME 216 : * 217 : NBELEM = 0 218 : * 219 : DO 80 I=1, POLY1.LISOUS(/1) 220 : * 221 : POLY = POLY1.LISOUS(I) 222 : * 223 : IF (POLY.NUM(/1).EQ.NUSP) THEN 224 : * 225 : NBELEM = POLY.NUM(/2)+1 226 : NBNN = NUSP 227 : NBSOUS = 0 228 : NBREF = 0 229 : * 230 : SEGADJ POLY 231 : GOTO 81 232 : * 233 : ENDIF 234 : * 235 : 80 CONTINUE 236 : 81 CONTINUE 237 : * 238 : IF (NBELEM.EQ.0) THEN 239 : * 240 : NBNN = 0 241 : NBELEM = 0 242 : NBREF = 0 243 : NBSOUS = POLY1.LISOUS(/1)+1 244 : SEGADJ POLY1 245 : * 246 : ENDIF 247 : * 248 : ENDIF 249 : * 250 : IF (NBELEM.EQ.0) THEN 251 : * 252 : * Creation de l'element a NUSP cote 253 : * 254 : NBELEM = 1 255 : NBNN = NUSP 256 : NBSOUS = 0 257 : NBREF = 0 258 : * 259 : SEGINI POLY 260 : * 261 : NBSOUS = POLY1.LISOUS(/1) 262 : POLY1.LISOUS(NBSOUS) = POLY 263 : POLY.ITYPEL = 32 264 : * 265 : ENDIF 266 : * 267 : * Recopie des données dans le MELEME 268 : * 269 : DO 90 I = 1, NUSP 270 : * 271 : POLY.NUM(I, NBELEM) = ILIST(I) 272 : * 273 : 90 CONTINUE 274 : * 275 : 100 CONTINUE 276 : * 277 : * Recopie du nouveau MELEME dans l'ancien 278 : * 279 : IPT3 = IPT2 280 : IPT2 = POLY1 281 : * 282 : SEGSUP IPT3 283 : * 284 : END 285 : 286 :
© Cast3M 2003 - All rights reserved.
Disclaimer