Télécharger coml12.eso

Retour à la liste

Numérotation des lignes :

  1. C COML12 SOURCE CB215821 18/09/13 21:15:14 9917
  2. SUBROUTINE COML12(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3. & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  4. & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou)
  5.  
  6. *----------------------------------------------------------------
  7. * lois locales pour la mecanique
  8. * decrites au point d integration
  9. *----------------------------------------------------------------
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCGEOME
  16. -INC SMMODEL
  17. -INC SMELEME
  18. -INC SMINTE
  19. -INC CCHAMP
  20. -INC SMCOORD
  21. * segment deroulant le mcheml
  22. -INC DECHE
  23. *
  24. SEGMENT WRK2
  25. REAL*8 TRAC(LTRAC)
  26. ENDSEGMENT
  27. *
  28. SEGMENT MWRKXE
  29. REAL*8 XEL(3,NBNNbi)
  30. ENDSEGMENT
  31. *
  32. SEGMENT WRK3
  33. REAL*8 WORK(LW),WORK2(LW2)
  34. ENDSEGMENT
  35. *
  36. SEGMENT WRK6
  37. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  38. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  39. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  40. ENDSEGMENT
  41. *
  42. SEGMENT WRK7
  43. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  44. ENDSEGMENT
  45. *
  46. SEGMENT WRK8
  47. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  48. REAL*8 DDINVp(NSTRS,NSTRS)
  49. ENDSEGMENT
  50. *
  51. SEGMENT WRK9
  52. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  53. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  54. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  55. REAL*8 SIGY(NSIGY)
  56. INTEGER NKX(NNKX)
  57. ENDSEGMENT
  58. *
  59. SEGMENT WRK91
  60. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  61. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  62. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  63. REAL*8 SIGY1(NSIGY1)
  64. ENDSEGMENT
  65. *
  66. SEGMENT WR10
  67. INTEGER IABLO1(NTABO1)
  68. REAL*8 TABLO2(NTABO2)
  69. ENDSEGMENT
  70. *
  71. SEGMENT WR11
  72. INTEGER IABLO3(NTABO3)
  73. REAL*8 TABLO4(NTABO4)
  74. ENDSEGMENT
  75. *
  76. SEGMENT WR12
  77. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  78. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  79. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  80. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  81. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  82. REAL*8 SM8(NSTRS)
  83. ENDSEGMENT
  84. SEGMENT WRK12
  85. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  86. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  87. real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  88. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  89. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  90. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  91. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  92. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  93. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  94. ENDSEGMENT
  95. segment wrkgur
  96. real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7
  97. real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6)
  98. real*8 wgur13(7), wgur14
  99. real*8 wgur15,wgur16,wgur17
  100. endsegment
  101. C
  102. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  103. C l'integrateur externe specifique UMAT
  104. C
  105. SEGMENT WKUMAT
  106. C Entrees/sorties de la routine UMAT
  107. REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  108. & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  109. & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  110. & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  111. CHARACTER*16 CMNAME
  112. INTEGER NDI, NSHR, NSTATV, NPROPS,
  113. & LAYER, KSPT, KSTEP, KINC
  114. C Variables de travail
  115. LOGICAL LTEMP, LPRED, LVARI, LDFGRD
  116. INTEGER NSIG0, NPARE0, NGRAD0
  117. ENDSEGMENT
  118. C
  119. C Segment de travail pour les lois 'VISCO_EXTERNE'
  120. C
  121. SEGMENT WCREEP
  122. C Entrees/sorties constantes de la routine CREEP
  123. REAL*8 SERD
  124. CHARACTER*16 CMNAMC
  125. INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC
  126. C Entrees/sorties de la routine CREEP pouvant varier
  127. REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV),
  128. & STVP2(NSTV), STV12(NSTV), STVP3(NSTV),
  129. & STVP4(NSTV), STV13(NSTV), STVF(NSTV),
  130. & TMP12, TMP, TMP32,
  131. & DTMP12, DTMP,
  132. & PRD12(NPRD), PRD(NPRD), PRD32(NPRD),
  133. & DPRD12(NPRD), DPRD(NPRD)
  134. INTEGER KSTEPC
  135. C Autres indicateurs et variables de travail
  136. LOGICAL LTMP, LPRD, LSTV
  137. INTEGER IVIEX, NPAREC
  138. REAL*8 dTMPdt, dPRDdt(NPRD)
  139. ENDSEGMENT
  140. *
  141. SEGMENT ENDO0
  142. REAL*8 ENDO(LENDO),RAPP(LENDO)
  143. ENDSEGMENT
  144. *
  145. DIMENSION NWA(9)
  146. DIMENSION SIG01(8),VAR01(37)
  147. DIMENSION EPSFLU(8)
  148.  
  149. SEGMENT ECOU
  150. REAL*8 ecow00,ecow0,
  151. C REAL*8 TEST, ALFAH,
  152. 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
  153. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  154. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  155. 2 ecow12(6),
  156. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  157. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  158. C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  159. 2 ecow17(6),ecow18(6),ecow19,ecow20
  160. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  161. ENDSEGMENT
  162. *
  163. * Segment NECOU utilisé dans ECOINC
  164. *
  165. SEGMENT NECOU
  166. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  167. . ITYP,IFOURB,IFLUAG,
  168. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  169. . JFLUAG,KFLUAG,LFLUAG,
  170. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  171. ENDSEGMENT
  172. *
  173. * Segment IECOU: sert de fourre-tout pour les initialisations
  174. * d'entiers
  175. *
  176. SEGMENT IECOU
  177. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  178. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  179. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  180. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  181. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  182. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  183. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  184. ENDSEGMENT
  185. *
  186. * Segment XECOU: sert de fourre-tout pour les initialisations
  187. * de réels
  188. *
  189. SEGMENT XECOU
  190. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  191. ENDSEGMENT
  192. C-----------------------------------------------------------------------
  193. C
  194. c moterr(1:6) = 'COML12 '
  195. c moterr(7:15) = 'element '
  196. c interr(1) = ib
  197. c interr(2) = igau
  198. c call erreur(-329)
  199. * write(6,*) ' entrée dans coml12 iecou ', iecou
  200. imodel = iqmod
  201. c
  202. c traitement du modele
  203. c
  204. NBPGAU = nbgs
  205. NVARI = NVART
  206. TETA1 = ture0(1)
  207. TETA2 = turef(1)
  208. SUCC1 = -1.D35
  209. SUCC2 = -1.D35
  210. nexo = exova0(/1)
  211. if (nexo.gt.0) then
  212. do 1296 inex = 1,nexo
  213. if ((nomexo(inex).eq.'SUCC ').and.
  214. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  215. SUCC1 = exova0(inex)
  216. SUCC2 = exova1(inex)
  217. goto 1295
  218. endif
  219. 1296 continue
  220. endif
  221. 1295 continue
  222. *---------------------- traitement des modeles
  223. * liaison_acbe
  224. IF(INPLAS.EQ.171) then
  225. call aclj(wrk52,wrk53,wrk54,nvari,iecou)
  226. ELSE IF (INPLAS.EQ.144) THEN
  227. * modele RICRAG
  228. if(ifour.ne.2) then
  229. CALL RIC2NL(wrk52,wrk53,wrk54,nvari,iecou)
  230. else
  231. CALL RIC3NL(wrk52,wrk53,wrk54,nvari,iecou)
  232. endif
  233.  
  234. * modele INTIMP
  235. ELSE IF (INPLAS.EQ.145 .AND. mfrbi.eq.7) THEN
  236. nstrbi=nstrss
  237. icarbi=icara
  238. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  239. nstrss=nstrbi
  240. icara=icarbi
  241.  
  242. c modele RICJOI
  243. ELSE IF (INPLAS.EQ.146) then
  244. * write(6,*) ' ifour ',ifour
  245. * if(ib+igau.eq.2) write(6,*)'sig0', (SIG0 (iou),iou=1,nstrs)
  246. * if(ib+igau.eq.2) write(6,*)'depst', (DEPST (iou),iou=1,nstrs)
  247. if(ifour.ne.2) then
  248. CALL RICJ2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  249. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  250. else
  251. CALL RICJ3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  252. & TETA1,TETA2,
  253. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  254. endif
  255. * if(ib+igau.eq.2) write(6,*)'SIGF', (SIGF(iou),iou=1,nstrs)
  256.  
  257.  
  258.  
  259. C +BR
  260. ELSEIF(INPLAS.EQ.157) then
  261. C Modele GLRC_DM
  262.  
  263. CALL LCGLDM(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  264.  
  265. RETURN
  266.  
  267. ELSEIF(INPLAS.EQ.158) then
  268. C Modele RICBET
  269.  
  270. CALL RICBET(wrk52,wrk53,wrk54,nvari,iecou)
  271.  
  272. RETURN
  273.  
  274. ELSEIF(INPLAS.EQ.159) then
  275. C Modele RICCOQ
  276.  
  277. CALL ELOCRAK1(wrk52,wrk53,wrk54,nvari,iecou)
  278.  
  279. RETURN
  280.  
  281. ELSEIF(INPLAS.EQ.173) then
  282. C Modele CONCYC
  283.  
  284. CALL CONCYC1(wrk52,wrk53,wrk54,nvari,iecou)
  285.  
  286. ELSEIF(INPLAS.EQ.175) then
  287. C Modele OUGLOVA
  288. IF (MFR.EQ.27) THEN
  289. CALL OUGLOB(XMAT,DEPST,SIG0,VAR0,SIGF,VARF)
  290. ELSE
  291. CALL OUGLOV(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,IFOUR)
  292. ENDIF
  293.  
  294.  
  295. RETURN
  296.  
  297. C -BR
  298.  
  299.  
  300. C
  301. C Ecoulement pour le modele de Symonds & Cowper
  302. ELSE IF (INPLAS.EQ.153.OR.INPLAS.EQ.154) then
  303. c write(6,*) ' dans coml12 envoi dans coulesyc',inplas,dt
  304. *
  305. C on recupere la courbe de traction
  306. C
  307. nccor=ncourb
  308. call CCOTRA(WRK52,WRK2,NCCOR,WRK53)
  309. ncourb= nccor
  310. C
  311. C meme maniere de proceder que dans ecoin0
  312. nccor=ncourb
  313. iforb=ifourb
  314.  
  315. CALL SYCO12(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  316. & NBPGAU,NCcor,IFORB,iecou,xecou)
  317. C
  318. ncourb=nccor
  319. ifourb=iforb
  320.  
  321. ELSEIF(INPLAS.EQ.172) then
  322. C Modele DP_SOL
  323.  
  324. CALL DP_SOL(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  325.  
  326. RETURN
  327.  
  328. ELSEIF(INPLAS.EQ.176) then
  329. C Modele IWPR3D_SOL
  330.  
  331. CALL IWPR3D(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCAR,
  332. & EPIN0,EPINF,EPST0,EPSTF)
  333.  
  334. RETURN
  335.  
  336. ELSEIF(INPLAS.EQ.177) then
  337. C Modele EFEM
  338. IF ((IFOUR.EQ.-2).AND.(ILCOUR.EQ.4)) THEN
  339. CALL PBEFEM(wrk52,wrk53,wrk54,nvari,iecou,mwrkxe)
  340. ELSE
  341. CALL ERREUR(5)
  342. ENDIF
  343.  
  344. RETURN
  345.  
  346. ELSE
  347. write(ioimp,*) 'Branchement incorrect dans COML12'
  348. CALL ERREUR(5)
  349. ENDIF
  350.  
  351. RETURN
  352. end
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  

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