Télécharger cconst.eso

Retour à la liste

Numérotation des lignes :

  1. C CCONST SOURCE BP208322 17/03/01 21:15:14 9325
  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
  192. CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
  193. & YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
  194. * write(6,*) 'cconst avant test kerre',kerre
  195. ENDIF
  196. IF (INPLAS.EQ.142) THEN
  197. * write(6,*) 'cconst avant test1 kerre',kerre
  198. CALL TEST1(YN1,NYN1,YM1,NYM1,YKK1,NYKK1,YALF2,NYALF2,YBET2,
  199. & NYBET2,YR1,NYR1,YA1,NYA1,SIGY1,NSIGY1,YQ1,NYQ1,ITEST)
  200. * write(6,*) 'cconst avant test1 kerre',kerre
  201. ENDIF
  202. C
  203. KERRE = 0
  204. IF (MFR1.NE.1.AND.MFR1.NE.3.AND.MFR1.NE.5.AND.MFR1.NE.17.AND.
  205. & MFR1.NE.33) THEN
  206. KERRE = 99
  207. RETURN
  208. ENDIF
  209. *
  210. * AM 5/5/00 MFR1 = 33 : MODELES 19 A 24 pour le moment
  211. * AM 27/5/3 : ET 44,45
  212. *
  213. IF (MFR1.EQ.33) THEN
  214. IF ((INPLAS.LT.19.OR.INPLAS.GT.24).AND.
  215. & (INPLAS.NE.44.AND.INPLAS.NE.45))THEN
  216. KERRE = 99
  217. RETURN
  218. ENDIF
  219. ENDIF
  220. *
  221. * write(6,*) 'cconst mfr1',mfr1
  222. IF (MFR1.EQ.3) THEN
  223. THICK = XCARB(1)
  224. ALFA = XCARB(2)
  225. ENDIF
  226. * dtprem=0.D0
  227. * dtdeux=0.d0
  228. dtleft= dt
  229. BORNE = 2.0
  230. RMAX = 1.3
  231. RMIN = 0.7
  232. DIV = 7.0
  233. FAC = 3.0
  234. TLIFE = -1.D0
  235. C
  236. C CALCUL DES INCREMENTS DE DEFORMATIONS
  237. C
  238. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  239. * write(6,*) 'cconst avant calcsig kerre',kerre
  240. CALL CALSIG(DEPST,DDAUX,NSTRS1,CMATE,VALMAT,VALCAR,N2EL,
  241. 1 N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,
  242. 2 NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,
  243. 3 D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  244. * write(6,*) 'cconst apres calcsig kerre',kerre
  245. C
  246. IF (IRTD.NE.1) THEN
  247. KERRE=69
  248. GOTO 998
  249. ENDIF
  250. C
  251. ENDIF
  252. IF (MFR1.EQ.3) THEN
  253. DO 10 I=1,NSTRS1/2
  254. SIG0( I)= SIG0( I)/THICK
  255. SIG0(NSTRS1/2+I)= SIG0(NSTRS1/2+I)*6.0D0/THICK/THICK
  256. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  257. DSIGT( I)= DSIGT( I)/THICK
  258. DSIGT(NSTRS1/2+I)= DSIGT(NSTRS1/2+I)*6.0D0/THICK/THICK
  259. ELSE
  260. DEPST( I)= DEPST( I)
  261. DEPST(NSTRS1/2+I)= -DEPST(NSTRS1/2+I)*THICK/2.D0
  262. ENDIF
  263. 10 CONTINUE
  264. IF (IFOURB.EQ.-2) THEN
  265. SIG0(2)=0.D0
  266. SIG0(4)=0.D0
  267. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  268. DSIGT(2)=0.D0
  269. DSIGT(4)=0.D0
  270. ENDIF
  271. ENDIF
  272. ENDIF
  273. C
  274. C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
  275. C L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
  276. C
  277. IF (MFR1.EQ.17) THEN
  278. SIG0(2) = 0.D0
  279. SIG0(3) = 0.D0
  280. SIG0(4) = 0.D0
  281. SIG0(5) = 0.D0
  282. ENDIF
  283. C
  284. C------------------------------------------
  285. C CONTROLE DE LA COHERENCE DES ENTREES
  286. C------------------------------------------
  287. IF (DT.LT.0.0) KERRE = 414
  288. IF (INPLAS.EQ.63.AND.MFR1.NE.1) THEN
  289. KERRE=99
  290. RETURN
  291. ENDIF
  292. IF (DT.EQ.0.0) DT = 1.e-20
  293. MOTERR(1:8) = ' CONST '
  294. IF (INPLAS.EQ.17) THEN
  295. IF ((NVARI.NE.(6+4*NSTRS1)).AND.(MFR1.NE.5)) KERRE = 146
  296. IF ((NVARI.NE.(10+4*NSTRS1)).AND.(MFR1.EQ.5)) KERRE = 146
  297. IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
  298. IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
  299. XMAX=XMAT(8)
  300. GOTO 30
  301. ENDIF
  302.  
  303. IF (MFR1.NE.33) THEN
  304. * write(6,*) 'cconst inplas ifourb ncomat',inplas,ifourb,ncomat
  305. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
  306. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
  307. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  308. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  309. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  310. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
  311. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  312. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  313. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  314. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  315. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
  316. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
  317. IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  318. IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  319. C IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  320. C IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  321. IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  322. IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  323. IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
  324. IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
  325. IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
  326. IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
  327. IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  328. IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  329. IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
  330. IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
  331. IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
  332. IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
  333. IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  334. IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  335. IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  336. IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  337. IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
  338. IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  339. IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  340. IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  341. IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  342. IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  343. IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
  344. IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
  345. IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
  346. IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
  347. IF (INPLAS.EQ.130.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  348. IF (INPLAS.EQ.130.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  349. IF (INPLAS.EQ.136.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  350. IF (INPLAS.EQ.136.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  351. IF (INPLAS.EQ.137.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  352. IF (INPLAS.EQ.137.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  353. IF (INPLAS.EQ.138.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  354. IF (INPLAS.EQ.138.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  355. IF (INPLAS.EQ.139.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  356. IF (INPLAS.EQ.139.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  357.  
  358. C
  359. ELSE
  360. C
  361. C cas MFR1=33
  362. C
  363.  
  364. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  365. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  366. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  367. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  368. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  369. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  370. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  371. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
  372. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
  373. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
  374. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  375. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  376. C
  377. ENDIF
  378. C
  379. IF (IFOURB.EQ.1) THEN
  380. KERRE = 194
  381. MOTERR(1:8) = 'FLUAGE'
  382. ENDIF
  383. XMAX=XMAT(5)
  384. IF ((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
  385. IF ((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
  386. IF ((INPLAS.EQ.70).OR.(INPLAS.EQ.107)) XMAX=XMAT(1)*1.D-3
  387. IF (INPLAS.EQ.29) THEN
  388. CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
  389. ENDIF
  390. IF (INPLAS.EQ.142) THEN
  391. CALL DERTRA(NYSMAX1,YSMAX1,TF,XMAX,XMAXV,TO,TO)
  392. ENDIF
  393. C
  394. C TEST SUR XMAX MILL 8/3/91
  395. C
  396. IF (XMAX.EQ.0.D0) THEN
  397. IF (INPLAS.EQ.29) THEN
  398. CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
  399. XMAX=XMAX*1.D-3
  400. ELSEIF (INPLAS.EQ.142) THEN
  401. CALL DERTRA(NYOG1,YOG1,TF,XMAX,XMAXV,TO,TO)
  402. XMAX=XMAX*1.D-3
  403. ELSEIF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  404. XMAX=XMAT(1)*1.D-3
  405. ENDIF
  406. ENDIF
  407. C
  408. 30 CONTINUE
  409. C
  410. C-----------------------------
  411. IF (KERRE.NE.0) THEN
  412. GOTO 999
  413. ENDIF
  414.  
  415. C
  416. C===========================================================
  417. C A PARTIR DE MAINTENANT, LES DEFORMATIONS
  418. C DE CISAILLEMENT NE SONT PLUS
  419. C DEFINIES PAR DES GAMA.
  420. C ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
  421. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  422. C DE LEMAITRE (INPLAS=29 ET INPLAS=142).
  423. C
  424. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  425. C MFR1=1 (MASSIF)
  426. C MFR1=5 (COQUES EPAISSES)
  427. C MFR1=3 (COQUES MINCES)
  428. C MFR1=17 (TUYAUX FISSURES)
  429. C MFR1=33 (POREUX)
  430. C
  431. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  432. C
  433. C Cas de la formulation massive
  434. C Les termes de cisaillement apparaissent
  435. C au delà de la troisieme composante
  436. C
  437. IF (MFR1.EQ.1.OR.MFR1.EQ.33) THEN
  438. DO I=4,NSTRS1
  439. EPIN0(I)=0.5D0*EPIN0(I)
  440. ENDDO
  441. C
  442. C Cas des coques épaisses
  443. C Les termes de cisaillement apparaissent
  444. C au delà de la deuxieme composante
  445. C
  446. ELSE IF (MFR1.EQ.5) THEN
  447. DO I=3,NSTRS1
  448. EPIN0(I)=0.5D0*EPIN0(I)
  449. ENDDO
  450. C
  451. C Cas des coques minces
  452. C Les termes de cisaillement apparaissent
  453. C pour la troisieme et la sixieme composante
  454. C uniquement dans les cas de calculs
  455. C tridimensionnels ou d'analyse de Fourier
  456. C
  457. ELSE IF (MFR1.EQ.3) THEN
  458. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  459. EPIN0(3)=0.5D0*EPIN0(3)
  460. EPIN0(6)=0.5D0*EPIN0(6)
  461. ENDIF
  462. C
  463. C Reste le cas des tuyaux fissurés (MFR1=17)
  464. C
  465. ENDIF
  466. ENDIF
  467. C
  468. C===========================================================
  469. C
  470. C ----------------
  471. C INITIALISATION
  472. C ----------------
  473. ITERO = 0
  474. 6543 CONTINUE
  475.  
  476. itero = 1 + itero
  477. if ( itero.ne.1) THEN
  478. if(ib.eq.1.and.igau.eq.1) write(6,*) 'itero ', itero
  479. dtlibr = .true.
  480. preloc = preloc * 7.d0
  481. c write(6,*) ' precision modifiée ', preloc
  482. if (itero.gt.3) then
  483. **** kerre = 460
  484. kerre = 268
  485. return
  486. endif
  487. endif
  488. DTLEFT = DT
  489. TAU = DTLEFT
  490. dtaumi= dtleft / 1500.
  491. TI0=T0
  492. TI1=TF
  493. TPOINT=(TF-T0)/DT
  494. FII0=FI0
  495. FII1=FIF
  496. FPOINT=(FIF-FI0)/DT
  497. ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS1))
  498. ERRABS = PRELOC*ASIG
  499. IF (XMAX.GT.ASIG) ERRABS = PRELOC*XMAX
  500. DO 40 I=1,NSTRS1
  501. SIG(I) = SIG0(I)
  502. EPSV(I) = EPIN0(I)
  503. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  504. DSPT(I) = DSIGT(I)/DT
  505. ENDIF
  506. 40 CONTINUE
  507. *
  508. * iter=0
  509. * if ( .NOT.DTLIBR) THEN
  510. * dtminl = ( dt * 1.001 ) / msopua
  511. * r = dtseco / dtprem
  512. * 1245 continue
  513. * iter=iter+1
  514. ** if ( abs ( 1.- R) . gt. 0.001 ) then
  515. * bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
  516. * else
  517. * r = 1.d0
  518. * bb = dtprem * ( msoupa - 10)
  519. * endif
  520. * tau = dtprem * dt / bb * 1.0001
  521. * write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
  522. * if (bb . lt . dt/1.2) THEN
  523. * if ( iter.lt.15) then
  524. * r = r + abs ( 1. - r ) / 10.
  525. * else
  526. * kerre = 460
  527. * return
  528. * endif
  529. * go to 1245
  530. * endif
  531. * 1234 format ('it pr se de r b t ta',i2, 7e9.3)
  532. *
  533. * dtx = dt * 1.00001;
  534. * write(6,*) 'avpremdeux r', dtprem,dtdeux,r
  535. * call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
  536. * $ ,xdf,dtx)
  537. * write(6,*) 'xde xdf de r',xde,xdf,r
  538. * tau = xde / r
  539. *
  540. * endif
  541. C
  542. IF (INPLAS.EQ.29) THEN
  543. C
  544. C================================================
  545. C Calcul de l increment de deformation totale reel.
  546. C On enleve donc tous les termes qui correspondent
  547. C a l influence de la temperature et de
  548. C l endommagement (travail inverse de ce qui est
  549. C fait dans le procedure increme).
  550. C================================================
  551. C
  552. ********* materiau dependant de la temperature ***********************
  553. CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
  554. CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
  555. XMAT(1)=YUNG0
  556. XMAT(2)=ENU0
  557. C------------------------------------------------
  558. C Calcul de la matrice de Hooke inverse DD a t=t0
  559. C------------------------------------------------
  560. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
  561. & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
  562. C
  563. ********* materiau dependant de la temperature ***********************
  564. CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
  565. CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
  566. XMAT(1)=YUNG1
  567. XMAT(2)=ENU1
  568. C---------------------------------------------------
  569. C Calcul de la matrice de Hooke inverse DDINV a T=TF
  570. C---------------------------------------------------
  571. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
  572. & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
  573. ***********************************************************************
  574. C
  575. CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
  576. CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
  577. CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
  578. C
  579. CALL ZDANUL(DSPT,NSTRS1)
  580. AA=1.D0
  581. DO 45 I=1,NSTRS1
  582. DSPT(I)=DEPST(I)
  583. IF (I.GT.3) AA=0.D0
  584. DO 46 J=1,NSTRS1
  585. DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
  586. DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
  587. 46 CONTINUE
  588. DSPT(I)=DSPT(I)-(AA*CTEPS)
  589. DSPT(I)=DSPT(I)/DT
  590. 45 CONTINUE
  591. C
  592. ELSEIF (INPLAS.EQ.142) THEN
  593. C
  594. C================================================
  595. C Calcul de l increment de deformation totale reel.
  596. C On enleve donc tous les termes qui correspondent
  597. C a l influence de la temperature et de
  598. C l endommagement (travail inverse de ce qui est
  599. C fait dans le procedure increme).
  600. C================================================
  601. C
  602. ********* materiau dependant de la temperature ***********************
  603. CALL DERTRA(NYOG1,YOG1,T0,YUNG0,YUNGV0,TO,TO)
  604. CALL DERTRA(NYNU1,YNU1,T0,ENU0,ENUV0,TO,TO)
  605. XMAT(1)=YUNG0
  606. XMAT(2)=ENU0
  607. C------------------------------------------------
  608. C Calcul de la matrice de Hooke inverse DD a t=t0
  609. C------------------------------------------------
  610. CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
  611. & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
  612. C
  613. ********* materiau dependant de la temperature ***********************
  614. CALL DERTRA(NYOG1,YOG1,TF,YUNG1,YUNGV1,TO,TO)
  615. CALL DERTRA(NYNU1,YNU1,TF,ENU1,ENUV1,TO,TO)
  616. XMAT(1)=YUNG1
  617. XMAT(2)=ENU1
  618. C---------------------------------------------------
  619. C Calcul de la matrice de Hooke inverse DDINV a T=TF
  620. C---------------------------------------------------
  621. CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
  622. & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
  623. ***********************************************************************
  624. C
  625. CALL DERTRA(NYALFT1,YALFT1,T0,ALFA0,ALFAV0,TO,TO)
  626. CALL DERTRA(NYALFT1,YALFT1,TF,ALFAF,ALFAVF,TO,TO)
  627. CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
  628. C
  629. CALL ZDANUL(DSPT,NSTRS1)
  630. AA=1.D0
  631. DO I=1,NSTRS1
  632. DSPT(I)=DEPST(I)
  633. IF (I.GT.3) AA=0.D0
  634. DO J=1,NSTRS1
  635. DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
  636. DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
  637. ENDDO
  638. DSPT(I)=DSPT(I)-(AA*CTEPS)
  639. DSPT(I)=DSPT(I)/DT
  640. ENDDO
  641. ENDIF
  642. DO I=1,NVARI
  643. VAR(I)=VAR0(I)
  644. ENDDO
  645. IF (NVARI.LT.100) THEN
  646. DO I=NVARI+1,100
  647. VAR(I)=0.0D0
  648. ENDDO
  649. ENDIF
  650.  
  651.  
  652. C
  653. C ---------------------------------------------------------------------
  654. INV = 0
  655. NSSINC = 0
  656. nitera = 1
  657. nopri=0
  658. C ---------------------------------------------------------------------
  659. C DEBUT DES ITERATIONS EN SSINCREMENTS /FIN SI DTLEFT = 0
  660. C ---------------------------------------------------------------------
  661. 70 CONTINUE
  662. iforce=.false.
  663. C if(dtaumi.gt.TAU) THEN
  664. if(dtaumi.gt.TAU.and.nssinc.gt.400) THEN
  665. tau=min(dtaumi,dtleft)
  666. iforce=.true.
  667. endif
  668. NSSINC = NSSINC + 1
  669. nopri = nopri + nitera - 1
  670. IF (NSSINC.GT.msoupa) THEN
  671. DTLIBR=.FALSE.
  672. GOTO 6543
  673. C GOTO 999
  674. ENDIF
  675. C
  676. C---------------------------------------------------------------------
  677. C START OF CALCULATIONS
  678. C_____________________________________________________________________
  679. IF (MFR1.EQ.17.AND.INPLAS.NE.19) GOTO 999
  680. IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.17) THEN
  681. CALL XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS1,NVARI,
  682. & NCOMAT,MFR1)
  683. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.((INPLAS.GE.19.AND.
  684. & INPLAS.LE.24).OR.INPLAS.EQ.61.OR.INPLAS.EQ.107)) THEN
  685. C-----------------------------------------------------------
  686. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  687. C de la nouvelle densite de fissions FII1
  688. C-----------------------------------------------------------
  689. C
  690. DELTAT=TPOINT*TAU
  691. TI1=TI0+DELTAT
  692. DELTAF=FPOINT*TAU
  693. FII1=FII0+DELTAF
  694. CALL INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,
  695. & INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
  696. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.25) THEN
  697. CALL INCRE2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  698. ELSE IF (MFR1.EQ.1.AND.INPLAS.EQ.130) THEN
  699. CALL INCREP(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
  700. & NVARI,NCOMAT)
  701. ELSE IF (MFR1.EQ.1.AND.(INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
  702. a INPLAS.EQ.138.OR.INPLAS.EQ.139)) THEN
  703. CALL INCVAR(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
  704. & NVARI,NCOMAT,INPLAS)
  705. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.76) THEN
  706. CALL INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  707. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.77) THEN
  708. CALL INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  709. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.53) THEN
  710. CALL INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  711. ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.63) THEN
  712. CALL INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
  713. & NCOMAT,IFOURB)
  714. ELSE IF (MFR1.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
  715. & .OR.INPLAS.EQ.61)) THEN
  716. CALL INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS1,
  717. & NVARI,INPLAS,NCOMAT)
  718. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.25) THEN
  719. CALL INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  720. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.76) THEN
  721. CALL INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  722. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.77) THEN
  723. CALL INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  724. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.53) THEN
  725. CALL INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  726. ELSE IF (MFR1.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
  727. & OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
  728. CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS1,NVARI,EVP1,
  729. & VARP1,TAU)
  730. ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.70) THEN
  731. CALL INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
  732. & NCOMAT)
  733. C
  734. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.29) THEN
  735. if (nssinc.eq.1) then
  736. C
  737. C-----------------------------------------------------------
  738. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
  739. C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
  740. C-----------------------------------------------------------
  741. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
  742. & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  743. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
  744. & NCOMAT,TI0,TINF,TSUP,ITEST,TRUC,NCOURB)
  745. C
  746. IF (ITHHER.EQ.2) THEN
  747. C********** materiau dependant de la temperature **********************
  748. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  749. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  750. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  751. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  752. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  753. & NCOURB)
  754. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  755. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  756. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  757. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  758. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  759. & NCOURB)
  760. C**********************************************************************
  761. ENDIF
  762. C--------------------------------------------------------------
  763. C Calcul de la derivee de la dilatation thermique /temps a t=t0
  764. C--------------------------------------------------------------
  765. CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
  766. CALL ZDANUL(EPSTHD,NSTRS1)
  767. CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
  768. DO I=1,3
  769. EPSTHD(I)=CTH
  770. ENDDO
  771. C
  772. CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
  773. & XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,NCOMAT,
  774. & NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR1,
  775. & XCARB,ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
  776. & ITHHER,TRUC,NCOURB)
  777. c DO i= 1,6
  778. c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
  779. c ENDDO
  780. c DO i= 1,6
  781. c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
  782. c ENDDO
  783. c DO i= 1,6
  784. c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
  785. c ENDDO
  786. CALL ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
  787. & NCOMAT,TI0,TAUX,TRUC,NCOURB)
  788. else
  789. do i=1,nstrs
  790. sigp1(i)=sigp4(i)
  791. evp1(i)=evp4(i)
  792. enddo
  793. do i=1,nvari
  794. varp1(i)=varp4(i)
  795. enddo
  796. endif
  797. C
  798. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.142) THEN
  799. if (nssinc.eq.1) then
  800. C
  801. C-----------------------------------------------------------
  802. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
  803. C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
  804. C-----------------------------------------------------------
  805. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  806. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
  807. & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
  808. & XMAT,NCOMAT,TI0,TINF,TSUP,ITEST)
  809. C
  810. IF (ITHHER.EQ.2) THEN
  811. C********** materiau dependant de la temperature **********************
  812. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  813. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  814. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  815. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  816. & NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  817. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  818. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  819. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  820. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  821. & NSIGY1,XMAT1,NCOMAT,TSUP,TO,TO,ITEST)
  822. C**********************************************************************
  823. ENDIF
  824. C--------------------------------------------------------------
  825. C Calcul de la derivee de la dilatation thermique /temps a t=t0
  826. C--------------------------------------------------------------
  827. CALL DERTRA(NYALFT1,YALFT1,TI0,ALFA0,ALFAV0,TO,TO)
  828. CALL ZDANUL(EPSTHD,NSTRS1)
  829. CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
  830. DO I=1,3
  831. EPSTHD(I)=CTH
  832. ENDDO
  833. CALL XXCRE1(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
  834. & XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,DDV,
  835. & DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,XCARB,
  836. & ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
  837. & ITHHER,VART,IB,IGAU,kerre)
  838. c DO i= 1,6
  839. c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
  840. c ENDDO
  841. c DO i= 1,6
  842. c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
  843. c ENDDO
  844. c DO i= 1,6
  845. c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
  846. c ENDDO
  847. VAR(8)=VART(8)
  848. CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI0,TAUX)
  849. else
  850. do i=1,nstrs
  851. sigp1(i)=sigp4(i)
  852. evp1(i)=evp4(i)
  853. enddo
  854. do i=1,nvari
  855. varp1(i)=varp4(i)
  856. enddo
  857. endif
  858. ELSE IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  859. CALL TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCARB,EVP1,VARP1,NSTRS1,
  860. & NVARI,INPLAS,NCOMAT,KERREU1)
  861. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.33).AND.INPLAS.EQ.44) THEN
  862. CALL POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
  863. & KERRE)
  864. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.33).AND.INPLAS.EQ.45) THEN
  865. CALL POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
  866. & KERRE)
  867. ENDIF
  868. C
  869. NITERA = 0
  870. C --------------------------------------------------------------------
  871. C DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
  872. C --------------------------------------------------------------------
  873. 80 CONTINUE
  874. iforce=.false.
  875. C WRITE(6,*) 'NITERA', nitera
  876. * if( tau.lt.dtaumi) then
  877. if( tau.lt.dtaumi.and.nssinc.gt.400) then
  878. tau=min(dtaumi,dtleft)
  879. iforce=.true.
  880. endif
  881. IF (MFR1.EQ.3) GOTO 150
  882. IF (MFR1.EQ.17) GOTO 210
  883. IF (INPLAS.EQ.17) THEN
  884. tau2=tau*0.5d0
  885. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
  886. & XPM1,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
  887. & MFR1)
  888. CALL XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS1,
  889. & NVARI,NCOMAT,MFR1)
  890. DO I=1,NSTRS1
  891. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  892. XPM2(I) = 0.5D0*(XPM1(I)+XPM2(I))
  893. ENDDO
  894. DO I=1,4+NSTRS1
  895. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  896. ENDDO
  897. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
  898. & XPM2,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
  899. & MFR1)
  900. CALL XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS1,
  901. & NVARI,NCOMAT,MFR1)
  902. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,EVP3,
  903. & VARP3,XPM3,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
  904. & IVTEST,MFR1)
  905. CALL XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS1,
  906. & NVARI,NCOMAT,MFR1)
  907. DO I=1,NSTRS1
  908. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  909. XPM4(I) = 0.5D0*(XPM3(I)+XPM4(I))
  910. enddo
  911. DO I=1,4+NSTRS1
  912. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  913. enddo
  914. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,EVP4,
  915. & VARP4,XPM4,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
  916. & IVTEST,MFR1)
  917. CALL XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS1,
  918. & NVARI,NCOMAT,MFR1)
  919. DO I=1,NSTRS1
  920. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  921. XPM2(I) = (XPM1(I)+XPM4(I))/6.d0+XPM3(I)*2.d0/3.d0
  922. enddo
  923. DO I=1,4+NSTRS1
  924. VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  925. enddo
  926. CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,EVP2,VARP2,XPM2,
  927. & DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,MFR1)
  928. C---------
  929. ELSE IF (INPLAS.EQ.44) THEN
  930. CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  931. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  932. CALL POUDRA(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  933. & NCOMAT,KERRE)
  934. DO I=1,NSTRS1
  935. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  936. ENDDO
  937. VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
  938. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  939. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  940. * tau2=tau*0.5d0
  941. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  942. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  943. * CALL POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  944. * & NCOMAT,KERRE)
  945. * DO I=1,NSTRS1
  946. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  947. * ENDDO
  948. * VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
  949. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  950. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  951. * CALL POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
  952. * & NCOMAT,KERRE)
  953. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  954. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  955. * CALL POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  956. * & NCOMAT,KERRE)
  957. * DO I=1,NSTRS1
  958. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  959. * enddo
  960. * VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
  961. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  962. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  963. * CALL POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  964. * & NCOMAT,KERRE)
  965. * DO I=1,NSTRS1
  966. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  967. * enddo
  968. * VARP2(1) = (VARP1(1)+VARP4(1))/6.d0+VARP3(1)*2.d0/3.d0
  969. * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  970. * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  971. *C---------
  972. ELSE IF (INPLAS.EQ.45) THEN
  973. CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  974. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  975. CALL POUDRB(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  976. & NCOMAT,KERRE)
  977. DO I=1,NSTRS1
  978. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  979. ENDDO
  980. VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
  981. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  982. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  983. C---------
  984. C CALCUL DE LA TAILLE DE GRAIN
  985. C---------
  986. CALL GRAIN(TAU,EVP1,EVP2,SIG,SIG1,VAR,VAR1,XMAT,NSTRS1,
  987. & NVARI,KERRE)
  988.  
  989.  
  990. * tau2=tau*0.5d0
  991. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  992. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  993. * CALL POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  994. * & NCOMAT,KERRE)
  995. * DO I=1,NSTRS1
  996. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  997. * ENDDO
  998. * VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
  999. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1000. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1001. *C---------
  1002. *C CALCUL DE LA TAILLE DE GRAIN
  1003. *C---------
  1004. * CALL GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS1,
  1005. * & NVARI,KERRE)
  1006. *c
  1007. * CALL POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
  1008. * & NCOMAT,KERRE)
  1009. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,DSPT,
  1010. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1011. * CALL POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  1012. * & NCOMAT,KERRE)
  1013. * DO I=1,NSTRS1
  1014. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1015. * enddo
  1016. * VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
  1017. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1018. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1019. * CALL POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  1020. * & NCOMAT,KERRE)
  1021. * DO I=1,NSTRS1
  1022. * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1023. * enddo
  1024. * VARP2(1) =(VARP1(1)+VARP2(1))/6.d0+VARP3(1)*2.d0/3.d0
  1025. * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  1026. * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1027. *C---------
  1028. *C CALCUL DE LA TAILLE DE GRAIN
  1029. *C---------
  1030. * CALL GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS1,
  1031. * & NVARI,KERRE)
  1032. *C---------
  1033. ELSE IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61.OR.
  1034. & INPLAS.EQ.107) THEN
  1035. tau2=tau*0.5d0
  1036. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1037. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1038. C-----------------------------------------------------------
  1039. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1040. C de la nouvelle densite de fissions FII1
  1041. C-----------------------------------------------------------
  1042. C
  1043. DELTAT=TPOINT*TAU
  1044. TI1=TI0+DELTAT
  1045. DELTAF=FPOINT*TAU
  1046. FII1=FII0+DELTAF
  1047. IF (INPLAS.EQ.107) VAR1(3)=VAR(3)
  1048. CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,
  1049. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
  1050. DO I=1,NSTRS1
  1051. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1052. ENDDO
  1053. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1054. IF (INPLAS.EQ.107) VARPBU=VARP2(3)
  1055. DO I=1,NVARI
  1056. VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  1057. ENDDO
  1058. ELSE
  1059. DO I=1,2*NSTRS1+2
  1060. VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
  1061. ENDDO
  1062. DO I=2*NSTRS1+4,NVARI
  1063. VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
  1064. ENDDO
  1065. ENDIF
  1066. C-----------------------------------------------------------
  1067. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1068. C de la nouvelle densite de fissions FII1
  1069. C-----------------------------------------------------------
  1070. C
  1071. DELTAT=TPOINT*TAU2
  1072. TI12=TI0+DELTAT
  1073. DELTAF=FPOINT*TAU2
  1074. FII12=FII0+DELTAF
  1075. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1076. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1077. IF (INPLAS.EQ.107) VAR12(3)=VAR(3)
  1078. CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,
  1079. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
  1080. C-----------------------------------------------------------
  1081. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1082. C de la nouvelle densite de fissions FII1
  1083. C-----------------------------------------------------------
  1084. C
  1085. TI1=TI12+DELTAT
  1086. FII1=FII12+DELTAF
  1087. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1088. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1089. CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,
  1090. & NVARI,INPLAS,NCOMAT,MFR1,FII12,FII1,TI1)
  1091. DO I=1,NSTRS1
  1092. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  1093. enddo
  1094. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1095. DO I=1,NVARI
  1096. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  1097. enddo
  1098. ELSE
  1099. DO I=1,2*NSTRS1+2
  1100. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  1101. enddo
  1102. DO I=2*NSTRS1+4,NVARI
  1103. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  1104. enddo
  1105. ENDIF
  1106. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1107. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1108. C-----------------------------------------------------------
  1109. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1110. C de la nouvelle densite de fissions FII1
  1111. C-----------------------------------------------------------
  1112. C
  1113. DELTAT=TPOINT*TAU2
  1114. TI12=TI0+DELTAT
  1115. DELTAF=FPOINT*TAU2
  1116. FII12=FII0+DELTAF
  1117. IF (INPLAS.EQ.107) VARf(3)=VAR(3)
  1118. CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,
  1119. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
  1120. DO I=1,NSTRS1
  1121. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1122. enddo
  1123. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1124. DO I=1,NVARI
  1125. VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1126. enddo
  1127. IF (INPLAS.EQ.107) VARP2(3)=VARPBU
  1128. ELSE
  1129. DO I=1,2*NSTRS1+2
  1130. VARP2(I)=(VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1131. enddo
  1132. DO I=2*NSTRS1+4,NVARI
  1133. VARP2(I)= (VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1134. enddo
  1135. ENDIF
  1136. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  1137. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1138. IF(INPLAS.EQ.107) VARf(3)=VAR1(3)
  1139. C---------
  1140. ELSE IF (INPLAS.EQ.25) THEN
  1141. tau2=tau*0.5d0
  1142. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1143. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1144. CALL INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1145. & NCOMAT)
  1146. DO I=1,NSTRS1
  1147. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1148. ENDDO
  1149. DO I=1,NVARI
  1150. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1151. ENDDO
  1152. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1153. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1154. CALL INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1155. & NCOMAT)
  1156. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1157. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1158. CALL INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1159. & NCOMAT)
  1160. DO I=1,NSTRS1
  1161. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1162. enddo
  1163. DO I=1,NVARI
  1164. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1165. enddo
  1166. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1167. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1168. CALL INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1169. & NCOMAT)
  1170. DO I=1,NSTRS1
  1171. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1172. enddo
  1173. DO I=1,NVARI
  1174. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1175. enddo
  1176. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1177. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1178. C---------
  1179. ELSE IF (INPLAS.EQ.130) THEN
  1180. tau2=tau*0.5d0
  1181. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1182. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1183. CALL INCREP(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1184. & NCOMAT)
  1185. DO I=1,NSTRS1
  1186. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1187. ENDDO
  1188. DO I=1,NVARI
  1189. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1190. ENDDO
  1191. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1192. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1193. CALL INCREP(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1194. & NCOMAT)
  1195. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1196. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1197. CALL INCREP(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1198. & NCOMAT)
  1199. DO I=1,NSTRS1
  1200. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1201. enddo
  1202. DO I=1,NVARI
  1203. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1204. enddo
  1205. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1206. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1207. CALL INCREP(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1208. & NCOMAT)
  1209. DO I=1,NSTRS1
  1210. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1211. enddo
  1212. DO I=1,NVARI
  1213. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1214. enddo
  1215. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1216. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1217. C---------
  1218. C--------- LOI CHAB_SINH_R, CHAB_SINH_X (Runge Kuta 2-3)
  1219. ELSE IF (INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
  1220. a INPLAS.EQ.138.OR.INPLAS.EQ.139) THEN
  1221. tau2=tau*0.5d0
  1222. C write(6,*)'première entrée dans advac'
  1223. CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1224. & DEPST,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1225. C write(6,*)'sortie de advac'
  1226. C write(6,*)'seconde entrée dans increp'
  1227. CALL INCVAR(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1228. & NCOMAT,INPLAS)
  1229. C write(6,*)'sortie de increp'
  1230. DO I=1,NSTRS1
  1231. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1232. ENDDO
  1233. DO I=1,2
  1234. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1235. ENDDO
  1236. C write(6,*)'seconde entrée dans advac'
  1237. CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1238. & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1239. C write(6,*)'sortie de advac'
  1240. C write(6,*)'troisième entrée entrée dans increp'
  1241. CALL INCVAR(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1242. & NCOMAT,INPLAS)
  1243. C write(6,*)'sortie de increp'
  1244. C write(6,*)'troisième entrée dans advac'
  1245. CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1246. & EVP3,DEPST,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1247. C write(6,*)'sortie de advac'
  1248. C write(6,*)'quatrième entrée dans increp'
  1249. CALL INCVAR(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1250. & NCOMAT,INPLAS)
  1251. C write(6,*)'sortie de increp'
  1252. DO I=1,NSTRS1
  1253. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1254. enddo
  1255. DO I=1,2
  1256. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1257. enddo
  1258. C write(6,*)'quatrième entrée dans advac'
  1259. CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1260. & EVP4,DEPST,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1261. C write(6,*)'sortie de advac'
  1262. C write(6,*)'cinquième entrée dans increp'
  1263. CALL INCVAR(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1264. & NCOMAT,INPLAS)
  1265. C write(6,*)'sortie de increp'
  1266. DO I=1,NSTRS1
  1267. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1268. enddo
  1269. DO I=1,2
  1270. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1271. enddo
  1272. C write(6,*)'cinquième entrée dans advac'
  1273. CALL ADVAR(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1274. & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1275. C write(6,*)'sortie de advac'
  1276. C---------
  1277. C---------
  1278. ELSE IF (INPLAS.EQ.76) THEN
  1279. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  1280. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1281. CALL INCRA2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1282. & NCOMAT)
  1283. DO I=1,NSTRS1
  1284. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1285. ENDDO
  1286. DO I=1,NVARI
  1287. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1288. ENDDO
  1289. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1290. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1291. * tau2=tau*0.5d0
  1292. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1293. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1294. * CALL INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1295. * & NCOMAT)
  1296. * DO I=1,NSTRS1
  1297. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1298. * ENDDO
  1299. * DO I=1,NVARI
  1300. * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1301. * ENDDO
  1302. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1303. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1304. * CALL INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1305. * & NCOMAT)
  1306. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1307. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1308. * CALL INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1309. * & NCOMAT)
  1310. * DO I=1,NSTRS1
  1311. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1312. * enddo
  1313. * DO I=1,NVARI
  1314. * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1315. * enddo
  1316. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1317. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1318. * CALL INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1319. * & NCOMAT)
  1320. * DO I=1,NSTRS1
  1321. * EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1322. * enddo
  1323. * DO I=1,NVARI
  1324. * VARP2(I) = (VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1325. * enddo
  1326. * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1327. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1328. C---------
  1329. ELSE IF (INPLAS.EQ.77) THEN
  1330. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  1331. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1332. CALL INCRB2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1333. & NCOMAT)
  1334. DO I=1,NSTRS1
  1335. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1336. enddo
  1337. DO I=1,NVARI
  1338. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1339. enddo
  1340. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1341. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1342.  
  1343. * tau2=tau*0.5d0
  1344. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1345. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1346. * CALL INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1347. * & NCOMAT)
  1348. * DO I=1,NSTRS1
  1349. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1350. * enddo
  1351. * DO I=1,NVARI
  1352. * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1353. * enddo
  1354. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1355. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1356. * CALL INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1357. * & NCOMAT)
  1358. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1359. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1360. * CALL INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1361. * & NCOMAT)
  1362. * DO I=1,NSTRS1
  1363. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1364. * enddo
  1365. * DO I=1,NVARI
  1366. * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1367. * enddo
  1368. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1369. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1370. * CALL INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1371. * & NCOMAT)
  1372. * DO I=1,NSTRS1
  1373. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1374. * enddo
  1375. * DO I=1,NVARI
  1376. * VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1377. * enddo
  1378. * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1379. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1380. C---------
  1381. ELSE IF (INPLAS.EQ.53) THEN
  1382. tau2=tau*0.5d0
  1383. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1384. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1385. CALL INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1386. & NCOMAT)
  1387. DO I=1,NSTRS1
  1388. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1389. ENDDO
  1390. DO I=1,NVARI
  1391. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1392. ENDDO
  1393. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1394. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1395. CALL INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1396. & NCOMAT)
  1397. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1398. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1399. CALL INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1400. & NCOMAT)
  1401. DO I=1,NSTRS1
  1402. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1403. enddo
  1404. DO I=1,NVARI
  1405. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1406. enddo
  1407. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1408. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1409. CALL INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1410. & NCOMAT)
  1411. DO I=1,NSTRS1
  1412. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1413. enddo
  1414. DO I=1,NVARI
  1415. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1416. enddo
  1417. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1418. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1419. C---------
  1420. ELSE IF (INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84.OR.
  1421. & INPLAS.EQ.102) THEN
  1422. tau2=tau*0.5d0
  1423. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1424. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1425. & MFR1)
  1426. CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS1,NVARI,
  1427. & EVP2,VARP2,TAU2)
  1428. DO I=1,NSTRS1
  1429. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1430. ENDDO
  1431. DO I=1,NVARI
  1432. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1433. ENDDO
  1434. C >>>> SI JE SUIS SUR LE PREMIER PAS <<<<
  1435. C et que j'ai calcule le resultat a la main
  1436. C _________________________________________
  1437. IF (VAR(12).GT.1.D0) THEN
  1438. C
  1439. DO I=1,NVARI
  1440. VARP2(I) = VARP1(I)
  1441. ENDDO
  1442. DO I=1,NSTRS1
  1443. EVP2(I) = EVP1(I)
  1444. ENDDO
  1445. ENDIF
  1446. C
  1447. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1448. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1449. & MFR1)
  1450. CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,NSTRS1,
  1451. & NVARI,EVP3,VARP3,TAU2)
  1452. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1453. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1454. & NCOMAT,MFR1)
  1455. CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,NSTRS1,
  1456. & NVARI,EVP4,VARP4,TAU2)
  1457. C print*,'==>4',VARP4(2),VARP4(3)
  1458. DO I=1,NSTRS1
  1459. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1460. enddo
  1461. C
  1462. DO I=1,NVARI
  1463. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1464. enddo
  1465. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1466. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1467. & NCOMAT,MFR1)
  1468. CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,NSTRS1,NVARI,
  1469. & EVP4,VARP4,TAU2)
  1470. DO I=1,NSTRS1
  1471. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1472. enddo
  1473. C
  1474. DO I=1,NVARI
  1475. VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1476. enddo
  1477. C print*,'==>5',VARP2(2),VARP2(3)
  1478. CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1479. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1480. & MFR1)
  1481. C----------
  1482. ELSE IF (INPLAS.EQ.63) THEN
  1483. tau2=tau*0.5d0
  1484. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1485. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1486. & MFR1)
  1487. CALL INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS1,MFR1,
  1488. & NVARI,NCOMAT,IFOURB)
  1489. DO I=1,NSTRS1
  1490. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1491. ENDDO
  1492. DO I=1,NVARI
  1493. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1494. ENDDO
  1495. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1496. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1497. & MFR1)
  1498. CALL INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS1,MFR1,
  1499. & NVARI,NCOMAT,IFOURB)
  1500. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1501. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1502. & NCOMAT,MFR1)
  1503. CALL INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1504. & NVARI,NCOMAT,IFOURB)
  1505. DO I=1,NSTRS1
  1506. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1507. enddo
  1508. DO I=1,NVARI
  1509. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1510. enddo
  1511. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1512. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1513. & NCOMAT,MFR1)
  1514. CALL INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1515. & NVARI,NCOMAT,IFOURB)
  1516. DO I=1,NSTRS1
  1517. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1518. enddo
  1519. DO I=1,NVARI
  1520. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1521. enddo
  1522. CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1523. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1524. & MFR1)
  1525. C--------
  1526. ELSE IF (INPLAS.EQ.70) THEN
  1527. tau2=tau*0.5d0
  1528. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1529. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1530. t12=(t0+tf)*0.5d0
  1531. CALL INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS1,MFR1,
  1532. & NVARI,NCOMAT)
  1533. C
  1534. DO I=1,NSTRS1
  1535. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1536. ENDDO
  1537. DO I=1,NVARI
  1538. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1539. ENDDO
  1540. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1541. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1542. CALL INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS1,MFR1,
  1543. & NVARI,NCOMAT)
  1544. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1545. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1546. CALL INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1547. & NVARI,NCOMAT)
  1548. DO I=1,NSTRS1
  1549. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1550. enddo
  1551. DO I=1,NVARI
  1552. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1553. enddo
  1554. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
  1555. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1556. CALL INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1557. & NVARI,NCOMAT)
  1558. DO I=1,NSTRS1
  1559. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1560. enddo
  1561. DO I=1,NVARI
  1562. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1563. enddo
  1564. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  1565. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1566. C---------
  1567. ELSE IF (INPLAS.EQ.29) THEN
  1568. C
  1569. 143 TAU2=0.5D0*TAU
  1570. C write(6,*) 'tau=',tau
  1571. C write(6,*) 'NSSINC=',NSSINC
  1572. * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
  1573. CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
  1574. & VARP1,NSTRS1,NVARI)
  1575. c write(6,*) 'varp1(3)=',varp1(3)
  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. * if (ib.eq.1.and.igau.eq.1)
  1586. * $ write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1587. aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
  1588. aap = max ( aap,ABS (Sig1(3)-SIG(3)))
  1589. IF ( aap . gt . XMAX * 5.) THEN
  1590. * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1591. rap = aap / xmax
  1592. TAU= TAU / rap
  1593. * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
  1594. go to 143
  1595. * do I=1,nstrs
  1596. * sig1(i)=XMAX*100.
  1597. * sigf(I)=xmax*200.
  1598. * enddo
  1599. * go to 250
  1600. endif
  1601. C
  1602. C-----------------------------------------------------------
  1603. C Mise a jour eventuelle de la nouvelle temperature TI1
  1604. C-----------------------------------------------------------
  1605. C
  1606. DELTAT=TPOINT*TAU2
  1607. TI12=TI0+DELTAT
  1608. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
  1609. C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
  1610. C-----------------------------------------------------------
  1611. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
  1612. & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1613. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
  1614. & NCOMAT,TI12,TINF,TSUP,ITEST,TRUC,NCOURB)
  1615. C
  1616. IF (ITHHER.EQ.2) THEN
  1617. C********** materiau dependant de la temperature **********************
  1618. C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
  1619. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1620. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1621. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1622. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  1623. & NCOURB)
  1624. C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
  1625. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1626. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1627. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1628. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  1629. & NCOURB)
  1630. C**********************************************************************
  1631. ENDIF
  1632. C------------------------------------------------------------------
  1633. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
  1634. C------------------------------------------------------------------
  1635. CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
  1636. CALL ZDANUL(EPSTHD,NSTRS1)
  1637. CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
  1638. DO I=1,3
  1639. EPSTHD(I)=CTH
  1640. ENDDO
  1641. C
  1642. c DO I=1,3
  1643. c WRITE(6,*) 'sig1(',I,')= ',sig1(I)
  1644. c ENDDO
  1645. CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
  1646. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1647. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1648. & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1649. & ITEST,ITHHER,TRUC,NCOURB)
  1650. c Do i=1,3
  1651. c write(6,*) 'sigp2(',i,')=',sigp2(i)
  1652. c enddo
  1653. C
  1654. do i=1,nstrs
  1655. sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
  1656. evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
  1657. enddo
  1658. do i=1,nvari
  1659. varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
  1660. enddo
  1661. t=tau2
  1662. CALL AVANXX(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 143
  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 143
  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
  1694. CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
  1695. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1696. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1697. & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1698. & ITEST,ITHHER,TRUC,NCOURB)
  1699. CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
  1700. & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
  1701. DELTAT=TPOINT*TAU
  1702. TI1=TI0+DELTAT
  1703. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
  1704. C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
  1705. C-----------------------------------------------------------
  1706. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1707. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,
  1708. & NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,
  1709. & XMAT,NCOMAT,TI1,TINF,TSUP,ITEST,TRUC,NCOURB)
  1710. IF (ITHHER.EQ.2) THEN
  1711. C********** materiau dependant de la temperature **********************
  1712. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  1713. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1714. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1715. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1716. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  1717. & NCOURB)
  1718. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  1719. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1720. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1721. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1722. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  1723. & NCOURB)
  1724. C**********************************************************************
  1725. ENDIF
  1726. C------------------------------------------------------------------
  1727. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
  1728. C------------------------------------------------------------------
  1729. CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
  1730. CALL ZDANUL(EPSTHD,NSTRS1)
  1731. CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
  1732. DO I=1,3
  1733. EPSTHD(I)=CTH
  1734. ENDDO
  1735. C
  1736. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1737. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1738. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1739. & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1740. & ITEST,ITHHER,TRUC,NCOURB)
  1741. do i=1,nstrs
  1742. sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
  1743. evp4(i) =0.5D0*( evp4(i)+ evp3(i))
  1744. enddo
  1745. do i=1,nvari
  1746. varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
  1747. enddo
  1748. call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
  1749. & EVP4,VARP4,NSTRS1,NVARI)
  1750. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1751. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1752. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1753. & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1754. & ITEST,ITHHER,TRUC,NCOURB)
  1755. DO I=1,NSTRS1
  1756. EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
  1757. SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
  1758. ENDDO
  1759. DO I=1,NVARI
  1760. VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
  1761. ENDDO
  1762. T=TAU
  1763. CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
  1764. & VARP2,NSTRS1,NVARI)
  1765. c Do i=1,6
  1766. c write(6,*) 'sig1(',i,')=',sig1(i)
  1767. c enddo
  1768. c Do i=1,6
  1769. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1770. c enddo
  1771. c Do i=1,3
  1772. c write(6,*) 'var1(',i,')=',var1(i)
  1773. c enddo
  1774. c IF (TAU.NE.T) GOTO 143
  1775. C---------
  1776. ELSE IF (INPLAS.EQ.142) THEN
  1777. C
  1778. 144 TAU2=0.5D0*TAU
  1779. C write(6,*) 'tau=',tau
  1780. C write(6,*) 'NSSINC=',NSSINC
  1781. * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
  1782. CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
  1783. & VARP1,NSTRS1,NVARI)
  1784. c Do i=2,4
  1785. c write(6,*) 'varp1(',i,')=',varp1(i)
  1786. c enddo
  1787. c Do i=1,6
  1788. c write(6,*) 'sig1(',i,')=',sig1(i)
  1789. c enddo
  1790. c Do i=1,6
  1791. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1792. c enddo
  1793. c Do i=1,7
  1794. c write(6,*) 'var1(',i,')=',var1(i)
  1795. c enddo
  1796. aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
  1797. aap = max ( aap,ABS (Sig1(3)-SIG(3)))
  1798. IF ( aap . gt . XMAX * 5.) THEN
  1799. * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1800. rap = aap / xmax
  1801. TAU= TAU / rap
  1802. go to 144
  1803. * do I=1,nstrs
  1804. * sig1(i)=XMAX*100.
  1805. * sigf(I)=xmax*200.
  1806. * enddo
  1807. * go to 250
  1808. endif
  1809. C
  1810. C-----------------------------------------------------------
  1811. C Mise a jour eventuelle de la nouvelle temperature TI1
  1812. C-----------------------------------------------------------
  1813. C
  1814. DELTAT=TPOINT*TAU2
  1815. TI12=TI0+DELTAT
  1816. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
  1817. C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
  1818. C-----------------------------------------------------------
  1819. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1820. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
  1821. & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
  1822. & XMAT,NCOMAT,TI12,TINF,TSUP,ITEST)
  1823. C
  1824. IF (ITHHER.EQ.2) THEN
  1825. C********** materiau dependant de la temperature **********************
  1826. C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
  1827. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1828. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1829. & NYA1,YQ1,NYQ1,YALFT2,NYALFT1,YRHO1,NYRHO1,
  1830. & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  1831. C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
  1832. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1833. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1834. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1835. & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
  1836. C**********************************************************************
  1837. ENDIF
  1838. C------------------------------------------------------------------
  1839. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
  1840. C------------------------------------------------------------------
  1841. CALL DERTRA(NYALFT1,YALFT1,TI12,ALFA1,ALFAV1,TO,TO)
  1842. CALL ZDANUL(EPSTHD,NSTRS1)
  1843. CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
  1844. DO I=1,3
  1845. EPSTHD(I)=CTH
  1846. ENDDO
  1847. C
  1848. c DO I=1,4
  1849. c WRITE(6,*) 'VAR1(',I,')= ',VAR1(I)
  1850. c ENDDO
  1851. c DO I=1,6
  1852. c WRITE(6,*) 'SIG1(',I,')= ',SIG1(I)
  1853. c ENDDO
  1854. CALL XXCRE1(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
  1855. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1856. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1857. & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1858. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1859. c DO I=1,4
  1860. c WRITE(6,*) 'VAR1 ap(',I,')= ',VAR1(I)
  1861. c ENDDO
  1862. c DO I=1,4
  1863. c WRITE(6,*) 'VARP2(',I,')= ',VARP2(I)
  1864. c ENDDO
  1865. c DO I=1,6
  1866. c WRITE(6,*) 'SIGP2(',I,')= ',SIGP2(I)
  1867. c ENDDO
  1868. c DO I=1,6
  1869. c WRITE(6,*) 'EVP2(',I,')= ',EVP2(I)
  1870. c ENDDO
  1871. C
  1872. do i=1,nstrs
  1873. sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
  1874. evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
  1875. enddo
  1876. do i=1,nvari
  1877. varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
  1878. enddo
  1879. t=tau2
  1880. CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,EVP2,
  1881. & VARP2,NSTRS1,NVARI)
  1882. c Do i=1,6
  1883. c write(6,*) 'sig12(',i,')=',sig12(i)
  1884. c enddo
  1885. c Do i=1,6
  1886. c write(6,*) 'epsv12(',i,')=',epsv12(i)
  1887. c enddo
  1888. c Do i=1,7
  1889. c write(6,*) 'var12(',i,')=',var12(i)
  1890. c enddo
  1891. if (tau2.ne.t) then
  1892. tau=2.d0*tau2
  1893. goto 144
  1894. endif
  1895. * if (ib.eq.1.and.igau.eq.1)
  1896. * $ write(6,*)'SIg1(1) SIg2 sig3',sig12(1),sig12(2),sig12(3)
  1897. aap = MAX(ABS(SIG12(1)-SIG(1)),ABS(SIG12(2)-SIG(2)))
  1898. aap = max ( aap,ABS (Sig12(3)-SIG(3)))
  1899. IF ( aap . gt . XMAX * 5.) THEN
  1900. * write(6,*)'SIg12(1) SIg12 SI1g3',sig12(1),sig12(2),sig12(3)
  1901. rap = aap / xmax
  1902. TAU= TAU / rap
  1903. * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
  1904. go to 144
  1905. * do I=1,nstrs
  1906. * sig1(i)=XMAX*100.
  1907. * sigf(I)=xmax*200.
  1908. * enddo
  1909. * go to 250
  1910. endif
  1911. C
  1912. CALL XXCRE1(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
  1913. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1914. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1915. & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1916. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1917. CALL AVANX1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
  1918. & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
  1919. DELTAT=TPOINT*TAU
  1920. TI1=TI0+DELTAT
  1921.  
  1922. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
  1923. C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
  1924. C-----------------------------------------------------------
  1925. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1926. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1927. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  1928. & NSIGY1,XMAT,NCOMAT,TI1,TINF,TSUP,ITEST)
  1929. IF (ITHHER.EQ.2) THEN
  1930. C********** materiau dependant de la temperature **********************
  1931. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  1932. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1933. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1934. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1935. & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  1936. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  1937. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1938. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1939. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1940. & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
  1941. C**********************************************************************
  1942. ENDIF
  1943. C------------------------------------------------------------------
  1944. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
  1945. C------------------------------------------------------------------
  1946. CALL DERTRA(NYALFT1,YALFT1,TI1,ALFA1,ALFAV1,TO,TO)
  1947. CALL ZDANUL(EPSTHD,NSTRS1)
  1948. CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
  1949. DO I=1,3
  1950. EPSTHD(I)=CTH
  1951. ENDDO
  1952. C
  1953. CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1954. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1955. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1956. & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1957. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1958. do i=1,nstrs
  1959. sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
  1960. evp4(i) =0.5D0*( evp4(i)+ evp3(i))
  1961. enddo
  1962. do i=1,nvari
  1963. varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
  1964. enddo
  1965. call AVANX1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
  1966. & EVP4,VARP4,NSTRS1,NVARI)
  1967. CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1968. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1969. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1970. & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1971. & ITEST,ITHHER,VART,IB,IGAU,kerre)
  1972. DO I=1,NSTRS1
  1973. EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
  1974. SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
  1975. ENDDO
  1976. DO I=1,NVARI
  1977. VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
  1978. ENDDO
  1979. T=TAU
  1980. CALL AVANX1(TAU,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP2,EVP2,
  1981. & VARP2,NSTRS1,NVARI)
  1982. c Do i=1,6
  1983. c write(6,*) 'sig1(',i,')=',sig1(i)
  1984. c enddo
  1985. c Do i=1,6
  1986. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1987. c enddo
  1988. c Do i=1,7
  1989. c write(6,*) 'var1(',i,')=',var1(i)
  1990. c enddo
  1991. c IF (TAU.NE.T) GOTO 144
  1992. ENDIF
  1993. GOTO 250
  1994. C _____________________________________________________________________
  1995. 150 CONTINUE
  1996. C----------------------------------------------------------------------
  1997. C CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
  1998. C----------------------------------------------------------------------
  1999. IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61) THEN
  2000. tau2=tau*0.5d0
  2001. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2002. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2003. CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
  2004. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2005. DO I=1,NSTRS1,1
  2006. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2007. ENDDO
  2008. IF (INPLAS.EQ.24) THEN
  2009. DO I=1,NVARI
  2010. VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  2011. ENDDO
  2012. ELSE
  2013. DO I=1,2*NSTRS1+2
  2014. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2015. ENDDO
  2016. DO I=2*NSTRS1+4,NVARI
  2017. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2018. ENDDO
  2019. ENDIF
  2020. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2021. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2022. CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
  2023. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2024. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2025. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2026. & NCOMAT)
  2027. CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
  2028. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2029. DO I=1,NSTRS1
  2030. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  2031. enddo
  2032. IF (INPLAS.EQ.24) THEN
  2033. DO I=1,NVARI
  2034. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  2035. enddo
  2036. ELSE
  2037. DO I=1,2*NSTRS1+2
  2038. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2039. enddo
  2040. DO I=2*NSTRS1+4,NVARI
  2041. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2042. enddo
  2043. ENDIF
  2044. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2045. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2046. & NCOMAT)
  2047. CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
  2048. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2049. DO I=1,NSTRS1,1
  2050. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2051. enddo
  2052. IF (INPLAS.EQ.24) THEN
  2053. DO I=1,NVARI
  2054. VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2055. enddo
  2056. ELSE
  2057. DO I=1,2*NSTRS1+2
  2058. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2059. enddo
  2060. DO I=2*NSTRS1+4,NVARI
  2061. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2062. enddo
  2063. endif
  2064. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2065. & VARp2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2066. C---------
  2067. ELSE IF (INPLAS.EQ.25) THEN
  2068. tau2=tau*0.5d0
  2069. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2070. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2071. CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2072. & NCOMAT)
  2073. DO I=1,NSTRS1
  2074. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2075. ENDDO
  2076. DO I=1,NVARI
  2077. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2078. ENDDO
  2079. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2080. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2081. CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2082. & NCOMAT)
  2083. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2084. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2085. & NCOMAT)
  2086. CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2087. & NCOMAT)
  2088. DO I=1,NSTRS1
  2089. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  2090. enddo
  2091. DO I=1,NVARI
  2092. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2093. enddo
  2094. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2095. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2096. & NCOMAT)
  2097. CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2098. & NCOMAT)
  2099. DO I=1,NSTRS1
  2100. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2101. enddo
  2102. DO I=1,NVARI
  2103. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2104. enddo
  2105. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2106. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2107. C---------
  2108. ELSE IF (INPLAS.EQ.76) THEN
  2109. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,
  2110. & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2111. & NCOMAT)
  2112. CALL INCRA4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2113. & NCOMAT)
  2114. DO I=1,NSTRS1
  2115. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2116. ENDDO
  2117. DO I=1,NVARI
  2118. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2119. ENDDO
  2120. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2121. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2122. * tau2=tau*0.5d0
  2123. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  2124. * & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2125. * & NCOMAT)
  2126. * CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2127. * & NCOMAT)
  2128. * DO I=1,NSTRS1
  2129. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2130. * ENDDO
  2131. * DO I=1,NVARI
  2132. * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2133. * ENDDO
  2134. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2135. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2136. * CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2137. * & NCOMAT)
  2138. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2139. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2140. * & NCOMAT)
  2141. * CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2142. * & NCOMAT)
  2143. * DO I=1,NSTRS1
  2144. * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2145. * enddo
  2146. * DO I=1,NVARI
  2147. * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2148. * enddo
  2149. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2150. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2151. * & NCOMAT)
  2152. * DO I=1,NSTRS1
  2153. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2154. * enddo
  2155. * DO I=1,NVARI
  2156. * VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2157. * enddo
  2158. * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2159. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2160. C---------
  2161. ELSE IF (INPLAS.EQ.77) THEN
  2162. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  2163. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,ncomat)
  2164. CALL INCRB4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2165. & NCOMAT)
  2166. DO I=1,NSTRS1
  2167. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2168. enddo
  2169. DO I=1,NVARI
  2170. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2171. enddo
  2172. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2173. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2174. * tau2=tau*0.5d0
  2175. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2176. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2177. * CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2178. * & NCOMAT)
  2179. * DO I=1,NSTRS1
  2180. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2181. * ENDDO
  2182. * DO I=1,NVARI
  2183. * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2184. * ENDDO
  2185. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2186. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2187. * CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2188. * & NCOMAT)
  2189. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2190. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2191. * & NCOMAT)
  2192. * CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2193. * & NCOMAT)
  2194. * DO I=1,NSTRS1
  2195. * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2196. * enddo
  2197. * DO I=1,NVARI
  2198. * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2199. * enddo
  2200. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2201. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2202. * & NCOMAT)
  2203. * CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2204. * & NCOMAT)
  2205. * DO I=1,NSTRS1
  2206. * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2207. * enddo
  2208. * DO I=1,NVARI
  2209. * VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2210. * enddo
  2211. * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2212. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2213. C---------
  2214. ELSE IF (INPLAS.EQ.53) THEN
  2215. tau2=tau*0.5d0
  2216. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  2217. & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2218. & NCOMAT)
  2219. CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2220. & NCOMAT)
  2221. DO I=1,NSTRS1
  2222. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2223. ENDDO
  2224. DO I=1,NVARI
  2225. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2226. ENDDO
  2227. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2228. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2229. CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2230. & NCOMAT)
  2231. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2232. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2233. & NCOMAT)
  2234. CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2235. & NCOMAT)
  2236. DO I=1,NSTRS1
  2237. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2238. enddo
  2239. DO I=1,NVARI
  2240. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2241. enddo
  2242. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2243. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2244. & NCOMAT)
  2245. CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2246. & NCOMAT)
  2247. DO I=1,NSTRS1
  2248. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2249. enddo
  2250. DO I=1,NVARI
  2251. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2252. enddo
  2253. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2254. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2255. C---------
  2256. ENDIF
  2257. GOTO 250
  2258. C
  2259. C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
  2260. C
  2261. 210 CONTINUE
  2262. IF (INPLAS.NE.19) GOTO 999
  2263. tau2=tau*0.5d0
  2264. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
  2265. & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2266. CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCARB,EVP2,VARP2,NSTRS1,
  2267. & NVARI,INPLAS,NCOMAT,KERREU1)
  2268. DO I=1,6
  2269. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2270. ENDDO
  2271. DO I=1,4
  2272. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2273. ENDDO
  2274. DO I=6,NVARI
  2275. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2276. ENDDO
  2277. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2278. & VARP2,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2279. & NCOMAT)
  2280. CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCARB,EVP3,VARP3,
  2281. & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
  2282. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2283. & EVP3,VARP3,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2284. & NCOMAT)
  2285. CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCARB,EVP4,VARP4,
  2286. & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
  2287. DO I=1,6
  2288. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2289. enddo
  2290. DO I=1,4
  2291. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2292. enddo
  2293. DO I=6,NVARI
  2294. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2295. enddo
  2296. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,EVP4,
  2297. & VARP4,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2298. & NCOMAT)
  2299. CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCARB,EVP4,VARP4,NSTRS1,
  2300. & NVARI,INPLAS,NCOMAT,KERREU1)
  2301. DO I=1,6
  2302. EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2303. enddo
  2304. DO I=1,4
  2305. VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2306. enddo
  2307. DO I=6,NVARI
  2308. VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2309. enddo
  2310. CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  2311. & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2312. C
  2313. C----------------------------------------------------------------------
  2314. 250 CONTINUE
  2315. C ---------------------------------------------------------------------
  2316. C CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
  2317. C ---------------------------------------------------------------------
  2318. DO I=1,NSTRS1
  2319. XX(I) = SIGF(I)-SIG1(I)
  2320. ENDDO
  2321. RA = SQRT(PROCON(XX,XX,NSTRS1))/(ERRABS)
  2322. c
  2323. * write(6,*) ' ra ' , ra
  2324. IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  2325. RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
  2326. ENDIF
  2327. SQRA = SQRT(RA)
  2328. IF (INPLAS.EQ.29) THEN
  2329. RD = 0.D0
  2330. IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
  2331. RD = (VARF(3)-VAR1(3))/VARF(3)
  2332. RD = ABS(RD)/1.D-4
  2333. ENDIF
  2334. RA = DMAX1(RA,RD)
  2335. SQRA = SQRT(RA)
  2336. ELSEIF (INPLAS.EQ.142) THEN
  2337. RD = 0.D0
  2338. IF (VARF(8).NE.0.D0.AND.VAR1(8).GT.1.0D-5) THEN
  2339. RD = (VARF(8)-VAR1(8))/VARF(8)
  2340. RD = ABS(RD)/1.D-4
  2341. ENDIF
  2342. RA = DMAX1(RA,RD)
  2343. SQRA = SQRT(RA)
  2344. ENDIF
  2345. C ---------------------------------------------------------------------
  2346. C TEST DE FIN D'ITERATIONS / MISE A JOUR DE TAU /OPTION JECHER
  2347. C DIV =7 BORNE = 2
  2348. C SI SQRA>7 TAU = TAU/7 ET NOUVEL ESSAI
  2349. C SI 2<RA<7*7 ON VISE RA = 1 ET NOUVEL ESSAI
  2350. C ------------------------------------------------------------------
  2351.  
  2352. IF (.not.iforce.and.dtlibr ) Then
  2353. c petite ruse pour dejouer l'optimisation
  2354. ra1=ra*1.d0
  2355. * write(6,*) ' ra, div tau taux' , ra, div,tau,taux
  2356. IF ((RA.GT.DIV*DIV).OR.(RA.NE.RA1)) THEN
  2357. TAU = TAU/div
  2358. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.142)) TAU = DMIN1(TAU,TAUX)
  2359. DELTAT=TPOINT*TAU
  2360. TI1=TI0+DELTAT
  2361. GOTO 80
  2362. ELSEIF ( RA.GT.(BORNE)) THEN
  2363. TAU = TAU/SQRA
  2364. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.142)) TAU = DMIN1(TAU,TAUX)
  2365. DELTAT=TPOINT*TAU
  2366. TI1=TI0+DELTAT
  2367. GOTO 80
  2368. ENDIF
  2369. endif
  2370. C ---------------------------------------------------------------------
  2371. C ici ra < borne cas JECHER :
  2372. C ---------------------------------------------------------------------
  2373. C je n'ai pas trouvé comment jecher = 1 pour moi jamais. TC
  2374. IF (JECHER.EQ.1) THEN
  2375. * write(6,*) ' on passe dans jecher = 1'
  2376. DTT = TAU
  2377. NSSINC = NITERA
  2378. IF ((NSSINC.EQ.1).AND.(RA.EQ.0.0)) GOTO 999
  2379. IF (NITERA.GE.8) GOTO 999
  2380. IF (FAC*SQRA.LT.1.0) THEN
  2381. TAU = TAU*FAC
  2382. DELTAT=TPOINT*TAU
  2383. TI1=TI0+DELTAT
  2384. GOTO 80
  2385. ELSEIF ((SQRA.LT.RMIN).OR.(SQRA.GT.RMAX)) THEN
  2386. TAU = TAU/SQRA
  2387. DELTAT=TPOINT*TAU
  2388. TI1=TI0+DELTAT
  2389. GOTO 80
  2390. ENDIF
  2391. C ---------------------------------------------------------------------
  2392. C ici rmin < sqra < rmax et nitera < 8
  2393. C pas de mise @ jour des variables
  2394. C ---------------------------------------------------------------------
  2395. GOTO 999
  2396. ENDIF
  2397. C ----------------------------------------------------------------------
  2398. C FIN D'ITERATIONS / MISE A JOUR DES VARIABLES
  2399. C ici RA < BORNE
  2400. C fin des boucles sur tau optimal
  2401. C on avance en temps
  2402. C mise @ jour de SIG etc...
  2403. C -------------------------------------------------------------------
  2404. INV = INV + IVTEST
  2405. DO I=1,NSTRS1,1
  2406. SIG(I) = SIGF(I)
  2407. EPSV(I) = EPINF(I)
  2408. ENDDO
  2409. DO I=1,NVARI,1
  2410. VAR(I) = VARF(I)
  2411. ENDDO
  2412. * if(pasbea.lt.ra) pasbea=ra
  2413. if(iforce)iffo=iffo+1
  2414.  
  2415. * IF ( nssinc.eq. 1) dtprem = tau
  2416. * IF ( nssinc.eq. 2) dtseco = tau
  2417. C
  2418. IF (INPLAS.EQ.29) THEN
  2419. C--------------------------------------------------------------
  2420. C Estimation du pas de temps apres la mise a jour des variables
  2421. C--------------------------------------------------------------
  2422. C
  2423. CALL ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
  2424. & NCOMAT,TI1,TD,TRUC,NCOURB)
  2425.  
  2426. IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
  2427. VARF(3)=1.D0
  2428. TLIFE = DT - (DTLEFT - TAU)
  2429. GOTO 999
  2430. ENDIF
  2431. C
  2432. ELSEIF (INPLAS.EQ.142) THEN
  2433. C--------------------------------------------------------------
  2434. C Estimation du pas de temps apres la mise a jour des variables
  2435. C--------------------------------------------------------------
  2436. C
  2437. CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI1,TD)
  2438.  
  2439. IF ((VARF(8).GE.0.96).OR.(TD.LT.1.D0)) THEN
  2440. VARF(8)=1.D0
  2441. TLIFE = DT - (DTLEFT - TAU)
  2442. GOTO 999
  2443. ENDIF
  2444. ENDIF
  2445. C
  2446. C --------------------------------------------------------------------
  2447. C TEST DE FIN SS INCREMENTS / MISE A JOUR DE TAU
  2448. C si SQRA<1/3 TAU = TAU*3
  2449. C si 1/3<SQRA<RMIN on vise RA = 1
  2450. C si RMIN<SQRA<RMAX TAU inchang{
  2451. C si SQRA>RMAX on vise RA = 1
  2452. C fin des boucles en ss increments si tau = dtleft
  2453. C --------------------------------------------------------------------
  2454. C
  2455. IF ( TAU.LT.DTLEFT ) THEN
  2456. * DTDEUX=TAU
  2457. DTLEFT = DTLEFT - TAU
  2458. * IF (dtlibr) then
  2459. IF ( FAC*SQRA.LT.1.D0) THEN
  2460. TAU=TAU*FAC
  2461. ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
  2462. TAU=TAU/SQRA
  2463. ENDIF
  2464. * else
  2465. * TAU = TAU * R
  2466. * endif
  2467. IF (TAU.GT.DTLEFT) then
  2468. TAU = DTLEFT
  2469. endif
  2470. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.107).OR.(INPLAS.EQ.142)) THEN
  2471. C----------------------------------------------------------------------------
  2472. C Mise a jour des temperatures
  2473. C TI0 temperature au dedut du pas de sous-incrementation avec TINF<TI0<TSUP
  2474. C TI1 temperature a la fin du pas de sous-incrementation
  2475. C-----------------------------------------------------------------------------
  2476. TI0=TI1
  2477. DELTAT=TPOINT*TAU
  2478. TI1=TI0+DELTAT
  2479. ENDIF
  2480. IF (INPLAS.EQ.107) THEN
  2481. C----------------------------------------------------------------------------
  2482. C Mise a jour des densites de fissions
  2483. C FII0 densite de fissions au dedut du pas de sous-incrementation
  2484. C FII1 densite de fissions a la fin du pas de sous-incrementation
  2485. C-----------------------------------------------------------------------------
  2486. FII0=FII1
  2487. DELTAF=FPOINT*TAU
  2488. FII1=FII0+DELTAF
  2489. ENDIF
  2490. GOTO 70
  2491. ENDIF
  2492. C
  2493. IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
  2494. WRITE ( IOIMP,* ) ' PROBLEME TAU > DTLEFT '
  2495. KERRE = 223
  2496. ENDIF
  2497.  
  2498. C-----------------------------------------------------------------------
  2499. 999 CONTINUE
  2500. * if(ib.eq.1.and.igau.eq.1) then
  2501. * write(6,*)'inplas nssinc nopri pasbea iforce',inplas,nssinc,nopri
  2502. * $ ,pasbea,iffo
  2503. * endif
  2504. IF (MFR1.EQ.3) THEN
  2505. DO 1000 I=1,NSTRS1/2
  2506. SIGF( I) =SIGF( I)*THICK
  2507. SIGF(NSTRS1/2+I) =SIGF(NSTRS1/2+ I)*THICK*THICK/6.0
  2508. * DSIGT( I)=DSIGT( I)*THICK
  2509. * DSIGT(NSTRS1/2+I)=DSIGT(NSTRS1/2+I)*THICK*THICK/6.0
  2510. 1000 CONTINUE
  2511. ENDIF
  2512. C
  2513. C===========================================================
  2514. C RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
  2515. C A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
  2516. C DEFINIES PAR DES GAMA.
  2517. C ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
  2518. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  2519. C DE LEMAITRE (INPLAS=29).
  2520. C
  2521. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  2522. C MFR1=1 (MASSIF)
  2523. C MFR1=5 (COQUES EPAISSES)
  2524. C MFR1=3 (COQUES MINCES)
  2525. C MFR1=17 (TUYAUX FISSURES)
  2526. C MFR1=33 (POREUX)
  2527. C
  2528. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  2529. C
  2530. C Cas de la formulation massive
  2531. C Les termes de cisaillement apparaissent
  2532. C au delà de la troisieme composante
  2533. C
  2534. IF (MFR1.EQ.1.OR.MFR1.EQ.33) THEN
  2535. DO 14 I=1,NSTRS1
  2536. A=1.D0
  2537. IF (I.GT.3) A=2.D0
  2538. EPIN0(I)=EPIN0(I)*A
  2539. EPINF(I)=EPINF(I)*A
  2540. 14 CONTINUE
  2541. C
  2542. C Cas des coques épaisses
  2543. C Les termes de cisaillement apparaissent
  2544. C au delà de la deuxieme composante
  2545. C
  2546. ELSE IF (MFR1.EQ.5) THEN
  2547. DO 15 I=1,NSTRS1
  2548. A=1.D0
  2549. IF (I.GT.2) A=2.D0
  2550. EPIN0(I)=EPIN0(I)*A
  2551. EPINF(I)=EPINF(I)*A
  2552. 15 CONTINUE
  2553. C
  2554. C Cas des coques minces
  2555. C Les termes de cisaillement apparaissent
  2556. C pour la troisieme et la sixieme composante
  2557. C uniquement dans les cas de calculs
  2558. C tridimensionnels ou d'analyse de Fourier
  2559. C
  2560. ELSE IF (MFR1.EQ.3) THEN
  2561. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  2562. DO 16 I=1,NSTRS1
  2563. A=1.D0
  2564. IF (I.EQ.3) A=2.D0
  2565. IF (I.EQ.6) A=2.D0
  2566. EPIN0(I)=EPIN0(I)*A
  2567. EPINF(I)=EPINF(I)*A
  2568. 16 CONTINUE
  2569. ENDIF
  2570. C
  2571. C Reste le cas des tuyaux fissurés (MFR1=17)
  2572. C
  2573. ENDIF
  2574. ENDIF
  2575. C
  2576. C===========================================================
  2577. C
  2578. 998 RETURN
  2579. END
  2580.  
  2581.  
  2582.  
  2583.  
  2584.  
  2585.  
  2586.  
  2587.  
  2588.  
  2589.  
  2590.  
  2591.  
  2592.  
  2593.  
  2594.  
  2595.  
  2596.  
  2597.  
  2598.  
  2599.  
  2600.  
  2601.  
  2602.  
  2603.  
  2604.  
  2605.  
  2606.  
  2607.  
  2608.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales