Télécharger coml8.eso

Retour à la liste

Numérotation des lignes :

  1. C COML8 SOURCE CB215821 19/08/20 21:16:06 10287
  2. SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3. & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  4. & iretou,wrk12,WR12,WRKK2,wrkgur,wkumat,wcreep,
  5. & ecou,iecou,necou,xecou)
  6.  
  7. *----------------------------------------------------------------
  8. * lois locales pour la mecanique
  9. * decrites au point d integration
  10. *----------------------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC CCHAMP
  18. -INC SMMODEL
  19. -INC SMELEME
  20. -INC SMINTE
  21. -INC SMCOORD
  22. * segment deroulant le mcheml
  23. -INC DECHE
  24. *
  25. SEGMENT WRK2
  26. REAL*8 TRAC(LTRAC)
  27. ENDSEGMENT
  28. *
  29. SEGMENT WRK3
  30. REAL*8 WORK(LW),WORK2(LW2)
  31. ENDSEGMENT
  32. *
  33. SEGMENT MWRKXE
  34. REAL*8 XE(3,NBNNbi)
  35. ENDSEGMENT
  36. *
  37. SEGMENT WRK6
  38. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  39. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  40. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  41. ENDSEGMENT
  42. *
  43. SEGMENT WRK7
  44. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  45. ENDSEGMENT
  46. *
  47. SEGMENT WRK8
  48. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  49. REAL*8 DDINVp(NSTRS,NSTRS)
  50. ENDSEGMENT
  51. *
  52. SEGMENT WRK9
  53. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  54. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  55. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  56. REAL*8 SIGY(NSIGY)
  57. INTEGER NKX(NNKX)
  58. ENDSEGMENT
  59. *
  60. SEGMENT WRK91
  61. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  62. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  63. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  64. REAL*8 SIGY1(NSIGY1)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WR10
  68. INTEGER IABLO1(NTABO1)
  69. REAL*8 TABLO2(NTABO2)
  70. ENDSEGMENT
  71. *
  72. SEGMENT WR11
  73. INTEGER IABLO3(NTABO3)
  74. REAL*8 TABLO4(NTABO4)
  75. ENDSEGMENT
  76. *
  77. SEGMENT WR12
  78. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  79. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  80. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  81. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  82. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  83. REAL*8 SM8(NSTRS)
  84. ENDSEGMENT
  85. SEGMENT WRK12
  86. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  87. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  88. real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  89. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  90. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  91. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  92. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  93. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  94. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  95. ENDSEGMENT
  96. SEGMENT WRK22
  97. REAL*8 XXE(3,NBNNbi)
  98. ENDSEGMENT
  99.  
  100. SEGMENT WRKGUR
  101. REAL*8 WGUR1,WGUR2,WGUR3,WGUR4,WGUR5,WGUR6,WGUR7
  102. REAL*8 WGUR8,WGUR9,WGUR10,WGUR11,WGUR12(6)
  103. REAL*8 WGUR13(7), WGUR14
  104. REAL*8 WGUR15,WGUR16,WGUR17
  105. ENDSEGMENT
  106. C
  107. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  108. C l'integrateur externe specifique UMAT
  109. C
  110. SEGMENT WKUMAT
  111. C Entrees/sorties de la routine UMAT
  112. REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  113. & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  114. & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  115. & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  116. CHARACTER*16 CMNAME
  117. INTEGER NDI, NSHR, NSTATV, NPROPS,
  118. & LAYER, KSPT, KSTEP, KINC
  119. C Variables de travail
  120. LOGICAL LTEMP, LPRED, LVARI, LDFGRD
  121. INTEGER NSIG0, NPARE0, NGRAD0
  122. ENDSEGMENT
  123. C
  124. C Segment de travail pour les lois 'VISCO_EXTERNE'
  125. C
  126. SEGMENT WCREEP
  127. C Entrees/sorties constantes de la routine CREEP
  128. REAL*8 SERD
  129. CHARACTER*16 CMNAMC
  130. INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC
  131. C Entrees/sorties de la routine CREEP pouvant varier
  132. REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV),
  133. & STVP2(NSTV), STV12(NSTV), STVP3(NSTV),
  134. & STVP4(NSTV), STV13(NSTV), STVF(NSTV),
  135. & TMP12, TMP, TMP32,
  136. & DTMP12, DTMP,
  137. & PRD12(NPRD), PRD(NPRD), PRD32(NPRD),
  138. & DPRD12(NPRD), DPRD(NPRD)
  139. INTEGER KSTEPC
  140. C Autres indicateurs et variables de travail
  141. LOGICAL LTMP, LPRD, LSTV
  142. INTEGER IVIEX, NPAREC
  143. REAL*8 dTMPdt, dPRDdt(NPRD)
  144. ENDSEGMENT
  145. *
  146. SEGMENT ENDO0
  147. REAL*8 ENDO(LENDO),RAPP(LENDO)
  148. ENDSEGMENT
  149. *
  150. character*16 modemo
  151. REAL*8 CRIGI(12),CMASS(12)
  152. DIMENSION NWA(9)
  153. DIMENSION SIG01(8),VAR01(37)
  154. DIMENSION EPSFLU(8)
  155.  
  156. SEGMENT ECOU
  157. REAL*8 ecow00,ecow0,
  158. C REAL*8 TEST, ALFAH,
  159. 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
  160. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  161. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  162. 2 ecow12(6),
  163. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  164. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  165. C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  166. 2 ecow17(6),ecow18(6),ecow19,ecow20
  167. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  168. ENDSEGMENT
  169. *
  170. * Segment NECOU utilisé dans ECOINC
  171. *
  172. SEGMENT NECOU
  173. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  174. . ITYP,IFOURB,IFLUAG,
  175. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  176. . JFLUAG,KFLUAG,LFLUAG,
  177. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  178. ENDSEGMENT
  179. *
  180. * Segment IECOU: sert de fourre-tout pour les initialisations
  181. * d'entiers
  182. *
  183. SEGMENT IECOU
  184. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  185. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  186. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  187. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  188. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  189. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  190. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  191. ENDSEGMENT
  192. *
  193. * Segment XECOU: sert de fourre-tout pour les initialisations
  194. * de réels
  195. *
  196. SEGMENT XECOU
  197. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  198. ENDSEGMENT
  199. C-----------------------------------------------------------------------
  200. C
  201. c moterr(1:6) = 'COML8 '
  202. c moterr(7:15) = 'element '
  203. c interr(1) = ib
  204. c interr(2) = igau
  205. c call erreur(-329)
  206. * write(6,*) ' entrée dans coml8 iecou ', iecou
  207. C imodel = iqmod
  208. c
  209. c traitement du modele
  210. c
  211. c NFOR=FORMOD(/2)
  212. c NMAT=MATMOD(/2)
  213. c
  214. NSSINC = 0
  215. INV = 0
  216. NBPGAU = nbgs
  217. NVARI = NVART
  218. TETA1 = ture0(1)
  219. TETA2 = turef(1)
  220. SUCC1 = -1.E35
  221. SUCC2 = -1.E35
  222. nexo = exova0(/1)
  223. if (nexo.gt.0) then
  224. do 1296 inex = 1,nexo
  225. if ((nomexo(inex)(1:4) .eq.'SUCC').and.
  226. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  227. SUCC1 = exova0(inex)
  228. SUCC2 = exova1(inex)
  229. goto 1295
  230. endif
  231. 1296 continue
  232. endif
  233. 1295 continue
  234. jnplas = inplas + 3
  235. * inplas -2 -1 0
  236. GOTO ( 898, 899, 900,
  237. * inplas 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
  238. $ 900,302,900,900,900,900,900,900,309,900,900,900,900,314,900,
  239. $ 316,900,318,900,900,900,900,900,900,900,326,327,328,329,330,
  240. * 31
  241. $ 331,332,333,334,335,336,337,338,339,340,341,342,900,900,900,
  242. $ 900,347,348,349,350,351,352,900,354,355,356,357,358,359,360,
  243. * 61
  244. $ 900,362,900,364,365,366,367,368,369,900,371,372,373,374,375,
  245. $ 900,900,378,379,380,900,900,900,900,900,900,900,388,389,900,
  246. * 91
  247. $ 391,392,393,900,900,396,397,398,900,900,900,900,900,404,900,
  248. $ 406,900,408,900,900,900,900,900,900,900,900,900,418,419,900,
  249. * 121
  250. $ 900,900,900,900,425,900,427,428,429,900,431,432,433,434,435,
  251. $ 900,900,900,900,440,441,442,443,900,900,900,447,900,900,450,
  252. * 151 152 155 156 157 158 159 160 161 162 163 164 165
  253. $ 451,452,900,900,455,456,900,900,900,900,900,900,900,900,900,
  254. * 166 167 168 169 170 171 172 173 174
  255. $ 900,900,900,900,900,900,900,900,474
  256. $ ) JNPLAS
  257.  
  258. 900 continue
  259. write(6,*) ' erreur d aiguillage coml8'
  260. call erreur (5)
  261. return
  262. *---------------------------------------------------------------------
  263. * modeles de viscoplasticite integres par consti
  264. * avec endommagement
  265. *---------------------------------------------------------------------
  266. 329 continue
  267. * IF (INPLAS .EQ. 29) THEN
  268. ntabo1 = iablo1(/1)
  269. ntabo2 = tablo2(/1)
  270. *
  271. NYOG=IABLO1(1)
  272. NYNU=IABLO1(2)
  273. NYALFA=IABLO1(3)
  274. NYSMAX=IABLO1(4)
  275. NYN=IABLO1(5)
  276. NYM=IABLO1(6)
  277. NYKK=IABLO1(7)
  278. NYALF1=IABLO1(8)
  279. NYBET1=IABLO1(9)
  280. NYR=IABLO1(10)
  281. NYA=IABLO1(11)
  282. C
  283. INTMAT=NMATT
  284. C
  285. IF (NTABO1.EQ.INTMAT) THEN
  286. NNKX=1
  287. NYKX=IABLO1(12)
  288. ELSE
  289. NNKX=IABLO1(12)
  290. NYKX=0
  291. DO 1881 I=1,NNKX
  292. NYKX=NYKX+(2*IABLO1(12+I))
  293. 1881 CONTINUE
  294. NYKX=NYKX+NNKX
  295. ENDIF
  296. NYRHO=IABLO1(NTABO1)
  297. NSIGY=1
  298. *** SEGINI WRK9
  299. if (wrk9.eq.0) segini wrk9
  300. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  301. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  302. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  303. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  304. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  305. > .or.nkx(/1).ne.nnkx) segadj wrk9
  306. inplas2 = INPLAS
  307. ifour2 = IFOUR
  308. mfr2 = MFRbi
  309. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  310. *** SEGSUP WR10
  311. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  312. NCOURB=2*NKX(1)
  313. ELSE
  314. NCOURB=NKX(1)
  315. DO 1882 I=1,NNKX
  316. IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  317. 1882 CONTINUE
  318. NCOURB=2*NCOURB
  319. ENDIF
  320. ** SEGINI WRK7
  321. if (wrk7.eq.0) segini wrk7
  322. if (w(/1).ne.ncourb) segadj wrk7
  323.  
  324. *** IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  325. IF (VAR0(3).GE.0.96) THEN
  326. CALL ZDANUL(SIGF,NSTRS)
  327. DO 1883 I=1,NVARI
  328. VARF(I) = VAR0(I)
  329. 1883 CONTINUE
  330. VARF(3) = 1.D0
  331. DO 1884 I=1,NSTRS
  332. EPINF(I) = EPIN0(I)
  333. 1884 CONTINUE
  334. ELSE
  335. FI1=0.D0
  336. FI2=0.D0
  337. dtbi=dt
  338. iforb=ifourb
  339. nccor = ncourb
  340. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  341. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  342. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  343. ifourb=iforb
  344. ncourb=nccor
  345. c
  346. *** IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  347. IF (TLIFE.GE.0.D0) THEN
  348. INTERR(1)=IB
  349. INTERR(2)=IGAU
  350. REAERR(1)=TLIFE
  351. CALL ERREUR(-279)
  352. ENDIF
  353. DTOPTI = MIN(DTOPTI,DTT)
  354. NINCMA = MAX(NINCMA,NSSINC)
  355. NCOMP = NCOMP + 1
  356. TSOM = TSOM + DTT
  357. NSOM = NSOM + NSSINC
  358. NINV = NINV + INV
  359. TCAR = TCAR + DTT* DTT
  360. IF (KERRE.NE.0) THEN
  361. KERR1=1
  362. ENDIF
  363. ENDIF
  364. ** SEGSUP WRK7
  365. ** SEGSUP WRK9
  366. RETURN
  367. C
  368. 442 continue
  369. * ELSEIF (INPLAS .EQ. 142) THEN
  370.  
  371. ntabo1 = iablo1(/1)
  372. ntabo2 = tablo2(/1)
  373. *
  374. NYOG1=IABLO1(1)
  375. NYNU1=IABLO1(2)
  376. NYALFT1=IABLO1(3)
  377. NYSMAX1=IABLO1(4)
  378. NYN1=IABLO1(5)
  379. NYM1=IABLO1(6)
  380. NYKK1=IABLO1(7)
  381. NYALF2=IABLO1(8)
  382. NYBET2=IABLO1(9)
  383. NYR1=IABLO1(10)
  384. NYA1=IABLO1(11)
  385. NYQ1=IABLO1(12)
  386. NYRHO1=IABLO1(NTABO1)
  387. NSIGY1=1
  388. *** SEGINI WRK91
  389. if (wrk91.eq.0) segini wrk91
  390. if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  391. > YALFT1(/1).ne.NYALFT1 .or.
  392. > YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  393. > YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  394. > YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  395. > YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  396. > segadj wrk91
  397. inplas2 = INPLAS
  398. ifour2 = IFOUR
  399. mfr2 = MFRbi
  400. CALL MAT142(WR10,WRK91,inplas2,ifour2,mfr2)
  401. *** SEGSUP WR10
  402. ** SEGINI WRK7
  403. if (wrk7.eq.0) segini wrk7
  404. if (w(/1).ne.ncourb) segadj wrk7
  405. IF (VAR0(8).GE.0.96) THEN
  406. CALL ZDANUL(SIGF,NSTRS)
  407. DO I=1,NVARI
  408. VARF(I) = VAR0(I)
  409. ENDDO
  410. VARF(8) = 1.D0
  411. DO I=1,NSTRS
  412. EPINF(I) = EPIN0(I)
  413. ENDDO
  414. ELSE
  415. FI1=0.D0
  416. FI2=0.D0
  417. dtbi=dt
  418. iforb=ifourb
  419. nccor = ncourb
  420. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  421. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  422. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  423. segact necou*mod
  424. ifourb=iforb
  425. ncourb=nccor
  426. c
  427. IF (TLIFE.GE.0.D0) THEN
  428. INTERR(1)=IB
  429. INTERR(2)=IGAU
  430. REAERR(1)=TLIFE
  431. CALL ERREUR(-279)
  432. ENDIF
  433. DTOPTI = MIN(DTOPTI,DTT)
  434. NINCMA = MAX(NINCMA,NSSINC)
  435. NCOMP = NCOMP + 1
  436. TSOM = TSOM + DTT
  437. NSOM = NSOM + NSSINC
  438. NINV = NINV + INV
  439. TCAR = TCAR + DTT* DTT
  440. IF (KERRE.NE.0) THEN
  441. KERR1=1
  442. ENDIF
  443. ENDIF
  444. SEGSUP WRK7
  445. *** SEGSUP WRK91
  446. RETURN
  447. c
  448. c modele plastique d'endommagement de lemaitre
  449. c ++++++++++++++++++++++++++++++++++++++++++++
  450. c traitement du materiau qui depend eventuellement de la temperature
  451. c ------------------------------------------------------------------
  452. 326 continue
  453. * ELSE IF (INPLAS.EQ.26) THEN
  454. ntabo1 = iablo1(/1)
  455. ntabo2 = tablo2(/1)
  456. NYOG=IABLO1(1)
  457. NYNU=IABLO1(2)
  458. NYRHO=IABLO1(3)
  459. NYALFA=IABLO1(4)
  460. c IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2)
  461. c & THEN
  462. c+DC INTMAT=9
  463. c INTMAT=10
  464. c ELSE
  465. c+DC INTMAT=8
  466. c INTMAT=9
  467. c ENDIF
  468. INTMAT=NMATT
  469. IF (NTABO1.EQ.INTMAT) THEN
  470. NNKX=1
  471. NYKX=IABLO1(5)
  472. IEPS=0
  473. ELSE
  474. NNKX=IABLO1(5)
  475. NYKX=0
  476. DO 1789 I=1,NNKX
  477. NYKX=NYKX+(2*IABLO1(5+I))
  478. 1789 CONTINUE
  479. NYKX=NYKX+NNKX
  480. IEPS=1
  481. ENDIF
  482. IORIGI=6+(IEPS*NNKX)
  483. NYN=IABLO1(IORIGI)
  484. NYM=IABLO1(IORIGI+1)
  485. NYKK=IABLO1(IORIGI+2)
  486. NYSMAX=0
  487. NYALF1=0
  488. NYBET1=0
  489. NYR=0
  490. NYA=0
  491. NSIGY=0
  492. ** SEGINI WRK9
  493. if (wrk9.eq.0) segini wrk9
  494. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  495. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  496. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  497. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  498. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  499. > .or.nkx(/1).ne.nnkx) segadj wrk9
  500. inplas2 = INPLAS
  501. ifour2 = IFOUR
  502. mfr2 = MFRbi
  503. * write(6,*) ' coml8 inplas2 ifour2 mfr2 ifourb'
  504. * write(6,*) inplas2,ifour2,mfr2,ifourb
  505. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  506. * write(6,*) ' sortier de mat29 kerre',kerre
  507. *** SEGSUP WR10
  508. c
  509. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  510. c *** on n' ecoule pas
  511. c
  512. CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  513. IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  514. DO 1115 IEN=1,NVARI
  515. VARF(IEN)=VAR0(IEN)
  516. 1115 continue
  517. VARF(3)=1.D0
  518. CALL ZDANUL(SIGF,NSTRS)
  519. CALL ZDANUL(DEFP,NSTRS)
  520. ELSE
  521. c ----------------------------------------------------------------------
  522. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  523. c p est en supplement
  524. c ----------------------------------------------------------------------
  525. NNVARI=2
  526. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  527. nccor=ncourb
  528. CALL CCOTR4(WRK52,WRK2,Nccor,WRK53)
  529. NCOURB=2*NKX(1)
  530. ELSE
  531. NCOURB=NKX(1)
  532. DO 1119 I=1,NNKX
  533. if (nkx(i).ge.ncourb) ncourb=nkx(i)
  534. 1119 CONTINUE
  535. NCOURB=4*NCOURB
  536. ENDIF
  537. IF (KERRE.EQ.0) THEN
  538. ** SEGINI WRK7
  539. if (wrk7.eq.0) segini wrk7
  540. if (w(/1).ne.ncourb) segadj wrk7
  541. trefab=trefa
  542. iforb=ifourb
  543. nccor=ncourb
  544. CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9,
  545. 1 NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou)
  546. ifourb=iforb
  547. ncourb=nccor
  548. trefa=trefab
  549. ** SEGSUP WRK7
  550. IF (KERRE.GT.200) THEN
  551. KERR1=1
  552. ENDIF
  553. ENDIF
  554. ENDIF
  555. ** SEGSUP WRK9
  556. RETURN
  557. * ELSE
  558. c KERRE = 99
  559. * ENDIF
  560. *
  561. *---------------------------------------------------------------------
  562. *
  563. * ecoulement selon les modeles plastique avec endommagement
  564. *
  565. *---------------------------------------------------------------------
  566. c
  567. c modeles implantes dans ecoinc
  568. c
  569. 351 continue
  570. * IF (INPLAS.EQ.51) THEN
  571. c
  572. SEGINI ENDO0
  573. c cas de la plasticite isotrope ecrouissable avec un
  574. c endommagement de type P/Y
  575. c
  576. c on recupere la courbe de traction et la courbe de début d'endommagement
  577. c
  578. nccor=ncourb
  579. CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP)
  580. ncourb=nccor
  581. INPLS0 = 51
  582. INPLAS = 5
  583. IF (VAR0(7).GE.1.D-10) THEN
  584. DO 110 I=1,NSTRS
  585. SIG0(I)=SIG0(I)/VAR0(7)
  586. 110 CONTINUE
  587. ENDIF
  588. c
  589. c calcul des contraintes plastiquement admissibles
  590. c
  591. IF (KERRE .EQ. 0) THEN
  592. DO 1114 IC=1,ICARA
  593. WORK(IC)=xcarb(IC)
  594. 1114 continue
  595. BID(1)=0.D00
  596. BID(2)=0.D00
  597. BID(3)=0.D00
  598. CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  599. & NBPGAU,ecou,necou,iecou)
  600. ENDIF
  601. c retour au modèle d'endommagement P/Y
  602. c
  603. c calcul des contraintes endommagées
  604. c
  605. CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP,
  606. & NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  607. segsup ENDO0
  608. INPLAS = 51
  609. RETURN
  610. c
  611. 362 continue
  612. * ELSE IF (INPLAS.EQ.62) THEN
  613. c
  614. c Modèle d'endommagement de Rousselier
  615. c - on recupère la courbe de traction
  616. c
  617. nccor=ncourb
  618. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  619. ncourb=nccor
  620. c
  621. c - appel au modèle
  622. C
  623. IF (KERRE.EQ.0) THEN
  624. CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  625. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  626. & necou)
  627. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  628. KERR1=1
  629. ENDIF
  630. ENDIF
  631. RETURN
  632. c
  633. 364 continue
  634. * ELSE IF (INPLAS.EQ.64) THEN
  635. c
  636. c Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  637. c - on recupère la courbe de traction
  638. c
  639. nccor=ncourb
  640. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  641. ncourb=nccor
  642. c
  643. c - appel au modèle
  644. c
  645. IF (KERRE.EQ.0) THEN
  646. CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  647. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  648. & necou)
  649. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  650. KERR1=1
  651. ENDIF
  652. ENDIF
  653. RETURN
  654. c
  655. 375 continue
  656. * ELSE IF (INPLAS.EQ.75) THEN
  657. c
  658. c Modèle d'endommagement de Dragon
  659. c
  660. CALL CDRAGO(wrk52,wrk53,wrk54)
  661. c
  662. c
  663. RETURN
  664. 433 continue
  665. * ELSE IF (INPLAS.EQ.133) THEN
  666. c
  667. c Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT
  668. c
  669. CALL DYNAR(wrk52,wrk53,wrk54,iecou)
  670. RETURN
  671. c
  672. * ELSE
  673. c KERRE = 99
  674. * ENDIF
  675. *---------------------------------------------------------------------
  676. *
  677. * ecoulement selon les modeles (endommageables)
  678. *
  679. *---------------------------------------------------------------------
  680. *
  681. 330 continue
  682. * IF (INPLAS .EQ. 30) THEN
  683. c
  684. c modele d'endommagement mazars ( beton )
  685. c
  686. c CALL MAZZZ(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  687. c & ICARA,MFR1)
  688. CALL CMAZZZ(WRK52,WRK53,WRK54,WRKK2,NVARI,Iecou)
  689. RETURN
  690. c
  691. 331 continue
  692. * ELSE IF (INPLAS .EQ. 31) THEN
  693. c
  694. c modele d'endommagement unilateral ( beton )
  695. c
  696. c CALL CLBBBB(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  697. c & ICARA,KERRE,MFR1,IFOURB)
  698.  
  699. CALL COLBBB(WRK52,WRK53,WRK54,NVARI,Iecou,necou)
  700. RETURN
  701. c
  702. 337 continue
  703. * ELSE IF (INPLAS .EQ. 37) THEN
  704. c
  705. c modele rotating crack
  706. c
  707. nstrbi=nstrss
  708. icarbi=icara
  709. CALL COTATI(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  710. nstrss=nstrbi
  711. icara=icarbi
  712. RETURN
  713. c
  714. 388 continue
  715. * ELSE IF (INPLAS .EQ. 88) THEN
  716. c modele SIC_SIC
  717. c
  718. CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  719. & ,iecou)
  720. RETURN
  721. c
  722. 389 continue
  723. * ELSE IF (INPLAS .EQ. 89) THEN
  724. C HINTE
  725. C MODELE INTERFACE 2D
  726.  
  727. CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF,
  728. & VARF,DEFP,PRECIS,MFR1,KERRE)
  729. RETURN
  730. C
  731. 396 continue
  732. * ELSE IF (INPLAS .EQ. 96) THEN
  733. C
  734. C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS
  735. C
  736. CALL CMICRO(WRK52,WRK53,WRK54,NVARI,Iecou)
  737. RETURN
  738. *
  739. 397 continue
  740. * ELSE IF (INPLAS .EQ. 97) THEN
  741. C
  742. C MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON )
  743. C
  744. icarbi=icara
  745. CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  746. RETURN
  747. *
  748. 398 continue
  749. * ELSE IF (INPLAS .EQ. 98) THEN
  750. C
  751. C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS
  752. C
  753. CALL CMICRI(WRK52,WRK53,WRK54,NVARI,Iecou)
  754. RETURN
  755. *
  756. 418 continue
  757. * ELSE IF (INPLAS.EQ.118) THEN
  758. C
  759. C modified von mises model
  760. C
  761. CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  762. RETURN
  763. c
  764. 431 continue
  765. * ELSE IF (INPLAS .EQ. 131) THEN
  766. c modele SIC_SIC
  767. c
  768. CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  769. & ,iecou)
  770. RETURN
  771. c
  772. 432 continue
  773. * ELSE IF (INPLAS .EQ. 132) THEN
  774. c modele SIC_SIC
  775. c
  776. CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  777. & ,iecou)
  778. RETURN
  779. C
  780. 434 continue
  781. * ELSE IF (INPLAS.EQ.134) THEN
  782. C
  783. C Modele de DESMORAT
  784. C
  785. CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou)
  786. RETURN
  787. * ELSE
  788. c KERRE = 99
  789. * ENDIF
  790. *
  791. *---------------------------------------------------------------------
  792. *
  793. * ecoulement selon les modeles (plastique hors moule ccoinXX)
  794. *
  795. *---------------------------------------------------------------------
  796. c
  797. c modele linespring
  798. c
  799. 302 continue
  800. 327 continue
  801. * IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN
  802. * write(6,*) ' coml8 ifour avant appel calsig', ifour
  803. CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU,
  804. & NBPGAU,iecou)
  805. RETURN
  806. c
  807. c modele beton
  808. c
  809. 309 continue
  810. * ELSE IF (INPLAS.EQ.9) THEN
  811. CALL BETON(SIG0 ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb,
  812. 1 DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  813. 2 IGAU,EPAIST,MELE,NPINT, SECT,LHOOK,
  814. 3 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,
  815. 4 SIGF,VARF,DEFP, NBPGAU,KERRE,ecou,necou,iecou)
  816. IF (KERRE.GT.200) THEN
  817. KERR1=1
  818. ENDIF
  819. RETURN
  820. c
  821. c tuyau fissure
  822. c
  823. 314 continue
  824. 318 continue
  825. * ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN
  826. iforb=ifourb
  827. CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU,
  828. & NBPGAU,iecou)
  829. ifourb=iforb
  830.  
  831.  
  832. c pas de materiau 18 dans nomate 02/01 Kich
  833. if (inplas.eq.18) inplas = 14
  834. c
  835. c modele gauvain
  836. c
  837. RETURN
  838. 316 continue
  839. * ELSE IF (INPLAS.EQ.16) THEN
  840. c
  841. c on recupere les courbes moment-courbure
  842. c
  843. nccor=ncourb
  844. CALL CCOTR2(wrk52,wrk53,WRK2,NCcor)
  845. ncourb=nccor
  846. IF (KERRE.NE.0) RETURN
  847. iforb=ifourb
  848. nccor=ncourb
  849. mfr1bi=mfr1
  850. nbgmab=nbgmat
  851. nlmatb=nelmat
  852. nstrbi=nstrs
  853. CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB,
  854. 1 IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT,
  855. 2 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,
  856. 3 SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC,
  857. 4 NCcor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  858. ifourb=iforb
  859. ncourb=nccor
  860. mfr1=mfr1bi
  861. nbgmat=nbgmab
  862. nelmat=nlmatb
  863. nstrs=nstrbi
  864.  
  865. IF (KERRE.GT.200) THEN
  866. KERR1=1
  867. ENDIF
  868. * ENDIF
  869. RETURN
  870. c
  871. c modele ubiquitous
  872. c
  873. 328 continue
  874. * ELSE IF (INPLAS .EQ.28) THEN
  875. CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  876. 1 IGAU,EPAIST,MELE,NPINT ,SECT,LHOOK,
  877. 2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,
  878. 3 DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT,
  879. 4 SIGF,VARF,DEFP,KERRE,ecou,necou,iecou)
  880. IF (KERRE.GT.200) THEN
  881. KERR1=1
  882. ENDIF
  883. RETURN
  884. c
  885. c modele global
  886. c
  887. 332 continue
  888. * ELSE IF (INPLAS.EQ.32) THEN
  889. iforb=ifourb
  890. CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU,
  891. & NBPGAU,iecou)
  892. ifourb=iforb
  893. IF (KERRE.LT.0) THEN
  894. INTERR(1)=IB
  895. INTERR(2)=IGAU
  896. IF (KERRE.LE.(-4)) THEN
  897. MOTERR(5:16) = 'CISAILLEMENT'
  898. CALL ERREUR(-283)
  899. KERRE = KERRE + 4
  900. ENDIF
  901. IF (KERRE.LE.(-2)) THEN
  902. MOTERR(5:16) = 'FLEXION'
  903. CALL ERREUR(-283)
  904. KERRE = KERRE + 2
  905. ENDIF
  906. IF (KERRE.LT.0) THEN
  907. MOTERR(5:16) = 'COMPRESSION'
  908. CALL ERREUR(-283)
  909. KERRE = 0
  910. ENDIF
  911. ENDIF
  912. RETURN
  913. c
  914. c modele cam-clay
  915. c
  916. 333 continue
  917. * ELSE IF (INPLAS.EQ.33) THEN
  918. CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  919. & VARF,DEFP,PRECIS,MFR1,KERRE)
  920. RETURN
  921. c
  922. 334 continue
  923. * ELSE IF (INPLAS .EQ. 34) THEN
  924. c
  925. c modele de mohr coulomb pour les joints
  926. c
  927. IF (MFR.EQ.35) THEN
  928. IF (IFOUR.EQ.2) THEN
  929. c
  930. c --------------------joints 3d
  931. c
  932. CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  933. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  934. ELSE
  935. c
  936. c --------------------joints 2d
  937. c
  938. CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  939. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  940. ENDIF
  941. c
  942. c --------------------joints JOI1
  943. c
  944. ELSE IF (MFR.EQ.75) THEN
  945. CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST,
  946. & IFOURB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  947. ENDIF
  948. RETURN
  949. c
  950. 335 continue
  951. * ELSE IF (INPLAS .EQ. 35) THEN
  952. c
  953. c modele de coulomb_dilatant pour les joints 2d
  954. c
  955. IF (IFOUR.NE.2) THEN
  956. CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  957. ENDIF
  958. RETURN
  959. c
  960. c modele de gurson
  961. c
  962. 338 continue
  963. * ELSE IF (INPLAS .EQ. 38) THEN
  964. nstrbi=nstrss
  965. icarbi=icara
  966. CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  967. & NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur)
  968. nstrss=nstrbi
  969. icara=icarbi
  970. RETURN
  971. c
  972. 336 continue
  973. * ELSE IF (INPLAS .EQ. 36) THEN
  974. c
  975. c modele beton_axi
  976. c
  977. nstrbi=nstrss
  978. CALL BETAXI(SIG0,NSTRbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb,
  979. & SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou)
  980. nstrss=nstrbi
  981. IF (KERRE.GT.200) THEN
  982. KERR1=1
  983. ENDIF
  984. RETURN
  985. c
  986. 339 continue
  987. * ELSE IF ((INPLAS .EQ. 39) .AND. (MFRbi .EQ. 27)) THEN
  988. c
  989. c modele beton_uni pour les elements unidirectionels (barre ..)
  990. c
  991. KERR1=0
  992. CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  993. RETURN
  994. c
  995. 404 continue
  996. * ELSE IF ((INPLAS .EQ. 104) .AND. (MFRbi .EQ. 27)) THEN
  997. c
  998. c modele beton unilateral pour les elements unidirectionels (barre ..)
  999. c
  1000. KERR1=0
  1001. CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1002. RETURN
  1003. c
  1004. 393 continue
  1005. * ELSE IF ((INPLAS .EQ. 93) .AND. (MFRbi .EQ. 27)) THEN
  1006. c
  1007. c
  1008. c modele ancrage_acier pour les elements unidirectionels (barre ..)
  1009. c
  1010. KERR1=0
  1011. CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1012. RETURN
  1013. c
  1014. 378 continue
  1015. * ELSE IF ((INPLAS .EQ. 78) .AND. (MFRbi .EQ. 27)) THEN
  1016. c
  1017. c modele fragile_uni pour les elements unidirectionels (barre ..)
  1018. c
  1019. KERR1=0
  1020. CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  1021. RETURN
  1022. c
  1023. 379 continue
  1024. * ELSE IF ((INPLAS .EQ. 79) .AND. (MFRbi .EQ. 27)) THEN
  1025. c
  1026. c modele beton_bael pour les elements unidirectionels (barre ..)
  1027. c
  1028. KERR1=0
  1029. CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  1030. RETURN
  1031. c
  1032. 392 continue
  1033. * ELSE IF ((INPLAS .EQ. 92) .AND. (MFRbi .EQ. 27)) THEN
  1034. c
  1035. c
  1036. c modele ancrage_parfait pour les elements unidirectionels (barre ..)
  1037. c
  1038. KERR1=0
  1039. CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1040. RETURN
  1041. c
  1042. c
  1043. 380 continue
  1044. * ELSE IF ((INPLAS .EQ. 80) .AND. (MFRbi .EQ. 27)) THEN
  1045. c
  1046. c modele parfait_uni pour les elements unidirectionels (barre ..)
  1047. c
  1048. KERR1=0
  1049. CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1050. c
  1051. * IF (KERRE.NE.0) return
  1052. RETURN
  1053. c
  1054. c modele acier_uni pour les materiau unidirectionel
  1055. c
  1056. c
  1057. 340 continue
  1058. * ELSE IF ((INPLAS .EQ. 40) .AND. (MFRbi .EQ. 27)) THEN
  1059. IF(MFRbi .EQ. 27)then
  1060. c
  1061. c modele acier_uni pour les elements unidirectionels (barre ..)
  1062. c
  1063. KERR1=0
  1064. CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1065. RETURN
  1066. elseif(MATE.EQ.4) then
  1067. * ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN
  1068. nstrbi=nstrss
  1069. mfr1bi=mfr1
  1070. CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi)
  1071. nstrss=nstrbi
  1072. mfr1=mfr1bi
  1073. RETURN
  1074. endif
  1075. c
  1076. c modele poutre en formulation section
  1077. c
  1078. 341 continue
  1079. * ELSE IF (INPLAS.EQ.41.AND.MFRbi.EQ.7) THEN
  1080. c
  1081. nstrbi=nstrss
  1082. icarbi=icara
  1083. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  1084. nstrss=nstrbi
  1085. icara=icarbi
  1086. RETURN
  1087. c
  1088. 350 continue
  1089. * ELSE IF (INPLAS .EQ. 50) THEN
  1090. c
  1091. c cas du modele de zerilli armstrong
  1092. c
  1093. c on recupere le pas de temps dt : voir comval
  1094. c kich : fixe dt = 0. pour plasticite
  1095. dtk1 = dt
  1096. dt = 0.d0
  1097. c
  1098. IF (KERRE .EQ. 0) THEN
  1099. DO 1124 IC=1,ICARA
  1100. WORK(IC)=xcarb(IC)
  1101. 1124 continue
  1102. BID(1)=0.D00
  1103. BID(2)=0.D00
  1104. BID(3)=0.D00
  1105. CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  1106. & NBPGAU,necou,ecou,iecou,xecou)
  1107. ENDIF
  1108. dt = dtk1
  1109. RETURN
  1110. c
  1111. c modele de steinberg cochran guinan
  1112. c
  1113. 349 continue
  1114. * ELSE IF (INPLAS.EQ.49) THEN
  1115. CALL STEINB(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1116. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1117. 2 KERRE)
  1118. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1119. KERR1=1
  1120. ENDIF
  1121. RETURN
  1122. c
  1123. c modele hujeux
  1124. c
  1125. 348 continue
  1126. * ELSE IF (INPLAS.EQ.48) THEN
  1127. CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  1128. & VARF,DEFP,PRECIS,MFR1,KERRE)
  1129. RETURN
  1130. c
  1131. c modele ottosen
  1132. c
  1133. 342 continue
  1134. * ELSE IF (INPLAS.EQ.42) THEN
  1135. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT,
  1136. 1 xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB,
  1137. 2 IGAU)
  1138. RETURN
  1139. c
  1140. 347 continue
  1141. * ELSE IF (INPLAS.EQ.47) THEN
  1142. c
  1143. c modele de amadei-saeb pour les joints
  1144. c
  1145. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  1146. IF (IFOUR.EQ.2) THEN
  1147. c
  1148. c --------------------joints 3d
  1149. c
  1150. CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1151. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1152. ELSE
  1153. c
  1154. c --------------------joints 2d
  1155. c
  1156. CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1157. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1158. ENDIF
  1159. RETURN
  1160. c
  1161. 352 continue
  1162. * ELSE IF (INPLAS.EQ.52) THEN
  1163. c
  1164. c modèle Preston-Tonks-Wallace
  1165. c
  1166. c on recupere le pas de temps dt : voir comval
  1167. c kich : fixe dt = 0. pour plasticite
  1168. dtk1 = dt
  1169. dt = 0.d0
  1170. c
  1171. CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1172. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1173. 2 KERRE,DT)
  1174. IF (KERRE.NE.0) THEN
  1175. KERR1=1
  1176. ENDIF
  1177. dt = dtk1
  1178. RETURN
  1179. c
  1180. 354 continue
  1181. * ELSE IF (INPLAS.EQ.54) THEN
  1182. c
  1183. c modele BETOCYCL
  1184. C
  1185. C ON VERIFIE LES CONTRAINTES PLANES
  1186. C
  1187. IF (IFOUR.EQ.-2) THEN
  1188. C
  1189. C ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  1190. C
  1191. IPOS1=1
  1192. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1193. NTRAT=NPOINT/2
  1194. IPOS2=IPOS1+NPOINT
  1195. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1196. NTRAC=NPOINT/2
  1197. IF (KERRE.EQ.0) THEN
  1198. CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC)
  1199. ENDIF
  1200. ELSE
  1201. KERRE = 99
  1202. ENDIF
  1203. RETURN
  1204. C
  1205. 355 continue
  1206. * ELSE IF (INPLAS.EQ.55) THEN
  1207. C
  1208. C MODELE ROTATING CRACK
  1209. C
  1210. C ON VERIFIE LES CONTRAINTES PLANES
  1211. C
  1212. IF (IFOUR.EQ.-2) THEN
  1213. IF (KERRE.EQ.0) THEN
  1214. CALL CROTAT(wrk52,wrk53,wrk54)
  1215. ENDIF
  1216. ELSE
  1217. KERRE = 99
  1218. ENDIF
  1219. RETURN
  1220. c
  1221. 356 continue
  1222. * ELSE IF (INPLAS.EQ.56) THEN
  1223. C
  1224. C MODELE JOINT_SOFT
  1225. C
  1226. C
  1227. C ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  1228. C
  1229. C
  1230. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  1231. C 6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1232. C 'ALFA' a la place 3 et 4 dans defmat.eso
  1233. C
  1234. IPOS1=1
  1235. CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT)
  1236. NTRAC=NPOINT/2
  1237. IPOS2=IPOS1+NPOINT
  1238. CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT)
  1239. NTRAS=NPOINT/2
  1240. IPOS3=IPOS2+NPOINT
  1241. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT)
  1242. NTRAT=NPOINT/2
  1243. C
  1244. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1245. IF(KERRE.EQ.0) THEN
  1246. C
  1247. CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  1248. . TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  1249. . TRAC(IPOS3),NTRAT,
  1250. . SIGF,VARF,DEFP,KERRE)
  1251. END IF
  1252. ELSEIF(IFOUR.EQ.2)THEN
  1253. IF(KERRE.EQ.0) THEN
  1254. C
  1255. CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  1256. . TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  1257. . TRAC(IPOS3),NTRAC,
  1258. . SIGF,VARF,DEFP,KERRE)
  1259. END IF
  1260. C
  1261. END IF
  1262. RETURN
  1263. C
  1264. 419 continue
  1265. * ELSE IF (INPLAS.EQ.119)THEN
  1266. C
  1267. C MODELE JOINT_COAT
  1268. C
  1269. C ON RECUPERE LA COURBE DE SHEAR
  1270. C
  1271. C Note: La courbe a maintenant l'indices 4 alors que c'est
  1272. C 2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1273. C 'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  1274. C
  1275. IPOS1=1
  1276. CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT)
  1277. NTRAS=NPOINT/2
  1278. C
  1279. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1280. IF(KERRE.EQ.0) THEN
  1281. C
  1282. CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  1283. . SIGF,VARF,DEFP,KERRE)
  1284. END IF
  1285. ELSEIF(IFOUR.EQ.2)THEN
  1286. IF(KERRE.EQ.0) THEN
  1287. END IF
  1288. C
  1289. END IF
  1290. RETURN
  1291. C
  1292. 425 continue
  1293. * ELSE IF (INPLAS.EQ.125)THEN
  1294. IF(MFR.EQ.1)THEN
  1295. CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0,
  1296. & DEPST,DSIGT,EPST0,EPIN0, SIGF,VARF,DEFP,
  1297. & XMAT0,DDAUX)
  1298. ENDIF
  1299. RETURN
  1300.  
  1301. 435 continue
  1302. * ELSE IF (INPLAS.EQ.135) THEN
  1303. CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0,
  1304. & SIGF,DEPST,NSTRS,KERRE,ISTEP)
  1305. RETURN
  1306. C
  1307. C
  1308. 426 continue
  1309. * ELSE IF (INPLAS.EQ.126)THEN
  1310. C
  1311. C MODELE MUR_SHEAR
  1312. C POUR LE MOMENT, ELEMENT DE POUTRE
  1313. C MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT
  1314. C
  1315. IF(MFR.EQ.7.OR.MFR.EQ.61)THEN
  1316. C
  1317. C ON RECUPERE LES COURBES
  1318. C
  1319. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  1320. C c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  1321. C incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  1322. C
  1323. IPOS1=1
  1324. CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT)
  1325. NCURFP=NPOINT/2
  1326. IPOS2=IPOS1+NPOINT
  1327. CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT)
  1328. NCURKP=NPOINT/2
  1329. IPOS3=IPOS2+NPOINT
  1330. CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT)
  1331. NCURLP=NPOINT/2
  1332. IPOS4=IPOS3+NPOINT
  1333. CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT)
  1334. NCURFM=NPOINT/2
  1335. IPOS5=IPOS4+NPOINT
  1336. CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT)
  1337. NCURKM=NPOINT/2
  1338. IPOS6=IPOS5+NPOINT
  1339. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT)
  1340. NCURLM=NPOINT/2
  1341. C
  1342. IF(KERRE.EQ.0) THEN
  1343. C+PPM
  1344. IF(MFR.EQ.7)THEN
  1345. C+PPM
  1346. CALL MSHETI(wrk52,wrk53,WRK2,
  1347. > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1348. > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6,
  1349. > KERR2)
  1350. KERRE = KERR2
  1351. C+PPM
  1352. ELSE
  1353. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1354. CALL MASHEJ(wrk52,wrk53,WRK2,
  1355. > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1356. > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6)
  1357. ELSE
  1358. KERRE=99
  1359. ENDIF
  1360. ENDIF
  1361. C+PPM
  1362. END IF
  1363.  
  1364. C
  1365. END IF
  1366. RETURN
  1367. C
  1368. C
  1369. c
  1370. 391 continue
  1371. * ELSE IF (INPLAS.EQ.91) THEN
  1372. C
  1373. C MODELE ANCRAGE_ELIGEHAUSEN
  1374. C
  1375. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1376. C
  1377. CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  1378. ENDIF
  1379. RETURN
  1380. c
  1381. 357 continue
  1382. * ELSE IF (INPLAS.EQ.57) THEN
  1383. C
  1384. C MODELE BILI_MOMY
  1385. C
  1386. KERRE=0
  1387. CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1388. RETURN
  1389. c
  1390. 358 continue
  1391. * ELSE IF (INPLAS.EQ.58) THEN
  1392. C
  1393. C MODELE BILI_EFFZ
  1394. C
  1395. KERRE=0
  1396. CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1397. RETURN
  1398. c
  1399. 359 continue
  1400. * ELSE IF (INPLAS.EQ.59) THEN
  1401. C
  1402. C MODELE TAKEMO_MOMY
  1403. C
  1404. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1405. C
  1406. nccor=ncourb
  1407. CALL COTRAF(wrk52,wrk53,WRK2,NCcOR)
  1408. ncourb=nccor
  1409. IF (KERRE.EQ.0) THEN
  1410. C
  1411. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1412. CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1413. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1414. ELSE
  1415. CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1416. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1417. ENDIF
  1418. ENDIF
  1419. RETURN
  1420.  
  1421.  
  1422.  
  1423.  
  1424. 447 continue
  1425. * ELSE IF (INPLAS.EQ.73) THEN
  1426. C
  1427. C MODELE BA1D
  1428. C
  1429. CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1430. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1431.  
  1432. RETURN
  1433. c
  1434. 360 continue
  1435. * ELSE IF (INPLAS.EQ.60) THEN
  1436. C
  1437. C MODELE TAKEMO_EFFZ
  1438. C
  1439. C
  1440. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1441. C
  1442. nccor=ncourb
  1443. CALL COTRAF(wrk52,wrk53,WRK2,NCcor)
  1444. ncourb=nccor
  1445. IF (KERRE.EQ.0) THEN
  1446. C
  1447. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1448. CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1449. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1450. ELSE
  1451. CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1452. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1453. ENDIF
  1454. C
  1455. ENDIF
  1456. RETURN
  1457. c
  1458. 440 continue
  1459. * ELSE IF (INPLAS.EQ.140) THEN
  1460. *
  1461. * modele DRUCKER_PRAGER2
  1462. *
  1463. XLCARA=0.D0
  1464. NEXO = EXOVA0(/1)
  1465. DO INEX=1,NEXO
  1466. IF ((NOMEXO(INEX)(1:4) .EQ.'LCAR').AND.
  1467. & (CONEXO(INEX)(1:LCONMO).EQ.CONM(1:LCONMO))) THEN
  1468. XLCARA=EXOVA0(INEX)
  1469. ENDIF
  1470. ENDDO
  1471. CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA,
  1472. & NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  1473. & IB,IGAU,IFOURB,XLCARA,MELE)
  1474. RETURN
  1475. 441 continue
  1476. * ELSE IF (INPLAS.EQ.141) THEN
  1477.  
  1478. * Fatigue damage model (fatsin)
  1479. * print*,'appel a cfattt dans coml8'
  1480. CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou)
  1481. RETURN
  1482.  
  1483. * ELSE
  1484. * KERRE=99
  1485. * ENDIF
  1486. *
  1487. *---------------------------------------------------------------------
  1488. *
  1489. * ecoulement selon les modeles (plastique hors ccoinXX) suite
  1490. *
  1491. *---------------------------------------------------------------------
  1492. *
  1493. 366 continue
  1494. * IF (INPLAS.EQ.66) THEN
  1495. C
  1496. C
  1497. C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  1498. C DEFORMATION PLANES ET AXISYMETRIE
  1499. C
  1500. nstrbi=nstrss
  1501. iwpoi1=wrk12
  1502. CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF,
  1503. 1 KERRE,MELE,IFOURB,NVARI,xcarb,NCARR,MFRbi,EPIN0,
  1504. 2 EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1)
  1505. RETURN
  1506. C
  1507. C
  1508. 367 continue
  1509. * ELSEIF (INPLAS.EQ.67) THEN
  1510. C
  1511. C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  1512. C
  1513. MVEL1= nint(XMAT(NMATR) )
  1514. nccor=ncourb
  1515. CALL CCOTRO(wrk52,wrk53,WRK2,NCcor,MVEL1)
  1516. ncourb=nccor
  1517. LT1=NCOURB*2
  1518. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1519. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1520. RETURN
  1521. *
  1522. *
  1523. 368 continue
  1524. * ELSEIF (INPLAS.EQ.68) THEN
  1525. C
  1526. C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  1527. C
  1528. NCOURB=3
  1529. KERRE = 0
  1530. TRAC(1)=0.D0
  1531. TRAC(2)=0.D0
  1532. TRAC(3)=XMAT(NMATR)
  1533. TRAC(4)=XMAT(NMATR)/XMAT(1)
  1534. TRAC(5)=XMAT(NMATR)
  1535. TRAC(6)=1.D0
  1536. IF (XMAT(NMATR).EQ.0.D0) KERRE = 33
  1537. LT1=NCOURB*2
  1538. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1539. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1540. RETURN
  1541. C
  1542. 369 continue
  1543. * ELSEIF (INPLAS.EQ.69) THEN
  1544. C
  1545. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  1546. C
  1547. ****************************
  1548. * SPECIAL SUCCION
  1549. *
  1550. CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1551. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1552. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1553. KERR1=1
  1554. ENDIF
  1555. RETURN
  1556. C
  1557. 371 continue
  1558. * ELSEIF (INPLAS.EQ.71) THEN
  1559. C
  1560. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  1561. C
  1562. CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1563. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1564. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1565. KERR1=1
  1566. ENDIF
  1567. RETURN
  1568. ****************************
  1569. C
  1570. 372 continue
  1571. * ELSEIF (INPLAS.EQ.72) THEN
  1572. C
  1573. C MODELE INFILL_UNI
  1574. C
  1575. IF (MFRbi.EQ.27) THEN
  1576. C
  1577. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1578. C
  1579. CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT)
  1580. NCOURB=NPOINT/2
  1581. IF (KERRE.EQ.0) THEN
  1582. nccor=ncourb
  1583. CALL CINFIL(wrk52,wrk53,wrk54,WRK2,NCcor)
  1584. ncourb=nccor
  1585. ENDIF
  1586. ELSE
  1587. KERRE = 99
  1588. ENDIF
  1589. RETURN
  1590. C
  1591. 373 continue
  1592. * ELSE IF (INPLAS.EQ.73) THEN
  1593. C
  1594. C MODELE ETAGE
  1595. C pour le moment, element de barre
  1596. *
  1597. IF (MFRbi.EQ.7) THEN
  1598. C
  1599. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1600. C
  1601. IPOS1=1
  1602. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1603. NTRAP=NPOINT/2
  1604. IPOS2=IPOS1+NPOINT
  1605. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1606. NTRAN=NPOINT/2
  1607. IF (KERRE.EQ.0) THEN
  1608. CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN)
  1609. ENDIF
  1610. ELSE
  1611. KERRE = 99
  1612. ENDIF
  1613. RETURN
  1614. C
  1615. * ELSE
  1616. c KERRE=99
  1617. * ENDIF
  1618. *
  1619. *---------------------------------------------------------------------
  1620. * ceramique caroline, couplage gatt_monerie ottosen,
  1621. * maxwell, couplage maxwell ottosen
  1622. *---------------------------------------------------------------------
  1623. 365 continue
  1624. * IF (INPLAS.EQ.65) THEN
  1625. *
  1626. IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  1627. IBIDO = 19
  1628. ELSE
  1629. IBIDO = 14
  1630. ENDIF
  1631. *
  1632. * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  1633. * CAD LORSQUE TTRAN = 0
  1634. *
  1635. IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  1636. *
  1637. * si le point de gauss est déjà endommagé par endommagement généralisé
  1638. * on le traite simplement par ccerac
  1639. *
  1640. IF (VAR0(NVARI-1).EQ.1) THEN
  1641. iforb=ifourb
  1642. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1643. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1644. IND=1
  1645. ELSE
  1646. *
  1647. * si le point de gauss n'a pas un endommagement généralisé
  1648. * on regarde si il a été fissuré
  1649. * par ottosen et si non on applique le fluage puis ottosen
  1650. * si oui on le traite par ottosen
  1651. *
  1652. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1653. IF (ITOTO.EQ.0) THEN
  1654. iforb=ifourb
  1655. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1656. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1657. ifourb=iforb
  1658. IND=1
  1659. * Ligne suivante à supprimer
  1660. * IF (IND.EQ.0) THEN
  1661. * on regarde si on a eu endommagement généralisé
  1662. * si on n'a pas eu endommagement généralisé on appelle ottosen
  1663. IF (VARF(NVARI-1).NE.1) THEN
  1664. DO 161 I = 1,NVARI
  1665. VAR01(I) = VARF(I)
  1666. 161 CONTINUE
  1667. DO 835 I=1,NSTRS
  1668. * PRINT *,'DEPST EPINF-EPIN0 ',
  1669. * 1 I,DEPST(I),(EPINF(I)-EPIN0(I))
  1670. DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I))
  1671. C on remplace SIGF par SIG0
  1672. SIG01(I) = SIG0(I)
  1673. 835 CONTINUE
  1674. CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,
  1675. 1 ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF,
  1676. 2 DEFP,MFR1,KERRE,IB,IGAU)
  1677. C on met à jour la variable interne EPSE commune aux deux modèles
  1678. VARF(1) = VARF(1)+VARF(NVARI)
  1679. C DO 537 I=1,NSTRS
  1680. C IF (SIGF(I).NE.SIG01(I)) THEN
  1681. C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  1682. C ENDIF
  1683. C537 CONTINUE
  1684. C DO 538 I=1,NVARI
  1685. C IF (VARF(I).NE.VAR01(I)) THEN
  1686. C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  1687. C ENDIF
  1688. C 538 CONTINUE
  1689.  
  1690. C on calcule l'increment de déformation du pas de temps
  1691. DO 836 I=1,NSTRS
  1692. C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I)
  1693. DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I))
  1694. 836 CONTINUE
  1695. IND=0
  1696. ENDIF
  1697. C Ligne suivante à supprimer
  1698. C ENDIF
  1699. ELSE
  1700. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1701. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1702. 2 KERRE,IB,IGAU)
  1703. VARF(1) = VARF(1)+VARF(NVARI)
  1704. IND=0
  1705. ENDIF
  1706. ENDIF
  1707. C
  1708. ELSE
  1709. *
  1710. * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION
  1711. *
  1712. IF (TETA2.GE.XMAT(IBIDO)) THEN
  1713. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1714. IF (ITOTO.EQ.0) THEN
  1715. iforb=ifourb
  1716. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1717. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1718. ifourb=iforb
  1719. IND=1
  1720. ELSE
  1721. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1722. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1723. 2 KERRE,IB,IGAU)
  1724. VARF(1) = VARF(1)+VARF(NVARI)
  1725. IND=0
  1726. ENDIF
  1727. ELSE
  1728. IF (VAR0(NVARI-1).EQ.1) THEN
  1729. iforb=ifourb
  1730. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1731. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1732. ifourb=iforb
  1733. IND=1
  1734. ELSE
  1735. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1736. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1737. 2 KERRE,IB,IGAU)
  1738. VARF(1) = VARF(1)+VARF(NVARI)
  1739. IND=0
  1740. ENDIF
  1741. ENDIF
  1742. ENDIF
  1743. IF (MFR1.EQ.17) THEN
  1744. IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  1745. CALL ERREUR(KERREU1)
  1746. ENDIF
  1747. ENDIF
  1748. C
  1749. DTOPTI = MIN(DTOPTI,DTT)
  1750. NINCMA = MAX(NINCMA,NSSINC)
  1751. NCOMP = NCOMP + 1
  1752. TSOM = TSOM + DTT
  1753. NSOM = NSOM + NSSINC
  1754. NINV = NINV + INV
  1755. TCAR = TCAR + DTT* DTT
  1756. IF (KERRE.NE.0.AND.KERRE.NE.99) THEN
  1757. KERR1=1
  1758. ENDIF
  1759. RETURN
  1760. C
  1761. 408 continue
  1762. * ELSEIF (INPLAS.EQ.108) THEN
  1763. C
  1764. IND=0
  1765. FI1 = 0.D0
  1766. FI2 = 0.D0
  1767. nexo = exova0(/1)
  1768. do 2050 inex = 1,nexo
  1769. if ((nomexo(inex)(1:4).eq.'DFIS').and.
  1770. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  1771. fi1 = exova0(inex)
  1772. fi2 = exova1(inex)
  1773. goto 2001
  1774. endif
  1775. 2050 continue
  1776. 2001 continue
  1777. C
  1778. C NSIMP pointe sur la caracteristique de fissuration facult. qui
  1779. C indique le type de resolution souhaite
  1780. C
  1781. IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN
  1782. NSIMP=71
  1783. ELSE
  1784. NSIMP=66
  1785. IF(MFR1.EQ.1.AND.IFOUR.EQ.-2) NSIMP=62
  1786. IF(MFR1.EQ.3.OR.MFR1.EQ.9) NSIMP=61
  1787. ENDIF
  1788. XSIMP=XMAT(NSIMP)
  1789. C
  1790. IF (XSIMP.EQ.0.D0) THEN
  1791. C resolution complete
  1792. C
  1793. CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1794. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1795. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1796. ELSE
  1797. C resolution simplifiee
  1798. C
  1799. CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1800. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1801. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1802. ENDIF
  1803. IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1
  1804. RETURN
  1805. C
  1806. 374 continue
  1807. * ELSE IF (INPLAS.EQ.74) THEN
  1808. *
  1809. * CHAINE DE MAXWELL
  1810. *
  1811. * on commence par recuperer le nombre d'elements dans la chaine
  1812. * et les proprietes et variables internes associees a des objets
  1813. *
  1814. nbgmab=nbgmat
  1815. nlmatb=nelmat
  1816. CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA,
  1817. & NCHAIN)
  1818. nbgmat=nbgmab
  1819. nelmat=nlmatb
  1820. IF (IERR.NE.0) THEN
  1821. SEGSUP WR12
  1822. return
  1823. ENDIF
  1824. C
  1825. IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN
  1826. dtbi=dt
  1827. CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1828. dt=dtbi
  1829. ELSE
  1830. C
  1831. *
  1832. * MLR 10/08/99
  1833. *
  1834. * ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  1835. dtbi=dt
  1836. CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1837. dt=dtbi
  1838. ENDIF
  1839. *
  1840. * ici gerer les erreurs
  1841. *
  1842. CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN)
  1843. C SEGSUP WR12
  1844. RETURN
  1845.  
  1846. *----------------------------------------------------------
  1847. * modele maxott
  1848. *----------------------------------------------------------
  1849. 406 continue
  1850. * ELSE IF (INPLAS.EQ.106) THEN
  1851. *
  1852. * on commence par recuperer le nombre d'elements dans la chaine
  1853. * et les proprietes et variables internes associees a des objets
  1854. *
  1855. nbgmab=nbgmat
  1856. nlmatb=nelmat
  1857. CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA,
  1858. & NCHAIN,EPSFLU)
  1859. nbgmat=nbgmab
  1860. nelmat=nlmatb
  1861. IF (IERR.NE.0) THEN
  1862. SEGSUP WR12
  1863. RETURN
  1864. ENDIF
  1865. *
  1866. * modele maxott
  1867. *
  1868. dtbi=dt
  1869. CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA,
  1870. & EPSFLU)
  1871. dt=dtbi
  1872. *
  1873. * stockage des variables internes et des proprietes
  1874. *
  1875. CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU)
  1876. C SEGSUP WR12
  1877. RETURN
  1878. *
  1879. *----------------------------------------------------------
  1880. * modeles FBB1 et FBB2
  1881. *----------------------------------------------------------
  1882. *
  1883. 427 continue
  1884. 428 continue
  1885. * ELSE IF (INPLAS.EQ.127.OR.INPLAS.EQ.128) THEN
  1886. *
  1887. LEPLAS = INPLAS
  1888. CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU,
  1889. & IECOU,LEPLAS)
  1890. RETURN
  1891. *
  1892. *----------------------------------------------------------
  1893. * modele INCO
  1894. *----------------------------------------------------------
  1895. 429 continue
  1896. * ELSE IF (INPLAS .EQ. 129) THEN
  1897. *
  1898. * modele INCO
  1899. *
  1900. CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1901. RETURN
  1902. *
  1903. *----------------------------------------------------------
  1904. * modele KELVIN
  1905. *----------------------------------------------------------
  1906. 474 continue
  1907. * ELSE IF (INPLAS .EQ. 174) THEN
  1908. *
  1909. * modele KELVIN
  1910. *
  1911. CALL KELVIN (wrk52,wrk53,wrk54,IB,IGAU,NBPGAU)
  1912. RETURN
  1913. *
  1914. *----------------------------------------------------------
  1915. * modele FLUTRA
  1916. *----------------------------------------------------------
  1917. 443 continue
  1918. * ELSE IF (INPLAS .EQ. 143) THEN
  1919. *
  1920. * modele FLUTRA
  1921. *
  1922. NMATER = NMATT + 3
  1923. LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS)
  1924. IF(LW.LT.LWTRA) THEN
  1925. LW = LWTRA
  1926. SEGADJ WRK3
  1927. ENDIF
  1928. *
  1929. LA1 = 1
  1930. LA2 = LA1 + NMATER
  1931. LA3 = LA2 + NSTRS
  1932. LA4 = LA3 + NSTRS
  1933. LA5 = LA4 + NSTRS
  1934. LA6 = LA5 + NSTRS*NSTRS
  1935. LA7 = LA6 + NSTRS
  1936. LA8 = LA7 + NSTRS
  1937. LA9 = LA8 + NSTRS
  1938. LA10 = LA9 + NSTRS
  1939. LA11 = LA10 + NSTRS
  1940. LA12 = LA11 + NSTRS*NSTRS
  1941. *
  1942. CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT,
  1943. & IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER,
  1944. & SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3),
  1945. & WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7),
  1946. & WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11),
  1947. & WORK(LA12),KERRE)
  1948. RETURN
  1949. *
  1950. 450 continue
  1951. * ELSE IF (INPLAS.EQ.150) THEN
  1952. C
  1953. C MODELE BILIN_EFFX
  1954. C
  1955. KERRE=0
  1956. CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1957. RETURN
  1958. *
  1959. 451 continue
  1960. * ELSE IF (INPLAS.EQ.151) THEN
  1961. C
  1962. C MODELE ISS_GRANGE
  1963. C
  1964. KERRE=0
  1965. CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1966. IF (KERRE.EQ.22) THEN
  1967. INTERR(1)=IB
  1968. MOTERR(1:4) = 'JOI1'
  1969. INTERR(2)=IGAU
  1970. INTERR(3)=INPLAS
  1971. CALL ERREUR(268)
  1972. ENDIF
  1973. IF (KERRE.EQ.23) THEN
  1974. CALL ERREUR(1016)
  1975. ENDIF
  1976. IF (KERRE.EQ.25) THEN
  1977. CALL ERREUR(1017)
  1978. ENDIF
  1979. RETURN
  1980. *
  1981. 452 continue
  1982. * ELSE IF (INPLAS.EQ.152) THEN
  1983. C
  1984. C MODELE RUP_THER
  1985. C
  1986. KERRE=0
  1987. CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1988. IF (KERRE.EQ.22) THEN
  1989. INTERR(1)=IB
  1990. MOTERR(1:4) = 'JOI1'
  1991. INTERR(2)=IGAU
  1992. INTERR(3)=INPLAS
  1993. CALL ERREUR(268)
  1994. ENDIF
  1995. RETURN
  1996. *
  1997. 455 continue
  1998. * ELSE IF (INPLAS.EQ.155) THEN
  1999. C
  2000. C MODELE GERNAY
  2001. C
  2002. KERRE=0
  2003. CALL GERNAY(WRK52,WRK53,WRK54,WRK3,IB,IGAU,NBPGAU)
  2004. RETURN
  2005.  
  2006. 456 continue
  2007. * ELSE IF (INPLAS.EQ.156) THEN
  2008. C
  2009. C MODELE WELLS
  2010. C
  2011. CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  2012. RETURN
  2013. C
  2014. C-----------------------------------------------------------------------
  2015. C Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe
  2016. C specifique UMAT
  2017. C-----------------------------------------------------------------------
  2018. 899 continue
  2019. * ELSE IF (INPLAS.EQ.-1) THEN
  2020. C
  2021. KERR1 = 0
  2022. C
  2023. C Pointeur (>0) sur fonction externe si definie
  2024. m_ptre = wrk53.jecher
  2025. C
  2026. C Preparation des entrees de la routine UMAT
  2027. C N.B. Les arguments pointeurs sont reperes par des
  2028. C caracteres minuscules
  2029. C
  2030. CALL WKUMA1 ( wrk52, wkumat )
  2031. C
  2032. C Integration de la loi externe au point courant
  2033. C N.B. Les entrees/sorties non actives ou non exploitees sont
  2034. C reperees par des caracteres minuscules
  2035. C
  2036. IF (m_ptre.LE.0) THEN
  2037. C
  2038. C Appel a UMAT standard de Cast3M
  2039. CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd,
  2040. & rpl, ddsddt, drplde, drpldt,
  2041. & EPST0, DEPST, TIME, DTIME,
  2042. & TEMP, DTEMP, PAREX0, DPRED,
  2043. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  2044. & XMATF, NPROPS, COORGA,
  2045. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  2046. & IB, IGAU, layer, kspt, kstep, KINC )
  2047. C
  2048. ELSE
  2049. C
  2050. C Branchement a la loi externe pointee par m_ptre
  2051. CALL UMATEXT ( m_ptre,
  2052. & SIGF, VARF, ddsdde, sse, spd, scd,
  2053. & rpl, ddsddt, drplde, drpldt,
  2054. & EPST0, DEPST, TIME, DTIME,
  2055. & TEMP, DTEMP, PAREX0, DPRED,
  2056. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  2057. & XMATF, NPROPS, COORGA,
  2058. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  2059. & IB, IGAU, layer, kspt, kstep, KINC )
  2060. C
  2061. ENDIF
  2062. C
  2063. IF (KINC.NE.1) THEN
  2064. IF (KINC.EQ.0) THEN
  2065. ISIGN = 1
  2066. ELSE
  2067. ISIGN = ABS(KINC)/KINC
  2068. ENDIF
  2069. KERRE = ISIGN*92
  2070. KERR1 = -1-ABS(KINC)
  2071. ENDIF
  2072. C
  2073. C Releve du pas de temps optimal pour l'iteration suivante
  2074. C
  2075. DTOPTI=PNEWDT*DTIME
  2076.  
  2077. RETURN
  2078. C
  2079. C-----------------------------------------------------------------------
  2080. C Modeles 'VISCO_EXTERNE' : integres par CCREEP
  2081. C-----------------------------------------------------------------------
  2082. 898 continue
  2083. C ELSEIF (INPLAS.EQ.-2) THEN
  2084. C
  2085. KERR1 = 0
  2086. C
  2087. C Pointeur (>0) sur fonction externe si definie
  2088. m_ptre = wrk53.jecher
  2089. C
  2090. IF (m_ptre.LE.0) THEN
  2091. C
  2092. C Appel a CCREEP standard de Cast3M
  2093. IFORB = IFOURB
  2094. CALL CCREEP ( wrk52, wrk53, wrk54,
  2095. & IFORB, IB, IGAU, NBPGAU,
  2096. & wcreep, iecou, xecou )
  2097. C
  2098. ELSE
  2099. C
  2100. C Branchement a la loi externe pointee par m_ptre
  2101. C* CALL EXTLOI(m_ptre,...)
  2102. KSTEPC = 251
  2103. C*TMP Option non disponible pour l'instant (cf. modeli.eso)
  2104. C
  2105. ENDIF
  2106.  
  2107. C Erreur detectee par l'integrateur CCREEP
  2108. C
  2109. IF (KERRE.NE.0) THEN
  2110. KERR1 = 1
  2111. RETURN
  2112. ENDIF
  2113. C
  2114. C Erreur lors d'un appel au module utilisateur CREEP
  2115. C
  2116. IF (KSTEPC.NE.1) THEN
  2117. IF (KSTEPC.EQ.0) THEN
  2118. ISIGN = 1
  2119. ELSE
  2120. ISIGN = ABS(KSTEPC)/KSTEPC
  2121. ENDIF
  2122. KERRE = ISIGN*93
  2123. KERR1 = -1-ABS(KSTEPC)
  2124. ENDIF
  2125. RETURN
  2126. C
  2127. C-----------------------------------------------------------------------
  2128. C ELSE
  2129. C KERRE = 99
  2130. C ENDIF
  2131. C
  2132. END
  2133.  
  2134.  
  2135.  
  2136.  
  2137.  
  2138.  
  2139.  
  2140.  
  2141.  
  2142.  
  2143.  
  2144.  
  2145.  
  2146.  
  2147.  
  2148.  
  2149.  
  2150.  

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