Télécharger coml8.eso

Retour à la liste

Numérotation des lignes :

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

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