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

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