Download consti.eso
Back to the list
1 : C CONSTI SOURCE AM 08/12/19 21:16:03 6237
2 : SUBROUTINE CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
3 : 1 INPLAS,MFR,DT,NSTRS,NVARI,NCOMAT,PRECAS,MSOUPA,JECHER,DTT,
4 : 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,
5 : 3 NYN,NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,T0,TF,
6 : 5 TREF,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
7 : 7NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
8 : C
9 : C---------------------------------------------------------------------
10 : C Objet: Calculer au cours d'un pas de temps DT, l'evolution des
11 : C variables internes a l'aide d'un schema Runge-Kutta 1.2
12 : C ---------------------------------------------------------------------
13 : C
14 : C---------------------------------------------------------------------
15 : C Entree: INPLAS type de materiau
16 : C MFR indice de la formulation mecanique(seulement massif ou coque
17 : C pour les materiaux endommageables)
18 : C DEPST(NSTRS) increment des deformations totales
19 : C SIG0(NSTRS) contraintes initiales
20 : C EPIN0(NSTRS) deformations viscoplastiques initiales
21 : C VAR0(NVARI) variables internes initiales
22 : C NVARI nombre de variables internes
23 : C YOG(NYOG) courbe du module d'Young en fonction de T°C
24 : C YNU(NYNU) courbe du coefficient de Poisson en fonction de T°C
25 : C SIGY(NSIGY) courbe de la limite elastique en fonction de T°C
26 : C YRHO(NYRHO) courbe de la masse volumique en fonction de T°C
27 : C YALFA(NYALFA) courbe du coeff de dilatation en fonction de T°C
28 : C YN(NYN)
29 : C YM(NYM)
30 : C YKK(NYKK) courbes des autres coefficients caracteristiques
31 : C YALFA1(NYALF1) en fonction de la T°C intervenant
32 : C YBETA1(NYBET1) dans les lois d'evolution
33 : C YR(NYR)
34 : C YA(NYA)
35 : C YKX(NYKX) fonction k(X) tabulee en fonction de la temperature
36 : C NKX(NNKX) tableau de pointeurs sur les courbes de k(X)
37 : C XMAT(NCOMAT) materiau
38 : C XCAR(ICARA) caracteristiques geometriques
39 : C YSMAX(NYSMAX) intervient ds. le test de convergence des iter.
40 : C TRUC(NCOURB) tableau de travail
41 : C PRECIS precision relative sur SIGMA
42 : C MSOUPA nombre maximal de sous pas autorises
43 : C JECHER = 0 avancer
44 : C = 1 rechercher sortie avec DTT
45 : C IFOURB = -3 EN DEFORM. PLANES GENER.
46 : C -2 EN CONTR.PLANES
47 : C -1 EN DEFORM. PLANES
48 : C 0 EN AXISYMETRIE
49 : C 1 EN SERIE DE FOURIER
50 : C 2 EN TRIDIM
51 : * CMATE = NOM DU MATERIAU
52 : * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
53 : * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
54 : * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
55 : * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
56 : * IB = NUMERO DE L ELEMENT COURANT
57 : * IGAU = NUMERO DU POINT COURANT
58 : * EPAIST= EPAISSEUR
59 : * NBPGAU= NBRE DE POINTS DE GAUSS
60 : * MELE = NUMERO DE L ELEMENT FINI
61 : * NPINT = NBRE DE POINTS D INTEGRATION
62 : * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
63 : * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
64 : * SECT = SECTION
65 : * LHOOK = TAILLE DE LA MATRICE DE HOOKE
66 : C DD(NSTRS,NSTRS) matrice de Hooke en fonction de T
67 : C DDV(NSTRS,NSTRS) derivee de DD
68 : C DDINV(NSTRS,NSTRS) inverse de DD
69 : C T0 temperature a t0
70 : C TF temperature a t0+DT
71 : C TREF temperature de reference
72 : C DT pas de temps
73 : C ITHHER = 0 pas de chargement thermique et materiau constant
74 : C = 1 chargement thermique et materiau constant
75 : C = 2 chargement thermique et materiau(T)
76 : C-----------------------------------------------------------------------
77 : C
78 : C-----------------------------------------------------------------------
79 : C Sortie: SIGF(NSTRS) contraintes finales
80 : C EPINF(NSTRS) deformations viscoplastiques finales
81 : C VARF(NVARI) variables internes finales
82 : C DTT sous-increment de temps optimal (si JECHER=1)
83 : C TLIFE sous-increment de temps a rupture pour materiau
84 : C viscoplastique endommageable
85 : C NSSINC nombre de sous-increments si JECHER=0
86 : C INV = 1 si inversion
87 : C 0 sinon
88 : C KERRE = 0 si tout OK
89 : C <> 0 si entrees incoherentes
90 : C-----------------------------------------------------------------------
91 : C
92 : IMPLICIT INTEGER(I-N)
93 : IMPLICIT REAL*8(A-H,O-Z)
94 : -INC CCOPTIO
95 : *
96 : SEGMENT WRK0
97 : REAL*8 XMAT(NCXMAT)
98 : ENDSEGMENT
99 : *
100 : SEGMENT WR00
101 : CHARACTER*16 TYMAT(NCXMAT)
102 : REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
103 : ENDSEGMENT
104 : *
105 : SEGMENT WRK1
106 : REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
107 : REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
108 : REAL*8 DEFP(NSTRS),XCAR(ICARA)
109 : ENDSEGMENT
110 : *
111 : SEGMENT WRK5
112 : REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
113 : ENDSEGMENT
114 : *
115 : SEGMENT WRK7
116 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
117 : ENDSEGMENT
118 : *
119 : SEGMENT WRK8
120 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
121 : REAL*8 DDINVp(NSTRS1,NSTRS1)
122 : ENDSEGMENT
123 : *
124 : SEGMENT WRK9
125 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
126 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
127 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
128 : REAL*8 SIGY(NSIGY)
129 : INTEGER NKX(NNKX)
130 : ENDSEGMENT
131 : *
132 : SEGMENT WTRAV
133 : REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
134 : REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
135 : REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
136 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM)
137 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
138 : ENDSEGMENT
139 : *
140 : DIMENSION VAR(100),VAR1(100),VARP1(100),VARP2(100)
141 : DIMENSION CRIGI(12),VARP12(100),VAR12(100),VARP3(100)
142 : DIMENSION VARP4(100),VAR13(100),VARP5(100)
143 : *
144 : C#MC 21/01/99 : les tableaux doivent dimensionnes en fonction
145 : C du plus grand INFELE(16) (voir elquoi.eso)
146 : DIMENSION SIG(8),SIG1(8),SIG12(8),SIG13(8),SIG15(8)
147 : DIMENSION DSPT(8),EPSTHD(8),XX(8),SIGP5(8)
148 : DIMENSION EVP1(8),EVP2(8),XPM1(8),XPM2(8),EVP3(8),EVP4(8)
149 : DIMENSION XPM3(8),XPM4(8)
150 : DIMENSION SIGP1(8),SIGP2(8), SIGP3(8), SIGP4(8),EVP5(8)
151 : DIMENSION EPSV(8),EPSV1(8),EPSCP(8),EPSV12(8),EPSV13(8)
152 : *
153 : CHARACTER*8 CMATE
154 : logical dtlibr,impre
155 : precis = precas
156 : C
157 : *
158 : dtlibr=.TRUE.
159 : IF (INPLAS.EQ.29) THEN
160 : C Test sur l'identite de toutes les listes de temperatures des coefficients
161 : C intervenant dans les lois d'evolutions non-lineaires des variables internes
161 : CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
162 : & YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
163 : ENDIF
164 : KERRE = 0
165 : IF(MFR.NE.1.AND.MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.17
166 : & .AND.MFR.NE.33)THEN
167 : KERRE = 99
168 : RETURN
169 : ENDIF
170 : *
171 : * AM 5/5/00 MFR = 33 : MODELES 19 A 24 pour le moment
172 : *
173 : IF(MFR.EQ.33) THEN
174 : IF(INPLAS.LT.19.OR.INPLAS.GT.24) THEN
175 : KERRE = 99
176 : RETURN
177 : ENDIF
178 : ENDIF
179 : *
180 : IF(MFR.EQ.3) THEN
181 : THICK = XCAR(1)
182 : ALFA = XCAR(2)
183 : ENDIF
184 : * dtprem=0.D0
185 : * dtdeux=0.d0
186 : dtleft= dt
187 : BORNE = 2.0
188 : RMAX = 1.3
189 : RMIN = 0.7
190 : DIV = 7.0
191 : FAC = 3.0
192 : TLIFE = -1.D0
193 : CCC Eloi
194 : CCC Pour etre en harmonie avec l'appel de INCRE1 par CCONST
195 : FI1 = 0.D0
196 : FITAU = 0.D0
197 : TTAU = 0.D0
198 : C
199 : C CALCUL DES INCREMENTS DE DEFORMATIONS
200 : C
201 : IF (INPLAS.NE.29) THEN
201 : CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
202 : 1 VALCAR,N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
203 : 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
204 : 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
205 : *
206 : IF(IRTD.NE.1) THEN
207 : KERRE=69
208 : GOTO 998
209 : ENDIF
210 : *
211 : ENDIF
212 : IF(MFR.EQ.3) THEN
213 : DO 10 I=1,NSTRS/2
214 : SIG0( I) = SIG0( I)/THICK
215 : SIG0(NSTRS/2+I) = SIG0(NSTRS/2+I)*6.0D0/THICK/THICK
216 : IF (INPLAS.NE.29) THEN
217 : DSIGT( I) = DSIGT( I)/THICK
218 : DSIGT(NSTRS/2+I)= DSIGT(NSTRS/2+I)*6.0D0/THICK/THICK
219 : ELSE
220 : DEPST( I) = DEPST( I)
221 : DEPST(NSTRS/2+I)= -DEPST(NSTRS/2+I)*THICK/2
222 : ENDIF
223 : 10 CONTINUE
224 : IF(IFOURB.EQ.-2) THEN
225 : SIG0 (2) =0.0
226 : SIG0 (4) =0.0
227 : IF (INPLAS.NE.29) THEN
228 : DSIGT(2) =0.0
229 : DSIGT(4) =0.0
230 : ENDIF
231 : ENDIF
232 : ENDIF
233 : C
234 : C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
235 : C L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
236 : C
237 : IF(MFR.EQ.17) THEN
238 : SIG0( 2) = 0.0D0
239 : SIG0( 3) = 0.0D0
240 : SIG0( 4) = 0.0D0
241 : SIG0( 5) = 0.0D0
242 : ENDIF
243 : C
244 : C------------------------------------------
245 : C CONTROLE DE LA COHERENCE DES ENTREES
246 : C------------------------------------------
247 : IF (DT.LT.0.0) KERRE = 414
248 : IF (INPLAS.EQ.63.AND.MFR.NE.1) THEN
249 : KERRE=99
250 : RETURN
251 : ENDIF
252 : IF(DT.EQ.0.0) DT = 1.e-20
253 : MOTERR(1:8) = ' CONST '
254 : IF(INPLAS.NE.17) GO TO 20
255 : IF ((NVARI.NE.(6+4*NSTRS)).AND.(MFR.NE.5)) KERRE = 146
256 : IF ((NVARI.NE.(10+4*NSTRS)).AND.(MFR.EQ.5)) KERRE = 146
257 : IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
258 : IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
259 : XMAX=XMAT(8)
260 : GO TO 30
261 : 20 CONTINUE
262 :
263 : IF(MFR.NE.33) THEN
264 :
265 : IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
266 : IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
267 : IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
268 : IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
269 : IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
270 : IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
271 : IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
272 : IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
273 : IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
274 : IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
275 : IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
276 : IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
277 : IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
278 : IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
279 : IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
280 : IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
281 : IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
282 : IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
283 : IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
284 : IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
285 : IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
286 : IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
287 : IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
288 : IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
289 : IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
290 : IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
291 : IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
292 : IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
293 : IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
294 : IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
295 : IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
296 : IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
297 : IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
298 : IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
299 : IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
300 : IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
301 : IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
302 : IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
303 : IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
304 : IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
305 : IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
306 : IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
307 :
308 : ELSE
309 : *
310 : * cas MFR=33
311 : *
312 :
313 : IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
314 : IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
315 : IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
316 : IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
317 : IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
318 : IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
319 : IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
320 : IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
321 : IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
322 : IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
323 : IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
324 : IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
325 :
326 :
327 : ENDIF
328 :
329 :
330 : IF(IFOURB.EQ.1) THEN
331 : KERRE = 194
332 : MOTERR(1:8) = 'FLUAGE'
333 : ENDIF
334 : XMAX=XMAT(5)
335 : IF((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
336 : IF((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
337 : IF(INPLAS.EQ.70) XMAX =XMAT(1)*1.D-3
338 : IF(INPLAS.EQ.29) THEN
338 : CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
339 : ENDIF
340 : *
341 : * TEST SUR XMAX MILL 8/3/91
342 : *
343 : IF (XMAX.EQ.0.D0) THEN
344 : IF(INPLAS.EQ.29) THEN
344 : CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
345 : XMAX=XMAX*1.D-3
346 : ELSE
347 : XMAX=XMAT(1)*1.D-3
348 : ENDIF
349 : ENDIF
350 : *
351 : 30 CONTINUE
352 : C
353 : C-----------------------------
354 : IF (KERRE.NE.0) THEN
355 : GOTO 999
356 : ENDIF
357 :
358 : C
359 : C===========================================================
360 : C A PARTIR DE MAINTENANT, LES DEFORMATIONS
361 : C DE CISAILLEMENT NE SONT PLUS
362 : C DEFINIES PAR DES GAMA.
363 : C ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
364 : C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
365 : C DE LEMAITRE (INPLAS=29).
366 : C
367 : C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
368 : C MFR=1 (MASSIF)
369 : C MFR=5 (COQUES EPAISSES)
370 : C MFR=3 (COQUES MINCES)
371 : C MFR=17 (TUYAUX FISSURES)
372 : C MFR=33 (POREUX)
373 : C
374 : IF (INPLAS.NE.29) THEN
375 : C
376 : C Cas de la formulation massive
377 : C Les termes de cisaillement apparaissent
378 : C au delà de la troisieme composante
379 : C
380 : IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
381 : DO 11 I=4,NSTRS
382 : EPIN0(I)=EPIN0(I)/2d0
383 : 11 CONTINUE
384 : C
385 : C Cas des coques épaisses
386 : C Les termes de cisaillement apparaissent
387 : C au delà de la deuxieme composante
388 : C
389 : ELSE IF (MFR.EQ.5) THEN
390 : DO 12 I=3,NSTRS
391 : EPIN0(I)=EPIN0(I)/2d0
392 : 12 CONTINUE
393 : C
394 : C Cas des coques minces
395 : C Les termes de cisaillement apparaissent
396 : C pour la troisieme et la sixieme composante
397 : C uniquement dans les cas de calculs
398 : C tridimensionnels ou d'analyse de Fourier
399 : C
400 : ELSE IF (MFR.EQ.3) THEN
401 : IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
402 : EPIN0(3)=EPIN0(3)/2d0
403 : EPIN0(6)=EPIN0(6)/2d0
404 : ENDIF
405 : C
406 : C Reste le cas des tuyaux fissurés (MFR=17)
407 : C
408 : ENDIF
409 : ENDIF
410 : C
411 : C===========================================================
412 : C
413 : C ----------------
414 : C INITIALISATION
415 : C ----------------
416 : ITERO = 0
417 : 6543 CONTINUE
418 :
419 : itero = 1 + itero
420 : if( itero.ne.1) THEN
421 : c write(6,*) 'itero ib igau', itero,ib,igau
422 : dtlibr = .true.
423 : precis = precis * 7.
424 : * write(6,*) ' precision modifiée ', precis
425 : if( itero. gt . 3) then
426 : **** kerre = 460
427 : kerre = 268
428 : return
429 : endif
430 : endif
431 : DTLEFT = DT
432 : TAU = DTLEFT
433 : TI0=T0
434 : TI1=TF
435 : TPOINT=(TF-T0)/DT
436 : ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS))
437 : ERRABS = PRECIS*ASIG
438 : IF (XMAX.GT.ASIG) ERRABS = PRECIS*XMAX
439 : DO 40 I=1,NSTRS
440 : SIG(I) = SIG0(I)
441 : EPSV(I) = EPIN0(I)
442 : IF (INPLAS.NE.29) DSPT(I) = DSIGT(I)/DT
443 : 40 CONTINUE
444 : *
445 : * iter=0
446 : * if( .NOT.DTLIBR) THEN
447 : * dtminl = ( dt * 1.001 ) / msopua
448 : * r = dtseco / dtprem
449 : * 1245 continue
450 : * iter=iter+1
451 : ** if ( abs ( 1.- R) . gt. 0.001 ) then
452 : * bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
453 : * else
454 : * r = 1.d0
455 : * bb = dtprem * ( msoupa - 10)
456 : * endif
457 : * tau = dtprem * dt / bb * 1.0001
458 : * write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
459 : * if(bb . lt . dt/1.2) THEN
460 : * if( iter.lt.15) then
461 : * r = r + abs ( 1. - r ) / 10.
462 : * else
463 : * kerre = 460
464 : * return
465 : * endif
466 : * go to 1245
467 : * endif
468 : * 1234 format ('it pr se de r b t ta',i2, 7e9.3)
469 : *
470 : * dtx = dt * 1.00001;
471 : * write(6,*) 'avpremdeux r', dtprem,dtdeux,r
471 : * call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
472 : * $ ,xdf,dtx)
473 : * write(6,*) 'xde xdf de r',xde,xdf,r
474 : * tau = xde / r
475 : *
476 : * endif
477 : C
478 : IF (INPLAS.EQ.29) THEN
479 : C
480 : C================================================
481 : C Calcul de l increment de deformation totale reel.
482 : C On enleve donc tous les termes qui correspondent
483 : C a l influence de la temperature et de
484 : C l endommagement (travail inverse de ce qui est
485 : C fait dans le procedure increme).
486 : C================================================
487 : C
488 : ********* materiau dependant de la temperature ***********************
488 : CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
488 : CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
489 : XMAT(1)=YUNG0
490 : XMAT(2)=ENU0
491 : C------------------------------------------------
492 : C Calcul de la matrice de Hooke inverse DD a t=t0
493 : C------------------------------------------------
493 : CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,
494 : & ENUV0,XCAR,ICARA,MFR,NSTRS,DD,DDV,KERRE,2,ITHHER)
495 : C
496 : ********* materiau dependant de la temperature ***********************
496 : CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
496 : CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
497 : XMAT(1)=YUNG1
498 : XMAT(2)=ENU1
499 : C---------------------------------------------------
500 : C Calcul de la matrice de Hooke inverse DDINV a T=TF
501 : C---------------------------------------------------
501 : CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,
502 : & ENUV1,XCAR,ICARA,MFR,NSTRS,DDINV,DDV,KERRE,2,ITHHER)
503 : ***********************************************************************
504 : C
504 : CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
504 : CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
505 : CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
506 : C
507 : C
507 : CALL ZDANUL(DSPT,NSTRS)
508 : AA=1.D0
509 : DO 45 I=1,NSTRS
510 : DSPT(I)=DEPST(I)
511 : IF (I.GT.3) AA=0.D0
512 : DO 46 J=1,NSTRS
513 : DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
514 : DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
515 : 46 CONTINUE
516 : DSPT(I)=DSPT(I)-(AA*CTEPS)
517 : DSPT(I)=DSPT(I)/DT
518 : 45 CONTINUE
519 : ENDIF
520 : DO 48 I=1,NVARI
521 : 48 VAR(I)=VAR0(I)
522 : C
523 : C ---------------------------------------------------------------------
524 : INV = 0
525 : NSSINC = 0
526 : nitera=0
527 : C ---------------------------------------------------------------------
528 : C DEBUT DES ITERATIONS EN SSINCREMENTS /FIN SI DTLEFT = 0
529 : C ---------------------------------------------------------------------
530 : 70 NSSINC = NSSINC + 1
531 : IF (NSSINC.GT.msoupa) THEN
532 : DTLIBR=.FALSE.
533 : GO TO 6543
534 : * GOTO 999
535 : ENDIF
536 : C
537 : C---------------------------------------------------------------------
538 : C START OF CALCULATIONS
539 : C_____________________________________________________________________
540 : IF (MFR.EQ.17.AND.INPLAS.NE.19) GO TO 999
541 : IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.17) THEN
541 : CALL XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS,NVARI,
542 : & NCOMAT,MFR)
543 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.((INPLAS.GE.19.AND.
544 : & INPLAS.LE.24).OR.INPLAS.EQ.61)) THEN
544 : CALL INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
545 : & INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
546 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.25) THEN
546 : CALL INCRE2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
547 : & NVARI,NCOMAT)
548 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.76) THEN
548 : CALL INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
549 : & NVARI,NCOMAT)
550 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.77) THEN
550 : CALL INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
551 : & NVARI,NCOMAT)
552 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.53) THEN
552 : CALL INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
553 : & NVARI,NCOMAT)
554 : ELSE IF(MFR.NE.3.AND.INPLAS.EQ.63) THEN
554 : CALL INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS,MFR,
555 : & NVARI,NCOMAT,IFOURB)
556 : ELSE IF(MFR.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
557 : & .OR.INPLAS.EQ.61)) THEN
557 : CALL INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS,
558 : & NVARI,INPLAS,NCOMAT)
559 : ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.25) THEN
559 : CALL INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
560 : & ,NVARI,NCOMAT)
561 : ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.76) THEN
561 : CALL INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
562 : & ,NVARI,NCOMAT)
563 : ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.77) THEN
563 : CALL INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
564 : & ,NVARI,NCOMAT)
565 : ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.53) THEN
565 : CALL INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS,
566 : & NVARI,NCOMAT)
567 : ELSE IF (MFR.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
568 : & OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
568 : CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS,NVARI,
569 : & EVP1,VARP1,TAU)
570 : ELSE IF(MFR.NE.3.AND.INPLAS.EQ.70) THEN
570 : CALL INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS,
571 : & MFR,NVARI,NCOMAT)
572 : C
573 : ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.29) THEN
574 : if (nssinc.eq.1) then
575 : C
576 : C-----------------------------------------------------------
577 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
578 : C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
579 : C-----------------------------------------------------------
579 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
580 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
581 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI0,
582 : & TINF,TSUP,ITEST,TRUC,NCOURB)
583 : C
584 : IF (ITHHER.EQ.2) THEN
585 : C********** materiau dependant de la temperature **********************
586 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
586 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
587 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
588 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
589 : & TO,TO,ITEST,TRUC,NCOURB)
590 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
590 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
591 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
592 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
593 : & TO,TO,ITEST,TRUC,NCOURB)
594 : C**********************************************************************
595 : ENDIF
596 : C--------------------------------------------------------------
597 : C Calcul de la derivee de la dilatation thermique /temps a t=t0
598 : C--------------------------------------------------------------
598 : CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
598 : CALL ZDANUL(EPSTHD,NSTRS)
599 : CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
600 : DO 47 I=1,3
601 : 47 EPSTHD(I)=CTH
602 : C
602 : CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,
603 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
604 : & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
605 : & 2,TI0,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
605 : CALL ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
606 : & XMAT,NCOMAT,TI0,TAUX,TRUC,NCOURB)
607 : else
608 : do i=1,nstrs
609 : sigp1(i)=sigp4(i)
610 : evp1(i)=evp4(i)
611 : enddo
612 : do i=1,nvari
613 : varp1(i)=varp4(i)
614 : enddo
615 : endif
616 : ELSE IF(MFR.EQ.17.AND.INPLAS.EQ.19) THEN
616 : CALL TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCAR,EVP1,VARP1,NSTRS,
617 : & NVARI,INPLAS,NCOMAT,KERREU1)
618 : ELSE IF(MFR.EQ.1.AND.INPLAS.EQ.44) THEN
618 : CALL POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
619 : & NCOMAT,KERRE)
620 : ELSE IF(MFR.EQ.1.AND.INPLAS.EQ.45) THEN
620 : CALL POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
621 : & NCOMAT,KERRE)
622 : ENDIF
623 : C
624 : NITERA = 0
625 : C --------------------------------------------------------------------
626 : C DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
627 : C --------------------------------------------------------------------
628 : 80 NITERA = NITERA + 1
629 : IF(MFR.EQ.3) GO TO 150
630 : IF(MFR.EQ.17) GO TO 210
631 : IF(INPLAS.EQ.17) THEN
632 : tau2=tau*0.5d0
632 : CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
633 : & XPM1,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
634 : & MFR)
634 : CALL XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS,
635 : & NVARI,NCOMAT,MFR)
636 : DO 90 I=1,NSTRS
637 : EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
638 : XPM2(I) = 0.5*(XPM1(I)+XPM2(I))
639 : 90 CONTINUE
640 : DO 100 I=1,4+NSTRS
641 : 100 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
641 : CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
642 : & XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
643 : & MFR)
643 : CALL XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS,
644 : & NVARI,NCOMAT,MFR)
644 : CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
645 : $ ,EVP3,VARP3,XPM3,DSPT,XMAT,NSTRS,NVARI,NCOMAT
646 : & ,IFOURB,IVTEST,MFR)
646 : CALL XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS,
647 : & NVARI,NCOMAT,MFR)
648 : DO I=1,NSTRS
649 : EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
650 : XPM4(I) = 0.5*(XPM3(I)+XPM4(I))
651 : enddo
652 : DO I=1,4+NSTRS
653 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
654 : enddo
654 : CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
655 : $ ,EVP4,VARP4,XPM4,DSPT,XMAT,NSTRS,NVARI,NCOMAT
656 : & ,IFOURB,IVTEST,MFR)
656 : CALL XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS,
657 : & NVARI,NCOMAT,MFR)
658 : DO I=1,NSTRS
659 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
660 : XPM2(I) = (XPM1(I)+XPM4(I))/6d0+XPM3(I)*2d0/3d0
661 : enddo
662 : DO I=1,4+NSTRS
663 : VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
664 : enddo
664 : CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
665 : $ ,EVP2,VARP2,XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT
666 : & ,IFOURB,IVTEST,MFR)
667 : C---------
668 : ELSE IF(INPLAS.EQ.44) THEN
669 : tau2=tau*0.5d0
669 : CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
670 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
670 : CALL POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
671 : & NCOMAT,KERRE)
672 : DO 105 I=1,NSTRS
673 : EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
674 : 105 CONTINUE
675 : VARP2(1) = 0.5*(VARP1(1)+VARP2(1))
675 : CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
676 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
676 : CALL POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
677 : & NCOMAT,KERRE)
677 : CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
678 : $ ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
678 : CALL POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
679 : & NCOMAT,KERRE)
680 : DO I=1,NSTRS
681 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
682 : enddo
683 : VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
683 : CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
684 : $ ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
684 : CALL POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
685 : & NCOMAT,KERRE)
686 : DO I=1,NSTRS
687 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
688 : enddo
689 : VARP2(1) = (VARP1(1)+VARP4(1))/6d0+VARP3(1)*2d0/3d0
689 : CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
690 : $ ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
691 : C---------
692 : ELSE IF(INPLAS.EQ.45) THEN
693 : tau2=tau*0.5d0
693 : CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
694 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
694 : CALL POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
695 : & NCOMAT,KERRE)
696 : DO 106 I=1,NSTRS
697 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
698 : 106 CONTINUE
699 : VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
699 : CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
700 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
701 : C---------
702 : C CALCUL DE LA TAILLE DE GRAIN
703 : C---------
703 : CALL GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS,
704 : & NVARI,KERRE)
705 : c
705 : CALL POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
706 : & NCOMAT,KERRE)
706 : CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13
707 : & ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
707 : CALL POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
708 : & NCOMAT,KERRE)
709 : DO I=1,NSTRS
710 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
711 : enddo
712 : VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
712 : CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
713 : & ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
713 : CALL POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
714 : & NCOMAT,KERRE)
715 : DO I=1,NSTRS
716 : EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
717 : enddo
718 : VARP2(1) =(VARP1(1)+VARP2(1))/6d0+VARP3(1)*2d0/3d0
718 : CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
719 : & ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
720 : C---------
721 : C CALCUL DE LA TAILLE DE GRAIN
722 : C---------
722 : CALL GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS,
723 : & NVARI,KERRE)
724 : C---------
725 : ELSE IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
726 : & )THEN
727 : tau2=tau*0.5d0
727 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
728 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
728 : CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
729 : & INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
730 : DO 110 I=1,NSTRS
731 : 110 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
732 : IF(INPLAS.EQ.24) THEN
733 : DO 115 I=1,NVARI
734 : 115 VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
735 : ELSE
736 : DO 120 I=1,2*NSTRS+2
737 : 120 VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
738 : DO 130 I=2*NSTRS+4,NVARI
739 : 130 VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
740 : ENDIF
740 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
741 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
741 : CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,
742 : & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
742 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
743 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
743 : CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,
744 : & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
745 : DO I=1,NSTRS
746 : EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
747 : enddo
748 : IF(INPLAS.EQ.24) THEN
749 : DO I=1,NVARI
750 : VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
751 : enddo
752 : ELSE
753 : DO I=1,2*NSTRS+2
754 : VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
755 : enddo
756 : DO I=2*NSTRS+4,NVARI
757 : VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
758 : enddo
759 : ENDIF
759 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
760 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
760 : CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,
761 : & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
762 : DO I=1,NSTRS
763 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
764 : enddo
765 : IF(INPLAS.EQ.24) THEN
766 : DO I=1,NVARI
767 : VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
768 : enddo
769 : ELSE
770 : DO I=1,2*NSTRS+2
771 : VARP2(I)=(VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
772 : enddo
773 : DO I=2*NSTRS+4,NVARI
774 : VARP2(I)= (VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
775 : enddo
776 : ENDIF
776 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
777 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
778 : C---------
779 : ELSE IF(INPLAS.EQ.25) THEN
780 : tau2=tau*0.5d0
780 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
781 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
781 : CALL INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
782 : & NCOMAT)
783 : DO 135 I=1,NSTRS
784 : 135 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
785 : DO 140 I=1,NVARI
786 : 140 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
786 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
787 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
787 : CALL INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
788 : & NCOMAT)
788 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
789 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
789 : CALL INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
790 : & NCOMAT)
791 : DO I=1,NSTRS
792 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
793 : enddo
794 : DO I=1,NVARI
795 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
796 : enddo
796 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
797 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
797 : CALL INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
798 : & NCOMAT)
799 : DO I=1,NSTRS
800 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
801 : enddo
802 : DO I=1,NVARI
803 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
804 : enddo
804 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
805 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
806 : C---------
807 : ELSE IF(INPLAS.EQ.76) THEN
808 : tau2=tau*0.5d0
808 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
809 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
809 : CALL INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
810 : & NCOMAT)
811 : DO 1135 I=1,NSTRS
812 : 1135 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
813 : DO 1140 I=1,NVARI
814 : 1140 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
814 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
815 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
815 : CALL INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
816 : & NCOMAT)
816 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
817 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
817 : CALL INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
818 : & NCOMAT)
819 : DO I=1,NSTRS
820 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
821 : enddo
822 : DO I=1,NVARI
823 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
824 : enddo
824 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
825 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
825 : CALL INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
826 : & NCOMAT)
827 : DO I=1,NSTRS
828 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
829 : enddo
830 : DO I=1,NVARI
831 : VARP2(I) = (VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
832 : enddo
832 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
833 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
834 : C---------
835 : ELSE IF(INPLAS.EQ.77) THEN
836 : tau2=tau*0.5d0
836 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
837 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
837 : CALL INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
838 : & NCOMAT)
839 : DO I=1,NSTRS
840 : EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
841 : enddo
842 : DO I=1,NVARI
843 : VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
844 : enddo
844 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
845 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
845 : CALL INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
846 : & NCOMAT)
846 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
847 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
847 : CALL INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
848 : & NCOMAT)
849 : DO I=1,NSTRS
850 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
851 : enddo
852 : DO I=1,NVARI
853 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
854 : enddo
854 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
855 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
855 : CALL INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
856 : & NCOMAT)
857 : DO I=1,NSTRS
858 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
859 : enddo
860 : DO I=1,NVARI
861 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
862 : enddo
862 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
863 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
864 : C---------
865 : ELSE IF(INPLAS.EQ.53) THEN
866 : tau2=tau*0.5d0
866 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
867 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
868 :
868 : CALL INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,
869 : & NVARI,NCOMAT)
870 : DO 137 I=1,NSTRS
871 : 137 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
872 : DO 141 I=1,NVARI
873 : 141 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
873 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
874 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
874 : CALL INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,
875 : & NVARI,NCOMAT)
875 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
876 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
876 : CALL INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,
877 : & NVARI,NCOMAT)
878 : DO I=1,NSTRS
879 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
880 : enddo
881 : DO I=1,NVARI
882 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
883 : enddo
883 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
884 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
884 : CALL INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,
885 : & NVARI,NCOMAT)
886 : DO I=1,NSTRS
887 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
888 : enddo
889 : DO I=1,NVARI
890 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
891 : enddo
891 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
892 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
893 : C---------
894 : ELSE IF(INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84
895 : & .OR.INPLAS.EQ.102) THEN
896 : tau2=tau*0.5d0
896 : CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
897 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
898 : & MFR)
898 : CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS,NVARI
899 : & ,EVP2,VARP2,TAU2)
900 :
901 : DO 739 I=1,NSTRS
902 : 739 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
903 : DO 741 I=1,NVARI
904 : 741 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
905 : C >>>> SI JE SUIS SUR LE PREMIER PAS <<<<
906 : C et que j'ai calcule le resultat a la main
907 : C _________________________________________
908 : IF (VAR(12).GT.1.) THEN
909 :
910 : DO 788 I=1,NVARI
911 : 788 VARP2(I) = VARP1(I)
912 : DO 737 I=1,NSTRS
913 : EVP2(I) = EVP1(I)
914 : 737 CONTINUE
915 : ENDIF
916 :
916 : CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
917 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
917 : CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,
918 : $ NSTRS,NVARI,EVP3,VARP3,TAU2)
918 : CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,
919 : $ DSPT,EVP3,
920 : & VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
920 : CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,
921 : $ NSTRS,NVARI,EVP4,VARP4,TAU2)
922 : C print*,'==>4',VARP4(2),VARP4(3)
923 : DO I=1,NSTRS
924 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
925 : enddo
926 : c
927 : DO I=1,NVARI
928 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
929 : enddo
929 : CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,
930 : $ DSPT,EVP4,
931 : & VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
931 : CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,
932 : $ NSTRS,NVARI,EVP4,VARP4,TAU2)
933 : DO I=1,NSTRS
934 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
935 : enddo
936 : c
937 : DO I=1,NVARI
938 : VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
939 : enddo
940 : C print*,'==>5',VARP2(2),VARP2(3)
940 : CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,
941 : $ DSPT,EVP2,
942 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
943 : C---------
944 : ELSE IF(INPLAS.EQ.63) THEN
945 : tau2=tau*0.5d0
945 : CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
946 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
947 : & MFR)
947 : CALL INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS,MFR,
948 : & NVARI,NCOMAT,IFOURB)
949 : DO 138 I=1,NSTRS
950 : 138 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
951 : DO 142 I=1,NVARI
952 : 142 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
952 : CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
953 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
953 : CALL INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS,MFR,
954 : & NVARI,NCOMAT,IFOURB)
954 : CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
955 : $ ,DSPT,EVP3,
956 : & VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
956 : CALL INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
957 : & NVARI,NCOMAT,IFOURB)
958 : DO I=1,NSTRS
959 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
960 : enddo
961 : DO I=1,NVARI
962 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
963 : enddo
963 : CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
964 : $ ,DSPT,EVP4,
965 : & VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
965 : CALL INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
966 : & NVARI,NCOMAT,IFOURB)
967 : DO I=1,NSTRS
968 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
969 : enddo
970 : DO I=1,NVARI
971 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
972 : enddo
972 : CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
973 : $ ,DSPT,EVP2,
974 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
975 : C--------
976 : ELSE IF(INPLAS.EQ.70) THEN
977 : tau2=tau*0.5d0
977 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
978 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
979 : t12=(t0+tf)*0.5d0
979 : CALL INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS,MFR,
980 : & NVARI,NCOMAT)
981 : C
982 : DO 177 I=1,NSTRS
983 : 177 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
984 : DO 178 I=1,NVARI
985 : 178 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
985 : CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
986 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
986 : CALL INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS,MFR,
987 : & NVARI,NCOMAT)
987 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
988 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
988 : CALL INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
989 : & NVARI,NCOMAT)
990 : DO I=1,NSTRS
991 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
992 : enddo
993 : DO I=1,NVARI
994 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
995 : enddo
995 : CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
996 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
996 : CALL INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
997 : & NVARI,NCOMAT)
998 : DO I=1,NSTRS
999 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1000 : enddo
1001 : DO I=1,NVARI
1002 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1003 : enddo
1003 : CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
1004 : & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
1005 : C---------
1006 : ELSE IF(INPLAS.EQ.29) THEN
1007 :
1008 : 143 TAU2=TAU/2.D0
1008 : CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
1009 : & VARP1,NSTRS,NVARI)
1010 : C
1011 : C-----------------------------------------------------------
1012 : C Mise a jour eventuelle de la nouvelle temperature TI1
1013 : C-----------------------------------------------------------
1014 : C
1015 : DELTAT=TPOINT*TAU2
1016 : TI12=TI0+DELTAT
1017 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
1018 : C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
1019 : C-----------------------------------------------------------
1019 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1020 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1021 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI12,
1022 : & TINF,TSUP,ITEST,TRUC,NCOURB)
1023 : C
1024 : IF (ITHHER.EQ.2) THEN
1025 : C********** materiau dependant de la temperature **********************
1026 : C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
1026 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1027 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1028 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
1029 : & TO,TO,ITEST,TRUC,NCOURB)
1030 : C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
1030 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1031 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1032 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
1033 : & TO,TO,ITEST,TRUC,NCOURB)
1034 : C**********************************************************************
1035 : ENDIF
1036 : C------------------------------------------------------------------
1037 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
1038 : C------------------------------------------------------------------
1038 : CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
1038 : CALL ZDANUL(EPSTHD,NSTRS)
1039 : CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
1040 : DO 136 I=1,3
1041 : 136 EPSTHD(I)=CTH
1042 : C
1042 : CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
1043 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
1044 : & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
1045 : & 2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
1046 : C
1047 : do 1360 i=1,nstrs
1048 : sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
1049 : evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
1050 : 1360 continue
1051 : do 1361 i=1,nvari
1052 : varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
1053 : 1361 continue
1054 : t=tau2
1054 : CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,
1055 : & EVP2, VARP2,NSTRS,NVARI)
1056 : if (tau2.ne.t)then
1057 : tau=2d0*tau2
1058 : goto 143
1059 : endif
1060 :
1061 : C
1061 : CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
1062 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
1063 : & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
1064 : & 2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
1065 :
1065 : CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,SIGP3,
1066 : & EVP3, VARP3,NSTRS,NVARI)
1067 : DELTAT=TPOINT*TAU
1068 : TI1=TI0+DELTAT
1069 : C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
1070 : C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
1071 : C-----------------------------------------------------------
1071 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1072 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1073 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI1,
1074 : & TINF,TSUP,ITEST,TRUC,NCOURB)
1075 : IF (ITHHER.EQ.2) THEN
1076 : C********** materiau dependant de la temperature **********************
1077 : C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
1077 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1078 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1079 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
1080 : & TO,TO,ITEST,TRUC,NCOURB)
1081 : C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
1081 : CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
1082 : & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
1083 : & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
1084 : & TO,TO,ITEST,TRUC,NCOURB)
1085 : C**********************************************************************
1086 : ENDIF
1087 : C------------------------------------------------------------------
1088 : C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
1089 : C------------------------------------------------------------------
1089 : CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
1089 : CALL ZDANUL(EPSTHD,NSTRS)
1090 : CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
1091 : DO 1362 I=1,3
1092 : 1362 EPSTHD(I)=CTH
1093 : C
1093 : CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1094 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
1095 : & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
1096 : & 2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
1097 :
1098 : do 1363 i=1,nstrs
1099 : sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
1100 : evp4(i) =0.5D0*( evp4(i)+ evp3(i))
1101 : 1363 continue
1102 : do 1364 i=1,nvari
1103 : varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
1104 : 1364 continue
1104 : call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
1105 : & EVP4, VARP4,NSTRS,NVARI)
1106 :
1106 : CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
1107 : & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
1108 : & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
1109 : & 2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
1110 : DO 145 I=1,NSTRS
1111 : EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
1112 : SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
1113 : 145 CONTINUE
1114 : DO 148 I=1,NVARI
1115 : 148 VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
1116 : T=TAU
1116 : CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
1117 : & VARP2,NSTRS,NVARI)
1118 : c IF (TAU.NE.T) GOTO 143
1119 : ENDIF
1120 : GO TO 250
1121 : C _____________________________________________________________________
1122 : 150 CONTINUE
1123 : C----------------------------------------------------------------------
1124 : C CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
1125 : C----------------------------------------------------------------------
1126 : IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
1127 : & ) THEN
1128 : tau2=tau*0.5d0
1128 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
1129 : & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1129 : CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
1130 : & NSTRS,NVARI,INPLAS,NCOMAT)
1131 : DO 160 I=1,NSTRS,1
1132 : 160 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1133 : IF(INPLAS.EQ.24) THEN
1134 : DO 165 I=1,NVARI
1135 : 165 VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
1136 : ELSE
1137 : DO 170 I=1,2*NSTRS+2
1138 : 170 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1139 : DO 180 I=2*NSTRS+4,NVARI
1140 : 180 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1141 : ENDIF
1141 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
1142 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1142 : CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
1143 : & NSTRS,NVARI,INPLAS,NCOMAT)
1143 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1144 : $ ,DSPT,
1145 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1145 : CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
1146 : & NSTRS,NVARI,INPLAS,NCOMAT)
1147 : DO I=1,NSTRS,1
1148 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1149 : enddo
1150 : IF(INPLAS.EQ.24) THEN
1151 : DO I=1,NVARI
1152 : VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
1153 : enddo
1154 : ELSE
1155 : DO I=1,2*NSTRS+2
1156 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1157 : enddo
1158 : DO I=2*NSTRS+4,NVARI
1159 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1160 : enddo
1161 : ENDIF
1161 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
1162 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1162 : CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
1163 : & NSTRS,NVARI,INPLAS,NCOMAT)
1164 : DO I=1,NSTRS,1
1165 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1166 : enddo
1167 : IF(INPLAS.EQ.24) THEN
1168 : DO I=1,NVARI
1169 : VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1170 : enddo
1171 : ELSE
1172 : DO I=1,2*NSTRS+2
1173 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1174 : enddo
1175 : DO I=2*NSTRS+4,NVARI
1176 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1177 : enddo
1178 : endif
1178 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,
1179 : & EVP2,VARp2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1180 : C---------
1181 : ELSE IF(INPLAS.EQ.25) THEN
1182 : tau2=tau*0.5d0
1182 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1183 : & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1183 : CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
1184 : & NVARI,NCOMAT)
1185 : DO 190 I=1,NSTRS
1186 : 190 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
1187 : DO 195 I=1,NVARI
1188 : 195 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
1188 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
1189 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1189 : CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
1190 : & NVARI,NCOMAT)
1190 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1191 : $ ,DSPT,
1192 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1192 : CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
1193 : & NVARI,NCOMAT)
1194 : DO I=1,NSTRS
1195 : EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
1196 : enddo
1197 : DO I=1,NVARI
1198 : VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
1199 : enddo
1199 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
1200 : $ ,DSPT,
1201 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1201 : CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
1202 : & NVARI,NCOMAT)
1203 : DO I=1,NSTRS
1204 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1205 : enddo
1206 : DO I=1,NVARI
1207 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1208 : enddo
1208 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
1209 : $ ,DSPT,
1210 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1211 : C---------
1212 : ELSE IF(INPLAS.EQ.76) THEN
1213 : tua2=tau*0.5d0
1213 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1214 : & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1214 : CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
1215 : & NVARI,NCOMAT)
1216 : DO 1190 I=1,NSTRS
1217 : 1190 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
1218 : DO 1195 I=1,NVARI
1219 : 1195 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
1219 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
1220 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1220 : CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
1221 : & NVARI,NCOMAT)
1221 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1222 : $ ,DSPT,
1223 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1223 : CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
1224 : & NVARI,NCOMAT)
1225 : DO I=1,NSTRS
1226 : EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
1227 : enddo
1228 : DO I=1,NVARI
1229 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
1230 : enddo
1230 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
1231 : $ ,DSPT,
1232 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1233 : DO I=1,NSTRS
1234 : EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1235 : enddo
1236 : DO I=1,NVARI
1237 : VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1238 : enddo
1239 : C---------
1240 : ELSE IF(INPLAS.EQ.77) THEN
1241 : tau2=tau*0.5d0
1241 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1242 : & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1242 : CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
1243 : & NVARI,NCOMAT)
1244 : DO 2190 I=1,NSTRS
1245 : 2190 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
1246 : DO 2195 I=1,NVARI
1247 : 2195 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
1247 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
1248 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1248 : CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
1249 : & NVARI,NCOMAT)
1249 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1250 : $ ,DSPT,
1251 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1251 : CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
1252 : & NVARI,NCOMAT)
1253 : DO I=1,NSTRS
1254 : EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
1255 : enddo
1256 : DO I=1,NVARI
1257 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
1258 : enddo
1258 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
1259 : $ ,DSPT,
1260 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1260 : CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
1261 : & NVARI,NCOMAT)
1262 : DO I=1,NSTRS
1263 : EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1264 : enddo
1265 : DO I=1,NVARI
1266 : VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1267 : enddo
1267 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
1268 : $ ,DSPT,
1269 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1270 : C---------
1271 : ELSE IF(INPLAS.EQ.53) THEN
1272 : tau2=tau*0.5d0
1272 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
1273 : & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1273 : CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
1274 : & NVARI,NCOMAT)
1275 : DO 191 I=1,NSTRS
1276 : 191 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
1277 :
1278 : DO 196 I=1,NVARI
1279 : 196 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
1279 : CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
1280 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1280 : CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
1281 : & NVARI,NCOMAT)
1281 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1282 : $ ,DSPT,
1283 : & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1283 : CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
1284 : & NVARI,NCOMAT)
1285 : DO I=1,NSTRS
1286 : EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
1287 : enddo
1288 : DO I=1,NVARI
1289 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
1290 : enddo
1290 : CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
1291 : $ ,DSPT,
1292 : & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1292 : CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
1293 : & NVARI,NCOMAT)
1294 : DO I=1,NSTRS
1295 : EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1296 : enddo
1297 : DO I=1,NVARI
1298 : VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1299 : enddo
1299 : CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
1300 : $ ,DSPT,
1301 : & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1302 : C---------
1303 : ENDIF
1304 : GO TO 250
1305 : C
1306 : C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
1307 : C
1308 : 210 CONTINUE
1309 : IF(INPLAS.NE.19) GO TO 999
1310 : tau2=tau*0.5d0
1310 : CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
1311 : & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1311 : CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCAR,EVP2,VARP2,NSTRS,
1312 : & NVARI,INPLAS,NCOMAT,KERREU1)
1313 : DO 220 I=1,6
1314 : EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
1315 : 220 CONTINUE
1316 : DO 230 I=1,4
1317 : VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
1318 : 230 CONTINUE
1319 : DO 240 I=6,NVARI
1320 : VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
1321 : 240 CONTINUE
1321 : CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12
1322 : $ ,DSPT,EVP2,VARP2,
1323 : & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1323 : CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCAR,EVP3,VARP3,NSTRS,
1324 : & NVARI,INPLAS,NCOMAT,KERREU1)
1324 : CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
1325 : $ ,DSPT,EVP3,VARP3,
1326 : & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1326 : CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCAR,EVP4,VARP4,NSTRS,
1327 : & NVARI,INPLAS,NCOMAT,KERREU1)
1328 : DO I=1,6
1329 : EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
1330 : enddo
1331 : DO I=1,4
1332 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
1333 : enddo
1334 : DO I=6,NVARI
1335 : VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
1336 : enddo
1336 : CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
1337 : $ ,DSPT,EVP4,VARP4,
1338 : & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1338 : CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCAR,EVP4,VARP4,NSTRS,
1339 : & NVARI,INPLAS,NCOMAT,KERREU1)
1340 : DO I=1,6
1341 : EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
1342 : enddo
1343 : DO I=1,4
1344 : VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1345 : enddo
1346 : DO I=6,NVARI
1347 : VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
1348 : enddo
1348 : CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
1349 : $ ,DSPT,EVP2,VARP2,
1350 : & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
1351 : C
1352 : C----------------------------------------------------------------------
1353 : 250 CONTINUE
1354 : C ---------------------------------------------------------------------
1355 : C CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
1356 : C ---------------------------------------------------------------------
1357 : DO 260 I=1,NSTRS
1358 : 260 XX(I) = SIGF(I)-SIG1(I)
1359 : RA = SQRT(PROCON(XX,XX,NSTRS))/(ERRABS)
1360 : c
1361 : IF (MFR.EQ.17.AND.INPLAS.EQ.19) THEN
1362 : RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
1363 : ENDIF
1364 : SQRA = SQRT(RA)
1365 : IF (INPLAS.EQ.29) THEN
1366 : RD = 0.D0
1367 : IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
1368 : RD = (VARF(3)-VAR1(3))/VARF(3)
1369 : RD = DABS(RD)/1.D-4
1370 : ENDIF
1371 : RA = DMAX1(RA,RD)
1372 : SQRA = SQRT(RA)
1373 : ENDIF
1374 : C ---------------------------------------------------------------------
1375 : C TEST DE FIN D'ITERATIONS / MISE A JOUR DE TAU /OPTION JECHER
1376 : C DIV =7 BORNE = 2
1377 : C SI SQRA>7 TAU = TAU/7 ET NOUVEL ESSAI
1378 : C SI 2ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
1447 : & XMAT,NCOMAT,TI1,TD,TRUC,NCOURB)
1448 :
1449 : IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
1450 : VARF(3)=1.D0
1451 : TLIFE = DT - (DTLEFT - TAU)
1452 : GOTO 999
1453 : ENDIF
1454 : ENDIF
1455 : C
1456 : C --------------------------------------------------------------------
1457 : C TEST DE FIN SS INCREMENTS / MISE A JOUR DE TAU
1458 : C si SQRA<1/3 TAU = TAU*3
1459 : C si 1/3RMAX on vise RA = 1
1462 : C fin des boucles en ss increments si tau = dtleft
1463 : C --------------------------------------------------------------------
1464 : C
1465 : IF ( TAU.LT.DTLEFT ) THEN
1466 : * DTDEUX=TAU
1467 : DTLEFT = DTLEFT - TAU
1468 : * IF(dtlibr) then
1469 : IF ( FAC*SQRA.LT.1.D0) THEN
1470 : TAU=TAU*FAC
1471 : ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
1472 : TAU=TAU/SQRA
1473 : ENDIF
1474 : * else
1475 : * TAU = TAU * R
1476 : * endif
1477 : IF (TAU.GT.DTLEFT) TAU = DTLEFT
1478 : IF (INPLAS.EQ.29) THEN
1479 : C----------------------------------------------------------------------------
1480 : C Mise a jour des temperatures
1481 : C TI0 temperature au dedut du pas de sous-incrementation avec TINFC TI1 temperature a la fin du pas de sous-incrementation
1483 : C-----------------------------------------------------------------------------
1484 : TI0=TI1
1485 : DELTAT=TPOINT*TAU
1486 : TI1=TI0+DELTAT
1487 : ENDIF
1488 :
1489 : GOTO 70
1490 : ENDIF
1491 : C
1492 : IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
1493 : WRITE ( IOIMP,* ) ' PROBLEME TAU > DTLEFT '
1494 : KERRE = 223
1495 : ENDIF
1496 : C-----------------------------------------------------------------------
1497 : 999 CONTINUE
1498 : IF(MFR.EQ.3) THEN
1499 : DO 1000 I=1,NSTRS/2
1500 : SIGF( I) =SIGF( I)*THICK
1501 : SIGF(NSTRS/2+I) =SIGF(NSTRS/2+ I)*THICK*THICK/6.0
1502 : * DSIGT( I)=DSIGT( I)*THICK
1503 : * DSIGT(NSTRS/2+I)=DSIGT(NSTRS/2+I)*THICK*THICK/6.0
1504 : 1000 CONTINUE
1505 : ENDIF
1506 :
1507 : C
1508 : C===========================================================
1509 : C RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
1510 : C A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
1511 : C DEFINIES PAR DES GAMA.
1512 : C ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
1513 : C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
1514 : C DE LEMAITRE (INPLAS=29).
1515 : C
1516 : C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
1517 : C MFR=1 (MASSIF)
1518 : C MFR=5 (COQUES EPAISSES)
1519 : C MFR=3 (COQUES MINCES)
1520 : C MFR=17 (TUYAUX FISSURES)
1521 : C MFR=33 (POREUX)
1522 : C
1523 : IF (INPLAS.NE.29) THEN
1524 : C
1525 : C Cas de la formulation massive
1526 : C Les termes de cisaillement apparaissent
1527 : C au delà de la troisieme composante
1528 : C
1529 : IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
1530 : DO 14 I=1,NSTRS
1531 : A=1.D0
1532 : IF (I.GT.3) A=2.D0
1533 : EPIN0(I)=EPIN0(I)*A
1534 : EPINF(I)=EPINF(I)*A
1535 : 14 CONTINUE
1536 : C
1537 : C Cas des coques épaisses
1538 : C Les termes de cisaillement apparaissent
1539 : C au delà de la deuxieme composante
1540 : C
1541 : ELSE IF (MFR.EQ.5) THEN
1542 : DO 15 I=1,NSTRS
1543 : A=1.D0
1544 : IF (I.GT.2) A=2.D0
1545 : EPIN0(I)=EPIN0(I)*A
1546 : EPINF(I)=EPINF(I)*A
1547 : 15 CONTINUE
1548 : C
1549 : C Cas des coques minces
1550 : C Les termes de cisaillement apparaissent
1551 : C pour la troisieme et la sixieme composante
1552 : C uniquement dans les cas de calculs
1553 : C tridimensionnels ou d'analyse de Fourier
1554 : C
1555 : ELSE IF (MFR.EQ.3) THEN
1556 : IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
1557 : DO 16 I=1,NSTRS
1558 : A=1.D0
1559 : IF (I.EQ.3) A=2.D0
1560 : IF (I.EQ.6) A=2.D0
1561 : EPIN0(I)=EPIN0(I)*A
1562 : EPINF(I)=EPINF(I)*A
1563 : 16 CONTINUE
1564 : ENDIF
1565 : C
1566 : C Reste le cas des tuyaux fissurés (MFR=17)
1567 : C
1568 : ENDIF
1569 : ENDIF
1570 : C
1571 : C===========================================================
1572 : C
1573 : 998 RETURN
1574 : END
1575 :
1576 :
1577 :
1578 :
1579 :
1580 :
1581 :
1582 :
1583 :