1 : C DYNEPA SOURCE CHAT 05/01/12 23:18:27 5004 2 : SUBROUTINE DYNEPA(IPRIG,IPPT,IDDL,NDDL,DT, 3 : & ICHT41,ICHT43, 4 : & ICHT51,ICHT52,ICHT53,ICHT12,ICHT13,ICHT14, 5 : & ICHT61,ICHT62,ICHT63,ICHT64,ICHT65,ICHT66) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : ************************************************************************ 9 : * 10 : * D Y N E P A 11 : * ----------- 12 : * 13 : * FONCTION: 14 : * --------- 15 : * UTILITAIRE DE L'OPERATEUR "DYNE" 16 : * CALCUL D'UN PAS DE L'ALGORITHME DE DYNAMIQUE EXPLICITE 17 : * 18 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 19 : * ----------- 20 : * 21 : * IPRIG (E) TABLEAU DE POINTEURS SUR DES RIGIDITES, AVEC : 22 : * IPRIG(1) POINTEUR SUR L'OBJET M 23 : * IPRIG(2) POINTEUR SUR L'OBJET K 24 : * IPRIG(3) POINTEUR SUR L'OBJET A 25 : * IPRIG(4) POINTEUR SUR L'OBJET Z 26 : * IPPT (E) TABLEAU DE POINTEURS, AVEC : -1 27 : * IPPT(1) POINTEUR SUR LE VECTDOUB CONTENANT M 28 : * ( ACTIF ) 29 : * IPPT(2) POINTEUR SUR UN SEGMENT MBLO ( ACTIF ) 30 : * IPPT(3) POINTEUR SUR UN SEGMENT MBLO ( ACTIF ) 31 : * IPPT(4) POINTEUR SUR LE SEGMENT MUCTRA ( ACTIF ) 32 : * IPPT(5) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF ) 33 : * IPPT(6) POINTEUR SUR LE SEGMENT MZZZ ( ACTIF ) 34 : * VCHT1 (E/S) VECTEUR CONTENANT B2 35 : * VCHT3 (E/S) VECTEUR CONTENANT F1 36 : * VEC. (E/S) VECTEURS DE TRAVAIL 37 : * VCH1 (E/S) VECTEUR CONTENANT U1 38 : * VCH2 (E/S) VECTEUR CONTENANT V0 39 : * VCH3 (E/S) VECTEUR CONTENANT G0 40 : * VCH4 (E/S) VECTEUR CONTENANT U2 41 : * VCH5 (E/S) VECTEUR CONTENANT V1 42 : * VCH6 (E/S) VECTEUR CONTENANT G1 43 : * 44 : * AUTEUR, DATE DE CREATION: 45 : * ------------------------- 46 : * DENIS ROBERT, LE 21 OCTOBRE 1988. 47 : * REVU ET CORRIGE DECEMBRE 89 MP 48 : * 49 : * LANGAGE: 50 : * -------- 51 : * ESOPE + FORTRAN77 52 : * 53 : ************************************************************************ 54 : * 55 : * MODULES UTILISES: 56 : * 57 : -INC CCOPTIO 58 : * 59 : SEGMENT,MCHT1 60 : REAL*8 VCC1(IDDL) 61 : ENDSEGMENT 62 : POINTEUR MCHT12.MCHT1,MCHT13.MCHT1,MCHT14.MCHT1 63 : * 64 : SEGMENT,MCHT2 65 : REAL*8 VCC2(NDDL) 66 : ENDSEGMENT 67 : POINTEUR MCHT41.MCHT2,MCHT42.MCHT2,MCHT43.MCHT2 68 : POINTEUR MCHT51.MCHT2,MCHT52.MCHT2,MCHT53.MCHT2 69 : POINTEUR MCHT61.MCHT2,MCHT62.MCHT2,MCHT63.MCHT2 70 : POINTEUR MCHT64.MCHT2,MCHT65.MCHT2,MCHT66.MCHT2 71 : * 72 : INTEGER IPRIG(4),IPPT(6) 73 : * REAL*8 VEC1(*),VEC2(*),VEC3(*),VEC4(*),VEC5(*),VEC6(*) 74 : * REAL*8 VCH1(*),VCH2(*),VCH3(*),VCH4(*),VCH5(*),VCH6(*) 75 : * REAL*8 VCHT1(*),VCHT3(*) 76 : * 77 : PARAMETER ( ZERO=0.D0 ) 78 : PARAMETER ( O2=2.D0 ) 79 : PARAMETER ( O1=-1.D0 ) 80 : * 81 : MCHT41=ICHT41 82 : MCHT43=ICHT43 83 : MCHT51=ICHT51 84 : MCHT52=ICHT52 85 : MCHT53=ICHT53 86 : MCHT12=ICHT12 87 : MCHT13=ICHT13 88 : MCHT14=ICHT14 89 : MCHT61=ICHT61 90 : MCHT62=ICHT62 91 : MCHT63=ICHT63 92 : MCHT64=ICHT64 93 : MCHT65=ICHT65 94 : MCHT66=ICHT66 95 : * 96 : DT2=DT**2 97 : DT3=DT2/O2 98 : DT4=DT/O2 99 : DT5=O1/DT2 100 : DT6=O1/DT 101 : * 102 : IF (IPRIG(3).NE.0) THEN 103 : * 104 : *--- L'OBJET RIGIDITE "A" EXISTE 105 : * 106 : *--------------------------------------------------------------------* 107 : * CALCUL DE : Z L1 = A * M-1 * ( F1 - K * U1 ) - 1/DT2 * B2 * 108 : * + A * ( 1/DT2 * U1 + 1/DT * V0 + 1/2 * G0 ) * 109 : *--------------------------------------------------------------------* 110 : * 111 : *--- CALCUL DE : - ( 1/DT2 * U1 + 1/DT * V0 + 1/2 * G0 ) 112 : * 112 : CALL COLIVE(MCHT61.VCC2,MCHT62.VCC2,NDDL,DT5,DT6, 113 : & MCHT51.VCC2) 113 : CALL COLIVE(MCHT51.VCC2,MCHT63.VCC2,NDDL,1.D0,-0.5D0, 114 : & MCHT52.VCC2) 115 : * 116 : *--- CALCUL DE : A * - ( 1/DT2 * U1 + 1/DT * V0 + 1/2 * G0 ) 117 : * 117 : CALL DYNE06(IPPT(3),ICHT52,ICHT12) 118 : IF (IERR.NE.0) RETURN 119 : * 120 : *--- CALCUL DE : - K * U1 121 : * 122 : DO 10 I10=1,NDDL 123 : MCHT51.VCC2(I10)=ZERO 124 : MCHT52.VCC2(I10)=ZERO 125 : 10 CONTINUE 126 : * END DO 127 : * 127 : CALL DYNE05(IPRIG(2),ICHT61,ICHT51,NDDL,IPPT(4)) 128 : IF (IERR.NE.0) RETURN 129 : * 130 : *--- CALCUL DE : F1 - K * U1 131 : * 131 : CALL COLIVE(MCHT43.VCC2,MCHT51.VCC2,NDDL,1.D0,1.D0, 132 : & MCHT52.VCC2) 133 : * 134 : *--- CALCUL DE : A * M-1 * ( F1 - K * U1 ) 135 : * 135 : CALL DYNE06(IPPT(2),ICHT52,ICHT13) 136 : * 137 : *--- CALCUL DE : C1 / NE PAS OUBLIER 1/DT2 * B2 / 138 : * 138 : CALL COLIVE(MCHT12.VCC1,MCHT13.VCC1,IDDL,-1.D0,1.D0, 139 : & MCHT14.VCC1) 140 : * 141 : DO 15 I15=1,IDDL 142 : MCHT13.VCC1(I15)=ZERO 143 : 15 CONTINUE 144 : * END DO 144 : CALL COLIVE(MCHT14.VCC1,MCHT41.VCC2,IDDL,1.D0,DT5, 145 : & MCHT13.VCC1) 146 : * 147 : *--- RESOLUTION : Z L1 = C1 148 : * 149 : DO 20 I20=1,IDDL 150 : MCHT12.VCC1(I20)=ZERO 151 : 20 CONTINUE 152 : * END DO 153 : * 153 : CALL DYNERE(ICHT13,IPPT(6),ICHT12,IDDL) 154 : * 155 : *--------------------------------------------------------------------* 156 : *--- CALCUL DE : G1 = M-1 * ( F1 - K * U1 - AT * L1 ) ---* 157 : *--------------------------------------------------------------------* 158 : * 159 : DO 30 I30=1,NDDL 160 : MCHT51.VCC2(I30)=ZERO 161 : MCHT53.VCC2(I30)=ZERO 162 : 30 CONTINUE 163 : * END DO 164 : * 165 : *--- CALCUL DE : AT * L1 166 : * 166 : CALL DYNE08(ICHT12,IDDL,NDDL,IPPT(3),ICHT51) 167 : IF (IERR.NE.0) RETURN 168 : * 169 : *--- CALCUL DE : ( F1 - K * U1 ) - ( AT * L1 ) 170 : * 170 : CALL COLIVE(MCHT52.VCC2,MCHT51.VCC2,NDDL,1.D0,-1.D0, 171 : & MCHT53.VCC2) 172 : * 173 : ELSE 174 : * 175 : *--- L'OBJET RIGIDITE "A" N'EXISTE PAS 176 : * 176 : CALL VTRANS(MCHT53.VCC2,MCHT52.VCC2,NDDL) 177 : ENDIF 178 : * 179 : *--- CALCUL DE : M-1 * 'TOUT LE RESTE' 180 : * 180 : CALL DYNE10(ICHT53,IPPT(1),ICHT66,NDDL) 181 : * 182 : *--- CALCUL DE : V1 = V0 + ( DT/2 * ( G0 + G1 ) ) 183 : *--- CALCUL DE : U2 = U1 + ( DT * V1 ) + ( DT2/2 * G1 ) 184 : * 185 : DO 40 I40=1,NDDL 186 : MCHT51.VCC2(I40)=ZERO 187 : MCHT52.VCC2(I40)=ZERO 188 : 40 CONTINUE 189 : * END DO 190 : * 190 : CALL COLIVE(MCHT63.VCC2,MCHT66.VCC2,NDDL,1.D0,1.D0, 191 : & MCHT51.VCC2) 191 : CALL COLIVE(MCHT62.VCC2,MCHT51.VCC2,NDDL,1.D0,DT4, 192 : & MCHT65.VCC2) 193 : * 193 : CALL COLIVE(MCHT65.VCC2,MCHT66.VCC2,NDDL,DT,DT3, 194 : & MCHT52.VCC2) 194 : CALL COLIVE(MCHT61.VCC2,MCHT52.VCC2,NDDL,1.D0,1.D0, 195 : & MCHT64.VCC2) 196 : * 197 : END 198 :
© Cast3M 2003 - All rights reserved.
Disclaimer