Télécharger la plaquette Cast3M


fr en

Télécharger t2c1.eso

Retour à la liste

Numérotation des lignes : 

t2c1

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

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