Download cconst.eso
Back to the list
1 : C CCONST SOURCE PV 11/03/08 21:15:00 6888
2 : SUBROUTINE CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,
3 : 1 WRK91,NVARI,NSSINC,INV,IFOURB,T0,TF,FI0,FIF
4 : 4 ,TLIFE,NCOURB,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
5 : C CONSTI SOURCE BROC 00/12/20 21:15:56 4058
6 : c SUBROUTINE CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
7 : c 1 INPLAS,MFR,DT,NSTRS,NVARI,NCOMAT,PRECAS,MSOUPA,JECHER,DTT,
8 : c 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,
9 : c 3 NYN,NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,T0,TF,
10 : c 5 TREF,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
11 : c 7NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,KERREU1)
12 : C
13 : C---------------------------------------------------------------------
14 : C Objet: Calculer au cours d'un pas de temps DT, l'evolution des
15 : C variables internes a l'aide d'un schema Runge-Kutta 1.2
16 : C ---------------------------------------------------------------------
17 : C MFR1 <- MFR, XCARB <- XCAR, NSTRS1 <- NSTRS,
18 : C
19 : C---------------------------------------------------------------------
20 : C Entree: INPLAS type de materiau
21 : C MFR indice de la formulation mecanique(seulement massif ou coque
22 : C pour les materiaux endommageables)
23 : C DEPST(NSTRS1) increment des deformations totales
24 : C SIG0(NSTRS1) contraintes initiales
25 : C EPIN0(NSTRS1) deformations viscoplastiques initiales
26 : C VAR0(NVARI) variables internes initiales
27 : C NVARI nombre de variables internes
28 : C YOG(NYOG) courbe du module d'Young en fonction de T°C
29 : C YNU(NYNU) courbe du coefficient de Poisson en fonction de T°C
30 : C SIGY(NSIGY) courbe de la limite elastique en fonction de T°C
31 : C YRHO(NYRHO) courbe de la masse volumique en fonction de T°C
32 : C YALFA(NYALFA) courbe du coeff de dilatation en fonction de T°C
33 : C YN(NYN)
34 : C YM(NYM)
35 : C YKK(NYKK)
36 : C YALFA1(NYALF1) courbes des autres coefficients caracteristiques
37 : C YBETA1(NYBET1) en fonction de la T°C intervenant
38 : C YALF2(NYALF2) dans les lois d'evolution
39 : C YBET2(NYBET2)
40 : C YR(NYR)
41 : C YA(NYA)
42 : C YKX(NYKX) fonction k(X) tabulee en fonction de la temperature
43 : C NKX(NNKX) tableau de pointeurs sur les courbes de k(X)
44 : C XMAT(NCOMAT) materiau
45 : C XCARB(ICARA) caracteristiques geometriques
46 : C YSMAX(NYSMAX) intervient ds. le test de convergence des iter.
47 : C TRUC(NCOURB) tableau de travail
48 : C PRECIS precision relative sur SIGMA
49 : C MSOUPA nombre maximal de sous pas autorises
50 : C JECHER = 0 avancer
51 : C = 1 rechercher sortie avec DTT
52 : C IFOURB = -3 EN DEFORM. PLANES GENER.
53 : C -2 EN CONTR.PLANES
54 : C -1 EN DEFORM. PLANES
55 : C 0 EN AXISYMETRIE
56 : C 1 EN SERIE DE FOURIER
57 : C 2 EN TRIDIM
58 : * CMATE = NOM DU MATERIAU
59 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
60 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
61 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
62 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
63 : * IB = NUMERO DE L ELEMENT COURANT
64 : * IGAU = NUMERO DU POINT COURANT
65 : * EPAIST= EPAISSEUR
66 : * NBPGAU= NBRE DE POINTS DE GAUSS
67 : * MELE = NUMERO DE L ELEMENT FINI
68 : * NPINT = NBRE DE POINTS D INTEGRATION
69 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
70 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
71 : * SECT = SECTION
72 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE
73 : C DD(NSTRS1,NSTRS1) matrice de Hooke en fonction de T
74 : C DDV(NSTRS1,NSTRS1) derivee de DD
75 : C DDINV(NSTRS1,NSTRS1) inverse de DD
76 : C T0 temperature a t0
77 : C TF temperature a t0+DT
78 : C FI0 densite de fissions a t0
79 : C FIF densite de fissions a t0+DT
80 : C TREF temperature de reference
81 : C DT pas de temps
82 : C ITHHER = 0 pas de chargement thermique et materiau constant
83 : C = 1 chargement thermique et materiau constant
84 : C = 2 chargement thermique et materiau(T)
85 : C-----------------------------------------------------------------------
86 : C
87 : C-----------------------------------------------------------------------
88 : C Sortie: SIGF(NSTRS1) contraintes finales
89 : C EPINF(NSTRS1) deformations viscoplastiques finales
90 : C VARF(NVARI) variables internes finales
91 : C DTT sous-increment de temps optimal (si JECHER=1)
92 : C TLIFE sous-increment de temps a rupture pour materiau
93 : C viscoplastique endommageable
94 : C NSSINC nombre de sous-increments si JECHER=0
95 : C INV = 1 si inversion
96 : C 0 sinon
97 : C KERRE = 0 si tout OK
98 : C <> 0 si entrees incoherentes
99 : C-----------------------------------------------------------------------
100 : C
101 : IMPLICIT INTEGER(I-N)
102 : IMPLICIT REAL*8(A-H,O-Z)
103 : -INC CCOPTIO
104 : -INC DECHE
105 :
106 :
107 : SEGMENT IECOU
108 : * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
109 : INTEGER NYOG, NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
110 : C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
111 : 1 NYALF1,NYBET1,NYR , NYA, NYRHO,NSIGY, NNKX,NYKX,icow16,
112 : C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX,NYKX, IND,
113 : 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
114 : C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
115 : 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
116 : C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
117 : 4 icow32,icow33,NSTRS1,MFR1, NBGMAT,NELMAT,MSOUPA,
118 : C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
119 : 5 icow39,icow40,icow41,icow42,icow43,icow44,NYOG1,
120 : C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME,NYOG1,
121 : 6 NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
122 : C . NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
123 : 7 NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
124 : C . NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
125 : ENDSEGMENT
126 :
127 :
128 : SEGMENT XECOU
129 : * COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
130 : REAL*8 xcow1, xcow2,xcow3,DTT ,DT, TREF, xcow7
131 : C REAL*8 DTOPTI,TSOM, TCAR, DTT, DT, TREFA,TEMP00
132 : ENDSEGMENT
133 :
134 :
135 : C
136 : C
137 : SEGMENT WRK7
138 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
139 : ENDSEGMENT
140 : C
141 : SEGMENT WRK8
142 : REAL*8 DD(NSTRS1,NSTRS1),DDV(NSTRS1,NSTRS1),DDINV(NSTRS1,NSTRS1)
143 : REAL*8 DDINVp(NSTRS1,NSTRS1)
144 : ENDSEGMENT
145 : C
146 : SEGMENT WRK9
147 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
148 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
149 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
150 : REAL*8 SIGY(NSIGY)
151 : INTEGER NKX(NNKX)
152 : ENDSEGMENT
153 : C
154 : SEGMENT WRK91
155 : REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
156 : REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
157 : REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
158 : REAL*8 SIGY1(NSIGY1)
159 : ENDSEGMENT
160 : C
161 : DIMENSION VAR(100),VAR1(100),VARP1(100),VARP2(100)
162 : DIMENSION CRIGI(12),VAR12(100),VARP3(100)
163 : DIMENSION VARP4(100),VAR13(100),VART(100)
164 : DIMENSION VART1(100)
165 : C
166 : C#MC 21/01/99 : les tableaux doivent dimensionnes en fonction
167 : C du plus grand INFELE(16) (voir elquoi.eso)
168 : DIMENSION SIG(8),SIG1(8),SIG12(8),SIG13(8)
169 : DIMENSION DSPT(8),EPSTHD(8),XX(8)
170 : DIMENSION EVP1(8),EVP2(8),XPM1(8),XPM2(8),EVP3(8),EVP4(8)
171 : DIMENSION XPM3(8),XPM4(8)
172 : DIMENSION SIGP1(8),SIGP2(8), SIGP3(8), SIGP4(8)
173 : DIMENSION EPSV(8),EPSV1(8),EPSV12(8),EPSV13(8)
174 : C
175 : logical dtlibr,iforce
176 : C
177 : NCOMAT = NMATT
178 : C
179 : C
180 : C
181 : iffo=0
182 : * pasbea=0.d0
183 : PRELOC=1.d-8
184 : msoupa=1000000
185 : * write(6,*) 'cconst ncomat',ncomat
186 : * write(6,*) (xmat(iu),iu=1,ncomat+1)
187 : dtlibr=.TRUE.
188 : C Test sur l'identite de toutes les listes de temperatures des coefficients
189 : C intervenant dans les lois d'evolutions non-lineaires des variables internes
190 : IF (INPLAS.EQ.29) THEN
191 : * write(6,*) 'cconst avant test kerre',kerre
191 : CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
192 : & YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
193 : * write(6,*) 'cconst avant test kerre',kerre
194 : ENDIF
195 : IF (INPLAS.EQ.142) THEN
196 : * write(6,*) 'cconst avant test1 kerre',kerre
196 : CALL TEST1(YN1,NYN1,YM1,NYM1,YKK1,NYKK1,YALF2,NYALF2,YBET2,
197 : & NYBET2,YR1,NYR1,YA1,NYA1,SIGY1,NSIGY1,YQ1,NYQ1,ITEST)
198 : * write(6,*) 'cconst avant test1 kerre',kerre
199 : ENDIF
200 : C
201 : KERRE = 0
202 : IF (MFR1.NE.1.AND.MFR1.NE.3.AND.MFR1.NE.5.AND.MFR1.NE.17.AND.
203 : & MFR1.NE.33) THEN
204 : KERRE = 99
205 : RETURN
206 : ENDIF
207 : *
208 : * AM 5/5/00 MFR1 = 33 : MODELES 19 A 24 pour le moment
209 : * AM 27/5/3 : ET 44,45
210 : *
211 : IF (MFR1.EQ.33) THEN
212 : IF ((INPLAS.LT.19.OR.INPLAS.GT.24).AND.
213 : & (INPLAS.NE.44.AND.INPLAS.NE.45))THEN
214 : KERRE = 99
215 : RETURN
216 : ENDIF
217 : ENDIF
218 : *
219 : * write(6,*) 'cconst mfr1',mfr1
220 : IF (MFR1.EQ.3) THEN
221 : THICK = XCARB(1)
222 : ALFA = XCARB(2)
223 : ENDIF
224 : * dtprem=0.D0
225 : * dtdeux=0.d0
226 : dtleft= dt
227 : BORNE = 2.0
228 : RMAX = 1.3
229 : RMIN = 0.7
230 : DIV = 7.0
231 : FAC = 3.0
232 : TLIFE = -1.D0
233 : C
234 : C CALCUL DES INCREMENTS DE DEFORMATIONS
235 : C
236 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
237 : * write(6,*) 'cconst avant calcsig kerre',kerre
237 : CALL CALSIG(DEPST,DDAUX,NSTRS1,CMATE,VALMAT,VALCAR,N2EL,
238 : 1 N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,
239 : 2 NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,
240 : 3 D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
241 : * write(6,*) 'cconst apres calcsig kerre',kerre
242 : C
243 : IF (IRTD.NE.1) THEN
244 : KERRE=69
245 : GOTO 998
246 : ENDIF
247 : C
248 : ENDIF
249 : IF (MFR1.EQ.3) THEN
250 : DO 10 I=1,NSTRS1/2
251 : SIG0( I)= SIG0( I)/THICK
252 : SIG0(NSTRS1/2+I)= SIG0(NSTRS1/2+I)*6.0D0/THICK/THICK
253 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
254 : DSIGT( I)= DSIGT( I)/THICK
255 : DSIGT(NSTRS1/2+I)= DSIGT(NSTRS1/2+I)*6.0D0/THICK/THICK
256 : ELSE
257 : DEPST( I)= DEPST( I)
258 : DEPST(NSTRS1/2+I)= -DEPST(NSTRS1/2+I)*THICK/2.D0
259 : ENDIF
260 : 10 CONTINUE
261 : IF (IFOURB.EQ.-2) THEN
262 : SIG0(2)=0.D0
263 : SIG0(4)=0.D0
264 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
265 : DSIGT(2)=0.D0
266 : DSIGT(4)=0.D0
267 : ENDIF
268 : ENDIF
269 : ENDIF
270 : C
271 : C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
272 : C L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
273 : C
274 : IF (MFR1.EQ.17) THEN
275 : SIG0(2) = 0.D0
276 : SIG0(3) = 0.D0
277 : SIG0(4) = 0.D0
278 : SIG0(5) = 0.D0
279 : ENDIF
280 : C
281 : C------------------------------------------
282 : C CONTROLE DE LA COHERENCE DES ENTREES
283 : C------------------------------------------
284 : IF (DT.LT.0.0) KERRE = 414
285 : IF (INPLAS.EQ.63.AND.MFR1.NE.1) THEN
286 : KERRE=99
287 : RETURN
288 : ENDIF
289 : IF (DT.EQ.0.0) DT = 1.e-20
290 : MOTERR(1:8) = ' CONST '
291 : IF (INPLAS.EQ.17) THEN
292 : IF ((NVARI.NE.(6+4*NSTRS1)).AND.(MFR1.NE.5)) KERRE = 146
293 : IF ((NVARI.NE.(10+4*NSTRS1)).AND.(MFR1.EQ.5)) KERRE = 146
294 : IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
295 : IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
296 : XMAX=XMAT(8)
297 : GOTO 30
298 : ENDIF
299 :
300 : IF (MFR1.NE.33) THEN
301 : * write(6,*) 'cconst inplas ifourb ncomat',inplas,ifourb,ncomat
302 : IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
303 : IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
304 : IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
305 : IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
306 : IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
307 : IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
308 : IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
309 : IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
310 : IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
311 : IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
312 : IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
313 : IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
314 : IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
315 : IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
316 : C IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
317 : C IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
318 : IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
319 : IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
320 : IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
321 : IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
322 : IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
323 : IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
324 : IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
325 : IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
326 : IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
327 : IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
328 : IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
329 : IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
330 : IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
331 : IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
332 : IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
333 : IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
334 : IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
335 : IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
336 : IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
337 : IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
338 : IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
339 : IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
340 : IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
341 : IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
342 : IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
343 : IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
344 : IF (INPLAS.EQ.130.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
345 : IF (INPLAS.EQ.130.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
346 : IF (INPLAS.EQ.136.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
347 : IF (INPLAS.EQ.136.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
348 : IF (INPLAS.EQ.137.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
349 : IF (INPLAS.EQ.137.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
350 : IF (INPLAS.EQ.138.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
351 : IF (INPLAS.EQ.138.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
352 : IF (INPLAS.EQ.139.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
353 : IF (INPLAS.EQ.139.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
354 :
355 : C
356 : ELSE
357 : C
358 : C cas MFR1=33
359 : C
360 :
361 : IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
362 : IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
363 : IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
364 : IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
365 : IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
366 : IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
367 : IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
368 : IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
369 : IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
370 : IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
371 : IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
372 : IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
373 : C
374 : ENDIF
375 : C
376 : IF (IFOURB.EQ.1) THEN
377 : KERRE = 194
378 : MOTERR(1:8) = 'FLUAGE'
379 : ENDIF
380 : XMAX=XMAT(5)
381 : IF ((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
382 : IF ((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
383 : IF ((INPLAS.EQ.70).OR.(INPLAS.EQ.107)) XMAX=XMAT(1)*1.D-3
384 : IF (INPLAS.EQ.29) THEN
384 : CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
385 : ENDIF
386 : IF (INPLAS.EQ.142) THEN
386 : CALL DERTRA(NYSMAX1,YSMAX1,TF,XMAX,XMAXV,TO,TO)
387 : ENDIF
388 : C
389 : C TEST SUR XMAX MILL 8/3/91
390 : C
391 : IF (XMAX.EQ.0.D0) THEN
392 : IF (INPLAS.EQ.29) THEN
392 : CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
393 : XMAX=XMAX*1.D-3
394 : ELSEIF (INPLAS.EQ.142) THEN
394 : CALL DERTRA(NYOG1,YOG1,TF,XMAX,XMAXV,TO,TO)
395 : XMAX=XMAX*1.D-3
396 : ELSEIF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
397 : XMAX=XMAT(1)*1.D-3
398 : ENDIF
399 : ENDIF
400 : C
401 : 30 CONTINUE
402 : C
403 : C-----------------------------
404 : IF (KERRE.NE.0) THEN
405 : GOTO 999
406 : ENDIF
407 :
408 : C
409 : C===========================================================
410 : C A PARTIR DE MAINTENANT, LES DEFORMATIONS
411 : C DE CISAILLEMENT NE SONT PLUS
412 : C DEFINIES PAR DES GAMA.
413 : C ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
414 : C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
415 : C DE LEMAITRE (INPLAS=29 ET INPLAS=142).
416 : C
417 : C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
418 : C MFR1=1 (MASSIF)
419 : C MFR1=5 (COQUES EPAISSES)
420 : C MFR1=3 (COQUES MINCES)
421 : C MFR1=17 (TUYAUX FISSURES)
422 : C MFR1=33 (POREUX)
423 : C
424 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
425 : C
426 : C Cas de la formulation massive
427 : C Les termes de cisaillement apparaissent
428 : C au delà de la troisieme composante
429 : C
430 : IF (MFR1.EQ.1.OR.MFR1.EQ.33) THEN
431 : DO I=4,NSTRS1
432 : EPIN0(I)=0.5D0*EPIN0(I)
433 : ENDDO
434 : C
435 : C Cas des coques épaisses
436 : C Les termes de cisaillement apparaissent
437 : C au delà de la deuxieme composante
438 : C
439 : ELSE IF (MFR1.EQ.5) THEN
440 : DO I=3,NSTRS1
441 : EPIN0(I)=0.5D0*EPIN0(I)
442 : ENDDO
443 : C
444 : C Cas des coques minces
445 : C Les termes de cisaillement apparaissent
446 : C pour la troisieme et la sixieme composante
447 : C uniquement dans les cas de calculs
448 : C tridimensionnels ou d'analyse de Fourier
449 : C
450 : ELSE IF (MFR1.EQ.3) THEN
451 : IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
452 : EPIN0(3)=0.5D0*EPIN0(3)
453 : EPIN0(6)=0.5D0*EPIN0(6)
454 : ENDIF
455 : C
456 : C Reste le cas des tuyaux fissurés (MFR1=17)
457 : C
458 : ENDIF
459 : ENDIF
460 : C
461 : C===========================================================
462 : C
463 : C ----------------
464 : C INITIALISATION
465 : C ----------------
466 : ITERO = 0
467 : 6543 CONTINUE
468 :
469 : itero = 1 + itero
470 : if ( itero.ne.1) THEN
471 : if(ib.eq.1.and.igau.eq.1) write(6,*) 'itero ', itero
472 : dtlibr = .true.
473 : preloc = preloc * 7.d0
474 : c write(6,*) ' precision modifiée ', preloc
475 : if (itero.gt.3) then
476 : **** kerre = 460
477 : kerre = 268
478 : return
479 : endif
480 : endif
481 : DTLEFT = DT
482 : TAU = DTLEFT
483 : dtaumi= dtleft / 1500.
484 : TI0=T0
485 : TI1=TF
486 : TPOINT=(TF-T0)/DT
487 : FII0=FI0
488 : FII1=FIF
489 : FPOINT=(FIF-FI0)/DT
490 : ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS1))
491 : ERRABS = PRELOC*ASIG
492 : IF (XMAX.GT.ASIG) ERRABS = PRELOC*XMAX
493 : DO 40 I=1,NSTRS1
494 : SIG(I) = SIG0(I)
495 : EPSV(I) = EPIN0(I)
496 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
497 : DSPT(I) = DSIGT(I)/DT
498 : ENDIF
499 : 40 CONTINUE
500 : *
501 : * iter=0
502 : * if ( .NOT.DTLIBR) THEN
503 : * dtminl = ( dt * 1.001 ) / msopua
504 : * r = dtseco / dtprem
505 : * 1245 continue
506 : * iter=iter+1
507 : ** if ( abs ( 1.- R) . gt. 0.001 ) then
508 : * bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
509 : * else
510 : * r = 1.d0
511 : * bb = dtprem * ( msoupa - 10)
512 : * endif
513 : * tau = dtprem * dt / bb * 1.0001
514 : * write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
515 : * if (bb . lt . dt/1.2) THEN
516 : * if ( iter.lt.15) then
517 : * r = r + abs ( 1. - r ) / 10.
518 : * else
519 : * kerre = 460
520 : * return
521 : * endif
522 : * go to 1245
523 : * endif
524 : * 1234 format ('it pr se de r b t ta',i2, 7e9.3)
525 : *
526 : * dtx = dt * 1.00001;
527 : * write(6,*) 'avpremdeux r', dtprem,dtdeux,r
527 : * call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
528 : * $ ,xdf,dtx)
529 : * write(6,*) 'xde xdf de r',xde,xdf,r
530 : * tau = xde / r
531 : *
532 : * endif
533 : C
534 : IF (INPLAS.EQ.29) THEN
535 : C
536 : C================================================
537 : C Calcul de l increment de deformation totale reel.
538 : C On enleve donc tous les termes qui correspondent
539 : C a l influence de la temperature et de
540 : C l endommagement (travail inverse de ce qui est
541 : C fait dans le procedure increme).
542 : C================================================
543 : C
544 : ********* materiau dependant de la temperature ***********************
544 : CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
544 : CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
545 : XMAT(1)=YUNG0
546 : XMAT(2)=ENU0
547 : C------------------------------------------------
548 : C Calcul de la matrice de Hooke inverse DD a t=t0
549 : C------------------------------------------------
549 : CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
550 : & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
551 : C
552 : ********* materiau dependant de la temperature ***********************
552 : CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
552 : CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
553 : XMAT(1)=YUNG1
554 : XMAT(2)=ENU1
555 : C---------------------------------------------------
556 : C Calcul de la matrice de Hooke inverse DDINV a T=TF
557 : C---------------------------------------------------
557 : CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
558 : & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
559 : ***********************************************************************
560 : C
560 : CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
560 : CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
561 : CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
562 : C
562 : CALL ZDANUL(DSPT,NSTRS1)
563 : AA=1.D0
564 : DO 45 I=1,NSTRS1
565 : DSPT(I)=DEPST(I)
566 : IF (I.GT.3) AA=0.D0
567 : DO 46 J=1,NSTRS1
568 : DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
569 : DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
570 : 46 CONTINUE
571 : DSPT(I)=DSPT(I)-(AA*CTEPS)
572 : DSPT(I)=DSPT(I)/DT
573 : 45 CONTINUE
574 : C
575 : ELSEIF (INPLAS.EQ.142) THEN
576 : C
577 : C================================================
578 : C Calcul de l increment de deformation totale reel.
579 : C On enleve donc tous les termes qui correspondent
580 : C a l influence de la temperature et de
581 : C l endommagement (travail inverse de ce qui est
582 : C fait dans le procedure increme).
583 : C================================================
584 : C
585 : ********* materiau dependant de la temperature ***********************
585 : CALL DERTRA(NYOG1,YOG1,T0,YUNG0,YUNGV0,TO,TO)
585 : CALL DERTRA(NYNU1,YNU1,T0,ENU0,ENUV0,TO,TO)
586 : XMAT(1)=YUNG0
587 : XMAT(2)=ENU0
588 : C------------------------------------------------
589 : C Calcul de la matrice de Hooke inverse DD a t=t0
590 : C------------------------------------------------
590 : CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
591 : & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
592 : C
593 : ********* materiau dependant de la temperature ***********************
593 : CALL DERTRA(NYOG1,YOG1,TF,YUNG1,YUNGV1,TO,TO)
593 : CALL DERTRA(NYNU1,YNU1,TF,ENU1,ENUV1,TO,TO)
594 : XMAT(1)=YUNG1
595 : XMAT(2)=ENU1
596 : C---------------------------------------------------
597 : C Calcul de la matrice de Hooke inverse DDINV a T=TF
598 : C---------------------------------------------------
598 : CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
599 : & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
600 : ***********************************************************************
601 : C
601 : CALL DERTRA(NYALFT1,YALFT1,T0,ALFA0,ALFAV0,TO,TO)
601 : CALL DERTRA(NYALFT1,YALFT1,TF,ALFAF,ALFAVF,TO,TO)
602 : CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
603 : C
603 : CALL ZDANUL(DSPT,NSTRS1)
604 : AA=1.D0
605 : DO I=1,NSTRS1
606 : DSPT(I)=DEPST(I)
607 : IF (I.GT.3) AA=0.D0
608 : DO J=1,NSTRS1
609 : DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
610 : DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
611 : ENDDO
612 : DSPT(I)=DSPT(I)-(AA*CTEPS)
613 : DSPT(I)=DSPT(I)/DT
614 : ENDDO
615 : ENDIF
616 : DO I=1,NVARI
617 : VAR(I)=VAR0(I)
618 : ENDDO
619 : IF (NVARI.LT.100) THEN
620 : DO I=NVARI+1,100
621 : VAR(I)=0.0D0
622 : ENDDO
623 : ENDIF
624 :
625 :
626 : C
627 : C ---------------------------------------------------------------------
628 : INV = 0
629 : NSSINC = 0
630 : nitera = 1
631 : nopri=0
632 : C ---------------------------------------------------------------------
633 : C DEBUT DES ITERATIONS EN SSINCREMENTS /FIN SI DTLEFT = 0
634 : C ---------------------------------------------------------------------
635 : 70 CONTINUE
636 : iforce=.false.
637 : C if(dtaumi.gt.TAU) THEN
638 : if(dtaumi.gt.TAU.and.nssinc.gt.400) THEN
639 : tau=min(dtaumi,dtleft)
640 : iforce=.true.
641 : endif
642 : NSSINC = NSSINC + 1
643 : nopri = nopri + nitera - 1
644 : IF (NSSINC.GT.msoupa) THEN
645 : DTLIBR=.FALSE.
646 : GOTO 6543
647 : C GOTO 999
648 : ENDIF
649 : C
650 : C---------------------------------------------------------------------
651 : C START OF CALCULATIONS
652 : C_____________________________________________________________________
653 : IF (MFR1.EQ.17.AND.INPLAS.NE.19) GOTO 999
654 : IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.17) THEN
654 : CALL XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS1,NVARI,
655 : & NCOMAT,MFR1)
656 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.((INPLAS.GE.19.AND.
657 : & INPLAS.LE.24).OR.INPLAS.EQ.61.OR.INPLAS.EQ.107)) THEN
658 : C-----------------------------------------------------------
659 : C Mise a jour eventuelle de la nouvelle temperature TI1 et
660 : C de la nouvelle densite de fissions FII1
661 : C-----------------------------------------------------------
662 : C
663 : DELTAT=TPOINT*TAU
664 : TI1=TI0+DELTAT
665 : DELTAF=FPOINT*TAU
666 : FII1=FII0+DELTAF
666 : CALL INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,
667 : & INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
668 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.25) THEN
668 : CALL INCRE2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
669 : ELSE IF (MFR1.EQ.1.AND.INPLAS.EQ.130) THEN
669 : CALL INCREP(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
670 : & NVARI,NCOMAT)
671 : ELSE IF (MFR1.EQ.1.AND.(INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
672 : a INPLAS.EQ.138.OR.INPLAS.EQ.139)) THEN
672 : CALL INCVAR(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
673 : & NVARI,NCOMAT,INPLAS)
674 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.76) THEN
674 : CALL INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
675 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.77) THEN
675 : CALL INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
676 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.53) THEN
676 : CALL INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
677 : ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.63) THEN
677 : CALL INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
678 : & NCOMAT,IFOURB)
679 : ELSE IF (MFR1.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
680 : & .OR.INPLAS.EQ.61)) THEN
680 : CALL INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS1,
681 : & NVARI,INPLAS,NCOMAT)
682 : ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.25) THEN
682 : CALL INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
683 : ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.76) THEN
683 : CALL INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
684 : ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.77) THEN
684 : CALL INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
685 : ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.53) THEN
685 : CALL INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
686 : ELSE IF (MFR1.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
687 : & OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
687 : CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS1,NVARI,EVP1,
688 : & VARP1,TAU)
689 : ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.70) THEN
689 : CALL INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
690 : & NCOMAT)
691 : C
692 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.29) THEN
693 : if (nssinc.eq.1) then
694 : C
695 : C-----------------------------------------------------------
696 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
697 : C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
698 : C-----------------------------------------------------------
698 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
699 : & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
700 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
701 : & NCOMAT,TI0,TINF,TSUP,ITEST,TRUC,NCOURB)
702 : C
703 : IF (ITHHER.EQ.2) THEN
704 : C********** materiau dependant de la temperature **********************
705 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
705 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
706 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
707 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
708 : & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
709 : & NCOURB)
710 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
710 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
711 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
712 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
713 : & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
714 : & NCOURB)
715 : C**********************************************************************
716 : ENDIF
717 : C--------------------------------------------------------------
718 : C Calcul de la derivee de la dilatation thermique /temps a t=t0
719 : C--------------------------------------------------------------
719 : CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
719 : CALL ZDANUL(EPSTHD,NSTRS1)
720 : CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
721 : DO I=1,3
722 : EPSTHD(I)=CTH
723 : ENDDO
724 : C
724 : CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
725 : & XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,NCOMAT,
726 : & NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR1,
727 : & XCARB,ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
728 : & ITHHER,TRUC,NCOURB)
729 : c DO i= 1,6
730 : c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
731 : c ENDDO
732 : c DO i= 1,6
733 : c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
734 : c ENDDO
735 : c DO i= 1,6
736 : c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
737 : c ENDDO
737 : CALL ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
738 : & NCOMAT,TI0,TAUX,TRUC,NCOURB)
739 : else
740 : do i=1,nstrs
741 : sigp1(i)=sigp4(i)
742 : evp1(i)=evp4(i)
743 : enddo
744 : do i=1,nvari
745 : varp1(i)=varp4(i)
746 : enddo
747 : endif
748 : C
749 : ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.142) THEN
750 : if (nssinc.eq.1) then
751 : C
752 : C-----------------------------------------------------------
753 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
754 : C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
755 : C-----------------------------------------------------------
755 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
756 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
757 : & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
758 : & XMAT,NCOMAT,TI0,TINF,TSUP,ITEST)
759 : C
760 : IF (ITHHER.EQ.2) THEN
761 : C********** materiau dependant de la temperature **********************
762 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
762 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
763 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
764 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
765 : & NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
766 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
766 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
767 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
768 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
769 : & NSIGY1,XMAT1,NCOMAT,TSUP,TO,TO,ITEST)
770 : C**********************************************************************
771 : ENDIF
772 : C--------------------------------------------------------------
773 : C Calcul de la derivee de la dilatation thermique /temps a t=t0
774 : C--------------------------------------------------------------
774 : CALL DERTRA(NYALFT1,YALFT1,TI0,ALFA0,ALFAV0,TO,TO)
774 : CALL ZDANUL(EPSTHD,NSTRS1)
775 : CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
776 : DO I=1,3
777 : EPSTHD(I)=CTH
778 : ENDDO
778 : CALL XXCRE1(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
779 : & XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,DDV,
780 : & DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,XCARB,
781 : & ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
782 : & ITHHER,VART,IB,IGAU,kerre)
783 : c DO i= 1,6
784 : c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
785 : c ENDDO
786 : c DO i= 1,6
787 : c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
788 : c ENDDO
789 : c DO i= 1,6
790 : c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
791 : c ENDDO
792 : VAR(8)=VART(8)
792 : CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI0,TAUX)
793 : else
794 : do i=1,nstrs
795 : sigp1(i)=sigp4(i)
796 : evp1(i)=evp4(i)
797 : enddo
798 : do i=1,nvari
799 : varp1(i)=varp4(i)
800 : enddo
801 : endif
802 : ELSE IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
802 : CALL TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCARB,EVP1,VARP1,NSTRS1,
803 : & NVARI,INPLAS,NCOMAT,KERREU1)
804 : ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.33).AND.INPLAS.EQ.44) THEN
804 : CALL POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
805 : & KERRE)
806 : ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.33).AND.INPLAS.EQ.45) THEN
806 : CALL POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
807 : & KERRE)
808 : ENDIF
809 : C
810 : NITERA = 0
811 : C --------------------------------------------------------------------
812 : C DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
813 : C --------------------------------------------------------------------
814 : 80 CONTINUE
815 : iforce=.false.
816 : C WRITE(6,*) 'NITERA', nitera
817 : * if( tau.lt.dtaumi) then
818 : if( tau.lt.dtaumi.and.nssinc.gt.400) then
819 : tau=min(dtaumi,dtleft)
820 : iforce=.true.
821 : endif
822 : IF (MFR1.EQ.3) GOTO 150
823 : IF (MFR1.EQ.17) GOTO 210
824 : IF (INPLAS.EQ.17) THEN
825 : tau2=tau*0.5d0
825 : CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
826 : & XPM1,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
827 : & MFR1)
827 : CALL XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS1,
828 : & NVARI,NCOMAT,MFR1)
829 : DO I=1,NSTRS1
830 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
831 : XPM2(I) = 0.5D0*(XPM1(I)+XPM2(I))
832 : ENDDO
833 : DO I=1,4+NSTRS1
834 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
835 : ENDDO
835 : CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
836 : & XPM2,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
837 : & MFR1)
837 : CALL XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS1,
838 : & NVARI,NCOMAT,MFR1)
838 : CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,EVP3,
839 : & VARP3,XPM3,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
840 : & IVTEST,MFR1)
840 : CALL XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS1,
841 : & NVARI,NCOMAT,MFR1)
842 : DO I=1,NSTRS1
843 : EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
844 : XPM4(I) = 0.5D0*(XPM3(I)+XPM4(I))
845 : enddo
846 : DO I=1,4+NSTRS1
847 : VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
848 : enddo
848 : CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,EVP4,
849 : & VARP4,XPM4,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
850 : & IVTEST,MFR1)
850 : CALL XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS1,
851 : & NVARI,NCOMAT,MFR1)
852 : DO I=1,NSTRS1
853 : EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
854 : XPM2(I) = (XPM1(I)+XPM4(I))/6.d0+XPM3(I)*2.d0/3.d0
855 : enddo
856 : DO I=1,4+NSTRS1
857 : VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
858 : enddo
858 : CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,EVP2,VARP2,XPM2,
859 : & DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,MFR1)
860 : C---------
861 : ELSE IF (INPLAS.EQ.44) THEN
861 : CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
862 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
862 : CALL POUDRA(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
863 : & NCOMAT,KERRE)
864 : DO I=1,NSTRS1
865 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
866 : ENDDO
867 : VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
867 : CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
868 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
869 : * tau2=tau*0.5d0
869 : * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
870 : * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
870 : * CALL POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
871 : * & NCOMAT,KERRE)
872 : * DO I=1,NSTRS1
873 : * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
874 : * ENDDO
875 : * VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
875 : * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
876 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
876 : * CALL POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
877 : * & NCOMAT,KERRE)
877 : * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
878 : * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
878 : * CALL POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
879 : * & NCOMAT,KERRE)
880 : * DO I=1,NSTRS1
881 : * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
882 : * enddo
883 : * VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
883 : * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
884 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
884 : * CALL POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
885 : * & NCOMAT,KERRE)
886 : * DO I=1,NSTRS1
887 : * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
888 : * enddo
889 : * VARP2(1) = (VARP1(1)+VARP4(1))/6.d0+VARP3(1)*2.d0/3.d0
889 : * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
890 : * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
891 : *C---------
892 : ELSE IF (INPLAS.EQ.45) THEN
892 : CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
893 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
893 : CALL POUDRB(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
894 : & NCOMAT,KERRE)
895 : DO I=1,NSTRS1
896 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
897 : ENDDO
898 : VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
898 : CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
899 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
900 : C---------
901 : C CALCUL DE LA TAILLE DE GRAIN
902 : C---------
902 : CALL GRAIN(TAU,EVP1,EVP2,SIG,SIG1,VAR,VAR1,XMAT,NSTRS1,
903 : & NVARI,KERRE)
904 :
905 :
906 : * tau2=tau*0.5d0
906 : * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
907 : * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
907 : * CALL POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
908 : * & NCOMAT,KERRE)
909 : * DO I=1,NSTRS1
910 : * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
911 : * ENDDO
912 : * VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
912 : * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
913 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
914 : *C---------
915 : *C CALCUL DE LA TAILLE DE GRAIN
916 : *C---------
916 : * CALL GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS1,
917 : * & NVARI,KERRE)
918 : *c
918 : * CALL POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
919 : * & NCOMAT,KERRE)
919 : * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,DSPT,
920 : * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
920 : * CALL POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
921 : * & NCOMAT,KERRE)
922 : * DO I=1,NSTRS1
923 : * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
924 : * enddo
925 : * VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
925 : * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
926 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
926 : * CALL POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
927 : * & NCOMAT,KERRE)
928 : * DO I=1,NSTRS1
929 : * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
930 : * enddo
931 : * VARP2(1) =(VARP1(1)+VARP2(1))/6.d0+VARP3(1)*2.d0/3.d0
931 : * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
932 : * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
933 : *C---------
934 : *C CALCUL DE LA TAILLE DE GRAIN
935 : *C---------
935 : * CALL GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS1,
936 : * & NVARI,KERRE)
937 : *C---------
938 : ELSE IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61.OR.
939 : & INPLAS.EQ.107) THEN
940 : tau2=tau*0.5d0
940 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
941 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
942 : C-----------------------------------------------------------
943 : C Mise a jour eventuelle de la nouvelle temperature TI1 et
944 : C de la nouvelle densite de fissions FII1
945 : C-----------------------------------------------------------
946 : C
947 : DELTAT=TPOINT*TAU
948 : TI1=TI0+DELTAT
949 : DELTAF=FPOINT*TAU
950 : FII1=FII0+DELTAF
951 : IF (INPLAS.EQ.107) VAR1(3)=VAR(3)
951 : CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,
952 : & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
953 : DO I=1,NSTRS1
954 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
955 : ENDDO
956 : IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
957 : IF (INPLAS.EQ.107) VARPBU=VARP2(3)
958 : DO I=1,NVARI
959 : VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
960 : ENDDO
961 : ELSE
962 : DO I=1,2*NSTRS1+2
963 : VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
964 : ENDDO
965 : DO I=2*NSTRS1+4,NVARI
966 : VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
967 : ENDDO
968 : ENDIF
969 : C-----------------------------------------------------------
970 : C Mise a jour eventuelle de la nouvelle temperature TI1 et
971 : C de la nouvelle densite de fissions FII1
972 : C-----------------------------------------------------------
973 : C
974 : DELTAT=TPOINT*TAU2
975 : TI12=TI0+DELTAT
976 : DELTAF=FPOINT*TAU2
977 : FII12=FII0+DELTAF
977 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
978 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
979 : IF (INPLAS.EQ.107) VAR12(3)=VAR(3)
979 : CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,
980 : & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
981 : C-----------------------------------------------------------
982 : C Mise a jour eventuelle de la nouvelle temperature TI1 et
983 : C de la nouvelle densite de fissions FII1
984 : C-----------------------------------------------------------
985 : C
986 : TI1=TI12+DELTAT
987 : FII1=FII12+DELTAF
987 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
988 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
988 : CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,
989 : & NVARI,INPLAS,NCOMAT,MFR1,FII12,FII1,TI1)
990 : DO I=1,NSTRS1
991 : EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
992 : enddo
993 : IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
994 : DO I=1,NVARI
995 : VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
996 : enddo
997 : ELSE
998 : DO I=1,2*NSTRS1+2
999 : VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
1000 : enddo
1001 : DO I=2*NSTRS1+4,NVARI
1002 : VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
1003 : enddo
1004 : ENDIF
1004 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1005 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1006 : C-----------------------------------------------------------
1007 : C Mise a jour eventuelle de la nouvelle temperature TI1 et
1008 : C de la nouvelle densite de fissions FII1
1009 : C-----------------------------------------------------------
1010 : C
1011 : DELTAT=TPOINT*TAU2
1012 : TI12=TI0+DELTAT
1013 : DELTAF=FPOINT*TAU2
1014 : FII12=FII0+DELTAF
1015 : IF (INPLAS.EQ.107) VARf(3)=VAR(3)
1015 : CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,
1016 : & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
1017 : DO I=1,NSTRS1
1018 : EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1019 : enddo
1020 : IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
1021 : DO I=1,NVARI
1022 : VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1023 : enddo
1024 : IF (INPLAS.EQ.107) VARP2(3)=VARPBU
1025 : ELSE
1026 : DO I=1,2*NSTRS1+2
1027 : VARP2(I)=(VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1028 : enddo
1029 : DO I=2*NSTRS1+4,NVARI
1030 : VARP2(I)= (VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1031 : enddo
1032 : ENDIF
1032 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
1033 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1034 : IF(INPLAS.EQ.107) VARf(3)=VAR1(3)
1035 : C---------
1036 : ELSE IF (INPLAS.EQ.25) THEN
1037 : tau2=tau*0.5d0
1037 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1038 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1038 : CALL INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1039 : & NCOMAT)
1040 : DO I=1,NSTRS1
1041 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1042 : ENDDO
1043 : DO I=1,NVARI
1044 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1045 : ENDDO
1045 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1046 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1046 : CALL INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1047 : & NCOMAT)
1047 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1048 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1048 : CALL INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1049 : & NCOMAT)
1050 : DO I=1,NSTRS1
1051 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1052 : enddo
1053 : DO I=1,NVARI
1054 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1055 : enddo
1055 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1056 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1056 : CALL INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1057 : & NCOMAT)
1058 : DO I=1,NSTRS1
1059 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1060 : enddo
1061 : DO I=1,NVARI
1062 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1063 : enddo
1063 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1064 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1065 : C---------
1066 : ELSE IF (INPLAS.EQ.130) THEN
1067 : tau2=tau*0.5d0
1067 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1068 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1068 : CALL INCREP(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1069 : & NCOMAT)
1070 : DO I=1,NSTRS1
1071 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1072 : ENDDO
1073 : DO I=1,NVARI
1074 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1075 : ENDDO
1075 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1076 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1076 : CALL INCREP(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1077 : & NCOMAT)
1077 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1078 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1078 : CALL INCREP(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1079 : & NCOMAT)
1080 : DO I=1,NSTRS1
1081 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1082 : enddo
1083 : DO I=1,NVARI
1084 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1085 : enddo
1085 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1086 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1086 : CALL INCREP(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1087 : & NCOMAT)
1088 : DO I=1,NSTRS1
1089 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1090 : enddo
1091 : DO I=1,NVARI
1092 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1093 : enddo
1093 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1094 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1095 : C---------
1096 : C--------- LOI CHAB_SINH_R, CHAB_SINH_X (Runge Kuta 2-3)
1097 : ELSE IF (INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
1098 : a INPLAS.EQ.138.OR.INPLAS.EQ.139) THEN
1099 : tau2=tau*0.5d0
1100 : C write(6,*)'première entrée dans advac'
1100 : CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1101 : & DEPST,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1102 : C write(6,*)'sortie de advac'
1103 : C write(6,*)'seconde entrée dans increp'
1103 : CALL INCVAR(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1104 : & NCOMAT,INPLAS)
1105 : C write(6,*)'sortie de increp'
1106 : DO I=1,NSTRS1
1107 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1108 : ENDDO
1109 : DO I=1,2
1110 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1111 : ENDDO
1112 : C write(6,*)'seconde entrée dans advac'
1112 : CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1113 : & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1114 : C write(6,*)'sortie de advac'
1115 : C write(6,*)'troisième entrée entrée dans increp'
1115 : CALL INCVAR(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1116 : & NCOMAT,INPLAS)
1117 : C write(6,*)'sortie de increp'
1118 : C write(6,*)'troisième entrée dans advac'
1118 : CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1119 : & EVP3,DEPST,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1120 : C write(6,*)'sortie de advac'
1121 : C write(6,*)'quatrième entrée dans increp'
1121 : CALL INCVAR(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1122 : & NCOMAT,INPLAS)
1123 : C write(6,*)'sortie de increp'
1124 : DO I=1,NSTRS1
1125 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1126 : enddo
1127 : DO I=1,2
1128 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1129 : enddo
1130 : C write(6,*)'quatrième entrée dans advac'
1130 : CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1131 : & EVP4,DEPST,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1132 : C write(6,*)'sortie de advac'
1133 : C write(6,*)'cinquième entrée dans increp'
1133 : CALL INCVAR(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1134 : & NCOMAT,INPLAS)
1135 : C write(6,*)'sortie de increp'
1136 : DO I=1,NSTRS1
1137 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1138 : enddo
1139 : DO I=1,2
1140 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1141 : enddo
1142 : C write(6,*)'cinquième entrée dans advac'
1142 : CALL ADVAR(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1143 : & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1144 : C write(6,*)'sortie de advac'
1145 : C---------
1146 : C---------
1147 : ELSE IF (INPLAS.EQ.76) THEN
1147 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
1148 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1148 : CALL INCRA2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1149 : & NCOMAT)
1150 : DO I=1,NSTRS1
1151 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1152 : ENDDO
1153 : DO I=1,NVARI
1154 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1155 : ENDDO
1155 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1156 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1157 : * tau2=tau*0.5d0
1157 : * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1158 : * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1158 : * CALL INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1159 : * & NCOMAT)
1160 : * DO I=1,NSTRS1
1161 : * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1162 : * ENDDO
1163 : * DO I=1,NVARI
1164 : * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1165 : * ENDDO
1165 : * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1166 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1166 : * CALL INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1167 : * & NCOMAT)
1167 : * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1168 : * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1168 : * CALL INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1169 : * & NCOMAT)
1170 : * DO I=1,NSTRS1
1171 : * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1172 : * enddo
1173 : * DO I=1,NVARI
1174 : * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1175 : * enddo
1175 : * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1176 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1176 : * CALL INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1177 : * & NCOMAT)
1178 : * DO I=1,NSTRS1
1179 : * EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1180 : * enddo
1181 : * DO I=1,NVARI
1182 : * VARP2(I) = (VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1183 : * enddo
1183 : * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1184 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1185 : C---------
1186 : ELSE IF (INPLAS.EQ.77) THEN
1186 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
1187 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1187 : CALL INCRB2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1188 : & NCOMAT)
1189 : DO I=1,NSTRS1
1190 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1191 : enddo
1192 : DO I=1,NVARI
1193 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1194 : enddo
1194 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1195 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1196 :
1197 : * tau2=tau*0.5d0
1197 : * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1198 : * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1198 : * CALL INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1199 : * & NCOMAT)
1200 : * DO I=1,NSTRS1
1201 : * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1202 : * enddo
1203 : * DO I=1,NVARI
1204 : * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1205 : * enddo
1205 : * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1206 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1206 : * CALL INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1207 : * & NCOMAT)
1207 : * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1208 : * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1208 : * CALL INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1209 : * & NCOMAT)
1210 : * DO I=1,NSTRS1
1211 : * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1212 : * enddo
1213 : * DO I=1,NVARI
1214 : * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1215 : * enddo
1215 : * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1216 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1216 : * CALL INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1217 : * & NCOMAT)
1218 : * DO I=1,NSTRS1
1219 : * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1220 : * enddo
1221 : * DO I=1,NVARI
1222 : * VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1223 : * enddo
1223 : * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1224 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1225 : C---------
1226 : ELSE IF (INPLAS.EQ.53) THEN
1227 : tau2=tau*0.5d0
1227 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1228 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1228 : CALL INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
1229 : & NCOMAT)
1230 : DO I=1,NSTRS1
1231 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1232 : ENDDO
1233 : DO I=1,NVARI
1234 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1235 : ENDDO
1235 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1236 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1236 : CALL INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
1237 : & NCOMAT)
1237 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1238 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1238 : CALL INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1239 : & NCOMAT)
1240 : DO I=1,NSTRS1
1241 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1242 : enddo
1243 : DO I=1,NVARI
1244 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1245 : enddo
1245 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1246 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1246 : CALL INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
1247 : & NCOMAT)
1248 : DO I=1,NSTRS1
1249 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1250 : enddo
1251 : DO I=1,NVARI
1252 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1253 : enddo
1253 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1254 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1255 : C---------
1256 : ELSE IF (INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84.OR.
1257 : & INPLAS.EQ.102) THEN
1258 : tau2=tau*0.5d0
1258 : CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1259 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1260 : & MFR1)
1260 : CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS1,NVARI,
1261 : & EVP2,VARP2,TAU2)
1262 : DO I=1,NSTRS1
1263 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1264 : ENDDO
1265 : DO I=1,NVARI
1266 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1267 : ENDDO
1268 : C >>>> SI JE SUIS SUR LE PREMIER PAS <<<<
1269 : C et que j'ai calcule le resultat a la main
1270 : C _________________________________________
1271 : IF (VAR(12).GT.1.D0) THEN
1272 : C
1273 : DO I=1,NVARI
1274 : VARP2(I) = VARP1(I)
1275 : ENDDO
1276 : DO I=1,NSTRS1
1277 : EVP2(I) = EVP1(I)
1278 : ENDDO
1279 : ENDIF
1280 : C
1280 : CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1281 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1282 : & MFR1)
1282 : CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,NSTRS1,
1283 : & NVARI,EVP3,VARP3,TAU2)
1283 : CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1284 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1285 : & NCOMAT,MFR1)
1285 : CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,NSTRS1,
1286 : & NVARI,EVP4,VARP4,TAU2)
1287 : C print*,'==>4',VARP4(2),VARP4(3)
1288 : DO I=1,NSTRS1
1289 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1290 : enddo
1291 : C
1292 : DO I=1,NVARI
1293 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1294 : enddo
1294 : CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1295 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1296 : & NCOMAT,MFR1)
1296 : CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,NSTRS1,NVARI,
1297 : & EVP4,VARP4,TAU2)
1298 : DO I=1,NSTRS1
1299 : EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1300 : enddo
1301 : C
1302 : DO I=1,NVARI
1303 : VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1304 : enddo
1305 : C print*,'==>5',VARP2(2),VARP2(3)
1305 : CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1306 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1307 : & MFR1)
1308 : C----------
1309 : ELSE IF (INPLAS.EQ.63) THEN
1310 : tau2=tau*0.5d0
1310 : CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1311 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1312 : & MFR1)
1312 : CALL INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS1,MFR1,
1313 : & NVARI,NCOMAT,IFOURB)
1314 : DO I=1,NSTRS1
1315 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1316 : ENDDO
1317 : DO I=1,NVARI
1318 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1319 : ENDDO
1319 : CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1320 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1321 : & MFR1)
1321 : CALL INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS1,MFR1,
1322 : & NVARI,NCOMAT,IFOURB)
1322 : CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1323 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1324 : & NCOMAT,MFR1)
1324 : CALL INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
1325 : & NVARI,NCOMAT,IFOURB)
1326 : DO I=1,NSTRS1
1327 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1328 : enddo
1329 : DO I=1,NVARI
1330 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1331 : enddo
1331 : CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1332 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1333 : & NCOMAT,MFR1)
1333 : CALL INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
1334 : & NVARI,NCOMAT,IFOURB)
1335 : DO I=1,NSTRS1
1336 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1337 : enddo
1338 : DO I=1,NVARI
1339 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1340 : enddo
1340 : CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1341 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
1342 : & MFR1)
1343 : C--------
1344 : ELSE IF (INPLAS.EQ.70) THEN
1345 : tau2=tau*0.5d0
1345 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1346 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1347 : t12=(t0+tf)*0.5d0
1347 : CALL INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS1,MFR1,
1348 : & NVARI,NCOMAT)
1349 : C
1350 : DO I=1,NSTRS1
1351 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1352 : ENDDO
1353 : DO I=1,NVARI
1354 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1355 : ENDDO
1355 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1356 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1356 : CALL INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS1,MFR1,
1357 : & NVARI,NCOMAT)
1357 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1358 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1358 : CALL INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
1359 : & NVARI,NCOMAT)
1360 : DO I=1,NSTRS1
1361 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1362 : enddo
1363 : DO I=1,NVARI
1364 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1365 : enddo
1365 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
1366 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1366 : CALL INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
1367 : & NVARI,NCOMAT)
1368 : DO I=1,NSTRS1
1369 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1370 : enddo
1371 : DO I=1,NVARI
1372 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1373 : enddo
1373 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
1374 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
1375 : C---------
1376 : ELSE IF (INPLAS.EQ.29) THEN
1377 : C
1378 : 143 TAU2=0.5D0*TAU
1379 : C write(6,*) 'tau=',tau
1380 : C write(6,*) 'NSSINC=',NSSINC
1381 : * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
1381 : CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
1382 : & VARP1,NSTRS1,NVARI)
1383 : c write(6,*) 'varp1(3)=',varp1(3)
1384 : c Do i=1,6
1385 : c write(6,*) 'sig1(',i,')=',sig1(i)
1386 : c enddo
1387 : c Do i=1,6
1388 : c write(6,*) 'epsv1(',i,')=',epsv1(i)
1389 : c enddo
1390 : c Do i=1,7
1391 : c write(6,*) 'var1(',i,')=',var1(i)
1392 : c enddo
1393 : * if (ib.eq.1.and.igau.eq.1)
1394 : * $ write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
1395 : aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
1396 : aap = max ( aap,ABS (Sig1(3)-SIG(3)))
1397 : IF ( aap . gt . XMAX * 5.) THEN
1398 : * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
1399 : rap = aap / xmax
1400 : TAU= TAU / rap
1401 : * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
1402 : go to 143
1403 : * do I=1,nstrs
1404 : * sig1(i)=XMAX*100.
1405 : * sigf(I)=xmax*200.
1406 : * enddo
1407 : * go to 250
1408 : endif
1409 : C
1410 : C-----------------------------------------------------------
1411 : C Mise a jour eventuelle de la nouvelle temperature TI1
1412 : C-----------------------------------------------------------
1413 : C
1414 : DELTAT=TPOINT*TAU2
1415 : TI12=TI0+DELTAT
1416 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
1417 : C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
1418 : C-----------------------------------------------------------
1418 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
1419 : & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1420 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
1421 : & NCOMAT,TI12,TINF,TSUP,ITEST,TRUC,NCOURB)
1422 : C
1423 : IF (ITHHER.EQ.2) THEN
1424 : C********** materiau dependant de la temperature **********************
1425 : C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
1425 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1426 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
1427 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
1428 : & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
1429 : & NCOURB)
1430 : C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
1430 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1431 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
1432 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
1433 : & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
1434 : & NCOURB)
1435 : C**********************************************************************
1436 : ENDIF
1437 : C------------------------------------------------------------------
1438 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
1439 : C------------------------------------------------------------------
1439 : CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
1439 : CALL ZDANUL(EPSTHD,NSTRS1)
1440 : CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
1441 : DO I=1,3
1442 : EPSTHD(I)=CTH
1443 : ENDDO
1444 : C
1445 : c DO I=1,3
1446 : c WRITE(6,*) 'sig1(',I,')= ',sig1(I)
1447 : c ENDDO
1447 : CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
1448 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
1449 : & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
1450 : & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
1451 : & ITEST,ITHHER,TRUC,NCOURB)
1452 : c Do i=1,3
1453 : c write(6,*) 'sigp2(',i,')=',sigp2(i)
1454 : c enddo
1455 : C
1456 : do i=1,nstrs
1457 : sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
1458 : evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
1459 : enddo
1460 : do i=1,nvari
1461 : varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
1462 : enddo
1463 : t=tau2
1463 : CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,EVP2,
1464 : & VARP2,NSTRS1,NVARI)
1465 : c Do i=1,6
1466 : c write(6,*) 'sig12(',i,')=',sig12(i)
1467 : c enddo
1468 : c Do i=1,6
1469 : c write(6,*) 'epsv12(',i,')=',epsv12(i)
1470 : c enddo
1471 : c Do i=1,7
1472 : c write(6,*) 'var12(',i,')=',var12(i)
1473 : c enddo
1474 : if (tau2.ne.t) then
1475 : tau=2.d0*tau2
1476 : goto 143
1477 : endif
1478 : * if (ib.eq.1.and.igau.eq.1)
1479 : * $ write(6,*)'SIg1(1) SIg2 sig3',sig12(1),sig12(2),sig12(3)
1480 : aap = MAX(ABS(SIG12(1)-SIG(1)),ABS(SIG12(2)-SIG(2)))
1481 : aap = max ( aap,ABS (Sig12(3)-SIG(3)))
1482 : IF ( aap . gt . XMAX * 5.) THEN
1483 : * write(6,*)'SIg12(1) SIg12 SI1g3',sig12(1),sig12(2),sig12(3)
1484 : rap = aap / xmax
1485 : TAU= TAU / rap
1486 : * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
1487 : go to 143
1488 : * do I=1,nstrs
1489 : * sig1(i)=XMAX*100.
1490 : * sigf(I)=xmax*200.
1491 : * enddo
1492 : * go to 250
1493 : endif
1494 : C
1494 : CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
1495 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
1496 : & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
1497 : & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
1498 : & ITEST,ITHHER,TRUC,NCOURB)
1498 : CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
1499 : & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
1500 : DELTAT=TPOINT*TAU
1501 : TI1=TI0+DELTAT
1502 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
1503 : C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
1504 : C-----------------------------------------------------------
1504 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1505 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,
1506 : & NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,
1507 : & XMAT,NCOMAT,TI1,TINF,TSUP,ITEST,TRUC,NCOURB)
1508 : IF (ITHHER.EQ.2) THEN
1509 : C********** materiau dependant de la temperature **********************
1510 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
1510 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1511 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
1512 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
1513 : & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
1514 : & NCOURB)
1515 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
1515 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1516 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
1517 : & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
1518 : & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
1519 : & NCOURB)
1520 : C**********************************************************************
1521 : ENDIF
1522 : C------------------------------------------------------------------
1523 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
1524 : C------------------------------------------------------------------
1524 : CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
1524 : CALL ZDANUL(EPSTHD,NSTRS1)
1525 : CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
1526 : DO I=1,3
1527 : EPSTHD(I)=CTH
1528 : ENDDO
1529 : C
1529 : CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1530 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
1531 : & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
1532 : & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
1533 : & ITEST,ITHHER,TRUC,NCOURB)
1534 : do i=1,nstrs
1535 : sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
1536 : evp4(i) =0.5D0*( evp4(i)+ evp3(i))
1537 : enddo
1538 : do i=1,nvari
1539 : varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
1540 : enddo
1540 : call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
1541 : & EVP4,VARP4,NSTRS1,NVARI)
1541 : CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1542 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
1543 : & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
1544 : & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
1545 : & ITEST,ITHHER,TRUC,NCOURB)
1546 : DO I=1,NSTRS1
1547 : EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
1548 : SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
1549 : ENDDO
1550 : DO I=1,NVARI
1551 : VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
1552 : ENDDO
1553 : T=TAU
1553 : CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
1554 : & VARP2,NSTRS1,NVARI)
1555 : c Do i=1,6
1556 : c write(6,*) 'sig1(',i,')=',sig1(i)
1557 : c enddo
1558 : c Do i=1,6
1559 : c write(6,*) 'epsv1(',i,')=',epsv1(i)
1560 : c enddo
1561 : c Do i=1,3
1562 : c write(6,*) 'var1(',i,')=',var1(i)
1563 : c enddo
1564 : c IF (TAU.NE.T) GOTO 143
1565 : C---------
1566 : ELSE IF (INPLAS.EQ.142) THEN
1567 : C
1568 : 144 TAU2=0.5D0*TAU
1569 : C write(6,*) 'tau=',tau
1570 : C write(6,*) 'NSSINC=',NSSINC
1571 : * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
1571 : CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
1572 : & VARP1,NSTRS1,NVARI)
1573 : c Do i=2,4
1574 : c write(6,*) 'varp1(',i,')=',varp1(i)
1575 : c enddo
1576 : c Do i=1,6
1577 : c write(6,*) 'sig1(',i,')=',sig1(i)
1578 : c enddo
1579 : c Do i=1,6
1580 : c write(6,*) 'epsv1(',i,')=',epsv1(i)
1581 : c enddo
1582 : c Do i=1,7
1583 : c write(6,*) 'var1(',i,')=',var1(i)
1584 : c enddo
1585 : aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
1586 : aap = max ( aap,ABS (Sig1(3)-SIG(3)))
1587 : IF ( aap . gt . XMAX * 5.) THEN
1588 : * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
1589 : rap = aap / xmax
1590 : TAU= TAU / rap
1591 : go to 144
1592 : * do I=1,nstrs
1593 : * sig1(i)=XMAX*100.
1594 : * sigf(I)=xmax*200.
1595 : * enddo
1596 : * go to 250
1597 : endif
1598 : C
1599 : C-----------------------------------------------------------
1600 : C Mise a jour eventuelle de la nouvelle temperature TI1
1601 : C-----------------------------------------------------------
1602 : C
1603 : DELTAT=TPOINT*TAU2
1604 : TI12=TI0+DELTAT
1605 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
1606 : C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
1607 : C-----------------------------------------------------------
1607 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1608 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
1609 : & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
1610 : & XMAT,NCOMAT,TI12,TINF,TSUP,ITEST)
1611 : C
1612 : IF (ITHHER.EQ.2) THEN
1613 : C********** materiau dependant de la temperature **********************
1614 : C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
1614 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1615 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
1616 : & NYA1,YQ1,NYQ1,YALFT2,NYALFT1,YRHO1,NYRHO1,
1617 : & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
1618 : C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
1618 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1619 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
1620 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
1621 : & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
1622 : C**********************************************************************
1623 : ENDIF
1624 : C------------------------------------------------------------------
1625 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
1626 : C------------------------------------------------------------------
1626 : CALL DERTRA(NYALFT1,YALFT1,TI12,ALFA1,ALFAV1,TO,TO)
1626 : CALL ZDANUL(EPSTHD,NSTRS1)
1627 : CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
1628 : DO I=1,3
1629 : EPSTHD(I)=CTH
1630 : ENDDO
1631 : C
1632 : c DO I=1,4
1633 : c WRITE(6,*) 'VAR1(',I,')= ',VAR1(I)
1634 : c ENDDO
1635 : c DO I=1,6
1636 : c WRITE(6,*) 'SIG1(',I,')= ',SIG1(I)
1637 : c ENDDO
1637 : CALL XXCRE1(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
1638 : & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
1639 : & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
1640 : & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
1641 : & ITEST,ITHHER,VART1,IB,IGAU,kerre)
1642 : c DO I=1,4
1643 : c WRITE(6,*) 'VAR1 ap(',I,')= ',VAR1(I)
1644 : c ENDDO
1645 : c DO I=1,4
1646 : c WRITE(6,*) 'VARP2(',I,')= ',VARP2(I)
1647 : c ENDDO
1648 : c DO I=1,6
1649 : c WRITE(6,*) 'SIGP2(',I,')= ',SIGP2(I)
1650 : c ENDDO
1651 : c DO I=1,6
1652 : c WRITE(6,*) 'EVP2(',I,')= ',EVP2(I)
1653 : c ENDDO
1654 : C
1655 : do i=1,nstrs
1656 : sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
1657 : evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
1658 : enddo
1659 : do i=1,nvari
1660 : varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
1661 : enddo
1662 : t=tau2
1662 : CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,EVP2,
1663 : & VARP2,NSTRS1,NVARI)
1664 : c Do i=1,6
1665 : c write(6,*) 'sig12(',i,')=',sig12(i)
1666 : c enddo
1667 : c Do i=1,6
1668 : c write(6,*) 'epsv12(',i,')=',epsv12(i)
1669 : c enddo
1670 : c Do i=1,7
1671 : c write(6,*) 'var12(',i,')=',var12(i)
1672 : c enddo
1673 : if (tau2.ne.t) then
1674 : tau=2.d0*tau2
1675 : goto 144
1676 : endif
1677 : * if (ib.eq.1.and.igau.eq.1)
1678 : * $ write(6,*)'SIg1(1) SIg2 sig3',sig12(1),sig12(2),sig12(3)
1679 : aap = MAX(ABS(SIG12(1)-SIG(1)),ABS(SIG12(2)-SIG(2)))
1680 : aap = max ( aap,ABS (Sig12(3)-SIG(3)))
1681 : IF ( aap . gt . XMAX * 5.) THEN
1682 : * write(6,*)'SIg12(1) SIg12 SI1g3',sig12(1),sig12(2),sig12(3)
1683 : rap = aap / xmax
1684 : TAU= TAU / rap
1685 : * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
1686 : go to 144
1687 : * do I=1,nstrs
1688 : * sig1(i)=XMAX*100.
1689 : * sigf(I)=xmax*200.
1690 : * enddo
1691 : * go to 250
1692 : endif
1693 : C
1693 : CALL XXCRE1(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
1694 : & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
1695 : & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
1696 : & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
1697 : & ITEST,ITHHER,VART1,IB,IGAU,kerre)
1697 : CALL AVANX1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
1698 : & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
1699 : DELTAT=TPOINT*TAU
1700 : TI1=TI0+DELTAT
1701 :
1702 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
1703 : C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
1704 : C-----------------------------------------------------------
1704 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1705 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
1706 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
1707 : & NSIGY1,XMAT,NCOMAT,TI1,TINF,TSUP,ITEST)
1708 : IF (ITHHER.EQ.2) THEN
1709 : C********** materiau dependant de la temperature **********************
1710 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
1710 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1711 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
1712 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
1713 : & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
1714 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
1714 : CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
1715 : & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
1716 : & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
1717 : & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
1718 : C**********************************************************************
1719 : ENDIF
1720 : C------------------------------------------------------------------
1721 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
1722 : C------------------------------------------------------------------
1722 : CALL DERTRA(NYALFT1,YALFT1,TI1,ALFA1,ALFAV1,TO,TO)
1722 : CALL ZDANUL(EPSTHD,NSTRS1)
1723 : CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
1724 : DO I=1,3
1725 : EPSTHD(I)=CTH
1726 : ENDDO
1727 : C
1727 : CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1728 : & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
1729 : & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
1730 : & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
1731 : & ITEST,ITHHER,VART1,IB,IGAU,kerre)
1732 : do i=1,nstrs
1733 : sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
1734 : evp4(i) =0.5D0*( evp4(i)+ evp3(i))
1735 : enddo
1736 : do i=1,nvari
1737 : varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
1738 : enddo
1738 : call AVANX1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
1739 : & EVP4,VARP4,NSTRS1,NVARI)
1739 : CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1740 : & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
1741 : & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
1742 : & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
1743 : & ITEST,ITHHER,VART,IB,IGAU,kerre)
1744 : DO I=1,NSTRS1
1745 : EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
1746 : SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
1747 : ENDDO
1748 : DO I=1,NVARI
1749 : VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
1750 : ENDDO
1751 : T=TAU
1751 : CALL AVANX1(TAU,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP2,EVP2,
1752 : & VARP2,NSTRS1,NVARI)
1753 : c Do i=1,6
1754 : c write(6,*) 'sig1(',i,')=',sig1(i)
1755 : c enddo
1756 : c Do i=1,6
1757 : c write(6,*) 'epsv1(',i,')=',epsv1(i)
1758 : c enddo
1759 : c Do i=1,7
1760 : c write(6,*) 'var1(',i,')=',var1(i)
1761 : c enddo
1762 : c IF (TAU.NE.T) GOTO 144
1763 : ENDIF
1764 : GOTO 250
1765 : C _____________________________________________________________________
1766 : 150 CONTINUE
1767 : C----------------------------------------------------------------------
1768 : C CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
1769 : C----------------------------------------------------------------------
1770 : IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61) THEN
1771 : tau2=tau*0.5d0
1771 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1772 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1772 : CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
1773 : & NSTRS1,NVARI,INPLAS,NCOMAT)
1774 : DO I=1,NSTRS1,1
1775 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1776 : ENDDO
1777 : IF (INPLAS.EQ.24) THEN
1778 : DO I=1,NVARI
1779 : VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
1780 : ENDDO
1781 : ELSE
1782 : DO I=1,2*NSTRS1+2
1783 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1784 : ENDDO
1785 : DO I=2*NSTRS1+4,NVARI
1786 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1787 : ENDDO
1788 : ENDIF
1788 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1789 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1789 : CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
1790 : & NSTRS1,NVARI,INPLAS,NCOMAT)
1790 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1791 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1792 : & NCOMAT)
1792 : CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
1793 : & NSTRS1,NVARI,INPLAS,NCOMAT)
1794 : DO I=1,NSTRS1
1795 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1796 : enddo
1797 : IF (INPLAS.EQ.24) THEN
1798 : DO I=1,NVARI
1799 : VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
1800 : enddo
1801 : ELSE
1802 : DO I=1,2*NSTRS1+2
1803 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1804 : enddo
1805 : DO I=2*NSTRS1+4,NVARI
1806 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1807 : enddo
1808 : ENDIF
1808 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1809 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1810 : & NCOMAT)
1810 : CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
1811 : & NSTRS1,NVARI,INPLAS,NCOMAT)
1812 : DO I=1,NSTRS1,1
1813 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1814 : enddo
1815 : IF (INPLAS.EQ.24) THEN
1816 : DO I=1,NVARI
1817 : VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1818 : enddo
1819 : ELSE
1820 : DO I=1,2*NSTRS1+2
1821 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1822 : enddo
1823 : DO I=2*NSTRS1+4,NVARI
1824 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1825 : enddo
1826 : endif
1826 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1827 : & VARp2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1828 : C---------
1829 : ELSE IF (INPLAS.EQ.25) THEN
1830 : tau2=tau*0.5d0
1830 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1831 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1831 : CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1832 : & NCOMAT)
1833 : DO I=1,NSTRS1
1834 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1835 : ENDDO
1836 : DO I=1,NVARI
1837 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1838 : ENDDO
1838 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1839 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1839 : CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
1840 : & NCOMAT)
1840 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1841 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1842 : & NCOMAT)
1842 : CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1843 : & NCOMAT)
1844 : DO I=1,NSTRS1
1845 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1846 : enddo
1847 : DO I=1,NVARI
1848 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1849 : enddo
1849 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1850 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1851 : & NCOMAT)
1851 : CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1852 : & NCOMAT)
1853 : DO I=1,NSTRS1
1854 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1855 : enddo
1856 : DO I=1,NVARI
1857 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1858 : enddo
1858 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1859 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1860 : C---------
1861 : ELSE IF (INPLAS.EQ.76) THEN
1861 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,
1862 : & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1863 : & NCOMAT)
1863 : CALL INCRA4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1864 : & NCOMAT)
1865 : DO I=1,NSTRS1
1866 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1867 : ENDDO
1868 : DO I=1,NVARI
1869 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1870 : ENDDO
1870 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1871 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1872 : * tau2=tau*0.5d0
1872 : * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1873 : * & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1874 : * & NCOMAT)
1874 : * CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1875 : * & NCOMAT)
1876 : * DO I=1,NSTRS1
1877 : * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1878 : * ENDDO
1879 : * DO I=1,NVARI
1880 : * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1881 : * ENDDO
1881 : * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1882 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1882 : * CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
1883 : * & NCOMAT)
1883 : * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1884 : * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1885 : * & NCOMAT)
1885 : * CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1886 : * & NCOMAT)
1887 : * DO I=1,NSTRS1
1888 : * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
1889 : * enddo
1890 : * DO I=1,NVARI
1891 : * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
1892 : * enddo
1892 : * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1893 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1894 : * & NCOMAT)
1895 : * DO I=1,NSTRS1
1896 : * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1897 : * enddo
1898 : * DO I=1,NVARI
1899 : * VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1900 : * enddo
1900 : * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1901 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1902 : C---------
1903 : ELSE IF (INPLAS.EQ.77) THEN
1903 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
1904 : & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,ncomat)
1904 : CALL INCRB4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1905 : & NCOMAT)
1906 : DO I=1,NSTRS1
1907 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1908 : enddo
1909 : DO I=1,NVARI
1910 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1911 : enddo
1911 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1912 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1913 : * tau2=tau*0.5d0
1913 : * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1914 : * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1914 : * CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1915 : * & NCOMAT)
1916 : * DO I=1,NSTRS1
1917 : * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1918 : * ENDDO
1919 : * DO I=1,NVARI
1920 : * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1921 : * ENDDO
1921 : * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1922 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1922 : * CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
1923 : * & NCOMAT)
1923 : * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1924 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1925 : * & NCOMAT)
1925 : * CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1926 : * & NCOMAT)
1927 : * DO I=1,NSTRS1
1928 : * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
1929 : * enddo
1930 : * DO I=1,NVARI
1931 : * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
1932 : * enddo
1932 : * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1933 : * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1934 : * & NCOMAT)
1934 : * CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1935 : * & NCOMAT)
1936 : * DO I=1,NSTRS1
1937 : * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1938 : * enddo
1939 : * DO I=1,NVARI
1940 : * VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1941 : * enddo
1941 : * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1942 : * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1943 : C---------
1944 : ELSE IF (INPLAS.EQ.53) THEN
1945 : tau2=tau*0.5d0
1945 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1946 : & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1947 : & NCOMAT)
1947 : CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
1948 : & NCOMAT)
1949 : DO I=1,NSTRS1
1950 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1951 : ENDDO
1952 : DO I=1,NVARI
1953 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1954 : ENDDO
1954 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1955 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1955 : CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
1956 : & NCOMAT)
1956 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1957 : & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1958 : & NCOMAT)
1958 : CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1959 : & NCOMAT)
1960 : DO I=1,NSTRS1
1961 : EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
1962 : enddo
1963 : DO I=1,NVARI
1964 : VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
1965 : enddo
1965 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1966 : & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
1967 : & NCOMAT)
1967 : CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
1968 : & NCOMAT)
1969 : DO I=1,NSTRS1
1970 : EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
1971 : enddo
1972 : DO I=1,NVARI
1973 : VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
1974 : enddo
1974 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
1975 : & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1976 : C---------
1977 : ENDIF
1978 : GOTO 250
1979 : C
1980 : C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
1981 : C
1982 : 210 CONTINUE
1983 : IF (INPLAS.NE.19) GOTO 999
1984 : tau2=tau*0.5d0
1984 : CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
1985 : & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
1985 : CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCARB,EVP2,VARP2,NSTRS1,
1986 : & NVARI,INPLAS,NCOMAT,KERREU1)
1987 : DO I=1,6
1988 : EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
1989 : ENDDO
1990 : DO I=1,4
1991 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1992 : ENDDO
1993 : DO I=6,NVARI
1994 : VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
1995 : ENDDO
1995 : CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
1996 : & VARP2,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
1997 : & NCOMAT)
1997 : CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCARB,EVP3,VARP3,
1998 : & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
1998 : CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
1999 : & EVP3,VARP3,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
2000 : & NCOMAT)
2000 : CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCARB,EVP4,VARP4,
2001 : & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
2002 : DO I=1,6
2003 : EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
2004 : enddo
2005 : DO I=1,4
2006 : VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
2007 : enddo
2008 : DO I=6,NVARI
2009 : VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
2010 : enddo
2010 : CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,EVP4,
2011 : & VARP4,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
2012 : & NCOMAT)
2012 : CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCARB,EVP4,VARP4,NSTRS1,
2013 : & NVARI,INPLAS,NCOMAT,KERREU1)
2014 : DO I=1,6
2015 : EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
2016 : enddo
2017 : DO I=1,4
2018 : VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
2019 : enddo
2020 : DO I=6,NVARI
2021 : VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
2022 : enddo
2022 : CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
2023 : & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
2024 : C
2025 : C----------------------------------------------------------------------
2026 : 250 CONTINUE
2027 : C ---------------------------------------------------------------------
2028 : C CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
2029 : C ---------------------------------------------------------------------
2030 : DO I=1,NSTRS1
2031 : XX(I) = SIGF(I)-SIG1(I)
2032 : ENDDO
2033 : RA = SQRT(PROCON(XX,XX,NSTRS1))/(ERRABS)
2034 : c
2035 : * write(6,*) ' ra ' , ra
2036 : IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
2037 : RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
2038 : ENDIF
2039 : SQRA = SQRT(RA)
2040 : IF (INPLAS.EQ.29) THEN
2041 : RD = 0.D0
2042 : IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
2043 : RD = (VARF(3)-VAR1(3))/VARF(3)
2044 : RD = DABS(RD)/1.D-4
2045 : ENDIF
2046 : RA = DMAX1(RA,RD)
2047 : SQRA = SQRT(RA)
2048 : ELSEIF (INPLAS.EQ.142) THEN
2049 : RD = 0.D0
2050 : IF (VARF(8).NE.0.D0.AND.VAR1(8).GT.1.0D-5) THEN
2051 : RD = (VARF(8)-VAR1(8))/VARF(8)
2052 : RD = DABS(RD)/1.D-4
2053 : ENDIF
2054 : RA = DMAX1(RA,RD)
2055 : SQRA = SQRT(RA)
2056 : ENDIF
2057 : C ---------------------------------------------------------------------
2058 : C TEST DE FIN D'ITERATIONS / MISE A JOUR DE TAU /OPTION JECHER
2059 : C DIV =7 BORNE = 2
2060 : C SI SQRA>7 TAU = TAU/7 ET NOUVEL ESSAI
2061 : C SI 2ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
2135 : & NCOMAT,TI1,TD,TRUC,NCOURB)
2136 :
2137 : IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
2138 : VARF(3)=1.D0
2139 : TLIFE = DT - (DTLEFT - TAU)
2140 : GOTO 999
2141 : ENDIF
2142 : C
2143 : ELSEIF (INPLAS.EQ.142) THEN
2144 : C--------------------------------------------------------------
2145 : C Estimation du pas de temps apres la mise a jour des variables
2146 : C--------------------------------------------------------------
2147 : C
2147 : CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI1,TD)
2148 :
2149 : IF ((VARF(8).GE.0.96).OR.(TD.LT.1.D0)) THEN
2150 : VARF(8)=1.D0
2151 : TLIFE = DT - (DTLEFT - TAU)
2152 : GOTO 999
2153 : ENDIF
2154 : ENDIF
2155 : C
2156 : C --------------------------------------------------------------------
2157 : C TEST DE FIN SS INCREMENTS / MISE A JOUR DE TAU
2158 : C si SQRA<1/3 TAU = TAU*3
2159 : C si 1/3RMAX on vise RA = 1
2162 : C fin des boucles en ss increments si tau = dtleft
2163 : C --------------------------------------------------------------------
2164 : C
2165 : IF ( TAU.LT.DTLEFT ) THEN
2166 : * DTDEUX=TAU
2167 : DTLEFT = DTLEFT - TAU
2168 : * IF (dtlibr) then
2169 : IF ( FAC*SQRA.LT.1.D0) THEN
2170 : TAU=TAU*FAC
2171 : ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
2172 : TAU=TAU/SQRA
2173 : ENDIF
2174 : * else
2175 : * TAU = TAU * R
2176 : * endif
2177 : IF (TAU.GT.DTLEFT) then
2178 : TAU = DTLEFT
2179 : endif
2180 : IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.107).OR.(INPLAS.EQ.142)) THEN
2181 : C----------------------------------------------------------------------------
2182 : C Mise a jour des temperatures
2183 : C TI0 temperature au dedut du pas de sous-incrementation avec TINFC TI1 temperature a la fin du pas de sous-incrementation
2185 : C-----------------------------------------------------------------------------
2186 : TI0=TI1
2187 : DELTAT=TPOINT*TAU
2188 : TI1=TI0+DELTAT
2189 : ENDIF
2190 : IF (INPLAS.EQ.107) THEN
2191 : C----------------------------------------------------------------------------
2192 : C Mise a jour des densites de fissions
2193 : C FII0 densite de fissions au dedut du pas de sous-incrementation
2194 : C FII1 densite de fissions a la fin du pas de sous-incrementation
2195 : C-----------------------------------------------------------------------------
2196 : FII0=FII1
2197 : DELTAF=FPOINT*TAU
2198 : FII1=FII0+DELTAF
2199 : ENDIF
2200 : GOTO 70
2201 : ENDIF
2202 : C
2203 : IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
2204 : WRITE ( IOIMP,* ) ' PROBLEME TAU > DTLEFT '
2205 : KERRE = 223
2206 : ENDIF
2207 :
2208 : C-----------------------------------------------------------------------
2209 : 999 CONTINUE
2210 : * if(ib.eq.1.and.igau.eq.1) then
2211 : * write(6,*)'inplas nssinc nopri pasbea iforce',inplas,nssinc,nopri
2212 : * $ ,pasbea,iffo
2213 : * endif
2214 : IF (MFR1.EQ.3) THEN
2215 : DO 1000 I=1,NSTRS1/2
2216 : SIGF( I) =SIGF( I)*THICK
2217 : SIGF(NSTRS1/2+I) =SIGF(NSTRS1/2+ I)*THICK*THICK/6.0
2218 : * DSIGT( I)=DSIGT( I)*THICK
2219 : * DSIGT(NSTRS1/2+I)=DSIGT(NSTRS1/2+I)*THICK*THICK/6.0
2220 : 1000 CONTINUE
2221 : ENDIF
2222 : C
2223 : C===========================================================
2224 : C RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
2225 : C A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
2226 : C DEFINIES PAR DES GAMA.
2227 : C ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
2228 : C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
2229 : C DE LEMAITRE (INPLAS=29).
2230 : C
2231 : C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
2232 : C MFR1=1 (MASSIF)
2233 : C MFR1=5 (COQUES EPAISSES)
2234 : C MFR1=3 (COQUES MINCES)
2235 : C MFR1=17 (TUYAUX FISSURES)
2236 : C MFR1=33 (POREUX)
2237 : C
2238 : IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
2239 : C
2240 : C Cas de la formulation massive
2241 : C Les termes de cisaillement apparaissent
2242 : C au delà de la troisieme composante
2243 : C
2244 : IF (MFR1.EQ.1.OR.MFR1.EQ.33) THEN
2245 : DO 14 I=1,NSTRS1
2246 : A=1.D0
2247 : IF (I.GT.3) A=2.D0
2248 : EPIN0(I)=EPIN0(I)*A
2249 : EPINF(I)=EPINF(I)*A
2250 : 14 CONTINUE
2251 : C
2252 : C Cas des coques épaisses
2253 : C Les termes de cisaillement apparaissent
2254 : C au delà de la deuxieme composante
2255 : C
2256 : ELSE IF (MFR1.EQ.5) THEN
2257 : DO 15 I=1,NSTRS1
2258 : A=1.D0
2259 : IF (I.GT.2) A=2.D0
2260 : EPIN0(I)=EPIN0(I)*A
2261 : EPINF(I)=EPINF(I)*A
2262 : 15 CONTINUE
2263 : C
2264 : C Cas des coques minces
2265 : C Les termes de cisaillement apparaissent
2266 : C pour la troisieme et la sixieme composante
2267 : C uniquement dans les cas de calculs
2268 : C tridimensionnels ou d'analyse de Fourier
2269 : C
2270 : ELSE IF (MFR1.EQ.3) THEN
2271 : IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
2272 : DO 16 I=1,NSTRS1
2273 : A=1.D0
2274 : IF (I.EQ.3) A=2.D0
2275 : IF (I.EQ.6) A=2.D0
2276 : EPIN0(I)=EPIN0(I)*A
2277 : EPINF(I)=EPINF(I)*A
2278 : 16 CONTINUE
2279 : ENDIF
2280 : C
2281 : C Reste le cas des tuyaux fissurés (MFR1=17)
2282 : C
2283 : ENDIF
2284 : ENDIF
2285 : C
2286 : C===========================================================
2287 : C
2288 : 998 RETURN
2289 : END
2290 :
2291 :
2292 :
2293 :
2294 :
2295 :
2296 :
2297 :
2298 :
2299 :
2300 :
2301 :
2302 :
2303 :
2304 :
2305 :
2306 :
2307 :
2308 :
2309 :
2310 :
2311 :
2312 :
2313 :