1 : C KALPR2 SOURCE CHAT 11/03/16 21:25:54 6902 2 : SUBROUTINE KALPR2 (MYMOD,INFOEL,SKFAC2,SHC2D,XDEC,NELD,SKRESO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C---------------------------------------------------------------------- 6 : * Facteurs de forme en 2D-PLAN. Cas general 7 : * Calcul du decoupage des faces et initialisations 8 : * SP APPELE PAR facge2 9 : * entrée 10 : * MYMOD : pointeur de l'objet modèle 11 : * INFOEL : informations concernant le type des éléments des maillages 12 : * XDEC : parametre pour le decoupage des faces 13 : * NELD : nombre total d'elements 14 : * sortie 15 : * SKRESO : pointeur infos. globales 16 : * SKFAC2 : pointeur sur l objet 'faces' pour le calcul des FF 17 : * SHC2D : pointeur sur la surface de projection 18 : C---------------------------------------------------------------------- 19 : C traitement des coques par dedoublement des elements 20 : C traitement des quadratiques en se ramenant a des elements 21 : C lineaires 22 : C---------------------------------------------------------------------- 23 : LOGICAL ICOQ 24 : -INC CCOPTIO 25 : -INC SMCOORD 26 : -INC SMMODEL 27 : POINTEUR MYMOD.MMODEL 28 : -INC SMELEME 29 : 30 : C --------------------------------------------------------------- 31 : C Stockage d'informations concernant le type des éléments des maillages 32 : SEGMENT ,INFOEL 33 : LOGICAL KCOQ(N1),KQUAD(N1) 34 : ENDSEGMENT 35 : C --------------------------------------------------------------- 36 : SEGMENT SKRESO 37 : INTEGER KFC,NRES,KES,KIMP 38 : ENDSEGMENT 39 : C KFC : NOMBRE DE FACES H.C 40 : C NRES: RESOLUTION 41 : C KES : DIM ESPACE 42 : C KIMP: IMPRESSION 43 : C----------------------------------------------------------------------- 44 : SEGMENT SKFAC2 45 : INTEGER NUK(MS,MFACE),KPATCH(MFACE) 46 : INTEGER NCELL(MFACE) 47 : REAL*8 U(3,MFACE),S(MFACE) 48 : REAL*8 FF1(MFACE) 49 : ENDSEGMENT 50 : SEGMENT IPATCH 51 : REAL*8 GP(MSP,NPATCH),SP(NPATCH) 52 : ENDSEGMENT 53 : C 54 : C DESCRIPTION DES ELEMENTS 55 : C ------------------------ 56 : C MFACE : NOMBRE DE FACES 57 : C NUK : CONNECTIVITES 58 : C U : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT 59 : C S : SURFACE 60 : C KVU : VISIBILITE A PRIORI 61 : C FF : FACTEURS DE FORME 62 : C FF1 : TRAVAIL 63 : C NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT 64 : C KPATCH: POINTEUR SUR IPATCH 65 : C NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE) 66 : C GP : COORDONNEES DES POINTS 67 : C SP : ET SURFACES 68 : C----------------------------------------------------------------------- 69 : SEGMENT SHC2D 70 : INTEGER IR(NR),KA(NFC),IM(NFC,NFC) 71 : INTEGER KRO(NFC,NES),KSI(NFC,NES) 72 : REAL*8 V(NES,NR),G(NR) 73 : ENDSEGMENT 74 : 75 : C DESCRIPTION DU H.C DE PROJECTION 76 : C -------------------------------- 77 : C V : DIRECTION UNITAIRE DES CELLULES 78 : C G : FACTEUR DE FORME ASSOCIE 79 : C IR: CORRESPONDANCE 80 : C KRO , KSI : POUR LE CHANGEMENT DE REPERE 81 : C IM : REFERENCE 82 : C NR : RESOLUTION 83 : C NFC : NOMBRE DE FACES 84 : C----------------------------------------------------------------------- 85 : SEGMENT SDECOU 86 : INTEGER KDECOU(MFACE) 87 : ENDSEGMENT 88 : C-------------------------------------------------------------------- 89 : C 90 : SEGMENT STRAV 91 : REAL*8 A1(2,2),A2(2,2),U1(3),U2(3) 92 : ENDSEGMENT 93 : C-------------------------------------------------------------------- 94 : C 95 : DMIN=1.E-5 96 : DMAX=1./DMIN 97 : NPM=20 98 : C pour les elements lineaires (sinon pas=2) 99 : NSPA=1 100 : C on se ramene toujours a des SEG2 101 : NS=2 102 : 103 : SEGINI STRAV 104 : C 105 : C>>> CREATION DE L'OBJET FACE 106 : C 107 : IF (INFOEL.EQ.0) THEN 108 : ICOQ = .FALSE. 109 : ELSE 110 : ICOQ = .TRUE. 111 : SEGACT INFOEL 112 : ENDIF 113 : 114 : SEGACT MYMOD 115 : NTYP = MYMOD.KMODEL(/1) 116 : NFACE = 0 117 : NELD = 0 118 : DO 10 ITYP=1,NTYP 119 : IMODE1 = MYMOD.KMODEL(ITYP) 120 : SEGACT IMODE1 121 : IPT1 = IMODE1.IMAMOD 122 : SEGDES IMODE1 123 : SEGACT IPT1 124 : NEL = IPT1.NUM(/2) 125 : NSGEO = IPT1.NUM(/1) 126 : SEGDES IPT1 127 : C 128 : C un élément COQ -> 2 facteurs de formes 129 : IF (ICOQ.AND.KCOQ(ITYP)) NEL=2*NEL 130 : C 131 : NELD = NELD + NEL 132 : IF (NS.NE.2) WRITE(6,*) ' ON ATTEND DES SEG2 ' 133 : NFACE = NFACE + NEL 134 : 10 CONTINUE 135 : 136 : IF (IIMPI.GE.1) THEN 137 : */////// 138 : WRITE( 6,*) ' NOMBRE TOTAL D ELEMENTS',NELD,', DE FACES ',NFACE 139 : C NBSEG = 1+3*NTYP+(1+2*NTYP)*NELD 140 : C WRITE (6,*) 'Le CHAMELEM facteur de forme tient sur', 141 : C # NBSEG,' segments .' 142 : */////// 143 : ENDIF 144 : C 145 : MFACE = NFACE 146 : MS = NS 147 : SEGINI SKFAC2 148 : SEGINI SDECOU 149 : C 150 : C UN SEUL TYPE D'ELEMENTS : SEG2 151 : C 152 : C Remplissage de NUK(*,*) et de U(*,4) 153 : NELT= 0 154 : DO 100 ITYP = 1,NTYP 155 : 156 : 157 : IMODE1 = MYMOD.KMODEL(ITYP) 158 : SEGACT IMODE1 159 : IPT1 = IMODE1.IMAMOD 160 : SEGDES IMODE1 161 : SEGACT IPT1 162 : NSGEO = IPT1.NUM(/1) 163 : NSPA=1 164 : IF (ICOQ.AND.KQUAD(ITYP)) NSPA = 2 165 : NEL = IPT1.NUM(/2) 166 : DO 110 I = 1,NEL 167 : IF (ICOQ.AND.KCOQ(ITYP)) THEN 168 : WRITE (6,*) 'IL y a des COQ2' 169 : KEL = (2*I-1) + NELT 170 : ELSE 171 : KEL = I + NELT 172 : ENDIF 173 : 174 : DO 111 IS = 1, NSGEO, NSPA 175 : LS=IS 176 : IF (ICOQ.AND.KQUAD(ITYP)) LS=(IS+1)/2 177 : 178 : C** NUK(IS,KEL) = IPT1.NUM(IS,I) 179 : NUK(LS,KEL) = IPT1.NUM(IS,I) 180 : IF (IIMPI.GE.4) WRITE(6,*) 181 : # 'NUK(',LS,',',KEL,')=',NUK(LS,KEL) 182 : IREF = (IDIM+1)*(NUK(LS,KEL)-1) 183 : DO 112 K = 1,IDIM 184 : C** A1(K,IS) = XCOOR(IREF+K) 185 : A1(K,LS) = XCOOR(IREF+K) 186 : 112 CONTINUE 187 : 111 CONTINUE 187 : CALL KNORM2(IDIM,A1,NS,U1,S(KEL)) 188 : *//////////// 189 : * WRITE (6,*) 'Normale :',(U1(K),K=1,IDIM) 190 : *//////////// 191 : DO 113 L = 1,IDIM+1 192 : U(L,KEL) = U1(L) 193 : 113 CONTINUE 194 : C 195 : IF (ICOQ.AND.KCOQ(ITYP)) THEN 196 : C On remplit NUK , U et S pour l'élément inverse 197 : NUK(1,KEL+1) = NUK(2,KEL) 198 : NUK(2,KEL+1) = NUK(1,KEL) 199 : S(KEL+1) = S(KEL) 200 : DO 114 L = 1,IDIM+1 201 : U(L,KEL+1) = -U(L,KEL) 202 : 114 CONTINUE 203 : ENDIF 204 : 205 : 110 CONTINUE 206 : IF (ICOQ.AND.KCOQ(ITYP)) THEN 207 : NELT=NELT+NEL*2 208 : ELSE 209 : NELT=NELT+NEL 210 : ENDIF 211 : C 212 : SEGDES IPT1 213 : 100 CONTINUE 214 : C 215 : SEGDES MYMOD 216 : IF (ICOQ) SEGDES INFOEL 217 : C 218 : SEGACT SDECOU*MOD 219 : 220 : DO 200 K1= 1,NFACE 221 : DO 213 LS= 1, NS 222 : IREF = (IDIM+1)*(NUK(LS,K1)-1) 223 : DO 212 K = 1,IDIM 224 : C** A1(K,IS) = XCOOR(IREF+K) 225 : A1(K,LS) = XCOOR(IREF+K) 226 : 212 CONTINUE 227 : 213 CONTINUE 228 : DO 214 K=1,IDIM+1 229 : U1(K) = U(K,K1) 230 : 214 CONTINUE 231 : 232 : IF (XDEC.GE.0.01) THEN 233 : DK1 = DMAX 234 : DO 400 K2 = 1,MFACE 235 : C WRITE(6,*) ' K2 ',K2 236 : C 237 : DO 413 LS= 1, NS 238 : IREF = (IDIM+1)*(NUK(LS,K2)-1) 239 : DO 412 K = 1,IDIM 240 : C** A2(K,IS) = XCOOR(IREF+K) 241 : A2(K,LS) = XCOOR(IREF+K) 242 : 412 CONTINUE 243 : 413 CONTINUE 244 : DO 414 K=1,IDIM+1 245 : U2(K) = U(K,K2) 246 : 414 CONTINUE 247 : C 247 : CALL KPRIOR(IDIM,NS,NS,A1,A2,U1,U2,KVU) 248 : 249 : IF (KVU.NE.0) THEN 250 : C WRITE(6,*) ' KVU',KVU 251 : D1 = (A1(1,1)+A1(1,2)-A2(1,1)-A2(1,2))/2. 252 : D2 = (A1(2,2)+A1(2,2)-A2(2,1)-A2(2,2))/2. 253 : DKK1 = DSQRT(D1*D1+D2*D2) 254 : IF ((DKK1/S(K1)).GT.DMIN) THEN 255 : C tri angulaire 256 : CK1 = DABS(U1(1)*D1+U1(2)*D2)/DKK1 257 : C WRITE(6,*) ' K2 KVU DKK1 CK1 ',K1,KVU,DKK1,CK1 258 : IF(CK1.GE.0.01) THEN 259 : DK1= DMIN1(DKK1,DK1) 260 : ENDIF 261 : ENDIF 262 : ENDIF 263 : 400 CONTINUE 264 : DR=DK1/XDEC 265 : C WRITE(6,*) ' DR ',DR 266 : 267 : ELSE 268 : DR = DMAX 269 : ENDIF 270 : 271 : NPAT=INT(S(K1)/DR)+1 272 : NPAT=MIN0(NPAT,NPM) 273 : NPATCH = NPAT 274 : MSP = MS 275 : SEGINI IPATCH 275 : CALL KCREP2(A1,S(K1),IDIM,NPATCH,GP,SP) 276 : KDECOU(K1)= NPAT 277 : KPATCH(K1) = IPATCH 278 : SEGDES IPATCH 279 : 200 CONTINUE 280 : C 281 : IF(IIMPI.GE.2) THEN 282 : WRITE(6,*) 283 : WRITE(6,*) 'NOMBRE DE SUBDIVISIONS PAR FACE' 284 : WRITE(6,1000) (KDECOU(I),I=1,MFACE) 285 : 1000 FORMAT(1X,10(I4)) 286 : ENDIF 287 : C 288 : C>>> CARACTERISTIQUES GLOBALES 289 : C 290 : NFC = 4 291 : NR = NRES 292 : NES = IDIM 293 : SEGINI SHC2D 293 : CALL KCACU2(IDIM,NRES,G,V,NFC,KRO,KSI,IR,KA,IM) 294 : C 295 : C** KFC = NFC 296 : 297 : SEGDES SKFAC2,SHC2D 298 : SEGSUP SDECOU 299 : SEGSUP STRAV 300 : C 301 : RETURN 302 : END 303 : 304 : 305 : 306 : 307 : 308 : 309 : 310 : 311 :
© Cast3M 2003 - All rights reserved.
Disclaimer