1 : C DYNE02 SOURCE CHAT 09/10/09 21:17:30 6519 2 : SUBROUTINE DYNE02(ICHOLX,IRSCPR,NDDL,IRIG,IVEC,IPZ,IPM, 3 : & MBLO,MBLO2,IPRIGZ,ICPC) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * D Y N E 0 2 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * UTILITAIRE DE L'OPERATEUR "DYNE" 14 : * -1 T 15 : * CALCUL DU PRODUIT : Z = A M A 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 18 : * ----------- 19 : * 20 : * ICHOLX (E) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF ) 21 : * IRSCPR (E) POINTEUR SUR LE SEGMENT ICPR ( ACTIF ) 22 : * NDDL (E) NOMBRE DE DEGRES DE LIBERTE 23 : * IRIG (E) POINTEUR SUR L'OBJET RIGIDITE A ( ACTIF ) 24 : * IVEC (E/S) POINTEUR SUR UN VECTEUR DE TRAVAIL 25 : * IPZ (S) POINTEUR SUR LE SEGMENT MZZZ ( LAISSE ACTIF ) 26 : * -1 27 : * IPM (S) POINTEUR SUR LE VECTEUR CONTENANT M ( LAISSE ACTIF 28 : * MBLO (S) POINTEUR SUR LE SEGMENT MBLO | VOIR PLUS BAS 29 : * MBLO2 (S) POINTEUR SUR LE SEGMENT MBLO2 | ( LAISSES ACTIFS ) 30 : * IPRIGZ (S) POINTEUR SUR L'OBJET RIGIDITE Z 31 : * ICPC (S) POINTEUR SUR UN SEGMENT DE TYPE ICPR ( LAISSE ACTIF ) 32 : * 33 : * REMARQUES: 34 : * ---------- 35 : * CETTE VERSION NE TRAITE QUE LES DDL BLOQUES, POUR LES RELATIONS 36 : * IL FAUDRA PROCEDER AUTREMENT EN CE QUI CONCERNE LA MATRICE A. 37 : * -1 T 38 : * LE PRODUIT A M A NE SERA PLUS UNE MATRICE DIAGONALE, ON DEVRA 39 : * EFFECTUER UNE RESOLUTION : C'EST POURQUOI ON CREE L'OBJET Z 40 : * DE TYPE RIGIDITE. 41 : * 42 : * AUTEUR, DATE DE CREATION: 43 : * ------------------------- 44 : * DENIS ROBERT, LE 16 NOVEMBRE 1988. 45 : * 46 : * LANGAGE: 47 : * -------- 48 : * ESOPE + FORTRAN77 49 : * 50 : ************************************************************************ 51 : * 52 : * MODULES UTILISES: 53 : * 54 : -INC CCOPTIO 55 : -INC SMELEME 56 : -INC SMRIGID 57 : -INC SMMATRI 58 : -INC SMVECTD 59 : -INC SMCOORD 60 : * 61 : PARAMETER ( UN = 1.D0 ) 62 : PARAMETER ( ZERO = 0.D0 ) 63 : * 64 : CHARACTER*4 NI 65 : * 66 : *--- SEGMENTS DE TRAVAIL : 67 : * -1 T 68 : * MZZZ CONTIENT LE PRODUIT A M A RANGE EN LIGNE 69 : * -1 70 : * MBLO CONTIENT LE PRODUIT A M TABLEAU IDDL * NDDL 71 : * MBLO2 CONTIENT LA MATRICE A TABLEAU IDDL * NDDL 72 : * ICP. CONTIENT DES REFERENCES GEOMETRIQUES 73 : * MUITRA CONTIENT LES CORRESPONDANCES DES COMPOSANTES 74 : * 75 : SEGMENT MUITRA(NLIGRA) 76 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 77 : SEGMENT ICPA(XCOOR(/1)/(IDIM+1)) 78 : SEGMENT ICPB(XCOOR(/1)/(IDIM+1)) 79 : SEGMENT ICPC(XCOOR(/1)/(IDIM+1)) 80 : SEGMENT,MZZZ 81 : REAL*8 ZZZZ(LONZ,LONZ) 82 : ENDSEGMENT 83 : SEGMENT,MBLO 84 : REAL*8 BLO(IDDL,NDDL) 85 : ENDSEGMENT 86 : POINTEUR MBLO2.MBLO 87 : * 88 : MVECTD=IVEC 89 : MMATRI=ICHOLX 90 : MINCPO=IINCPO 91 : MIMIK=IIMIK 92 : ICPR=IRSCPR 93 : SEGINI,ICPA,ICPB,ICPC 94 : LNA=ICPA(/1) 95 : ININC=IMIK(/2) 96 : * 97 : DO 5 ILNA=1,LNA 98 : ICPA(ILNA)=0 99 : ICPB(ILNA)=0 100 : ICPC(ILNA)=0 101 : 5 CONTINUE 102 : * END DO 103 : * 104 : IF (IRIG.NE.0) THEN 105 : * 106 : *--- L'OBJET RIGIDITE "A" EXISTE 107 : * 108 : *------------------------------------------------* 109 : *--- BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---* 110 : *------------------------------------------------* 111 : * 112 : IK=0 113 : IKK=0 114 : RI1=IRIG 115 : SEGACT,RI1 116 : NRIGE1=RI1.IRIGEL(/2) 117 : DO 20 IRI=1,NRIGE1 118 : MELEME=RI1.IRIGEL(1,IRI) 119 : SEGACT,MELEME 120 : * 121 : *--- REMPLISSAGE DE ICPA ET ICPB 122 : * REMARQUE : N1= 3 CAR ON VEUT TOUJOURS LE 3EME NOEUD QUI 123 : * EST RELATIF AU DDL PHYSIQUE 124 : * 125 : N1=NUM(/1) 126 : N2=NUM(/2) 127 : DO 30 I2 = 1,N2 128 : IKK=IKK+1 129 : K=NUM(3,I2) 130 : ICPC(IKK)=NUM(1,I2) 131 : IF (ICPA(K).EQ.0) THEN 132 : IK=IK+1 133 : ICPA(K)=IK 134 : ICPB(IK)=K 135 : ENDIF 136 : 30 CONTINUE 137 : * END DO 138 : SEGDES,MELEME 139 : 20 CONTINUE 140 : * END DO 141 : IDDL=IKK 142 : * 143 : *---------------------------------------* 144 : *--- CREATION DE LA GEOMETRIE DE Z ---* 145 : *---------------------------------------* 146 : * 147 : NBSOUS=0 148 : NBREF=0 149 : NBNN=1 150 : NBELEM=IK 151 : SEGINI,IPT1 152 : DO 10 II=1,IK 153 : IPT1.NUM(1,II)=ICPB(II) 154 : 10 CONTINUE 155 : * END DO 156 : IPOGEO=IPT1 157 : SEGDES,IPT1 158 : SEGINI,MBLO 159 : DO 31 IA1=1,IDDL 160 : DO 32 IA2=1,NDDL 161 : BLO(IA1,IA2)=ZERO 162 : 32 CONTINUE 163 : * END DO 164 : 31 CONTINUE 165 : * END DO 166 : * 167 : *---------------------------------------------------* 168 : *--- RE-BOUCLE SUR LES ZONES ELEMENTAIRES DE A ---* 169 : *---------------------------------------------------* 170 : * 171 : IPPL=0 172 : NLIGRP=IDDL 173 : NLIGRD=IDDL 174 : SEGINI,DESCR 175 : DO 50 IR=1,NRIGE1 176 : MELEME=RI1.IRIGEL(1,IR) 177 : SEGACT,MELEME 178 : DES1=RI1.IRIGEL(3,IR) 179 : SEGACT,DES1 180 : * 181 : *--- ON REMPLIT MUITRA(IN) = IJ QUI DIT QUE LA IEME INCONNUE 182 : *--- DE LA ZONE ELEMENTAIRE DE "A" EST LA JEME DE ININC 183 : * 184 : NLIGRA=DES1.LISINC(/2) 185 : SEGINI,MUITRA 186 : DO 51 IN=1,NLIGRA 187 : NI=DES1.LISINC(IN) 188 : DO 52 IJ=1,ININC 189 : IF(NI.EQ.IMIK(IJ)) GO TO 53 190 : 52 CONTINUE 191 : * END DO 192 : 53 CONTINUE 193 : MUITRA(IN)=IJ 194 : 51 CONTINUE 195 : * END DO 196 : * xMATR1=RI1.IRIGEL(4,IR) 197 : COER=RI1.COERIG(IR) 198 : * SEGACT,xMATR1 199 : NN2=NUM(/2) 200 : * 201 : *---------------------------------------* 202 : *--- REMPLISSAGE DU TABLEAU BLO ---* 203 : *---------------------------------------* 204 : * 205 : DO 60 I22=1,NN2 206 : IPPL=IPPL+1 207 : * XMATR1=IMATR1.IMATTT(I22) 208 : * SEGACT,XMATR1 209 : * 210 : J2=ICPR(NUM(DES1.NOELEP(3),I22)) 211 : J1=MUITRA(3) 212 : IKI=INCPO(J1,J2) 213 : BLO(IPPL,IKI)=UN 214 : * 215 : NOELEP(IPPL)=ICPA(NUM(DES1.NOELEP(3),I22)) 216 : NOELED(IPPL)=ICPA(NUM(DES1.NOELED(3),I22)) 217 : LISINC(IPPL)=DES1.LISINC(3) 218 : LISDUA(IPPL)=DES1.LISDUA(3) 219 : * 220 : * SEGDES,XMATR1 221 : 60 CONTINUE 222 : * END DO 223 : SEGDES,DES1,MELEME 224 : SEGSUP,MUITRA 225 : 50 CONTINUE 226 : * END DO 227 : IPDES1=DESCR 228 : SEGDES,DESCR,RI1 229 : * 230 : IF (IPPL.NE.IDDL) THEN 231 : WRITE(IOIMP,*)'DYNE : IL MANQUE ',(IDDL-IPPL),' BLOCAGES |' 232 : ENDIF 233 : * 234 : *------------------------------------------* 235 : * -1 T * 236 : *--- CALCUL DU PRODUIT : Z = A M A * 237 : *------------------------------------------* 238 : * 239 : SEGINI,MBLO2=MBLO 240 : * -1 241 : *--- CALCUL DE : A M ---> RANGE DANS BLO 242 : * 243 : DO 100 IL=1,IDDL 244 : DO 200 IK=1,NDDL 245 : IF (BLO(IL,IK).NE.ZERO) THEN 246 : BLO(IL,IK)=VECTBB(IK) 247 : ENDIF 248 : 200 CONTINUE 249 : * END DO 250 : 100 CONTINUE 251 : * END DO 252 : * -1 T 253 : *--- CALCUL DE : A M A ---> DIAGONALE 254 : *--- INFERIEURE STOCKEE EN LIGNE, DE LONGUEUR IDDL*(IDDL+1)/2 255 : * 256 : LONZ=IDDL 257 : SEGINI,MZZZ 258 : IPZ=MZZZ 259 : DO 120 IZ=1,LONZ 260 : DO 120 IKZ=1,LONZ 261 : ZZZZ(IKZ,IZ)=ZERO 262 : 120 CONTINUE 263 : * END DO 264 : IZZ=0 265 : DO 300 IB1=1,IDDL 266 : DO 400 IB2=1,IDDL 267 : IF (IB2.GE.IB1) THEN 268 : * IZZ=IZZ+1 269 : DO 500 IBB=1,NDDL 270 : ZZZZ(IB2,IB1)=ZZZZ(IB2,IB1)+BLO(IB1,IBB)*MBLO2.BLO(IB2,IBB) 271 : 500 CONTINUE 272 : * END DO 273 : ELSE 274 : ZZZZ(IB2,IB1)=ZZZZ(IB1,IB2) 275 : ENDIF 276 : 400 CONTINUE 277 : * END DO 278 : 300 CONTINUE 279 : * END DO 280 : * IF (IZZ.NE.LONZ) THEN 281 : * WRITE(IOIMP,*)'DYNE : IL MANQUE',(LONZ-IZZ),'TERMES DANS Z |' 282 : * ENDIF 283 : * 284 : *--------------------------------------------------------------* 285 : *--- ON VA MAINTENANT CREER UN OBJET RIGIDITE CONTENANT Z ---* 286 : *--------------------------------------------------------------* 287 : * 288 : NRIGEL=1 289 : NRIGE=8 290 : SEGINI,MRIGID 291 : ICHOLE=0 292 : IMGEO1=0 293 : IMGEO2=0 294 : IFORIG=IFOMOD 295 : ISUPEQ=0 296 : NBGEOR=0 297 : MTYMAT='RIGIDITE' 298 : COERIG(1)=UN 299 : IRIGEL(1,1)=IPOGEO 300 : IRIGEL(2,1)=0 301 : IRIGEL(3,1)=IPDES1 302 : IRIGEL(5,1)=0 303 : IRIGEL(6,1)=0 304 : NELRIG=1 305 : * SEGINI,IMATRI 306 : NLIGRP=LONZ 307 : NLIGRD=LONZ 308 : SEGINI,XMATRI 309 : DO 600 IRZ=1,LONZ 310 : DO 600 IKRZ=1,LONZ 311 : RE(IKRZ,IRZ,1)=ZZZZ(IKRZ,IRZ) 312 : 600 CONTINUE 313 : * END DO 314 : * IMATTT(1)=XMATRI 315 : * SEGDES,XMATRI 316 : IRIGEL(4,1)=xMATRI 317 : SEGDES,xMATRI 318 : IPRIGZ=MRIGID 319 : SEGDES,MRIGID 320 : * 321 : *--- FIN DU TRAITEMENT DE L'OBJET RIGIDITE "A" 322 : * 323 : ENDIF 324 : * -1 325 : *--- STOCKAGE DE M DANS UN VECTEUR DE LONGUEUR NDDL 326 : * 327 : IBB1=0 328 : INC=NDDL 329 : SEGINI,MVECT1 330 : DO 777 IB0=1,NDDL 331 : MVECT1.VECTBB(IB0)=ZERO 332 : 777 CONTINUE 333 : * END DO 334 : DO 888 IB1=1,VECTBB(/1) 335 : TTEST=VECTBB(IB1) 336 : IF (TTEST.NE.ZERO) THEN 337 : IBB1=IBB1+1 338 : MVECT1.VECTBB(IBB1)=VECTBB(IB1) 339 : ENDIF 340 : 888 CONTINUE 341 : * END DO 342 : IPM=MVECT1 343 : * SEGSUP,ICPA,ICPB 344 : * 345 : END 346 : 347 : 348 : 349 : 350 : 351 : 352 : 353 : 354 :
© Cast3M 2003 - All rights reserved.
Disclaimer