Télécharger la plaquette Cast3M


fr en

Télécharger betokt.eso

Retour à la liste

Numérotation des lignes : 

betokt

  1. C BETOKT    SOURCE    PV        11/03/07    21:15:10     6885
  2.       SUBROUTINE BETOKT(XMAT,TRAC,VARF,SIGF,NCURVT,NCURVC,XKTAT,KERRE)
  3. C
  4. C   Matrice tangente pour le modele endommageable en cyclique
  5. C   D. Combescure 18/09/95 ELSA-Ispra
  6. C
  7. C ENTREES:
  8. C -------
  9. C     XMAT    = Caracteristiques materiaux
  10. C
  11. C     VARF    = Variables internes
  12. C
  13. C     SIGF    = Contraintes
  14. C
  15. C SORTIES:
  16. C -------
  17. C     XKTAT    = Matrice tangente
  18. C
  19. C================================================================
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25.          DIMENSION XMAT(*)
  26.          DIMENSION TRAC(*)
  27. C
  28.       DIMENSION VARF(14),SIGF(4),EPSI(2),FG(2)
  29.       DIMENSION XNOR1(4),XNOR2(4),XCOU1(3,3),XCOU2(3,3)
  30.       DIMENSION GAMBDA(2),EEE(2,2),SIGP(2),EEE2(2,2)
  31.       DIMENSION UUU(3,2),VVV(2,3),UUU2(3,2),VVV2(2,3),UUU3(3,2)
  32.       DIMENSION HHH1(3,3),HHH2(3,3),HHH3(3,3)
  33.       DIMENSION XKTAT(4,4),RESIST(6),XKISO(2)
  34.       PARAMETER (UN=1.D0,UNDEMI=0.5D0,EPSILO=1.D-20,XZER=0.D0)
  35.       PARAMETER (PRECIS=1.D-4)
  36.       KERRE=0
  37. C================================================================
  38. C   LECTURE DES CARACTERISTIQUES MAT. ET DES VAR. INT.
  39. C===============================================================
  40. C Pour la lecture des courbes
  41.       IPT    = 1
  42.       IPC    = IPT+2*NCURVT
  43. C
  44.       YOUN = XMAT(1)
  45.       XNU  = XMAT(2)
  46.       XGGG = (UNDEMI*YOUN/(UN+XNU))
  47.       XHH1 = XMAT(3)
  48.       DEGRAD    = XMAT(8)/XMAT(9)
  49.       RESIST(1) = XMAT(4)
  50.       RESIST(2) = XMAT(4)
  51.       RESIST(3) = XMAT(5)
  52.       RESIST(4) = XMAT(5)
  53.       RESIST(5) = XMAT(6)
  54.       RESIST(6) = XMAT(7)
  55.       XLCAT     = XMAT(10)
  56.       XLCAC     = XMAT(11)
  57.       CPHI    = VARF(5) + UN
  58.       SPHI    = VARF(6)
  59.       EPSI(1) = VARF(3)
  60.       EPSI(2) = VARF(4)
  61.       ICAS1 = nint(VARF(11))
  62.       ICAS2 = nint(VARF(12))
  63. C==============================================================
  64. C    RAIDEUR ELASTIQUE
  65. C===============================================================
  66.       CALL ZERO(XKTAT,4,4)
  67.       XKTAT(1,1) = YOUN/(UN - (XNU**2))
  68.       XKTAT(1,2) = XNU*XKTAT(1,1)
  69.       XKTAT(2,1) = XKTAT(1,2)
  70.       XKTAT(2,2) = XKTAT(1,1)
  71.       XKTAT(4,4) = YOUN/(2.D0*(UN+XNU))
  72. C==============================================================
  73.       IF (ICAS1.EQ.0) THEN
  74.          GOTO 9999
  75.       ENDIF
  76. C
  77.       CALL VALEUR(EPSI(1),TRAC(IPT),NCURVT,XLCAT,
  78.      &XKISO(1),XPEN1,KERRE)
  79.       CALL VALEUR(EPSI(2),TRAC(IPC),NCURVC,XLCAC,
  80.      &XKISO(2),XPEN2,KERRE)
  81.       GAMBDA(1) = VARF(13)
  82.       GAMBDA(2) = VARF(14)
  83.       IF (ICAS1.LE.4) THEN
  84.          FG(1) = RESIST(ICAS1)
  85.       ELSE
  86.          FG(1) = XKISO(ICAS1-4)*RESIST(ICAS1)
  87.       ENDIF
  88.       IF (ICAS2.LE.4) THEN
  89.          FG(2) = RESIST(ICAS2)
  90.       ELSE
  91.          FG(2) = XKISO(ICAS2-4)*RESIST(ICAS2)
  92.       ENDIF
  93. C==============================================================
  94. C   CALCUL DE L'INVERSE
  95. C==============================================================
  96.         CALL ZERO(HHH1,3,3)
  97.         HHH1(1,1) = UN/YOUN
  98.         HHH1(1,2) = -XNU*HHH1(1,1)
  99.         HHH1(2,1) = HHH1(1,2)
  100.         HHH1(2,2) = HHH1(1,1)
  101.         HHH1(3,3) = (2.D0*(UN+XNU)/YOUN)
  102. C
  103.         CALL CONPRI (SIGF,CPHI,SPHI,SIGP,CPHI,SPHI)
  104. C
  105.         IF (ICAS1.EQ.1) THEN
  106.            ISGNTC = 1
  107.         ELSE IF (ICAS1.EQ.2) THEN
  108.            ISGNTC = 1
  109.         ELSE IF (ICAS1.EQ.3) THEN
  110.            ISGNTC = -1
  111.         ELSE IF (ICAS1.EQ.4) THEN
  112.            ISGNTC = -1
  113.         ELSE IF (ICAS1.EQ.5) THEN
  114.            ISGNTC = 1
  115.         ELSE IF (ICAS1.EQ.6) THEN
  116.            ISGNTC = -1
  117.         ENDIF
  118.         IF (ICAS1.LE.4) THEN
  119.           IF (SIGP(2).GE.SIGP(1)) THEN
  120.             IF ((ICAS1.EQ.1).OR.(ICAS1.EQ.3)) THEN
  121.               ISGN2 = -1
  122.             ELSE
  123.               ISGN2 = 1
  124.             ENDIF
  125.           ELSE
  126.             IF ((ICAS1.EQ.1).OR.(ICAS1.EQ.3)) THEN
  127.               ISGN2 = 1
  128.             ELSE
  129.               ISGN2 = -1
  130.             ENDIF
  131.           ENDIF
  132.         ELSE
  133.           ISGN2 = 1
  134.         ENDIF
  135.         IF (ICAS1.LE.4) THEN
  136.           CALL COURBU(SIGF,FG(1),ISGNTC,ISGN2,1,XCOU1)
  137.           CALL NORMBL(SIGF,FG(1),ISGNTC,ISGN2,1,XNOR1)
  138.         ELSE
  139.           PHI = SQRT ((UNDEMI*(SIGF(1)-SIGF(2)))**2+SIGF(4)**2)
  140.           IF ((PHI.LT.ABS(PRECIS*FG(1))).AND.(ICAS1.EQ.ICAS2)) THEN
  141. C            Cas de l'apex ou on calcule directement H-1
  142.             HHH1(1,1) = XGGG*((4.D0*PHI)+(YOUN*GAMBDA(1)))/
  143.      & (2.D0*(UN-XNU)*((2.D0*PHI)+(XGGG*GAMBDA(1))))
  144.             HHH1(2,2)=HHH1(1,1)
  145.             HHH1(1,2) = XGGG*((4.D0*XNU*PHI)+(YOUN*GAMBDA(1)))/
  146.      & (2.D0*(UN-XNU)*((2.D0*PHI)+(XGGG*GAMBDA(1))))
  147.             HHH1(2,1)=HHH1(1,2)
  148.             HHH1(3,3) = XGGG*PHI/(PHI+XGGG*GAMBDA(1))
  149.             CALL NORMBL(SIGF,FG(1),ISGNTC,1,2,XNOR1)
  150.             GOTO 1010
  151.           ELSE
  152.             CALL COURBU(SIGF,FG(1),ISGNTC,1,2,XCOU1)
  153.             CALL NORMBL(SIGF,FG(1),ISGNTC,1,2,XNOR1)
  154.           ENDIF
  155.         ENDIF
  156. C
  157. C
  158.         IF (ICAS1.EQ.ICAS2) THEN
  159.            GOTO 1000
  160.         ELSE
  161.           IF (ICAS2.LE.4) THEN
  162.              FG(2) = RESIST(ICAS2)
  163.           ELSE
  164.              FG(2) = XKISO(ICAS2-4)*RESIST(ICAS2)
  165.           ENDIF
  166.           IF (ICAS2.EQ.1) THEN
  167.              ISGNTCB = 1
  168.           ELSE IF (ICAS2.EQ.2) THEN
  169.              ISGNTCB = 1
  170.           ELSE IF (ICAS2.EQ.3) THEN
  171.              ISGNTCB = -1
  172.           ELSE IF (ICAS2.EQ.4) THEN
  173.              ISGNTCB = -1
  174.           ELSE IF (ICAS2.EQ.5) THEN
  175.              ISGNTCB = 1
  176.           ELSE IF (ICAS2.EQ.6) THEN
  177.              ISGNTCB = -1
  178.           ENDIF
  179.           IF (ICAS2.LE.4) THEN
  180.             IF (SIGP(2).GE.SIGP(1)) THEN
  181.               IF ((ICAS2.EQ.1).OR.(ICAS2.EQ.3)) THEN
  182.                 ISGN2B = -1
  183.               ELSE
  184.                 ISGN2B = 1
  185.               ENDIF
  186.             ELSE
  187.               IF ((ICAS2.EQ.1).OR.(ICAS2.EQ.3)) THEN
  188.                 ISGN2B = 1
  189.               ELSE
  190.                 ISGN2B = -1
  191.               ENDIF
  192.             ENDIF
  193.           ELSE
  194.             ISGN2B = 1
  195.           ENDIF
  196. C
  197.           IF (ICAS2.LE.4) THEN
  198.             CALL COURBU(SIGF,FG(2),ISGNTCB,ISGN2B,1,XCOU2)
  199.             CALL NORMBL(SIGF,FG(2),ISGNTCB,ISGN2B,1,XNOR2)
  200.           ELSE
  201.             CALL COURBU(SIGF,FG(2),ISGNTCB,1,2,XCOU2)
  202.             CALL NORMBL(SIGF,FG(2),ISGNTCB,1,2,XNOR2)
  203.           ENDIF
  204. C
  205.            GOTO 2000
  206.         ENDIF
  207. C
  208. C
  209. C
  210.  1000 CONTINUE
  211. C
  212. C  Cas 1 mecanisme
  213. C
  214. C  Calcul de l'inverse de H et de H
  215.       CALL PLMATR(HHH1,UN,XCOU1,GAMBDA(1),3,3,HHH1)
  216.       CALL INVALM(HHH1,3,3,IRD,1.D-8)
  217.       IF (IRD.NE.0) THEN
  218.         WRITE (IOIMP,*)'BETOKT: Determinant nul'
  219.         GOTO 9999
  220.       ENDIF
  221. C  Point d'entree dans le cas de l'apex
  222.  1010 CONTINUE
  223. C  Calcul de U,V et E-1
  224.       CALL ZERO(UUU,3,2)
  225.       CALL ZERO(VVV,2,3)
  226.       CALL ZERO(UUU2,3,2)
  227.       CALL ZERO(VVV2,2,3)
  228.       UUU(1,1) = XNOR1(1)
  229.       UUU(2,1) = XNOR1(2)
  230.       UUU(3,1) = XNOR1(4)
  231.       VVV(1,1) = XNOR1(1)
  232.       VVV(1,2) = XNOR1(2)
  233.       VVV(1,3) = XNOR1(4)
  234. C
  235.       IF (ICAS1.LE.4) THEN
  236.         EEE(1,1) = XHH1
  237.       ELSE IF (ICAS1.EQ.5) THEN
  238.         EEE(1,1) = ISGNTC*XPEN1*RESIST(ICAS1)
  239.       ELSE IF (ICAS1.EQ.6) THEN
  240.         EEE(1,1) = ISGNTC*XPEN2*RESIST(ICAS1)
  241.       ENDIF
  242. C
  243.       CALL MATMAT(HHH1,UUU,3,3,2,UUU2)
  244.       CALL MATMAT(VVV,HHH1,2,3,3,VVV2)
  245. C
  246.       CALL MATMAT(VVV,UUU2,2,3,2,HHH2)
  247. C
  248.       EEE(1,1) = EEE(1,1) + HHH2(1,1)
  249.       IF (ABS(EEE(1,1)).GT.EPSILO) THEN
  250.         EEE(1,1) = -UN/EEE(1,1)
  251.       ELSE
  252.         WRITE (IOIMP,*)'BETOKT: Determinant nul'
  253.         GOTO 9999
  254.       ENDIF
  255.       CALL MATMAT(UUU2,VVV2,3,2,3,HHH3)
  256.       CALL PLMATR(HHH1,UN,HHH3,EEE(1,1),3,3,HHH1)
  257. C
  258.       GOTO 3000
  259. C
  260.  2000 CONTINUE
  261. C
  262. C  Cas 2 mecanismes
  263. C
  264. C Calcul de H-1 et H
  265.       CALL PLMATR(HHH1,UN,XCOU1,GAMBDA(1),3,3,HHH1)
  266.       CALL PLMATR(HHH1,UN,XCOU2,GAMBDA(2),3,3,HHH1)
  267.       CALL INVALM(HHH1,3,3,IRD,1.D-8)
  268.       IF (IRD.NE.0) THEN
  269.         WRITE (IOIMP,*)'BETOKT: Determinant nul'
  270.         GOTO 9999
  271.       ENDIF
  272. C Calcul de U ,V et E
  273.       UUU(1,1) = XNOR1(1)
  274.       UUU(2,1) = XNOR1(2)
  275.       UUU(3,1) = XNOR1(4)
  276.       UUU(1,2) = XNOR2(1)
  277.       UUU(2,2) = XNOR2(2)
  278.       UUU(3,2) = XNOR2(4)
  279.       VVV(1,1) = XNOR1(1)
  280.       VVV(1,2) = XNOR1(2)
  281.       VVV(1,3) = XNOR1(4)
  282.       VVV(2,1) = XNOR2(1)
  283.       VVV(2,2) = XNOR2(2)
  284.       VVV(2,3) = XNOR2(4)
  285. C
  286.       IF (ICAS1.LE.4) THEN
  287.         EEE(1,1) = XHH1
  288.         IF (ICAS2.EQ.6) THEN
  289.           EEE(2,1) = DEGRAD*ISGNTCB*RESIST(6)
  290.      &*ISGNTC*RESIST(ICAS1)*XPEN2
  291.         ELSE
  292.           EEE(2,1) = XZER
  293.         ENDIF
  294.       ELSE IF (ICAS1.EQ.5) THEN
  295.         EEE(1,1) = ISGNTC*XPEN1*RESIST(ICAS1)
  296.         EEE(2,1) = XZER
  297.       ELSE IF (ICAS1.EQ.6) THEN
  298.         EEE(1,1) = ISGNTC*XPEN2*RESIST(ICAS1)
  299.         EEE(2,1) = XZER
  300.       ENDIF
  301.       IF (ICAS2.LE.4) THEN
  302.         EEE(2,2) = XHH1
  303.         IF (ICAS1.EQ.6) THEN
  304.           EEE(1,2) = DEGRAD*ISGNTC*RESIST(6)
  305.      &*ISGNTCB*RESIST(ICAS2)*XPEN2
  306.         ELSE
  307.           EEE(1,2) = XZER
  308.         ENDIF
  309.       ELSE IF (ICAS2.EQ.5) THEN
  310.         EEE(2,2) = ISGNTCB*XPEN1*RESIST(ICAS2)
  311.         EEE(1,2) = XZER
  312.       ELSE IF (ICAS2.EQ.6) THEN
  313.         EEE(2,2) = ISGNTCB*XPEN2*RESIST(ICAS2)
  314.         EEE(1,2) = XZER
  315.       ENDIF
  316. C
  317.       CALL MATMAT(HHH1,UUU,3,3,2,UUU2)
  318.       CALL MATMAT(VVV,HHH1,2,3,3,VVV2)
  319. C
  320.       CALL MATMAT(VVV,UUU2,2,3,2,HHH2)
  321. C
  322.       CALL PLMATR(EEE,UN,HHH2,UN,2,2,EEE)
  323.       XDET = EEE(1,1)*EEE(2,2) - EEE(1,2)*EEE(2,1)
  324.       IF (ABS(XDET).GT.EPSILO) THEN
  325.         XDET = UN/XDET
  326.         EEE2(1,1) = XDET*EEE(2,2)
  327.         EEE2(2,2) = XDET*EEE(1,1)
  328.         EEE2(2,1) = -XDET*EEE(1,2)
  329.         EEE2(1,2) = -XDET*EEE(2,1)
  330.       ELSE
  331.         WRITE (IOIMP,*)'BETOKT: Determinant nul'
  332.         GOTO 9999
  333.       ENDIF
  334.       CALL MATMAT(UUU2,EEE2,3,2,2,UUU3)
  335.       CALL MATMAT(UUU3,VVV2,3,2,3,HHH3)
  336.       CALL PLMATR(HHH1,UN,HHH3,-UN,3,3,HHH1)
  337. C
  338.       GOTO 3000
  339. C
  340. C==============================================================
  341.  3000   CONTINUE
  342.         CALL ZERO(XKTAT,4,4)
  343.         XKTAT(1,1) = HHH1(1,1)
  344.         XKTAT(1,2) = HHH1(1,2)
  345.         XKTAT(2,1) = HHH1(2,1)
  346.         XKTAT(2,2) = HHH1(2,2)
  347.         XKTAT(4,4) = HHH1(3,3)
  348.         XKTAT(4,1) = HHH1(3,1)
  349.         XKTAT(4,2) = HHH1(3,2)
  350.         XKTAT(1,4) = HHH1(1,3)
  351.         XKTAT(2,4) = HHH1(2,3)
  352.  9999 CONTINUE
  353. C===============================================================
  354. C                 Fin de la routine
  355. C===============================================================
  356.       RETURN
  357.       END
  358.  
  359.  
  360.  
  361.  

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