Télécharger ecocri.eso

Retour à la liste

Numérotation des lignes :

  1. C ECOCRI SOURCE AM 13/12/16 21:15:27 7825
  2. SUBROUTINE ECOCRI(SIG0,VARIN0,VAREX0,XMAT,CRICRI,
  3. . CARAC,TRAC,KERRE,MFR,NSTRS,INPLAS,
  4. $ necou,ecou)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. C---------------------------------------------------------------------
  8. C CRITERE POUR UN POINT
  9. C INSPIRE D'ECOINC
  10. C---------------------------------------------------------------------
  11. C
  12. C EN ENTREE :
  13. C
  14. C SIG0 CONTRAINTES AU DEBUT DU PAS
  15. C VARIN0 VARIABLES INTERNES DEDUT DU PAS
  16. C VAREX0 VARIABLES EXTERNES DEBUT DU PAS
  17. C XMAT COEFFICIENTS DU MATERIAU
  18. C CARAC DES CARACTERISTIQUES
  19. C TRAC COURBE DE TRACTION
  20. C MFR INDICE DE FORMULATION
  21. C NSTRS NOMBRE DE CONTRAINTES CA2000
  22. C INPLAS NUMERO DU MODELE DE PLASTICITE
  23. C
  24. C EN SORTIE :
  25. C
  26. C CRICRI LE CRITERE
  27. C KERRE CODE D'ERREUR
  28. C = 0 SI TOUT OK
  29. C = 2 PROBLEME DANS LES CARACT DU TUYAU
  30. C = 38 NU DEVRAIT ETRE NUL
  31. C = 99 SI FORMULATION NON DISPONIBLE
  32. C
  33. C-----------------------------------------------------------------------
  34. -INC CCOPTIO
  35. SEGMENT ECOU
  36. *** COMMON/ECOU/TEST,ALFAH,
  37. REAL*8 TEST,ALFAH,
  38. C REAL*8 TEST, ALFAH,
  39. * 1 HPAS, TEMPS,ecow3(6),ecow4(9),ecow5(6),
  40. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  41. * 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  42. * 2 ecow12(6),
  43. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  44. * 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  45. 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  46. * 2 ecow17(6),ecow18(6),ecow19,ecow20
  47. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  48. ENDSEGMENT
  49.  
  50. SEGMENT NECOU
  51. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  52. INTEGER NCOURB, ncow2,IT,IMAPLA, ISOTRO,
  53. C INTEGER NCOURB,IPLAST,IT, IMAPLA,ISOTRO,
  54. 1 ITYP, IFOURB, IFLUAG,
  55. C . ITYP, IFOURB,IFLUAG,
  56. 2 ICINE,ITHER, IFLUPL,ICYCL, IBI,
  57. C . ICINE,ITHER, IFLUPL,ICYCL, IBI,
  58. 3 JFLUAG,KFLUAG, LFLUAG,
  59. C . JFLUAG,KFLUAG,LFLUAG,
  60. 4 IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEP
  61. C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  62. ENDSEGMENT
  63.  
  64.  
  65. * COMMON/ECOU/TEST,ALFAH,
  66. * 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  67. * 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  68. * 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  69. * 2 SIPLAD(6),DSIGP0(6),TET,TETI
  70. C
  71. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  72. * . ITYP,IFOURB,IFLUAG,
  73. * . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  74. * . JFLUAG,KFLUAG,LFLUAG,
  75. * . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  76. C
  77. DIMENSION SIG0(*),VARIN0(*),XMAT(*),
  78. . VAREX0(*),CARAC(*),TRAC(*)
  79. DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),DIV(7)
  80. DIMENSION ZBID(6),DSIGT(6)
  81. C ZZZZZZZZZZZZZZZZZZZZZZZ
  82. C DIMENSIONS A REVOIR
  83. C ZZZZZZZZZZZZZZZZZZZZZ
  84. DIMENSION SIG(30),EPS(30)
  85. DIMENSION ORMAT(1),ANORM(1)
  86. DIMENSION WORK(130)
  87. CHARACTER*8 CMATE
  88.  
  89. DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  90. DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0,
  91. . -0.8164965808D0/
  92. DATA A1/1.D0/
  93. DATA A2/.5D0/
  94. DATA A3/3.D0/
  95. CMATE='ISOTROPE'
  96. C-----------------------------------------------------------------------
  97. C CONVENTION DE REMPLISSAGE DES MEMOIRES : VOIR ECOINC
  98. C-----------------------------------------------------------------------
  99. C REMPLISSAGE
  100. C-----------------------------------------------------------------------
  101. CRICRI=0.D0
  102. IF(IMAPLA.EQ.0) RETURN
  103. YUNG=XMAT(1)
  104. XNU=XMAT(2)
  105. EPSM1=VARIN0(1)
  106. TIMEXI=VARIN0(1)
  107. DPSM1=VARIN0(1)
  108. DPSM2=VARIN0(1)
  109. EPENT=VARIN0(1)
  110. EPSFLU=VARIN0(1)
  111. TEMPS0=VAREX0(1)
  112. IT=nint(VAREX0(3))
  113. TETI=VAREX0(2)
  114. IF(NCOURB.EQ.0) GO TO 5634
  115. DO 292 I=1,NCOURB
  116. SIG(I)=TRAC(2*I-1)
  117. 292 EPS(I)=TRAC(2*I)
  118. 5634 CONTINUE
  119. ORMAT(1)=XMAT(1)
  120. C----------------------------------------------------------------------
  121. C INITIALISATIONS
  122. C----------------------------------------------------------------------
  123. KERRE=0
  124. JA=1
  125. JC=1
  126. IA=1
  127. C
  128. C PETIT TEST SUR NU POUR CERTAINS CAS
  129. C
  130. IF(MFR.EQ.2.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN
  131. KERRE=38
  132. RETURN
  133. ENDIF
  134. DO 3648 I=1,6
  135. 3648 DSIGT(I)=0.D0
  136. CZZZZZZZZZZZZZ
  137. C PROVISOIRE
  138. CZZZZZZZZZZZZ
  139. ANORM(1)=XMAT(1)
  140. ICENT2=0
  141. IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1
  142. IF(INPLAS.EQ.7) NUMCHA=1
  143. IF(INPLAS.EQ.11) NUMCHA=2
  144. IF(INPLAS.EQ.12) NUMCHA=3
  145. IF(INPLAS.EQ.13) NUMCHA=4
  146. *
  147. * ON MET PRECIS A 1.D-3
  148. *
  149. PRECIS=1.D-3
  150. TEST=0.5D00*PRECIS
  151. MCOD=1
  152. CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL,
  153. . ZBID,ZBID,ZBID,ZBID,ZBID,
  154. . ZBID,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE,ecou,necou)
  155. IF(ITYP.EQ.0) THEN
  156. KERRE=99
  157. RETURN
  158. ENDIF
  159. C-----------------------------------------------------------------------
  160. IPLAST=0
  161. C
  162. C CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH
  163. C
  164. ALFAH=1.D0
  165. IF(ITYP.EQ.2) ALFAH=CARAC(2)**2
  166. IF(ITYP.EQ.7) ALFAH=CARAC(2)**2
  167. UNALF=0.D0
  168. IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH
  169. C
  170. C CAS DES POUTRES
  171. C
  172. IF(ITYP.NE.11) GO TO 841
  173. DIV(1)=1.D0/CARAC(4)
  174. DIV(2)=1.D0
  175. DIV(3)=1.D0
  176. DIV(4)=CARAC(10)/CARAC(1)
  177. DIV(5)=CARAC(11)/CARAC(2)
  178. DIV(6)=CARAC(12)/CARAC(3)
  179. GO TO 761
  180. 841 CONTINUE
  181. C
  182. C CAS DES TUYAUX
  183. C
  184. IF(ITYP.NE.12) GO TO 842
  185. EPAIS=CARAC(1)
  186. REXT=CARAC(2)
  187. RMOY=REXT-EPAIS*0.5D0
  188. RACO=CARAC(3)
  189. GAM=1.D0
  190. IF(RACO.EQ.0.D0) GO TO 765
  191. XLAM=RMOY*RMOY/EPAIS/RACO
  192. GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  193. IF(GAM.LT.1.D0) GAM=1.D0
  194. 765 CONTINUE
  195. C
  196. C NB 23/09/98
  197. C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  198. C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  199. C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  200. C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  201. C DUE A LA PRESSION )
  202. C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  203. C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  204. C
  205. DIV(1)=1.D0
  206. DIV(2)=1.D0
  207. DIV(3)=1.D0
  208. DIV(4)=R33
  209. DIV(5)=PI4*GAM
  210. DIV(6)=DIV(5)
  211. DIV(7)=0.D0
  212. IF(IDIM.EQ.2) THEN
  213. PRES1=CARAC(6)
  214. CISA1=CARAC(7)
  215. IXCAR1=12
  216. IDEB1=8
  217. ELSE IF(IDIM.EQ.3) THEN
  218. PRES1=CARAC(7)
  219. CISA1=CARAC(8)
  220. IXCAR1=13
  221. IDEB1=9
  222. ENDIF
  223. C
  224. JDIV1=2
  225. DO 1515 IBA=IDEB1,IXCAR1
  226. JDIV1=JDIV1+1
  227. VCAR1=CARAC(IBA)
  228. IF (VCAR1.NE.-1.D0) DIV(JDIV1)=CARAC(IBA)
  229. 1515 CONTINUE
  230. C
  231. C NB 23/09/98
  232. C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  233. C 1.D0 DE DIV(3)
  234. C
  235. DIV(1)=DIV(3)
  236. DIV(3)=1.D0
  237. C
  238. VX=CARAC(4)
  239. VY=CARAC(5)
  240. VZ=CARAC(6)
  241. CALL TUYCAR(CARAC,CISA1,VX,VY,VZ,KERRE,1)
  242. IF(KERRE.EQ.0) GO TO 843
  243. KERRE=2
  244. RETURN
  245. 843 CONTINUE
  246. DIV(1)=DIV(1)/CARAC(4)
  247. DIV(4)=DIV(4)*RMOY/CARAC(1)
  248. DIV(5)=DIV(5)*RMOY/CARAC(2)
  249. DIV(6)=DIV(6)*RMOY/CARAC(3)
  250. 761 CONTINUE
  251. IF(ITYP.NE.11) GO TO 842
  252. DO 762 IB=4,6
  253. IF(DIV(IB).NE.0.D0) GO TO 762
  254. DIV(IB)=1.D0
  255. 762 CONTINUE
  256. 842 CONTINUE
  257. C
  258. IF(ICINE.EQ.0.OR.JFLUAG.EQ.1) GO TO 204
  259. C
  260. C ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE )
  261. C
  262. DO 206 IB=1,IBOU
  263. 206 SIGMA(IB)=SIGMA(IB)-SPHER(IB)
  264. 204 CONTINUE
  265. C
  266. IF(ITYP.NE.11.AND.ITYP.NE.12) GO TO 844
  267. DO 845 IB=1,IBOU
  268. SIGMA(IB)=SIGMA(IB)*DIV(IB)
  269. IF(ICINE.EQ.0) GO TO 845
  270. 845 SPHER(IB)=SPHER(IB)*DIV(IB)
  271. 844 CONTINUE
  272. DO 886 IB=1,IBOU
  273. 886 STOT(IB)=SIGMA(IB)
  274. C----------------------------------------------------------------------
  275. C CALCUL DE LA LIMITE ELASTIQUE
  276. C----------------------------------------------------------------------
  277. IF(IMAPLA.NE.4) GO TO 262
  278. BPSTAR=EPSM1
  279. ICOD=1
  280. CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD,
  281. . BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA)
  282. GO TO 261
  283. 262 IF(IMAPLA.NE.5) GO TO 263
  284. SELAS=XMAT(7)
  285. GO TO 261
  286. 263 CONTINUE
  287. EPSTAR=EPSM1
  288. IF(ICINE.EQ.1) EPSTAR=0.
  289. CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,IBI)
  290. IF(IBI.EQ.1) THEN
  291. KERRE=75
  292. RETURN
  293. ENDIF
  294. 261 CONTINUE
  295. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  296. C A VOIR CE QU'IL Y A DANS ANORM
  297. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  298. IF(IMAPLA.EQ.7) COVNMS(1)=ANORM(2*JC-1)
  299. IF(IMAPLA.EQ.7.AND.IT.EQ.1) ANORM(2*JC)=1.E-20
  300. CCCCCCCCCCCCC SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE
  301. C AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE
  302. IXMAT=5
  303. IF(IMAPLA.EQ.5.AND.EPSM1.EQ.0.) IXMAT=10
  304. CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR)
  305. C---------------------------------------------------------------------
  306. C CALCUL DU CRITERE
  307. C---------------------------------------------------------------------
  308. CRICRI=SSTAR-SELAS
  309. 31 CONTINUE
  310. RETURN
  311. END
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  

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