Télécharger la plaquette Cast3M


fr en

Télécharger ecocri.eso

Retour à la liste

Numérotation des lignes : 

ecocri

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

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