1 : C RCDEP2 SOURCE CHAT 05/01/13 02:45:55 5004 2 : SUBROUTINE RCDEP2(IBAS,KTRAV,KCPR,KCHAR,XTEMP,ICHDE,ITRES,IPOS, 3 : & ITLIA,ITYP) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Recombine le chpoint ICHPT en déplacement ou en réaction. * 9 : * * 10 : * Paramètres: * 11 : * * 12 : * e IBAS table représentant une base modale * 13 : * e KCHAR chargement de la structure * 14 : * e XTEMP temps de recombinaison * 15 : * e ITRES table résultat issue de l'opérateur DYNE * 16 : * e IPOS position de XTEMP dans le listreel des temps * 17 : * e ITLIA table des liaisons * 18 : * e ITYP = 0 , on recombine les déplacements nature diffuse * * 19 : * = 1 , on recombine les vitesses * 20 : * =-1 , on recombine les accélérations * 21 : * = 2 , on recombine les réactions. nature discrete * * 22 : * - RIGIDE Vrai si l'on a un corps rigide,faux sinon * 23 : * * 24 : * Auteur, date de création: * 25 : * * 26 : * Lionel VIVAN, le 26 avril 1990. * 27 : * * 28 : *--------------------------------------------------------------------* 29 : -INC CCOPTIO 30 : -INC SMCOORD 31 : -INC SMCHPOI 32 : -INC SMELEME 33 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 34 : SEGMENT TRAV(NPOIN)*D 35 : LOGICAL L0,L1,RIGIDE 36 : CHARACTER*8 TYPRET,MORIGI,CMOT,CHARRE 37 : REAL*8 XAXROT(3),XROTA(2,6) 38 : * 39 : 40 : TRAV = KTRAV 41 : ICPR = KCPR 42 : RIGIDE =.FALSE. 43 : * 43 : CALL ACCTAB(IBAS,'MOT',I0,X0,'MODES',L0,IP0, 44 : & 'TABLE',I1,X1,' ',L1,IBBB) 45 : * 46 : * initialisation du CHPOINT 47 : * 48 : N1 = 1 48 : CALL ACCTAB(IBBB,'ENTIER',N1,X0,' ',L0,IP0, 49 : & 'TABLE',I1,X1,' ',L1,ITBMOD) 50 : TYPRET = ' ' 51 : IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN 51 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, 52 : & TYPRET,I1,X1,CHARRE,L1,ICHD1) 53 : ELSE IF (ITYP.EQ.2) THEN 53 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0, 54 : & TYPRET,I1,X1,CHARRE,L1,ICHD1) 55 : ENDIF 56 : IF (ICHD1.EQ.0 .OR. TYPRET.NE.'CHPOINT ') THEN 57 : MOTERR(1:8) = 'RCDEP2 ' 58 : INTERR(1) = N1 58 : CALL ERREUR(169) 59 : RETURN 60 : ENDIF 61 : MCHPO1 = ICHD1 62 : SEGACT MCHPO1 63 : NSOUPO = MCHPO1.IPCHP(/1) 64 : NAT=MAX(MCHPO1.JATTRI(/1),1) 65 : SEGINI MCHPOI 66 : ICHDE = MCHPOI 67 : IFOPOI = MCHPO1.IFOPOI 68 : MTYPOI = MCHPO1.MTYPOI 69 : MOCHDE = ' CHPOINT CREE PAR RCDEP2 ' 70 : IF ( ITYP .EQ. 0 .OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN 71 : JATTRI(1) = 1 72 : ELSE IF ( ITYP .EQ. 2 ) THEN 73 : JATTRI(1) = 2 74 : ENDIF 75 : DO 10 ISOU = 1,NSOUPO 76 : MSOUP1 = MCHPO1.IPCHP(ISOU) 77 : SEGACT MSOUP1 78 : NC = MSOUP1.NOCOMP(/2) 79 : SEGINI MSOUPO 80 : IPCHP(ISOU) = MSOUPO 81 : DO 12 IC = 1,NC 82 : NOCOMP(IC) = MSOUP1.NOCOMP(IC) 83 : NOHARM(IC) = MSOUP1.NOHARM(IC) 84 : 12 CONTINUE 85 : IGEOC = MSOUP1.IGEOC 86 : MELEME = IGEOC 87 : SEGACT MELEME 88 : N = NUM(/2) 89 : SEGDES MELEME,MSOUP1 90 : SEGINI MPOVAL 91 : IPOVAL = MPOVAL 92 : SEGDES MPOVAL 93 : SEGDES MSOUPO 94 : 10 CONTINUE 95 : SEGDES MCHPO1 96 : * 97 : * boucle sur le nombre de modes 98 : * 99 : IM = 0 100 : 20 CONTINUE 101 : IM = IM + 1 102 : TYPRET = ' ' 102 : CALL ACCTAB(IBBB,'ENTIER',IM,X0,' ',L0,IP0, 103 : & TYPRET,I1,X1,CHARRE,L1,ITBMOD) 104 : IF (ITBMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 104 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0, 105 : & 'POINT',I1,X1,' ',L1,IPTR) 106 : IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN 106 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, 107 : & 'CHPOINT',I1,X1,' ',L1,ICHDI) 108 : rigide = .false. 109 : MORIGI = ' ' 109 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CORPS_RIGIDE',L0,IP0, 110 : & MORIGI,I1,X1,CMOT,L1,IP1) 111 : IF (IERR.NE.0) RETURN 112 : IF (MORIGI.EQ.'MOT') THEN 113 : IF (CMOT(1:4).EQ.'VRAI') THEN 114 : RIGIDE =.TRUE. 115 : ENDIF 116 : ENDIF 117 : ELSE IF (ITYP.EQ.2) THEN 117 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'REACTION_MODALE',L0,IP0, 118 : & 'CHPOINT',I1,X1,' ',L1,ICHDI) 119 : ENDIF 120 : IMODE = ICPR(IPTR) 121 : IF (IMODE.EQ.0) THEN 122 : * 123 : * on ne trouve pas la déformée modale 124 : * 125 : MOTERR(1:8) = 'RCDEP2' 126 : INTERR(1) = IM 126 : CALL ERREUR(169) 127 : RETURN 128 : ENDIF 129 : XVAL = TRAV(IMODE) 130 : MCHPO1 = ICHDI 131 : SEGACT MCHPO1 132 : DO 22 ISOU = 1,NSOUPO 133 : MSOUP1 = MCHPO1.IPCHP(ISOU) 134 : MSOUPO = IPCHP(ISOU) 135 : SEGACT MSOUP1,MSOUPO 136 : MPOVA1 = MSOUP1.IPOVAL 137 : MPOVAL = IPOVAL 138 : SEGDES MSOUP1 139 : SEGACT MPOVA1,MPOVAL*MOD 140 : N = MPOVA1.VPOCHA(/1) 141 : NC = MPOVA1.VPOCHA(/2) 142 : DO 24 IC = 1,NC 143 : DO 26 IN = 1,N 144 : VPOCHA(IN,IC) = VPOCHA(IN,IC) 145 : & + ( XVAL * MPOVA1.VPOCHA(IN,IC) ) 146 : 26 CONTINUE 147 : 24 CONTINUE 148 : SEGDES MPOVA1,MPOVAL 149 : SEGDES MSOUP1,MSOUPO 150 : 22 CONTINUE 151 : SEGDES MCHPO1 152 : * 153 : * Prise en compte de la rotation des corps rigide 154 : * 155 : IF ((ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1).AND.RIGIDE) THEN 155 : CALL ACCTAB(ITBMOD,'MOT',I0,X0,'CENTRE_DE_GRAVITE',L0,IP0, 156 : & 'POINT',I1,X1,' ',L1,ICDG) 157 : IF (IERR.NE.0) RETURN 158 : IF (ITYP.EQ.1.OR.ITYP.EQ.-1) THEN 159 : * On récupère la valeur de la rotation 159 : CALL RECANG(ITRES,IPOS,IPTR,XANGLE) 160 : * 161 : IF (ITYP.EQ.-1) THEN 162 : * On récupère la valeur de la vitesse angulaire 162 : CALL RECVIT(ITRES,IPOS,IPTR,XVIT) 163 : ENDIF 164 : ENDIF 165 : MERR =0 166 : MCHPO1=ICHDI 167 : SEGACT MCHPO1 168 : IF (IDIM.EQ.3) THEN 169 : IDIMB=6 170 : ELSE 171 : IDIMB=3 172 : ENDIF 173 : DO 30 ISOU =1,NSOUPO 174 : MSOUPO = IPCHP(ISOU) 175 : MSOUP1 = MCHPO1.IPCHP(ISOU) 176 : SEGACT MSOUPO,MSOUP1 177 : MELEME = IGEOC 178 : SEGACT MELEME 179 : MPOVAL = IPOVAL 180 : MPOVA1 = MSOUP1.IPOVAL 181 : SEGACT MPOVAL*MOD,MPOVA1 182 : N = VPOCHA(/1) 183 : DO 32 IN=1,N 184 : IPOINT = NUM(1,IN) 185 : DO 33 ID=(IDIM+1),IDIMB 186 : * On récupère l'axe de rotation 187 : XAXROT(ID-IDIM) = MPOVA1.VPOCHA(IN,ID) 188 : 33 CONTINUE 189 : * En 3D on le norme, on vérifie qu'il n'est pas nul 189 : CALL DYNE41(XAXROT,MERR,IDIM) 190 : * Calcul des fausses déformées modales de rotation 190 : CALL DYNE42(XROTA,XAXROT,IPOINT,ICDG,IDIMB,MERR) 191 : IF (ITYP.EQ.0) THEN 192 : * Recombinaison de déplacements 193 : DO 34 ID=1,IDIM 194 : VPOCHA(IN,ID)=VPOCHA(IN,ID)+ (XROTA(1,ID)* 195 : &(COS(XVAL)-1) + XROTA(2,ID)*SIN(XVAL)) 196 : 34 CONTINUE 197 : ELSE 198 : * Recombinaison de vitesses ou d accélérations 199 : DO 35 ID=1,IDIM 200 : VPOCHA(IN,ID)=VPOCHA(IN,ID)+XVAL*(COS(XANGLE)* 201 : &XROTA(2,ID)-SIN(XANGLE)*XROTA(1,ID)) 202 : 35 CONTINUE 203 : IF (ITYP.EQ.-1) THEN 204 : * Recombinaison d accélérations 205 : DO 36 ID=1,IDIM 206 : VPOCHA(IN,ID)=VPOCHA(IN,ID)-XVIT*XVIT* 207 : &(COS(XANGLE)*XROTA(1,ID)+SIN(XANGLE)*XROTA(2,ID)) 208 : 36 CONTINUE 209 : ENDIF 210 : ENDIF 211 : 32 CONTINUE 212 : SEGDES MPOVAL,MSOUPO,MELEME,MPOVA1,MSOUP1 213 : 30 CONTINUE 214 : SEGDES MCHPO1 215 : ENDIF 216 : GOTO 20 217 : ENDIF 218 : SEGDES MCHPOI 219 : * 220 : * Prise en compte des pseudo-modes 221 : * 222 : IF (KCHAR.NE.0 .OR. ITLIA.NE.0) THEN 223 : TYPRET = ' ' 223 : CALL ACCTAB(IBAS,'MOT',I0,X0,'PSEUDO_MODES',L0,IP0, 224 : & TYPRET,I1,X1,CHARRE,L1,ITPS) 225 : IF (ITPS.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN 226 : IF (ITYP.EQ.0.OR.ITYP.EQ.1.OR.ITYP.EQ.-1) THEN 226 : CALL PSRCD2('DEPL',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA) 227 : ELSE IF (ITYP.EQ.2) THEN 227 : CALL PSRCD2('REAC',ITPS,IBBB,ICHDE,KCHAR,XTEMP,ITRES,IPOS,ITLIA) 228 : ENDIF 229 : ELSE 229 : CALL ERREUR(429) 230 : ENDIF 231 : ENDIF 232 : * 233 : END 234 : 235 : 236 : 237 :
© Cast3M 2003 - All rights reserved.
Disclaimer