Télécharger coml12.eso

Retour à la liste

Numérotation des lignes :

  1. C COML12 SOURCE PV 17/12/08 21:16:36 9660
  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.(conexo(inex).eq.CONM)) then
  212. SUCC1 = exova0(inex)
  213. SUCC2 = exova1(inex)
  214. goto 1295
  215. endif
  216. 1296 continue
  217. endif
  218. 1295 continue
  219. *---------------------- traitement des modeles
  220. * liaison_acbe
  221. IF(INPLAS.EQ.171) then
  222. call aclj(wrk52,wrk53,wrk54,nvari,iecou)
  223. ELSE IF (INPLAS.EQ.144) THEN
  224. * modele RICRAG
  225. if(ifour.ne.2) then
  226. CALL RIC2NL(wrk52,wrk53,wrk54,nvari,iecou)
  227. else
  228. CALL RIC3NL(wrk52,wrk53,wrk54,nvari,iecou)
  229. endif
  230.  
  231. * modele INTIMP
  232. ELSE IF (INPLAS.EQ.145 .AND. mfrbi.eq.7) THEN
  233. nstrbi=nstrss
  234. icarbi=icara
  235. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  236. nstrss=nstrbi
  237. icara=icarbi
  238.  
  239. c modele RICJOI
  240. ELSE IF (INPLAS.EQ.146) then
  241. * write(6,*) ' ifour ',ifour
  242. * if(ib+igau.eq.2) write(6,*)'sig0', (SIG0 (iou),iou=1,nstrs)
  243. * if(ib+igau.eq.2) write(6,*)'depst', (DEPST (iou),iou=1,nstrs)
  244. if(ifour.ne.2) then
  245. CALL RICJ2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  246. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  247. else
  248. CALL RICJ3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  249. & TETA1,TETA2,
  250. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  251. endif
  252. * if(ib+igau.eq.2) write(6,*)'SIGF', (SIGF(iou),iou=1,nstrs)
  253.  
  254.  
  255.  
  256. C +BR
  257. ELSEIF(INPLAS.EQ.157) then
  258. C Modele GLRC_DM
  259.  
  260. CALL LCGLDM(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  261.  
  262. RETURN
  263.  
  264. ELSEIF(INPLAS.EQ.158) then
  265. C Modele RICBET
  266.  
  267. CALL RICBET(wrk52,wrk53,wrk54,nvari,iecou)
  268.  
  269. RETURN
  270.  
  271. ELSEIF(INPLAS.EQ.159) then
  272. C Modele RICCOQ
  273.  
  274. CALL ELOCRAK1(wrk52,wrk53,wrk54,nvari,iecou)
  275.  
  276. RETURN
  277.  
  278. ELSEIF(INPLAS.EQ.173) then
  279. C Modele CONCYC
  280.  
  281. CALL CONCYC1(wrk52,wrk53,wrk54,nvari,iecou)
  282.  
  283. ELSEIF(INPLAS.EQ.175) then
  284. C Modele OUGLOVA
  285. IF (MFR.EQ.27) THEN
  286. CALL OUGLOB(XMAT,DEPST,SIG0,VAR0,SIGF,VARF)
  287. ELSE
  288. CALL OUGLOV(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,IFOUR)
  289. ENDIF
  290.  
  291.  
  292. RETURN
  293.  
  294. C -BR
  295.  
  296.  
  297. C
  298. C Ecoulement pour le modele de Symonds & Cowper
  299. ELSE IF (INPLAS.EQ.153.OR.INPLAS.EQ.154) then
  300. c write(6,*) ' dans coml12 envoi dans coulesyc',inplas,dt
  301. *
  302. C on recupere la courbe de traction
  303. C
  304. nccor=ncourb
  305. call CCOTRA(WRK52,WRK2,NCCOR,WRK53)
  306. ncourb= nccor
  307. C
  308. C meme maniere de proceder que dans ecoin0
  309. nccor=ncourb
  310. iforb=ifourb
  311.  
  312. CALL SYCO12(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  313. & NBPGAU,NCcor,IFORB,iecou,xecou)
  314. C
  315. ncourb=nccor
  316. ifourb=iforb
  317.  
  318. ELSEIF(INPLAS.EQ.172) then
  319. C Modele DP_SOL
  320.  
  321. CALL DP_SOL(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  322.  
  323. RETURN
  324.  
  325. ELSEIF(INPLAS.EQ.176) then
  326. C Modele IWPR3D_SOL
  327.  
  328. CALL IWPR3D(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCAR,
  329. & EPIN0,EPINF,EPST0,EPSTF)
  330.  
  331. RETURN
  332.  
  333. ELSEIF(INPLAS.EQ.177) then
  334. C Modele EFEM
  335. IF ((IFOUR.EQ.-2).AND.(ILCOUR.EQ.4)) THEN
  336. CALL PBEFEM(wrk52,wrk53,wrk54,nvari,iecou,mwrkxe)
  337. ELSE
  338. CALL ERREUR(5)
  339. ENDIF
  340.  
  341. RETURN
  342.  
  343. ELSE
  344. write(ioimp,*) 'Branchement incorrect dans COML12'
  345. CALL ERREUR(5)
  346. ENDIF
  347.  
  348. RETURN
  349. end
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  

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