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    OF166741  25/11/04    21:15:44     12349          
  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. -INC TECOU
  37.  
  38.       DIMENSION SIG0(*),VARIN0(*),XMAT(*),
  39.      .          VAREX0(*),CARAC(*),TRAC(*)
  40.       DIMENSION SIGMA(6),DSIGMA(6),SPHER(6),AUXIL(6),DIV(7)
  41.       DIMENSION ZBID(6),DSIGT(6)
  42. C ZZZZZZZZZZZZZZZZZZZZZZZ
  43. C    DIMENSIONS A REVOIR
  44. C ZZZZZZZZZZZZZZZZZZZZZ
  45.       DIMENSION SIG(30),EPS(30)
  46.       DIMENSION ORMAT(1),ANORM(2)
  47.       CHARACTER*8 CMATE
  48.  
  49.       DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/
  50.       DATA A,B,C,D/.577350269D0,.7071067814D0,.4082482904D0,
  51.      . -0.8164965808D0/
  52.       DATA A1/1.D0/
  53.       DATA A2/.5D0/
  54.       DATA A3/3.D0/
  55.  
  56.       KERRE = 0
  57.       IF (IMAPLA.EQ.0) RETURN
  58. C-----------------------------------------------------------------------
  59. C     CONVENTION DE REMPLISSAGE DES MEMOIRES   :  VOIR ECOINC
  60. C-----------------------------------------------------------------------
  61. C                     REMPLISSAGE
  62. C-----------------------------------------------------------------------
  63.       CMATE='ISOTROPE'
  64.       CRICRI=0.D0
  65.       YUNG=XMAT(1)
  66.       XNU=XMAT(2)
  67.       EPSM1=VARIN0(1)
  68.       TIMEXI=VARIN0(1)
  69.       DPSM1=VARIN0(1)
  70.       DPSM2=VARIN0(1)
  71.       EPENT=VARIN0(1)
  72.       EPSFLU=VARIN0(1)
  73.       TEMPS0=VAREX0(1)
  74.       IT=nint(VAREX0(3))
  75.       TETI=VAREX0(2)
  76.       DO I=1,NCOURB
  77.         SIG(I)=TRAC(2*I-1)
  78.         EPS(I)=TRAC(2*I)
  79.       ENDDO
  80.       ORMAT(1)=XMAT(1)
  81.  
  82. C  PETIT TEST SUR NU POUR CERTAINS CAS
  83.       IF (MFR.EQ.2.AND.IFOURB.EQ.-2.AND.XNU.NE.0.D0) THEN
  84.         KERRE=38
  85.         RETURN
  86.       ENDIF
  87. C----------------------------------------------------------------------
  88. C                       INITIALISATIONS
  89. C----------------------------------------------------------------------
  90.       JA=1
  91.       JC=1
  92.       IA=1
  93.       DO I=1,6
  94.         DSIGT(I)=0.D0
  95.       ENDDO
  96. CZZZZZZZZZZZZZ
  97. C  PROVISOIRE
  98. CZZZZZZZZZZZZ
  99.       ANORM(1)=XMAT(1)
  100.  
  101.       ICENT2=0
  102.       IF(INPLAS.EQ.12.OR.INPLAS.EQ.13) ICENT2=1
  103.       IF(INPLAS.EQ.7) NUMCHA=1
  104.       IF(INPLAS.EQ.11) NUMCHA=2
  105.       IF(INPLAS.EQ.12) NUMCHA=3
  106.       IF(INPLAS.EQ.13) NUMCHA=4
  107. *
  108. *  ON MET PRECIS A 1.D-3
  109. *
  110.       PRECIS=1.D-3
  111.       ECTEST=0.5D00*PRECIS
  112.       MCOD=1
  113.       CALL VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL,
  114.      .         ZBID,ZBID,ZBID,ZBID,ZBID,
  115.      .         ZBID,ICENT2,MCOD,IBOU,MFR,NSTRS,CARAC,CMATE,ecou,necou)
  116.       IF (necou.ITYP.EQ.0) THEN
  117.         KERRE=99
  118.         RETURN
  119.       ENDIF
  120. C-----------------------------------------------------------------------
  121. C
  122. C  CAS DES COQUES EN GLOBAL - ON RECUPERE LE ALFAH
  123. C
  124.       ALFAH=1.D0
  125.       IF (ITYP.EQ.2) ALFAH=CARAC(2)**2
  126.       IF (ITYP.EQ.7) ALFAH=CARAC(2)**2
  127.       UNALF=0.D0
  128.       IF(ALFAH.GE.1.D-12) UNALF=1.D0/ALFAH
  129. C
  130. C  CAS DES POUTRES
  131. C
  132.       IF(ITYP.EQ.11) THEN
  133.         DIV(1)=1.D0/CARAC(4)
  134.         DIV(2)=1.D0
  135.         DIV(3)=1.D0
  136.         DIV(4)=CARAC(10)/CARAC(1)
  137.         DIV(5)=CARAC(11)/CARAC(2)
  138.         DIV(6)=CARAC(12)/CARAC(3)
  139.         GO TO 761
  140.       ENDIF
  141. C
  142. C  CAS DES TUYAUX
  143. C
  144.       IF (ITYP.NE.12) GO TO 842
  145.       EPAIS=CARAC(1)
  146.       REXT=CARAC(2)
  147.       RMOY=REXT-EPAIS*0.5D0
  148.       RACO=CARAC(3)
  149.       GAM=1.D0
  150.       IF (RACO.NE.0.D0) THEN
  151.         XLAM = RMOY*RMOY/(EPAIS*RACO)
  152.         GAM = 0.8888888888888889D0*(XLAM)**0.6666666666666667D0
  153.         GAM = MAX(GAM,1.D0)
  154.       ENDIF
  155. C
  156. C     NB 23/09/98
  157. C     VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY
  158. C     CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES
  159. C     CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS
  160. C     DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE
  161. C     DUE A LA PRESSION )
  162. C     POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE
  163. C     DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7)
  164. C
  165.       DIV(1)=1.D0
  166.       DIV(2)=1.D0
  167.       DIV(3)=1.D0
  168.       DIV(4)=R33
  169.       DIV(5)=PI4*GAM
  170.       DIV(6)=DIV(5)
  171.       DIV(7)=0.D0
  172.       IF(IDIM.EQ.2) THEN
  173.         PRES1=CARAC(6)
  174.         CISA1=CARAC(7)
  175.         IXCAR1=12
  176.         IDEB1=8
  177.       ELSE IF(IDIM.EQ.3) THEN
  178.         PRES1=CARAC(7)
  179.         CISA1=CARAC(8)
  180.         IXCAR1=13
  181.         IDEB1=9
  182.       ENDIF
  183. C
  184.       JDIV1=2
  185.       DO 1515 IBA=IDEB1,IXCAR1
  186.         JDIV1=JDIV1+1
  187.         VCAR1=CARAC(IBA)
  188.         IF (VCAR1.NE.-1.D0) DIV(JDIV1)=CARAC(IBA)
  189.  1515 CONTINUE
  190. C
  191. C     NB 23/09/98
  192. C     TRANSFERT DE CFFX DANS DIV(1) ET REMISE A
  193. C     1.D0 DE DIV(3)
  194. C
  195.       DIV(1)=DIV(3)
  196.       DIV(3)=1.D0
  197. C
  198.       VX=CARAC(4)
  199.       VY=CARAC(5)
  200.       VZ=CARAC(6)
  201.       CALL TUYCAR(CARAC,CISA1,VX,VY,VZ,KERRE,1)
  202.       IF (KERRE.NE.0) THEN
  203.         KERRE=2
  204.         RETURN
  205.       ENDIF
  206.       DIV(1)=DIV(1)/CARAC(4)
  207.       DIV(4)=DIV(4)*RMOY/CARAC(1)
  208.       DIV(5)=DIV(5)*RMOY/CARAC(2)
  209.       DIV(6)=DIV(6)*RMOY/CARAC(3)
  210. 761   CONTINUE
  211.       IF (ITYP.EQ.11) THEN
  212.         DO 762 IB=4,6
  213.           IF (DIV(IB).EQ.0.D0) DIV(IB)=1.D0
  214. 762     CONTINUE
  215.       ENDIF
  216.  
  217.   842 CONTINUE
  218.  
  219. C       ON EST EN CINEMATIQUE ( PLASTIQUE OU FLUAGE )
  220.       IF (ICINE.NE.0.AND.JFLUAG.NE.1) THEN
  221.         DO IB=1,IBOU
  222.           SIGMA(IB)=SIGMA(IB)-SPHER(IB)
  223.         ENDDO
  224.       ENDIF
  225. C
  226.       IF (ITYP.EQ.11.OR.ITYP.EQ.12) THEN
  227.         DO 845 IB=1,IBOU
  228.           SIGMA(IB)=SIGMA(IB)*DIV(IB)
  229.           IF (ICINE.NE.0) SPHER(IB)=SPHER(IB)*DIV(IB)
  230. 845     CONTINUE
  231.       ENDIF
  232.  
  233.       DO IB=1,IBOU
  234.         STOT(IB)=SIGMA(IB)
  235.       ENDDO
  236. C----------------------------------------------------------------------
  237. C               CALCUL DE LA LIMITE ELASTIQUE
  238. C----------------------------------------------------------------------
  239.       IF (IMAPLA.EQ.4) THEN
  240.         BPSTAR=EPSM1
  241.         ICOD=1
  242.         CALL CHALIM(BPSTAR,SELAS,XMAT,TET,ICOD,
  243.      &  BID,BID,BID,BID,BID1,BID2,BI3,BI4,BI5,BI6,IBID,IBID,NUMCHA)
  244.       ELSE IF (IMAPLA.EQ.5) THEN
  245.         SELAS=XMAT(7)
  246.       ELSE
  247.         EPSTAR=EPSM1
  248.         IF(ICINE.EQ.1) EPSTAR=0.
  249.         CALL TRACTI(SELAS,EPSTAR,SIG,EPS,NCOURB,2,izz)
  250.         IF (izz.EQ.1) THEN
  251.           KERRE=75
  252.           RETURN
  253.         ENDIF
  254.       ENDIF
  255. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  256. C   A VOIR    CE QU'IL Y A DANS ANORM
  257. CZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
  258.       IF (IMAPLA.EQ.7) THEN
  259.         COVNMS(1)=ANORM(2*JC-1)
  260.         IF (IT.EQ.1) ANORM(2*JC)=1.E-20
  261.       ENDIF
  262. CCCCCCCCCCCCC   SI MATERIAU DRUCKER PRAGER ON CHERCHE LE CRITERE
  263. C               AVEC LEQUEL ON DOIT FAIRE LA PROJECTION ET LE CRITERE
  264.       IXMAT=5
  265.       IF (IMAPLA.EQ.5.AND.EPSM1.EQ.0.) IXMAT=10
  266.       CALL CKRIT(IMAPLA,STOT,ITYP,XMAT(IXMAT),ALFAH,COVNMS,XINV,SSTAR)
  267. C---------------------------------------------------------------------
  268. C          CALCUL DU CRITERE
  269. C---------------------------------------------------------------------
  270.       CRICRI=SSTAR-SELAS
  271.  
  272.       RETURN
  273.       END
  274.  
  275.  
  276.  

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