C HBM26 SOURCE OF166741 26/05/11 21:15:06 12538 *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Transpose l'information des objets de Castem2000 dans des * * tableaux de travail. * * * * Parametres: * * * * e IBAS Table representant une base modale * * es KTKAM Segment contenant les matrices XK, XASM et XM * * es KTPHI Segment des deformees modales * * e KTLIAB Segment des liaisons sur base B * * es IA1 Compteur * * e IB Compteur de la sous base * * es RIGIDE Vrai si l'on a un corps rigide, faux sinon * * e ITKM >0 si table RAIDEUR_ET_MASSE fournie * * * * Auteur, date de creation: * * * * Lionel VIVAN, le 24 octobre 1989. * * * *--------------------------------------------------------------------* SUBROUTINE HBM26(IBAS,KTKAM,KTLIAB,KTPHI,IA1,IB,ICOMP,RIGIDE,ITKM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCHAML -INC SMELEME -INC SMMODEL -INC TMDYNC LOGICAL L0,L1,RIGIDE CHARACTER*4 NOMTRI(6),NOMAXI(6),NOMPLA(3) CHARACTER*8 CMOT,TYPRET,MORIGI,CHARRE REAL*8 XAXROT(3),XROTA(2,3) * * si IFOMOD = -1 : modele PLAN * si IFOMOD = 0 : modele AXIS * si IFOMOD = 1 : modele FOUR * si IFOMOD = 2 : modele TRID * * Les noms de composante sont * - en modele PLAN : UX, UY, RT * - en modele AXIS : UX, UY, RZ * - en modele FOUR 1 : UR, UZ, UT, RT * - en modele TRID : UX, UY, UZ, RX, RY, RZ * DATA NOMTRI/'UX ','UY ','UZ ','RX ','RY ','RZ '/ DATA NOMAXI/'UR ','UT ','UZ ','RR ','RT ','RZ '/ DATA NOMPLA/'UX ','UY ','RZ '/ * MTKAM = KTKAM MTPHI = KTPHI MTLIAB = KTLIAB * NLIAB = IPALB(/1) NPLB = JPLIB(/1) NSB = XPHILB(/1) NPLSB = XPHILB(/2) NA2 = XPHILB(/3) IDIMB = XPHILB(/4) DEUXPI = 2.D0 * XPI * IORSB(IB) = IA1 + 1 IAROTA(IB) = 0 IROT = 0 IN = 0 ************************************************************************ * table BASE_MODALE ************************************************************************ 10 CONTINUE IN = IN + 1 TYPRET = ' ' CALL ACCTAB(IBAS,'ENTIER',IN,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,IBAMOD) IF (IERR.NE.0) RETURN * -on a bien un objet de type table IF (IBAMOD.NE.0) THEN IF (TYPRET.EQ.'TABLE ') THEN IA1 = IA1 + 1 * remplissage de XM et XK diagonale depuis la table BASE_MODALE * sauf si deja fait car on a une table RAIDEUR_ET_MASSE ! IF (ITKM.LE.0) THEN CALL ACCTAB(IBAMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0, & 'FLOTTANT',I1,XMASSE,' ',L1,IP1) IF (IERR.NE.0) RETURN XM(IA1,1) = XMASSE CALL ACCTAB(IBAMOD,'MOT',I0,X0,'FREQUENCE',L0,IP0, & 'FLOTTANT',I1,XFREQ,' ',L1,IP1) IF (IERR.NE.0) RETURN OMEGA = XFREQ * DEUXPI XK(IA1,1) = XMASSE * OMEGA * OMEGA IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'HBM26 : XM(',IA1,') =',XMASSE WRITE(IOIMP,*)'HBM26 : XK(',IA1,') =',XK(IA1,1) ENDIF ENDIF * si liaison_B existe, remplissage de IPLSB, XPHILB, IAROTA, INMSB... IF (NLIAB.NE.0) THEN CALL ACCTAB(IBAMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICDM) IF (IERR.NE.0) RETURN CALL ACTOBJ('CHPOINT',ICDM,1) DO 12 ID = 1,IDIMB IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) THEN CMOT = NOMAXI(ID) ELSE IF (IFOMOD.EQ.-1) THEN CMOT = NOMPLA(ID) ELSE CMOT = NOMTRI(ID) ENDIF ENDIF IF (IIMPI.EQ.333) & WRITE(IOIMP,*)'HBM26 : composante a extraire :',CMOT ICOMP = 0 DO 14 IP = 1,NPLB IPOINT = JPLIB(IP) * On extrait du chpoint ICDM au point IPOINT de composante CMOT CALL EXTRA9(ICDM,IPOINT,CMOT,0,.FALSE.,XVAL,IRET) ICOMP = ICOMP + 1 * on ajuste la taille si necessaire IF(ICOMP.GT.NPLSB) THEN NPLSB=ICOMP SEGADJ MTPHI ENDIF IPLSB(IP) = ICOMP * suite a la modif dans extra9, car on attribue une valeur meme * si le point n'existe pas dans le chpoint IF (XVAL.NE.0.) THEN IF ((IBASB(IP).NE.0).AND.(IBASB(IP).NE.IB)) THEN call erreur (783) RETURN ENDIF IBASB(IP) = IB ELSEIF ((IB.EQ.NSB).AND.(IBASB(IP).EQ.0)) THEN IBASB(IP) = IB ENDIF XPHILB(IB,ICOMP,IN,ID) = XVAL IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'HBM26 : IPLSB(',IP,') =',IPLSB(IP) WRITE(IOIMP,*)'HBM26 : IBASB(',IP,') =',IBASB(IP) XVA2 = XPHILB(IB,ICOMP,IN,ID) WRITE(IOIMP,*)'HBM26 : XPHILB(',IB,ICOMP,IN,ID,') =',XVA2 ENDIF 14 CONTINUE 12 CONTINUE ENDIF c * Prise en compte d'un mode de rotation de corps rigide MORIGI = ' ' CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, & MORIGI,I1,X1,CMOT,L1,IP1) IF (IERR.NE.0) RETURN IF (MORIGI.EQ.'MOT') THEN IF (CMOT(1:4).EQ.'VRAI') THEN CALL ACCTAB(IBAMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE', & L0,IP0,'POINT',I1,X1,' ',L1,ICDG) IF (IERR.NE.0) RETURN IAROTA(IB)=IA1 IROT = IN ENDIF ENDIF GOTO 10 ELSE CALL ERREUR(491) RETURN ENDIF ENDIF * -fin du cas ou on a bien un objet de type table INMSB(IB) = IN - 1 * ************************************************************************ * Remplissage des fausses deformees modales de rotations ************************************************************************ * *50 continue IF (IAROTA(IB).NE.0) THEN RIGIDE = .TRUE. MERR = 0 NPLUS = IN + 1 IF (NPLUS.GT.NA2) THEN * On reajuste le dimension NA2 de XPHILB NA2 = NPLUS SEGADJ MTPHI ENDIF DO 18 IP=1,NPLB IPOINT=JPLIB(IP) IPOS=IPLSB(IP) IBBAS= IBASB(IP) IF (IBBAS.EQ.IB) THEN DO 20 ID=(IDIM+1),IDIMB XAXROT(ID-IDIM) = XPHILB(IB,IPOS,IROT,ID) 20 CONTINUE * En tridimensionnel l'axe de rotation est le vecteur propre de rotation * On norme l axe du plan de rotation CALL DYNE41(XAXROT,MERR,IDIM) * En bidimensionnel l'axe de rotation est fixe * Calcul des fausses deformees modales de rotation CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR) DO 22 ID =1,IDIMB XPHILB(IB,IPOS,IN,ID) = XROTA(1,ID) XPHILB(IB,IPOS,IN+1,ID)= XROTA(2,ID) 22 CONTINUE ENDIF 18 CONTINUE ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'HBM26 : INMSB(',IB,') =',INMSB(IB) WRITE(IOIMP,*)'HBM26 : IORSB(',IB,') =',IORSB(IB) WRITE(IOIMP,*)'HBM26 : IAROTA(',IB,') =',IAROTA(IB) ENDIF RETURN END