1 : C XXPT1 SOURCE CHAT 05/01/13 04:15:53 5004 2 : SUBROUTINE XXPT1(SIG,EPSV,VAR,EPSVPT,VARPT,XPM, 3 : + XMAT,NSTRS0,NVARI,NCOMAT,MFR) 4 : C 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : -INC CCOPTIO 8 : DIMENSION SIG(*),EPSV(*),VAR(*),EPSVPT(*),VARPT(*),XPM(*) 9 : DIMENSION XMAT(*) 10 : DIMENSION XX(6),SIG0(6),EPSV0(6),EPS0(6) 11 : PARAMETER (AMAX = 1.0D20, AMIN = 1.D-20) 12 : C---------------------------------------------------------------- 13 : C ====> Connaissant l'etat, c'est @ dire SIG, EPSV et VAR 14 : C on calcule les d{riv{es EPSVPT et VARPT ( et XPM ) 15 : C en utilisant les constantes XMAT 16 : C Il n'y a que (4+NSTRS) valeurs dans VARPT, 17 : C le reste constitue la m{moire. 18 : C---------------------------------------------------------------- 19 : C 20 : C------- CAS DES COQUES EPAISSES: PASSAGE A 6 COMPOSANTES 21 : C 22 : IF (MFR.EQ.5) THEN 23 : NSTRS=NSTRS0+1 24 : SIG0(1)=SIG(1) 25 : SIG0(2)=SIG(2) 26 : SIG0(3)=0.D0 27 : SIG0(4)=SIG(3) 28 : SIG0(5)=SIG(4) 29 : SIG0(6)=SIG(5) 30 : EPSV0(1)=EPSV(1) 31 : EPSV0(2)=EPSV(2) 32 : EPSV0(3)=-1.D0*(EPSV0(1)+EPSV0(2)) 33 : EPSV0(4)=EPSV(3) 34 : EPSV0(5)=EPSV(4) 35 : EPSV0(6)=EPSV(5) 36 : ELSE 37 : NSTRS=NSTRS0 38 : DO 01 I=1,NSTRS 39 : SIG0(I)=SIG(I) 40 : EPSV0(I)=EPSV(I) 41 : 01 CONTINUE 42 : ENDIF 43 : C 44 : C------- AFFECTATION DE QUELQUES VARIABLES 45 : P1 = VAR(2) 46 : XN = XMAT(17) 47 : ALPH2 = VAR(3) 48 : ALPH4 = VAR(4) 49 : C 50 : C------- EVALUATION DE J2( SIGMA - X ) = SQRT(3/2* Dev():Dev() ) 51 : DO 69 I=1,NSTRS 52 : XX(I) = SIG0(I)- VAR(4+I) 53 : 69 CONTINUE 54 : TRACE = XX(1)+XX(2)+XX(3) 55 : C 56 : DO 70 I=1,NSTRS 57 : A = 0.0D0 58 : IF (I.LE.3) A=1.0D0/3.0D0 59 : XX(I) = XX(I)-A*TRACE 60 : 70 CONTINUE 61 : AJ2 = PROCON (XX,XX,NSTRS) 62 : AJ2 = SQRT(1.5D0*AJ2) 63 : C 64 : C------- CALCUL DU SEUIL 65 : R0 = XMAT(8) 66 : CD = XMAT(9) 67 : C K = XMAT(6), CK = XMAT(7) 68 : R = R0*((1.0D0-CD)+CD*ALPH2) 69 : SEUIL =(AJ2 - R)/( XMAT(6)*( 1.0D0 + XMAT(7)*ALPH2 ) ) 70 : C 71 : C------- CALCUL DE EPS0 72 : C N = XMAT(5) XPUISS(X,A,AMAX) CALCULE X**A 73 : IF (SEUIL.GT.0.0D0) THEN 74 : PPT = XPUISS(SEUIL,XMAT(5),AMAX) 75 : ELSE 76 : PPT = 0.0D0 77 : ENDIF 78 : C 79 : DO 71 I=1,NSTRS,1 80 : IF (PPT.EQ.0.0D0) THEN 81 : EPS0(I) = 0.0D0 82 : XX(I) = 0.0D0 83 : ELSE 84 : XX(I) = XX(I)/AJ2 85 : EPS0(I) = XX(I)*PPT*1.5D0 86 : ENDIF 87 : 71 CONTINUE 88 : C 89 : C------- CALCUL DE P POINT 90 : C Par definition : 91 : C PPT = SQRT(2.0/3.0*PROCON(EPS0,EPS0,NSTRS)) 92 : VARPT(1) = PPT 93 : VARPT(2) = PPT 94 : C 95 : C------- CALCUL DE LA NORMALE N = 2./3.*DEPSV/DP 96 : C en fait N // @ EPS0 et @ S - X 97 : C On utilisera N(I) = 2./3.*EPS0(I)/ PPT = XX(I) 98 : C 99 : C------- CALCUL DE XPT ( VARPT(4+1..NSTRS) ET XPM) 100 : C En fait on va differencier X ainsi : 101 : C D X = XPM * D P1**XM + XT * D T 102 : C 103 : C--- PREPARATION DU CALCUL DE XPM = CN.N - CX.X 104 : IF (PPT.NE.0.0D0) THEN 105 : C A = XMAT(11), A1 = XMAT(12) 106 : COEF1= XMAT(11)*ALPH2 + XMAT(12)*PROCON(EPSV0,XX,NSTRS) 107 : C C = XMAT(13), C1 = XMAT(14) 108 : COEF2= (XMAT(13)-XMAT(14)*ALPH4)* PROCON(VAR(5),XX,NSTRS) 109 : CN = (2.0D0/3.0D0*COEF1 - COEF2)*1.5D0 110 : CX =XMAT(14)*ALPH4 111 : C C0 = XMAT(23), P1M0 = XMAT(24) 112 : IF (VAR(5+NSTRS).GT.XMAT(24)) THEN 113 : CX = CX + (XMAT(23)*(VAR(5+NSTRS)-XMAT(24))) 114 : ENDIF 115 : ENDIF 116 : C 117 : C--- PREPARATION DU CALCUL DE XPT = - COX.X 118 : C G= XMAT(15), R = XMAT(16) 119 : XII = SQRT(1.5D0*PROCON(VAR(5),VAR(5),NSTRS)) 120 : COX = XMAT(15)*XPUISS(XII,XMAT(16)-1.0D0,AMAX) 121 : C 122 : C--- CALCUL DE XPM ET XPT 123 : C Cas ou PPT = 0 (et EPS0 aussi ) 124 : C alors XPM = 0.0 convient 125 : DO 72 I=1,NSTRS,1 126 : VARPT(4+I) = - COX*VAR(4+I) 127 : IF (PPT.NE.0.0D0) THEN 128 : XPM (I) = CN*XX(I) - CX*VAR(4+I) 129 : ELSE 130 : XPM(I) = 0.0D0 131 : ENDIF 132 : 72 CONTINUE 133 : C 134 : C------- DERIVEES DE ALPH2 ET ALPH4 : VARPT(3) ET VARPT(4) 135 : C C2,Q,G1,R1,BHETA = XMAT(18..22) 136 : C P,P1,ALPH2,ALPH4 = VAR (1..4) 137 : C Chargement cyclique ? si P1 < P1M 138 : IF (VAR(2).LT.VAR(5+NSTRS)) THEN 139 : AN = XMAT(17) 140 : P1M = VAR (5+NSTRS) 141 : CO = XMAT(18)* (XMAT(19)*XPUISS(P1M,AN,AMAX)-ALPH2)* PPT 142 : VARPT(3) = CO - XMAT(20)*XPUISS(ALPH2,XMAT(21),AMAX) 143 : IF(VAR(1).LT.AMIN) 144 : . WRITE(IOIMP,*) ' PROBLEME XXPT1 - VAR(1) = ',VAR(1) 145 : VARPT(4) = -XMAT(22)*PPT*ALPH4/(VAR(1)+AMIN) 146 : ELSE 147 : VARPT(3) = 0.0D0 148 : VARPT(4) = 0.0D0 149 : ENDIF 150 : C 151 : C------ CAS COQUE EPAISSE: RETOUR A 5 COMPOSANTES 152 : C 153 : IF (MFR.EQ.5) THEN 154 : EPSVPT(1)=EPS0(1) 155 : EPSVPT(2)=EPS0(2) 156 : EPSVPT(3)=EPS0(4) 157 : EPSVPT(4)=EPS0(5) 158 : EPSVPT(5)=EPS0(6) 159 : ELSE 160 : DO 02 I=1,NSTRS 161 : EPSVPT(I)=EPS0(I) 162 : 02 CONTINUE 163 : ENDIF 164 : C 165 : C------ ON RENTRE 166 : RETURN 167 : END 168 : 169 :
© Cast3M 2003 - All rights reserved.
Disclaimer