Télécharger la plaquette Cast3M


fr en

Télécharger c1c2.eso

Retour à la liste

Numérotation des lignes : 

c1c2

  1. C C1C2      SOURCE    CHAT      05/01/12    21:44:44     5004
  2.       SUBROUTINE C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,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. C
  14. C--------------------------------------------------------
  15. C     FERMETURE DES FISSURES DANS LES DEUX DIRECTIONS   |
  16. C--------------------------------------------------------
  17. C
  18. C-------------------------------------------------
  19. C     ON SE PLACE DANS LE REPERE DE FISSURATION
  20. C-------------------------------------------------
  21. C
  22.       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  23. 9999  FORMAT(1X,'C1C2 COUPLAGE COMP 1 COMP 2',/)
  24.       IC1=0
  25.       IC2=0
  26.       CALL CHREP(SIG,SFG,ANG)
  27.       CALL CHREP(DSIG,DSFG,ANG)
  28. C
  29. C------------------------------------------
  30. C     OBTENTION DU SYSTEME EN DL1 DL2
  31. C------------------------------------------
  32. C
  33.       B(1)=DSFG(1)+SFG(1)
  34.       B(2)=DSFG(2)+SFG(2)
  35.       A(1)=Y
  36.       A(4)=Y
  37.       A(2)=ANU*Y
  38.       A(3)=A(2)
  39.       CALL SYLIN2(A,B,DL1,DL2)
  40. C
  41. C-----------------------------------------------
  42. C     CAS DES FAUX COUPLAGES DL1 OU DL2 POSITIF
  43. C-----------------------------------------------
  44. C
  45.       IF(DL1.GT.1.E-10) IDAM(1)=0
  46.       IF(DL2.GT.1.E-10) IDAM(2)=0
  47.       IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) RETURN
  48.       IF(DL1.LT.-XLAM1) IC1=1
  49.       IF(DL2.LT.-XLAM2) IC2=1
  50. C
  51. C-----------------------------------------------
  52. C     CAS OU ON FERME TOTALEMENT LA FISSURE 1
  53. C-----------------------------------------------
  54. C
  55.       IF(DL1.LT.-XLAM1) GOTO 1000
  56. C
  57. C-----------------------------------------------
  58. C     CAS OU ON FERME TOTALEMENT LA FISSURE 2
  59. C-----------------------------------------------
  60. C
  61.       IF(DL2.LT.-XLAM2) GOTO 2000
  62. C
  63. C------------------------------------
  64. C     ON EFFECTUE L ECOULEMENT
  65. C------------------------------------
  66. C
  67.       EPC(1)=DL1
  68.       EPC(2)=DL2
  69.       EPC(3)=0.D0
  70.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  71.       DO 10 ITYP=1,3
  72.    10 TSFC(ITYP)=DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  73. C
  74. C------------------------------------------------
  75. C     ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  76. C     PENDANT L 'ECOULEMENT (SINON 3000)
  77. C------------------------------------------------
  78. C
  79.       CALL CDP(TSFC,ADP,RDP,VCDP)
  80.       IF(VCDP.GT.0.D0) GOTO 3000
  81. C
  82. C------------------------------------------------
  83. C     CAS OU L ECOULEMENT SE FAIT ENTIEREMENT
  84. C     MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  85. C------------------------------------------------
  86. C
  87.       XLAM1=XLAM1+DL1
  88.       XLAM2=XLAM2+DL2
  89.       IDAM(1)=0
  90.       IDAM(2)=0
  91.       IDAM(3)=0
  92.       DO 20 ITYP=1,3
  93.    20 DSIG(ITYP)=0.D0
  94.       CALL CHREP(TSFC,SIG,-ANG)
  95.       RETURN
  96. C
  97. C------------------------------------------------
  98. C     CAS OU LA FISSURE1 EST COMPLETEMENT FERMEE
  99. C------------------------------------------------
  100. C
  101. C------------------------------------------
  102. C     OBTENTION DU SYSTEME EN X DL2
  103. C------------------------------------------
  104. C
  105.  1000 DL1=-XLAM1
  106.       B(1)=-SFG(1)+DL1*Y
  107.       B(2)=-SFG(2)+DL1*ANU*Y
  108.       A(4)=-Y
  109.       A(1)=DSFG(1)
  110.       A(2)=-ANU*Y
  111.       A(3)=DSFG(2)
  112.       DET=A(1)*A(4)-A(2)*A(3)
  113.       IF(DET.EQ.0.D0.AND.DL2.LT.-XLAM2) GOTO 2000
  114.       IF(DET.EQ.0.D0) GOTO 2500
  115.       CALL SYLIN2(A,B,X,DL2)
  116.       IF(DL2.LT.-XLAM2) GOTO 2000
  117.       EPC(1)=DL1
  118.       EPC(2)=DL2
  119.       EPC(3)=0.D0
  120.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  121.       DO 30 ITYP=1,3
  122.    30 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  123. C
  124. C------------------------------------------------
  125. C     ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  126. C     PENDANT L 'ECOULEMENT (SINON 3000)
  127. C------------------------------------------------
  128. C
  129.       CALL CDP(SFC,ADP,RDP,VCDP)
  130.       IF(VCDP.GT.0.D0) GOTO 3000
  131. C
  132. C------------------------------------------------
  133. C     L ECOULEMENT SE FAIT PARTIELLEMENT
  134. C     MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  135. C     ET DE L INCREMENT DSIGMA
  136. C------------------------------------------------
  137. C
  138.       XLAM1=0.D0
  139.       XLAM2=XLAM2+DL2
  140.       DO 40 ITYP=1,3
  141.       DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  142.    40 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  143.       GOTO 2750
  144. C
  145. C------------------------------------------------
  146. C     CAS OU LA FISSURE2 EST COMPLETEMENT FERMEE
  147. C------------------------------------------------
  148. C
  149. C------------------------------------------
  150. C     OBTENTION DU SYSTEME EN X DL1
  151. C------------------------------------------
  152. C
  153.  2000 DL2=-XLAM2
  154.       B(1)=-SFG(1)+DL2*ANU*Y
  155.       B(2)=-SFG(2)+DL2*Y
  156.       A(2)=-Y
  157.       A(1)=DSFG(1)
  158.       A(4)=-ANU*Y
  159.       A(3)=DSFG(2)
  160.       DET=A(1)*A(4)-A(2)*A(3)
  161.       IF(DET.EQ.0.D0) GOTO 2500
  162.       CALL SYLIN2(A,B,X,DL1)
  163.       IF(DL1.LT.-XLAM1) GOTO 2500
  164.       EPC(1)=DL1
  165.       EPC(2)=DL2
  166.       EPC(3)=0.D0
  167.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  168.       DO 130 ITYP=1,3
  169.   130 SFC(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  170. C
  171. C------------------------------------------------
  172. C     ON VERIFIE QUE LE DP N EST PAS ENDOMMAGE
  173. C     PENDANT L 'ECOULEMENT (SINON 3000)
  174. C------------------------------------------------
  175. C
  176.       CALL CDP(SFC,ADP,RDP,VCDP)
  177.       IF(VCDP.GT.0.D0) GOTO 3000
  178. C
  179. C------------------------------------------------
  180. C     L ECOULEMENT SE FAIT PARTIELLEMENT
  181. C     MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  182. C     ET DE L INCREMENT DSIGMA
  183. C------------------------------------------------
  184. C
  185.       XLAM2=0.D0
  186.       XLAM1=XLAM1+DL1
  187.       DO 140 ITYP=1,3
  188.       DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  189.   140 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  190.       GOTO 2750
  191.  2500 IF(IC1.EQ.1.AND.IC2.EQ.1) THEN
  192.       DL1=-XLAM1
  193.       DL2=-XLAM2
  194.       XLAM1=0.D0
  195.       XLAM2=0.D0
  196.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  197.       DO 150 ITYP=1,3
  198.       SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  199.   150 TENS(ITYP)=SFC(ITYP)+DSFG(ITYP)
  200.       GOTO 2750
  201.       ENDIF
  202.       IF(IC1.EQ.1) THEN
  203.       DL1=-XLAM1
  204.       XLAM1=0.D0
  205.       DL2=SFG(2)/Y-ANU*DL1
  206.       IF(DL2.GT.0.D0) DL2=0.D0
  207.       IF(DL2.LT.-XLAM2) DL2=-XLAM2
  208.       XLAM2=XLAM2+DL2
  209.       EPC(1)=DL1
  210.       EPC(2)=DL2
  211.       EPC(3)=0.D0
  212.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  213.       DO 153 ITYP=1,3
  214.       SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  215.   153 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP)
  216.       GOTO 2750
  217.       ENDIF
  218.       IF(IC2.EQ.1) THEN
  219.       DL2=-XLAM2
  220.       XLAM2=0.D0
  221.       DL1=SFG(1)/Y-ANU*DL2
  222.       IF(DL1.GT.0.D0) DL1=0.D0
  223.       IF(DL1.LT.-XLAM1) DL1=-XLAM1
  224.       XLAM1=XLAM1+DL1
  225.       EPC(1)=DL1
  226.       EPC(2)=DL2
  227.       EPC(3)=0.D0
  228.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  229.       DO 155 ITYP=1,3
  230.       SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
  231.   155 TENS(ITYP)=DSFG(ITYP)+SFC(ITYP)
  232.       ENDIF
  233.  2750 IDAM(1)=0
  234.       IDAM(2)=0
  235.       IDAM(3)=0
  236.       GAMDP=10.D0
  237.       GAMTR1=10.D0
  238.       GAMTR2=10.D0
  239.       GAMCO1=10.D0
  240.       GAMCO2=10.D0
  241.       CALL CDP(TENS,ADP,RDP,VCDP)
  242.       IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFG,RDP,ADP,GAMDP)
  243.       CALL CTRAF(TENS(1),RT1,VCTR1)
  244.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFG(1),RT1,GAMTR1)
  245.       CALL CCOAF(TENS(1),XLAM1,VCCO1)
  246.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFG(1),GAMCO1)
  247.       CALL CTRAF(TENS(2),RT2,VCTR2)
  248.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(2),DSFG(2),RT2,GAMTR2)
  249.       CALL CCOAF(TENS(2),XLAM2,VCCO2)
  250.       IF(VCCO2.GT.0.D0) CALL GAMCAF(SFC(2),DSFG(2),GAMCO2)
  251.       GAM=MIN(GAMCO1,GAMDP,GAMTR1,GAMTR2,GAMCO2)
  252.       IF(GAM.GE.1.D0) THEN
  253.       DO 156 ITYP=1,3
  254.       SFG(ITYP)=SFC(ITYP)+DSFG(ITYP)
  255.   156 DSIG(ITYP)=0.D0
  256.       CALL CHREP(SFG,SIG,-ANG)
  257.       RETURN
  258.       ENDIF
  259.       IF(ABS(GAM-GAMCO1).LT.1E-10) IDAM(1)=-1
  260.       IF(ABS(GAM-GAMTR1).LT.1E-10) IDAM(1)=1
  261.       IF(ABS(GAM-GAMCO2).LT.1E-10) IDAM(2)=-1
  262.       IF(ABS(GAM-GAMTR2).LT.1E-10) IDAM(2)=1
  263.       IF(ABS(GAM-GAMDP).LT.1E-10) IDAM(3)=1
  264.       DO 157 ITYP=1,3
  265.       SFG(ITYP)=SFC(ITYP)+GAM*DSFG(ITYP)
  266.   157 DSFG(ITYP)=DSFG(ITYP)*(1.D0-GAM)
  267.       CALL CHREP(SFG,SIG,-ANG)
  268.       CALL CHREP(DSFG,DSIG,-ANG)
  269.       RETURN
  270. C
  271. C-----------------------------------------------------
  272. C     CAS OU ON ENDOMMAGE LE DP PENDANT L ECOULEMENT
  273. C     CALCUL DE X POUR ARRIVER SUR LE CRITERE
  274. C-----------------------------------------------------
  275. C
  276. 3000  CONTINUE
  277.       EPC1(1)=1.D0
  278.       EPC1(2)=0.D0
  279.       EPC1(3)=0.D0
  280.       EPC2(2)=1.D0
  281.       EPC2(1)=0.D0
  282.       EPC2(3)=0.D0
  283.       CALL CPHOOB(EPC1,SG1,YOUN,ANU)
  284.       CALL CPHOOB(EPC2,SG2,YOUN,ANU)
  285.       B(1)=SFG(1)
  286.       B(2)=SFG(2)
  287.       A(4)=Y
  288.       A(1)=A(4)
  289.       A(2)=A(4)*ANU
  290.       A(3)=A(2)
  291.       CALL SYLIN2(A,B,DL11,DL21)
  292.       B(1)=DSFG(1)
  293.       B(2)=DSFG(2)
  294.       CALL SYLIN2(A,B,DL12,DL22)
  295.       DO 3010 ITYP=1,3
  296.       SG(ITYP)=SFG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  297.  3010 DSG(ITYP)=DSFG(ITYP)-DL12*SG1(ITYP)-DL22*SG2(ITYP)
  298.       CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
  299.       IF(ITEST.EQ.1) THEN
  300.       IDAM(1)=-1
  301.       IDAM(2)=-1
  302.       IDAM(3)=1
  303.       RETURN
  304.       ENDIF
  305.       DL1=DL11+X*DL12
  306.       DL2=DL21+X*DL22
  307. C
  308. C------------------------------------------------
  309. C     L ECOULEMENT SE FAIT PARTIELLEMENT
  310. C     MISE A JOUR DES VARIABLES D ENDOMMAGEMENT
  311. C     ET DE L INCREMENT DSIGMA
  312. C------------------------------------------------
  313. C
  314.       XLAM1=XLAM1+DL1
  315.       XLAM2=XLAM2+DL2
  316.       IDAM(1)=-1
  317.       IDAM(2)=-1
  318.       IDAM(3)=1
  319.       IF(XLAM1.LT.1.E-8) THEN
  320.       XLAM1=0.D0
  321.       IDAM(1)=0
  322.       ENDIF
  323.       IF(XLAM2.LT.1.E-8) THEN
  324.       XLAM2=0.D0
  325.       IDAM(2)=0
  326.       ENDIF
  327.       EPC(1)=DL1
  328.       EPC(2)=DL2
  329.       EPC(3)=0.D0
  330.       CALL CPHOOB(EPC,SFC,YOUN,ANU)
  331.       DO 50 ITYP=1,3
  332.       SFG(ITYP)=X*DSFG(ITYP)+SFG(ITYP)-SFC(ITYP)
  333.    50 DSFG(ITYP)=(1.D0-X)*DSFG(ITYP)
  334.       CALL CHREP(DSFG,DSIG,-ANG)
  335.       CALL CHREP(SFG,SIG,-ANG)
  336.       RETURN
  337.       END
  338.  
  339.  

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