1 : C UPVAR2 SOURCE CHAT 05/01/13 03:59:57 5004 2 : C UPVAR2 SOURCE A1 12/01/12 12.15.00 3 : C _____________________________________________________________________ 4 : SUBROUTINE UPVAR2(EM,EB,EPSCRP,EPSPLU,EPSMIN,EPSEFF,EPSH,M, 5 : & ALF1,ALF2,NSTRS) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL *8 (A-H,O-Z) 8 : DIMENSION EM(*),EB(*),EPSCRP(*),EPSPLU(*),EPSMIN(*) 9 : DIMENSION DIF0(8) 10 : DATA X,Y/1.0D-06,0.0D0/ 11 : C _____________________________________________________________________ 12 : C THIS ROUTINE UPDATES THE INTERNAL VARIABLES 13 : C _____________________________________________________________________ 14 : C 15 : NS = NSTRS/2 16 : DO 10 I=1,NS 17 : DIF0(I)=EPSCRP(I)-EPSPLU(I) 18 : 10 CONTINUE 19 : PROM1=PROCON(DIF0,EM,NS) 20 : PROM2=PROCON(DIF0,DIF0,NS) 21 : DO 21 I=1,NS 22 : DIF0(I)=EPSCRP(I+NS)-EPSPLU(I+NS) 23 : 21 CONTINUE 24 : PROB1=PROCON(DIF0,EB,NS) 25 : PROB2=PROCON(DIF0,DIF0,NS) 26 : SPLU=PROM1+ ALF1*PROB1 27 : GPLU=PROM2+ ALF2*PROB2 28 : * IF(NS.EQ.2) THEN 29 : * P1 =(EPSCRP(1)-EPSPLU(1)) 30 : * P2 =(EPSCRP(2)-EPSPLU(2)) 31 : * P3 =(EPSCRP(3)-EPSPLU(3)) 32 : * P4 =(EPSCRP(4)-EPSPLU(4)) 33 : * SPLU= P1*SIG(1)+P2*SIG(2) + ALF1 * (P3*SIG(3)+P4*SIG(4)) 34 : * GPLU=(P1*P1+P2*P2+P1*P2) + ALF2 * (P3*P3 +P4*P4+P3*P4) 35 : DO 30 I=1,NS 36 : DIF0(I)=EPSCRP(I)-EPSMIN(I) 37 : 30 CONTINUE 38 : PROM1=PROCON(DIF0,EM,NS) 39 : PROM2=PROCON(DIF0,DIF0,NS) 40 : DO 40 I=1,NS 41 : DIF0(I)=EPSCRP(I+NS)-EPSMIN(I+NS) 42 : 40 CONTINUE 43 : PROB1=PROCON(DIF0,EB,NS) 44 : PROB2=PROCON(DIF0,DIF0,NS) 45 : SMIN=PROM1+ ALF1*PROB1 46 : GMIN=PROM2+ ALF2*PROB2 47 : * P1 =(EPSCRP(1)-EPSMIN(1)) 48 : * P2 =(EPSCRP(2)-EPSMIN(2)) 49 : * P3 =(EPSCRP(3)-EPSMIN(3)) 50 : * P4 =(EPSCRP(4)-EPSMIN(4)) 51 : * SMIN= P1*SIG(1)+P2*SIG(2) + ALF1*(P3*SIG(3)+P4*SIG(4)) 52 : * GMIN=(P1*P1+P2*P2+P1*P2) + ALF2*(P3*P3+P4*P4+P3*P4) 53 : * ELSE 54 : * P1 =(EPSCRP(1)-EPSPLU(1)) 55 : * P2 =(EPSCRP(2)-EPSPLU(2)) 56 : * P3 =(EPSCRP(3)-EPSPLU(3)) 57 : * P4 =(EPSCRP(4)-EPSPLU(4)) 58 : * P5 =(EPSCRP(5)-EPSPLU(5)) 59 : * P6 =(EPSCRP(6)-EPSPLU(6)) 60 : * SPL1= P1*SIG(1)+P2*SIG(2)+P3*SIG(3) 61 : * SPL2= P4*SIG(4)+P5*SIG(5)+P6*SIG(6) 62 : * SPLU= SPL1 + ALF1* SPL2 63 : ** GPL1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) 64 : ** GPL2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) 65 : * GPL1=(P1*P1+P2*P2+P1*P2+P3*P3) 66 : * GPL2=(P4*P4+P5*P5+P4*P5+P6*P6) 67 : * GPLU= GPL1 + ALF2* GPL2 68 : * P1 =(EPSCRP(1)-EPSMIN(1)) 69 : * P2 =(EPSCRP(2)-EPSMIN(2)) 70 : * P3 =(EPSCRP(3)-EPSMIN(3)) 71 : * P4 =(EPSCRP(4)-EPSMIN(4)) 72 : * P5 =(EPSCRP(5)-EPSMIN(5)) 73 : * P6 =(EPSCRP(6)-EPSMIN(6)) 74 : * SMI1= P1*SIG(1)+P2*SIG(2)+P3*SIG(3) 75 : * SMI2= P4*SIG(4)+P5*SIG(5)+P6*SIG(6) 76 : * SMIN= SMI1 + ALF1* SMI2 77 : ** GMI1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) 78 : ** GMI2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) 79 : * GMI1=(P1*P1+P2*P2+P1*P2+P3*P3) 80 : * GMI2=(P4*P4+P5*P5+P4*P5+P6*P6) 81 : * GMIN= GMI1 + ALF2 * GMI2 82 : * ENDIF 83 : * SPLU=SPLU*2.D0 84 : * SMIN=SMIN*2.D0 85 : GPLU=SQRT(2.D0*GPLU/3.0D0) 86 : GMIN=SQRT(2.D0*GMIN/3.0D0) 87 : N=0 88 : IF(GPLU.LT.X.AND.GMIN.LT.X) THEN 89 : N=1 90 : GO TO 13 91 : ELSE IF(SPLU.GE.Y.AND.SMIN.LT.Y) THEN 92 : N=1 93 : GO TO 13 94 : ELSE IF(SPLU.GT.Y.AND.SMIN.LE.Y) THEN 95 : N=1 96 : GO TO 13 97 : ELSE IF(SPLU.LT.Y.AND.SMIN.GE.Y) THEN 98 : N=2 99 : GO TO 13 100 : ELSE IF(SPLU.LE.Y.AND.SMIN.GT.Y) THEN 101 : N=2 102 : GO TO 13 103 : ELSE IF(SPLU.GT.Y.AND.SMIN.GT.Y.AND.GMIN.GT.(GPLU+X)) THEN 104 : N=2 105 : GO TO 13 106 : ELSE IF(SPLU.GT.Y.AND.SMIN.GT.Y.AND.GMIN.LE.(GPLU+X)) THEN 107 : N=1 108 : GO TO 13 109 : ELSE IF(SPLU.LT.Y.AND.SMIN.LT.Y.AND.GMIN.GT.(GPLU+X)) THEN 110 : N=1 111 : GO TO 13 112 : ELSE IF(SPLU.LT.Y.AND.SMIN.LT.Y.AND.GMIN.LE.(GPLU+X)) THEN 113 : N=2 114 : ENDIF 115 : 13 CONTINUE 116 : IF(N.EQ.0) GO TO 18 117 : IF(N.EQ.1) LL=0 118 : IF(N.EQ.2) LL=1 119 : IF(LL.EQ.M) GO TO 18 120 : IF(M.EQ.1) GO TO 15 121 : IF(GPLU.LE.EPSEFF) GO TO 18 122 : DO 14 L=1,NSTRS 123 : 14 EPSMIN(L)=EPSCRP(L) 124 : EPSEFF=GPLU 125 : GO TO 18 126 : 15 IF(GMIN.LE.EPSEFF) GO TO 18 127 : DO 16 L=1,NSTRS 128 : 16 EPSPLU(L)=EPSCRP(L) 129 : EPSEFF=GMIN 130 : 18 CONTINUE 131 : IF(LL.NE.0) GO TO 20 132 : * IF(NS.EQ.2) THEN 133 : * P1 =(EPSCRP(1)-EPSPLU(1)) 134 : * P2 =(EPSCRP(2)-EPSPLU(2)) 135 : * P3 =(EPSCRP(3)-EPSPLU(3)) 136 : * P4 =(EPSCRP(4)-EPSPLU(4)) 137 : * EPS1=(P1*P1+P2*P2+P1*P2) 138 : * EPS2=(P3*P3+P4*P4+P3*P4) 139 : * EPSH= EPS1 + ALF2 * EPS2 140 : * ELSE 141 : * P1 =(EPSCRP(1)-EPSPLU(1)) 142 : * P2 =(EPSCRP(2)-EPSPLU(2)) 143 : * P3 =(EPSCRP(3)-EPSPLU(3)) 144 : * P4 =(EPSCRP(4)-EPSPLU(4)) 145 : * P5 =(EPSCRP(5)-EPSPLU(5)) 146 : * P6 =(EPSCRP(6)-EPSPLU(6)) 147 : ** EPS1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) 148 : ** EPS2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) 149 : * EPS1=(P1*P1+P2*P2+P1*P2+P3*P3) 150 : * EPS2=(P4*P4+P5*P5+P4*P5+P6*P6) 151 : * EPSH= EPS1 + ALF2 * EPS2 152 : * ENDIF 153 : DO 50 I=1,NS 154 : DIF0(I)=EPSCRP(I)-EPSPLU(I) 155 : 50 CONTINUE 156 : PROM1=PROCON(DIF0,DIF0,NS) 157 : DO 60 I=1,NS 158 : DIF0(I)=EPSCRP(I+NS)-EPSPLU(I+NS) 159 : 60 CONTINUE 160 : PROB1=PROCON(DIF0,DIF0,NS) 161 : EPSH=PROM1+ ALF2*PROB1 162 : EPSH= SQRT(2.D0*EPSH/3.0D0) 163 : GO TO 22 164 : 20 CONTINUE 165 : * IF(NS.EQ.2) THEN 166 : * P1 =(EPSCRP(1)-EPSMIN(1)) 167 : * P2 =(EPSCRP(2)-EPSMIN(2)) 168 : * P3 =(EPSCRP(3)-EPSMIN(3)) 169 : * P4 =(EPSCRP(4)-EPSMIN(4)) 170 : * EPS1=(P1*P1+P2*P2+P1*P2) 171 : * EPS2=(P3*P3+P4*P4+P3*P4) 172 : * EPSH= EPS1 + ALF2 * EPS2 173 : * ELSE 174 : * P1 =(EPSCRP(1)-EPSMIN(1)) 175 : * P2 =(EPSCRP(2)-EPSMIN(2)) 176 : * P3 =(EPSCRP(3)-EPSMIN(3)) 177 : * P4 =(EPSCRP(4)-EPSMIN(4)) 178 : * P5 =(EPSCRP(5)-EPSMIN(5)) 179 : * P6 =(EPSCRP(6)-EPSMIN(6)) 180 : ** EPS1=(P1*P1+P2*P2+P1*P2+P3*P3/3.0D0) 181 : ** EPS2=(P4*P4+P5*P5+P4*P5+P6*P6/3.0D0) 182 : * EPS1=(P1*P1+P2*P2+P1*P2+P3*P3) 183 : * EPS2=(P4*P4+P5*P5+P4*P5+P6*P6) 184 : * EPSH= EPS1 + ALF2 * EPS2 185 : * ENDIF 186 : * EPSH= SQRT(EPSH/3.0D0)*2.0D0 187 : DO 51 I=1,NS 188 : DIF0(I)=EPSCRP(I)-EPSMIN(I) 189 : 51 CONTINUE 190 : PROM1=PROCON(DIF0,DIF0,NS) 191 : DO 61 I=1,NS 192 : DIF0(I)=EPSCRP(I+NS)-EPSMIN(I+NS) 193 : 61 CONTINUE 194 : PROB1=PROCON(DIF0,DIF0,NS) 195 : EPSH=PROM1+ ALF2*PROB1 196 : EPSH= SQRT(2.D0*EPSH/3.0D0) 197 : 22 CONTINUE 198 : M = LL 199 : C ---------------------------------------------------------------------- 200 : RETURN 201 : END 202 : 203 :
© Cast3M 2003 - All rights reserved.
Disclaimer