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

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