1 : C GAMMAN SOURCE CHAT 05/01/13 00:15:32 5004 2 : SUBROUTINE GAMMAN(I,S,DS,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR, 3 : .R1,R2,R3,FST,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,GAMMA, 4 : .PREC,RFSG,RFEP,RFPR,KERRE) 5 : C 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : -INC CCOPTIO 9 : C 10 : DIMENSION S(*),DS(*),TS(3) 11 : C 12 : TRS0=S(1)+S(2)+S(3) 13 : SEQ2=AVM(S,S) 14 : SEQ0=SQRT(SEQ2) 15 : GO TO (100,200,300,400,500,600,700),I 16 : WRITE(IOIMP,20) I 17 : KERRE=640 18 : RETURN 19 : C 20 : C CAS DE CRITERE DE LA POROSITE (1) 21 : C 22 : 100 FS0=-TRS0*0.33333333333333333333333333333D0 23 : X=POR-FS0 24 : DEN=FST-FS0 25 : GO TO 1 26 : C 27 : C CAS DU CRITERE DE DRUCKER DUCTILE (2) 28 : C 29 : 200 FS0=ALFV*TRS0+SEQ0 30 : X=DPD-FS0 31 : IF(SEQ0.NE.0.D0) GO TO 201 32 : DEN=ALFV*(DS(1)+DS(2)+DS(3)) 33 : GO TO 1 34 : 201 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5) 35 : .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0) 36 : DEN=Z*3.D0/(2.D0*SEQ0)+ALFV*(DS(1)+DS(2)+DS(3)) 37 : GO TO 1 38 : C 39 : C CAS DU CRITERE DE VON MISES (3) 40 : C 41 : 300 FS0=SEQ0 42 : X=VOM-FS0 43 : IF (SEQ0.NE.0.D0) GO TO 301 44 : WRITE(IOIMP,22) 45 : KERRE=640 46 : RETURN 47 : 301 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5) 48 : .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0) 49 : DEN=Z*3.D0/(2.D0*SEQ0) 50 : GO TO 1 51 : C 52 : C CAS DU CRITERE DE DRUCKER FRAGILE (4) 53 : C 54 : 400 FS0=ALF1*TRS0+SEQ0 55 : X=DF1-FS0 56 : IF(SEQ0.NE.0.D0) GO TO 401 57 : DEN=ALF1*(DS(1)+DS(2)+DS(3)) 58 : GO TO 1 59 : 401 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5) 60 : .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0) 61 : DEN=Z*3.D0/(2.D0*SEQ0)+ALF1*(DS(1)+DS(2)+DS(3)) 62 : GO TO 1 63 : C 64 : C CAS DU CRITERE DE DRUCKER FRAGILE ECROUI. (5) 65 : C 66 : 500 FS0=ALF2*TRS0+SEQ0 67 : X=DF2-FS0 68 : IF(SEQ0.NE.0.D0) GO TO 501 69 : DEN=ALF2*(DS(1)+DS(2)+DS(3)) 70 : GO TO 1 71 : 501 Z=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)+2.D0*(S(4)*DS(4)+S(5)*DS(5) 72 : .+S(6)*DS(6))-((S(1)+S(2)+S(3))*(DS(1)+DS(2)+DS(3))/3.D0) 73 : DEN=Z*3.D0/(2.D0*SEQ0)+ALF2*(DS(1)+DS(2)+DS(3)) 74 : GO TO 1 75 : C 76 : C CAS DU CRITERE DE LA TRACTION DANS LE PLAN RZ (6) 77 : C 78 : 600 IT=ITRAC+1 79 : GO TO(601,602),IT 80 : WRITE(IOIMP,21) IT 81 : KERRE=640 82 : RETURN 83 : C 84 : 601 TS(1)=S(1) 85 : TS(2)=S(2) 86 : TS(3)=S(4) 86 : CALL DIAGOD(TS) 87 : F1S0=TS(1) 88 : F2S0=TS(2) 89 : GO TO 2 90 : C 91 : 602 F1S0=ROTA(S,CC,SS,CS,1) 92 : F2S0=ROTA(S,CC,SS,CS,2) 93 : 2 IF(F1ST.GT.R1) GO TO 3 94 : GAM1=100.D0 95 : GO TO 4 96 : 3 X=R1-F1S0 97 : DEN1=F1ST-F1S0 98 : IF(DEN1.NE.0.D0) GO TO 5 99 : GAM1=100.D0 100 : GO TO 4 101 : 5 GAM1=X/DEN1 102 : 4 IF(F2ST.GT.R2) GO TO 6 103 : GAM2=100.D0 104 : GO TO 7 105 : 6 X=R2-F2S0 106 : DEN2=F2ST-F2S0 107 : IF(DEN2.NE.0.D0) GO TO 8 108 : GAM2=100.D0 109 : GO TO 7 110 : 8 GAM2=X/DEN2 111 : 7 GAMMA=GAM1 112 : IF(ABS(GAM2).LT.ABS(GAM1)) GAMMA=GAM2 113 : IRZ=1 114 : IF(GAMMA.EQ.GAM2) IRZ=2 115 : DENOR=MIN(GAM1,GAM2) 116 : DENOR=MAX(DENOR,RFPR) 117 : DIF=ABS(GAM1-GAM2)/DENOR 118 : IF(DIF.LE.PREC) IRZ=3 119 : RETURN 120 : C 121 : C CAS DU CRITERE DE LA TRACTION DANS LA DIRECTION TETA (7) 122 : C 123 : 700 FS0=S(3) 124 : X=R3-FS0 125 : DEN=FST-FS0 126 : C 127 : 1 IF(DEN.NE.0.D0) GO TO 10 128 : GAMMA=100.D0 129 : RETURN 130 : 10 GAMMA=X/DEN 131 : C 132 : 20 FORMAT(1X,'ERREUR DANS GAMMAN IL FAUT DETERMINER I =',I4) 133 : 21 FORMAT(1X,'ERREUR DANS GAMMAN IL FAUT DETERMINER ITRAC =',I4) 134 : 22 FORMAT(1X,'ERREUR DANS GAMMAN LA VALEUR DE SEQ EST NULLE') 135 : C 136 : RETURN 137 : END 138 :
© Cast3M 2003 - All rights reserved.
Disclaimer