Télécharger la plaquette Cast3M


fr en

Télécharger t1c2.eso

Retour à la liste

Numérotation des lignes : 

t1c2

  1. C T1C2      SOURCE    CB215821  26/10/26    21:16:07     12682          
  2.       SUBROUTINE T1C2(SIG,DSIG,YOUN,ANU,RT1,H1,RDP,ADP,
  3.      1 XLAM1,XLAM2,IDAM,ANG)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. -INC PPARAM
  7. -INC CCOPTIO
  8.       DIMENSION SIG(3),DSIG(3),SFC(3),DSFC(3),TSFC(3),SFG(3),DSFG(3),
  9.      1 EPC(3),A(4),B(2),IDAM(3),EPC1(3),EPC2(3),SG(3),DSG(3),SG1(3),
  10.      1 SG2(3),TENS(3)
  11.       Y=YOUN/(1.D0-ANU*ANU)
  12.       IF(RT1.LT.1.E-10) THEN
  13.       H1=0.D0
  14.       RT1=0.D0
  15.       ENDIF
  16. C
  17. C------------------------------------------
  18. C     TRACTION DANS LA DIRECTION 1        |
  19. C     COMPRESSION DANS LA DIRECTION 2     |
  20. C------------------------------------------
  21. C
  22. C-------------------------------------------------
  23. C     ON SE PLACE DANS LE REPERE DE FISSURATION  |
  24. C-------------------------------------------------
  25. C
  26.       CALL CHREP(SIG,SFG,ANG)
  27.       CALL CHREP(DSIG,DSFG,ANG)
  28.       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  29. 9999  FORMAT(1X,'T1C2 COUPLAGE TRACTION 1 COMP 2',/)
  30. C
  31. C------------------------------------------
  32. C     OBTENTION DU SYSTEME EN DL1 DL2
  33. C------------------------------------------
  34. C
  35.     1 B(1)=-RT1+DSFG(1)+SFG(1)
  36.       B(2)=DSFG(2)+SFG(2)
  37.       A(1)=Y-H1
  38.       A(4)=Y
  39.       A(2)=ANU*Y
  40.       A(3)=A(2)
  41.       CALL SYLIN2(A,B,DL1,DL2)
  42. C
  43. C-----------------------------------------
  44. C     CAS DES FAUX COUPLAGES
  45. C-----------------------------------------
  46. C
  47.       IF(DL1.LT.-1.E-10) IDAM(1)=0
  48.       IF(DL2.GT.1.E-10) IDAM(2)=0
  49.       IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) THEN
  50.       CALL CHREP(SFG,SIG,-ANG)
  51.       CALL CHREP(DSFG,DSIG,-ANG)
  52.       RETURN
  53.       ENDIF
  54. C
  55. C-----------------------------------------------
  56. C     CAS OU LA LIMITE EN TRACTION ATTEINT 0   |
  57. C-----------------------------------------------
  58. C
  59.       IF((RT1-H1*DL1).GE.-1.E-10) GOTO 1000
  60.       DL1=RT1/H1
  61.       A(1)=DSFG(1)
  62.       A(3)=DSFG(2)
  63.       A(4)=-Y
  64.       A(2)=-Y*ANU
  65.       DET=A(1)*A(4)-A(2)*A(3)
  66.       IF(DET.EQ.0.D0) THEN
  67.       X=0.D0
  68.       DL2=(SFG(1)-Y*DL1)/Y/ANU
  69.       IF(DL2.GT.0.D0) DL2=0.D0
  70.       GOTO 5
  71.       ENDIF
  72.       B(1)=-SFG(1)+Y*DL1
  73.       B(2)=-SFG(2)+ANU*Y*DL1
  74.       CALL SYLIN2(A,B,X,DL2)
  75.     5 EPC(1)=DL1
  76.       EPC(2)=DL2
  77.       EPC(3)=0.D0
  78.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  79.       DO 10 ITYP=1,3
  80.       DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
  81.       SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
  82.    10 CONTINUE
  83.       IF(DL2.LT.-XLAM2) GOTO 1001
  84.       CALL CDP(SFC,ADP,RDP,VCDP)
  85.       IF(VCDP.GT.0.D0) GOTO 3000
  86.       RT1=0.D0
  87.       H1=0.D0
  88.       XLAM1=XLAM1+DL1
  89.       XLAM2=XLAM2+DL2
  90.       DO 20 ITYP=1,3
  91.       DSFG(ITYP)=DSFC(ITYP)
  92.       SFG(ITYP)=SFC(ITYP)
  93.    20 CONTINUE
  94.       GOTO 1
  95. C
  96. C-----------------------------------------------
  97. C     CAS OU ON FERME TOTALEMENT LA FISSURE 2
  98. C-----------------------------------------------
  99. C
  100.  1000 IF(DL2.GE.-XLAM2) GOTO 2000
  101.  1001 DL2=-XLAM2
  102.       B(1)=RT1-SFG(1)+DL2*ANU*Y
  103.       B(2)=-SFG(2)+DL2*Y
  104.       A(2)=-Y+H1
  105.       A(1)=DSFG(1)
  106.       A(4)=-Y*ANU
  107.       A(3)=DSFG(2)
  108.       DET=A(1)*A(4)-A(2)*A(3)
  109.       IF(DET.EQ.0.D0) THEN
  110.       X=0.D0
  111.       DL1=(SFG(1)-RT1-DL2*ANU*Y)/(Y-H1)
  112.       IF(DL1.LT.0.D0) DL1=0.D0
  113.       GOTO 1005
  114.       ENDIF
  115.       CALL SYLIN2(A,B,X,DL1)
  116.  1005 CONTINUE
  117.       EPC(1)=DL1
  118.       EPC(2)=DL2
  119.       EPC(3)=0.D0
  120.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  121.       DO 1010 ITYP=1,3
  122.       SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
  123.       DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
  124.       TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)
  125.  1010 CONTINUE
  126.       VCDP=-1.D0
  127.       IF(X.GT.1.E-10) CALL CDP(SFC,ADP,RDP,VCDP)
  128.       IF(VCDP.GT.0.D0) GOTO 3000
  129.       RT1=RT1-H1*DL1
  130.       IF(RT1.LE.1.E-10) THEN
  131.       H1=0.D0
  132.       RT1=0.D0
  133.       ENDIF
  134.       XLAM2=0.D0
  135.       XLAM1=XLAM1+DL1
  136.       IDAM(2)=0
  137.       GAMCO=10.D0
  138.       GAMTR=10.D0
  139.       GAMDP=10.D0
  140.       IDAM(1)=0
  141.       IDAM(3)=0
  142.       CALL CDP(TSFC,ADP,RDP,VCDP)
  143.       IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP)
  144.       CALL CTRAF(TSFC(1),RT1,VCTR1)
  145.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFC(1),RT1,GAMTR)
  146.       CALL CCOAF(TSFC(1),XLAM1,VCCO1)
  147.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFC(1),GAMCO)
  148.       GAM=MIN(GAMDP,GAMTR,GAMCO)
  149.       IF(GAM.GE.1.D0) THEN
  150.       GAM=1.D0
  151.       GOTO 1020
  152.       ENDIF
  153.       IF(ABS(GAM-GAMCO).LE.1.E-10) IDAM(1)=-1
  154.       IF(ABS(GAM-GAMTR).LE.1.E-10) IDAM(1)=1
  155.       IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1
  156.  1020 DO 1030 ITYP=1,3
  157.       SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP)
  158.       DSFG(ITYP)=DSFC(ITYP)*(1.D0-GAM)
  159.  1030 CONTINUE
  160.       CALL CHREP(SFG,SIG,-ANG)
  161.       CALL CHREP(DSFG,DSIG,-ANG)
  162.       RETURN
  163. 2000  CONTINUE
  164.       EPC(1)=DL1
  165.       EPC(2)=DL2
  166.       EPC(3)=0.D0
  167.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  168.       DO 2010 ITYP=1,3
  169.       SFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  170.  2010 CONTINUE
  171.       CALL CDP(SFC,ADP,RDP,VCDP)
  172.       IF(VCDP.GT.0.D0) GOTO 3000
  173. C
  174. C------------------------------------------------
  175. C     ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  176. C     PENDANT L 'ECOULEMENT (SINON 3000)
  177. C------------------------------------------------
  178. C
  179.       RT1=RT1-H1*DL1
  180.       IF(RT1.LE.1.E-10) THEN
  181.       H1=0.D0
  182.       RT1=0.D0
  183.       ENDIF
  184.       XLAM1=XLAM1+DL1
  185.       XLAM2=XLAM2+DL2
  186.       IDAM(1)=0
  187.       IDAM(2)=0
  188.       IDAM(3)=0
  189.       CALL CHREP(SFC,SIG,-ANG)
  190.       DO 2020 ITYP=1,3
  191.       DSIG(ITYP)=0.D0
  192.  2020 CONTINUE
  193.       RETURN
  194. 3000  CONTINUE
  195.       EPC1(1)=1.D0
  196.       EPC1(2)=0.D0
  197.       EPC1(3)=0.D0
  198.       EPC2(2)=1.D0
  199.       EPC2(1)=0.D0
  200.       EPC2(3)=0.D0
  201.       CALL CPHOOB(EPC1,SG1,YOUN,ANU)
  202.       CALL CPHOOB(EPC2,SG2,YOUN,ANU)
  203.       B(1)=SFG(1)-RT1
  204.       B(2)=SFG(2)
  205.       A(4)=Y
  206.       A(1)=Y-H1
  207.       A(2)=ANU*Y
  208.       A(3)=A(2)
  209.       CALL SYLIN2(A,B,DL11,DL21)
  210.       B(1)=DSFG(1)
  211.       B(2)=DSFG(2)
  212.       CALL SYLIN2(A,B,DL12,DL22)
  213.       DO 3010 ITYP=1,3
  214.       SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  215.       DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP)
  216.  3010 CONTINUE
  217.       CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
  218.       IF(ITEST.EQ.1) THEN
  219.       IDAM(1)=1
  220.       IDAM(2)=-1
  221.       IDAM(3)=1
  222.       CALL CHREP(SFG,SIG,-ANG)
  223.       CALL CHREP(DSFG,DSIG,-ANG)
  224.       RETURN
  225.       ENDIF
  226.       DL1=DL11+X*DL12
  227.       DL2=DL21+X*DL22
  228.       RT1=RT1-H1*DL1
  229.       IF(RT1.LE.1.E-10) THEN
  230.       H1=0.D0
  231.       RT1=0.D0
  232.       ENDIF
  233.       XLAM1=XLAM1+DL1
  234.       XLAM2=XLAM2+DL2
  235.       IDAM(1)=1
  236.       IDAM(2)=-1
  237.       IDAM(3)=1
  238.       IF(XLAM2.LT.1.E-8) THEN
  239.       XLAM2=0.D0
  240.       IDAM(2)=0
  241.       ENDIF
  242.       EPC(1)=DL1
  243.       EPC(2)=DL2
  244.       EPC(3)=0.D0
  245.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  246.       DO 3020 ITYP=1,3
  247.       SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  248.       DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  249.  3020 CONTINUE
  250.       CALL CHREP(DSFG,DSIG,-ANG)
  251.       CALL CHREP(SFG,SIG,-ANG)
  252.       RETURN
  253.       END
  254.  
  255.  
  256.  

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