C ********************* 00000001 C * SUBROUTINE PART1 * PART 1 00000002 C * VARIANT 'ALBEAL' * UNFOLDED CHAIN: NELICES & ALL BETA-SHEETS 00000003 C ********************* 00000004 SUBROUTINE PART1(NL1,NL2,CPEN) 00000005 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/DSTR/MAL,MBC,MST,MT1 00000006 1,MINB2,MAXB2,MBE1(100),MEN1(100),MBE2(50),MEN2(50),MBE3(50),MEN3(500000007 20)/VECT/V(1800),V1(1800),VV1(100,2),VV(5),TRA(8,8),NZ,PFN/INOU/KPR00000008 3OU1,AM(40),EVSTR(22),JA(507),B(500)/ENER2/KNSP,KSIG,KTES,KPRIN,KPR00000009 4OU2/PART/IP1,IP2,PROGN(2)/CT/NZON,NBEG,N91/MLPP/MLPP,MAXBP,LP,LPP,00000010 5LPE,SIGP(5)/ENER/SIG(9) 00000011 DIMENSION PROG1(2),CPEN(NL1,NL2) 00000012 DATA PROG1/'*ALB','EAL*'/ 00000013 PROGN(1)=PROG1(1) 00000014 PROGN(2)=PROG1(2) 00000015 C 00000020 C MAIN >>...>> PART1(ALBEAL)-----+--------+--------+-------+ 00000021 C I I I I I 00000022 C ENESPP ENBET MULTV1 MULTV2 SCAL 00000023 C 00000024 C + 'DISC', ENTRIES: 'RITE','RID','FAIND' 00000026 C 00000027 C THE RESULS ARE: THE PROBABILITIES OF ALPHA-HELICAL, TURN, LOOP 00000028 C AND BETA-STRAND STATE FOR EVERY CHAIN RESIDUE FOR UNFOLDED 00000029 C PROTEIN CHAIN 00000030 C 00000031 NZ=1342 00000037 204 FORMAT(' *** UNFOLDED CHAIN: HELICES, BETA-SHEETS (LENGTH OF STR00000038 1ANDS: ',I2,'-',I2,',ANTIPARALLEL; ',I2,'-',I2,',PARALLEL), TURNS'/00000039 27X,14('*')) 00000040 IF(MINB.LT.2) MINB=2 00000041 IF(MAXB.GT.62) MAXB=62 00000042 IF(MAXB.GT.50.AND.MBE1(1).NE.0) MAXB=50 00000043 IF(MAXB.LE.0) MAXB=20 00000044 IF(MAXBP.LE.0) MAXBP=10 00000045 MINB2=(N1-1)/2 00000046 MAXB=MIN0(MINB2,MAXB) 00000047 IF(MAXBP.GE.MINB2) MAXBP=MINB2-1 00000048 MST=MAL 00000049 MINB=2*(MINB/2) 00000050 MINB2=MINB+2 00000051 MEN1(1)=2 00000052 IF(MAXB.GE.2) GOTO 1001 00000053 MEN1(1)=1 00000054 1002 FORMAT(' * UNFOLDED CHAIN : FREE ENERGY OF SECONDARY STRUCTURE 00000055 *FORMATION = -',F6.1,' KT'/70X,'=========='/) 00000056 C IF MAXB (MAXBP) =1, - NO CALCULATIONS FOR ANTI- OR PARALLEL SHEET 00000057 1001 IF(MAXBP.GE.2) GOTO 1000 00000058 MEN1(1)=0 00000059 332 FORMAT(68H ||||| ONLY ANTIPARALLEL BETA-STRUCTURE AND HELICES AR00000060 1E CONSIDERED,40X,5H||||/) 00000061 333 FORMAT(64H ||||| ONLY PARALLEL BETA-STRUCTURE AND HELICES ARE CO00000062 1NSIDERED,44X,5H|||||/) 00000063 331 FORMAT(' *** UNFOLDED CHAIN : ONLY HELICES '/7X,14('*')/) 00000064 1000 IF(MAXBP.GT.15) MAXBP=15 00000065 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) PRINT 331 00000066 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 209 00000067 MAXBP=MAX0(MAXBP,MINB2) 00000068 MAXB=MAX0(MAXB,MAXBP) 00000069 MAXBP=2*(MAXBP/2) 00000070 MAXB=2*(MAXB/2) 00000071 MAXB=MAX0(MAXB,MINB2) 00000072 LP=MAXBP-2 00000073 PRINT 204,MINB,MAXB,MINB,MAXBP 00000074 IF(MEN1(1).EQ.0) PRINT 332 00000075 IF(MEN1(1).EQ.1) PRINT 333 00000076 MAXB2=MAXB-2 00000077 330 FORMAT(65H ||ONLY BETA-HAIRPINS, NO BETA-SHEETS ARE TAKEN INTO A00000080 1CCOUNT ||,45X,10H**********) 00000081 IF(MBE1(1).NE.0) MBE1(1)=1 00000082 IF(MBE1(1).GE.1) PRINT 330 00000083 MTN=4 00000084 MLP=MTN+1 00000085 C 00000086 CALL ENESPP 00000087 C 00000114 MT1=MAL+2*MAXB 00000115 DO 100 I=2,MAXB 00000116 MBE1(I)=0 00000117 100 MEN1(I)=0 00000118 DO 101 I=MINB,MAXB 00000119 MBE1(I)=MT1+(I-MINB)*MLP+1 00000120 101 MEN1(I)=MBE1(I)+MLP-1 00000121 MT2=MEN1(MAXB) 00000122 MBC=MT2 00000123 C 00000124 IF(MBE1(1).GE.1) GOTO 208 00000149 C 00000162 DO 102 I=1,MAXB 00000163 MBE2(I)=0 00000164 MEN2(I)=0 00000165 MBE3(I)=0 00000166 102 MEN3(I)=0 00000167 MBE2(MINB)=MT2+1 00000168 MEN2(MINB)=MT2+MINB 00000169 I1=MINB+2 00000170 DO 103 I=I1,MAXB,2 00000171 MBE2(I)=MBE2(I-2)+I-2 00000172 103 MEN2(I)=MEN2(I-2)+I 00000173 MT3=MEN2(MAXB) 00000174 C 00000175 MBE3(MINB)=MT3+1 00000181 MEN3(MINB)=MT3+MLP 00000182 DO 104 I=I1,MAXB2,2 00000183 MBE3(I)=MEN3(I-2)+MAXB+1 00000184 104 MEN3(I)=MEN3(I-2)+MAXB+MLP 00000185 MBC=MEN3(MAXB2)+MAXB 00000186 C 00000219 208 CONTINUE 00000220 MST=MBC+MAXB+MAXB/2 00000221 C 00000227 LPE=MST 00000228 C 00000229 LPP=LPE+8*MAXBP 00000237 C 00000238 MST=LPP+8*MAXBP/2 00000241 C 00000242 206 FORMAT(/' DECREASE MAXB OR INCREASE MINB: MST=',I5,' IS GREATE00000243 1R THEN LIMIT=',I5,' ||| PART 1 IS OMITTED |||'//) 00000244 IF(MST.LE.NZ) GOTO 209 00000245 PRINT 206,MST,NZ 00000246 GOTO 207 00000247 209 CONTINUE 00000248 C 00000249 C IZING-LIKE MODEL 00000250 C ---------------- 00000251 C 00000252 C //Y // 00000253 C N1 00000254 DO 111 J=2,MST 00000257 111 V(J)=0. 00000258 V(1)=1. 00000259 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 992 00000260 V(MT1)=1. 00000261 NZ=1 00000262 CALL RITE(NZ,1800,V) 00000263 GOTO 995 00000264 992 DO 991 I=1,MST 00000265 991 CPEN(N1,I+6)=V(I) 00000266 C 00000267 C //Y // 00000268 C N1-1 00000269 995 DO 112 J=1,MST 00000270 112 V1(J)=V(J) 00000271 V(1)=0. 00000272 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 997 00000273 V(MT1)=0. 00000274 C 00000275 C //Y //,...,//Y // 00000276 C N1-1 1 00000277 997 DO 113 NN=2,N1 00000278 N=N1-NN+1 00000279 NZ=NN 00000280 CALL ENBET(NL1,NL2,CPEN) 00000281 113 CALL MULTV1(NL1,NL2,CPEN) 00000282 C 00000283 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 996 00000288 DO 114 I=1,2 00000289 DO 114 K=1,MAXB 00000290 114 VV1(K,I)=0. 00000291 DO 115 I=1,5 00000292 115 VV(I)=0. 00000293 C 00000294 C //X // 00000295 C 1 00000296 996 DO 116 J=2,MST 00000299 116 V1(J)=0. 00000300 V1(1)=1. 00000301 V1(2)=.5 00000302 IF(N91.GE.1) V1(2)=1. 00000303 IF(N91.LE.-1) V1(2)=0. 00000304 V1(MAL+1)=1. 00000305 NN=1 00000306 NZ=N1 00000307 C 00000308 C //X //*//Y //; W (J) 00000309 C 1 1 1 00000310 CALL SCAL(NL1,NL2,CPEN) 00000311 C 00000312 C //X //, //X //*//Y //, W (J);..;//X //, //X //*//Y //, W 00000313 C 2 2 2 2 N1 N1 N1 N1 00000314 DO 117 NN=2,N1 00000315 N=NN-1 00000316 NZ=N1-N 00000317 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 998 00000318 CALL FAIND(NZ,1800,V) 00000319 998 CALL MULTV2(NL1,NL2,CPEN) 00000320 117 CALL SCAL(NL1,NL2,CPEN) 00000321 IF(KPROU1.GE.0) PRINT 1002,PFN 00000322 207 RETURN 00000323 END 00000324 C ********************** 00000001 C * SUBROUTINE ENESPP * PARALLEL BETA-SHEET STABILITY PARAMETERS 00000002 C ********************** 00000003 SUBROUTINE ENESPP 00000004 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/INOU/KPROU1,AM(40) 00000005 1/ENER/SIG(9),ELP(20),CE(5,20),SPAR(6,20,20),SI(18,20),QSI(18,2) 00000006 2/ENER1/SH(9,20),SB(3,20),SPEV(3,20),ZNEL(20),EPAR(19),RAD(20), 00000007 3SH1(20),SH2(20),SISH(20),FKIN(20),FETURN(20),FEEDGE(20),FEBET(20),00000008 4SIS1(20,2),DTZN(20),DTH(20),DTA(20),UR(20,6),DTP(20),DXX(20), 00000009 5SPARS(2,20,20),SBP(3,20),SPEP(3,20),EL(4,19),CEP(5,20) 00000010 */MLPP/MLPP,MAXBP,LP,LPP,LPE,SIGP(5)/ENER2/KXXX(4),KPROU2 00000011 4 FORMAT(20(2X,A4)) 00000012 5 FORMAT(20F6.2) 00000013 6 FORMAT(/70H PARALLEL BETA STABILITY PARAMETERS FOR RESIDUES IN '00000014 1AVERAGE' SHEET: /114H 1)(PAR./ANTIPAR)**.5 2)EDGE, NH-,CO- OUT 00000015 23)EDGE, NH-,CO- IN 4)ADJOINING, NH-,CO- OUT, 5)ADJOINING, NH-,CO-00000016 3 IN/) 00000017 8 FORMAT(62H PARALLEL BETA SHEET STABILITY PARAMETERS /SBP/: 1=INT00000018 1ERNAL,,27X,5H|-|-|/66H SPECIFIC EDGE EFFECTS: 2=EDGE, NH-,CO- OUT00000019 2, 3=EDGE, NH-,CO- IN ,3X,11H(EFFECTIVE),9X,5H2 1 3 /89X,5H|/|/|) 00000020 12 FORMAT(/) 00000021 C 00000022 SSI=SQRT(SIG(8)*SIG(9)) 00000023 IF(SIGP(2).LE.SSI) GOTO 77 00000024 SIGP(2)=SSI 00000025 PRINT 7,SIG(8),SIG(9),SIGP(2) 00000026 77 CONTINUE 00000027 7 FORMAT(/' *|*|* INTERROGATION: SIGP(2) = (SIG(8)*SIG(9))**.5 = (00000028 *',F4.3,'*',F4.3,')**.5 = ',F4.3,' IS TAKEN '/ 00000029 *34X,'TO AVOID OVERESTIMATION OF PARALLEL BETA-SHEETS'/) 00000030 C 00000031 DO 9 L=1,20 00000033 DO 19 I=2,3 00000034 SBP(I,L)=CE(I,L)*SBP(I,L)*SBP(1,L)*SIGP(2)/(SB(I,L)*SB(1,L)*SIG(I+00000035 16)) 00000036 CEP(I,L)=SBP(I,L)*SPEP(I,L) 00000037 CEP(I+2,L)=CEP(I,L)/CE(1,L) 00000038 19 CONTINUE 00000039 Q=CE(2,L)*CE(3,L)/CE(1,L) 00000040 Q1=SBP(1,L)/SB(1,L) 00000041 SBP(1,L)=Q*Q1 00000042 CEP(1,L)=SQRT(Q1*SPEP(1,L)/SPEV(1,L)) 00000043 9 CONTINUE 00000044 IF(KPROU1.LE.0.AND.KPROU2.LE.0) GOTO 11 00000045 PRINT 12 00000046 PRINT 6 00000047 PRINT 4,(AM(L),L=1,20) 00000048 PRINT 5,((CEP(I,L),L=1,20),I=1,5) 00000049 PRINT 12 00000050 PRINT 8 00000051 PRINT 4,(AM(L),L=1,20) 00000052 PRINT 5,((SBP(I,L),L=1,20),I=1,3) 00000053 PRINT 12 00000054 11 CONTINUE 00000055 RETURN 00000056 END 00000057 C ********************* 00000001 C * SUBROUTINE ENBET * STABILITY OF STRUCTURE ELEMENTS 00000002 C * VARIANT 'ALBEAL' * 00000003 C ********************* 00000004 SUBROUTINE ENBET(NL1,NL2,CPEN) 00000005 DIMENSION ESTR(62,6),CPEN(NL1,NL2),EP(2),ESTP(15,2),ESQ(15,3) 00000006 *,PEEP(2) 00000007 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/NLL/N8(2),Y(3),QPR(20)/ENER/SIG(900000008 1),ELP(20),CE(5,20),SPAR(6,20,20)/VECT/V(1800),V1(1800),VV1(100,2),00000009 2VV(5),TRA(8,8),NZ,PFN/INOU/KPROU1,AM(40),EVSTR(22),JA(507),B(500),00000010 3CEE(5,20)/CT/N88(4),LPRO,LGLY/ENER1/X(1755),CEP(5,20) 00000011 4 /DSTR/MAL,MBC,MST,MT1,MINB2,MAXB2,MBE1(100),MEN1(100) 00000012 * /MLPP/MLPP,MAXBP,LP,LPP,LPE,SIGP(5) 00000013 EQUIVALENCE(V(1424),QQ),(V(1425),P11),(V(1426),PL),(V(1427),ESTR(100000014 1)),(V(1394),ESTP(1)),(V(1393),PL1),(V(1392),PH1),(V(1391),PNA),(V(00000015 21390),PCA),(V(1389),PLY),(V(1388),PCAY),(V(1343),ESQ(1)) 00000016 C 00000017 C //U // : NON-ZERO MATRIX ELEMENTS 00000019 C N,N+1 00000020 C 00000021 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 990 00000022 L=JA(N) 00000023 C 00000024 QQ=CPEN(N,7) 00000027 C 00000028 P11=CE(1,L)*QQ 00000031 C 00000032 M=N1-1 00000043 IF(N.LT.M) GOTO 49 00000044 Q20=EXP(3.14*3.14/4.)*2.8 00000045 QEN=-ALOG(SIG(7)) 00000046 PL1=QEN 00000047 PL10=QEN 00000048 PLP=VV(5)*2.72 00000049 PLP55=PLP*QEN 00000050 PH1=SIG(7)*SIGP(5) 00000051 PLP56=PLP55*SIGP(1)/SIG(6) 00000052 SIGPA=Q20*SIGP(4)/(QEN*SIG(1)) 00000053 Q=SIGP(4)/SIG(1)-1. 00000054 IF(Q.LT.0) Q=0. 00000055 QEEN=1./(1.+SQRT(SIG(1))*Q) 00000056 49 CONTINUE 00000057 K1=MTN+2 00000058 DO 50 I=1,K1 00000059 DO 50 K=2,MAXB 00000060 50 ESTR(K,I)=0. 00000061 IF(MEN1(1).EQ.1) GOTO 57 00000062 DO 51 IT=1,MTN 00000063 ESTR(1,IT)=CPEN(N,7+IT) 00000064 C 00000071 I=N1-N-IT 00000072 MAXIM=MIN0(MAXB,N,I) 00000073 IF(MAXIM.LT.2) GOTO 51 00000074 KEV=1 00000075 DO 52 K=2,MAXIM 00000076 KEV=1-KEV 00000077 K1=N+1-K 00000078 K2=N+IT+K 00000079 LN1=JA(K1) 00000080 LN2=JA(K2) 00000081 LN11=LGLY 00000082 LN13=JA(K1+1) 00000083 LN21=JA(K2-1) 00000084 LN23=LGLY 00000085 IF(K1.LE.1) GOTO 53 00000086 LN11=JA(K1-1) 00000087 53 IF(K2.GE.N1) GOTO 62 00000088 LN23=JA(K2+1) 00000089 62 ESTR(K,IT)=ESTR(K-1,IT)*CE(4+KEV,LN1)*CE(2+KEV,LN2)*CPEN(K2,7)*SPA00000090 1R(1+KEV,LN1,LN2)*SPAR(3+KEV,LN11,LN21)*SPAR(5+KEV,LN13,LN23) 00000091 ESTR(K-1,IT)=ESTR(K-1,IT)*(KEV+(1-KEV)*QPR(LN2)) 00000092 52 CONTINUE 00000093 51 CONTINUE 00000094 C 00000104 K1=N1-N-1 00000105 MAXIM=MIN0(MAXB,N,K1) 00000106 IF(MAXIM.LT.2) GOTO 54 00000107 KEV=1 00000108 LN1=JA(N) 00000109 LN13=JA(N+1) 00000110 Q=CEE(2,LN13)*CPEN(N+1,7)/ELP(LN13)*QPR(JA(N+2)) 00000111 ESTR(1,MLP)=P11*CEE(5,LN1)*(1.+Q) 00000112 DO 55 K=2,MAXIM 00000113 KEV=1-KEV 00000114 LN1=JA(N+1-K) 00000115 ESTR(K,MLP)=ESTR(K-1,MLP)*CEE(4+KEV,LN1) 00000116 55 CONTINUE 00000117 54 K1=K1+1 00000118 K2=N-1 00000119 MAXIM=MIN0(MAXB,K1,K2) 00000120 IF(MAXIM.LT.2) GOTO 57 00000121 LN2=JA(N+MLP) 00000122 LN21=JA(N+MLP-1) 00000123 KEV=1 00000124 PLP5=PLP55 00000125 DO 56 I=1,MLP 00000126 LN1=JA(N-1+I) 00000127 56 PLP5=PLP5*ELP(LN1) 00000128 ESTR(1,MLP+1)=PLP5*(1.+CEE(2,LN21)*CPEN(N+MLP-1,7)/ELP(LN21))*CEE(00000129 13,LN2)*CPEN(N+MLP,7)*0.5 00000130 DO 58 K=2,MAXIM 00000131 KEV=1-KEV 00000132 K1=N+MLP-1+K 00000133 LN2=JA(K1) 00000134 ESTR(K,MLP+1)=ESTR(K-1,MLP+1)*CEE(2+KEV,LN2)*CPEN(K1,7) 00000135 ESTR(K-1,MLP+1)=ESTR(K-1,MLP+1)*(KEV+(1-KEV)*QPR(LN2)) 00000136 58 CONTINUE 00000137 C 00000138 57 PL=ELP(L) 00000141 C 00000142 990 ESTR5=ESTR(1,5) 00000145 DO 59 I=1,6 00000146 59 ESTR(1,I)=CPEN(N,I) 00000147 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 103 00000148 C 00000149 DO 102 K=1,MAXBP 00000150 ESQ(K,1)=1. 00000151 DO 102 I=1,2 00000152 ESQ(K,I+1)=0. 00000153 102 ESTP(K,I)=0. 00000154 C 00000156 PNA=SIGPA*EXP(CPEN(N,22))*PH1 00000157 PCA=EXP(CPEN(N,16))*PH1 00000158 PCAY=PCA*QEN/Q20 00000159 PLY=QEEN*PL 00000160 C 00000162 IF(MEN1(1).EQ.0) GOTO 103 00000165 JJ=17 00000166 K1=N1-N-1 00000167 MAXIM=MIN0(MAXBP,N,K1) 00000168 IF(MAXIM.LT.2) GOTO 64 00000169 KEV=1 00000170 LN1=JA(N) 00000171 LN13=JA(N+1) 00000172 PCA=PCA*ELP(LN13) 00000173 Q=CEP(2,LN13)*(CPEN(N+1,7)/ELP(LN13))*CPEN(N+1,JJ)*QPR(JA(N+2)) 00000174 ESTP(1,1)=P11*CEP(5,LN1)*(1.+Q)*CPEN(N,JJ) 00000175 QSEQ=CEP(1,LN1)*CPEN(N,JJ) 00000176 ESQ(1,2)=QSEQ*ESTR5 00000177 ESQ(1,1)=1. 00000178 DO 65 K=2,MAXIM 00000179 KEV=1-KEV 00000180 K2=N+1-K 00000181 LN1=JA(K2) 00000182 QSEQ=CEP(1,LN1)*CPEN(K2,JJ)*QSEQ 00000183 ESQ(K,2)=QSEQ*ESTR(K,5) 00000184 ESTP(K,1)=ESTP(K-1,1)*CEP(4+KEV,LN1)*CPEN(K2,JJ) 00000185 ESQ(K,1)=ESTP(K,1)/ESQ(K,2) 00000186 65 CONTINUE 00000187 64 K1=K1+1 00000188 K2=N-3 00000189 MAXIM=MIN0(MAXBP,K1,K2) 00000190 IF(MAXIM.LT.2) GOTO 103 00000191 LN2=JA(N+1) 00000192 QSEQ=CEP(1,LN2)*CPEN(N+1,JJ) 00000193 PEEP(1)=PLP56*PL*CEE(3,LN2)*CPEN(N+1,7)*QSEQ 00000194 PEEP(2)=PLP56*PL*CEE(2,LN2)*CPEN(N+1,7)*QSEQ 00000195 EP(1)=PLP56*PL*CEP(3,LN2)*CPEN(N+1,7)*CPEN(N+1,JJ) 00000196 EP(2)=PLP56*PL*CEP(2,LN2)*CPEN(N+1,7)*CPEN(N+1,JJ) 00000197 KEV=1 00000198 DO 68 K=1,MAXIM 00000199 KEV=1-KEV 00000200 K1=N+K+1 00000201 ESQ(K,3)=PEEP(2-KEV)*.5 00000202 ESTP(K,2)=EP(2-KEV)*.5 00000203 IF(K1.GT.N1) GOTO 68 00000204 LN2=JA(K1) 00000205 Q=QPR(LN2) 00000206 PL22=3.*PL10*FLOAT(K) 00000207 EQE=EXP(-PL22)/(1.+PL22) 00000208 ESTP(K,2)=ESTP(K,2)*(Q+CEP(3,LN2)*CPEN(K1,7)*CPEN(K1,JJ))*EQE 00000209 ESQ(K,3)=ESQ(K,3)*(Q+CEE(3,LN2)*CPEN(K1,7)*CPEN(K1,JJ))*EQE 00000210 QSEQ=CEP(1,LN2)*CPEN(K1,JJ) 00000211 PEEP(1)=PEEP(1)*CEE(2+KEV,LN2)*CPEN(K1,7)*QSEQ 00000212 PEEP(2)=PEEP(2)*CEE(3-KEV,LN2)*CPEN(K1,7)*QSEQ 00000213 EP(1)=EP(1)*CEP(2+KEV,LN2)*CPEN(K1,7)*CPEN(K1,JJ) 00000214 EP(2)=EP(2)*CEP(3-KEV,LN2)*CPEN(K1,7)*CPEN(K1,JJ) 00000215 68 CONTINUE 00000216 C IF(N.NE.52) GOTO 103 00000217 C PRINT 1111,N,PL1,PLY,PH1,PNA,PCA,PCAY 00000218 C PRINT 1112,(ESTP(K,1),K=1,5),(ESTP(K,2),K=1,5) 00000219 C * ,(ESTR(K,1),K=1,5),(ESTR(K,2),K=1,5) 00000220 C * ,(ESTR(K,3),K=1,5),(ESTR(K,4),K=1,5) 00000221 C * ,(ESTR(K,5),K=1,5),(ESTR(K,6),K=1,5) 00000222 C *,(ESQ(K,1),K=1,5),(ESQ(K,2),K=1,5),(ESQ(K,3),K=1,5) 00000223 C1111 FORMAT(' N=',I2,' PL1=',F4.2,' PLY=',F5.2,' PH1=',F4.2, 00000224 C *' PNA=',E10.2,' PCA=',E10.2,' PCAY=',E10.2) 00000225 C1112 FORMAT(' ESTP=, ESTR=, ESQ= '/(10E10.2)) 00000226 103 RETURN 00000227 END 00000228 C ********************** 00000001 C * SUBROUTINE MULTV1 * //Y // = //U //*//Y // 00000002 C * VARIANT 'ALBEAL' *** N N,N+1 N 00000003 C ********************** 00000004 SUBROUTINE MULTV1(NL1,NL2,CPEN) 00000005 DIMENSION ESTR(62,6),ESTP(15,2),CPEN(NL1,NL2) 00000006 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/DSTR/MAL,MBC,MST,MT1 00000007 1,MINB2,MAXB2,MBE1(100),MEN1(100),MBE2(50),MEN2(50),MBE3(50),MEN3(500000008 20)/VECT/V(1800),V1(1800),VV1(100,2),VV(5),TRA(8,8),NZ,PFN 00000009 3/MLPP/MLPP,MAXBP,LP,LPP,LPE,SIGP(5)/ENER/SIG(9),PNAP1(2945),PNAP 00000010 EQUIVALENCE(V(1424),QQ),(V(1425),P11),(V(1426),PL),(V(1427),ESTR(100000011 1)),(V(1394),ESTP(1)),(V(1393),PL1),(V(1392),PH1),(V(1391),PNA),(V(00000012 21390),PCA),(V(1389),PLY),(V(1388),PCAY) 00000013 C 00000014 C //Y (J)// = //U (J,J1)// * //Y (J1)// (SUM OVER J1) 00000018 C N N,N+1 N+1 00000019 C 00000020 C V <---> //Y //, V1 <---> //Y // ; //U (J,J1)// =/= 0 00000021 C N N+1 N,N+1 00000022 C 00000023 DO 60 J=1,8 00000026 P=1. 00000027 IF (J-2) 61,61,62 00000028 62 P=ESTR(1,J-2) 00000029 61 DO 60 J1=1,8 00000030 Q=TRA(J,J1) 00000031 IF (Q) 60,60,63 00000032 63 V(J)=V(J)+V1(J1)*P 00000033 60 CONTINUE 00000034 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 990 00000035 C 00000036 V(MAL)=V(MAL)+V1(MAL+1)*ESTR(1,6) 00000039 C 00000040 V(1)=V(1)+V1(MAL+1) 00000043 C 00000044 V(MT1)=V1(MAL+1) 00000047 C 00000048 V(MT1)=V(MT1)+V1(1) 00000051 C 00000052 V(MT1)=V(MT1)+V1(2) 00000055 C 00000056 I1=MAL+1 00000059 I2=MAL+MAXB-1 00000060 DO 64 J=I1,I2 00000061 64 V(J)=V1(J+1)*P11 00000062 C 00000063 I1=MAL+MAXB+1 00000066 I2=MAL+2*MAXB-1 00000067 DO 65 J=I1,I2 00000068 65 V(J)=V1(J+1) 00000069 C 00000070 DO 66 I=MINB,MAXB 00000073 I1=MBE1(I)+1 00000074 I2=MEN1(I)-1 00000075 DO 66 J=I1,I2 00000076 66 V(J)=V1(J+1) 00000077 C 00000083 DO 67 I=MINB,MAXB 00000084 J=MBE1(I) 00000085 J2=MBC+I 00000086 V(J2)=V1(J2)*PL+V1(J+1)*ESTR(I,6) 00000087 V(J)=(V1(J)+V1(J2))*PL 00000088 V(J)=V(J)+V1(J+1)*ESTR(I,6) 00000089 67 CONTINUE 00000090 DO 671 I=MINB,MAXBP 00000091 C 00000092 J=LPE+8*(I-1) 00000093 PL22=3.*FLOAT(I)*PL1 00000094 PL22=1.+.5*PL22*PL1/(1.+PL22) 00000095 V(J+1)=V(J+1)+(V1(J+7)+V1(J+4))*PL*PL22 00000096 V(J+2)=V(J+2)+(V1(J+2)+V1(J+4))*PLY 00000097 V(J+4)=V(J+4)+V1(J+5)*PNA 00000098 V(J+5)=V(J+5)+(V1(J+5)+V1(J+6))*PH1*PL22 00000099 V(J+6)=V(J+6)+(V1(J+3)+V1(J+8))*PCA+V1(J+2)*PCAY 00000100 V(J+7)=V(J+7)+(V1(J+4)+V1(J+7)+V1(J+8))*PL*PL22 00000101 V(J+8)=V(J+8)+(V1(J+3)+V1(J+8))*PL*PL22 00000102 C 00000103 J=J+3 00000104 J1=MT1+1-I 00000105 671 V(J)=V(J)+V1(J1)*ESTP(I,2) 00000106 C 00000107 DO 68 I=MINB,MAXB 00000110 J=MEN1(I) 00000111 J1=MT1+1-I 00000112 68 V(J)=V1(J1) 00000113 C 00000122 DO 70 IT=1,MLP 00000123 C 00000126 I=N1-N-IT 00000127 MAXIM=MIN0(MAXB,N,I) 00000128 IF(MAXIM.LT.MINB) GOTO 70 00000129 DO 71 K=MINB,MAXIM 00000130 J1=MEN1(K)+1-IT 00000131 71 V(MAL+K)=V(MAL+K)+V1(J1)*ESTR(K,IT) 00000132 70 CONTINUE 00000133 I=N1-N-5 00000134 MAXIP=MIN0(MAXBP,N,I) 00000135 IF(MAXIP.LT.MINB) GOTO 701 00000136 DO 711 K=MINB,MAXIP 00000137 C 00000138 J1=LPE+8*(K-1)+1 00000139 711 V(MAL+K)=V(MAL+K)+V1(J1)*ESTP(K,1) 00000140 701 CONTINUE 00000141 C 00000142 IF(MBE1(1).GE.1) GOTO 208 00000146 C 00000148 DO 75 I=MINB,MAXB,2 00000149 J=MEN1(I) 00000150 J1=MBE2(I) 00000151 75 V(J)=V(J)+V1(J1)*PNAP 00000152 DO 751 I=MINB,MAXBP,2 00000153 C 00000154 J=LPE+8*(I-1)+3 00000155 J1=MBE2(I) 00000156 751 V(J)=V(J)+V1(J1)*ESTP(I,2)*PNAP 00000157 C 00000158 DO 76 I=MINB,MAXB,2 00000161 I1=MBE2(I) 00000162 I2=MEN2(I)-1 00000163 DO 76 J=I1,I2 00000164 76 V(J)=V1(J+1) 00000165 C 00000166 DO 77 I=MINB,MAXB2,2 00000171 I1=MBE3(I)+1 00000172 I2=MEN3(I)+I-1 00000173 DO 78 J=I1,I2 00000174 78 V(J)=V1(J+1) 00000175 V(I2+1)=V1(I2+2)*PNAP 00000176 I1=I2+2 00000177 I2=MEN3(I)+MAXB-1 00000178 DO 77 J=I1,I2 00000179 77 V(J)=V1(J+1)*P11 00000180 C 00000186 DO 79 I=MINB,MAXB2,2 00000187 J=MBE3(I) 00000188 J2=MBC+MAXB+I/2 00000189 V(J2)=V1(J2)*PL+V1(J+1)*ESTR(I,6) 00000190 V(J)=(V1(J)+V1(J2))*PL 00000191 V(J)=V(J)+V1(J+1)*ESTR(I,6) 00000192 79 CONTINUE 00000193 DO 761 I=MINB,LP,2 00000194 C 00000195 J=LPP+8*(I/2-1) 00000196 PL22=3.*FLOAT(I)*PL1 00000197 PL22=1.+.5*PL22*PL1/(1.+PL22) 00000198 V(J+1)=V(J+1)+(V1(J+7)+V1(J+4))*PL*PL22 00000199 V(J+2)=V(J+2)+(V1(J+2)+V1(J+4))*PLY 00000200 V(J+4)=V(J+4)+V1(J+5)*PNA 00000201 V(J+5)=V(J+5)+(V1(J+5)+V1(J+6))*PH1*PL22 00000202 V(J+6)=V(J+6)+(V1(J+3)+V1(J+8))*PCA+V1(J+2)*PCAY 00000203 V(J+7)=V(J+7)+(V1(J+4)+V1(J+7)+V1(J+8))*PL*PL22 00000204 V(J+8)=V(J+8)+(V1(J+3)+V1(J+8))*PL*PL22 00000205 C 00000206 J=J+3 00000207 J1=MEN3(I)+1 00000208 761 V(J)=V(J)+V1(J1)*ESTP(I,2) 00000209 C 00000216 DO 80 IT=1,6 00000217 C 00000223 I=N1-N-IT 00000224 MAXIM=MIN0(MAXB,N,I) 00000225 IF(IT.EQ.6) MAXIM=MAXIP 00000226 IF(MAXIM.LT.MINB) GOTO 80 00000227 KEV=1 00000228 DO 85 K=MINB,MAXIM 00000229 KEV=1-KEV 00000230 C 00000231 J1=MEN1(K)+1-IT 00000238 P=ESTR(K,IT) 00000239 IF(IT.EQ.6) J1=LPE+8*(K-1)+1 00000240 IF(IT.EQ.6) P=ESTP(K,1) 00000241 P13=V1(J1)*P 00000242 KK=K+KEV 00000243 KK=MAX0(KK,MINB2) 00000244 DO 81 K1=KK,MAXB,2 00000245 C 00000246 K3=K1-2 00000248 K2=K1-K-KEV+2 00000249 K2=MAX0(K2,MINB) 00000250 IF (K2.GT.K3) GOTO 83 00000251 DO 82 I=K2,K3,2 00000252 J=MEN3(I)+K1 00000253 82 V(J)=V(J)+P13 00000254 83 K2=K2-2 00000255 IF (K2.GE.MINB.AND.KEV.EQ.0) V(MEN3(K2)+K1)=V(MEN3(K2)+K1)+P13*.5 00000256 C 00000257 81 CONTINUE 00000260 C 00000261 P13=P13/P11 00000265 KK=K+KEV 00000266 DO 84 K1=KK,MAXB,2 00000267 J=MEN2(K1) 00000268 V(J)=V(J)+P13 00000269 84 CONTINUE 00000270 C 00000271 IF(K.EQ.MAXB) GOTO 85 00000275 KK=K-KEV 00000276 J1=MEN3(KK)+1-IT 00000277 IF(IT.EQ.6) J1=LPP+8*(KK/2-1)+1 00000278 P13=V1(J1)*P 00000279 V(MAL+K)=V(MAL+K)+P13 00000280 IF(KEV.EQ.1) GOTO 85 00000281 C 00000285 KK=K-2 00000286 IF(KK.LT.MINB) GOTO 86 00000287 DO 87 I=MINB,KK,2 00000288 J=MEN3(I)+K 00000289 87 V(J)=V(J)+P13 00000290 C 00000291 86 J=MEN2(K) 00000295 V(J)=V(J)+P13/P11 00000296 85 CONTINUE 00000297 80 CONTINUE 00000298 C 00000299 C V(MST) <-------> //Y // 00000300 C N 00000301 208 CONTINUE 00000302 Q1=0. 00000303 DO 88 J=1,MST 00000304 88 Q1=Q1+V(J) 00000305 Q1=100./Q1 00000306 DO 89 J=1,MST 00000307 89 V(J)=V(J)*Q1 00000308 C 00000312 N2=N1-1 00000313 IF(N.LT.N2) GOTO 90 00000314 PFN=0. 00000315 CPEN(N1,14)=0. 00000316 90 PFN=PFN-ALOG(Q1) 00000317 ZZ=0. 00000318 IF(N.EQ.1) GOTO 91 00000319 ZZ=V(2) 00000320 91 ZZ=ZZ+V(1)+V(MAL+1) 00000321 CPEN(N,14)=PFN+ALOG(ZZ) 00000322 C 00000323 GOTO 991 00000327 990 DO 992 J=1,MST 00000328 992 CPEN(N,J+6)=V(J) 00000329 GOTO 993 00000330 991 CALL RITE(NZ,1800,V) 00000331 993 DO 92 J=1,MST 00000332 V1(J)=V(J) 00000333 92 V(J)=0. 00000334 RETURN 00000335 END 00000336 C ********************** 00000001 C * SUBROUTINE MULTV2 * //X // = //X //*//U // 00000002 C * VARIANT 'ALBEAL' *** N+1 N N,N+1 00000003 C ********************** 00000004 SUBROUTINE MULTV2(NL1,NL2,CPEN) 00000005 DIMENSION ESTR(62,6),ESTP(15,2),CPEN(NL1,NL2) 00000006 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/DSTR/MAL,MBC,MST,MT1 00000007 1,MINB2,MAXB2,MBE1(100),MEN1(100),MBE2(50),MEN2(50),MBE3(50),MEN3(500000008 20)/VECT/V(1800),V1(1800),VV1(100,2),VV(5),TRA(8,8),NZ,PFN 00000009 3/MLPP/MLPP,MAXBP,LP,LPP,LPE,SIGP(5)/ENER/SIG(9),PNAP1(2945),PNAP 00000010 EQUIVALENCE(V(1424),QQ),(V(1425),P11),(V(1426),PL),(V(1427),ESTR(100000011 1)),(V(1394),ESTP(1)),(V(1393),PL1),(V(1392),PH1),(V(1391),PNA),(V(00000012 21390),PCA),(V(1389),PLY),(V(1388),PCAY) 00000013 C 00000017 C //X (J1)// = //X (J)// * //U (J,J1)// (SUM OVER J) 00000018 C N+1 N N,N+1 00000019 C 00000020 C NN=N+1 00000021 C V1 <---> //X //, V <---> //X // ; //U (J,J1)// =/= 0 00000022 C N+1 N N,N+1 00000023 C 00000024 DO 60 J=1,8 00000027 P=1. 00000028 IF (J-2) 61,61,62 00000029 62 P=ESTR(1,J-2) 00000030 61 DO 60 J1=1,8 00000031 Q=TRA(J,J1) 00000032 IF (Q) 60,60,63 00000033 63 V1(J1)=V1(J1)+V(J)*P 00000034 60 CONTINUE 00000035 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 208 00000036 C 00000039 V1(MAL+1)=V(MAL)*ESTR(1,6) 00000040 C 00000041 V1(MAL+1)=V1(MAL+1)+V(1) 00000044 C 00000045 V1(MAL+1)=V1(MAL+1)+V(MT1) 00000048 C 00000051 V1(1)=V1(1)+V(MT1) 00000052 C 00000055 V1(2)=V1(2)+V(MT1) 00000056 C 00000059 I1=MAL+1 00000060 I2=MAL+MAXB-1 00000061 DO 64 J=I1,I2 00000062 64 V1(J+1)=V(J)*P11 00000063 C 00000066 I1=MAL+MAXB+1 00000067 I2=MAL+2*MAXB-1 00000068 DO 65 J=I1,I2 00000069 65 V1(J+1)=V(J) 00000070 C 00000073 DO 66 I=MINB,MAXB 00000074 I1=MBE1(I)+1 00000075 I2=MEN1(I)-1 00000076 DO 66 J=I1,I2 00000077 66 V1(J+1)=V(J) 00000078 C 00000088 DO 67 I=MINB,MAXB 00000089 J=MBE1(I) 00000090 V1(J)=V(J)*PL 00000091 J2=MBC+I 00000092 V1(J2)=(V(J2)+V(J))*PL 00000093 V1(J+1)=(V(J2)+V(J))*ESTR(I,6) 00000094 67 VV1(I,1)=V1(J+1) 00000095 DO 671 I=MINB,MAXBP 00000096 C 00000097 J=LPE+8*(I-1) 00000098 PL22=3.*FLOAT(I)*PL1 00000099 PL22=1.+.5*PL22*PL1/(1.+PL22) 00000100 V1(J+2)=V1(J+2)+V(J+2)*PLY+V(J+6)*PCAY 00000101 V1(J+3)=V1(J+3)+V(J+8)*PL*PL22+V(J+6)*PCA 00000102 V1(J+4)=V1(J+4)+(V(J+1)+V(J+7))*PL*PL22+V(J+2)*PLY 00000103 V1(J+5)=V1(J+5)+V(J+4)*PNA+V(J+5)*PH1*PL22 00000104 V1(J+6)=V1(J+6)+V(J+5)*PH1*PL22 00000105 V1(J+7)=V1(J+7)+(V(J+1)+V(J+7))*PL*PL22 00000106 V1(J+8)=V1(J+8)+(V(J+7)+V(J+8))*PL*PL22+V(J+6)*PCA 00000107 C 00000108 J=J+3 00000109 J1=MT1+1-I 00000110 671 V1(J1)=V1(J1)+V(J)*ESTP(I,2) 00000111 C 00000114 DO 68 I=MINB,MAXB 00000115 J=MEN1(I) 00000116 J1=MT1+1-I 00000117 68 V1(J1)=V1(J1)+V(J) 00000118 C 00000119 DO 70 IT=1,MLP 00000128 C 00000131 I=N1-N-IT 00000132 MAXIM=MIN0(MAXB,N,I) 00000133 IF(MAXIM.LT.MINB) GOTO 70 00000134 DO 71 K=MINB,MAXIM 00000135 J1=MEN1(K)+1-IT 00000136 71 V1(J1)=V1(J1)+V(MAL+K)*ESTR(K,IT) 00000137 70 CONTINUE 00000138 I=N1-N-5 00000139 MAXIP=MIN0(MAXBP,N,I) 00000140 IF(MAXIP.LT.MINB) GOTO 701 00000141 DO 711 K=MINB,MAXIP 00000142 C 00000143 J1=LPE+8*(K-1)+1 00000144 711 V1(J1)=V1(J1)+V(MAL+K)*ESTP(K,1) 00000145 701 CONTINUE 00000146 C 00000151 IF(MBE1(1).GE.1) GOTO 208 00000152 C 00000154 DO 75 I=MINB,MAXB,2 00000155 J=MEN1(I) 00000156 J1=MBE2(I) 00000157 75 V1(J1)=V(J)*PNAP 00000158 DO 751 I=MINB,MAXBP,2 00000159 C 00000160 J=LPE+8*(I-1)+3 00000161 J1=MBE2(I) 00000162 751 V1(J1)=V1(J1)+V(J)*ESTP(I,2)*PNAP 00000163 C 00000164 DO 76 I=MINB,MAXB,2 00000167 I1=MBE2(I) 00000168 I2=MEN2(I)-1 00000169 DO 76 J=I1,I2 00000170 76 V1(J+1)=V(J) 00000171 C 00000176 DO 77 I=MINB,MAXB2,2 00000177 I1=MBE3(I)+1 00000178 I2=MEN3(I)+I-1 00000179 DO 78 J=I1,I2 00000180 78 V1(J+1)=V(J) 00000181 V1(I2+2)=V(I2+1)*PNAP 00000182 I1=I2+2 00000183 I2=MEN3(I)+MAXB-1 00000184 DO 77 J=I1,I2 00000185 77 V1(J+1)=V(J)*P11 00000186 C 00000192 DO 79 I=MINB,MAXB2,2 00000193 J=MBE3(I) 00000194 V1(J)=V(J)*PL 00000195 J2=MBC+MAXB+I/2 00000196 V1(J2)=(V(J)+V(J2))*PL 00000197 V1(J+1)=(V(J)+V(J2))*ESTR(I,6) 00000198 79 VV1(I,2)=V1(J+1) 00000199 DO 761 I=MINB,LP,2 00000200 C 00000201 J=LPP+8*(I/2-1) 00000202 PL22=3.*FLOAT(I)*PL1 00000203 PL22=1.+.5*PL22*PL1/(1.+PL22) 00000204 V1(J+2)=V1(J+2)+V(J+2)*PLY+V(J+6)*PCAY 00000205 V1(J+3)=V1(J+3)+V(J+8)*PL*PL22+V(J+6)*PCA 00000206 V1(J+4)=V1(J+4)+(V(J+1)+V(J+7))*PL*PL22+V(J+2)*PLY 00000207 V1(J+5)=V1(J+5)+V(J+4)*PNA+V(J+5)*PH1*PL22 00000208 V1(J+6)=V1(J+6)+V(J+5)*PH1*PL22 00000209 V1(J+7)=V1(J+7)+(V(J+1)+V(J+7))*PL*PL22 00000210 V1(J+8)=V1(J+8)+(V(J+7)+V(J+8))*PL*PL22+V(J+6)*PCA 00000211 C 00000212 J=J+3 00000213 J1=MEN3(I)+1 00000214 761 V1(J1)=V1(J1)+V(J)*ESTP(I,2) 00000215 C 00000222 DO 90 IT=1,6 00000223 C 00000229 I=N1-N-IT 00000230 MAXIM=MIN0(MAXB,N,I) 00000231 IF(IT.EQ.6) MAXIM=MAXIP 00000232 IF(MAXIM.LT.MINB) GOTO 90 00000233 KEV=1 00000234 DO 80 K=MINB,MAXIM 00000235 KEV=1-KEV 00000236 C 00000243 J1=MEN1(K)+1-IT 00000244 P=ESTR(K,IT) 00000245 IF(IT.EQ.6) J1=LPE+8*(K-1)+1 00000246 IF(IT.EQ.6) P=ESTP(K,1) 00000247 P13=0. 00000248 KK=K+KEV 00000249 KK=MAX0(KK,MINB2) 00000250 DO 81 K1=KK,MAXB,2 00000251 C 00000253 K3=K1-2 00000254 K2=K1-K-KEV+2 00000255 K2=MAX0(K2,MINB) 00000256 IF (K2.GT.K3) GOTO 83 00000257 DO 82 I=K2,K3,2 00000258 J=MEN3(I)+K1 00000259 82 P13=P13+V(J)*P 00000260 83 K2=K2-2 00000261 IF (K2.GE.MINB.AND.KEV.EQ.0) P13=P13+V(MEN3(K2)+K1)*P*.5 00000262 C 00000265 81 CONTINUE 00000266 C 00000270 P=P/P11 00000271 KK=K+KEV 00000272 DO 84 K1=KK,MAXB,2 00000273 J=MEN2(K1) 00000274 84 P13=P13+V(J)*P 00000275 V1(J1)=P13+V1(J1) 00000276 C 00000277 P=P*P11 00000281 IF(K.EQ.MAXB) GOTO 80 00000282 KK=K-KEV 00000283 J1=MEN3(KK)+1-IT 00000284 IF(IT.EQ.6) J1=LPP+8*(KK/2-1)+1 00000285 P13=V(MAL+K)*P 00000286 IF(KEV.EQ.1) GOTO 85 00000287 KK=K-2 00000288 C 00000289 IF(KK.LT.MINB) GOTO 86 00000293 DO 87 I=MINB,KK,2 00000294 J=MEN3(I)+K 00000295 87 P13=P13+V(J)*P 00000296 C 00000300 86 J=MEN2(K) 00000301 P13=P13+V(J)*P/P11 00000302 85 V1(J1)=P13+V1(J1) 00000303 80 CONTINUE 00000304 90 CONTINUE 00000305 208 CONTINUE 00000306 RETURN 00000307 END 00000308 C ******************** 00000001 C * SUBROUTINE SCAL * //X//*//Y// --> STATE PROBABILITIES 00000002 C * VARIANT 'ALBEAL' * 00000003 C ******************** 00000004 SUBROUTINE SCAL(NL1,NL2,CPEN) 00000005 COMMON MTN,MLP,N1,N,NN,MINB,MAXB/DSTR/MAL,MBC,MST,MT1 00000006 1,MINB2,MAXB2,MBE1(100),MEN1(100),MBE2(50),MEN2(50),MBE3(50),MEN3(500000007 20)/VECT/V(1800),V1(1800),VV1(100,2),VV(5),TRA(8,8),NZ,PFN 00000008 COMMON /MLPP/MLPP,MAXBP,LP,LPP,LPE,SIGP(5) 00000009 DIMENSION VPM(8),CPEN(NL1,NL2),ESTR(62,6) 00000010 EQUIVALENCE (V(1427),ESTR(1)) 00000011 C 00000012 C W (J)=X (J)*Y (J)/(//X (J)//*//Y (J)//) 00000014 C NN NN NN NN NN 00000015 C 00000021 NZ=N1-NN+1 00000026 IF(MAXB.NE.1.OR.MAXBP.NE.1) GOTO 990 00000027 DO 980 I=1,MST 00000028 980 V(I)=CPEN(NN,I+6) 00000029 DO 981 I=1,6 00000030 981 ESTR(1,I)=CPEN(NN,I) 00000031 DO 982 I=1,13 00000032 982 CPEN(NN,I)=0. 00000033 VL=0. 00000034 GOTO 282 00000035 990 CALL RID(NZ,1800,V) 00000036 C 00000040 VL=0. 00000041 DO 81 I=MINB,MAXB 00000042 J=MBE1(I)+1 00000043 81 VL=VL+VV1(I,1)*V(J) 00000044 IF(MBE1(1).GE.1) GOTO 282 00000045 DO 82 I=MINB,MAXB2,2 00000046 J=MBE3(I)+1 00000047 82 VL=VL+VV1(I,2)*V(J) 00000048 282 CONTINUE 00000049 C 00000050 C //X //*//Y // ; //X // 00000051 C NN NN NN 00000052 Q1=0. 00000056 Q2=0. 00000057 DO 83 J=1,MST 00000058 Q=V1(J)*V(J) 00000059 Q1=Q1+Q 00000060 V(J)=Q 00000061 83 Q2=Q2+V1(J) 00000062 C 00000063 ZZ=0. 00000067 Q1=100./Q1 00000068 Q2=100./Q2 00000069 DO 84 J=1,MST 00000070 Q=V(J)*Q1 00000071 V(J)=V1(J)*Q2 00000072 84 V1(J)=Q 00000073 VL=VL*Q1 00000074 C 00000075 VPR1=0. 00000076 IF(NN.EQ.1) VPRH=0. 00000077 DO 810 K=1,8 00000078 810 VPM(K)=0. 00000079 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 992 00000080 IF(MEN1(1).EQ.0) GOTO 811 00000081 DO 814 K=1,8 00000082 DO 812 I=MINB,MAXBP 00000083 J=LPE+8*(I-1)+K 00000084 812 VPM(K)=VPM(K)+V1(J) 00000085 IF(MBE1(1).EQ.0) GOTO 814 00000086 DO 813 I=MINB,LP,2 00000087 J=LPP+8*(I/2-1)+K 00000088 813 VPM(K)=VPM(K)+V1(J) 00000089 814 VPR1=VPR1+VPM(K) 00000090 811 CONTINUE 00000091 DO 85 I=1,13 00000092 85 CPEN(NN,I)=0. 00000093 C 00000097 ZZ=ZZ+V(MT1) 00000098 992 IF(NN.GT.1) GOTO 86 00000099 PFN=0. 00000100 86 PFN=PFN-ALOG(Q2) 00000101 IF(NN.LT.N1) ZZ=V(MAL)+ZZ 00000102 ZZ=ZZ+V(1) 00000103 CPEN(NN,13)=PFN+ALOG(ZZ) 00000104 IF(NN.EQ.N1) PFN=CPEN(N1,13) 00000105 C 00000111 P=0. 00000112 DO 87 J=2,MAL 00000113 87 P=P+V1(J) 00000114 CPEN(NN,2)=P+VPM(4)+VPM(5)+VPM(6) 00000115 CPEN(NN,1)=V1(2)+VPM(4) 00000116 CPEN(NN,3)=V1(MAL)+VPM(6) 00000117 IF(MAXB.EQ.1.AND.MAXBP.EQ.1) GOTO 993 00000118 C 00000121 P=0. 00000122 Q=0. 00000123 DO 88 K=1,MAXB 00000124 P=P+V1(MAL+K) 00000125 88 Q=Q+V1(MT1+1-K) 00000126 CPEN(NN,8)=P 00000127 CPEN(NN,11)=Q 00000128 C 00000133 Q1=0. 00000134 Q2=0. 00000135 Q3=0. 00000136 DO 89 K=MINB,MAXB 00000137 I1=MEN1(K)-MTN+1 00000138 I2=I1+MTN-2 00000139 J=MBC+K 00000140 Q3=V1(I1-1)+Q3+V1(J) 00000141 DO 90 J=I1,I2 00000142 90 Q2=Q2+V1(J) 00000143 89 Q1=V1(I2+1)+Q1 00000144 Q4=0. 00000145 IF(MBE1(1).GE.1) GOTO 208 00000146 C 00000150 DO 91 K=MINB,MAXB2,2 00000151 I1=MEN3(K)-MTN+1 00000152 I2=I1+MTN-2 00000153 J=MBC+MAXB+K/2 00000154 Q3=V1(I1-1)+Q3+V1(J) 00000155 DO 92 J=I1,I2 00000156 92 Q2=Q2+V1(J) 00000157 91 Q1=V1(I2+1)+Q1 00000158 C 00000161 DO 93 K=MINB,MAXB,2 00000162 I1=MBE2(K) 00000163 I2=MEN2(K) 00000164 DO 94 J=I1,I2 00000165 94 Q4=Q4+V1(J) 00000166 IF(K.EQ.MAXB) GOTO 93 00000167 I1=MEN3(K)+1 00000168 I2=MEN3(K)+MAXB 00000169 DO 95 J=I1,I2 00000170 95 Q4=Q4+V1(J) 00000171 93 CONTINUE 00000172 208 CONTINUE 00000173 C 00000176 CPEN(NN,5)=P+Q+Q4 00000177 C 00000180 CPEN(NN,10)=Q1+Q2+Q3+VPR1 00000181 C 00000184 CPEN(NN,9)=Q1+Q2-VL-VV(1)-VV(2)-VV(3) 00000185 VV(3)=VV(2) 00000186 VV(2)=VV(1) 00000187 VV(1)=VL 00000188 C 00000194 CPEN(NN,4)=V1(MAL+1)+VV(4)+VPRH 00000195 VV(4)=Q1 00000196 C 00000197 VPRH=VPM(3) 00000199 C 00000200 IF(NN.EQ.1) GOTO 96 00000207 IF(NN.LT.N1) GOTO 97 00000208 CPEN(N1,6)=V1(MT1) 00000209 97 CPEN(NN-1,6)=Q1+Q2+Q3+VPM(1)-VV(5) 00000210 96 VV(5)=Q2+Q3-V1(MT1) 00000211 C 00000212 CPEN(NN,7)=CPEN(NN,5)+CPEN(NN,10) 00000215 C 00000216 993 CPEN(NN,12)=V1(1) 00000218 C 00000219 DO 98 J=1,MST 00000220 98 V1(J)=0. 00000221 RETURN 00000222 END 00000223