Télécharger coml12.eso

Retour à la liste

Numérotation des lignes :

coml12
  1. C COML12 SOURCE MB234859 23/02/03 21:15:04 11581
  2. SUBROUTINE COML12(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3. & mwrkxe,iretou,iecou,necou,dlttmp)
  4.  
  5. *----------------------------------------------------------------
  6. * lois locales pour la mecanique
  7. * decrites au point d integration
  8. *----------------------------------------------------------------
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11.  
  12. -INC PPARAM
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC SMMODEL
  16. -INC SMELEME
  17. -INC SMINTE
  18. -INC CCHAMP
  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 MWRKXE
  28. REAL*8 XEL(3,NBNNbi)
  29. ENDSEGMENT
  30. *
  31. * Segment NECOU utilisé dans ECOINC
  32. *
  33. SEGMENT NECOU
  34. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  35. . ITYP,IFOURB,IFLUAG,
  36. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  37. . JFLUAG,KFLUAG,LFLUAG,
  38. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  39. ENDSEGMENT
  40. *
  41. * Segment IECOU: sert de fourre-tout pour les initialisations
  42. * d'entiers
  43. *
  44. SEGMENT IECOU
  45. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  46. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  47. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  48. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  49. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  50. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  51. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  52. ENDSEGMENT
  53. *
  54. REAL*8 DLTTMP
  55. dimension xcar(1)
  56. C-----------------------------------------------------------------------
  57. C
  58. c moterr(1:6) = 'COML12 '
  59. c moterr(7:15) = 'element '
  60. c interr(1) = ib
  61. c interr(2) = igau
  62. c call erreur(-329)
  63. * write(6,*) ' entrée dans coml12 iecou ', iecou
  64. imodel = iqmod
  65. c
  66. c traitement du modele
  67. c
  68. NBPGAU = nbgs
  69. NVARI = NVART
  70. TETA1 = ture0(1)
  71. TETA2 = turef(1)
  72. SUCC1 = -1.D35
  73. SUCC2 = -1.D35
  74. nexo = exova0(/1)
  75. if (nexo.gt.0) then
  76. do 1296 inex = 1,nexo
  77. if ((nomexo(inex).eq.'SUCC ').and.
  78. & (conexo(inex)(1:LCONMO).eq.CONM(1:LCONMO))) then
  79. SUCC1 = exova0(inex)
  80. SUCC2 = exova1(inex)
  81. goto 1295
  82. endif
  83. 1296 continue
  84. endif
  85. 1295 continue
  86. C
  87. C MODELE PLASTIQUE 'LIAISON_ACBE'
  88. IF(INPLAS.EQ.171) then
  89. call aclj(wrk52,wrk53,wrk54,nvari,iecou)
  90. C
  91. C MODELE ENDOMMAGEABLE 'RICRAG'
  92. ELSE IF (INPLAS.EQ.144) THEN
  93. if(ifour.ne.2) then
  94. CALL RIC2NL(wrk52,wrk53,wrk54,nvari,iecou)
  95. else
  96. CALL RIC3NL(wrk52,wrk53,wrk54,nvari,iecou)
  97. endif
  98. C
  99. C MODELE PLASTIQUE 'INTIMP'
  100. ELSE IF (INPLAS.EQ.145 .AND. mfrbi.eq.7) THEN
  101. nstrbi=nstrss
  102. icarbi=icara
  103. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  104. nstrss=nstrbi
  105. icara=icarbi
  106. C
  107. C MODELE PLASTIQUE 'RICJOI'
  108. ELSE IF (INPLAS.EQ.146) then
  109. * write(6,*) ' ifour ',ifour
  110. * if(ib+igau.eq.2) write(6,*)'sig0', (SIG0 (iou),iou=1,nstrs)
  111. * if(ib+igau.eq.2) write(6,*)'depst', (DEPST (iou),iou=1,nstrs)
  112. if(ifour.ne.2) then
  113. CALL RICJ2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  114. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  115. else
  116. CALL RICJ3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  117. & TETA1,TETA2,
  118. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  119. endif
  120. * if(ib+igau.eq.2) write(6,*)'SIGF', (SIGF(iou),iou=1,nstrs)
  121. C +BR
  122. C
  123. C MODELE ENODMMAGEABLE 'GLRC_DM'
  124. ELSEIF(INPLAS.EQ.157) then
  125. CALL LCGLDM(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  126. C
  127. C MODELE ENODMMAGEABLE 'RICBET'
  128. ELSEIF(INPLAS.EQ.158) then
  129. CALL RICBET(wrk52,wrk53,wrk54,nvari,iecou)
  130. C
  131. C MODELE ENODMMAGEABLE 'RICCOQ'
  132. ELSEIF(INPLAS.EQ.159) then
  133. CALL ELOCRAK1(wrk52,wrk53,wrk54,nvari,iecou)
  134. C
  135. C MODELE PLASTIQUE 'CONCYC'
  136. ELSEIF(INPLAS.EQ.173) then
  137. CALL CONCYC1(wrk52,wrk53,wrk54,nvari,iecou)
  138. C
  139. C MODELE PLASTIQUE 'OUGLOVA'
  140. ELSEIF(INPLAS.EQ.175) then
  141. IF (MFR.EQ.27) THEN
  142. CALL OUGLOB(XMAT,DEPST,SIG0,VAR0,SIGF,VARF)
  143. ELSE
  144. CALL OUGLOV(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,IFOUR)
  145. ENDIF
  146. C -BR
  147. C
  148. C MODELES VISCOPLASTIQUE 'SYCO1' ET 'SYCO2' (Symonds & Cowper)
  149. ELSE IF (INPLAS.EQ.153.OR.INPLAS.EQ.154) then
  150. C on recupere la courbe de traction
  151. nccor=ncourb
  152. call CCOTRA(WRK52,WRK2,NCCOR,WRK53)
  153. ncourb= nccor
  154. C
  155. C meme maniere de proceder que dans ecoin0
  156. nccor=ncourb
  157. iforb=ifourb
  158. CALL SYCO12(wrk52,wrk53,wrk54,wrk2,IB,IGAU,
  159. & NBPGAU,NCcor,IFORB,iecou,dlttmp)
  160. C
  161. ncourb=nccor
  162. ifourb=iforb
  163. C
  164. C MODELE PLASTIQUE 'DP_SOL'
  165. ELSEIF(INPLAS.EQ.172) then
  166. CALL DP_SOL(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB)
  167. C
  168. C MODELE PLASTIQUE 'IWPR3D_SOL'
  169. ELSEIF(INPLAS.EQ.176) then
  170. CALL IWPR3D(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCAR,
  171. & EPIN0,EPINF,EPST0,EPSTF)
  172.  
  173. C
  174. C MODELE ENDOMMAGEABLE 'EFEM'
  175. ELSEIF(INPLAS.EQ.177) then
  176. IF ((IFOUR.EQ.-2).AND.(ILCOUR.EQ.4)) THEN
  177. CALL PBEFEM(wrk52,wrk53,wrk54,nvari,iecou,mwrkxe)
  178. ELSE
  179. CALL ERREUR(5)
  180. ENDIF
  181. C
  182. ELSE
  183. write(ioimp,*) 'Branchement incorrect dans COML12'
  184. CALL ERREUR(5)
  185. ENDIF
  186.  
  187. RETURN
  188. END
  189.  
  190.  

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