Sources Esope | Cast3M

gamman
C GAMMAN    SOURCE    CHAT      05/01/13    00:15:32     5004
      SUBROUTINE GAMMAN(I,S,DS,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,
     .R1,R2,R3,FST,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,GAMMA,
     .PREC,RFSG,RFEP,RFPR,KERRE)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION S(*),DS(*),TS(3)
C
      TRS0=S(1)+S(2)+S(3)
      SEQ2=AVM(S,S)
      SEQ0=SQRT(SEQ2)
      GO TO (100,200,300,400,500,600,700),I
      WRITE(IOIMP,20) I
      KERRE=640
      RETURN
C
C CAS DE CRITERE DE LA POROSITE (1)
C
  100 FS0=-TRS0*0.33333333333333333333333333333D0
      X=POR-FS0
      DEN=FST-FS0
      GO TO 1
C
C CAS DU CRITERE DE DRUCKER DUCTILE (2)
C
  200 FS0=ALFV*TRS0+SEQ0
      X=DPD-FS0
      IF(SEQ0.NE.0.D0) GO TO 201
      DEN=ALFV*(DS(1)+DS(2)+DS(3))
      GO TO 1
  201 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5)
     .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0)
      DEN=Z*3.D0/(2.D0*SEQ0)+ALFV*(DS(1)+DS(2)+DS(3))
      GO TO 1
C
C CAS DU CRITERE DE VON MISES (3)
C
  300 FS0=SEQ0
      X=VOM-FS0
      IF (SEQ0.NE.0.D0) GO TO 301
      WRITE(IOIMP,22)
      KERRE=640
      RETURN
  301 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5)
     .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0)
      DEN=Z*3.D0/(2.D0*SEQ0)
      GO TO 1
C
C CAS DU CRITERE DE DRUCKER FRAGILE (4)
C
  400 FS0=ALF1*TRS0+SEQ0
      X=DF1-FS0
      IF(SEQ0.NE.0.D0) GO TO 401
      DEN=ALF1*(DS(1)+DS(2)+DS(3))
      GO TO 1
  401 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5)
     .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0)
      DEN=Z*3.D0/(2.D0*SEQ0)+ALF1*(DS(1)+DS(2)+DS(3))
      GO TO 1
C
C CAS DU CRITERE DE DRUCKER FRAGILE ECROUI. (5)
C
  500 FS0=ALF2*TRS0+SEQ0
      X=DF2-FS0
      IF(SEQ0.NE.0.D0) GO TO 501
      DEN=ALF2*(DS(1)+DS(2)+DS(3))
      GO TO 1
  501 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5)
     .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0)
      DEN=Z*3.D0/(2.D0*SEQ0)+ALF2*(DS(1)+DS(2)+DS(3))
      GO TO 1
C
C CAS DU CRITERE DE LA TRACTION DANS LE PLAN RZ (6)
C
  600 IT=ITRAC+1
      GO TO(601,602),IT
      WRITE(IOIMP,21) IT
      KERRE=640
      RETURN
C
  601 TS(1)=S(1)
      TS(2)=S(2)
      TS(3)=S(4)
      CALL DIAGOD(TS)
      F1S0=TS(1)
      F2S0=TS(2)
      GO TO 2
C
  602 F1S0=ROTA(S,CC,SS,CS,1)
      F2S0=ROTA(S,CC,SS,CS,2)
    2 IF(F1ST.GT.R1) GO TO 3
      GAM1=100.D0
      GO TO 4
    3 X=R1-F1S0
      DEN1=F1ST-F1S0
      IF(DEN1.NE.0.D0) GO TO 5
      GAM1=100.D0
      GO TO 4
    5 GAM1=X/DEN1
    4 IF(F2ST.GT.R2) GO TO 6
      GAM2=100.D0
      GO TO 7
    6 X=R2-F2S0
      DEN2=F2ST-F2S0
      IF(DEN2.NE.0.D0) GO TO 8
      GAM2=100.D0
      GO TO 7
    8 GAM2=X/DEN2
    7 GAMMA=GAM1
      IF(ABS(GAM2).LT.ABS(GAM1)) GAMMA=GAM2
      IRZ=1
      IF(GAMMA.EQ.GAM2) IRZ=2
      DENOR=MIN(GAM1,GAM2)
      DENOR=MAX(DENOR,RFPR)
      DIF=ABS(GAM1-GAM2)/DENOR
      IF(DIF.LE.PREC) IRZ=3
      RETURN
C
C CAS DU CRITERE DE LA TRACTION DANS LA DIRECTION TETA (7)
C
  700 FS0=S(3)
      X=R3-FS0
      DEN=FST-FS0
C
    1 IF(DEN.NE.0.D0) GO TO 10
      GAMMA=100.D0
      RETURN
   10 GAMMA=X/DEN
C
   20 FORMAT(1X,'ERREUR DANS GAMMAN IL FAUT DETERMINER I     =',I4)
   21 FORMAT(1X,'ERREUR DANS GAMMAN IL FAUT DETERMINER ITRAC =',I4)
   22 FORMAT(1X,'ERREUR DANS GAMMAN LA VALEUR DE SEQ EST NULLE')
C
      RETURN
      END