1 : C CHAFON SOURCE CHAT 05/01/12 21:54:13 5004
2 : SUBROUTINE CHAFON(EPST,F1,F2,F3, DYK,SI,
3 : . C1,C2,ITYP,ICENT2,IDIAM,G,R,IBOU,ELT,HDEP,R0,RM,B,ICAS,WEP,
4 : . SINT,X1INT,X2INT,PSI,OME,ecou)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8(A-H,O-Z)
7 : DIMENSION F1(*),F2(*),F3(*),DYK(*),SINT(*),X1INT(*),X2INT(*)
8 : C
9 : * Commun ECOU: sert de fourre-tout pour les tableaux
10 : *
11 : SEGMENT ECOU
12 : *** COMMON/ECOU/TEST,ALFAH,
13 : REAL*8 TEST, ALFAH,
14 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
15 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),X1(6),X2(6),
16 : 1 DALPHA(6),DSIGO(6),S(12),XINV(3),
17 : 2 SIPLAD(6),DSIGP0(6),TET,TETI
18 : ENDSEGMENT
19 : C COMMON/ECOU/TEST,ALFAH,
20 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
21 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),X1(6),X2(6),
22 : C 1 DALPHA(6),DSIGO(6),S(12),XINV(3),
23 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI
24 : C
25 : C LES CONTRAINTES SONT DANS S ET LE VON-MISES CORRESPONDANT EST
26 : C DANS SI
27 : C ICAS = 1 ON CHERCHE UNE PREMIERE ESTIMATION DU HDEP
28 : C ICAS = 2 ON CALCULE LE VECTEUR INCREMENT DYK ET ON MET A JOUR
29 : C S ,SI,X1,X2
30 : C ICAS = 3 ON CALCULE LA PENTE ( STOCKEE DANS WEP ) POUR LA
31 : C DETERMINATION DU DEPSI
32 : C DANS DYK ON STOCKE DANS L ORDRE : SIG-X1-X2,X1,X2
33 : C R EST CALCULE EN ENTREE POUR UN EPST DONNE
34 : C
35 : IF(IDIAM.NE.0) R=RM-(RM-R0)*EXP(-B*EPST)
36 : PHI=1.D00
37 : IF(PSI.NE.1.D00) PHI=1.D00+(PSI-1.D00)*EXP(-OME*EPST)
38 : UNSUR=1./SI
39 : H=B*(RM-R)
40 : GO TO (101,102,103,104,105,106,107,108,109,999,
41 : . 999,999,113,114),ITYP
42 : 101 F1(1)=(S(1)-0.5*(S(2)+S(3)))*UNSUR
43 : F1(2)=(S(2)-0.5*(S(1)+S(3)))*UNSUR
44 : F1(3)=(S(3)-0.5*(S(1)+S(2)))*UNSUR
45 : DO 10 I=4,6
46 : F1(I)=3.*S(I)*UNSUR
47 : F2(I)=F1(I)*0.5
48 : 10 F3(I)=G*F1(I)
49 : DO 11 I=1,3
50 : 11 F2(I)=F1(I)
51 : F3(1)=S(7)*F1(1)+S(8)*(F1(2)+F1(3))
52 : F3(2)=S(7)*F1(2)+S(8)*(F1(1)+F1(3))
53 : F3(3)=S(7)*F1(3)+S(8)*(F1(1)+F1(2))
54 : DUM=H+1.5*ELT
55 : GO TO (111,300,300),ICAS
56 : 111 DUM=DUM+1.5*S(9)*PHI
57 : GO TO 200
58 : 102 IBO=2
59 : I3=3
60 : AL1=SQRT(ALFAH)
61 : GO TO 121
62 : 103 I3=3
63 : GO TO 110
64 : 106 I3=4
65 : 110 IBO=1
66 : 121 DUM=H
67 : DO 125 IPP=1,IBO
68 : IP=3*(IPP-1)
69 : IP1=IP+1
70 : IP2=IP+2
71 : IP3=IP+I3
72 : F1(IP1)=(S(IP1)-0.5*S(IP2))*UNSUR
73 : F1(IP2)=(S(IP2)-0.5*S(IP1))*UNSUR
74 : IF(ITYP.NE.6) GO TO 127
75 : F1(3)=0.
76 : F2(3)=0.
77 : F3(3)=0.
78 : 127 CONTINUE
79 : F1(IP3)=3.*S(IP3)*UNSUR
80 : F2(IP1)=S(IP1)*UNSUR
81 : F2(IP2)=S(IP2)*UNSUR
82 : F2(IP3)=S(IP3)*UNSUR
83 : F3(IP1)=S(7)*F1(IP1)+S(8)*F1(IP2)
84 : F3(IP2)=S(7)*F1(IP2)+S(8)*F1(IP1)
85 : F3(IP3)=G*F1(IP3)
86 : DUM2=F1(IP1)*F3(IP1)+F1(IP2)*F3(IP2)+F1(IP3)*F3(IP3)
87 : IF(ITYP.NE.2.OR.IPP.NE.1) GO TO 128
88 : DUM2=DUM2*ALFAH
89 : F1(IP1)=F1(IP1)*AL1
90 : F1(IP2)=F1(IP2)*AL1
91 : F1(IP3)=F1(IP3)*AL1
92 : 128 CONTINUE
93 : DUM=DUM+DUM2
94 : 125 CONTINUE
95 : GO TO (124,300,300),ICAS
96 : 124 DUM=DUM+S(9)*PHI
97 : GO TO 200
98 : 104 I1=3
99 : GO TO 140
100 : 107 AL1=SQRT(ALFAH)
101 : 108 I1=1
102 : 140 DUM=H
103 : DO 141 I=1,IBOU
104 : F1(I)=0.
105 : F2(I)=0.
106 : 141 F3(I)=0.
107 : F1(I1)=S(I1)*UNSUR
108 : F2(I1)=F1(I1)
109 : F3(I1)=S(7)*F1(I1)
110 : DUM2=F1(I1)*F3(I1)
111 : IF(ITYP.NE.7) GO TO 142
112 : DUM2=DUM2*ALFAH
113 : F1(I1)=F1(I1)*AL1
114 : F1(4)=S(4)*UNSUR
115 : F2(4)=F1(4)
116 : F3(4)=S(7)*F1(4)
117 : DUM=DUM+F1(4)*F3(4)
118 : 142 DUM=DUM+DUM2
119 : GO TO (124,300,300),ICAS
120 : 113 DUM=H
121 : F1(1)=(S(1)-0.5*S(2))*UNSUR
122 : F1(2)=(S(2)-0.5*S(1))*UNSUR
123 : F1(3)=0.
124 : F2(3)=0.
125 : F3(3)=0.
126 : DO 1113 IB=4,6
127 : F1(IB)=3.*S(IB)*UNSUR
128 : F2(IB)=S(IB)*UNSUR
129 : F3(IB)=G*F1(IB)
130 : 1113 CONTINUE
131 : F2(1)=S(1)*UNSUR
132 : F2(2)=S(2)*UNSUR
133 : F3(1)=S(7)*F1(1)+S(8)*F1(2)
134 : F3(2)=S(7)*F1(2)+S(8)*F1(1)
135 : DUM2=F1(1)*F3(1)+F1(2)*F3(2)+F1(4)*F3(4)+F1(5)*F3(5)+F1(6)*F3(6)
136 : DUM=DUM+DUM2
137 : GO TO (124,300,300),ICAS
138 : C= Modes de calcul UNIDIMENSIONNELs (1D)
139 : 114 F1(1)=(S(1)-0.5*(S(2)+S(3)))*UNSUR
140 : F1(2)=(S(2)-0.5*(S(1)+S(3)))*UNSUR
141 : F1(3)=(S(3)-0.5*(S(1)+S(2)))*UNSUR
142 : F2(1)=F1(1)
143 : F2(2)=F1(2)
144 : F2(3)=F1(3)
145 : F3(1)=S(7)*F1(1)+S(8)*(F1(2)+F1(3))
146 : F3(2)=S(7)*F1(2)+S(8)*(F1(1)+F1(3))
147 : F3(3)=S(7)*F1(3)+S(8)*(F1(1)+F1(2))
148 : DUM=H+1.5*ELT
149 : GO TO (1140,300,300),ICAS
150 : 1140 DUM=DUM+1.5*S(9)*PHI
151 : GO TO 200
152 : 105 CONTINUE
153 : 109 CONTINUE
154 : C-----------------------------------------------------------------------
155 : C ICAS = 1
156 : C-----------------------------------------------------------------------
157 : 200 CONTINUE
158 : DO 1 I=1,IBOU
159 : DUM=DUM-C1*F1(I)*X1(I)
160 : IF(ICENT2.EQ.0) GO TO 1
161 : DUM=DUM-C2*F1(I)*X2(I)
162 : 1 CONTINUE
163 : HDEP=(SI-R)/DUM
164 : RETURN
165 : C-----------------------------------------------------------------------
166 : C ICAS = 2 OU 3
167 : C-----------------------------------------------------------------------
168 : 300 CONTINUE
169 : DO 2 I=1,IBOU
170 : DYK(6+I)=(S(10)*PHI*F2(I)-C1*X1(I))*HDEP
171 : X1(I)=X1INT(I)+DYK(6+I)*WEP
172 : IF(ICENT2.EQ.0) GO TO 2
173 : DYK(12+I)=(S(11)*PHI*F2(I)-C2*X2(I))*HDEP
174 : X2(I)=X2INT(I)+DYK(12+I)*WEP
175 : 2 CONTINUE
176 : DO 3 I=1,IBOU
177 : DYK(I)=-F3(I)*HDEP -DYK(6+I)
178 : IF(ICENT2.EQ.0) GO TO 33
179 : DYK(I)=DYK(I) -DYK(12+I)
180 : 33 S(I)=SINT(I)+DYK(I)*WEP
181 : 3 CONTINUE
182 : SI=VONMIS(S,ITYP,ALFAH,COVNMS)
183 : IF(ICAS.EQ.2) RETURN
184 : C
185 : C CALCUL DE LA PENTE POUR LA DETERMINATION DU DEPSI
186 : C
187 : WEP=H
188 : DO 631 IB=1,IBOU
189 : 631 WEP=WEP-F1(IB)*DYK(IB)/HDEP
190 : RETURN
191 : 999 WRITE(6,7999)
192 : 7999 FORMAT('0 CHAFON - CAS NON IMPLEMENTE '/)
193 : RETURN
194 : END
195 :
196 :
197 :
198 :
199 :
200 :
© Cast3M 2003 - All rights reserved.
Disclaimer