1 : C DYNE26 SOURCE CHAT 11/03/16 21:19:39 6902 2 : SUBROUTINE DYNE26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IB,ICOMP, 3 : & RIGIDE,ITCARA,LMODYN) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Op�rateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Transpose l'information des objets de Castem2000 dans des * 12 : * tableaux de travail. * 13 : * * 14 : * Param�tres: * 15 : * * 16 : * e IBAS Table repr�sentant une base modale * 17 : * es KTKAM Segment contenant les matrices XK, XASM et XM * 18 : * es KTPHI Segment des d�form�es modales * 19 : * e KTLIAB Segment des liaisons sur base B * 20 : * es IA1 Compteur * 21 : * es RIGIDE Vrai si l'on a un corps rigide, faux sinon * 22 : * * 23 : * Auteur, date de cr�ation: * 24 : * * 25 : * Lionel VIVAN, le 24 octobre 1989. * 26 : * * 27 : *--------------------------------------------------------------------* 28 : -INC CCOPTIO 29 : -INC CCREEL 30 : -INC SMCHAML 31 : -INC SMELEME 32 : -INC SMMODEL 33 : * 34 : SEGMENT,MTKAM 35 : REAL*8 XK(NA1),XASM(NA1),XM(NA1) 36 : ENDSEGMENT 37 : * 38 : SEGMENT,MTPHI 39 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 40 : INTEGER IAROTA(NSB) 41 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 42 : ENDSEGMENT 43 : * 44 : SEGMENT,MTLIAB 45 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 46 : REAL*8 XPALB(NLIAB,NXPALB) 47 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 48 : ENDSEGMENT 49 : * 50 : segment mtbas 51 : integer itbmod,lsstru(np1),nsstru 52 : endsegment 53 : * 54 : LOGICAL L0,L1,RIGIDE,LMODYN 55 : CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3) 56 : CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE 57 : REAL*8 XAXROT(3),XROTA(2,3) 58 : * 59 : * si IFOMOD = -1 : mod�le PLAN 60 : * si IFOMOD = 0 : mod�le AXIS 61 : * si IFOMOD = 1 : mod�le FOUR 62 : * si IFOMOD = 2 : mod�le TRID 63 : * 64 : * Les noms de composante sont 65 : * - en mod�le PLAN : UX, UY, RT 66 : * - en mod�le AXIS : UX, UY, RZ 67 : * - en mod�le FOUR 1 : UR, UZ, UT, RT 68 : * - en mod�le TRID : UX, UY, UZ, RX, RY, RZ 69 : * 70 : DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/ 71 : DATA NOMAXI/'UR ','UT ','UZ ','RR ','RT ','RZ '/ 72 : DATA NOMPLA/'UX ','UY ','RZ '/ 73 : * 74 : MTKAM = KTKAM 75 : MTPHI = KTPHI 76 : MTLIAB = KTLIAB 77 : * 78 : NLIAB = IPALB(/1) 79 : NPLB = JPLIB(/1) 80 : NSB = XPHILB(/1) 81 : NPLSB = XPHILB(/2) 82 : NA2 = XPHILB(/3) 83 : IDIMB = XPHILB(/4) 84 : DEUXPI = 2.D0 * XPI 85 : * 86 : IORSB(IB) = IA1 + 1 87 : IAROTA(IB) = 0 88 : IROT = 0 89 : IN = 0 90 : 91 : if (lmodyn) goto 40 92 : 10 CONTINUE 93 : IN = IN + 1 94 : TYPRET = ' ' 94 : CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0, 95 : & TYPRET,I1,X1,CHARRE,L1,IBAMOD) 96 : IF (IERR.NE.0) RETURN 97 : IF (IBAMOD.NE.0) THEN 98 : IF (TYPRET.EQ.'TABLE ') THEN 99 : IA1 = IA1 + 1 99 : CALL ACCTAB(IBAMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0, 100 : & 'FLOTTANT',I1,XMASSE,' ',L1,IP1) 101 : IF (IERR.NE.0) RETURN 102 : XM(IA1) = XMASSE 102 : CALL ACCTAB(IBAMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0, 103 : & 'FLOTTANT',I1,XFREQ,' ',L1,IP1) 104 : IF (IERR.NE.0) RETURN 105 : OMEGA = XFREQ * DEUXPI 106 : XK(IA1) = XMASSE * OMEGA * OMEGA 106 : CALL ACCTAB(IBAMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, 107 : & 'CHPOINT',I1,X1,' ',L1,ICDM) 108 : IF (IERR.NE.0) RETURN 109 : * 110 : IF (IIMPI.EQ.333) THEN 111 : WRITE(IOIMP,*)'DYNE26 : XM(',IA1,') =',XMASSE 112 : WRITE(IOIMP,*)'DYNE26 : XK(',IA1,') =',XK(IA1) 113 : ENDIF 114 : IF (NLIAB.NE.0) THEN 115 : DO 12 ID = 1,IDIMB 116 : IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN 117 : CMOT = NOMAXI(ID) 118 : ELSE 119 : IF (IFOMOD.EQ.-1) THEN 120 : CMOT = NOMPLA(ID) 121 : ELSE 122 : CMOT = NOMTRI(ID) 123 : ENDIF 124 : ENDIF 125 : IF (IIMPI.EQ.333) THEN 126 : WRITE(IOIMP,*)'DYNE26 : composante @ extraire :',CMOT 127 : ENDIF 128 : ICOMP = 0 129 : DO 14 IP = 1,NPLB 130 : IPOINT = JPLIB(IP) 131 : * 132 : * On extrait du chpoint ICDM au point IPOINT de composante CMOT 133 : * 133 : CALL EXTRA9(ICDM,IPOINT,CMOT,KERRE,XVAL) 134 : ICOMP = ICOMP + 1 135 : * 136 : * on ajuste la taille si necessaire 137 : * MP 138 : IF(ICOMP.GT.NPLSB) THEN 139 : NPLSB=ICOMP 140 : SEGADJ MTPHI 141 : ENDIF 142 : IPLSB(IP) = ICOMP 143 : * suite � la modif dans extra9, car on attribue une valeur meme 144 : * si le point n'existe pas dans le chpoint 145 : IF (XVAL.NE.0.) THEN 146 : IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN 146 : call erreur (783) 147 : RETURN 148 : ENDIF 149 : IBASB(IP) = IB 150 : ELSE 151 : IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB 152 : ENDIF 153 : * 154 : XPHILB(IB,ICOMP,IN,ID) = XVAL 155 : IF (IIMPI.EQ.333) THEN 156 : WRITE(IOIMP,*)'DYNE26 : IPLSB(',IP,') =',IPLSB(IP) 157 : WRITE(IOIMP,*)'DYNE26 : IBASB(',IP,') =',IBASB(IP) 158 : XVA2 = XPHILB(IB,ICOMP,IN,ID) 159 : WRITE(IOIMP,*)'DYNE26 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2 160 : ENDIF 161 : 162 : 14 CONTINUE 163 : * end do 164 : 12 CONTINUE 165 : * end do 166 : ENDIF 167 : ** 168 : * Prise en compte d'un mode de rotation de corps rigide 169 : ** 170 : MORIGI = ' ' 170 : CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, 171 : & MORIGI,I1,X1,CMOT,L1,IP1) 172 : IF (IERR.NE.0) RETURN 173 : IF (MORIGI.EQ.'MOT') THEN 174 : IF (CMOT(1:4).EQ.'VRAI') THEN 174 : CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE', 175 : &L0,IP0,'POINT',I1,X1,' ',L1,ICDG) 176 : IF (IERR.NE.0) RETURN 177 : IAROTA(IB)=IA1 178 : IROT = IN 179 : ENDIF 180 : ENDIF 181 : GOTO 10 182 : ELSE 182 : CALL ERREUR(491) 183 : RETURN 184 : ENDIF 185 : ENDIF 186 : INMSB(IB) = IN - 1 187 : 188 : 40 if (lmodyn) then 189 : * 190 : mtbas = ibas 191 : mmodel = itbmod 192 : segact mmodel 193 : mchelm = itcara 194 : segact mchelm 195 : n1 = imache(/1) 196 : IN = 0 197 : 198 : do 41 ik =1,kmodel(/1) 199 : imodel = kmodel(ik) 200 : if (lsstru(ik).ne.ib) goto 41 201 : IN = IN + 1 202 : segact imodel 203 : jdefo = 0 204 : jmass = 0 205 : jfreq = 0 206 : jgrav = 0 207 : do 46 inc = 1,n1 208 : meleme = imache(inc) 209 : if (meleme.ne.imamod) goto 46 210 : if (conche(inc).ne.conmod) goto 46 211 : segact meleme 212 : mchaml = ichaml(inc) 213 : segact mchaml 214 : n2 = ielval(/1) 215 : 216 : do io = 1,n2 217 : if (nomche(io)(1:4).eq.'DEFO') then 218 : jdefo = io 219 : melval = ielval(io) 220 : segact melval 221 : else if (nomche(io)(1:4).eq.'MASS') then 222 : jmass =io 223 : melval = ielval(io) 224 : segact melval 225 : else if (nomche(io)(1:4).eq.'FREQ') then 226 : jfreq = io 227 : melval = ielval(io) 228 : segact melval 229 : else if (nomche(io)(1:4).eq.'CGRA') then 230 : jgrav = io 231 : melval = ielval(io) 232 : segact melval 233 : else 234 : endif 235 : if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0.and. 236 : &jgrav.gt.0) goto 47 237 : enddo 238 : if (jdefo.gt.0.and.jmass.gt.0.and.jfreq.gt.0) goto 47 239 : 46 continue 240 : if (jdefo.eq.0.and.jmass.eq.0.and.jfreq.eq.0) then 241 : write(6,*) 'pas de caracteristiques modele ',ik, conmod 242 : return 243 : endif 244 : 47 continue 245 : do ip =1,num(/2) 246 : IA1 = IA1 + 1 247 : melval = ielval(jmass) 248 : xmasse = velche(1,ip) 249 : XM(IA1) = XMASSE 250 : 251 : melval = ielval(jfreq) 252 : xfreq = velche(1,ip) 253 : OMEGA = XFREQ * DEUXPI 254 : XK(IA1) = XMASSE * OMEGA * OMEGA 255 : 256 : melval = ielval(jdefo) 257 : icdm = ielche(1,ip) 258 : 259 : ** 260 : * Prise en compte d'un mode de rotation de corps rigide 261 : if (jgrav.gt.0) then 262 : melval = ielval(jgrav) 263 : ICDG = ielche(1,ip) 264 : IAROTA(IB)=IA1 265 : IROT = IN 266 : endif 267 : enddo 268 : * 269 : * 270 : IF (IIMPI.EQ.333) THEN 271 : WRITE(IOIMP,*)'DYNE26 : XM(',IA1,') =',XMASSE 272 : WRITE(IOIMP,*)'DYNE26 : XK(',IA1,') =',XK(IA1) 273 : ENDIF 274 : IF (NLIAB.NE.0) THEN 275 : DO 42 ID = 1,IDIMB 276 : IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN 277 : CMOT = NOMAXI(ID) 278 : ELSE 279 : IF (IFOMOD.EQ.-1) THEN 280 : CMOT = NOMPLA(ID) 281 : ELSE 282 : CMOT = NOMTRI(ID) 283 : ENDIF 284 : ENDIF 285 : IF (IIMPI.EQ.333) THEN 286 : WRITE(IOIMP,*)'DYNE26 : composante @ extraire :',CMOT 287 : ENDIF 288 : ICOMP = 0 289 : DO 44 IP = 1,NPLB 290 : IPOINT = JPLIB(IP) 291 : * 292 : * On extrait du chpoint ICDM au point IPOINT de composante CMOT 293 : * 293 : CALL EXTRA9(ICDM,IPOINT,CMOT,KERRE,XVAL) 294 : ICOMP = ICOMP + 1 295 : * 296 : * on ajuste la taille si necessaire 297 : * MP 298 : IF(ICOMP.GT.NPLSB) THEN 299 : NPLSB=ICOMP 300 : SEGADJ MTPHI 301 : ENDIF 302 : IPLSB(IP) = ICOMP 303 : * suite � la modif dans extra9, car on attribue une valeur meme 304 : * si le point n'existe pas dans le chpoint 305 : IF (XVAL.NE.0.) THEN 306 : IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN 306 : call erreur (783) 307 : RETURN 308 : ENDIF 309 : IBASB(IP) = IB 310 : ELSE 311 : IF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) IBASB(IP) = IB 312 : ENDIF 313 : * 314 : XPHILB(IB,ICOMP,IN,ID) = XVAL 315 : IF (IIMPI.EQ.333) THEN 316 : WRITE(IOIMP,*)'DYNE26 : IPLSB(',IP,') =',IPLSB(IP) 317 : WRITE(IOIMP,*)'DYNE26 : IBASB(',IP,') =',IBASB(IP) 318 : XVA2 = XPHILB(IB,ICOMP,IN,ID) 319 : WRITE(IOIMP,*)'DYNE26 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2 320 : ENDIF 321 : 322 : 44 CONTINUE 323 : * end do 324 : 42 CONTINUE 325 : * end do 326 : ENDIF 327 : * 328 : 329 : 41 continue 330 : INMSB(IB) = IN 331 : IN = IN + 1 332 : endif 333 : ** 334 : * Remplissage des fausses d�form�es modales de rotations 335 : ** 336 : 50 continue 337 : IF (IAROTA(IB).NE.0) THEN 338 : RIGIDE = .TRUE. 339 : MERR = 0 340 : NPLUS = IN + 1 341 : IF (NPLUS.GT.NA2) THEN 342 : * On r�ajuste le dimension NA2 de XPHILB 343 : NA2 = NPLUS 344 : SEGADJ MTPHI 345 : ENDIF 346 : DO 18 IP=1,NPLB 347 : IPOINT=JPLIB(IP) 348 : IPOS=IPLSB(IP) 349 : IBBAS= IBASB(IP) 350 : IF (IBBAS.EQ.IB) THEN 351 : DO 20 ID=(IDIM+1),IDIMB 352 : XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID) 353 : 20 CONTINUE 354 : * En tridimensionnel l'axe de rotation est le vecteur propre de rotation 355 : * On norme l axe du plan de rotation 355 : CALL DYNE41(XAXROT,MERR,IDIM) 356 : * En bidimensionnel l'axe de rotation est fixe 357 : * Calcul des fausses d�form�es modales de rotation 357 : CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR) 358 : DO 22 ID =1,IDIMB 359 : XPHILB(IB,IPOS,IN,ID) = XROTA(1,ID) 360 : XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID) 361 : 22 CONTINUE 362 : ENDIF 363 : 18 CONTINUE 364 : ENDIF 365 : IF (IIMPI.EQ.333) THEN 366 : WRITE(IOIMP,*)'DYNE26 : INMSB(',IB,') =',INMSB(IB) 367 : WRITE(IOIMP,*)'DYNE26 : IORSB(',IB,') =',IORSB(IB) 368 : WRITE(IOIMP,*)'DYNE26 : IAROTA(',IB,') =',IAROTA(IB) 369 : ENDIF 370 : * 371 : END 372 : 373 : 374 : 375 : 376 : 377 : 378 : 379 : 380 : 381 : 382 :
© Cast3M 2003 - All rights reserved.
Disclaimer