Télécharger cconst.eso

Retour à la liste

Numérotation des lignes :

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

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