C UPVAR2 SOURCE CHAT 05/01/13 03:59:57 5004 C UPVAR2 SOURCE A1 12/01/12 12.15.00 C _____________________________________________________________________ SUBROUTINE UPVAR2(EM,EB,EPSCRP,EPSPLU,EPSMIN,EPSEFF,EPSH,M, & ALF1,ALF2,NSTRS) IMPLICIT INTEGER(I-N) IMPLICIT REAL *8 (A-H,O-Z) DIMENSION EM(*),EB(*),EPSCRP(*),EPSPLU(*),EPSMIN(*) DIMENSION DIF0(8) DATA X,Y/1.0D-06,0.0D0/ C _____________________________________________________________________ C THIS ROUTINE UPDATES THE INTERNAL VARIABLES C _____________________________________________________________________ C NS = NSTRS/2 DO 10 I=1,NS DIF0(I)=EPSCRP(I)-EPSPLU(I) 10 CONTINUE PROM1=PROCON(DIF0,EM,NS) PROM2=PROCON(DIF0,DIF0,NS) DO 21 I=1,NS DIF0(I)=EPSCRP(I+NS)-EPSPLU(I+NS) 21 CONTINUE PROB1=PROCON(DIF0,EB,NS) PROB2=PROCON(DIF0,DIF0,NS) SPLU=PROM1+ ALF1*PROB1 GPLU=PROM2+ ALF2*PROB2 * IF(NS.EQ.2) THEN * P1 =(EPSCRP(1)-EPSPLU(1)) * P2 =(EPSCRP(2)-EPSPLU(2)) * P3 =(EPSCRP(3)-EPSPLU(3)) * P4 =(EPSCRP(4)-EPSPLU(4)) * SPLU= P1*SIG(1)+P2*SIG(2) + ALF1 * (P3*SIG(3)+P4*SIG(4)) * GPLU=(P1*P1+P2*P2+P1*P2) + ALF2 * (P3*P3 +P4*P4+P3*P4) DO 30 I=1,NS DIF0(I)=EPSCRP(I)-EPSMIN(I) 30 CONTINUE PROM1=PROCON(DIF0,EM,NS) PROM2=PROCON(DIF0,DIF0,NS) DO 40 I=1,NS DIF0(I)=EPSCRP(I+NS)-EPSMIN(I+NS) 40 CONTINUE PROB1=PROCON(DIF0,EB,NS) PROB2=PROCON(DIF0,DIF0,NS) SMIN=PROM1+ ALF1*PROB1 GMIN=PROM2+ ALF2*PROB2 * P1 =(EPSCRP(1)-EPSMIN(1)) * P2 =(EPSCRP(2)-EPSMIN(2)) * P3 =(EPSCRP(3)-EPSMIN(3)) * P4 =(EPSCRP(4)-EPSMIN(4)) * SMIN= P1*SIG(1)+P2*SIG(2) + ALF1*(P3*SIG(3)+P4*SIG(4)) * GMIN=(P1*P1+P2*P2+P1*P2) + ALF2*(P3*P3+P4*P4+P3*P4) * ELSE * P1 =(EPSCRP(1)-EPSPLU(1)) * P2 =(EPSCRP(2)-EPSPLU(2)) * P3 =(EPSCRP(3)-EPSPLU(3)) * P4 =(EPSCRP(4)-EPSPLU(4)) * P5 =(EPSCRP(5)-EPSPLU(5)) * P6 =(EPSCRP(6)-EPSPLU(6)) * SPL1= P1*SIG(1)+P2*SIG(2)+P3*SIG(3) * SPL2= P4*SIG(4)+P5*SIG(5)+P6*SIG(6) * SPLU= SPL1 + ALF1* SPL2 ** GPL1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) ** GPL2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) * GPL1=(P1*P1+P2*P2+P1*P2+P3*P3) * GPL2=(P4*P4+P5*P5+P4*P5+P6*P6) * GPLU= GPL1 + ALF2* GPL2 * P1 =(EPSCRP(1)-EPSMIN(1)) * P2 =(EPSCRP(2)-EPSMIN(2)) * P3 =(EPSCRP(3)-EPSMIN(3)) * P4 =(EPSCRP(4)-EPSMIN(4)) * P5 =(EPSCRP(5)-EPSMIN(5)) * P6 =(EPSCRP(6)-EPSMIN(6)) * SMI1= P1*SIG(1)+P2*SIG(2)+P3*SIG(3) * SMI2= P4*SIG(4)+P5*SIG(5)+P6*SIG(6) * SMIN= SMI1 + ALF1* SMI2 ** GMI1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) ** GMI2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) * GMI1=(P1*P1+P2*P2+P1*P2+P3*P3) * GMI2=(P4*P4+P5*P5+P4*P5+P6*P6) * GMIN= GMI1 + ALF2 * GMI2 * ENDIF * SPLU=SPLU*2.D0 * SMIN=SMIN*2.D0 GPLU=SQRT(2.D0*GPLU/3.0D0) GMIN=SQRT(2.D0*GMIN/3.0D0) N=0 IF(GPLU.LT.X.AND.GMIN.LT.X) THEN N=1 GO TO 13 ELSE IF(SPLU.GE.Y.AND.SMIN.LT.Y) THEN N=1 GO TO 13 ELSE IF(SPLU.GT.Y.AND.SMIN.LE.Y) THEN N=1 GO TO 13 ELSE IF(SPLU.LT.Y.AND.SMIN.GE.Y) THEN N=2 GO TO 13 ELSE IF(SPLU.LE.Y.AND.SMIN.GT.Y) THEN N=2 GO TO 13 ELSE IF(SPLU.GT.Y.AND.SMIN.GT.Y.AND.GMIN.GT.(GPLU+X)) THEN N=2 GO TO 13 ELSE IF(SPLU.GT.Y.AND.SMIN.GT.Y.AND.GMIN.LE.(GPLU+X)) THEN N=1 GO TO 13 ELSE IF(SPLU.LT.Y.AND.SMIN.LT.Y.AND.GMIN.GT.(GPLU+X)) THEN N=1 GO TO 13 ELSE IF(SPLU.LT.Y.AND.SMIN.LT.Y.AND.GMIN.LE.(GPLU+X)) THEN N=2 ENDIF 13 CONTINUE IF(N.EQ.0) GO TO 18 IF(N.EQ.1) LL=0 IF(N.EQ.2) LL=1 IF(LL.EQ.M) GO TO 18 IF(M.EQ.1) GO TO 15 IF(GPLU.LE.EPSEFF) GO TO 18 DO 14 L=1,NSTRS 14 EPSMIN(L)=EPSCRP(L) EPSEFF=GPLU GO TO 18 15 IF(GMIN.LE.EPSEFF) GO TO 18 DO 16 L=1,NSTRS 16 EPSPLU(L)=EPSCRP(L) EPSEFF=GMIN 18 CONTINUE IF(LL.NE.0) GO TO 20 * IF(NS.EQ.2) THEN * P1 =(EPSCRP(1)-EPSPLU(1)) * P2 =(EPSCRP(2)-EPSPLU(2)) * P3 =(EPSCRP(3)-EPSPLU(3)) * P4 =(EPSCRP(4)-EPSPLU(4)) * EPS1=(P1*P1+P2*P2+P1*P2) * EPS2=(P3*P3+P4*P4+P3*P4) * EPSH= EPS1 + ALF2 * EPS2 * ELSE * P1 =(EPSCRP(1)-EPSPLU(1)) * P2 =(EPSCRP(2)-EPSPLU(2)) * P3 =(EPSCRP(3)-EPSPLU(3)) * P4 =(EPSCRP(4)-EPSPLU(4)) * P5 =(EPSCRP(5)-EPSPLU(5)) * P6 =(EPSCRP(6)-EPSPLU(6)) ** EPS1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) ** EPS2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) * EPS1=(P1*P1+P2*P2+P1*P2+P3*P3) * EPS2=(P4*P4+P5*P5+P4*P5+P6*P6) * EPSH= EPS1 + ALF2 * EPS2 * ENDIF DO 50 I=1,NS DIF0(I)=EPSCRP(I)-EPSPLU(I) 50 CONTINUE PROM1=PROCON(DIF0,DIF0,NS) DO 60 I=1,NS DIF0(I)=EPSCRP(I+NS)-EPSPLU(I+NS) 60 CONTINUE PROB1=PROCON(DIF0,DIF0,NS) EPSH=PROM1+ ALF2*PROB1 EPSH= SQRT(2.D0*EPSH/3.0D0) GO TO 22 20 CONTINUE * IF(NS.EQ.2) THEN * P1 =(EPSCRP(1)-EPSMIN(1)) * P2 =(EPSCRP(2)-EPSMIN(2)) * P3 =(EPSCRP(3)-EPSMIN(3)) * P4 =(EPSCRP(4)-EPSMIN(4)) * EPS1=(P1*P1+P2*P2+P1*P2) * EPS2=(P3*P3+P4*P4+P3*P4) * EPSH= EPS1 + ALF2 * EPS2 * ELSE * P1 =(EPSCRP(1)-EPSMIN(1)) * P2 =(EPSCRP(2)-EPSMIN(2)) * P3 =(EPSCRP(3)-EPSMIN(3)) * P4 =(EPSCRP(4)-EPSMIN(4)) * P5 =(EPSCRP(5)-EPSMIN(5)) * P6 =(EPSCRP(6)-EPSMIN(6)) ** EPS1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) ** EPS2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) * EPS1=(P1*P1+P2*P2+P1*P2+P3*P3) * EPS2=(P4*P4+P5*P5+P4*P5+P6*P6) * EPSH= EPS1 + ALF2 * EPS2 * ENDIF * EPSH= SQRT(EPSH/3.0D0)*2.0D0 DO 51 I=1,NS DIF0(I)=EPSCRP(I)-EPSMIN(I) 51 CONTINUE PROM1=PROCON(DIF0,DIF0,NS) DO 61 I=1,NS DIF0(I)=EPSCRP(I+NS)-EPSMIN(I+NS) 61 CONTINUE PROB1=PROCON(DIF0,DIF0,NS) EPSH=PROM1+ ALF2*PROB1 EPSH= SQRT(2.D0*EPSH/3.0D0) 22 CONTINUE M = LL C ---------------------------------------------------------------------- RETURN END