1 : C COSI SOURCE CHAT 05/01/12 22:22:50 5004 2 : *$$$$ COSI 3 : C COSI SOURCE ISPRA 90/06/12 4 : SUBROUTINE COSI 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : C======================================================================= 8 : C OPERATEUR COSI 9 : C 10 : C A2*EVOLUTION = COSI A1*EVOLUTION (METH*MOT) 11 : C 12 : C======================================================================= 13 : C PROGRAMMEUR : P.P. 14 : C======================================================================= 15 : C 16 : CHARACTER *72 TI 17 : CHARACTER*12 MOTX,MOTY 18 : C 19 : PARAMETER (NMOCLE=2) 20 : CHARACTER*4 MOTCLE(NMOCLE) 21 : C 22 : -INC CCOPTIO 23 : -INC SMEVOLL 24 : -INC SMLREEL 25 : C 26 : POINTEUR IACCE1.MLREEL,ITEMP1.MLREEL,IACCE2.MLREEL,ITEMP2.MLREEL 27 : POINTEUR JACCE1.MEVOLL,JACCE2.MEVOLL 28 : POINTEUR KACCE1.KEVOLL,KACCE2.KEVOLL 29 : SEGMENT, MTRAV 30 : IMPLIED AI(NPT),BI(NPT),GI(NPT) 31 : ENDSEGMENT 32 : C 33 : DIMENSION A(3,3),B(3) 34 : C 35 : C 1) LECTURE DES DONNEES GIBIANE 36 : C 37 : C 1.1) LISTE DES MOTS CLEF 38 : C 39 : DATA MOTCLE/'SIMP','LINE'/ 40 : C 41 : C 42 : C 1.2) DEFAUTS 43 : C 44 : IMETH=1 45 : C 46 : C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT L'ACCELERATION 47 : C 47 : CALL LIROBJ('EVOLUTIO',JACCE1,1,IRET) 48 : IF(IRET.EQ.0) GOTO 666 49 : C 50 : C 1.4) LECTURE DU MOT-CLEF 51 : C (OPTIONEL) 52 : C 52 : CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) 53 : C 54 : IF(IVAL.NE.0)THEN 55 : IMETH=IVAL 56 : ENDIF 57 : C 58 : C 59 : C 2) VERIFICATION DES DONNEES 60 : C 61 : C 2.1) MEME ABSCISSE 62 : C 63 : SEGACT, JACCE1 64 : N=JACCE1.IEVOLL(/1) 65 : DO 10 IE1=1,N 66 : KACCE1=JACCE1.IEVOLL(IE1) 67 : SEGACT, KACCE1 68 : ITEMP=KACCE1.IPROGX 69 : SEGDES, KACCE1 70 : IF(IE1.EQ.1)THEN 71 : ITEMP1=ITEMP 72 : ELSE 73 : IF(ITEMP.NE.ITEMP1)THEN 73 : CALL ERREUR(567) 74 : SEGDES, JACCE1 75 : GOTO 666 76 : ENDIF 77 : ENDIF 78 : 10 CONTINUE 79 : C 80 : C 2.2) REPARTITION HOMOGENE DES DT 81 : C 82 : SEGACT, ITEMP1 83 : NPT=ITEMP1.PROG(/1) 84 : DT=(ITEMP1.PROG(NPT)-ITEMP1.PROG(1))/(NPT-1) 85 : DT1=ITEMP1.PROG(2)-ITEMP1.PROG(1) 86 : SEGDES, ITEMP1 87 : IF(ABS(DT1-DT)/DT.GT.1.D-5)THEN 87 : CALL ERREUR(568) 88 : SEGDES, JACCE1 89 : GOTO 666 90 : ENDIF 91 : C 92 : C 3) DUPLICATION DES TEMPS ET INITIALISATIONS DIVERSES 93 : C 94 : SEGINI, ITEMP2=ITEMP1 95 : SEGDES, ITEMP2 96 : C 97 : TI=JACCE1.IEVTEX 98 : SEGINI, JACCE2 99 : JACCE2.IEVTEX='Correction de:'//TI(1:58) 100 : C 101 : SEGINI, MTRAV 102 : C 103 : C 104 : C 4) LOOP DE CALCUL 105 : C 106 : DO 100 IE1=1,N 107 : C 108 : C 4.1) INITIALISATION ET DUPLICATION DES DONNEES 109 : C 110 : C 111 : KACCE1=JACCE1.IEVOLL(IE1) 112 : SEGINI, KACCE2=KACCE1 113 : C 114 : KACCE2.IPROGX=ITEMP2 115 : C 116 : IACCE1=KACCE2.IPROGY 117 : SEGINI, IACCE2=IACCE1 118 : KACCE2.IPROGY=IACCE2 119 : C 120 : SEGDES, KACCE2 121 : JACCE2.IEVOLL(IE1)=KACCE2 122 : C 123 : C 124 : C 4.2) CALCUL DE ALPHA(I), BETA(I) ET GAMMA(I) 125 : C 126 : C 4.2.1) METHODE SIMPLIFIEE 127 : C 128 : IF(IMETH.EQ.1)THEN 129 : AI(1)=DT/2 130 : BI(1)=(2*(NPT-2)+1)*DT*DT/4 131 : DO 20 IE2=2,NPT-1 132 : AI(IE2)=DT 133 : BI(IE2)=(NPT-IE2)*DT*DT 134 : 20 CONTINUE 135 : AI(NPT)=DT/2 136 : BI(NPT)=DT*DT/4 137 : C 138 : GI(1)=0.D0 139 : DO 21 IE2=2,NPT 140 : GI(1)=GI(1)+BI(IE2)*DT/2 141 : 21 CONTINUE 142 : DO 22 IE2=2,NPT-1 143 : GI(IE2)=BI(IE2)*DT/2 144 : DO 22 IE3=IE2+1,NPT 145 : GI(IE2)=GI(IE2)+BI(IE3)*DT 146 : 22 CONTINUE 147 : GI(NPT)=BI(NPT)*DT/2 148 : ENDIF 149 : C 150 : C 4.2.2) METHODE LINEAIRE 151 : C 152 : IF(IMETH.EQ.2)THEN 153 : AI(1)=DT/2 154 : BI(1)=(3*(NPT-2)+2)*DT*DT/6 155 : DO 25 IE2=2,NPT-1 156 : AI(IE2)=DT 157 : BI(IE2)=(NPT-IE2)*DT*DT 158 : 25 CONTINUE 159 : AI(NPT)=DT/2 160 : BI(NPT)=DT*DT/6 161 : C 162 : GI(1)=(2*(NPT-2)+1)*DT*DT*DT/24 163 : DO 26 IE2=2,NPT 164 : GI(1)=GI(1)+BI(IE2)*DT/2 165 : 26 CONTINUE 166 : DO 27 IE2=2,NPT-1 167 : GI(IE2)=BI(IE2)*DT/2-DT*DT*DT/12 168 : DO 27 IE3=IE2+1,NPT 169 : GI(IE2)=GI(IE2)+BI(IE3)*DT 170 : 27 CONTINUE 171 : GI(NPT)=BI(NPT)*DT/4 172 : ENDIF 173 : C 174 : C 4.3) CALCUL DE A ET B 175 : C 176 : DO 30 IE2=1,3 177 : B(IE2)=0.D0 178 : DO 30 IE3=1,3 179 : A(IE3,IE2)=0.D0 180 : 30 CONTINUE 181 : DO 31 IE2=1,NPT 182 : A(1,1)=A(1,1)+AI(IE2)**2 183 : A(1,2)=A(1,2)+AI(IE2)*BI(IE2) 184 : A(1,3)=A(1,3)+AI(IE2)*GI(IE2) 185 : A(2,2)=A(2,2)+BI(IE2)**2 186 : A(2,3)=A(2,3)+BI(IE2)*GI(IE2) 187 : A(3,3)=A(3,3)+GI(IE2)**2 188 : B(1)=B(1)+AI(IE2)*IACCE2.PROG(IE2) 189 : B(2)=B(2)+BI(IE2)*IACCE2.PROG(IE2) 190 : B(3)=B(3)+GI(IE2)*IACCE2.PROG(IE2) 191 : 31 CONTINUE 192 : A(2,1)=A(1,2) 193 : A(3,1)=A(1,3) 194 : A(3,2)=A(2,3) 195 : C 196 : C 4.4) RESOLUTION DE A*X=B 197 : C 198 : DET=A(1,1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3)) 199 : > -A(2,1)*(A(1,2)*A(3,3)-A(3,2)*A(1,3)) 200 : > +A(3,1)*(A(1,2)*A(2,3)-A(2,2)*A(1,3)) 201 : XAM1= B(1)*(A(2,2)*A(3,3)-A(3,2)*A(2,3)) 202 : > -B(2)*(A(1,2)*A(3,3)-A(3,2)*A(1,3)) 203 : > +B(3)*(A(1,2)*A(2,3)-A(2,2)*A(1,3)) 204 : XAM2=-B(1)*(A(2,1)*A(3,3)-A(3,1)*A(2,3)) 205 : > +B(2)*(A(1,1)*A(3,3)-A(3,1)*A(1,3)) 206 : > -B(3)*(A(1,1)*A(2,3)-A(2,1)*A(1,3)) 207 : XAM3= B(1)*(A(2,1)*A(3,2)-A(3,1)*A(2,2)) 208 : > -B(2)*(A(1,1)*A(3,2)-A(3,1)*A(1,2)) 209 : > +B(3)*(A(1,1)*A(2,2)-A(2,1)*A(1,2)) 210 : XAM1=XAM1/DET 211 : XAM2=XAM2/DET 212 : XAM3=XAM3/DET 213 : C 214 : C 4.5) CORRECTION DE L'ACCELERATION 215 : C 216 : DO 40 IE2=1,NPT 217 : IACCE2.PROG(IE2)=IACCE2.PROG(IE2) 218 : > -XAM1*AI(IE2)-XAM2*BI(IE2)-XAM3*GI(IE2) 219 : 40 CONTINUE 220 : C 221 : C 4.6) FIN ACTIVATION 222 : C 223 : SEGDES, IACCE2 224 : C 225 : 100 CONTINUE 226 : C 227 : C 228 : C 229 : SEGSUP, MTRAV 230 : SEGDES, JACCE1 231 : SEGDES, JACCE2 232 : C 233 : C 5) RETOUR A GIBIANE 234 : C 234 : CALL ECROBJ('EVOLUTIO',JACCE2) 235 : C 236 : C 237 : 666 CONTINUE 238 : RETURN 239 : END 240 : 241 : 242 : 243 :
© Cast3M 2003 - All rights reserved.
Disclaimer