Sources Esope | Cast3M

c2
C C2        SOURCE    CHAT      05/01/12    21:45:04     5004
      SUBROUTINE C2(SIG,DSIG,YOUN,ANU,RT1,RDP,ADP,
     1 XLAM1,XLAM2,IDAM,ANG)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
      DIMENSION SIG(3),DSIG(3),SFC(3),DSFC(3),TSFC(3),SFG(3),DSFG(3),
     1 A(4),B(2),IDAM(3),EPC(3),SG(3),DSG(3)
      Y=YOUN/(1.D0-ANU*ANU)
C
C--------------------------------------------
C     BOITE D ECOULEMENT DE COMPRESSION
C--------------------------------------------
C
C-----------------------------------------------
C     ON SE PLACE DANS LE REPERE DE FISSURATION
C-----------------------------------------------
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
9999  FORMAT(1X,'C2 ECOULEMENT SUIVANT COMP 2',/)
      CALL CHREP(SIG,SFG,ANG)
      CALL CHREP(DSIG,DSFG,ANG)
      DL2=(SFG(2)+DSFG(2))/Y
C
C------------------------------------------
C     CAS OU LA FISSURE RESTE OUVERTE
C     TOUT LE TEMPS DE L ECOULEMENT (1000)
C-------------------------------------------
C
      IF(DL2.GT.0.D0) THEN
      IDAM(2)=0
      RETURN
      ENDIF
      IF(DL2.GE.-XLAM2) THEN
      EPC(2)=DL2
      EPC(1)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      X=1.D0
      GOTO 1000
      ENDIF
C
C-------------------------------------------
C     CAS OU LA FISSURE EST FERME AVANT
C     LA FIN DE L ECOULEMENT
C-------------------------------------------
C
      DL2=-XLAM2
      EPC(2)=DL2
      EPC(1)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
C
C------------------------------------------
C     ON CALCULE LA PARTIE DE DSIGMA
C     QU IL FAUT POUR FERMER LA FISSURE
C------------------------------------------
C
      IF(DSFG(2).EQ.0.D0) THEN
      X=0.D0
      DO 10 ITYP=1,3
      DSFC(ITYP)=DSFG(ITYP)
   10 SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
      XLAM2=0.D0
      DL2=0.D0
      GOTO 1010
      ENDIF
      X=(-SFG(2)+SFC(2))/DSFG(2)
      IF(X.LT.0.D0) THEN
      X=0.D0
      DO 15 ITYP=1,3
      DSFC(ITYP)=DSFG(ITYP)
   15 SFC(ITYP)=SFG(ITYP)-SFC(ITYP)
      XLAM2=0.D0
      DL2=0.D0
      GOTO 1010
      ENDIF
 1000 DO 20 ITYP=1,3
      DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
   20 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
C
C-----------------------------------------------
C     ON REGARDE SI LES AUTRES CRITERES NE
C     SONT PAS ENDOMMAGES PENDANT L ECOULEMENT
C-----------------------------------------------
C
      CALL CDP(SFC,ADP,RDP,VCDP)
      CALL CTRAF(SFC(1),RT1,VCTR1)
      CALL CCOAF(SFC(1),XLAM1,VCCO1)
C
C------------------------------------
C     CRITERE DE TRACTION ENDOMMAGE
C------------------------------------
C
      IF(VCTR1.GT.0.D0) GOTO 2000
C
C----------------------------------------
C     CRITERE DE COMPRESSION ENDOMMAGE
C----------------------------------------
C
      IF(VCCO1.GT.0.D0) GOTO 3000
C
C------------------------------------
C     CRITERE DE TRACTION ENDOMMAGE
C------------------------------------
C
      IF(VCDP.GT.0.D0) GOTO 4000
C
C---------------------------------------------------
C     AUCUN CRITERE ENDOMMAGE PENDANT L ECOULEMENT
C---------------------------------------------------
C
 1010 DO 30 ITYP=1,3
   30 TSFC(ITYP)=DSFC(ITYP)+SFC(ITYP)
