Télécharger consti.eso

Retour à la liste

Numérotation des lignes :

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

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