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    CHAT      05/01/13    03:29:24     5004
  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.    10 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
  82.       IF(DL2.LT.-XLAM2) GOTO 1001
  83.       CALL CDP(SFC,ADP,RDP,VCDP)
  84.       IF(VCDP.GT.0.D0) GOTO 3000
  85.       RT1=0.D0
  86.       H1=0.D0
  87.       XLAM1=XLAM1+DL1
  88.       XLAM2=XLAM2+DL2
  89.       DO 20 ITYP=1,3
  90.       DSFG(ITYP)=DSFC(ITYP)
  91.    20 SFG(ITYP)=SFC(ITYP)
  92.       GOTO 1
  93. C
  94. C-----------------------------------------------
  95. C     CAS OU ON FERME TOTALEMENT LA FISSURE 2
  96. C-----------------------------------------------
  97. C
  98.  1000 IF(DL2.GE.-XLAM2) GOTO 2000
  99.  1001 DL2=-XLAM2
  100.       B(1)=RT1-SFG(1)+DL2*ANU*Y
  101.       B(2)=-SFG(2)+DL2*Y
  102.       A(2)=-Y+H1
  103.       A(1)=DSFG(1)
  104.       A(4)=-Y*ANU
  105.       A(3)=DSFG(2)
  106.       DET=A(1)*A(4)-A(2)*A(3)
  107.       IF(DET.EQ.0.D0) THEN
  108.       X=0.D0
  109.       DL1=(SFG(1)-RT1-DL2*ANU*Y)/(Y-H1)
  110.       IF(DL1.LT.0.D0) DL1=0.D0
  111.       GOTO 1005
  112.       ENDIF
  113.       CALL SYLIN2(A,B,X,DL1)
  114.  1005 CONTINUE
  115.       EPC(1)=DL1
  116.       EPC(2)=DL2
  117.       EPC(3)=0.D0
  118.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  119.       DO 1010 ITYP=1,3
  120.       SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
  121.       DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
  122.  1010 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)
  123.       VCDP=-1.D0
  124.       IF(X.GT.1.E-10) CALL CDP(SFC,ADP,RDP,VCDP)
  125.       IF(VCDP.GT.0.D0) GOTO 3000
  126.       RT1=RT1-H1*DL1
  127.       IF(RT1.LE.1.E-10) THEN
  128.       H1=0.D0
  129.       RT1=0.D0
  130.       ENDIF
  131.       XLAM2=0.D0
  132.       XLAM1=XLAM1+DL1
  133.       IDAM(2)=0
  134.       GAMCO=10.D0
  135.       GAMTR=10.D0
  136.       GAMDP=10.D0
  137.       IDAM(1)=0
  138.       IDAM(3)=0
  139.       CALL CDP(TSFC,ADP,RDP,VCDP)
  140.       IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP)
  141.       CALL CTRAF(TSFC(1),RT1,VCTR1)
  142.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFC(1),RT1,GAMTR)
  143.       CALL CCOAF(TSFC(1),XLAM1,VCCO1)
  144.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFC(1),GAMCO)
  145.       GAM=MIN(GAMDP,GAMTR,GAMCO)
  146.       IF(GAM.GE.1.D0) THEN
  147.       GAM=1.D0
  148.       GOTO 1020
  149.       ENDIF
  150.       IF(ABS(GAM-GAMCO).LE.1.E-10) IDAM(1)=-1
  151.       IF(ABS(GAM-GAMTR).LE.1.E-10) IDAM(1)=1
  152.       IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1
  153.  1020 DO 1030 ITYP=1,3
  154.       SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP)
  155.  1030 DSFG(ITYP)=DSFC(ITYP)*(1.D0-GAM)
  156.       CALL CHREP(SFG,SIG,-ANG)
  157.       CALL CHREP(DSFG,DSIG,-ANG)
  158.       RETURN
  159. 2000  CONTINUE
  160.       EPC(1)=DL1
  161.       EPC(2)=DL2
  162.       EPC(3)=0.D0
  163.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  164.       DO 2010 ITYP=1,3
  165.  2010 SFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  166.       CALL CDP(SFC,ADP,RDP,VCDP)
  167.       IF(VCDP.GT.0.D0) GOTO 3000
  168. C
  169. C------------------------------------------------
  170. C     ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  171. C     PENDANT L 'ECOULEMENT (SINON 3000)
  172. C------------------------------------------------
  173. C
  174.       RT1=RT1-H1*DL1
  175.       IF(RT1.LE.1.E-10) THEN
  176.       H1=0.D0
  177.       RT1=0.D0
  178.       ENDIF
  179.       XLAM1=XLAM1+DL1
  180.       XLAM2=XLAM2+DL2
  181.       IDAM(1)=0
  182.       IDAM(2)=0
  183.       IDAM(3)=0
  184.       CALL CHREP(SFC,SIG,-ANG)
  185.       DO 2020 ITYP=1,3
  186.  2020 DSIG(ITYP)=0.D0
  187.       RETURN
  188. 3000  CONTINUE
  189.       EPC1(1)=1.D0
  190.       EPC1(2)=0.D0
  191.       EPC1(3)=0.D0
  192.       EPC2(2)=1.D0
  193.       EPC2(1)=0.D0
  194.       EPC2(3)=0.D0
  195.       CALL CPHOOB(EPC1,SG1,YOUN,ANU)
  196.       CALL CPHOOB(EPC2,SG2,YOUN,ANU)
  197.       B(1)=SFG(1)-RT1
  198.       B(2)=SFG(2)
  199.       A(4)=Y
  200.       A(1)=Y-H1
  201.       A(2)=ANU*Y
  202.       A(3)=A(2)
  203.       CALL SYLIN2(A,B,DL11,DL21)
  204.       B(1)=DSFG(1)
  205.       B(2)=DSFG(2)
  206.       CALL SYLIN2(A,B,DL12,DL22)
  207.       DO 3010 ITYP=1,3
  208.       SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  209.  3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP)
  210.       CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
  211.       IF(ITEST.EQ.1) THEN
  212.       IDAM(1)=1
  213.       IDAM(2)=-1
  214.       IDAM(3)=1
  215.       CALL CHREP(SFG,SIG,-ANG)
  216.       CALL CHREP(DSFG,DSIG,-ANG)
  217.       RETURN
  218.       ENDIF
  219.       DL1=DL11+X*DL12
  220.       DL2=DL21+X*DL22
  221.       RT1=RT1-H1*DL1
  222.       IF(RT1.LE.1.E-10) THEN
  223.       H1=0.D0
  224.       RT1=0.D0
  225.       ENDIF
  226.       XLAM1=XLAM1+DL1
  227.       XLAM2=XLAM2+DL2
  228.       IDAM(1)=1
  229.       IDAM(2)=-1
  230.       IDAM(3)=1
  231.       IF(XLAM2.LT.1.E-8) THEN
  232.       XLAM2=0.D0
  233.       IDAM(2)=0
  234.       ENDIF
  235.       EPC(1)=DL1
  236.       EPC(2)=DL2
  237.       EPC(3)=0.D0
  238.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  239.       DO 3020 ITYP=1,3
  240.       SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  241.  3020 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  242.       CALL CHREP(DSFG,DSIG,-ANG)
  243.       CALL CHREP(SFG,SIG,-ANG)
  244.       RETURN
  245.       END
  246.  
  247.  

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