C
C---------------------------------------------------
C     ON REGARDE SI L ECOULEMENT RESTANT N ENDOMMAGE
C     PAS LES CRITERES
C---------------------------------------------------
C
      IDAM(1)=0
      IDAM(2)=0
      IDAM(3)=0
      C=1.D0-1.D-10
      IF(X.GE.C) THEN
      GAM=1.D0
      GOTO 1500
      ENDIF
      GAMDP=10.D0
      GAMCO1=10.D0
      GAMTR1=10.D0
      CALL CDP(TSFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) CALL GDP(SFC,DSFC,RDP,ADP,GAMDP)
      CALL CTRAF(TSFC(1),RT1,VCTR1)
      IF(VCTR1.GT.0.D0) CALL GAMTAF(SFC(1),DSFC(1),RT1,GAMTR1)
      CALL CCOAF(TSFC(1),XLAM1,VCCO1)
      IF(VCCO1.GT.0.D0) CALL GAMCAF(SFC(1),DSFC(1),GAMCO1)
      GAM=MIN(GAMTR1,GAMCO1,GAMDP)
      IF(GAM.GE.C) THEN
      GAM=1.D0
      GOTO 1500
      ENDIF
      IF(ABS(GAMCO1-GAM).LT.1.E-10) IDAM(1)=-1
      IF(ABS(GAMTR1-GAM).LT.1.E-10) IDAM(1)=1
      IF(ABS(GAMDP-GAM).LT.1.E-10) IDAM(3)=1
      XLAM2=0.D0
      DL2=0.D0
 1500 DO 40 ITYP=1,3
      SFG(ITYP)=SFC(ITYP)+GAM*DSFC(ITYP)
   40 DSFG(ITYP)=(1.D0-GAM)*DSFC(ITYP)
      CALL CHREP(SFG,SIG,-ANG)
      CALL CHREP(DSFG,DSIG,-ANG)
      XLAM2=XLAM2+DL2
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LA TRACTION1
C     PENDANT LA FERMETURE DE LA FISSURE
C----------------------------------------
C
 2000 A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(4)=-Y
      A(2)=A(4)*ANU
      DET=A(1)*A(4)-A(2)*A(3)
      IF(DET.EQ.0.D0) THEN
      IDAM(1)=1
      IDAM(2)=-1
      IDAM(3)=0
      RETURN
      ENDIF
      B(1)=RT1-SFG(1)
      B(2)=-SFG(2)
      CALL SYLIN2(A,B,X,DL2)
      EPC(2)=DL2
      EPC(1)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 50 ITYP=1,3
      DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
   50 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 4000
      IDAM(2)=-1
      IDAM(1)=1
      IDAM(3)=0
      XLAM2=XLAM2+DL2
      CALL CHREP(DSFC,DSIG,-ANG)
      CALL CHREP(SFC,SIG,-ANG)
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LA COMPRESSION1
C     PENDANT LA FERMETURE DE LA FISSURE
C----------------------------------------
C
 3000 A(1)=DSFG(1)
      A(3)=DSFG(2)
      A(4)=-Y
      A(2)=A(4)*ANU
      DET=A(1)*A(4)-A(2)*A(3)
      IF(DET.EQ.0.D0) THEN
      IDAM(1)=-1
      IDAM(2)=-1
      IDAM(3)=0
      RETURN
      ENDIF
      B(1)=-SFG(1)
      B(2)=-SFG(2)
      CALL SYLIN2(A,B,X,DL2)
      EPC(2)=DL2
      EPC(1)=0.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 150 ITYP=1,3
      DSFC(ITYP)=(1.D0-X)*DSFG(ITYP)
  150 SFC(ITYP)=SFG(ITYP)+X*DSFG(ITYP)-SFC(ITYP)
      CALL CDP(SFC,ADP,RDP,VCDP)
      IF(VCDP.GT.0.D0) GOTO 4000
      IDAM(1)=-1
      IDAM(2)=-1
      IDAM(3)=0
      XLAM2=XLAM2+DL2
      CALL CHREP(DSFC,DSIG,-ANG)
      CALL CHREP(SFC,SIG,-ANG)
      RETURN
C
C----------------------------------------
C     CAS OU EN ENDOMMAGE LE DP
C     PENDANT LA FERMETURE DE LA FISSURE
C----------------------------------------
C
 4000 CONTINUE
      EPC(1)=0.D0
      EPC(2)=1.D0
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      E=Y
      F=SFG(2)/E
      G=DSFG(2)/E
      DO 70 ITYP=1,3
      SG(ITYP)=SFG(ITYP)-F*SFC(ITYP)
   70 DSG(ITYP)=DSFG(ITYP)-G*SFC(ITYP)
      CALL XDP(SG,DSG,RDP,ADP,X,ITEST)
      IF(ITEST.EQ.1) THEN
      IDAM(1)=0
      IDAM(2)=-1
      IDAM(3)=1
      RETURN
      ENDIF
      DL2=(SFG(2)+X*DSFG(2))/Y
      EPC(1)=0.D0
      EPC(2)=DL2
      EPC(3)=0.D0
      CALL CPHOOB(EPC,SFC,YOUN,ANU)
      DO 60 ITYP=1,3
      SFG(ITYP)=X*DSFG(ITYP)-SFC(ITYP)+SFG(ITYP)
   60 DSFG(ITYP)=DSFG(ITYP)*(1.D0-X)
      XLAM2=XLAM2+DL2
      CALL CHREP(DSFG,DSIG,-ANG)
      CALL CHREP(SFG,SIG,-ANG)
      IDAM(1)=0
      IDAM(2)=-1
      IDAM(3)=1
      RETURN
      END