C RCDEP2 SOURCE CB215821 20/11/25 13:38:34 10792 SUBROUTINE RCDEP2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS, & ITLIA,ITYP) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Recombine le chpoint ICHPT en déplacement ou en réaction. * * * * Paramètres: * * * * e IBAS table représentant une base modale * * e KCHAR chargement de la structure * * e XTEMP temps de recombinaison * * e ITRES table résultat issue de l'opérateur DYNE * * e IPOS position de XTEMP dans le listreel des temps * * e ITLIA table des liaisons * * e ITYP = 0 , on recombine les déplacements nature diffuse * * * = 1 , on recombine les vitesses * * =-1 , on recombine les accélérations * * = 2 , on recombine les réactions. nature discrete * * * - RIGIDE Vrai si l'on a un corps rigide,faux sinon * * * * Auteur, date de création: * * * * Lionel VIVAN, le 26 avril 1990. * * * *--------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMCHPOI -INC SMELEME SEGMENT ICPR(nbpts) SEGMENT TRAV(NPOIN)*D LOGICAL L0,L1,RIGIDE CHARACTER*8 TYPRET,MORIGI,CMOT,CHARRE REAL*8 XAXROT(3),XROTA(2,6) * TRAV = KTRAV ICPR = KCPR RIGIDE =.FALSE. * CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0, & 'TABLE',I1,X1,' ',L1,IBBB) * * initialisation du CHPOINT * N1 = 1 CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0, & 'TABLE',I1,X1,' ',L1,ITBMOD) TYPRET = ' ' IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ICHD1) ELSE IF (ITYP.EQ.2) THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ICHD1) ENDIF IF (ICHD1.EQ.0 .OR. TYPRET.NE.'CHPOINT ') THEN MOTERR(1:8) = 'RCDEP2 ' INTERR(1) = N1 CALL ERREUR(169) RETURN ENDIF MCHPO1 = ICHD1 SEGACT MCHPO1 NSOUPO = MCHPO1.IPCHP(/1) NAT=MAX(MCHPO1.JATTRI(/1),1) SEGINI MCHPOI ICHDE = MCHPOI IFOPOI = MCHPO1.IFOPOI MTYPOI = MCHPO1.MTYPOI MOCHDE = ' CHPOINT CREE PAR RCDEP2 ' IF ( ITYP .EQ. 0 .OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN JATTRI(1) = 1 ELSE IF ( ITYP .EQ. 2 ) THEN JATTRI(1) = 2 ENDIF DO 10 ISOU = 1,NSOUPO MSOUP1 = MCHPO1.IPCHP(ISOU) SEGACT MSOUP1 NC = MSOUP1.NOCOMP(/2) SEGINI MSOUPO IPCHP(ISOU) = MSOUPO DO 12 IC = 1,NC NOCOMP(IC) = MSOUP1.NOCOMP(IC) NOHARM(IC) = MSOUP1.NOHARM(IC) 12 CONTINUE IGEOC = MSOUP1.IGEOC MELEME = IGEOC SEGACT MELEME N = NUM(/2) SEGDES MELEME,MSOUP1 SEGINI MPOVAL IPOVAL = MPOVAL SEGDES MPOVAL SEGDES MSOUPO 10 CONTINUE SEGDES MCHPO1 * * boucle sur le nombre de modes * IM = 0 20 CONTINUE IM = IM + 1 TYPRET = ' ' CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITBMOD) IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0, & 'POINT',I1,X1,' ',L1,IPTR) IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHDI) rigide = .false. MORIGI = ' ' CALL ACCTAB(ITBMOD,'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 RIGIDE =.TRUE. ENDIF ENDIF ELSE IF (ITYP.EQ.2) THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0, & 'CHPOINT',I1,X1,' ',L1,ICHDI) ENDIF IMODE = ICPR(IPTR) IF (IMODE.EQ.0) THEN * * on ne trouve pas la déformée modale * MOTERR(1:8) = 'RCDEP2' INTERR(1) = IM CALL ERREUR(169) RETURN ENDIF XVAL = TRAV(IMODE) MCHPO1 = ICHDI SEGACT MCHPO1 DO 22 ISOU = 1,NSOUPO MSOUP1 = MCHPO1.IPCHP(ISOU) MSOUPO = IPCHP(ISOU) SEGACT MSOUP1,MSOUPO MPOVA1 = MSOUP1.IPOVAL MPOVAL = IPOVAL SEGDES MSOUP1 SEGACT MPOVA1,MPOVAL*MOD N = MPOVA1.VPOCHA(/1) NC = MPOVA1.VPOCHA(/2) DO 24 IC = 1,NC DO 26 IN = 1,N VPOCHA(IN,IC) = VPOCHA(IN,IC) & + ( XVAL * MPOVA1.VPOCHA(IN,IC) ) 26 CONTINUE 24 CONTINUE SEGDES MPOVA1,MPOVAL SEGDES MSOUP1,MSOUPO 22 CONTINUE SEGDES MCHPO1 * * Prise en compte de la rotation des corps rigide * IF ((ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1).AND.RIGIDE) THEN CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',L0,IP0, & 'POINT',I1,X1,' ',L1,ICDG) IF (IERR.NE.0) RETURN IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN * On récupère la valeur de la rotation CALL RECANG(ITRES,IPOS,IPTR,XANGLE) * IF (ITYP.EQ.-1) THEN * On récupère la valeur de la vitesse angulaire CALL RECVIT(ITRES,IPOS,IPTR,XVIT) ENDIF ENDIF MERR =0 MCHPO1=ICHDI SEGACT MCHPO1 IF (IDIM.EQ.3) THEN IDIMB=6 ELSE IDIMB=3 ENDIF DO 30 ISOU =1,NSOUPO MSOUPO = IPCHP(ISOU) MSOUP1 = MCHPO1.IPCHP(ISOU) SEGACT MSOUPO,MSOUP1 MELEME = IGEOC SEGACT MELEME MPOVAL = IPOVAL MPOVA1 = MSOUP1.IPOVAL SEGACT MPOVAL*MOD,MPOVA1 N = VPOCHA(/1) DO 32 IN=1,N IPOINT = NUM(1,IN) DO 33 ID=(IDIM+1),IDIMB * On récupère l'axe de rotation XAXROT(ID-IDIM) = MPOVA1.VPOCHA(IN,ID) 33 CONTINUE * En 3D on le norme, on vérifie qu'il n'est pas nul CALL DYNE41(XAXROT,MERR,IDIM) * Calcul des fausses déformées modales de rotation CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR) IF (ITYP.EQ.0) THEN * Recombinaison de déplacements DO 34 ID=1,IDIM VPOCHA(IN,ID)=VPOCHA(IN,ID)+ (XROTA(1,ID)* &(COS(XVAL)-1) + XROTA(2,ID)*SIN(XVAL)) 34 CONTINUE ELSE * Recombinaison de vitesses ou d accélérations DO 35 ID=1,IDIM VPOCHA(IN,ID)=VPOCHA(IN,ID)+XVAL*(COS(XANGLE)* &XROTA(2,ID)-SIN(XANGLE)*XROTA(1,ID)) 35 CONTINUE IF (ITYP.EQ.-1) THEN * Recombinaison d accélérations DO 36 ID=1,IDIM VPOCHA(IN,ID)=VPOCHA(IN,ID)-XVIT*XVIT* &(COS(XANGLE)*XROTA(1,ID)+SIN(XANGLE)*XROTA(2,ID)) 36 CONTINUE ENDIF ENDIF 32 CONTINUE SEGDES MPOVAL,MSOUPO,MELEME,MPOVA1,MSOUP1 30 CONTINUE SEGDES MCHPO1 ENDIF GOTO 20 ENDIF SEGDES MCHPOI * * Prise en compte des pseudo-modes * IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN TYPRET = ' ' CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITPS) IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN CALL PSRCD2('DEPL',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA) ELSE IF (ITYP.EQ.2) THEN CALL PSRCD2('REAC',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA) ENDIF ELSE CALL ERREUR(429) ENDIF ENDIF * END