COMPILATION LISTING OF tss_fortran (>spec>online>spec1021>tss_fortran.fortran) Compiled by: Multics New Fortran Compiler, Release 2 Compiled on: 10/25/77 1235.0 mst Tue Options: optimize relocatable map Function anpf 1 c ********normal probability function ****** 2 function anpf(x1,x2,xmu,sigma) 3 1 temp=1.4142136*sigma 4 u1=(x1-xmu)/temp 5 u2=(x2-xmu)/temp 6 if (u1) 300,200,100 7 100 if (u2) 200,200,900 8 300 if (u2) 900,200,200 9 200 anpf=0.5*(errf(abs(u2))*sign(1.0,u2)-errf(abs(u1))*sign(1.0,u1)) 10 go to 5001 11 900 anpf =0.5*(errf(-abs(u1))*sign(1.0,u1)-errf(-abs(u2))*sign(1.0,u2)) 12 5001 return 13 end Function anpf NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES abs builtin ref 9 9 11 11 anpf entry point 000232 constant real on line 2 anpf 000246 automatic real ref 2 9 11 errf internal function constant real ref 9 9 11 11 sigma parameter position 4 real ref 2 3 sign builtin real ref 9 9 11 11 temp 000247 automatic real ref 3 3 4 5 u1 000250 automatic real ref 4 6 9 9 11 11 u2 000251 automatic real ref 5 7 8 9 9 11 11 x1 parameter position 1 real ref 2 4 x2 parameter position 2 real ref 2 5 xmu parameter position 3 real ref 2 4 4 5 5 LOC LABEL TYPE LINE REFERENCES 000252 1 executable 3 000271 100 executable 7 used in transfer ref 6 000277 200 executable 9 used in transfer ref 6 7 7 8 8 000274 300 executable 8 used in transfer ref 6 000333 900 executable 11 used in transfer ref 7 8 000370 5001 executable 12 used in transfer ref 10 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2 000231 3 000252 4 000255 5 000261 6 000265 7 000271 8 000274 9 000277 10 000332 11 000333 12 000370 Function beta 14 c beta 15 c *****incomplete beta function approximation***** 16 cSTART beta 17 function beta(ix,bbb,xx,yy) 18 isign=ix 19 bp=bbb 20 x=xx 21 y=yy 22 if(isign-1)100,200,200 23 100 c1=gbeta(x,y,0.,bp) 24 c2=gbeta(x,y,0.,1.) 25 beta=c1/c2 26 return 27 200 if(x-1.)232,225,232 28 225 if(y-1.)229,228,229 29 232 if(y-1.)237,233,237 30 237 bet=gbeta(x,y,0.,1.) 31 beta=x/(x+y) 32 do 250 i=1,5 33 c1=gbeta(x,y,0.,beta) 34 c2=ftion(x,y,beta) 35 beta=beta+(bet*bp-c1)/c2 36 if(beta-1.)10,40,40 37 10 if(beta)20,20,250 38 20 beta =0. 39 30 go to 300 40 40 beta=1. 41 go to 300 42 250 continue 43 go to 300 44 228 beta=bp 45 go to 300 46 229 beta=1.-(1.-bp)**(1./y) 47 go to 300 48 233 beta=bp**(1./x) 49 go to 300 50 300 return 51 end Function beta NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES bbb parameter position 2 real ref 17 19 bet 000261 automatic real ref 30 35 beta entry point 000374 constant real on line 17 beta 000252 automatic real ref 17 25 31 33 34 35 35 36 37 38 40 44 46 48 bp 000254 automatic real ref 19 23 35 44 46 46 48 c1 000257 automatic real ref 23 25 33 35 c2 000260 automatic real ref 24 25 34 35 ftion internal function constant real ref 34 gbeta internal function constant real ref 23 24 30 33 i 000262 automatic integer ref 32 isign 000253 automatic integer ref 18 18 22 ix parameter position 1 integer ref 17 18 x 000255 automatic real ref 20 23 24 27 30 31 31 33 34 48 xx parameter position 3 real ref 17 20 y 000256 automatic real ref 21 23 24 28 29 30 31 31 33 34 46 yy parameter position 4 real ref 17 21 LOC LABEL TYPE LINE REFERENCES 000520 10 executable 37 used in transfer ref 36 000523 20 executable 38 used in transfer ref 37 37 000525 30 executable 39 000526 40 executable 40 used in transfer ref 36 36 000430 100 executable 23 used in transfer ref 22 000446 200 executable 27 used in transfer ref 22 22 000452 225 executable 28 used in transfer ref 27 000536 228 executable 44 used in transfer ref 28 000541 229 executable 46 used in transfer ref 28 28 000456 232 executable 29 used in transfer ref 27 27 000561 233 executable 48 used in transfer ref 29 000462 237 executable 30 used in transfer ref 29 29 000531 250 executable 42 used in transfer ref 32 37 000574 300 executable 50 used in transfer ref 39 41 43 45 47 49 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 17 000373 18 000414 19 000416 20 000420 21 000422 22 000424 23 000430 24 000435 25 000442 26 000444 27 000446 28 000452 29 000456 30 000462 31 000467 32 000473 33 000475 34 000502 35 000507 36 000515 37 000520 38 000523 39 000525 40 000526 41 000530 42 000531 43 000535 44 000536 45 000540 46 000541 47 000560 48 000561 49 000573 50 000574 Function gbeta 52 cSTART gbeta 53 function gbeta(x,y,a,b) 54 dimension u(8),h(8) 55 data u/.04750625,.14080178,.22900839,.30893812, 56 & .37770220,.43281560,.47228751,.49470047/ 57 data h/.09472531,.09130171,.08457826,.07479799, 58 & .06231449,.04757926,.03112676,.01357623/ 59 sum=0.0 60 do 20 i=1,8 61 arg1=((b-a)*u(i)+(b+a)/2.) 62 arg2=(a-b)*u(i)+(b+a)/2. 63 x1=ftion(x,y,arg1) 64 x2=ftion(x,y,arg2) 65 20 sum=sum+h(i)*(x1+x2) 66 gbeta=(b-a)*sum 67 return 68 end Function gbeta NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 3 real ref 53 61 61 61 61 62 62 62 66 66 arg1 000267 automatic real ref 61 63 arg2 000270 automatic real ref 62 64 b parameter position 4 real ref 53 61 61 62 62 62 66 ftion internal function constant real ref 63 64 gbeta 000264 automatic real ref 53 66 gbeta entry point 000600 constant real on line 53 h 000110 automatic real array(8) initialized ref 54 57 65 i 000266 automatic integer ref 60 61 62 65 sum 000265 automatic real ref 59 59 65 65 66 u 000100 automatic real array(8) initialized ref 54 55 61 62 x parameter position 1 real ref 53 63 64 x1 000271 automatic real ref 63 65 x2 000272 automatic real ref 64 65 65 y parameter position 2 real ref 53 63 64 LOC LABEL TYPE LINE REFERENCES 000703 20 executable 65 ref 60 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 53 000577 59 000620 60 000622 61 000624 62 000640 63 000645 64 000664 65 000703 66 000714 67 000720 Function ftion 69 cSTART ftion 70 function ftion(x,y,z) 71 xu=x-1. 72 if(z-1.e-37)100,100,20 73 20 if(xu*alog(z)-80.)30,200,200 74 30 if(xu*alog(z)+80.)300,300,40 75 40 ch=xu*alog(z) 76 a=z**xu 77 go to 50 78 100 z=1.e-37 79 go to 40 80 200 a=1.e37 81 go to 50 82 300 a=0. 83 50 yv=y-1. 84 q=1.-z 85 if(q-1.e-37)400,400,60 86 60 if(yv*alog(q)-80.)70,500,500 87 70 if(yv*alog(q)+80.)600,600,80 88 80 ch=yv*alog(q) 89 b=q**yv 90 90 if(a)82,95,82 91 82 if(b)85,95,85 92 85 if((alog(abs(a))+alog(abs(b))).ge.(-80.))go to 95 93 ftion=1.e-36 94 go to 96 95 95 ftion=a*b 96 96 return 97 400 q=1.e-37 98 go to 80 99 500 b=1.e37 100 go to 90 101 600 b=0. 102 go to 90 103 end Function ftion NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000277 automatic real ref 76 80 82 90 92 95 abs builtin ref 92 92 alog builtin ref 73 74 75 86 87 88 92 92 b 000302 automatic real ref 89 91 92 95 99 101 ch 000276 automatic real ref 75 88 ftion entry point 000723 constant real on line 70 ftion 000274 automatic real ref 70 93 95 q 000301 automatic real ref 84 85 86 87 88 89 97 x parameter position 1 real ref 70 71 xu 000275 automatic real ref 71 71 73 74 75 76 y parameter position 2 real ref 70 83 yv 000300 automatic real ref 83 86 87 88 89 z parameter position 3 real ref 70 72 73 74 75 76 78 84 LOC LABEL TYPE LINE REFERENCES 000752 20 executable 73 used in transfer ref 72 000763 30 executable 74 used in transfer ref 73 000774 40 executable 75 used in transfer ref 74 79 001023 50 executable 83 used in transfer ref 77 81 001034 60 executable 86 used in transfer ref 85 001045 70 executable 87 used in transfer ref 86 001056 80 executable 88 used in transfer ref 87 98 001077 82 executable 91 used in transfer ref 90 90 001102 85 executable 92 used in transfer ref 91 91 001074 90 executable 90 used in transfer ref 100 102 001133 95 executable 95 used in transfer ref 90 91 92 001136 96 executable 96 used in transfer ref 94 001013 100 executable 78 used in transfer ref 72 72 001016 200 executable 80 used in transfer ref 73 73 001021 300 executable 82 used in transfer ref 74 74 001141 400 executable 97 used in transfer ref 85 85 001144 500 executable 99 used in transfer ref 86 86 001147 600 executable 101 used in transfer ref 87 87 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 70 000722 71 000743 72 000746 73 000752 74 000763 75 000774 76 001003 77 001012 78 001013 79 001015 80 001016 81 001020 82 001021 83 001023 84 001026 85 001031 86 001034 87 001045 88 001056 89 001065 90 001074 91 001077 92 001102 93 001130 94 001132 95 001133 96 001136 97 001141 98 001143 99 001144 100 001146 101 001147 102 001151 Function errf 104 c errf mod dec 6,1972 105 cSTART errf 106 function errf(w) 107 c ******program to evaluate the error function and its compliment 108 double precision a(25),b(30),f 109 data a/16443152242714.d-13,-9049760497548.d-13, 110 & 643570883797.d-13,196418177368.d-13,-1244215694.d-13, 111 & -9101941905.d-13,-1796219835.d-13,139836786.d-13, 112 & 164789417.d-13,39009267.d-13,-893145.d-13,-3747896.d-13, 113 & 1298818.d-13,136773.d-13,77107.d-13,46810.d-13, 114 & 11844.d-13,-5.d-13,-1384.d-13,-652.d-13,145.d-13, 115 & 10.d-13,24.d-13,11.d-13,2.d-13/ 116 m=24 117 x=abs(w) 118 if(x-.01)1,2,2 119 1 xerr=2.0/(3.0*1.77245385)*x*(3.0-x**2) 120 go to 6 121 2 z=(x-1.0)/(x+1.0) 122 do 3 i=1,30 123 124 b(i)=0.0 125 3 continue 126 do 4 i=1,m 127 m1=(m+1)-i 128 b(m1)=2.0*z*b(m1+1)-b(m1+2)+a(m1+1) 129 4 continue 130 f=-b(2)+z*b(1)+.5*a(1) 131 xerr=1.0-(1.0/1.77245385)*(exp(-(x**2)))*f 132 if(x-.01)6,7,7 133 6 cerr=1.0-xerr 134 go to 5 135 7 cerr=(1.0/1.77245385)*(exp(-(x**2)))*f 136 5 if(w)9,8,8 137 8 errf=xerr 138 139 go to 13 140 9 errf=cerr 141 13 return 142 end Function errf NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000120 automatic double precision array(25) initialized ref 108 109 128 130 abs builtin ref 117 b 000304 automatic double precision array(30) ref 108 124 128 128 128 130 130 cerr 000411 automatic real ref 133 135 140 errf 000402 automatic real ref 106 137 140 errf entry point 001153 constant real on line 106 exp builtin ref 131 135 f 000400 automatic double precision ref 108 130 131 135 i 000407 automatic integer ref 122 124 126 127 m 000403 automatic integer ref 116 116 126 127 m1 000410 automatic integer ref 127 128 128 128 128 w parameter position 1 real ref 106 117 136 x 000404 automatic real ref 117 118 119 119 121 121 131 132 135 xerr 000405 automatic real ref 119 131 133 137 z 000406 automatic real ref 121 128 130 LOC LABEL TYPE LINE REFERENCES 001204 1 executable 119 used in transfer ref 118 001222 2 executable 121 used in transfer ref 118 118 001240 3 executable 125 ref 122 001310 4 executable 129 ref 126 001367 5 executable 136 used in transfer ref 134 001353 6 executable 133 used in transfer ref 120 132 001357 7 executable 135 used in transfer ref 132 132 001372 8 executable 137 used in transfer ref 136 136 001375 9 executable 140 used in transfer ref 136 001377 13 executable 141 used in transfer ref 139 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 106 001152 116 001173 117 001175 118 001201 119 001204 120 001221 121 001222 122 001231 124 001233 125 001240 126 001244 127 001250 128 001254 129 001310 130 001314 131 001327 132 001347 133 001353 134 001356 135 001357 136 001367 137 001372 139 001374 140 001375 141 001377 WARNING 36 on line 119 The real constant 1.77245385 has more than 8 digits and has been converted to double precision. WARNING 36 on line 131 The real constant 1.77245385 has more than 8 digits and has been converted to double precision. WARNING 36 on line 135 The real constant 1.77245385 has more than 8 digits and has been converted to double precision. Subroutine linefit 143 c linefit 144 cSTART linefit 145 subroutine linefit (in,last,x,y,s,yi) 146 dimension x(last),y(last) 147 n=last-in+1 148 s1=0 149 s2=0 150 s3=0 151 s4=0 152 do 10 i=in,last 153 s1=s1+x(i) 154 s2=s2+y(i) 155 s3=s3+x(i)*y(i) 156 s4=s4+x(i)*x(i) 157 10 continue 158 s=(n*s3-s1*s2)/(n*s4-s1*s1) 159 yi=(s2*s4-s1*s3)/(n*s4-s1*s1) 160 return 161 end Subroutine linefit NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES i 000417 automatic integer ref 152 153 154 155 155 156 156 in parameter position 1 integer ref 145 147 152 last parameter position 2 integer ref 145 146 146 147 152 linefit entry point 001403 constant on line 145 n 000412 automatic integer ref 147 147 158 158 159 s parameter position 5 real ref 145 158 s1 000413 automatic real ref 148 153 153 158 158 158 159 159 159 s2 000414 automatic real ref 149 154 154 158 159 s3 000415 automatic real ref 150 155 155 158 159 s4 000416 automatic real ref 151 156 156 158 159 159 x parameter position 3 real array(last) ref 145 146 153 155 156 156 y parameter position 4 real array(last) ref 145 146 154 155 yi parameter position 6 real ref 145 159 LOC LABEL TYPE LINE REFERENCES 001465 10 executable 157 ref 152 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 145 001402 147 001427 148 001433 149 001435 150 001436 151 001437 152 001440 153 001444 154 001451 155 001455 156 001461 157 001465 158 001471 159 001515 160 001526 Subroutine lineq 162 c lineq 163 c ***********solution of simultaneous linear equations *********** 164 c ************* gaussian elimination *************************** 165 cSTART lineq 166 subroutine lineq(a,b,naarg,nbarg,idim) 167 dimension a(idim,naarg),b(idim,nbarg) 168 1 na=naarg 169 nb=nbarg 170 ns=0 171 if(na)10,5001,60 172 10 if(nb)20,5001,30 173 20 nb=iabs(nb) 174 na=iabs(na) 175 ns=1 176 go to 40 177 30 na=iabs(na) 178 ns=-1 179 40 napl1=na+1 180 60 do 291 j1=1,na 181 temp=0. 182 if(ns)120,122,125 183 120 do 121 j2=j1,na 184 if(abs(a(j2,j1)).lt.temp) go to 121 185 temp=abs(a(j2,j1)) 186 a(j1,napl1)=j2 187 121 continue 188 go to 125 189 122 do 124 j2=j1,na 190 if(abs(a(j2,j1)).lt.temp) go to 124 191 temp=abs(a(j2,j1)) 192 ibig=j2 193 124 continue 194 go to 126 195 125 ibig=a(j1,napl1) 196 126 if(ibig.eq.j1) go to 201 197 if(ns)135,135,160 198 c ********** rearrange rows to place largest absolute ********** 199 c ********** value in pivot position ************************** 200 135 do 141 j2=j1,na 201 temp=a(j1,j2) 202 a(j1,j2)=a(ibig,j2) 203 141 a(ibig,j2)=temp 204 160 do 161 j2=1,nb 205 temp=b(j1,j2) 206 b(j1,j2)=b(ibig,j2) 207 161 b(ibig,j2)=temp 208 201 if(j1.eq.na) go to 301 209 n1=j1+1 210 c ******** compute new coefficients in remaining rows ********* 211 do 281 j2=n1,na 212 if(ns)240,240,250 213 240 a(j2,j1) = a(j2,j1)/a(j1,j1) 214 do 241 j3=n1,na 215 241 a(j2,j3)=a(j2,j3)-a(j2,j1)*a(j1,j3) 216 250 do 251 j3=1,nb 217 251 b(j2,j3)=b(j2,j3)-a(j2,j1)*b(j1,j3) 218 281 continue 219 291 continue 220 c ***************** obtain solutions ************************* 221 301 do 391 j1=1,nb 222 b(na,j1)=b(na,j1)/a(na,na) 223 if(na.eq.1) go to 391 224 n1=na 225 321 do 341 j2=n1,na 226 341 b(n1-1,j1)=b(n1-1,j1)-b(j2,j1)*a(n1-1,j2) 227 b(n1-1,j1)=b(n1-1,j1)/a(n1-1,n1-1) 228 n1=n1-1 229 if(n1.ne.1) go to 321 230 391 continue 231 5001 return 232 end Subroutine lineq NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 1 real array(idim,naarg) ref 166 167 184 185 186 190 191 195 201 202 202 203 213 213 213 215 215 215 215 217 222 226 227 abs builtin ref 184 185 190 191 b parameter position 2 real array(idim,nbarg) ref 166 167 205 206 206 207 217 217 217 222 222 226 226 226 227 227 iabs builtin integer ref 173 174 177 ibig 000427 automatic integer ref 192 195 196 202 203 206 207 idim parameter position 5 integer ref 166 167 167 j1 000424 automatic integer ref 180 183 184 185 186 189 190 191 195 196 200 201 202 205 206 208 209 213 213 213 213 215 215 217 217 221 222 222 226 226 226 227 227 j2 000426 automatic integer ref 183 184 185 186 189 190 191 192 200 201 202 202 203 204 205 206 206 207 211 213 213 215 215 215 217 217 217 225 226 226 j3 000431 automatic integer ref 214 215 215 215 216 217 217 217 lineq entry point 001530 constant on line 166 n1 000430 automatic integer ref 209 211 214 224 225 226 226 226 227 227 227 227 228 228 229 na 000420 automatic integer ref 168 168 171 174 174 177 177 179 180 183 189 200 208 211 214 222 222 222 222 223 224 225 naarg parameter position 3 integer ref 166 167 168 napl1 000423 automatic integer ref 179 186 195 nb 000421 automatic integer ref 169 172 173 173 204 216 221 nbarg parameter position 4 integer ref 166 167 169 ns 000422 automatic integer ref 170 175 178 182 197 212 temp 000425 automatic real ref 181 184 185 190 191 201 203 205 207 LOC LABEL TYPE LINE REFERENCES 001566 1 executable 168 001577 10 executable 172 used in transfer ref 171 001603 20 executable 173 used in transfer ref 172 001620 30 executable 177 used in transfer ref 172 001627 40 executable 179 used in transfer ref 176 001632 60 executable 180 used in transfer ref 171 001644 120 executable 183 used in transfer ref 182 001704 121 executable 187 used in transfer ref 183 184 001711 122 executable 189 used in transfer ref 182 001743 124 executable 193 used in transfer ref 189 190 001750 125 executable 195 used in transfer ref 182 188 001760 126 executable 196 used in transfer ref 194 001767 135 executable 200 used in transfer ref 197 197 002015 141 executable 203 ref 200 002030 160 executable 204 used in transfer ref 197 002056 161 executable 207 ref 204 002071 201 executable 208 used in transfer ref 196 002106 240 executable 213 used in transfer ref 212 212 002135 241 executable 215 ref 214 002172 250 executable 216 used in transfer ref 212 002176 251 executable 217 ref 216 002234 281 executable 218 ref 211 002240 291 executable 219 ref 180 002244 301 executable 221 used in transfer ref 208 002302 321 executable 225 used in transfer ref 229 002306 341 executable 226 ref 225 002402 391 executable 230 used in transfer ref 221 223 002406 5001 executable 231 used in transfer ref 171 172 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 166 001527 168 001566 169 001570 170 001572 171 001573 172 001577 173 001603 174 001610 175 001615 176 001617 177 001620 178 001625 179 001627 180 001632 181 001636 182 001640 183 001644 184 001650 185 001663 186 001674 187 001704 188 001710 189 001711 190 001715 191 001730 192 001741 193 001743 194 001747 195 001750 196 001760 197 001764 200 001767 201 001773 202 002002 203 002015 204 002030 205 002034 206 002043 207 002056 208 002071 209 002075 211 002100 212 002103 213 002106 214 002131 215 002135 216 002172 217 002176 218 002234 219 002240 221 002244 222 002250 223 002274 224 002300 225 002302 226 002306 227 002347 228 002374 229 002376 230 002402 231 002406 Subroutine mtinv 233 c mtinv 234 c *************matrix inversion************************* 235 cSTART mtinv 236 subroutine mtinv(a,nrarg,ncarg,idim,label) 237 dimension a(idim,ncarg),label(nrarg) 238 1 nr=nrarg 239 nc=ncarg 240 do 21 j1=1,nr 241 21 label(j1)=j1 242 do 291 j1=1,nr 243 c **************find remaining row containing largest*** 244 c **************absolute value in pivotal column******** 245 101 temp=0.0 246 do 121 j2=j1,nr 247 if(abs(a(j2,j1)).lt.temp) go to 121 248 temp=abs(a(j2,j1)) 249 ibig=j2 250 121 continue 251 if(ibig.eq.j1)go to 201 252 c **************rearrange rows to place largest absolute 253 c **************value in pivot position***************** 254 do 141 j2=1,nc 255 temp=a(j1,j2) 256 a(j1,j2)=a(ibig,j2) 257 141 a(ibig,j2)=temp 258 i=label(j1) 259 label(j1)=label(ibig) 260 label(ibig)=i 261 c ::::compute coefficients in pivotal row:::: 262 201 temp=a(j1,j1) 263 a(j1,j1)=1.0 264 do 221 j2=1,nc 265 221 a(j1,j2)=a(j1,j2)/temp 266 c **************compute coefficients in other rows****** 267 do 281 j2=1,nr 268 if(j2.eq.j1) go to 281 269 temp=a(j2,j1) 270 a(j2,j1)=0.0 271 do 241 j3=1,nc 272 241 a(j2,j3)=a(j2,j3)-temp*a(j1,j3) 273 281 continue 274 291 continue 275 c **************interchange columns according to******** 276 c **************interchanges of rows of original matrix* 277 301 n1=nr-1 278 do 391 j1=1,n1 279 do 321 j2=j1,nr 280 if(label(j2).ne.j1) go to 321 281 if(j2.eq.j1) go to 391 282 go to 341 283 321 continue 284 341 do 361 j3=1,nr 285 temp=a(j3,j1) 286 a(j3,j1)=a(j3,j2) 287 361 a(j3,j2)=temp 288 label(j2)=label(j1) 289 391 continue 290 5001 return 291 end Subroutine mtinv NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 1 real array(idim,ncarg) ref 236 237 247 248 255 256 256 257 262 263 265 265 269 270 272 272 272 285 286 286 287 abs builtin ref 247 248 i 000440 automatic integer ref 258 260 ibig 000437 automatic integer ref 249 251 256 257 259 260 idim parameter position 4 integer ref 236 237 j1 000434 automatic integer ref 240 241 241 242 246 247 248 251 255 256 258 259 262 262 263 263 265 265 268 269 270 272 278 279 280 281 285 286 288 j2 000436 automatic integer ref 246 247 248 249 254 255 256 256 257 264 265 265 267 268 269 270 272 272 279 280 281 286 287 288 j3 000441 automatic integer ref 271 272 272 272 284 285 286 286 287 label parameter position 5 integer array(nrarg) ref 236 237 241 258 259 259 260 280 288 288 mtinv entry point 002410 constant on line 236 n1 000442 automatic integer ref 277 278 nc 000433 automatic integer ref 239 254 264 271 ncarg parameter position 3 integer ref 236 237 239 nr 000432 automatic integer ref 238 238 240 242 246 267 277 279 284 nrarg parameter position 2 integer ref 236 237 238 temp 000435 automatic real ref 245 247 248 255 257 262 265 269 272 285 287 LOC LABEL TYPE LINE REFERENCES 002441 1 executable 238 002451 21 executable 241 ref 240 002463 101 executable 245 002517 121 executable 250 used in transfer ref 246 247 002555 141 executable 257 ref 254 002601 201 executable 262 used in transfer ref 251 002623 221 executable 265 ref 264 002676 241 executable 272 ref 271 002726 281 executable 273 used in transfer ref 267 268 002732 291 executable 274 ref 242 002736 301 executable 277 002764 321 executable 283 used in transfer ref 279 280 002770 341 executable 284 used in transfer ref 282 003016 361 executable 287 ref 284 003036 391 executable 289 used in transfer ref 278 281 003042 5001 executable 290 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 236 002407 238 002441 239 002443 240 002445 241 002451 242 002457 245 002463 246 002465 247 002471 248 002504 249 002515 250 002517 251 002523 254 002527 255 002533 256 002542 257 002555 258 002570 259 002574 260 002577 262 002601 263 002610 264 002617 265 002623 267 002644 268 002650 269 002654 270 002663 271 002672 272 002676 273 002726 274 002732 277 002736 278 002741 279 002745 280 002751 281 002757 282 002763 283 002764 284 002770 285 002774 286 003003 287 003016 288 003031 289 003036 290 003042 Subroutine mtmpy 292 c mtmpy -- rev. april 1971 293 c honeywell time sharing applications 294 c **************matrix multiplication******************* 295 cSTART mtmpy 296 subroutine mtmpy(ind,a,b,c,larg,marg,n) 297 dimension a(25,999),b(25,999),c(25,999) 298 1 l=iabs(larg) 299 m=iabs(marg) 300 i=ind+1 301 go to (101,201,301,401),i 302 101 do 121 j1=1,l 303 do 121 j2=1,n 304 c(j1,j2)=0.0 305 do 121 j3=1,m 306 if(larg)102,5001,110 307 102 if(marg)103,5001,105 308 c **************t(matrix) x t(matrix) t(a(m,l))*t(b(n, 309 103 temp=a(j3,j1)*b(j2,j3) 310 go to 121 311 c **************t(matrix) x matrix t(a(m,l))*b(m,n) 312 105 temp=a(j3,j1)*b(j3,j2) 313 go to 121 314 110 if(marg)111,5001,115 315 c **************matrix x t(matrix) a(l,m)*t(b(n,m)) 316 111 temp=a(j1,j3)*b(j2,j3) 317 go to 121 318 c **************matrix x matrix a(l,m)*b(m,n)=c( 319 115 temp=a(j1,j3)*b(j3,j2) 320 121 c(j1,j2)=c(j1,j2)+temp 321 go to 5001 322 c **************diagonal x diagonal a(l,1)*b(l,1)=c( 323 201 do 221 j1=1,l 324 221 c(j1,1)=a(j1,1)*b(j1,1) 325 go to 5001 326 301 do 321 j1=1,l 327 do 321 j2=1,m 328 if(marg)310,5001,315 329 c **************diagonal x t(matrix) a(l,1)*t(b(m,l)) 330 310 temp=a(j1,1)*b(j2,j1) 331 go to 321 332 c **************diagonal x matrix a(l,1)*b(l,m)=c( 333 315 temp=a(j1,1)*b(j1,j2) 334 321 c(j1,j2)=temp 335 go to 5001 336 401 do 421 j1=1,l 337 do 421 j2=1,m 338 if(larg)410,5001,415 339 c **************t(matrix) x diagonal t(a(m,l))*b(m,1) 340 410 temp=a(j2,j1)*b(j2,1) 341 go to 421 342 c **************matrix x diagonal a(l,m)*b(m,1)=c( 343 415 temp=a(j1,j2)*b(j2,1) 344 421 c(j1,j2)=temp 345 5001 return 346 end Subroutine mtmpy NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 2 real array(25,999) ref 296 297 309 312 316 319 324 330 333 340 343 b parameter position 3 real array(25,999) ref 296 297 309 312 316 319 324 330 333 340 343 c parameter position 4 real array(25,999) ref 296 297 304 320 320 324 334 344 i 000446 automatic integer ref 300 301 iabs builtin integer ref 298 299 ind parameter position 1 integer ref 296 300 j1 000447 automatic integer ref 302 304 309 312 316 319 320 320 323 324 324 324 326 330 330 333 333 334 336 340 343 344 j2 000450 automatic integer ref 303 304 309 312 316 319 320 320 327 330 333 334 337 340 340 343 343 344 j3 000451 automatic integer ref 305 309 309 312 312 316 316 319 319 l 000444 automatic integer ref 298 298 302 323 326 336 larg parameter position 5 integer ref 296 298 306 338 m 000445 automatic integer ref 299 305 327 337 marg parameter position 6 integer ref 296 299 307 314 328 mtmpy entry point 003044 constant on line 296 n parameter position 7 integer ref 296 303 temp 000452 automatic real ref 309 312 316 319 320 330 333 334 340 343 344 LOC LABEL TYPE LINE REFERENCES 003064 1 executable 298 003112 101 executable 302 used in transfer ref 301 003141 102 executable 307 used in transfer ref 306 003145 103 executable 309 used in transfer ref 307 003162 105 executable 312 used in transfer ref 307 003177 110 executable 314 used in transfer ref 306 003203 111 executable 316 used in transfer ref 314 003220 115 executable 319 used in transfer ref 314 003234 121 executable 320 used in transfer ref 302 303 305 310 313 317 003265 201 executable 323 used in transfer ref 301 003271 221 executable 324 ref 323 003305 301 executable 326 used in transfer ref 301 003321 310 executable 330 used in transfer ref 328 003333 315 executable 333 used in transfer ref 328 003344 321 executable 334 used in transfer ref 326 327 331 003364 401 executable 336 used in transfer ref 301 003400 410 executable 340 used in transfer ref 338 003413 415 executable 343 used in transfer ref 338 003425 421 executable 344 used in transfer ref 336 337 341 003444 5001 executable 345 used in transfer ref 306 307 314 321 325 328 335 338 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 296 003043 298 003064 299 003071 300 003076 301 003101 302 003112 303 003116 304 003122 305 003131 306 003135 307 003141 309 003145 310 003161 312 003162 313 003176 314 003177 316 003203 317 003217 319 003220 320 003234 321 003264 323 003265 324 003271 325 003304 326 003305 327 003311 328 003315 330 003321 331 003332 333 003333 334 003344 335 003363 336 003364 337 003370 338 003374 340 003400 341 003412 343 003413 344 003425 345 003444 Subroutine plot 347 c plot -- july 1972 348 cSTART plot 349 subroutine plot(x,y,ymax,ymin,n,ind,ntot) 350 dimension ylabel(5),y(n) 351 save 352 character m72*1(72),iblank*1,markx*1,marki*1,mark*1(9) 353 data iblank,markx,marki/" ","x","|"/ 354 data mark/"*",".","+","(",")","#","$","-",","/ 355 cwidth = 70. 356 if(ind)20,20,1 357 1 ncount=0 358 icount=0 359 scale=(ymax-ymin)/cwidth 360 lpo=-ymin/scale+1.5 361 if(lpo.eq.1)lpo=2 362 if(lpo)2,2,3 363 2 lpo=2 364 3 do 10 j=1,72 365 10 m72(j)=" " 366 ylabel(1)=ymin 367 ylabel(5)=ymax 368 ylabel(3)=(ylabel(1)+ylabel(5))/2. 369 ylabel(2)=(ylabel(1)+ylabel(3))/2. 370 ylabel(4)=(ylabel(3)+ylabel(5))/2. 371 print 115,ylabel 372 return 373 20 icount=icount+1 374 if(x)910,888,910 375 888 isign=1 376 print 110 377 go to 907 378 900 print 106 379 go to 907 380 907 return 381 910 do 930 j=1,n 382 if(y(j).le.ymin)go to 921 383 z=(y(j)-ymin)/scale+1.5 384 if(z-1.)921,921,920 385 920 if(z-cwidth)928,928,925 386 921 l=2 387 go to 929 388 925 l=72 389 go to 929 390 928 l=z 391 if(l)921,921,929 392 929 m72(lpo)=marki 393 m72(l)=mark(j) 394 930 continue 395 931 do 934 j=1,72 396 if(m72(j).eq.iblank)go to 934 397 933 jj=j 398 934 continue 399 ncount=ncount+1 400 if(ncount-1)900,940,936 401 936 if((ncount/10)*10-ncount)938,940,938 402 938 print 102,(m72(j),j=2,jj) 403 go to 962 404 940 m72(lpo)=markx 405 950 print 103,x,(m72(j),j=13,jj) 406 962 do 970 j=1,72 407 970 m72(j)=iblank 408 if(icount.eq.ntot.and.isign.ne.1)go to 975 409 return 410 975 isign=1 411 print 110 412 print 115,ylabel 413 102 format(1x,71a1) 414 103 format(1x,1pe11.4,60a1) 415 106 format(" input error") 416 110 format(2h y,2(16(1h-),1hy),2(17(1h-),1hy)) 417 115 format(1x,1pe11.4,1pe14.4,1p3e15.4) 418 return 419 end Subroutine plot NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES cwidth 007741 static real ref 355 355 359 385 iblank 000010 static character(1) initialized ref 352 353 396 407 icount 007743 static integer ref 358 373 373 408 ind parameter position 6 integer ref 349 356 isign 007747 static integer ref 375 408 410 j 007746 static integer ref 364 365 381 382 383 393 395 396 397 402 402 405 405 406 407 jj 007752 static integer ref 397 402 405 l 007751 static integer ref 386 388 390 391 393 lpo 007745 static integer ref 360 361 361 362 363 392 404 m72 007631 static character(1) array(72) ref 352 365 392 393 396 402 404 405 407 mark 000013 static character(1) array(9) initialized ref 352 354 393 marki 000012 static character(1) initialized ref 352 353 392 markx 000011 static character(1) initialized ref 352 353 404 n parameter position 5 integer ref 349 350 381 ncount 007742 static integer ref 357 399 399 400 401 401 ntot parameter position 7 integer ref 349 408 plot entry point 003446 constant on line 349 scale 007744 static real ref 359 360 383 x parameter position 1 real ref 349 374 405 y parameter position 2 real array(n) ref 349 350 382 383 ylabel 007624 static real array(5) ref 350 366 367 368 368 368 369 369 369 370 370 370 371 412 ymax parameter position 3 real ref 349 359 367 ymin parameter position 4 real ref 349 359 359 360 366 382 383 z 007750 static real ref 383 384 385 390 LOC LABEL TYPE LINE REFERENCES 003475 1 executable 357 used in transfer ref 356 003521 2 executable 363 used in transfer ref 362 362 003523 3 executable 364 used in transfer ref 362 003525 10 executable 365 ref 364 003577 20 executable 373 used in transfer ref 356 356 102 format 413 ref 402 103 format 414 ref 405 106 format 415 ref 378 110 format 416 ref 376 411 115 format 417 ref 371 412 003603 888 executable 375 used in transfer ref 374 003615 900 executable 378 used in transfer ref 400 003625 907 executable 380 used in transfer ref 377 379 003626 910 executable 381 used in transfer ref 374 374 003652 920 executable 385 used in transfer ref 384 003656 921 executable 386 used in transfer ref 382 384 384 391 391 003661 925 executable 388 used in transfer ref 385 003664 928 executable 390 used in transfer ref 385 385 003671 929 executable 392 used in transfer ref 387 389 391 003705 930 executable 394 ref 381 003711 931 executable 395 003722 933 executable 397 003724 934 executable 398 used in transfer ref 395 396 003736 936 executable 401 used in transfer ref 400 003744 938 executable 402 used in transfer ref 401 401 003766 940 executable 404 used in transfer ref 400 401 003773 950 executable 405 004021 962 executable 406 used in transfer ref 403 004023 970 executable 407 ref 406 004047 975 executable 410 used in transfer ref 408 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 349 003445 355 003470 356 003472 357 003475 358 003476 359 003477 360 003503 361 003512 362 003516 363 003521 364 003523 365 003525 366 003536 367 003540 368 003542 369 003546 370 003552 371 003556 372 003576 373 003577 374 003600 375 003603 376 003605 377 003614 378 003615 379 003624 380 003625 381 003626 382 003632 383 003640 384 003647 385 003652 386 003656 387 003660 388 003661 389 003663 390 003664 391 003667 392 003671 393 003676 394 003705 395 003711 396 003713 397 003722 398 003724 399 003730 400 003731 401 003736 402 003744 403 003765 404 003766 405 003773 406 004021 407 004023 408 004034 409 004046 410 004047 411 004051 412 004060 418 004100 Function rndnrm 420 c rndnrm---normal random number generator 421 cSTART rndnrm 422 function rndnrm(s) 423 2 r1=flat(s);w=flat(s)-.5;x=abs(w)-.2 424 4 if(x) 6 ,6,8 425 6 if(r1-.9955698)32,32,30 426 8 if(x-.17) 9,9,14 427 9 if(r1-.59035036) 32,32,10 428 10 r1mtl=81.3*x*x*x-.9895+r1 429 if(r1mtl)32,32,12 430 12 if(r1mtl-.0235)30,30,2 431 14 if(x-.24) 16,16,20 432 16 if(r1-2.024+8.4*x)18,18,2 433 18 if(10.13*x-2.31245+r1)32,32,30 434 20 if(r1-.008) 30 ,30,2 435 30 z=.250000004-w*w 436 rndnrm=w*(1.77079939+.402454407/z) 437 t=.119047619*(.5-z)/(z*z)+.523809524 438 t=t*exp(-.5*rndnrm*rndnrm) 439 if(r1-t)40,40,2 440 32 rndnrm=w*(1.77079939+.402454407/(.250000004-w*w)) 441 40 return 442 end Function rndnrm NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES abs builtin ref 423 exp builtin ref 438 flat external function 010034 constant real ref 423 423 r1 000455 automatic real ref 423 423 425 427 428 432 433 434 439 r1mtl 000460 automatic real ref 428 429 430 rndnrm 000454 automatic real ref 422 436 438 438 440 rndnrm entry point 004102 constant real on line 422 s parameter position 1 real ref 422 423 423 t 000462 automatic real ref 437 438 438 439 w 000456 automatic real ref 423 423 435 435 436 440 440 440 x 000457 automatic real ref 423 424 426 428 428 428 431 432 433 z 000461 automatic real ref 435 436 437 437 437 437 LOC LABEL TYPE LINE REFERENCES 004122 2 executable 423 used in transfer ref 430 432 434 439 004157 4 executable 424 004161 6 executable 425 used in transfer ref 424 424 004165 8 executable 426 used in transfer ref 424 004171 9 executable 427 used in transfer ref 426 426 004175 10 executable 428 used in transfer ref 427 004206 12 executable 430 used in transfer ref 429 004212 14 executable 431 used in transfer ref 426 004216 16 executable 432 used in transfer ref 431 431 004226 18 executable 433 used in transfer ref 432 432 004234 20 executable 434 used in transfer ref 431 004240 30 executable 435 used in transfer ref 425 430 430 433 434 434 004301 32 executable 440 used in transfer ref 425 425 427 427 429 429 433 433 004311 40 executable 441 used in transfer ref 439 439 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 422 004101 423 004122 423 004136 423 004153 424 004157 425 004161 426 004165 427 004171 428 004175 429 004204 430 004206 431 004212 432 004216 433 004226 434 004234 435 004240 436 004245 437 004252 438 004263 439 004275 440 004301 441 004311 WARNING 36 on line 435 The real constant .250000004 has more than 8 digits and has been converted to double precision. WARNING 36 on line 436 The real constant 1.77079939 has more than 8 digits and has been converted to double precision. WARNING 36 on line 436 The real constant .402454407 has more than 8 digits and has been converted to double precision. WARNING 36 on line 437 The real constant .119047619 has more than 8 digits and has been converted to double precision. WARNING 36 on line 437 The real constant .523809524 has more than 8 digits and has been converted to double precision. WARNING 36 on line 440 The real constant 1.77079939 has more than 8 digits and has been converted to double precision. WARNING 36 on line 440 The real constant .402454407 has more than 8 digits and has been converted to double precision. WARNING 36 on line 440 The real constant .250000004 has more than 8 digits and has been converted to double precision. Function tdist 443 c tdist 444 cSTART tdist 445 function tdist(ix,a,x) 446 a1 = a/2. 447 a2 = .5 448 if(ix .eq. 1) go to 20 449 if(x .lt. 1.e-20) go to 10 450 y = a/(a+x*x) 451 tdist = 1.-beta(0,y,a1,a2) 452 453 5 return 454 10 tdist = 0. 455 go to 5 456 20 y = 1.-x 457 fx = beta(1,y,a1,a2) 458 tdist = sqrt(a*((1./fx)-1.)) 459 go to 5 460 end Function tdist NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 2 real ref 445 446 450 450 458 a1 000465 automatic real ref 446 446 451 457 a2 000466 automatic real ref 447 451 457 beta internal function constant on line 17 real ref 451 457 fx 000470 automatic real ref 457 458 ix parameter position 1 integer ref 445 448 sqrt builtin ref 458 tdist 000464 automatic real ref 445 451 454 458 tdist entry point 004315 constant real on line 445 x parameter position 3 real ref 445 449 450 450 456 y 000467 automatic real ref 450 451 456 457 LOC LABEL TYPE LINE REFERENCES 004365 5 executable 453 used in transfer ref 455 459 004370 10 executable 454 used in transfer ref 449 004373 20 executable 456 used in transfer ref 448 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 445 004314 446 004335 447 004340 448 004342 449 004346 450 004352 451 004357 453 004365 454 004370 455 004372 456 004373 457 004376 458 004403 459 004413 Subroutine rkpb1 461 subroutine rkpb1(exit,temp,x,dx,y,f,n) 462 463 c **************runge=kutta integration ******** 464 c *******calculate derivatines *************** 465 c *******store functions and derivatives ********** 466 dimension temp(999),y(n),f(n) 467 external exit 468 c *******initialization *************************** 469 101 m=n+1 470 temp(2*m+1)=x 471 do 121 i=2,m 472 ip2m=i+2*m 473 121 temp(ip2m)=y(i-1) 474 call exit 475 temp(3*m+1)=dx 476 do 141 i=2,m 477 ip3m=i+3*m 478 141 temp(ip3m)=f(i-1) 479 5001 return 480 end Subroutine rkpb1 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES dx parameter position 4 real ref 461 475 exit external subroutine parameter position 1 ref 461 467 474 f parameter position 6 real array(n) ref 461 466 478 i 000473 automatic integer ref 471 472 473 476 477 478 ip2m 000474 automatic integer ref 472 473 ip3m 000475 automatic integer ref 477 478 m 000472 automatic integer ref 469 469 470 471 472 475 476 477 n parameter position 7 integer ref 461 466 466 469 rkpb1 entry point 004415 constant on line 461 temp parameter position 2 real array(999) ref 461 466 470 473 475 478 x parameter position 3 real ref 461 470 y parameter position 5 real array(n) ref 461 466 473 LOC LABEL TYPE LINE REFERENCES 004441 101 executable 469 004462 121 executable 473 ref 471 004522 141 executable 478 ref 476 004535 5001 executable 479 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 461 004414 469 004441 470 004444 471 004452 472 004456 473 004462 474 004475 475 004503 476 004512 477 004516 478 004522 479 004535 Subroutine rkpb2 481 subroutine rkpb2(deriv,temp,x,dx,y,f,n) 482 dimension temp(999),y(n),f(n),rkcon(4) 483 external deriv 484 data rkcon/1.,2.,2.,1./ 485 c ************integrate to next point ********** 486 401 m=n+1 487 c **************restore previous values 488 x=temp(2*m+1) 489 do 421 i=2,m 490 ip2m=i+2*m 491 y(i-1)=temp(ip2m) 492 ip3m=ip2m+m 493 f(i-1)=temp(ip3m) 494 421 temp(i)=0.0 495 do 491 j=1,4 496 c *****************compute ki,s,delts *********** 497 do 441 i=2,m 498 ipm =i+m 499 temp(ipm)=f(i-1)*dx 500 441 temp(i)=temp(i)+temp(ipm)*rkcon(j) 501 if (j.eq.4) go to 501 502 x=temp(2*m+1)+dx/rkcon(j+1) 503 do 461 i=2,m 504 ipm=i+m 505 ip2m=ipm+m 506 461 y(i-1)=temp(ip2m)+temp(ipm)/rkcon(j+1) 507 call deriv 508 491 continue 509 501 x=temp(2*m+1)+dx 510 do 521 i=2,m 511 ip2m=i+2*m 512 521 y(i-1)=temp(ip2m)+temp(i)/6.0 513 5001 return 514 end Subroutine rkpb2 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES deriv external subroutine parameter position 1 ref 481 483 507 dx parameter position 4 real ref 481 499 502 509 f parameter position 6 real array(n) ref 481 482 493 499 i 000477 automatic integer ref 489 490 491 493 494 497 498 499 500 500 503 504 506 510 511 512 512 ip2m 000500 automatic integer ref 490 491 492 505 506 511 512 ip3m 000501 automatic integer ref 492 493 ipm 000503 automatic integer ref 498 499 500 504 505 506 j 000502 automatic integer ref 495 500 501 502 506 m 000476 automatic integer ref 486 486 488 489 490 492 497 498 502 503 504 505 509 510 511 n parameter position 7 integer ref 481 482 482 486 rkcon 000202 automatic real array(4) initialized ref 482 484 500 502 506 rkpb2 entry point 004537 constant on line 481 temp parameter position 2 real array(999) ref 481 482 488 491 493 494 499 500 500 500 502 506 506 509 512 512 x parameter position 3 real ref 481 488 502 509 y parameter position 5 real array(n) ref 481 482 491 506 512 LOC LABEL TYPE LINE REFERENCES 004563 401 executable 486 004621 421 executable 494 ref 489 004652 441 executable 500 ref 497 004716 461 executable 506 ref 503 004747 491 executable 508 ref 495 004753 501 executable 509 used in transfer ref 501 004773 521 executable 512 ref 510 005012 5001 executable 513 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 481 004536 486 004563 488 004566 489 004573 490 004577 491 004603 492 004613 493 004616 494 004621 495 004630 497 004632 498 004636 499 004641 500 004652 501 004664 502 004670 503 004705 504 004711 505 004714 506 004716 507 004741 508 004747 509 004753 510 004763 511 004767 512 004773 513 005012 Subroutine gasp 515 c gaspiia Modified Feb 1975 516 c Start gasp 517 subroutine gasp(nset,qset) 518 dimension nset(999),qset(999) 519 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 520 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 521 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 522 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 523 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 524 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 525 character fname*16 526 double precision stat 527 equivalence (istat,stat) 528 external com_err_ (descriptors), attach (descriptors), 529 & datan (descriptors), montr (descriptors), rmove (descriptors), 530 & events (descriptors), sumry (descriptors), otput (descriptors), 531 & error (descriptors), detach 532 ncrdr=10 533 nprnt=6 534 not = 0 535 call attach (istat) 536 if (istat) 5656,4545,5656 537 5656 call com_err_(stat,"gasp","error in attaching") 538 stop 539 4545 continue 540 1 call datan(nset,qset) 541 jevnt = 101 542 call montr (nset,qset) 543 write (nprnt,403) 544 403 format(1h ,3x,24h**intermediate results**//) 545 10 call rmove(mfe(1),1,nset,qset) 546 tnow = atrib(1) 547 jevnt = jtrib(1) 548 if(jevnt - 100)13,12,6 549 13 i = jevnt 550 call events (i,nset,qset) 551 if (mstop) 40,8,20 552 40 mstop = 0 553 if (norpt) 14,22,42 554 20 if(tnow-tfin)8,22,22 555 22 call sumry(nset,qset) 556 call otput (nset,qset) 557 42 if(nruns-1)14,9,23 558 23 nruns = nruns - 1 559 nrun = nrun + 1 560 go to 1 561 14 call error(93,nset,qset) 562 6 call montr(nset,qset) 563 go to 10 564 12 if(jmnit)14,30,31 565 30 jmnit = 1 566 go to 10 567 31 jmnit = 0 568 go to 10 569 8 if(jmnit)14,10,32 570 32 jtrib(1)=jevnt 571 jevnt = 100 572 call montr(nset,qset) 573 go to 10 574 9 end file 10 575 call detach 576 return 577 end Subroutine gasp NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES atrib 000042 // real array(10) ref 522 546 attach external subroutine 010042 constant with descriptors ref 528 535 blnk*com common block name 398 words ref 519 522 com_err_ external subroutine 010040 constant with descriptors ref 528 537 datan internal subroutine constant with descriptors ref 528 540 detach external subroutine 010044 constant ref 528 575 error internal subroutine constant with descriptors ref 528 561 events internal subroutine constant with descriptors ref 528 550 gasp entry point 005014 constant on line 517 i 000506 automatic integer ref 549 550 istat 000504 automatic integer equivalenced ref 527 535 536 jevnt 000003 // integer ref 519 541 547 548 549 570 571 jmnit 000004 // integer ref 519 564 565 567 569 jtrib 000602 // integer array(12) ref 522 547 570 mfe 000252 // integer array(4) ref 522 545 montr internal subroutine constant with descriptors ref 528 542 562 572 mstop 000006 // integer ref 519 551 552 ncrdr 000031 // integer ref 519 532 532 norpt 000014 // integer ref 519 553 not 000015 // integer ref 519 534 nprnt 000030 // integer ref 519 533 543 nrun 000017 // integer ref 519 559 559 nruns 000020 // integer ref 519 557 558 558 nset parameter position 1 integer array(999) ref 517 518 540 542 545 550 555 556 561 562 572 otput internal subroutine constant with descriptors ref 528 556 qset parameter position 2 real array(999) ref 517 518 540 542 545 550 555 556 561 562 572 rmove internal subroutine constant with descriptors ref 528 545 stat 000504 automatic double precision equivalenced ref 526 527 537 sumry internal subroutine constant with descriptors ref 528 555 tfin 000026 // real ref 519 554 tnow 000024 // real ref 519 546 554 NAMES DECLARED BUT NOT USED enq 000054 // real array(4) declared 522 fname character(16) declared 525 id 000000 // integer declared 519 im 000001 // integer declared 519 imm 000037 // integer declared 519 init 000002 // integer declared 519 inn 000060 // integer array(4) declared 522 iseed 000023 // integer declared 519 jcels 000064 // integer array(5,22) declared 522 jclr 000601 // integer declared 522 krank 000242 // integer array(4) declared 522 maxnq 000246 // integer array(4) declared 522 maxns 000041 // integer declared 519 maxqs 000040 // integer declared 519 mfa 000005 // integer declared 519 mlc 000256 // integer array(4) declared 522 mle 000262 // integer array(4) declared 522 mon 000576 // integer declared 522 mx 000007 // integer declared 519 mxc 000010 // integer declared 519 mxx 000027 // integer declared 519 name 000567 // integer array(6) declared 522 ncels 000266 // integer array(5) declared 522 nclct 000011 // integer declared 519 nday 000577 // integer declared 522 nep 000032 // integer declared 519 nhist 000012 // integer declared 519 noq 000013 // integer declared 519 nprms 000016 // integer declared 519 nproj 000575 // integer declared 522 nq 000273 // integer array(4) declared 522 nstat 000021 // integer declared 519 nyr 000600 // integer declared 522 out 000022 // real declared 519 param 000277 // real array(20,4) declared 522 qtime 000417 // real array(4) declared 522 ssuma 000423 // real array(10,5) declared 522 suma 000505 // real array(10,5) declared 522 tbeg 000025 // real declared 519 vnq 000033 // real array(4) declared 519 LOC LABEL TYPE LINE REFERENCES 005103 1 executable 540 used in transfer ref 560 005313 6 executable 562 used in transfer ref 548 005343 8 executable 569 used in transfer ref 551 554 005371 9 executable 574 used in transfer ref 557 005144 10 executable 545 used in transfer ref 563 566 568 569 573 005327 12 executable 564 used in transfer ref 548 005175 13 executable 549 used in transfer ref 548 005276 14 executable 561 used in transfer ref 553 557 564 569 005230 20 executable 554 used in transfer ref 551 005235 22 executable 555 used in transfer ref 553 554 554 005271 23 executable 558 used in transfer ref 557 005334 30 executable 565 used in transfer ref 564 005340 31 executable 567 used in transfer ref 564 005350 32 executable 570 used in transfer ref 569 005222 40 executable 552 used in transfer ref 551 005263 42 executable 557 used in transfer ref 553 403 format 544 ref 543 005103 4545 executable 539 used in transfer ref 536 005057 5656 executable 537 used in transfer ref 536 536 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 517 005013 532 005034 533 005037 534 005041 535 005042 536 005054 537 005057 538 005101 539 005103 540 005103 541 005116 542 005121 543 005134 545 005144 546 005164 547 005167 548 005171 549 005175 550 005200 551 005215 552 005222 553 005224 554 005230 555 005235 556 005250 557 005263 558 005271 559 005274 560 005275 561 005276 562 005313 563 005326 564 005327 565 005334 566 005337 567 005340 568 005342 569 005343 570 005350 571 005353 572 005355 573 005370 574 005371 575 005376 576 005404 Function amax 578 function amax(arg1,arg2) 579 if (arg1 - arg2) 2,1,1 580 1 amax = arg1 581 return 582 2 amax = arg2 583 return 584 end Function amax NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES amax entry point 005406 constant real on line 578 amax 000510 automatic real ref 578 580 582 arg1 parameter position 1 real ref 578 579 580 arg2 parameter position 2 real ref 578 579 582 LOC LABEL TYPE LINE REFERENCES 005432 1 executable 580 used in transfer ref 579 579 005436 2 executable 582 used in transfer ref 579 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 578 005405 579 005426 580 005432 581 005434 582 005436 583 005440 Function amin 585 function amin (arg1,arg2) 586 if (arg1-arg2) 1,1,2 587 1 amin = arg1 588 return 589 2 amin = arg2 590 return 591 end Function amin NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES amin entry point 005443 constant real on line 585 amin 000512 automatic real ref 585 587 589 arg1 parameter position 1 real ref 585 586 587 arg2 parameter position 2 real ref 585 586 589 LOC LABEL TYPE LINE REFERENCES 005467 1 executable 587 used in transfer ref 586 586 005473 2 executable 589 used in transfer ref 586 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 585 005442 586 005463 587 005467 588 005471 589 005473 590 005475 Subroutine colct 592 cSTART colct 593 subroutine colct (x,n,nset,qset) 594 dimension nset(999),qset(999) 595 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 596 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 597 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 598 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 599 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 600 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 601 external error(descriptors) 602 if (n) 2,2,1 603 2 call error(90,nset,qset) 604 1 if (n- nclct) 3,3,2 605 3 suma(n,1) = suma(n,1)+x 606 suma(n,2) = suma(n,2)+x*x 607 suma(n,3) = suma(n,3)+1.0 608 suma(n,4) = amin (suma(n,4),x) 609 suma(n,5) = amax (suma(n,5),x) 610 return 611 end Subroutine colct NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES amax internal function constant on line 578 real ref 609 amin internal function constant on line 585 real ref 608 blnk*com common block name 398 words ref 595 598 colct entry point 005500 constant on line 593 error internal subroutine constant with descriptors ref 601 603 n parameter position 2 integer ref 593 602 604 605 605 606 606 607 607 608 608 609 609 nclct 000011 // integer ref 595 604 nset parameter position 3 integer array(999) ref 593 594 603 qset parameter position 4 real array(999) ref 593 594 603 suma 000505 // real array(10,5) ref 598 605 605 606 606 607 607 608 608 609 609 x parameter position 1 real ref 593 605 606 606 608 609 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 598 enq 000054 // real array(4) declared 598 id 000000 // integer declared 595 im 000001 // integer declared 595 imm 000037 // integer declared 595 init 000002 // integer declared 595 inn 000060 // integer array(4) declared 598 iseed 000023 // integer declared 595 jcels 000064 // integer array(5,22) declared 598 jclr 000601 // integer declared 598 jevnt 000003 // integer declared 595 jmnit 000004 // integer declared 595 jtrib 000602 // integer array(12) declared 598 krank 000242 // integer array(4) declared 598 maxnq 000246 // integer array(4) declared 598 maxns 000041 // integer declared 595 maxqs 000040 // integer declared 595 mfa 000005 // integer declared 595 mfe 000252 // integer array(4) declared 598 mlc 000256 // integer array(4) declared 598 mle 000262 // integer array(4) declared 598 mon 000576 // integer declared 598 mstop 000006 // integer declared 595 mx 000007 // integer declared 595 mxc 000010 // integer declared 595 mxx 000027 // integer declared 595 name 000567 // integer array(6) declared 598 ncels 000266 // integer array(5) declared 598 ncrdr 000031 // integer declared 595 nday 000577 // integer declared 598 nep 000032 // integer declared 595 nhist 000012 // integer declared 595 noq 000013 // integer declared 595 norpt 000014 // integer declared 595 not 000015 // integer declared 595 nprms 000016 // integer declared 595 nprnt 000030 // integer declared 595 nproj 000575 // integer declared 598 nq 000273 // integer array(4) declared 598 nrun 000017 // integer declared 595 nruns 000020 // integer declared 595 nstat 000021 // integer declared 595 nyr 000600 // integer declared 598 out 000022 // real declared 595 param 000277 // real array(20,4) declared 598 qtime 000417 // real array(4) declared 598 ssuma 000423 // real array(10,5) declared 598 tbeg 000025 // real declared 595 tfin 000026 // real declared 595 tnow 000024 // real declared 595 vnq 000033 // real array(4) declared 595 LOC LABEL TYPE LINE REFERENCES 005540 1 executable 604 used in transfer ref 602 005523 2 executable 603 used in transfer ref 602 602 604 005545 3 executable 605 used in transfer ref 604 604 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 593 005477 602 005520 603 005523 604 005540 605 005545 606 005552 607 005556 608 005561 609 005600 610 005617 Subroutine datan 612 cSTART datan 613 subroutine datan(nset,qset) 614 dimension nset(999),qset(999) 615 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 616 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 617 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 618 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 619 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 620 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 621 external error(descriptors), exit, drand(descriptors),set(descriptors),filem(descriptors) 622 if (not)23,1,2 623 2 nt=nep 624 go to (1,5,6,41,42,8,43,299,15,20),nt 625 23 call error(95,nset,qset) 626 1 not = 1 627 nrun = 1 628 read(ncrdr,100) name 629 c name = 12 alpha chars 630 100 format(6a2) 631 read (ncrdr,101) nproj,mon,nday,nyr,nruns 632 c nproj = 4 chars 633 c mon = 2 numeric chars 634 c nday = 2 numeric chars 635 c nyr = 4 numeric chars 636 c nruns = 4 numeric chars 637 101 format (v) 638 if(nruns) 30,30,5 639 30 call exit 640 5 read (ncrdr,803) nprms,nhist,nclct,nstat,id,im,noq,mxc,imm 641 803 format (v) 642 if (nhist) 41,41,6 643 6 read (ncrdr,803) (ncels(i),i=1,nhist) 644 41 read (ncrdr,803) (krank(i),i=1,noq) 645 42 read (ncrdr,803) (inn(i),i=1,noq) 646 if (nprms) 23,43,8 647 8 do 9 i = 1,nprms 648 read (ncrdr,803) (param(i,j),j=1,4) 649 9 continue 650 43 read (ncrdr, 803) mstop,jclr,norpt,nep,tbeg,tfin,jseed 651 if (jseed) 26,26,27 652 27 iseed=jseed 653 call drand(iseed,rnum) 654 tnow = tbeg 655 do 142 j=1,noq 656 142 qtime(j)=tnow 657 26 jmnit = 0 658 299 do 300 js = 1,id 659 read (ncrdr,803)jq,(jtrib(jk),jk=1,im) 660 if(jq) 44,15,320 661 44 init=1 662 call set(1,nset,qset) 663 go to 300 664 320 read(ncrdr,803) (atrib(jk),jk=1,imm) 665 call filem(jq,nset,qset) 666 300 continue 667 15 if( jclr )20,20,10 668 10 if(nclct)23,110,116 669 116 do 18 i = 1,nclct 670 do 17 j =1,3 671 17 suma(i,j) = 0. 672 suma(i,4) = 1.0e20 673 18 suma(i,5)= -1.0e20 674 110 if (nstat)23,111,117 675 117 do 360 i = 1,nstat 676 do 370 j = 1,3 677 370 ssuma(i,j) = 0. 678 ssuma(i,4) = 1.0e20 679 360 ssuma(i,5) = -1.0e20 680 111 if(nhist)23,20,118 681 118 do 380 k = 1,nhist 682 do 380 l = 1,mxc 683 380 jcels(k,l) = 0 684 20 write (nprnt,102) nproj,name,mon,nday,nyr,nrun 685 102 format (1h ,1x,22hsimulation project no.,i4,2x,2hby,2x, 686 & 6a2//,2x,4hdate,i3,1h/,i3,1h/,i5,12x,10hrun number,i5//) 687 if(nprms ) 60,60,62 688 62 do 64 i=1,nprms 689 64 write (nprnt,107) i,(param(i,j),j=1,4) 690 107 format(2x,14h parameter no.,i5,4f12.4) 691 60 return 692 end Subroutine datan NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES atrib 000042 // real array(10) ref 618 664 blnk*com common block name 398 words ref 615 618 datan entry point 005621 constant on line 613 drand internal subroutine constant with descriptors ref 621 653 error internal subroutine constant with descriptors ref 621 625 exit external subroutine 010046 constant ref 621 639 filem internal subroutine constant with descriptors ref 621 665 i 000515 automatic integer ref 643 643 644 644 645 645 647 648 669 671 672 673 675 677 678 679 688 689 689 id 000000 // integer ref 615 640 658 im 000001 // integer ref 615 640 659 imm 000037 // integer ref 615 640 664 init 000002 // integer ref 615 661 inn 000060 // integer array(4) ref 618 645 iseed 000023 // integer ref 615 652 653 j 000516 automatic integer ref 648 648 655 656 670 671 676 677 689 689 jcels 000064 // integer array(5,22) ref 618 683 jclr 000601 // integer ref 618 650 667 jk 000523 automatic integer ref 659 659 664 664 jmnit 000004 // integer ref 615 657 jq 000522 automatic integer ref 659 660 665 js 000521 automatic integer ref 658 jseed 000517 automatic integer ref 650 651 652 jtrib 000602 // integer array(12) ref 618 659 k 000524 automatic integer ref 681 683 krank 000242 // integer array(4) ref 618 644 l 000525 automatic integer ref 682 683 mon 000576 // integer ref 618 631 684 mstop 000006 // integer ref 615 650 mxc 000010 // integer ref 615 640 682 name 000567 // integer array(6) ref 618 628 684 ncels 000266 // integer array(5) ref 618 643 nclct 000011 // integer ref 615 640 668 669 ncrdr 000031 // integer ref 615 628 631 640 643 644 645 648 650 659 664 nday 000577 // integer ref 618 631 684 nep 000032 // integer ref 615 623 650 nhist 000012 // integer ref 615 640 642 643 680 681 noq 000013 // integer ref 615 640 644 645 655 norpt 000014 // integer ref 615 650 not 000015 // integer ref 615 622 626 nprms 000016 // integer ref 615 640 646 647 687 688 nprnt 000030 // integer ref 615 684 689 nproj 000575 // integer ref 618 631 684 nrun 000017 // integer ref 615 627 684 nruns 000020 // integer ref 615 631 638 nset parameter position 1 integer array(999) ref 613 614 625 662 665 nstat 000021 // integer ref 615 640 674 675 nt 000514 automatic integer ref 623 624 nyr 000600 // integer ref 618 631 684 param 000277 // real array(20,4) ref 618 648 689 qset parameter position 2 real array(999) ref 613 614 625 662 665 qtime 000417 // real array(4) ref 618 656 rnum 000520 automatic real ref 653 set internal subroutine constant with descriptors ref 621 662 ssuma 000423 // real array(10,5) ref 618 677 678 679 suma 000505 // real array(10,5) ref 618 671 672 673 tbeg 000025 // real ref 615 650 654 tfin 000026 // real ref 615 650 tnow 000024 // real ref 615 654 656 NAMES DECLARED BUT NOT USED enq 000054 // real array(4) declared 618 jevnt 000003 // integer declared 615 maxnq 000246 // integer array(4) declared 618 maxns 000041 // integer declared 615 maxqs 000040 // integer declared 615 mfa 000005 // integer declared 615 mfe 000252 // integer array(4) declared 618 mlc 000256 // integer array(4) declared 618 mle 000262 // integer array(4) declared 618 mx 000007 // integer declared 615 mxx 000027 // integer declared 615 nq 000273 // integer array(4) declared 618 out 000022 // real declared 615 vnq 000033 // real array(4) declared 615 LOC LABEL TYPE LINE REFERENCES 005705 1 executable 626 used in transfer ref 622 624 005646 2 executable 623 used in transfer ref 622 006015 5 executable 640 used in transfer ref 624 638 006122 6 executable 643 used in transfer ref 624 642 006215 8 executable 647 used in transfer ref 624 646 006255 9 executable 649 ref 647 006535 10 executable 668 used in transfer ref 667 006531 15 executable 667 used in transfer ref 624 660 006551 17 executable 671 ref 670 006567 18 executable 673 ref 669 006673 20 executable 684 used in transfer ref 624 667 667 680 005670 23 executable 625 used in transfer ref 622 646 668 674 680 006403 26 executable 657 used in transfer ref 651 651 006350 27 executable 652 used in transfer ref 651 006007 30 executable 639 used in transfer ref 638 638 006144 41 executable 644 used in transfer ref 624 642 642 006166 42 executable 645 used in transfer ref 624 006261 43 executable 650 used in transfer ref 624 646 006445 44 executable 661 used in transfer ref 660 007030 60 executable 691 used in transfer ref 687 687 006757 62 executable 688 used in transfer ref 687 006764 64 executable 689 ref 688 100 format 630 ref 628 101 format 637 ref 631 102 format 685 ref 684 107 format 690 ref 689 006575 110 executable 674 used in transfer ref 668 006635 111 executable 680 used in transfer ref 674 006542 116 executable 669 used in transfer ref 668 006602 117 executable 675 used in transfer ref 674 006642 118 executable 681 used in transfer ref 680 006373 142 executable 656 ref 655 006405 299 executable 658 used in transfer ref 624 006525 300 executable 666 used in transfer ref 658 663 006466 320 executable 664 used in transfer ref 660 006627 360 executable 679 ref 675 006611 370 executable 677 ref 676 006654 380 executable 683 ref 681 682 803 format 641 ref 640 643 644 645 648 650 659 664 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 613 005620 622 005641 623 005646 624 005651 625 005670 626 005705 627 005710 628 005711 631 005732 638 006003 639 006007 640 006015 642 006116 643 006122 644 006144 645 006166 646 006210 647 006215 648 006222 649 006255 650 006261 651 006345 652 006350 653 006353 654 006364 655 006367 656 006373 657 006403 658 006405 659 006412 660 006441 661 006445 662 006450 663 006465 664 006466 665 006510 666 006525 667 006531 668 006535 669 006542 670 006547 671 006551 672 006564 673 006567 674 006575 675 006602 676 006607 677 006611 678 006624 679 006627 680 006635 681 006642 682 006647 683 006654 684 006673 687 006753 688 006757 689 006764 691 007030 Subroutine drand 693 subroutine drand(iseed,rnum) 694 external randu(descriptors) 695 call randu (iseed,rnum) 696 return 697 end Subroutine drand NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES drand entry point 007032 constant on line 693 iseed parameter position 1 integer ref 693 695 randu internal subroutine constant with descriptors ref 694 695 rnum parameter position 2 real ref 693 695 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 693 007031 695 007052 696 007063 Subroutine error 698 cSTART error 699 subroutine error(j,nset,qset) 700 dimension nset(999),qset(999) 701 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 702 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 703 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 704 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 705 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 706 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 707 write (nprnt,100) j,tnow 708 100 format(//2x,16herror exit, type,i3,7h error.//19h file status 709 & a time,f10.4/) 710 write (nprnt,200) 711 200 format(18x,4hnset/) 712 do 210 i=1,id 713 il=(i-1)*mxx+1 714 iv=il+mxx-1 715 210 write(nprnt,90) i,(nset(ij),ij=il,iv) 716 90 format(1x,i5,5x,8i8,/,13x,4i8) 717 write (nprnt,202) 718 202 format(//18x,4hqset/) 719 do 215 i=1,id 720 il=(i-1)*imm+1 721 iv=il+imm-1 722 215 write(nprnt,95) i,(qset(ij),ij=il,iv) 723 95 format(1x,i5,4x,5e13.6,/,11x,5e13.6) 724 if(nclct) 7,7,8 725 8 write (nprnt,98) 726 98 format(/11h array suma,/) 727 do 110 i=1,nclct 728 110 write (nprnt,80) i,(suma(i,k),k=1,5) 729 80 format(i10,5f10.4) 730 write (nprnt,99) 731 7 if(nstat)9,9,10 732 10 write (nprnt,97) 733 97 format(/12h array ssuma/) 734 do 111 i=1,nstat 735 111 write (nprnt,80) i,(ssuma(i,k),k=1,5) 736 write (nprnt,99) 737 9 if(nhist) 11,11,12 738 12 write (nprnt,96) 739 96 format (/12h array jcels/) 740 do 112 i=1,nhist 741 ncl=ncels (i)+2 742 112 write (nprnt,26) i,(jcels(i,k),k=1,ncl) 743 26 format(2x,i3,4x,15i4,/11x,15i4) 744 11 nfool = 0 745 if (nfool) 3,4,3 746 3 return 747 4 stop 748 99 format(1h ) 749 end Subroutine error NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 398 words ref 701 704 error entry point 007065 constant on line 699 i 000526 automatic integer ref 712 713 715 719 720 722 727 728 728 734 735 735 740 741 742 742 id 000000 // integer ref 701 712 719 ij 000531 automatic integer ref 715 715 722 722 il 000527 automatic integer ref 713 714 715 720 721 722 imm 000037 // integer ref 701 720 721 iv 000530 automatic integer ref 714 715 721 722 j parameter position 1 integer ref 699 707 jcels 000064 // integer array(5,22) ref 704 742 k 000532 automatic integer ref 728 728 735 735 742 742 mxx 000027 // integer ref 701 713 714 ncels 000266 // integer array(5) ref 704 741 ncl 000533 automatic integer ref 741 742 nclct 000011 // integer ref 701 724 727 nfool 000534 automatic integer ref 744 745 nhist 000012 // integer ref 701 737 740 nprnt 000030 // integer ref 701 707 710 715 717 722 725 728 730 732 735 736 738 742 nset parameter position 2 integer array(999) ref 699 700 715 nstat 000021 // integer ref 701 731 734 qset parameter position 3 real array(999) ref 699 700 722 ssuma 000423 // real array(10,5) ref 704 735 suma 000505 // real array(10,5) ref 704 728 tnow 000024 // real ref 701 707 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 704 enq 000054 // real array(4) declared 704 im 000001 // integer declared 701 init 000002 // integer declared 701 inn 000060 // integer array(4) declared 704 iseed 000023 // integer declared 701 jclr 000601 // integer declared 704 jevnt 000003 // integer declared 701 jmnit 000004 // integer declared 701 jtrib 000602 // integer array(12) declared 704 krank 000242 // integer array(4) declared 704 maxnq 000246 // integer array(4) declared 704 maxns 000041 // integer declared 701 maxqs 000040 // integer declared 701 mfa 000005 // integer declared 701 mfe 000252 // integer array(4) declared 704 mlc 000256 // integer array(4) declared 704 mle 000262 // integer array(4) declared 704 mon 000576 // integer declared 704 mstop 000006 // integer declared 701 mx 000007 // integer declared 701 mxc 000010 // integer declared 701 name 000567 // integer array(6) declared 704 ncrdr 000031 // integer declared 701 nday 000577 // integer declared 704 nep 000032 // integer declared 701 noq 000013 // integer declared 701 norpt 000014 // integer declared 701 not 000015 // integer declared 701 nprms 000016 // integer declared 701 nproj 000575 // integer declared 704 nq 000273 // integer array(4) declared 704 nrun 000017 // integer declared 701 nruns 000020 // integer declared 701 nyr 000600 // integer declared 704 out 000022 // real declared 701 param 000277 // real array(20,4) declared 704 qtime 000417 // real array(4) declared 704 tbeg 000025 // real declared 701 tfin 000026 // real declared 701 vnq 000033 // real array(4) declared 701 LOC LABEL TYPE LINE REFERENCES 007572 3 executable 746 used in transfer ref 745 745 007573 4 executable 747 used in transfer ref 745 007376 7 executable 731 used in transfer ref 724 724 007305 8 executable 725 used in transfer ref 724 007473 9 executable 737 used in transfer ref 731 731 007402 10 executable 732 used in transfer ref 731 007566 11 executable 744 used in transfer ref 737 737 007477 12 executable 738 used in transfer ref 737 26 format 743 ref 742 80 format 729 ref 728 735 90 format 716 ref 715 95 format 723 ref 722 96 format 739 ref 738 97 format 733 ref 732 98 format 726 ref 725 99 format 748 ref 730 736 100 format 708 ref 707 007322 110 executable 728 ref 727 007417 111 executable 735 ref 734 007521 112 executable 742 ref 740 200 format 711 ref 710 202 format 718 ref 717 007161 210 executable 715 ref 712 007244 215 executable 722 ref 719 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 699 007064 707 007105 710 007133 712 007143 713 007150 714 007156 715 007161 717 007216 719 007226 720 007233 721 007241 722 007244 724 007301 725 007305 727 007315 728 007322 730 007366 731 007376 732 007402 734 007412 735 007417 736 007463 737 007473 738 007477 740 007507 741 007514 742 007521 744 007566 745 007567 746 007572 747 007573 Subroutine filem 750 cSTART filem 751 subroutine filem (jq,nset,qset) 752 dimension nset(999),qset(999) 753 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 754 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 755 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 756 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 757 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 758 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 759 external error(descriptors), set(descriptors) 760 if (mfa - id ) 2,2,3 761 3 write (nprnt,4) 762 4 format (//24h overlap set given below/) 763 call error (87,nset,qset) 764 2 indx = (mfa - 1) * imm 765 do 1 i = 1,imm 766 indx = indx + 1 767 1 qset(indx) = atrib(i) 768 indx = (mfa - 1) * mxx 769 do 10 i = 1,im 770 indx = indx + 1 771 10 nset(indx) = jtrib(i) 772 call set (jq,nset,qset) 773 return 774 end Subroutine filem NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES atrib 000042 // real array(10) ref 756 767 blnk*com common block name 398 words ref 753 756 error internal subroutine constant on line 699 with descriptors ref 759 763 filem entry point 007576 constant on line 751 i 000537 automatic integer ref 765 767 769 771 id 000000 // integer ref 753 760 im 000001 // integer ref 753 769 imm 000037 // integer ref 753 764 765 indx 000536 automatic integer ref 764 766 766 767 768 770 770 771 jq parameter position 1 integer ref 751 772 jtrib 000602 // integer array(12) ref 756 771 mfa 000005 // integer ref 753 760 764 768 mxx 000027 // integer ref 753 768 nprnt 000030 // integer ref 753 761 nset parameter position 2 integer array(999) ref 751 752 763 771 772 qset parameter position 3 real array(999) ref 751 752 763 767 772 set internal subroutine constant with descriptors ref 759 772 NAMES DECLARED BUT NOT USED enq 000054 // real array(4) declared 756 init 000002 // integer declared 753 inn 000060 // integer array(4) declared 756 iseed 000023 // integer declared 753 jcels 000064 // integer array(5,22) declared 756 jclr 000601 // integer declared 756 jevnt 000003 // integer declared 753 jmnit 000004 // integer declared 753 krank 000242 // integer array(4) declared 756 maxnq 000246 // integer array(4) declared 756 maxns 000041 // integer declared 753 maxqs 000040 // integer declared 753 mfe 000252 // integer array(4) declared 756 mlc 000256 // integer array(4) declared 756 mle 000262 // integer array(4) declared 756 mon 000576 // integer declared 756 mstop 000006 // integer declared 753 mx 000007 // integer declared 753 mxc 000010 // integer declared 753 name 000567 // integer array(6) declared 756 ncels 000266 // integer array(5) declared 756 nclct 000011 // integer declared 753 ncrdr 000031 // integer declared 753 nday 000577 // integer declared 756 nep 000032 // integer declared 753 nhist 000012 // integer declared 753 noq 000013 // integer declared 753 norpt 000014 // integer declared 753 not 000015 // integer declared 753 nprms 000016 // integer declared 753 nproj 000575 // integer declared 756 nq 000273 // integer array(4) declared 756 nrun 000017 // integer declared 753 nruns 000020 // integer declared 753 nstat 000021 // integer declared 753 nyr 000600 // integer declared 756 out 000022 // real declared 753 param 000277 // real array(20,4) declared 756 qtime 000417 // real array(4) declared 756 ssuma 000423 // real array(10,5) declared 756 suma 000505 // real array(10,5) declared 756 tbeg 000025 // real declared 753 tfin 000026 // real declared 753 tnow 000024 // real declared 753 vnq 000033 // real array(4) declared 753 LOC LABEL TYPE LINE REFERENCES 007662 1 executable 767 ref 765 007650 2 executable 764 used in transfer ref 760 760 007623 3 executable 761 used in transfer ref 760 4 format 762 ref 761 007705 10 executable 771 ref 769 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 751 007575 760 007616 761 007623 763 007633 764 007650 765 007655 766 007661 767 007662 768 007674 769 007700 770 007704 771 007705 772 007717 773 007733 Subroutine histo 775 cSTART histo 776 subroutine histo (x1,a,w,n) 777 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 778 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 779 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 780 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 781 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 782 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 783 external exit 784 if (n-nhist) 11,11,2 785 2 print 250,n 786 250 format(19h error in histogram,i4//) 787 call exit 788 11 if(n)2,2,3 789 3 x = x1 - a 790 if (x)6,7,7 791 6 ic = 1 792 go to 8 793 7 ic = x/w + 2. 794 if (ic - ncels(n) - 1) 8,8,9 795 9 ic = ncels(n)+2 796 8 jcels(n,ic) = jcels(n,ic) + 1 797 return 798 end Subroutine histo NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 2 real ref 776 789 blnk*com common block name 398 words ref 777 780 exit external subroutine 010046 constant ref 783 787 histo entry point 007735 constant on line 776 ic 000541 automatic integer ref 791 793 794 795 796 796 jcels 000064 // integer array(5,22) ref 780 796 796 n parameter position 4 integer ref 776 784 785 788 794 795 796 796 ncels 000266 // integer array(5) ref 780 794 795 nhist 000012 // integer ref 777 784 w parameter position 3 real ref 776 793 x 000540 automatic real ref 789 790 793 x1 parameter position 1 real ref 776 789 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 780 enq 000054 // real array(4) declared 780 id 000000 // integer declared 777 im 000001 // integer declared 777 imm 000037 // integer declared 777 init 000002 // integer declared 777 inn 000060 // integer array(4) declared 780 iseed 000023 // integer declared 777 jclr 000601 // integer declared 780 jevnt 000003 // integer declared 777 jmnit 000004 // integer declared 777 jtrib 000602 // integer array(12) declared 780 krank 000242 // integer array(4) declared 780 maxnq 000246 // integer array(4) declared 780 maxns 000041 // integer declared 777 maxqs 000040 // integer declared 777 mfa 000005 // integer declared 777 mfe 000252 // integer array(4) declared 780 mlc 000256 // integer array(4) declared 780 mle 000262 // integer array(4) declared 780 mon 000576 // integer declared 780 mstop 000006 // integer declared 777 mx 000007 // integer declared 777 mxc 000010 // integer declared 777 mxx 000027 // integer declared 777 name 000567 // integer array(6) declared 780 nclct 000011 // integer declared 777 ncrdr 000031 // integer declared 777 nday 000577 // integer declared 780 nep 000032 // integer declared 777 noq 000013 // integer declared 777 norpt 000014 // integer declared 777 not 000015 // integer declared 777 nprms 000016 // integer declared 777 nprnt 000030 // integer declared 777 nproj 000575 // integer declared 780 nq 000273 // integer array(4) declared 780 nrun 000017 // integer declared 777 nruns 000020 // integer declared 777 nstat 000021 // integer declared 777 nyr 000600 // integer declared 780 out 000022 // real declared 777 param 000277 // real array(20,4) declared 780 qtime 000417 // real array(4) declared 780 ssuma 000423 // real array(10,5) declared 780 suma 000505 // real array(10,5) declared 780 tbeg 000025 // real declared 777 tfin 000026 // real declared 777 tnow 000024 // real declared 777 vnq 000033 // real array(4) declared 777 LOC LABEL TYPE LINE REFERENCES 007762 2 executable 785 used in transfer ref 784 788 788 010012 3 executable 789 used in transfer ref 788 010017 6 executable 791 used in transfer ref 790 010022 7 executable 793 used in transfer ref 790 790 010043 8 executable 796 used in transfer ref 792 794 794 010036 9 executable 795 used in transfer ref 794 010007 11 executable 788 used in transfer ref 784 784 250 format 786 ref 785 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 776 007734 784 007755 785 007762 787 010001 788 010007 789 010012 790 010015 791 010017 792 010021 793 010022 794 010030 795 010036 796 010043 797 010057 Subroutine montr 799 subroutine montr(nset,qset) 800 dimension nset(999),qset(999) 801 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 802 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 803 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 804 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 805 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 806 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 807 if (jevnt - 101) 9,7,9 808 7 print 8 809 8 format(44h do you want to see a gasp job storage dump?) 810 print 10 811 10 format(10h0=no,1=yes) 812 read 11,no 813 11 format (i1) 814 if(no.eq.0)return 815 write(nprnt,100) tnow 816 100 format(1h1,2x,31h**gasp job storage area dump at,f10.4, 817 & 2x,12htime units**//) 818 write (nprnt,200) 819 200 format(5x,4hnset/) 820 do 210 i=1,id 821 il=(i-1)*mxx+1 822 iv=il+mxx-1 823 210 write(nprnt,90) i,(nset(ij),ij=il,iv) 824 90 format(2x,i5,5x,12i8) 825 write (nprnt,202) 826 202 format(//5x,4hqset/) 827 do 215 i=1,id 828 il=(i-1)*imm+1 829 iv=il+imm-1 830 215 write(nprnt,95) i,(qset(ij),ij=il,iv) 831 95 format(2x,i5,4x,5e13.6,/12x,5e13.6) 832 end file 11 833 return 834 9 if(mfe(1))3,6,1 835 1 if(jmnit-1)5,4,3 836 3 write (nprnt,199) 837 199 format(///2x,26h error exit,type 99 error.) 838 endfile 11 839 4 indx=mfe(1) 840 il=(indx-1)*mxx+1 841 iv=il+mxx-1 842 write (nprnt,103) tnow,jtrib(1),(nset(i),i=il,iv) 843 103 format (/2x,23hcurrent event....time =,f8.2,5x,7hevent =,i7, 844 &/2x,17hnext event(nset).,(6i8)) 845 il=(indx-1)*imm+1 846 iv=il+imm-1 847 write(nprnt,120)(qset(i),i=il,iv) 848 120 format(/2x,19hnext event(qset)...,(4e12.4)) 849 5 return 850 6 write (nprnt,104) tnow 851 104 format (2x,19h file 1 is empty at,f10.2) 852 go to 5 853 end Subroutine montr NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 398 words ref 801 804 i 000543 automatic integer ref 820 821 823 827 828 830 842 842 847 847 id 000000 // integer ref 801 820 827 ij 000546 automatic integer ref 823 823 830 830 il 000544 automatic integer ref 821 822 823 828 829 830 840 841 842 845 846 847 imm 000037 // integer ref 801 828 829 845 846 indx 000547 automatic integer ref 839 840 845 iv 000545 automatic integer ref 822 823 829 830 841 842 846 847 jevnt 000003 // integer ref 801 807 jmnit 000004 // integer ref 801 835 jtrib 000602 // integer array(12) ref 804 842 mfe 000252 // integer array(4) ref 804 834 839 montr entry point 010061 constant on line 799 mxx 000027 // integer ref 801 821 822 840 841 no 000542 automatic integer ref 812 814 nprnt 000030 // integer ref 801 815 818 823 825 830 836 842 847 850 nset parameter position 1 integer array(999) ref 799 800 823 842 qset parameter position 2 real array(999) ref 799 800 830 847 tnow 000024 // real ref 801 815 842 850 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 804 enq 000054 // real array(4) declared 804 im 000001 // integer declared 801 init 000002 // integer declared 801 inn 000060 // integer array(4) declared 804 iseed 000023 // integer declared 801 jcels 000064 // integer array(5,22) declared 804 jclr 000601 // integer declared 804 krank 000242 // integer array(4) declared 804 maxnq 000246 // integer array(4) declared 804 maxns 000041 // integer declared 801 maxqs 000040 // integer declared 801 mfa 000005 // integer declared 801 mlc 000256 // integer array(4) declared 804 mle 000262 // integer array(4) declared 804 mon 000576 // integer declared 804 mstop 000006 // integer declared 801 mx 000007 // integer declared 801 mxc 000010 // integer declared 801 name 000567 // integer array(6) declared 804 ncels 000266 // integer array(5) declared 804 nclct 000011 // integer declared 801 ncrdr 000031 // integer declared 801 nday 000577 // integer declared 804 nep 000032 // integer declared 801 nhist 000012 // integer declared 801 noq 000013 // integer declared 801 norpt 000014 // integer declared 801 not 000015 // integer declared 801 nprms 000016 // integer declared 801 nproj 000575 // integer declared 804 nq 000273 // integer array(4) declared 804 nrun 000017 // integer declared 801 nruns 000020 // integer declared 801 nstat 000021 // integer declared 801 nyr 000600 // integer declared 804 out 000022 // real declared 801 param 000277 // real array(20,4) declared 804 qtime 000417 // real array(4) declared 804 ssuma 000423 // real array(10,5) declared 804 suma 000505 // real array(10,5) declared 804 tbeg 000025 // real declared 801 tfin 000026 // real declared 801 vnq 000033 // real array(4) declared 801 LOC LABEL TYPE LINE REFERENCES 010351 1 executable 835 used in transfer ref 834 010357 3 executable 836 used in transfer ref 834 835 010374 4 executable 839 used in transfer ref 835 010503 5 executable 849 used in transfer ref 835 852 010504 6 executable 850 used in transfer ref 834 010106 7 executable 808 used in transfer ref 807 8 format 809 ref 808 010344 9 executable 834 used in transfer ref 807 807 10 format 811 ref 810 11 format 813 ref 812 90 format 824 ref 823 95 format 831 ref 830 100 format 816 ref 815 103 format 843 ref 842 104 format 851 ref 850 120 format 848 ref 847 199 format 837 ref 836 200 format 819 ref 818 202 format 826 ref 825 010216 210 executable 823 ref 820 010301 215 executable 830 ref 827 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 799 010060 807 010101 808 010106 810 010115 812 010124 814 010143 815 010147 818 010170 820 010200 821 010205 822 010213 823 010216 825 010253 827 010263 828 010270 829 010276 830 010301 832 010336 833 010343 834 010344 835 010351 836 010357 838 010367 839 010374 840 010377 841 010404 842 010407 845 010447 846 010454 847 010457 849 010503 850 010504 852 010525 Subroutine tmst 854 cSTART tmst 855 subroutine tmst (x,t,n,nset,qset) 856 dimension nset(999),qset(999) 857 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 858 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 859 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 860 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 861 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 862 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 863 external error (descriptors) 864 if (n) 2,2,1 865 2 call error(91,nset,qset) 866 1 if(n-nstat)3,3,2 867 3 tt= t-ssuma(n,1) 868 ssuma(n,1) = ssuma(n,1) + tt 869 ssuma(n,2) = ssuma(n,2)+x*tt 870 ssuma(n,3) = ssuma(n,3)+x*x*tt 871 ssuma(n,4) = amin (ssuma(n,4),x) 872 ssuma(n,5) = amax (ssuma(n,5),x) 873 return 874 end Subroutine tmst NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES amax internal function constant on line 578 real ref 872 amin internal function constant on line 585 real ref 871 blnk*com common block name 398 words ref 857 860 error internal subroutine constant on line 699 with descriptors ref 863 865 n parameter position 3 integer ref 855 864 866 867 868 868 869 869 870 870 871 871 872 872 nset parameter position 4 integer array(999) ref 855 856 865 nstat 000021 // integer ref 857 866 qset parameter position 5 real array(999) ref 855 856 865 ssuma 000423 // real array(10,5) ref 860 867 868 868 869 869 870 870 871 871 872 872 t parameter position 2 real ref 855 867 tmst entry point 010527 constant on line 855 tt 000550 automatic real ref 867 868 869 870 x parameter position 1 real ref 855 869 870 870 871 872 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 860 enq 000054 // real array(4) declared 860 id 000000 // integer declared 857 im 000001 // integer declared 857 imm 000037 // integer declared 857 init 000002 // integer declared 857 inn 000060 // integer array(4) declared 860 iseed 000023 // integer declared 857 jcels 000064 // integer array(5,22) declared 860 jclr 000601 // integer declared 860 jevnt 000003 // integer declared 857 jmnit 000004 // integer declared 857 jtrib 000602 // integer array(12) declared 860 krank 000242 // integer array(4) declared 860 maxnq 000246 // integer array(4) declared 860 maxns 000041 // integer declared 857 maxqs 000040 // integer declared 857 mfa 000005 // integer declared 857 mfe 000252 // integer array(4) declared 860 mlc 000256 // integer array(4) declared 860 mle 000262 // integer array(4) declared 860 mon 000576 // integer declared 860 mstop 000006 // integer declared 857 mx 000007 // integer declared 857 mxc 000010 // integer declared 857 mxx 000027 // integer declared 857 name 000567 // integer array(6) declared 860 ncels 000266 // integer array(5) declared 860 nclct 000011 // integer declared 857 ncrdr 000031 // integer declared 857 nday 000577 // integer declared 860 nep 000032 // integer declared 857 nhist 000012 // integer declared 857 noq 000013 // integer declared 857 norpt 000014 // integer declared 857 not 000015 // integer declared 857 nprms 000016 // integer declared 857 nprnt 000030 // integer declared 857 nproj 000575 // integer declared 860 nq 000273 // integer array(4) declared 860 nrun 000017 // integer declared 857 nruns 000020 // integer declared 857 nyr 000600 // integer declared 860 out 000022 // real declared 857 param 000277 // real array(20,4) declared 860 qtime 000417 // real array(4) declared 860 suma 000505 // real array(10,5) declared 860 tbeg 000025 // real declared 857 tfin 000026 // real declared 857 tnow 000024 // real declared 857 vnq 000033 // real array(4) declared 857 LOC LABEL TYPE LINE REFERENCES 010567 1 executable 866 used in transfer ref 864 010552 2 executable 865 used in transfer ref 864 864 866 010574 3 executable 867 used in transfer ref 866 866 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 855 010526 864 010547 865 010552 866 010567 867 010574 868 010601 869 010603 870 010607 871 010614 872 010633 873 010652 Subroutine sumry 875 cSTART sumry 876 subroutine sumry (nset,qset) 877 dimension nset(999),qset(999) 878 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 879 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 880 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 881 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 882 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 883 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 884 external exit,prntq(descriptors) 885 write (nprnt,21) 886 21 format (1h ,1x,23h**gasp summary report**/) 887 write (nprnt,102) nproj,name,mon,nday,nyr,nrun 888 102 format (1x,22hsimulation project no.,i4,2x,2hby,2x, 889 & 6a2//,1x,4hdate,i3,1h/,i3,1h/,i5,12x,10hrun number,i5//) 890 if (nprms) 147,147,146 891 146 do 64 i=1,nprms 892 64 write (nprnt,107) i,(param(i,j),j=1,4) 893 107 format(2x,14h parameter no.,i5,4f12.4) 894 147 if(nclct)5,60,66 895 5 write (nprnt,199) 896 199 format(///2x,26herror exit, type 98 error.) 897 call exit 898 66 write (nprnt,23) 899 23 format (//2x,18h**generated data**/ 2x,4hcode,4x,4hmean,6x,6hs 900 &.dev.,5x,4hmin.,7x,4hmax.,5x,4hobs./) 901 do 2 i=1,nclct 902 if(suma(i,3))5,62,61 903 62 write (nprnt,63) i 904 63 format(2x,i3,10x,18hno values recorded) 905 go to 2 906 61 xs = suma(i,1) 907 xss = suma(i,2) 908 xn = suma(i,3) 909 avg = xs/xn 910 std=(((xn*xss)-(xs*xs))/(xn*(xn-1.0)))**.5 911 n = xn 912 write (nprnt,24) i,avg,std,suma(i,4),suma(i,5),n 913 24 format (2x,i3,4f11.4,i7) 914 2 continue 915 60 if(nstat)5,67,4 916 4 write (nprnt,29) 917 29 format (/2x,23h**time generated data**/ 2x,4hcode,4x,4hmean,6x, 918 &8hstd.dev.,5x,4hmin.,7x,4hmax.,3x,10htotal time/) 919 do 6 i = 1,nstat 920 if(ssuma(i,1))5,71,72 921 71 write (nprnt,63) i 922 go to 6 923 72 xt = ssuma(i,1) 924 xs = ssuma(i,2) 925 xss = ssuma(i,3) 926 avg = xs/xt 927 std = (xss/xt-avg*avg)**.5 928 write (nprnt,30) i,avg,std,ssuma(i,4),ssuma(i,5),xt 929 30 format (2x,i3,5f11.4) 930 6 continue 931 67 if(nhist)5,75,9 932 9 write (nprnt,25) 933 25 format (/2x,37h**generated frequency distributions**/ 2x,4hcod 934 &e,20x,10hhistograms/) 935 do 12 i=1,nhist 936 ncl = ncels (i)+2 937 12 write (nprnt,26) i,(jcels(i,j),j=1,ncl) 938 26 format (2x,i3,5x,11i4/10x,11i4/) 939 75 do 15 i = 1,noq 940 iimm=i 941 15 call prntq(iimm,nset,qset) 942 return 943 end Subroutine sumry NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES avg 000557 automatic real ref 909 912 926 927 927 928 blnk*com common block name 398 words ref 878 881 exit external subroutine 010046 constant ref 884 897 i 000552 automatic integer ref 891 892 892 901 902 903 906 907 908 912 912 912 919 920 921 923 924 925 928 928 928 935 936 937 937 939 940 iimm 000564 automatic integer ref 940 941 j 000553 automatic integer ref 892 892 937 937 jcels 000064 // integer array(5,22) ref 881 937 mon 000576 // integer ref 881 887 n 000561 automatic integer ref 911 912 name 000567 // integer array(6) ref 881 887 ncels 000266 // integer array(5) ref 881 936 ncl 000563 automatic integer ref 936 937 nclct 000011 // integer ref 878 894 901 nday 000577 // integer ref 881 887 nhist 000012 // integer ref 878 931 935 noq 000013 // integer ref 878 939 nprms 000016 // integer ref 878 890 891 nprnt 000030 // integer ref 878 885 887 892 895 898 903 912 916 921 928 932 937 nproj 000575 // integer ref 881 887 nrun 000017 // integer ref 878 887 nset parameter position 1 integer array(999) ref 876 877 941 nstat 000021 // integer ref 878 915 919 nyr 000600 // integer ref 881 887 param 000277 // real array(20,4) ref 881 892 prntq internal subroutine constant with descriptors ref 884 941 qset parameter position 2 real array(999) ref 876 877 941 ssuma 000423 // real array(10,5) ref 881 920 923 924 925 928 928 std 000560 automatic real ref 910 912 927 928 suma 000505 // real array(10,5) ref 881 902 906 907 908 912 912 sumry entry point 010654 constant on line 876 xn 000556 automatic real ref 908 909 910 910 910 911 xs 000554 automatic real ref 906 909 910 910 924 926 xss 000555 automatic real ref 907 910 925 927 xt 000562 automatic real ref 923 926 927 928 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 881 enq 000054 // real array(4) declared 881 id 000000 // integer declared 878 im 000001 // integer declared 878 imm 000037 // integer declared 878 init 000002 // integer declared 878 inn 000060 // integer array(4) declared 881 iseed 000023 // integer declared 878 jclr 000601 // integer declared 881 jevnt 000003 // integer declared 878 jmnit 000004 // integer declared 878 jtrib 000602 // integer array(12) declared 881 krank 000242 // integer array(4) declared 881 maxnq 000246 // integer array(4) declared 881 maxns 000041 // integer declared 878 maxqs 000040 // integer declared 878 mfa 000005 // integer declared 878 mfe 000252 // integer array(4) declared 881 mlc 000256 // integer array(4) declared 881 mle 000262 // integer array(4) declared 881 mstop 000006 // integer declared 878 mx 000007 // integer declared 878 mxc 000010 // integer declared 878 mxx 000027 // integer declared 878 ncrdr 000031 // integer declared 878 nep 000032 // integer declared 878 norpt 000014 // integer declared 878 not 000015 // integer declared 878 nq 000273 // integer array(4) declared 881 nruns 000020 // integer declared 878 out 000022 // real declared 878 qtime 000417 // real array(4) declared 881 tbeg 000025 // real declared 878 tfin 000026 // real declared 878 tnow 000024 // real declared 878 vnq 000033 // real array(4) declared 878 LOC LABEL TYPE LINE REFERENCES 011243 2 executable 914 used in transfer ref 901 905 011254 4 executable 916 used in transfer ref 915 011046 5 executable 895 used in transfer ref 894 902 915 920 931 011424 6 executable 930 used in transfer ref 919 922 011435 9 executable 932 used in transfer ref 931 011457 12 executable 937 ref 935 011533 15 executable 941 ref 939 21 format 886 ref 885 23 format 899 ref 898 24 format 913 ref 912 25 format 933 ref 932 26 format 938 ref 937 29 format 917 ref 916 30 format 929 ref 928 011247 60 executable 915 used in transfer ref 894 011130 61 executable 906 used in transfer ref 902 011107 62 executable 903 used in transfer ref 902 63 format 904 ref 903 921 010775 64 executable 892 ref 891 011064 66 executable 898 used in transfer ref 894 011430 67 executable 931 used in transfer ref 915 011277 71 executable 921 used in transfer ref 920 011320 72 executable 923 used in transfer ref 920 011524 75 executable 939 used in transfer ref 931 102 format 888 ref 887 107 format 893 ref 892 010770 146 executable 891 used in transfer ref 890 011041 147 executable 894 used in transfer ref 890 890 199 format 896 ref 895 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 876 010653 885 010674 887 010704 890 010764 891 010770 892 010775 894 011041 895 011046 897 011056 898 011064 901 011074 902 011101 903 011107 905 011127 906 011130 907 011134 908 011136 909 011140 910 011142 911 011164 912 011167 914 011243 915 011247 916 011254 919 011264 920 011271 921 011277 922 011317 923 011320 924 011324 925 011326 926 011330 927 011333 928 011350 930 011424 931 011430 932 011435 935 011445 936 011452 937 011457 939 011524 940 011531 941 011533 942 011554 Subroutine set 944 cSTART set 945 subroutine set (jq,nset,qset) 946 dimension nset(999),qset(999) 947 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 948 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 949 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 950 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 951 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 952 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 953 external error(descriptors) 954 if (init-1) 27,28,27 955 28 kol = 7777 956 kof = 8888 957 kle = 9999 958 mx = im +1 959 mxx=im+2 960 maxqs = id * imm 961 maxns = id * mxx 962 do 2 j = 1,maxqs 963 2 qset(j) = 0.0 964 do 4 j = 1,maxns 965 4 nset(j) = 0 966 do 1 i = 1,id 967 indx = i * mxx 968 nset(indx - 1) = i + 1 969 1 nset(indx) = i - 1 970 nset(maxns - 1) = kof 971 do 3 k = 1,noq 972 973 nq(k)=0 974 mlc(k)=0 975 mfe(k)=0 976 maxnq(k) = 0 977 mle(k)=0 978 enq(k)=0.0 979 vnq(k)=0.0 980 3 qtime(k)=tnow 981 982 mfa = 1 983 init = 0 984 out = 0.0 985 return 986 27 mfex = mfe(jq) 987 988 knt = 2 989 ks = krank(jq) 990 991 ksj = 1 992 if (ks - 100) 1020,100,1000 993 1000 ksj = 2 994 ks = ks - 100 995 1020 if (out - 1.0) 8,5,100 996 8 indx = mfa * mxx - 1 997 nxfa = nset(indx) 998 if (inn(jq)-1) 100,7,6 999 7 mlex=mle(jq) 1000 if (mlex) 100,10,11 1001 10 indx = mfa * mxx 1002 nset(indx) = kle 1003 mfe(jq) = mfa 1004 17 indx = mfa * mxx - 1 1005 nset(indx) = kol 1006 mle(jq) = mfa 1007 14 mfa =nxfa 1008 indx = nxfa*mxx 1009 nset(indx) = kle 1010 xnq = nq(jq) 1011 enq(jq) = enq(jq)+xnq*(tnow-qtime(jq)) 1012 vnq(jq)=vnq(jq)+xnq*xnq*(tnow-qtime(jq)) 1013 qtime(jq) = tnow 1014 nq(jq) = nq(jq) + 1 1015 maxnq(jq)=xmax(maxnq(jq),nq(jq)) 1016 mlc(jq)=mfe(jq) 1017 return 1018 11 go to (1100,1120),ksj 1019 1100 indx1 = (mfa - 1) * imm + ks 1020 indx2 = (mlex - 1) * imm + ks 1021 if (qset(indx1) - qset(indx2)) 12,13,13 1022 1120 indx1 = (mfa - 1) * mxx + ks 1023 indx2 = (mlex - 1) * mxx + ks 1024 if (nset(indx1) - nset(indx2)) 12,13,13 1025 13 indx = mlex * mxx - 1 1026 msu = nset(indx) 1027 nset(indx) = mfa 1028 indx = mfa * mxx 1029 nset(indx) = mlex 1030 go to (18,17),knt 1031 18 indx = mfa * mxx - 1 1032 nset(indx) = msu 1033 indx = msu * mxx 1034 nset(indx) = mfa 1035 go to 14 1036 12 knt = 1 1037 indx = mlex * mxx 1038 mlex = nset(indx) 1039 if(mlex-kle) 11,16,11 1040 16 indx = mfa * mxx 1041 nset(indx) = kle 1042 mfe(jq) = mfa 1043 26 indx = mfa * mxx - 1 1044 nset(indx) = mfex 1045 indx = mfex * mxx 1046 nset(indx) = mfa 1047 go to 14 1048 6 if (mfex) 100,10,19 1049 19 go to (1200,1220),ksj 1050 1200 indx1 = (mfa - 1) * imm + ks 1051 indx2 = (mfex - 1) * imm + ks 1052 if (qset(indx1) - qset(indx2)) 20,21,21 1053 1220 indx1 = (mfa - 1) * mxx + ks 1054 indx2 = (mfex - 1) * mxx + ks 1055 if (nset(indx1) - nset(indx2)) 20,21,21 1056 20 knt = 1 1057 mpre = mfex 1058 indx = mfex * mxx - 1 1059 mfex = nset(indx) 1060 if (mfex-kol) 19,24,19 1061 21 go to (22,16),knt 1062 22 knt = 2 1063 24 indx = mfa * mxx 1064 nset(indx) = mpre 1065 indx = mpre * mxx - 1 1066 nset(indx) = mfa 1067 go to (17,26), knt 1068 5 out = 0.0 1069 indx = (mlc(jq) - 1) * imm 1070 do 32 i=1,imm 1071 indx = indx + 1 1072 32 qset(indx) = 0.0 1073 indx = (mlc(jq) - 1) * mxx 1074 do 1300 i= 1,im 1075 indx = indx + 1 1076 1300 nset(indx) = 0 1077 indx = mlc(jq) * mxx 1078 jl = nset(indx - 1) 1079 jk = nset(indx) 1080 if (jl- kol) 33,34,33 1081 33 if (jk- kle) 35,36,35 1082 35 indx = jk * mxx - 1 1083 nset(indx) = jl 1084 indx = jl * mxx 1085 nset(indx) = jk 1086 37 indx = mlc(jq) * mxx - 1 1087 nset(indx) = mfa 1088 nset(indx+1) = kle 1089 indx=mfa*mxx 1090 nset(indx)=mlc(jq) 1091 mfa = mlc(jq) 1092 mlc(jq) = mfe(jq) 1093 xnq = nq(jq) 1094 enq(jq)=enq(jq)+xnq*(tnow-qtime(jq)) 1095 vnq(jq)=vnq(jq)+xnq*xnq*(tnow-qtime(jq)) 1096 qtime(jq) = tnow 1097 nq(jq) = nq(jq)-1 1098 return 1099 36 indx = jl * mxx 1100 nset(indx) = kle 1101 mfe(jq) = jl 1102 go to 37 1103 34 if (jk-kle) 38,39,38 1104 38 indx = jk *mxx - 1 1105 nset(indx) = kol 1106 mle(jq) = jk 1107 go to 37 1108 39 mfe(jq) = 0 1109 mle(jq) = 0 1110 go to 37 1111 100 call error (88,nset,qset) 1112 return 1113 end Subroutine set NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 398 words ref 947 950 enq 000054 // real array(4) ref 950 978 1011 1011 1094 1094 error internal subroutine constant on line 699 with descriptors ref 953 1111 i 000572 automatic integer ref 966 967 968 969 1070 1074 id 000000 // integer ref 947 960 961 966 im 000001 // integer ref 947 958 959 1074 imm 000037 // integer ref 947 960 1019 1020 1050 1051 1069 1070 indx 000573 automatic integer ref 967 968 969 996 997 1001 1002 1004 1005 1008 1009 1025 1026 1027 1028 1029 1031 1032 1033 1034 1037 1038 1040 1041 1043 1044 1045 1046 1058 1059 1063 1064 1065 1066 1069 1071 1071 1072 1073 1075 1075 1076 1077 1078 1079 1082 1083 1084 1085 1086 1087 1088 1089 1090 1099 1100 1104 1105 indx1 000604 automatic integer ref 1019 1021 1022 1024 1050 1052 1053 1055 indx2 000605 automatic integer ref 1020 1021 1023 1024 1051 1052 1054 1055 init 000002 // integer ref 947 954 983 inn 000060 // integer array(4) ref 950 998 j 000571 automatic integer ref 962 963 964 965 jk 000611 automatic integer ref 1079 1081 1082 1085 1103 1104 1106 jl 000610 automatic integer ref 1078 1080 1083 1084 1099 1101 jq parameter position 1 integer ref 945 986 989 998 999 1003 1006 1010 1011 1011 1011 1012 1012 1012 1013 1014 1014 1015 1015 1015 1016 1016 1042 1069 1073 1077 1086 1090 1091 1092 1092 1093 1094 1094 1094 1095 1095 1095 1096 1097 1097 1101 1106 1108 1109 k 000574 automatic integer ref 971 973 974 975 976 977 978 979 980 kle 000570 automatic integer ref 957 1002 1009 1039 1041 1081 1088 1100 1103 knt 000576 automatic integer ref 988 1030 1036 1056 1061 1062 1067 kof 000567 automatic integer ref 956 970 kol 000566 automatic integer ref 955 1005 1060 1080 1105 krank 000242 // integer array(4) ref 950 989 ks 000577 automatic integer ref 989 992 994 994 1019 1020 1022 1023 1050 1051 1053 1054 ksj 000600 automatic integer ref 991 993 1018 1049 maxnq 000246 // integer array(4) ref 950 976 1015 1015 maxns 000041 // integer ref 947 961 964 970 maxqs 000040 // integer ref 947 960 962 mfa 000005 // integer ref 947 982 996 1001 1003 1004 1006 1007 1019 1022 1027 1028 1031 1034 1040 1042 1043 1046 1050 1053 1063 1066 1087 1089 1091 mfe 000252 // integer array(4) ref 950 975 986 1003 1016 1042 1092 1101 1108 mfex 000575 automatic integer ref 986 1044 1045 1048 1051 1054 1057 1058 1059 1060 mlc 000256 // integer array(4) ref 950 974 1016 1069 1073 1077 1086 1090 1091 1092 mle 000262 // integer array(4) ref 950 977 999 1006 1106 1109 mlex 000602 automatic integer ref 999 1000 1020 1023 1025 1029 1037 1038 1039 mpre 000607 automatic integer ref 1057 1064 1065 msu 000606 automatic integer ref 1026 1032 1033 mx 000007 // integer ref 947 958 mxx 000027 // integer ref 947 959 961 967 996 1001 1004 1008 1022 1023 1025 1028 1031 1033 1037 1040 1043 1045 1053 1054 1058 1063 1065 1073 1077 1082 1084 1086 1089 1099 1104 noq 000013 // integer ref 947 971 nq 000273 // integer array(4) ref 950 973 1010 1014 1014 1015 1093 1097 1097 nset parameter position 2 integer array(999) ref 945 946 965 968 969 970 997 1002 1005 1009 1024 1024 1026 1027 1029 1032 1034 1038 1041 1044 1046 1055 1055 1059 1064 1066 1076 1078 1079 1083 1085 1087 1088 1090 1100 1105 1111 nxfa 000601 automatic integer ref 997 1007 1008 out 000022 // real ref 947 984 995 1068 qset parameter position 3 real array(999) ref 945 946 963 1021 1021 1052 1052 1072 1111 qtime 000417 // real array(4) ref 950 980 1011 1012 1013 1094 1095 1096 set entry point 011556 constant on line 945 tnow 000024 // real ref 947 980 1011 1012 1013 1094 1095 1096 vnq 000033 // real array(4) ref 947 979 1012 1012 1095 1095 xmax internal function constant real ref 1015 xnq 000603 automatic real ref 1010 1011 1012 1012 1093 1094 1095 1095 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 950 iseed 000023 // integer declared 947 jcels 000064 // integer array(5,22) declared 950 jclr 000601 // integer declared 950 jevnt 000003 // integer declared 947 jmnit 000004 // integer declared 947 jtrib 000602 // integer array(12) declared 950 mon 000576 // integer declared 950 mstop 000006 // integer declared 947 mxc 000010 // integer declared 947 name 000567 // integer array(6) declared 950 ncels 000266 // integer array(5) declared 950 nclct 000011 // integer declared 947 ncrdr 000031 // integer declared 947 nday 000577 // integer declared 950 nep 000032 // integer declared 947 nhist 000012 // integer declared 947 norpt 000014 // integer declared 947 not 000015 // integer declared 947 nprms 000016 // integer declared 947 nprnt 000030 // integer declared 947 nproj 000575 // integer declared 950 nrun 000017 // integer declared 947 nruns 000020 // integer declared 947 nstat 000021 // integer declared 947 nyr 000600 // integer declared 950 param 000277 // real array(20,4) declared 950 ssuma 000423 // real array(10,5) declared 950 suma 000505 // real array(10,5) declared 950 tbeg 000025 // real declared 947 tfin 000026 // real declared 947 LOC LABEL TYPE LINE REFERENCES 011677 1 executable 969 ref 966 011632 2 executable 963 ref 962 011733 3 executable 980 ref 971 011647 4 executable 965 ref 964 012466 5 executable 1068 used in transfer ref 995 012330 6 executable 1048 used in transfer ref 998 012016 7 executable 999 used in transfer ref 998 012000 8 executable 996 used in transfer ref 995 012025 10 executable 1001 used in transfer ref 1000 1048 012137 11 executable 1018 used in transfer ref 1000 1039 1039 012262 12 executable 1036 used in transfer ref 1021 1024 012213 13 executable 1025 used in transfer ref 1021 1021 1024 1024 012054 14 executable 1007 used in transfer ref 1035 1047 012276 16 executable 1040 used in transfer ref 1039 1061 012040 17 executable 1004 used in transfer ref 1030 1067 012243 18 executable 1031 used in transfer ref 1030 012334 19 executable 1049 used in transfer ref 1048 1060 1060 012410 20 executable 1056 used in transfer ref 1052 1055 012426 21 executable 1061 used in transfer ref 1052 1052 1055 1055 012436 22 executable 1062 used in transfer ref 1061 012440 24 executable 1063 used in transfer ref 1060 012311 26 executable 1043 used in transfer ref 1067 011747 27 executable 986 used in transfer ref 954 954 011603 28 executable 955 used in transfer ref 954 012503 32 executable 1072 ref 1070 012555 33 executable 1081 used in transfer ref 1080 1080 012672 34 executable 1103 used in transfer ref 1080 012561 35 executable 1082 used in transfer ref 1081 1081 012656 36 executable 1099 used in transfer ref 1081 012577 37 executable 1086 used in transfer ref 1102 1107 1110 012676 38 executable 1104 used in transfer ref 1103 1103 012713 39 executable 1108 used in transfer ref 1103 012721 100 executable 1111 used in transfer ref 992 995 998 1000 1048 011766 1000 executable 993 used in transfer ref 992 011772 1020 executable 995 used in transfer ref 992 012147 1100 executable 1019 used in transfer ref 1018 012171 1120 executable 1022 used in transfer ref 1018 012344 1200 executable 1050 used in transfer ref 1049 012366 1220 executable 1053 used in transfer ref 1049 012526 1300 executable 1076 ref 1074 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 945 011555 954 011576 955 011603 956 011605 957 011607 958 011611 959 011615 960 011620 961 011623 962 011626 963 011632 964 011642 965 011647 966 011657 967 011664 968 011670 969 011677 970 011707 971 011714 973 011720 974 011724 975 011725 976 011726 977 011727 978 011730 979 011732 980 011733 982 011741 983 011743 984 011744 985 011746 986 011747 988 011753 989 011755 991 011757 992 011761 993 011766 994 011770 995 011772 996 012000 997 012005 998 012010 999 012016 1000 012022 1001 012025 1002 012031 1003 012035 1004 012040 1005 012045 1006 012051 1007 012054 1008 012057 1009 012061 1010 012065 1011 012071 1012 012076 1013 012106 1014 012110 1015 012113 1016 012134 1017 012136 1018 012137 1019 012147 1020 012155 1021 012162 1022 012171 1023 012177 1024 012204 1025 012213 1026 012220 1027 012223 1028 012226 1029 012230 1030 012233 1031 012243 1032 012250 1033 012254 1034 012256 1035 012261 1036 012262 1037 012264 1038 012270 1039 012273 1040 012276 1041 012302 1042 012306 1043 012311 1044 012316 1045 012322 1046 012324 1047 012327 1048 012330 1049 012334 1050 012344 1051 012352 1052 012357 1053 012366 1054 012374 1055 012401 1056 012410 1057 012412 1058 012414 1059 012420 1060 012423 1061 012426 1062 012436 1063 012440 1064 012444 1065 012450 1066 012453 1067 012456 1068 012466 1069 012471 1070 012476 1071 012502 1072 012503 1073 012513 1074 012521 1075 012525 1076 012526 1077 012536 1078 012543 1079 012546 1080 012551 1081 012555 1082 012561 1083 012566 1084 012572 1085 012574 1086 012577 1087 012605 1088 012611 1089 012616 1090 012621 1091 012624 1092 012626 1093 012630 1094 012633 1095 012640 1096 012650 1097 012652 1098 012655 1099 012656 1100 012662 1101 012666 1102 012671 1103 012672 1104 012676 1105 012703 1106 012707 1107 012712 1108 012713 1109 012717 1110 012720 1111 012721 1112 012736 Subroutine rmove 1114 cSTART rmove 1115 subroutine rmove (kcoll,jq,nset,qset) 1116 dimension nset(999),qset(999),kcoll(4) 1117 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1118 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1119 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1120 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1121 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1122 &6(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1123 external error(descriptors), set(descriptors) 1124 kcol = kcoll(1) 1125 if (kcol) 16,16,2 1126 16 call error (97,nset,qset) 1127 2 mlc(jq) = kcol 1128 indx = (kcol - 1) * imm 1129 do 3 i = 1,imm 1130 indx = indx + 1 1131 3 atrib(i) = qset(indx) 1132 indx = (kcol - 1) * mxx 1133 do 10 i =1,im 1134 indx = indx + 1 1135 10 jtrib(i) = nset(indx) 1136 out = 1. 1137 call set (jq,nset,qset) 1138 return 1139 end Subroutine rmove NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES atrib 000042 // real array(10) ref 1120 1131 blnk*com common block name 398 words ref 1117 1120 error internal subroutine constant on line 699 with descriptors ref 1123 1126 i 000614 automatic integer ref 1129 1131 1133 1135 im 000001 // integer ref 1117 1133 imm 000037 // integer ref 1117 1128 1129 indx 000613 automatic integer ref 1128 1130 1130 1131 1132 1134 1134 1135 jq parameter position 2 integer ref 1115 1127 1137 jtrib 000602 // integer array(12) ref 1120 1135 kcol 000612 automatic integer ref 1124 1124 1125 1127 1128 1132 kcoll parameter position 1 integer array(4) ref 1115 1116 1124 mlc 000256 // integer array(4) ref 1120 1127 mxx 000027 // integer ref 1117 1132 nset parameter position 3 integer array(999) ref 1115 1116 1126 1135 1137 out 000022 // real ref 1117 1136 qset parameter position 4 real array(999) ref 1115 1116 1126 1131 1137 rmove entry point 012740 constant on line 1115 set internal subroutine constant on line 945 with descriptors ref 1123 1137 NAMES DECLARED BUT NOT USED enq 000054 // real array(4) declared 1120 id 000000 // integer declared 1117 init 000002 // integer declared 1117 inn 000060 // integer array(4) declared 1120 iseed 000023 // integer declared 1117 jcels 000064 // integer array(5,22) declared 1120 jclr 000601 // integer declared 1120 jevnt 000003 // integer declared 1117 jmnit 000004 // integer declared 1117 krank 000242 // integer array(4) declared 1120 maxnq 000246 // integer array(4) declared 1120 maxns 000041 // integer declared 1117 maxqs 000040 // integer declared 1117 mfa 000005 // integer declared 1117 mfe 000252 // integer array(4) declared 1120 mle 000262 // integer array(4) declared 1120 mon 000576 // integer declared 1120 mstop 000006 // integer declared 1117 mx 000007 // integer declared 1117 mxc 000010 // integer declared 1117 name 000567 // integer array(6) declared 1120 ncels 000266 // integer array(5) declared 1120 nclct 000011 // integer declared 1117 ncrdr 000031 // integer declared 1117 nday 000577 // integer declared 1120 nep 000032 // integer declared 1117 nhist 000012 // integer declared 1117 noq 000013 // integer declared 1117 norpt 000014 // integer declared 1117 not 000015 // integer declared 1117 nprms 000016 // integer declared 1117 nprnt 000030 // integer declared 1117 nproj 000575 // integer declared 1120 nq 000273 // integer array(4) declared 1120 nrun 000017 // integer declared 1117 nruns 000020 // integer declared 1117 nstat 000021 // integer declared 1117 nyr 000600 // integer declared 1120 param 000277 // real array(20,4) declared 1120 qtime 000417 // real array(4) declared 1120 ssuma6 000423 // real array(10,5) declared 1120 suma 000505 // real array(10,5) declared 1120 tbeg 000025 // real declared 1117 tfin 000026 // real declared 1117 tnow 000024 // real declared 1117 vnq 000033 // real array(4) declared 1117 LOC LABEL TYPE LINE REFERENCES 013002 2 executable 1127 used in transfer ref 1125 013016 3 executable 1131 ref 1129 013041 10 executable 1135 ref 1133 012765 16 executable 1126 used in transfer ref 1125 1125 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1115 012737 1124 012760 1125 012763 1126 012765 1127 013002 1128 013006 1129 013011 1130 013015 1131 013016 1132 013030 1133 013034 1134 013040 1135 013041 1136 013053 1137 013055 1138 013071 Subroutine prntq 1140 cSTART prntq 1141 subroutine prntq (jq,nset,qset) 1142 dimension nset(999),qset(999) 1143 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1144 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1145 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1146 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1147 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1148 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1149 write (nprnt,100) jq 1150 if (tnow - tbeg) 12,12,13 1151 12 write (nprnt,105) 1152 105 format(/2x,25h no printout tnow = tbeg //) 1153 go to 2 1154 13 xnq=nq(jq) 1155 x=(enq(jq)+xnq*(tnow-qtime(jq)))/(tnow-tbeg) 1156 std=((vnq(jq)+xnq*xnq*(tnow-qtime(jq)))/(tnow-tbeg)-x*x)**0.5 1157 write (nprnt,104) x,std,maxnq(jq) 1158 write (nprnt,101) 1159 1160 & nsq = 1 1161 write(nprnt,200) 1162 200 format(2x,4hnset/) 1163 230 line = mfe(jq) 1164 if (line-1) 4,1,1 1165 4 write (nprnt,102) 1166 2 return 1167 1 l1 = line - 1 1168 go to (202,201),nsq 1169 202 indx = l1 * mxx 1170 ib = indx + 1 1171 ie = indx + mxx 1172 write (nprnt,106) line, (nset(i),i=ib,ie) 1173 go to 210 1174 201 indx = l1 * imm 1175 ib = indx + 1 1176 ie = indx + imm 1177 write (nprnt,103) line, (qset(i),i=ib,ie) 1178 210 indx = line * mxx - 1 1179 line = nset(indx) 1180 if (line-7777) 1,2220,5 1181 2220 if (nsq-2) 221,2,2 1182 221 nsq = nsq + 1 1183 write (nprnt,205) 1184 205 format (//2x,4hqset/) 1185 go to 230 1186 5 write (nprnt,199) 1187 199 format(///2x,26herror exit, type 94 error.) 1188 100 format(//2x,24h file printout, file no.,i3) 1189 101 format (/2x,14h file contents//) 1190 102 format(/2x,17hthe file is empty//) 1191 103 format (2x,i5,4x,5e13.6/12x,5e13.6) 1192 104 format(/2x,27haverage number in file was,f10.4,/2x,9hstd. dev 1193 & 18x,f10.4,/2x,7hmaximum,24x,i4) 1194 106 format (2x,i5,5x,8i8,/13x,4i8) 1195 stop 1196 end Subroutine prntq NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 398 words ref 1143 1146 enq 000054 // real array(4) ref 1146 1155 i 000627 automatic integer ref 1172 1172 1177 1177 ib 000625 automatic integer ref 1170 1172 1175 1177 ie 000626 automatic integer ref 1171 1172 1176 1177 imm 000037 // integer ref 1143 1174 1176 indx 000624 automatic integer ref 1169 1170 1171 1174 1175 1176 1178 1179 jq parameter position 1 integer ref 1141 1149 1154 1155 1155 1156 1156 1157 1163 l1 000623 automatic integer ref 1167 1169 1174 line 000622 automatic integer ref 1163 1164 1167 1172 1177 1178 1179 1180 maxnq 000246 // integer array(4) ref 1146 1157 mfe 000252 // integer array(4) ref 1146 1163 mxx 000027 // integer ref 1143 1169 1171 1178 nprnt 000030 // integer ref 1143 1149 1151 1157 1158 1161 1165 1172 1177 1183 1186 nq 000273 // integer array(4) ref 1146 1154 nset parameter position 2 integer array(999) ref 1141 1142 1172 1179 nsq 000621 automatic integer ref 1160 1168 1181 1182 1182 prntq entry point 013073 constant on line 1141 qset parameter position 3 real array(999) ref 1141 1142 1177 qtime 000417 // real array(4) ref 1146 1155 1156 std 000620 automatic real ref 1156 1157 tbeg 000025 // real ref 1143 1150 1155 1155 1156 1156 tnow 000024 // real ref 1143 1150 1155 1155 1156 1156 vnq 000033 // real array(4) ref 1143 1156 x 000617 automatic real ref 1155 1156 1156 1157 xnq 000616 automatic real ref 1154 1155 1156 1156 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 1146 id 000000 // integer declared 1143 im 000001 // integer declared 1143 init 000002 // integer declared 1143 inn 000060 // integer array(4) declared 1146 iseed 000023 // integer declared 1143 jcels 000064 // integer array(5,22) declared 1146 jclr 000601 // integer declared 1146 jevnt 000003 // integer declared 1143 jmnit 000004 // integer declared 1143 jtrib 000602 // integer array(12) declared 1146 krank 000242 // integer array(4) declared 1146 maxns 000041 // integer declared 1143 maxqs 000040 // integer declared 1143 mfa 000005 // integer declared 1143 mlc 000256 // integer array(4) declared 1146 mle 000262 // integer array(4) declared 1146 mon 000576 // integer declared 1146 mstop 000006 // integer declared 1143 mx 000007 // integer declared 1143 mxc 000010 // integer declared 1143 name 000567 // integer array(6) declared 1146 ncels 000266 // integer array(5) declared 1146 nclct 000011 // integer declared 1143 ncrdr 000031 // integer declared 1143 nday 000577 // integer declared 1146 nep 000032 // integer declared 1143 nhist 000012 // integer declared 1143 noq 000013 // integer declared 1143 norpt 000014 // integer declared 1143 not 000015 // integer declared 1143 nprms 000016 // integer declared 1143 nproj 000575 // integer declared 1146 nrun 000017 // integer declared 1143 nruns 000020 // integer declared 1143 nstat 000021 // integer declared 1143 nyr 000600 // integer declared 1146 out 000022 // real declared 1143 param 000277 // real array(20,4) declared 1146 ssuma 000423 // real array(10,5) declared 1146 suma 000505 // real array(10,5) declared 1146 tfin 000026 // real declared 1143 LOC LABEL TYPE LINE REFERENCES 013305 1 executable 1167 used in transfer ref 1164 1164 1180 013304 2 executable 1166 used in transfer ref 1153 1181 1181 013274 4 executable 1165 used in transfer ref 1164 013457 5 executable 1186 used in transfer ref 1180 013141 12 executable 1151 used in transfer ref 1150 1150 013152 13 executable 1154 used in transfer ref 1150 100 format 1188 ref 1149 101 format 1189 ref 1158 102 format 1190 ref 1165 103 format 1191 ref 1177 104 format 1192 ref 1157 105 format 1152 ref 1151 106 format 1194 ref 1172 199 format 1187 ref 1186 200 format 1162 ref 1161 013363 201 executable 1174 used in transfer ref 1168 013320 202 executable 1169 used in transfer ref 1168 205 format 1184 ref 1183 013425 210 executable 1178 used in transfer ref 1173 013445 221 executable 1182 used in transfer ref 1181 013265 230 executable 1163 used in transfer ref 1185 013441 2220 executable 1181 used in transfer ref 1180 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1141 013072 1149 013113 1150 013133 1151 013141 1153 013151 1154 013152 1155 013157 1156 013165 1157 013207 1158 013243 1160 013253 1161 013255 1163 013265 1164 013271 1165 013274 1166 013304 1167 013305 1168 013310 1169 013320 1170 013324 1171 013326 1172 013331 1173 013362 1174 013363 1175 013367 1176 013371 1177 013374 1178 013425 1179 013432 1180 013435 1181 013441 1182 013445 1183 013446 1185 013456 1186 013457 1195 013467 Subroutine randu 1197 subroutine randu(i,x) 1198 x=flat(i) 1199 return 1200 end Subroutine randu NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES flat external function 010034 constant real ref 1198 i parameter position 1 integer ref 1197 1198 randu entry point 013472 constant on line 1197 x parameter position 2 real ref 1197 1198 1198 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1197 013471 1198 013512 1199 013526 Function xmax 1201 function xmax(iarg1,iarg2) 1202 if (iarg1 - iarg2) 2,2,1 1203 1 xmax = iarg1 1204 return 1205 2 xmax = iarg2 1206 return 1207 end Function xmax NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES iarg1 parameter position 1 integer ref 1201 1202 1203 iarg2 parameter position 2 integer ref 1201 1202 1205 xmax entry point 013530 constant real on line 1201 xmax 000630 automatic real ref 1201 1203 1205 LOC LABEL TYPE LINE REFERENCES 013554 1 executable 1203 used in transfer ref 1202 013561 2 executable 1205 used in transfer ref 1202 1202 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1201 013527 1202 013550 1203 013554 1204 013557 1205 013561 1206 013564 Subroutine events 1208 cSTART events 1209 subroutine events (ix, nset, qset) 1210 dimension nset(60), qset(80) 1211 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1212 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1213 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1214 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1215 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssum 1216 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1217 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1218 go to (1,2,2,3),ix 1219 1 call arrvl (nset, qset) 1220 return 1221 2 call endsv (nset, qset) 1222 return 1223 3 call endsm (nset, qset) 1224 return 1225 1226 end Subroutine events NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES arrvl internal subroutine constant ref 1219 endsm internal subroutine constant ref 1223 endsv internal subroutine constant ref 1221 events entry point 013567 constant on line 1209 ix parameter position 1 integer ref 1209 1218 nset parameter position 2 integer array(60) ref 1209 1210 1219 1221 1223 qset parameter position 3 real array(80) ref 1209 1210 1219 1221 1223 NAMES DECLARED BUT NOT USED atrib 000000 // real array(10) declared 1214 block 000000 // real declared 1217 cbalk 000000 // real declared 1217 enq 000000 // real array(4) declared 1214 id 000000 // integer declared 1211 im 000000 // integer declared 1211 imm 000000 // integer declared 1211 init 000000 // integer declared 1211 inn 000000 // integer array(4) declared 1214 iseed 000000 // integer declared 1211 jcels 000000 // integer array(5,22) declared 1214 jclr 000000 // integer declared 1214 jevnt 000000 // integer declared 1211 jmnit 000000 // integer declared 1211 jtrib 000000 // integer array(12) declared 1214 krank 000000 // integer array(4) declared 1214 maxnq 000000 // integer array(4) declared 1214 maxns 000000 // integer declared 1211 maxqs 000000 // integer declared 1211 mfa 000000 // integer declared 1211 mfe 000000 // integer array(4) declared 1214 mlc 000000 // integer array(4) declared 1214 mle 000000 // integer array(4) declared 1214 mon 000000 // integer declared 1214 mstop 000000 // integer declared 1211 mx 000000 // integer declared 1211 mxc 000000 // integer declared 1211 mxx 000000 // integer declared 1211 name 000000 // integer array(6) declared 1214 ncels 000000 // integer array(5) declared 1214 nclct 000000 // integer declared 1211 ncrdr 000000 // integer declared 1211 nday 000000 // integer declared 1214 nep 000000 // integer declared 1211 nhist 000000 // integer declared 1211 noq 000000 // integer declared 1211 norpt 000000 // integer declared 1211 not 000000 // integer declared 1211 nprms 000000 // integer declared 1211 nprnt 000000 // integer declared 1211 nproj 000000 // integer declared 1214 nq 000000 // integer array(4) declared 1214 nrun 000000 // integer declared 1211 nruns 000000 // integer declared 1211 nstat 000000 // integer declared 1211 nyr 000000 // integer declared 1214 out 000000 // real declared 1211 param 000000 // real array(20,4) declared 1214 qtime 000000 // real array(4) declared 1214 ssum 000000 // real array(10,5) declared 1214 suma 000000 // real array(10,5) declared 1214 tbd 000000 // real declared 1217 tbeg 000000 // real declared 1211 tfin 000000 // real declared 1211 tisys 000000 // real declared 1217 titem 000000 // real declared 1217 tld 000000 // real declared 1217 tnow 000000 // real declared 1211 vnq 000000 // real array(4) declared 1211 xbuz 000000 // real array(2) declared 1217 xist1 000000 // real declared 1217 xist2 000000 // real declared 1217 xisys 000000 // real declared 1217 LOC LABEL TYPE LINE REFERENCES 013621 1 executable 1219 used in transfer ref 1218 013635 2 executable 1221 used in transfer ref 1218 1218 013651 3 executable 1223 used in transfer ref 1218 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1209 013566 1218 013607 1219 013621 1220 013634 1221 013635 1222 013650 1223 013651 1224 013664 Subroutine arrvl 1227 cSTART arrvl 1228 subroutine arrvl (nset, qset) 1229 dimension nset(60), qset(80) 1230 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1231 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1232 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1233 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1234 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1235 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1236 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1237 call drand(iseed,rnum) 1238 atrib(1)= tnow- param(1,1)*alog(rnum) 1239 jtrib(1) = 1 1240 call filem (1, nset, qset) 1241 titem=titem+1. 1242 if(xist1 - 5.)11,10,10 1243 10 cbalk = cbalk + 1. 1244 return 1245 11 call tmst (xisys, tnow, 1, nset, qset) 1246 if(xist1)7,8,9 1247 7 call error (31, nset, qset) 1248 return 1249 8 xist1 = xist1 + 1. 1250 xisys = xisys + 1. 1251 call tmst (xbuz(1), tnow, 2, nset, qset) 1252 xbuz(1) = 1. 1253 call drand(iseed,rnum) 1254 atrib(1) = tnow - param(2,1)*alog(rnum) 1255 jtrib(1) = 2 1256 atrib(3) = tnow 1257 call filem (1, nset, qset) 1258 return 1259 9 xist1 = xist1 + 1. 1260 xisys = xisys + 1. 1261 atrib(3)=tnow 1262 call filem (2, nset, qset) 1263 return 1264 1265 end Subroutine arrvl NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alog builtin ref 1238 1254 arrvl entry point 013666 constant on line 1228 atrib 000042 // real array(10) ref 1233 1238 1254 1256 1261 blnk*com common block name 409 words ref 1230 1233 1236 cbalk 000626 // real ref 1236 1243 1243 drand internal subroutine constant on line 693 ref 1237 1253 error internal subroutine constant on line 699 ref 1247 filem internal subroutine constant on line 751 ref 1240 1257 1262 iseed 000023 // integer ref 1230 1237 1253 jtrib 000602 // integer array(12) ref 1233 1239 1255 nset parameter position 1 integer array(60) ref 1228 1229 1240 1245 1247 1251 1257 1262 param 000277 // real array(20,4) ref 1233 1238 1254 qset parameter position 2 real array(80) ref 1228 1229 1240 1245 1247 1251 1257 1262 rnum 000632 automatic real ref 1237 1238 1253 1254 titem 000625 // real ref 1236 1241 1241 tmst internal subroutine constant on line 855 ref 1245 1251 tnow 000024 // real ref 1230 1238 1245 1251 1254 1256 1261 xbuz 000623 // real array(2) ref 1236 1251 1252 xist1 000616 // real ref 1236 1242 1246 1249 1249 1259 1259 xisys 000620 // real ref 1236 1245 1250 1250 1260 1260 NAMES DECLARED BUT NOT USED block 000630 // real declared 1236 enq 000054 // real array(4) declared 1233 id 000000 // integer declared 1230 im 000001 // integer declared 1230 imm 000037 // integer declared 1230 init 000002 // integer declared 1230 inn 000060 // integer array(4) declared 1233 jcels 000064 // integer array(5,22) declared 1233 jclr 000601 // integer declared 1233 jevnt 000003 // integer declared 1230 jmnit 000004 // integer declared 1230 krank 000242 // integer array(4) declared 1233 maxnq 000246 // integer array(4) declared 1233 maxns 000041 // integer declared 1230 maxqs 000040 // integer declared 1230 mfa 000005 // integer declared 1230 mfe 000252 // integer array(4) declared 1233 mlc 000256 // integer array(4) declared 1233 mle 000262 // integer array(4) declared 1233 mon 000576 // integer declared 1233 mstop 000006 // integer declared 1230 mx 000007 // integer declared 1230 mxc 000010 // integer declared 1230 mxx 000027 // integer declared 1230 name 000567 // integer array(6) declared 1233 ncels 000266 // integer array(5) declared 1233 nclct 000011 // integer declared 1230 ncrdr 000031 // integer declared 1230 nday 000577 // integer declared 1233 nep 000032 // integer declared 1230 nhist 000012 // integer declared 1230 noq 000013 // integer declared 1230 norpt 000014 // integer declared 1230 not 000015 // integer declared 1230 nprms 000016 // integer declared 1230 nprnt 000030 // integer declared 1230 nproj 000575 // integer declared 1233 nq 000273 // integer array(4) declared 1233 nrun 000017 // integer declared 1230 nruns 000020 // integer declared 1230 nstat 000021 // integer declared 1230 nyr 000600 // integer declared 1233 out 000022 // real declared 1230 qtime 000417 // real array(4) declared 1233 ssuma 000423 // real array(10,5) declared 1233 suma 000505 // real array(10,5) declared 1233 tbd 000622 // real declared 1236 tbeg 000025 // real declared 1230 tfin 000026 // real declared 1230 tisys 000627 // real declared 1236 tld 000621 // real declared 1236 vnq 000033 // real array(4) declared 1230 xist2 000617 // real declared 1236 LOC LABEL TYPE LINE REFERENCES 014015 7 executable 1247 used in transfer ref 1246 014033 8 executable 1249 used in transfer ref 1246 014133 9 executable 1259 used in transfer ref 1246 013761 10 executable 1243 used in transfer ref 1242 1242 013766 11 executable 1245 used in transfer ref 1242 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1228 013665 1237 013706 1238 013720 1239 013732 1240 013734 1241 013751 1242 013755 1243 013761 1244 013765 1245 013766 1246 014010 1247 014015 1248 014032 1249 014033 1250 014037 1251 014042 1252 014063 1253 014066 1254 014077 1255 014111 1256 014113 1257 014115 1258 014132 1259 014133 1260 014137 1261 014142 1262 014144 1263 014161 Subroutine endsv 1266 cSTART endsv 1267 subroutine endsv (nset, qset) 1268 dimension nset(60), qset(80) 1269 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1270 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1271 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1272 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1273 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1274 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1275 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1276 ii = jtrib(1) 1277 ii = ii - 1 1278 go to (1,2),ii 1279 1 jj = xist2 + 1. 1280 go to (3,4,5,6),jj 1281 3 xist1 = xist1 - 1. 1282 xist2 = xist2 + 1. 1283 y = tnow + .2 1284 call tmst (xbuz(2), y, 3, nset, qset) 1285 xbuz(2) = 1. 1286 call drand(iseed,rnum) 1287 atrib(1) = y - param (3,1)*alog(rnum) 1288 jtrib(1) = 3 1289 call filem (1, nset, qset) 1290 10 if(nq(2))7,8,9 1291 7 call error (41, nset, qset) 1292 return 1293 8 call tmst (xbuz(1), tnow, 2, nset, qset) 1294 xbuz(1) = 0. 1295 return 1296 9 call rmove (mfe(2), 2, nset, qset) 1297 call drand(iseed,rnum) 1298 atrib(1) = tnow - param (2,1)*alog(rnum) 1299 jtrib(1) = 2 1300 call filem (1, nset, qset) 1301 call tmst (xbuz(1), tnow, 2, nset, qset) 1302 xbuz(1) = 1.0 1303 return 1304 4 xist1 = xist1 - 1. 1305 xist2 = xist2 + 1. 1306 atrib(4) = tnow + .1 1307 call filem (3, nset, qset) 1308 go to 10 1309 5 xist1 = xist1 - 1. 1310 xist2 = xist2 + 1. 1311 atrib(4) = tnow 1312 call filem (3, nset, qset) 1313 go to 10 1314 6 call tmst (block, tnow, 4, nset, qset) 1315 block = 100. 1316 call tmst (xbuz(1), tnow, 2, nset, qset) 1317 xbuz(1) = 0. 1318 call filem (4, nset, qset) 1319 return 1320 2 call tmst (xisys, tnow, 1, nset, qset) 1321 xisys = xisys - 1. 1322 xist2 = xist2 - 1. 1323 tisys = tnow - atrib(3) 1324 call colct (tisys, 1, nset, qset) 1325 call histo(tisys,.5,.5,1) 1326 tbd = tnow - tld 1327 tld = tnow 1328 call colct (tbd, 2, nset, qset) 1329 call histo(tbd,0.0,.175,2) 1330 if(nq(3))7,11,12 1331 11 call tmst (xbuz(2), tnow, 3, nset, qset) 1332 xbuz(2) = 0.0 1333 return 1334 12 call rmove (mfe(3), 3, nset, qset) 1335 call drand(iseed,rnum) 1336 atrib(1) = tnow - param (3,1)*alog(rnum) 1337 jtrib(1) = 3 1338 call filem (1, nset, qset) 1339 if(block)13,14,15 1340 13 call error (51, nset, qset) 1341 14 return 1342 15 call tmst (block, tnow, 4, nset, qset) 1343 block = 0.0 1344 call rmove (mfe(4), 4, nset, qset) 1345 go to 5 1346 end Subroutine endsv NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alog builtin ref 1287 1298 1336 atrib 000042 // real array(10) ref 1272 1287 1298 1306 1311 1323 1336 blnk*com common block name 409 words ref 1269 1272 1275 block 000630 // real ref 1275 1314 1315 1339 1342 1343 colct internal subroutine constant on line 593 ref 1324 1328 drand internal subroutine constant on line 693 ref 1286 1297 1335 endsv entry point 014163 constant on line 1267 error internal subroutine constant on line 699 ref 1291 1340 filem internal subroutine constant on line 751 ref 1289 1300 1307 1312 1318 1338 histo internal subroutine constant on line 776 ref 1325 1329 ii 000634 automatic integer ref 1276 1276 1277 1277 1278 iseed 000023 // integer ref 1269 1286 1297 1335 jj 000635 automatic integer ref 1279 1280 jtrib 000602 // integer array(12) ref 1272 1276 1288 1299 1337 mfe 000252 // integer array(4) ref 1272 1296 1334 1344 nq 000273 // integer array(4) ref 1272 1290 1330 nset parameter position 1 integer array(60) ref 1267 1268 1284 1289 1291 1293 1296 1300 1301 1307 1312 1314 1316 1318 1320 1324 1328 1331 1334 1338 1340 1342 1344 param 000277 // real array(20,4) ref 1272 1287 1298 1336 qset parameter position 2 real array(80) ref 1267 1268 1284 1289 1291 1293 1296 1300 1301 1307 1312 1314 1316 1318 1320 1324 1328 1331 1334 1338 1340 1342 1344 rmove internal subroutine constant on line 1115 ref 1296 1334 1344 rnum 000637 automatic real ref 1286 1287 1297 1298 1335 1336 tbd 000622 // real ref 1275 1326 1328 1329 tisys 000627 // real ref 1275 1323 1324 1325 tld 000621 // real ref 1275 1326 1327 tmst internal subroutine constant on line 855 ref 1284 1293 1301 1314 1316 1320 1331 1342 tnow 000024 // real ref 1269 1283 1293 1298 1301 1306 1311 1314 1316 1320 1323 1326 1327 1331 1336 1342 xbuz 000623 // real array(2) ref 1275 1284 1285 1293 1294 1301 1302 1316 1317 1331 1332 xist1 000616 // real ref 1275 1281 1281 1304 1304 1309 1309 xist2 000617 // real ref 1275 1279 1282 1282 1305 1305 1310 1310 1322 1322 xisys 000620 // real ref 1275 1320 1321 1321 y 000636 automatic real ref 1283 1284 1287 NAMES DECLARED BUT NOT USED cbalk 000626 // real declared 1275 enq 000054 // real array(4) declared 1272 id 000000 // integer declared 1269 im 000001 // integer declared 1269 imm 000037 // integer declared 1269 init 000002 // integer declared 1269 inn 000060 // integer array(4) declared 1272 jcels 000064 // integer array(5,22) declared 1272 jclr 000601 // integer declared 1272 jevnt 000003 // integer declared 1269 jmnit 000004 // integer declared 1269 krank 000242 // integer array(4) declared 1272 maxnq 000246 // integer array(4) declared 1272 maxns 000041 // integer declared 1269 maxqs 000040 // integer declared 1269 mfa 000005 // integer declared 1269 mlc 000256 // integer array(4) declared 1272 mle 000262 // integer array(4) declared 1272 mon 000576 // integer declared 1272 mstop 000006 // integer declared 1269 mx 000007 // integer declared 1269 mxc 000010 // integer declared 1269 mxx 000027 // integer declared 1269 name 000567 // integer array(6) declared 1272 ncels 000266 // integer array(5) declared 1272 nclct 000011 // integer declared 1269 ncrdr 000031 // integer declared 1269 nday 000577 // integer declared 1272 nep 000032 // integer declared 1269 nhist 000012 // integer declared 1269 noq 000013 // integer declared 1269 norpt 000014 // integer declared 1269 not 000015 // integer declared 1269 nprms 000016 // integer declared 1269 nprnt 000030 // integer declared 1269 nproj 000575 // integer declared 1272 nrun 000017 // integer declared 1269 nruns 000020 // integer declared 1269 nstat 000021 // integer declared 1269 nyr 000600 // integer declared 1272 out 000022 // real declared 1269 qtime 000417 // real array(4) declared 1272 ssuma 000423 // real array(10,5) declared 1272 suma 000505 // real array(10,5) declared 1272 tbeg 000025 // real declared 1269 tfin 000026 // real declared 1269 titem 000625 // real declared 1275 vnq 000033 // real array(4) declared 1269 LOC LABEL TYPE LINE REFERENCES 014220 1 executable 1279 used in transfer ref 1278 014667 2 executable 1320 used in transfer ref 1278 014237 3 executable 1281 used in transfer ref 1280 014521 4 executable 1304 used in transfer ref 1280 014551 5 executable 1309 used in transfer ref 1280 1345 014600 6 executable 1314 used in transfer ref 1280 014344 7 executable 1291 used in transfer ref 1290 1330 014362 8 executable 1293 used in transfer ref 1290 014410 9 executable 1296 used in transfer ref 1290 014337 10 executable 1290 used in transfer ref 1308 1313 015030 11 executable 1331 used in transfer ref 1330 015056 12 executable 1334 used in transfer ref 1330 015146 13 executable 1340 used in transfer ref 1339 015163 14 executable 1341 used in transfer ref 1339 015164 15 executable 1342 used in transfer ref 1339 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1267 014162 1276 014203 1277 014206 1278 014210 1279 014220 1280 014226 1281 014237 1282 014243 1283 014246 1284 014251 1285 014272 1286 014275 1287 014306 1288 014320 1289 014322 1290 014337 1291 014344 1292 014361 1293 014362 1294 014404 1295 014407 1296 014410 1297 014430 1298 014442 1299 014454 1300 014456 1301 014473 1302 014515 1303 014520 1304 014521 1305 014525 1306 014530 1307 014533 1308 014550 1309 014551 1310 014555 1311 014560 1312 014562 1313 014577 1314 014600 1315 014622 1316 014625 1317 014646 1318 014651 1319 014666 1320 014667 1321 014711 1322 014715 1323 014720 1324 014723 1325 014742 1326 014760 1327 014764 1328 014766 1329 015005 1330 015023 1331 015030 1332 015052 1333 015055 1334 015056 1335 015076 1336 015110 1337 015122 1338 015124 1339 015141 1340 015146 1341 015163 1342 015164 1343 015206 1344 015211 1345 015230 Subroutine otput 1347 cSTART otput 1348 subroutine otput (nset, qset) 1349 dimension nset(60), qset(80) 1350 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1351 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1352 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1353 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1354 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1355 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1356 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1357 write(nprnt,10) (param(k,1),k=1,3) 1358 10 format(/1x,28hmean time between arrivals =f4.2 /,1x,33hmean servi 1359 &ce time for station 1 =,f4.2 /,1x,33hmean service time for statio 1360 &n 2 =,f4.2) 1361 ybalk = cbalk*100./titem 1362 write (nprnt,20) ybalk,cbalk,titem 1363 20 format(1x,32hpercent of items subcontracted =,f6.2 /1x, 1364 &31hnumber of items subcontracted =,f5.0 /,1x,13htotal items =, 1365 &f6.0) 1366 return 1367 end Subroutine otput NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 409 words ref 1350 1353 1356 cbalk 000626 // real ref 1356 1361 1362 k 000640 automatic integer ref 1357 1357 nprnt 000030 // integer ref 1350 1357 1362 otput entry point 015232 constant on line 1348 param 000277 // real array(20,4) ref 1353 1357 titem 000625 // real ref 1356 1361 1362 ybalk 000641 automatic real ref 1361 1362 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 1353 block 000630 // real declared 1356 enq 000054 // real array(4) declared 1353 id 000000 // integer declared 1350 im 000001 // integer declared 1350 imm 000037 // integer declared 1350 init 000002 // integer declared 1350 inn 000060 // integer array(4) declared 1353 iseed 000023 // integer declared 1350 jcels 000064 // integer array(5,22) declared 1353 jclr 000601 // integer declared 1353 jevnt 000003 // integer declared 1350 jmnit 000004 // integer declared 1350 jtrib 000602 // integer array(12) declared 1353 krank 000242 // integer array(4) declared 1353 maxnq 000246 // integer array(4) declared 1353 maxns 000041 // integer declared 1350 maxqs 000040 // integer declared 1350 mfa 000005 // integer declared 1350 mfe 000252 // integer array(4) declared 1353 mlc 000256 // integer array(4) declared 1353 mle 000262 // integer array(4) declared 1353 mon 000576 // integer declared 1353 mstop 000006 // integer declared 1350 mx 000007 // integer declared 1350 mxc 000010 // integer declared 1350 mxx 000027 // integer declared 1350 name 000567 // integer array(6) declared 1353 ncels 000266 // integer array(5) declared 1353 nclct 000011 // integer declared 1350 ncrdr 000031 // integer declared 1350 nday 000577 // integer declared 1353 nep 000032 // integer declared 1350 nhist 000012 // integer declared 1350 noq 000013 // integer declared 1350 norpt 000014 // integer declared 1350 not 000015 // integer declared 1350 nprms 000016 // integer declared 1350 nproj 000575 // integer declared 1353 nq 000273 // integer array(4) declared 1353 nrun 000017 // integer declared 1350 nruns 000020 // integer declared 1350 nset parameter position 1 array(60) declared 1348 1349 nstat 000021 // integer declared 1350 nyr 000600 // integer declared 1353 out 000022 // real declared 1350 qset parameter position 2 array(80) declared 1348 1349 qtime 000417 // real array(4) declared 1353 ssuma 000423 // real array(10,5) declared 1353 suma 000505 // real array(10,5) declared 1353 tbd 000622 // real declared 1356 tbeg 000025 // real declared 1350 tfin 000026 // real declared 1350 tisys 000627 // real declared 1356 tld 000621 // real declared 1356 tnow 000024 // real declared 1350 vnq 000033 // real array(4) declared 1350 xbuz 000623 // real array(2) declared 1356 xist1 000616 // real declared 1356 xist2 000617 // real declared 1356 xisys 000620 // real declared 1356 LOC LABEL TYPE LINE REFERENCES 10 format 1358 ref 1357 20 format 1363 ref 1362 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1348 015231 1357 015252 1361 015274 1362 015301 1366 015334 Subroutine endsm 1368 cSTART endsm 1369 subroutine endsm (nset, qset) 1370 dimension nset(60), qset(80) 1371 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1372 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1373 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1374 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1375 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1376 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1377 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1378 12 if(nq(1))7,10,9 1379 7 call error (61, nset, qset) 1380 9 call rmove (mfe(1), 1, nset, qset) 1381 tnow = atrib(1) 1382 jj = jtrib(1) 1383 go to (12,13,13),jj 1384 13 call endsv (nset, qset) 1385 go to 12 1386 10 call tmst (xisys , tnow, 1, nset, qset) 1387 call tmst (xbuz(1), tnow, 2, nset, qset) 1388 call tmst (xbuz(2), tnow, 3, nset, qset) 1389 call tmst (block , tnow, 4, nset, qset) 1390 mstop = -1 1391 norpt = 0 1392 return 1393 end Subroutine endsm NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES atrib 000042 // real array(10) ref 1374 1381 blnk*com common block name 409 words ref 1371 1374 1377 block 000630 // real ref 1377 1389 endsm entry point 015336 constant on line 1369 endsv internal subroutine constant on line 1267 ref 1384 error internal subroutine constant on line 699 ref 1379 jj 000642 automatic integer ref 1382 1383 jtrib 000602 // integer array(12) ref 1374 1382 mfe 000252 // integer array(4) ref 1374 1380 mstop 000006 // integer ref 1371 1390 norpt 000014 // integer ref 1371 1391 nq 000273 // integer array(4) ref 1374 1378 nset parameter position 1 integer array(60) ref 1369 1370 1379 1380 1384 1386 1387 1388 1389 qset parameter position 2 real array(80) ref 1369 1370 1379 1380 1384 1386 1387 1388 1389 rmove internal subroutine constant on line 1115 ref 1380 tmst internal subroutine constant on line 855 ref 1386 1387 1388 1389 tnow 000024 // real ref 1371 1381 1386 1387 1388 1389 xbuz 000623 // real array(2) ref 1377 1387 1388 xisys 000620 // real ref 1377 1386 NAMES DECLARED BUT NOT USED cbalk 000626 // real declared 1377 enq 000054 // real array(4) declared 1374 id 000000 // integer declared 1371 im 000001 // integer declared 1371 imm 000037 // integer declared 1371 init 000002 // integer declared 1371 inn 000060 // integer array(4) declared 1374 iseed 000023 // integer declared 1371 jcels 000064 // integer array(5,22) declared 1374 jclr 000601 // integer declared 1374 jevnt 000003 // integer declared 1371 jmnit 000004 // integer declared 1371 krank 000242 // integer array(4) declared 1374 maxnq 000246 // integer array(4) declared 1374 maxns 000041 // integer declared 1371 maxqs 000040 // integer declared 1371 mfa 000005 // integer declared 1371 mlc 000256 // integer array(4) declared 1374 mle 000262 // integer array(4) declared 1374 mon 000576 // integer declared 1374 mx 000007 // integer declared 1371 mxc 000010 // integer declared 1371 mxx 000027 // integer declared 1371 name 000567 // integer array(6) declared 1374 ncels 000266 // integer array(5) declared 1374 nclct 000011 // integer declared 1371 ncrdr 000031 // integer declared 1371 nday 000577 // integer declared 1374 nep 000032 // integer declared 1371 nhist 000012 // integer declared 1371 noq 000013 // integer declared 1371 not 000015 // integer declared 1371 nprms 000016 // integer declared 1371 nprnt 000030 // integer declared 1371 nproj 000575 // integer declared 1374 nrun 000017 // integer declared 1371 nruns 000020 // integer declared 1371 nstat 000021 // integer declared 1371 nyr 000600 // integer declared 1374 out 000022 // real declared 1371 param 000277 // real array(20,4) declared 1374 qtime 000417 // real array(4) declared 1374 ssuma 000423 // real array(10,5) declared 1374 suma 000505 // real array(10,5) declared 1374 tbd 000622 // real declared 1377 tbeg 000025 // real declared 1371 tfin 000026 // real declared 1371 tisys 000627 // real declared 1377 titem 000625 // real declared 1377 tld 000621 // real declared 1377 vnq 000033 // real array(4) declared 1371 xist1 000616 // real declared 1377 xist2 000617 // real declared 1377 LOC LABEL TYPE LINE REFERENCES 015363 7 executable 1379 used in transfer ref 1378 015400 9 executable 1380 used in transfer ref 1378 015451 10 executable 1386 used in transfer ref 1378 015356 12 executable 1378 used in transfer ref 1383 1385 015435 13 executable 1384 used in transfer ref 1383 1383 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1369 015335 1378 015356 1379 015363 1380 015400 1381 015420 1382 015423 1383 015425 1384 015435 1385 015450 1386 015451 1387 015473 1388 015515 1389 015537 1390 015561 1391 015564 1392 015565 Subroutine eig1 1394 c ********eigenvalues.eigemvectors of a real symme 1395 c ********matrix-jacobi-corbato method************ 1396 subroutine eig1(atrix2,atrix1,norow1,eps,amax,ir,norow2,norow3) 1397 dimension atrix1(norow3,norow1),atrix2(100000),amax(norow1),ir(norow1) 1398 isubs(i,j) = norows*(i-1)+j-(i*(i-1))/2 1399 isubd(i,j) = norow2*(j-1)+i 1400 1000 norows=norow1 1401 1001 enorow=norows 1402 1003 if(norow2.ne.1) go to 1007 1403 1005 mfudge=1 1404 go to 1010 1405 1007 mfudge = 0 1406 c mfudge = 1 if atrix2 is stored in a single dimensioned 1407 c mfudge = 0 if atrix2 is stored in a double dimensioned 1408 1010 if(eps)3601,1011,1012 1409 1011 sqeps = 1.0e-6 1410 go to 1015 1411 1012 sqeps = sqrt(eps) 1412 1015 nocols = norows 1413 do 1060 i = 1,norows 1414 do 1050 j=1,nocols 1415 1050 atrix1(i,j) = 0.0 1416 amax(i) = 0. 1417 1060 atrix1(i,i) = 1.0 1418 nminus = norows - 1 1419 if(nminus)3601,3601,1080 1420 1080 do 1090 j=2,norows 1421 k = j-1 1422 do 1090 i = 1,k 1423 if (mfudge) 3601,1082,1083 1424 1082 loc = isubd(i,j) 1425 go to 1084 1426 1083 loc = isubs(i,j) 1427 1084 if (abs(atrix2(loc))-amax(j)) 1090,1085,1085 1428 c *****ir-row of max.abs.element for column j ******** 1429 c *****amax-max.abs. element of column j(not including diago 1430 1085 amax(j) = abs(atrix2(loc)) 1431 ir(j) = i 1432 1090 continue 1433 1100 biga=0. 1434 do 1125 j=2,norows 1435 if(amax(j)-biga)1125,1120,1120 1436 1120 biga=amax(j) 1437 l=ir(j) 1438 m=j 1439 1125 continue 1440 c l = row,m = col of max. element 1441 if (mfudge) 3601,1126,1127 1442 1126 lam = isubd(l,m) 1443 mam = lam-l+m 1444 lal = isubd(l,l) 1445 go to 1138 1446 1127 lam = isubs(l,m) 1447 lal = lam-m+l 1448 mam = isubs(m,m) 1449 c *****convergence test ****** 1450 1138 if (enorow*abs(atrix2(lam))-sqeps) 3490,1150,1150 1451 1150 lminus =l-1 1452 lplust = l+1 1453 mminus = m-1 1454 1455 mplust = m+1 1456 1457 c ****calculations associated with max.element at point (l,m) 1458 c ****only those elements change that are on row l,m and col 1459 1200 r = sqrt((atrix2(lal)-atrix2(mam))**2+4.*atrix2(lam)*atrix2(lam)) 1460 t = atrix2(lal)-atrix2(mam) 1461 1400 cos = sqrt(.5*(1.+abs(t)/r)) 1462 sin = -atrix2(lam)/(r*cos) 1463 if (t) 1401,1402,1402 1464 1401 sin = -sin 1465 1402 sinsin = sin*sin 1466 coscos = cos*cos 1467 sincos = sin*cos 1468 prod = 2.0*atrix2(lam)*sincos 1469 2000 atrix2(lam) = 0.0 1470 amax(l) = 0. 1471 amax(m) = 0. 1472 2010 if (l .eq. 1) go to 2110 1473 do 2040 i=1,lminus 1474 if (mfudge) 3601,2012,2013 1475 2012 ial = isubd(i,l) 1476 iam = isubd(i,m) 1477 go to 2014 1478 2013 ial = isubs(i,l) 1479 iam = ial-l+m 1480 2014 temper = atrix2(ial) 1481 c *****claculate new elements on col.l and m to row l-1,upda 1482 atrix2(ial) = atrix2(ial)*cos-atrix2(iam)*sin 1483 atrix2(iam) = atrix2(iam)*cos+temper*sin 1484 if (abs(atrix2(ial))-amax(l)) 2030,2015,2015 1485 2015 amax(l) = abs(atrix2(ial)) 1486 ir(l) = i 1487 2030 if (abs(atrix2(iam))-amax(m)) 2040,2035,2035 1488 2035 amax(m) = abs(atrix2(iam)) 1489 ir(m) = i 1490 2040 continue 1491 c ****if l .eq. 1 max. element is on row 1 ****** 1492 2110 if (l+1 .eq. m) go to 2210 1493 do 2140 k=lplust,mminus 1494 if (mfudge) 3601,2112,2113 1495 2112 lak = isubd(l,k) 1496 ltemp = lak -l 1497 kam = isubd(k,m) 1498 go to 2114 1499 2113 lak = isubs(l,k) 1500 kam = isubs(k,m) 1501 2114 temper = atrix2(lak) 1502 c *****calculate new elments across row l and down col m to m- 1503 atrix2(lak) = atrix2(lak)*cos-atrix2(kam)*sin 1504 atrix2(kam) = atrix2(kam)*cos+temper*sin 1505 if (ir(k)-l) 2115,2120,2115 1506 2115 if (abs(atrix2(lak))-amax(k)) 2130,2117,2117 1507 2117 amax(k) = abs(atrix2(lak)) 1508 ir(k) = l 1509 go to 2130 1510 2120 amax(k)=0. 1511 km1=k-1 1512 do 2125 it=1,km1 1513 if (mfudge) 3601,2121,2122 1514 2121 itak = ltemp+it 1515 go to 2123 1516 2122 itak = isubs(it,k) 1517 2123 if (abs(atrix2(itak))-amax(k)) 2125,2124,2124 1518 2124 amax(k) = abs(atrix2(itak)) 1519 ir(k) = it 1520 2125 continue 1521 2130 if (abs(atrix2(kam))-amax(m)) 2140,2135,2135 1522 2135 amax(m) = abs(atrix2(kam)) 1523 ir(m) = k 1524 2140 continue 1525 c *****if l+1 =m, no calculations across row l or down column m 1526 2210 if (m .eq. norows) go to 2310 1527 do 2240 j=mplust,norows 1528 if (mfudge) 3601,2212,2213 1529 2212 laj = isubd(l,j) 1530 ltemp = laj-l 1531 maj = ltemp+m 1532 go to 2214 1533 2213 laj = isubs(l,j) 1534 maj= isubs(m,j) 1535 2214 temper = atrix2(laj) 1536 c *****calculate new elements across row l and row m 1537 atrix2(laj) = atrix2(laj)*cos-atrix2(maj)*sin 1538 atrix2(maj) = atrix2(maj)*cos+temper*sin 1539 if(ir(j)-l) 2215,2225,2215 1540 2215 if (ir(j)-m) 2217,2225,2217 1541 2217 if (abs(atrix2(laj))-amax(j)) 2220,2218,2218 1542 2218 amax(j) = abs(atrix2(laj)) 1543 ir(j) =l 1544 2220 if (abs(atrix2(maj))-amax(j)) 2240,2221,2221 1545 2221 amax(j) = abs(atrix2(maj)) 1546 ir(j) = m 1547 go to 2240 1548 2225 amax(j)=0. 1549 jm1=j-1 1550 do 2230 it=1,jm1 1551 if(mfudge) 3601,2226,2227 1552 2226 itaj=ltemp+it 1553 go to 2228 1554 2227 itaj= isubs(it,j) 1555 2228 if (abs(atrix2(itaj))-amax(j)) 2230,2229,2229 1556 2229 amax(j) = abs(atrix2(itaj)) 1557 ir(j)=it 1558 2230 continue 1559 2240 continue 1560 c *****if m .eq. norows,no more elements change***** 1561 2310 temper = atrix2(lal) 1562 c *****compute new diagonal elements **** 1563 atrix2(lal)=atrix2(lal)*coscos-prod+atrix2(mam)*sinsin 1564 atrix2(mam)=atrix2(mam)*coscos+prod+temper*sinsin 1565 2500 do 2520 i=1,norows 1566 temper = atrix1(i,l) 1567 c *****compute vectors, column l and m 1568 atrix1(i,l) = atrix1(i,l)*cos-atrix1(i,m)*sin 1569 atrix1(i,m) = atrix1(i,m)*cos+temper*sin 1570 2520 continue 1571 go to 1100 1572 3490 if(mfudge) 3601,3601,3500 1573 3500 do 3505 i = 2, norows 1574 c *****store eigenvalues in first n locations of atrix2***** 1575 iai = isubs(i,i) 1576 3505 atrix2(i) = atrix2(iai) 1577 3601 return 1578 end Subroutine eig1 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES abs builtin ref 1427 1430 1450 1461 1484 1485 1487 1488 1506 1507 1517 1518 1521 1522 1541 1542 1544 1545 1555 1556 amax parameter position 5 real array(norow1) ref 1396 1397 1416 1427 1430 1435 1436 1470 1471 1484 1485 1487 1488 1506 1507 1510 1517 1518 1521 1522 1541 1542 1544 1545 1548 1555 1556 atrix1 parameter position 2 real array(norow3,norow1) ref 1396 1397 1415 1417 1566 1568 1568 1568 1569 1569 atrix2 parameter position 1 real array(100000) ref 1396 1397 1427 1430 1450 1459 1459 1459 1459 1460 1460 1462 1468 1469 1480 1482 1482 1482 1483 1483 1484 1485 1487 1488 1501 1503 1503 1503 1504 1504 1506 1507 1517 1518 1521 1522 1535 1537 1537 1537 1538 1538 1541 1542 1544 1545 1555 1556 1561 1563 1563 1563 1564 1564 1576 1576 biga 000662 automatic real ref 1433 1435 1436 cos 000676 automatic real ref 1461 1462 1466 1466 1467 1482 1483 1503 1504 1537 1538 1568 1569 coscos 000701 automatic real ref 1466 1563 1564 eig1 entry point 015567 constant on line 1396 enorow 000651 automatic real ref 1401 1450 eps parameter position 4 real ref 1396 1408 1411 i 000655 automatic integer ref 1413 1415 1416 1417 1417 1422 1424 1426 1431 1473 1475 1476 1478 1486 1489 1565 1566 1568 1568 1568 1569 1569 1573 1575 1575 1576 iai 000721 automatic integer ref 1575 1576 ial 000704 automatic integer ref 1475 1478 1479 1480 1482 1482 1484 1485 iam 000705 automatic integer ref 1476 1479 1482 1483 1483 1487 1488 ir parameter position 6 integer array(norow1) ref 1396 1397 1431 1437 1486 1489 1505 1508 1519 1523 1539 1540 1543 1546 1557 isubd statement function integer ref 1399 1424 1442 1444 1475 1476 1495 1497 1529 isubs statement function integer ref 1398 1426 1446 1448 1478 1499 1500 1516 1533 1534 1554 1575 it 000713 automatic integer ref 1512 1514 1516 1519 1550 1552 1554 1557 itaj 000720 automatic integer ref 1552 1554 1555 1556 itak 000714 automatic integer ref 1514 1516 1517 1518 j 000656 automatic integer ref 1414 1415 1420 1421 1424 1426 1427 1430 1431 1434 1435 1436 1437 1438 1527 1529 1533 1534 1539 1540 1541 1542 1543 1544 1545 1546 1548 1549 1554 1555 1556 1557 jm1 000717 automatic integer ref 1549 1550 k 000660 automatic integer ref 1421 1422 1493 1495 1497 1499 1500 1505 1506 1507 1508 1510 1511 1516 1517 1518 1519 1523 kam 000711 automatic integer ref 1497 1500 1503 1504 1504 1521 1522 km1 000712 automatic integer ref 1511 1512 l 000663 automatic integer ref 1437 1442 1443 1444 1444 1446 1447 1451 1452 1470 1472 1475 1478 1479 1484 1485 1486 1492 1495 1496 1499 1505 1508 1529 1530 1533 1539 1543 1566 1568 1568 laj 000715 automatic integer ref 1529 1530 1533 1535 1537 1537 1541 1542 lak 000707 automatic integer ref 1495 1496 1499 1501 1503 1503 1506 1507 lal 000667 automatic integer ref 1444 1447 1459 1460 1561 1563 1563 lam 000665 automatic integer ref 1442 1443 1446 1447 1450 1459 1459 1462 1468 1469 lminus 000670 automatic integer ref 1451 1473 loc 000661 automatic integer ref 1424 1426 1427 1430 lplust 000671 automatic integer ref 1452 1493 ltemp 000710 automatic integer ref 1496 1514 1530 1531 1552 m 000664 automatic integer ref 1438 1442 1443 1446 1447 1448 1448 1453 1455 1471 1476 1479 1487 1488 1489 1492 1497 1500 1521 1522 1523 1526 1531 1534 1540 1546 1568 1569 1569 maj 000716 automatic integer ref 1531 1534 1537 1538 1538 1544 1545 mam 000666 automatic integer ref 1443 1448 1459 1460 1563 1564 1564 mfudge 000652 automatic integer ref 1403 1405 1423 1441 1474 1494 1513 1528 1551 1572 mminus 000672 automatic integer ref 1453 1493 mplust 000673 automatic integer ref 1455 1527 nminus 000657 automatic integer ref 1418 1419 nocols 000654 automatic integer ref 1412 1414 norow1 parameter position 3 integer ref 1396 1397 1397 1397 1400 norow2 parameter position 7 integer ref 1396 1399 1402 norow3 parameter position 8 integer ref 1396 1397 norows 000646 automatic integer ref 1398 1400 1400 1401 1412 1413 1418 1420 1434 1526 1527 1565 1573 prod 000703 automatic real ref 1468 1563 1564 r 000674 automatic real ref 1459 1461 1462 sin 000677 automatic real ref 1462 1464 1464 1465 1465 1467 1482 1483 1503 1504 1537 1538 1568 1569 sincos 000702 automatic real ref 1467 1468 sinsin 000700 automatic real ref 1465 1563 1564 sqeps 000653 automatic real ref 1409 1411 1450 sqrt builtin ref 1411 1459 1461 t 000675 automatic real ref 1460 1461 1463 temper 000706 automatic real ref 1480 1483 1501 1504 1535 1538 1561 1564 1566 1569 LOC LABEL TYPE LINE REFERENCES 015651 1000 executable 1400 015653 1001 executable 1401 015655 1003 executable 1402 015661 1005 executable 1403 015664 1007 executable 1405 used in transfer ref 1402 015665 1010 executable 1408 used in transfer ref 1404 015671 1011 executable 1409 used in transfer ref 1408 015674 1012 executable 1411 used in transfer ref 1408 015702 1015 executable 1412 used in transfer ref 1410 015714 1050 executable 1415 ref 1414 015734 1060 executable 1417 ref 1413 015754 1080 executable 1420 used in transfer ref 1419 015773 1082 executable 1424 used in transfer ref 1423 016002 1083 executable 1426 used in transfer ref 1423 016010 1084 executable 1427 used in transfer ref 1425 016022 1085 executable 1430 used in transfer ref 1427 1427 016035 1090 executable 1432 used in transfer ref 1420 1422 1427 016045 1100 executable 1433 used in transfer ref 1571 016061 1120 executable 1436 used in transfer ref 1435 1435 016072 1125 executable 1439 used in transfer ref 1434 1435 016102 1126 executable 1442 used in transfer ref 1441 016121 1127 executable 1446 used in transfer ref 1441 016137 1138 executable 1450 used in transfer ref 1445 016150 1150 executable 1451 used in transfer ref 1450 1450 016164 1200 executable 1459 016220 1400 executable 1461 016245 1401 executable 1464 used in transfer ref 1463 016250 1402 executable 1465 used in transfer ref 1463 1463 016267 2000 executable 1469 016276 2010 executable 1472 016312 2012 executable 1475 used in transfer ref 1474 016327 2013 executable 1478 used in transfer ref 1474 016340 2014 executable 1480 used in transfer ref 1477 016374 2015 executable 1485 used in transfer ref 1484 1484 016407 2030 executable 1487 used in transfer ref 1484 016421 2035 executable 1488 used in transfer ref 1487 1487 016434 2040 executable 1490 used in transfer ref 1473 1487 016440 2110 executable 1492 used in transfer ref 1472 016455 2112 executable 1495 used in transfer ref 1494 016474 2113 executable 1499 used in transfer ref 1494 016510 2114 executable 1501 used in transfer ref 1498 016542 2115 executable 1506 used in transfer ref 1505 1505 016554 2117 executable 1507 used in transfer ref 1506 1506 016570 2120 executable 1510 used in transfer ref 1505 016607 2121 executable 1514 used in transfer ref 1513 016613 2122 executable 1516 used in transfer ref 1513 016621 2123 executable 1517 used in transfer ref 1515 016633 2124 executable 1518 used in transfer ref 1517 1517 016646 2125 executable 1520 used in transfer ref 1512 1517 016652 2130 executable 1521 used in transfer ref 1506 1509 016664 2135 executable 1522 used in transfer ref 1521 1521 016677 2140 executable 1524 used in transfer ref 1493 1521 016703 2210 executable 1526 used in transfer ref 1492 016717 2212 executable 1529 used in transfer ref 1528 016732 2213 executable 1533 used in transfer ref 1528 016746 2214 executable 1535 used in transfer ref 1532 017000 2215 executable 1540 used in transfer ref 1539 1539 017006 2217 executable 1541 used in transfer ref 1540 1540 017020 2218 executable 1542 used in transfer ref 1541 1541 017033 2220 executable 1544 used in transfer ref 1541 017045 2221 executable 1545 used in transfer ref 1544 1544 017061 2225 executable 1548 used in transfer ref 1539 1540 017100 2226 executable 1552 used in transfer ref 1551 017104 2227 executable 1554 used in transfer ref 1551 017112 2228 executable 1555 used in transfer ref 1553 017124 2229 executable 1556 used in transfer ref 1555 1555 017137 2230 executable 1558 used in transfer ref 1550 1555 017143 2240 executable 1559 used in transfer ref 1527 1544 1547 017147 2310 executable 1561 used in transfer ref 1526 017174 2500 executable 1565 017257 2520 executable 1570 ref 1565 017264 3490 executable 1572 used in transfer ref 1450 017267 3500 executable 1573 used in transfer ref 1572 017300 3505 executable 1576 ref 1573 017310 3601 executable 1577 used in transfer ref 1408 1419 1419 1423 1441 1474 1494 1513 1528 1551 1572 1572 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1396 015566 1398 015622 1399 015642 1400 015651 1401 015653 1402 015655 1403 015661 1404 015663 1405 015664 1408 015665 1409 015671 1410 015673 1411 015674 1412 015702 1413 015704 1414 015710 1415 015714 1416 015730 1417 015734 1418 015747 1419 015752 1420 015754 1421 015760 1422 015763 1423 015767 1424 015773 1425 016001 1426 016002 1427 016010 1430 016022 1431 016032 1432 016035 1433 016045 1434 016047 1435 016053 1436 016061 1437 016065 1438 016070 1439 016072 1441 016076 1442 016102 1443 016110 1444 016113 1445 016120 1446 016121 1447 016127 1448 016132 1450 016137 1451 016150 1452 016153 1453 016156 1455 016161 1459 016164 1460 016212 1461 016220 1462 016232 1463 016242 1464 016245 1465 016250 1466 016253 1467 016256 1468 016261 1469 016267 1470 016271 1471 016274 1472 016276 1473 016302 1474 016306 1475 016312 1476 016320 1477 016326 1478 016327 1479 016335 1480 016340 1482 016344 1483 016355 1484 016364 1485 016374 1486 016404 1487 016407 1488 016421 1489 016431 1490 016434 1492 016440 1493 016445 1494 016451 1495 016455 1496 016463 1497 016465 1498 016473 1499 016474 1500 016502 1501 016510 1503 016514 1504 016525 1505 016534 1506 016542 1507 016554 1508 016564 1509 016567 1510 016570 1511 016574 1512 016577 1513 016603 1514 016607 1515 016612 1516 016613 1517 016621 1518 016633 1519 016643 1520 016646 1521 016652 1522 016664 1523 016674 1524 016677 1526 016703 1527 016707 1528 016713 1529 016717 1530 016725 1531 016727 1532 016731 1533 016732 1534 016740 1535 016746 1537 016752 1538 016763 1539 016772 1540 017000 1541 017006 1542 017020 1543 017030 1544 017033 1545 017045 1546 017055 1547 017060 1548 017061 1549 017065 1550 017070 1551 017074 1552 017100 1553 017103 1554 017104 1555 017112 1556 017124 1557 017134 1558 017137 1559 017143 1561 017147 1563 017153 1564 017164 1565 017174 1566 017200 1568 017207 1569 017236 1570 017257 1571 017263 1572 017264 1573 017267 1575 017273 1576 017300 1577 017310 Subroutine ampb1 1579 c ampb1 1580 cSTART ampb1 1581 subroutine ampb1(ind,exit,temp,x,dx,y,f,n,icount,niter,mtst) 1582 c **************adams-moulton integration*************** 1583 dimension temp(999),y(n),f(n) 1584 external rkpb1(descriptors) 1585 c **************calculate derivatives******************* 1586 c **************store functions and derivatives********* 1587 101 if(ind .ne. 0) go to 111 1588 icount =1 1589 go to 302 1590 111 m=n+1 1591 do 191 i=1,m 1592 c **************store previous sets of derivatives****** 1593 do 121 j1=1,icount 1594 i1=i+(icount+3-j1)*m 1595 i2=i1+m 1596 121 temp(i2)=temp(i1) 1597 191 continue 1598 201 if(ind.le.0) go to 301 1599 c **************would like to double dx next time******* 1600 c **************can not do if icount less than 6******** 1601 if(icount.lt.6) go to 301 1602 dx=2.0*dx 1603 do 261 j1=1,3 1604 do 241 i=1,m 1605 i1=i+(j1+3)*m 1606 if(i.eq.1) go to 221 1607 i2=i+(2*j1+3)*m 1608 temp(i1)=temp(i2) 1609 go to 241 1610 221 temp(i1)=2.0*temp(i1) 1611 241 continue 1612 261 continue 1613 icount=3 1614 c **************increment count of sets of derivatives** 1615 301 icount=min0(icount+1,6) 1616 302 nnn=n 1617 call rkpb1(exit,temp,x,dx,y,f,nnn) 1618 ind=-1 1619 return 1620 end Subroutine ampb1 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES ampb1 entry point 017312 constant on line 1581 dx parameter position 5 real ref 1581 1602 1602 1617 exit parameter position 2 real ref 1581 1617 f parameter position 7 real array(n) ref 1581 1583 1617 i 000723 automatic integer ref 1591 1594 1604 1605 1606 1607 i1 000725 automatic integer ref 1594 1595 1596 1605 1608 1610 1610 i2 000726 automatic integer ref 1595 1596 1607 1608 icount parameter position 9 integer ref 1581 1588 1593 1594 1601 1613 1615 1615 ind parameter position 1 integer ref 1581 1587 1598 1618 j1 000724 automatic integer ref 1593 1594 1594 1603 1605 1607 m 000722 automatic integer ref 1590 1591 1594 1595 1604 1605 1607 min0 builtin integer ref 1615 n parameter position 8 integer ref 1581 1583 1583 1590 1616 nnn 000727 automatic integer ref 1616 1617 rkpb1 internal subroutine constant on line 461 with descriptors ref 1584 1617 temp parameter position 3 real array(999) ref 1581 1583 1596 1596 1608 1608 1610 1610 1617 x parameter position 4 real ref 1581 1617 y parameter position 6 real array(n) ref 1581 1583 1617 NAMES DECLARED BUT NOT USED mtst parameter position 11 declared 1581 niter parameter position 10 declared 1581 LOC LABEL TYPE LINE REFERENCES 017352 101 executable 1587 017361 111 executable 1590 used in transfer ref 1587 017404 121 executable 1596 ref 1593 017415 191 executable 1597 ref 1591 017421 201 executable 1598 017466 221 executable 1610 used in transfer ref 1606 017473 241 executable 1611 used in transfer ref 1604 1609 017477 261 executable 1612 ref 1603 017505 301 executable 1615 used in transfer ref 1598 1601 017513 302 executable 1616 used in transfer ref 1589 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1581 017311 1587 017352 1588 017356 1589 017360 1590 017361 1591 017364 1593 017370 1594 017374 1595 017402 1596 017404 1597 017415 1598 017421 1601 017425 1602 017431 1603 017434 1604 017436 1605 017442 1606 017447 1607 017453 1608 017461 1609 017465 1610 017466 1611 017473 1612 017477 1613 017503 1615 017505 1616 017513 1617 017515 1618 017543 1619 017545 Subroutine ampb2 1621 cSTART gecos.Wed1752.65 1622 1623 c ampb2 1624 c **************integrate to next point***************** 1625 subroutine ampb2(ind,exit,temp,x,dx,y,f,n,icount,niter,mtst) 1626 dimension temp(999),y(n),f(n),ak(2) 1627 external rkpb2(descriptors),exit 1628 data ak/.92962963,-.070370370/ 1629 m=n+1 1630 n1=niter+1 1631 c **************restore previous values***************** 1632 x=temp(2*m+1) 1633 do 421 i=2,m 1634 ip2m=i+2*m 1635 y(i-1)=temp(ip2m) 1636 ip3m=ip2m+m 1637 421 f(i-1)=temp(ip3m) 1638 if(ind.gt.0) go to 501 1639 if(icount.ge.4) go to 701 1640 go to 601 1641 c **************reduce dx******************************* 1642 501 dx=dx/2.0 1643 1644 icount=1 1645 c **************integration by runge-kutta************** 1646 601 nnn=n 1647 call rkpb2(exit,temp,x,dx,y,f,nnn) 1648 go to 1001 1649 c **************integration by adams-moulton************ 1650 c **************independent variable******************** 1651 701 x=x+dx 1652 temp(m+1)=x 1653 c **************predictor values************************ 1654 801 do 821 i=2,m 1655 ipm=i+m 1656 ip2m=ipm+m 1657 ip3m=ip2m+m 1658 ip4m=ip3m+m 1659 ip5m=ip4m+m 1660 ip6m=ip5m+m 1661 y(i-1)=temp(ip2m)+dx*(55.0*temp(ip3m)-59.0*temp(ip4m)+ 1662 & 37.0*temp(ip5m)-9.0*temp(ip6m))/24.0 1663 temp(ipm)=y(i-1) 1664 if(mtst.ne.0.and.icount.gt.4) y(i-1)=y(i-1)+ak(1)/ak(2)*temp 1665 & (i) 1666 821 continue 1667 c **************corrector values************************ 1668 901 do 991 j1=1,n1 1669 call exit 1670 do 921 i=2,m 1671 ipm=i+m 1672 ip2m=ipm+m 1673 ip3m=ip2m+m 1674 ip4m=ip3m+m 1675 ip5m=ip4m+m 1676 y(i-1)=temp(ip2m)+dx*(9.0*f(i-1)+19.0*temp(ip3m)-5.0*temp(ip 1677 & 4m)+ 1678 & temp(ip5m))/24.0 1679 temp(i)=ak(2)*(y(i-1)-temp(ipm)) 1680 if(mtst.ne.0) y(i-1)=y(i-1)+temp(i) 1681 921 continue 1682 991 continue 1683 c **************restore normal mode********************* 1684 1001 ind=-1 1685 5001 return 1686 end Subroutine ampb2 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES ak 000206 automatic real array(2) initialized ref 1626 1628 1664 1664 1679 ampb2 entry point 017547 constant on line 1625 dx parameter position 5 real ref 1625 1642 1642 1647 1651 1661 1676 exit external subroutine parameter position 2 ref 1625 1627 1647 1669 f parameter position 7 real array(n) ref 1625 1626 1637 1647 1676 i 000742 automatic integer ref 1633 1634 1635 1637 1654 1655 1661 1663 1664 1664 1664 1670 1671 1676 1676 1679 1679 1680 1680 1680 icount parameter position 9 integer ref 1625 1639 1644 1664 ind parameter position 1 integer ref 1625 1638 1684 ip2m 000743 automatic integer ref 1634 1635 1636 1656 1657 1661 1672 1673 1676 ip3m 000744 automatic integer ref 1636 1637 1657 1658 1661 1673 1674 1676 ip4m 000747 automatic integer ref 1658 1659 1661 1674 1675 1676 ip5m 000750 automatic integer ref 1659 1660 1661 1675 1676 ip6m 000751 automatic integer ref 1660 1661 ipm 000746 automatic integer ref 1655 1656 1663 1671 1672 1679 j1 000752 automatic integer ref 1668 m 000740 automatic integer ref 1629 1629 1632 1633 1634 1636 1652 1654 1655 1656 1657 1658 1659 1660 1670 1671 1672 1673 1674 1675 mtst parameter position 11 integer ref 1625 1664 1680 n parameter position 8 integer ref 1625 1626 1626 1629 1646 n1 000741 automatic integer ref 1630 1668 niter parameter position 10 integer ref 1625 1630 nnn 000745 automatic integer ref 1646 1647 rkpb2 internal subroutine constant on line 481 with descriptors ref 1627 1647 temp parameter position 3 real array(999) ref 1625 1626 1632 1635 1637 1647 1652 1661 1661 1661 1661 1661 1663 1664 1676 1676 1676 1676 1679 1679 1680 x parameter position 4 real ref 1625 1632 1647 1651 1651 1652 y parameter position 6 real array(n) ref 1625 1626 1635 1647 1661 1663 1664 1664 1676 1679 1680 1680 LOC LABEL TYPE LINE REFERENCES 017646 421 executable 1637 ref 1633 017666 501 executable 1642 used in transfer ref 1638 017673 601 executable 1646 used in transfer ref 1640 017724 701 executable 1651 used in transfer ref 1639 017735 801 executable 1654 020041 821 executable 1666 ref 1654 020045 901 executable 1668 020150 921 executable 1681 ref 1670 020154 991 executable 1682 ref 1668 020160 1001 executable 1684 used in transfer ref 1648 020162 5001 executable 1685 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1625 017546 1629 017607 1630 017612 1632 017615 1633 017623 1634 017627 1635 017633 1636 017643 1637 017646 1638 017655 1639 017661 1640 017665 1642 017666 1644 017671 1646 017673 1647 017675 1648 017723 1651 017724 1652 017727 1654 017735 1655 017741 1656 017744 1657 017746 1658 017750 1659 017752 1660 017754 1661 017756 1663 020014 1664 020017 1666 020041 1668 020045 1669 020051 1670 020057 1671 020063 1672 020066 1673 020070 1674 020072 1675 020074 1676 020076 1679 020130 1680 020136 1681 020150 1682 020154 1684 020160 1685 020162 WARNING 36 on line 1628 The real constant .070370370 has more than 8 digits and has been converted to double precision. Subroutine secant 1687 cSTART gecos.Fri1603.50 1688 1689 c secant 1690 subroutine secant(n,ni,cc,fm,y,f,q,z,s,g,x,idim,eval,ierr) 1691 dimension y(999),f(999),q(999),z(999),s(999),g(idim,999),x(idim,999) 1692 fm=1.0e+37 1693 np=n+1 1694 jpa=0 1695 nit=ni 1696 10 y(np)=1. 1697 f(np)=1. 1698 z(np)=1. 1699 bf=abs(y(1)) 1700 do 20 i=2,n 1701 20 bf=amax1(bf,abs(y(i))) 1702 do 30 i=1,n 1703 if(y(i))30,25,30 1704 25 y(i)=(1.0e-6)*bf 1705 30 z(i)=y(i) 1706 l=np 1707 35 y(l-1)=1.1*y(l-1) 1708 40 y(l)=z(l) 1709 45 call eval(f,y) 1710 af=abs(f(1)) 1711 if(n-1)55,55,47 1712 47 do 50 i=2,n 1713 50 af=amax1(af,abs(f(i))) 1714 55 if(af-fm)60,80,80 1715 60 fm=af 1716 if (fm)5000,5000,65 1717 65 do 70 i=1,np 1718 70 s(i)=y(i) 1719 80 if(l)120,120,85 1720 85 do 90 i=1,np 1721 x(i,l)=y(i) 1722 90 g(i,l)=f(i) 1723 l=l-1 1724 if(l-1)100,40,35 1725 100 call mtinv(g,np,np,idim,q) 1726 105 do 110 i=1,np 1727 y(i)=0. 1728 do 110 j=1,np 1729 110 y(i)=y(i)+x(i,j)*g(j,np) 1730 if(abs(y(np)-1.)-.01)45,190,190 1731 120 af=abs(y(1)-z(1)) 1732 z(1)=y(1) 1733 do 130 i=2,n 1734 af=amax1(af,abs(y(i)-z(i))) 1735 130 z(i)=y(i) 1736 if(af-cc)5000,5000,140 1737 140 nit=nit-1 1738 if(nit)192,192,145 1739 145 do 150 i=1,np 1740 q(i)=0. 1741 do 150 j=1,np 1742 150 q(i)=q(i)+g(i,j)*f(j) 1743 af=abs(q(1)) 1744 k=1 1745 do 160 i=2,np 1746 afi=abs(q(i)) 1747 if(afi-af)160,160,155 1748 155 af=afi 1749 k=i 1750 160 continue 1751 do 170 i=1,np 1752 170 g(k,i)=g(k,i)/q(k) 1753 do 181 i=1,np 1754 x(i,k)=y(i) 1755 if(i-k)175,181,175 1756 175 do 180 j=1,np 1757 g(i,j)=g(i,j)-q(i)*g(k,j) 1758 180 continue 1759 181 continue 1760 go to 105 1761 190 ierr=1 1762 go to 193 1763 192 ierr=2 1764 193 if(jpa)195,195,5010 1765 195 jpa=1 1766 nit=ni 1767 do 200 i=1,n 1768 200 y(i)=s(i) 1769 go to 10 1770 5000 ierr=0 1771 5010 return 1772 end Subroutine secant NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES abs builtin ref 1699 1701 1710 1713 1730 1731 1734 1743 1746 af 000772 automatic real ref 1710 1713 1713 1714 1715 1731 1734 1734 1736 1743 1747 1748 afi 000775 automatic real ref 1746 1747 1748 amax1 builtin real ref 1701 1713 1734 bf 000767 automatic real ref 1699 1701 1701 1704 cc parameter position 3 real ref 1690 1736 eval external subroutine parameter position 13 ref 1690 1709 f parameter position 6 real array(999) ref 1690 1691 1697 1709 1710 1713 1722 1742 fm parameter position 4 real ref 1690 1692 1692 1714 1715 1716 g parameter position 10 real array(idim,999) ref 1690 1691 1722 1725 1729 1742 1752 1752 1757 1757 1757 i 000770 automatic integer ref 1700 1701 1702 1703 1704 1705 1705 1712 1713 1717 1718 1718 1720 1721 1721 1722 1722 1726 1727 1729 1729 1729 1733 1734 1734 1735 1735 1739 1740 1742 1742 1742 1745 1746 1749 1751 1752 1752 1753 1754 1754 1755 1757 1757 1757 1767 1768 1768 idim parameter position 12 integer ref 1690 1691 1691 1725 ierr parameter position 14 integer ref 1690 1761 1763 1770 j 000773 automatic integer ref 1728 1729 1729 1741 1742 1742 1756 1757 1757 1757 jpa 000765 automatic integer ref 1694 1764 1765 k 000774 automatic integer ref 1744 1749 1752 1752 1752 1754 1755 1757 l 000771 automatic integer ref 1706 1707 1707 1708 1708 1719 1721 1722 1723 1723 1724 mtinv internal subroutine constant on line 236 ref 1725 n parameter position 1 integer ref 1690 1693 1700 1702 1711 1712 1733 1767 ni parameter position 2 integer ref 1690 1695 1766 nit 000766 automatic integer ref 1695 1737 1737 1738 1766 np 000764 automatic integer ref 1693 1696 1697 1698 1706 1717 1720 1725 1725 1726 1728 1729 1730 1739 1741 1745 1751 1753 1756 q parameter position 7 real array(999) ref 1690 1691 1725 1740 1742 1742 1743 1746 1752 1757 s parameter position 9 real array(999) ref 1690 1691 1718 1768 secant entry point 020164 constant on line 1690 x parameter position 11 real array(idim,999) ref 1690 1691 1721 1729 1754 y parameter position 5 real array(999) ref 1690 1691 1696 1699 1701 1703 1704 1705 1707 1707 1708 1709 1718 1721 1727 1729 1729 1730 1731 1732 1734 1735 1754 1768 z parameter position 8 real array(999) ref 1690 1691 1698 1705 1708 1731 1732 1734 1735 LOC LABEL TYPE LINE REFERENCES 020232 10 executable 1696 used in transfer ref 1769 020252 20 executable 1701 ref 1700 020300 25 executable 1704 used in transfer ref 1703 020305 30 executable 1705 used in transfer ref 1702 1703 1703 020320 35 executable 1707 used in transfer ref 1724 020327 40 executable 1708 used in transfer ref 1724 020334 45 executable 1709 used in transfer ref 1730 020361 47 executable 1712 used in transfer ref 1711 020365 50 executable 1713 ref 1712 020402 55 executable 1714 used in transfer ref 1711 1711 020406 60 executable 1715 used in transfer ref 1714 020412 65 executable 1717 used in transfer ref 1716 020416 70 executable 1718 ref 1717 020427 80 executable 1719 used in transfer ref 1714 1714 020432 85 executable 1720 used in transfer ref 1719 020450 90 executable 1722 ref 1720 020474 100 executable 1725 used in transfer ref 1724 020515 105 executable 1726 used in transfer ref 1760 020531 110 executable 1729 ref 1726 1728 020572 120 executable 1731 used in transfer ref 1719 1719 020622 130 executable 1735 ref 1733 020634 140 executable 1737 used in transfer ref 1736 020641 145 executable 1739 used in transfer ref 1738 020655 150 executable 1742 ref 1739 1741 020726 155 executable 1748 used in transfer ref 1747 020732 160 executable 1750 used in transfer ref 1745 1747 1747 020742 170 executable 1752 ref 1751 021007 175 executable 1756 used in transfer ref 1755 1755 021041 180 executable 1758 ref 1756 021045 181 executable 1759 used in transfer ref 1753 1755 021052 190 executable 1761 used in transfer ref 1730 1730 021055 192 executable 1763 used in transfer ref 1738 1738 021057 193 executable 1764 used in transfer ref 1762 021062 195 executable 1765 used in transfer ref 1764 1764 021072 200 executable 1768 ref 1767 021104 5000 executable 1770 used in transfer ref 1716 1716 1736 1736 021105 5010 executable 1771 used in transfer ref 1764 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1690 020163 1692 020222 1693 020224 1694 020227 1695 020230 1696 020232 1697 020236 1698 020240 1699 020242 1700 020246 1701 020252 1702 020267 1703 020273 1704 020300 1705 020305 1706 020316 1707 020320 1708 020327 1709 020334 1710 020350 1711 020355 1712 020361 1713 020365 1714 020402 1715 020406 1716 020410 1717 020412 1718 020416 1719 020427 1720 020432 1721 020436 1722 020450 1723 020465 1724 020467 1725 020474 1726 020515 1727 020521 1728 020525 1729 020531 1730 020562 1731 020572 1732 020601 1733 020603 1734 020607 1735 020622 1736 020630 1737 020634 1738 020636 1739 020641 1740 020645 1741 020651 1742 020655 1743 020703 1744 020707 1745 020711 1746 020715 1747 020723 1748 020726 1749 020730 1750 020732 1751 020736 1752 020742 1753 020765 1754 020771 1755 021003 1756 021007 1757 021013 1758 021041 1759 021045 1760 021051 1761 021052 1762 021054 1763 021055 1764 021057 1765 021062 1766 021064 1767 021066 1768 021072 1769 021103 1770 021104 1771 021105 Subroutine corrl2 1773 subroutine corrl2 1774 c ************** corrl2 *************************************** 1775 cSTART gecos.Wed1751.30 1776 dimension x(2000),xr(1000),t(2) 1777 2 format(///" number of elements in each array") 1778 3 format(//" input x,y arrays"/) 1779 4 format(v) 1780 50 format(v) 1781 print 2 1782 read 4, n 1783 jn=2*n 1784 print 3 1785 read 50, (x(i),i=1,jn) 1786 t(1)=0.;t(2)=0. 1787 do 20 j=1,2 1788 do 19 i=1,n 1789 idum=(j-1)*n+i 1790 num=0;num1=0;num2=0 1791 do 10 k=1,n 1792 idum1=(j-1)*n+k 1793 if(x(idum)-x(idum1))10,6,5 1794 6 num1=num1+1 1795 5 num=num+1 1796 10 continue 1797 num=num-num1+1 1798 if(num1-1)8,16,8 1799 8 num2=num 1800 num3=num1-1 1801 do 15 kk=1,num3 1802 num2=num2+num+kk 1803 xnum2=num2 1804 xnum1=num1 1805 xnum=xnum2/xnum1 1806 15 continue 1807 t(j)=t(j)+(xnum1**3-xnum1)/(12.*xnum1) 1808 go to 17 1809 16 xnum=num 1810 17 xr(i)=xnum 1811 19 continue 1812 do 20 i=1,n 1813 idum=(j-1)*n+i 1814 x(idum)=xr(i) 1815 20 continue 1816 sum=0. 1817 do 30 i=1,n 1818 idum2=(i-1)*2 1819 xr(i)=x(i)-x(n+i) 1820 sum=sum+(x(i)-x(n+i))**2 1821 30 continue 1822 xn=n 1823 xsqr=(xn**3-xn)/12.-t(1) 1824 ysqr=(xn**3-xn)/12.-t(2) 1825 rs=(xsqr+ysqr-sum)/(2.*sqrt(xsqr*ysqr)) 1826 print 25,rs 1827 25 format(//" The spearman correlation coefficient: rs=",e20.8) 1828 if(n-10)200,100,100 1829 100 tt=rs*sqrt((xn-2.)/(1.-rs**2)) 1830 xnn=n-2 1831 prob=(1.-tdist(0,xnn,tt))/2. 1832 print 150,prob 1833 150 format(//" This value of rs is significant at the", 1834 & e20.8," level"///) 1835 200 stop 1836 end Subroutine corrl2 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES corrl2 entry point 021107 constant on line 1773 i 006672 automatic integer ref 1785 1785 1788 1789 1810 1812 1813 1814 1817 1818 1819 1819 1819 1820 1820 idum 006674 automatic integer ref 1789 1793 1813 1814 idum1 006701 automatic integer ref 1792 1793 idum2 006710 automatic integer ref 1818 j 006673 automatic integer ref 1787 1789 1792 1807 1807 1813 jn 006671 automatic integer ref 1783 1785 k 006700 automatic integer ref 1791 1792 kk 006703 automatic integer ref 1801 1802 n 006670 automatic integer ref 1782 1783 1788 1789 1791 1792 1812 1813 1817 1819 1820 1822 1828 1830 num 006675 automatic integer ref 1790 1795 1795 1797 1797 1799 1802 1809 num1 006676 automatic integer ref 1790 1794 1794 1797 1798 1800 1804 num2 006677 automatic integer ref 1790 1799 1802 1802 1803 num3 006702 automatic integer ref 1800 1801 prob 006717 automatic real ref 1831 1832 rs 006714 automatic real ref 1825 1826 1829 1829 sqrt builtin ref 1825 1829 sum 006707 automatic real ref 1816 1820 1820 1825 1825 t 006666 automatic real array(2) ref 1776 1786 1786 1807 1807 1823 1824 tdist internal function constant on line 445 real ref 1831 tt 006715 automatic real ref 1829 1831 x 000776 automatic real array(2000) ref 1776 1785 1793 1793 1814 1819 1819 1820 1820 xn 006711 automatic real ref 1822 1823 1823 1824 1824 1829 xnn 006716 automatic real ref 1830 1831 xnum 006706 automatic real ref 1805 1809 1810 xnum1 006705 automatic real ref 1804 1805 1807 1807 1807 xnum2 006704 automatic real ref 1803 1805 xr 004716 automatic real array(1000) ref 1776 1810 1814 1819 xsqr 006712 automatic real ref 1823 1825 1825 ysqr 006713 automatic real ref 1824 1825 1825 LOC LABEL TYPE LINE REFERENCES 2 format ref 1777 1781 3 format ref 1778 1784 4 format ref 1779 1782 021251 5 executable 1795 used in transfer ref 1793 021250 6 executable 1794 used in transfer ref 1793 021267 8 executable 1799 used in transfer ref 1798 1798 021252 10 executable 1796 used in transfer ref 1791 1793 021312 15 executable 1806 ref 1801 021335 16 executable 1809 used in transfer ref 1798 021340 17 executable 1810 used in transfer ref 1808 021343 19 executable 1811 ref 1788 021364 20 executable 1815 ref 1787 1812 25 format 1827 ref 1826 021426 30 executable 1821 ref 1817 50 format ref 1780 1785 021511 100 executable 1829 used in transfer ref 1828 1828 150 format 1833 ref 1832 021562 200 executable 1835 used in transfer ref 1828 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1773 021106 1781 021127 1782 021136 1783 021155 1784 021160 1785 021167 1786 021207 1786 021211 1787 021212 1788 021214 1789 021220 1790 021225 1790 021226 1790 021227 1791 021230 1792 021234 1793 021241 1794 021250 1795 021251 1796 021252 1797 021256 1798 021262 1799 021267 1800 021271 1801 021273 1802 021277 1803 021303 1804 021305 1805 021310 1806 021312 1807 021316 1808 021334 1809 021335 1810 021340 1811 021343 1812 021347 1813 021353 1814 021360 1815 021364 1816 021374 1817 021376 1818 021402 1819 021406 1820 021415 1821 021426 1822 021432 1823 021435 1824 021447 1825 021452 1826 021466 1828 021505 1829 021511 1830 021527 1831 021534 1832 021543 1835 021562 Subroutine eigsr 1837 subroutine eigsr 1838 c Modified Feb 1975 1839 dimension a(25,25),b(25,25),am(25),ir(25),d(25) 1840 character iy*4,icy*4 1841 1 print 2 1842 2 format(/" EIGSR"/) 1843 print 100 1844 100 format(49h Do you desire user instructions, type yes or no?) 1845 read 1010,iy 1846 if("yes" .ne. iy)go to 200 1847 print 102 1848 102 format(/" This program finds the Eigenvalues and Eigenvectors of a read") 1849 print 142 1850 142 format(47h symmetric matrix by the jacobi-corbato method.//) 1851 print 150 1852 150 format(27h The matrix is of the form:/) 1853 print 103 1854 103 format(" a11 a12 a1n where the a(i,j) are real(floating point) and") 1855 print 106 1856 106 format(" a21 a22 a2n n(fixed point) cannot exceed 25:") 1857 155 format(14h an1 an2 ann//) 1858 print 155 1859 160 format(49h Since the matrix is symmetric, only the elements) 1860 161 format(37h on and above the diagonal are input.//) 1861 print 160 1862 print 161 1863 print 107 1864 107 format(/" The program types Order ? the user types the order of the matrix."/) 1865 print 108 1866 108 format(" The program types a(1,1)= the user types the first row elements") 1867 print 112 1868 112 format (" the program types a(2,2)= the user types the 1869 & second row starting") 1870 169 format(48h with the diagonal element.-etc.- to a(n,n)/) 1871 print 169 1872 print 114 1873 114 format (" Input is typed in with each value containing a decimal point and 1874 &separated by commas, a carriage return ends the field."/) 1875 print 115 1876 115 format(" After a(n,n) is input, the program provides the 1877 & opportunity") 1878 182 format(46h and instructions for correcting typing errors//) 1879 print 182 1880 190 format(15h Now you try it//) 1881 print 190 1882 200 print 201 1883 201 format(7h Order?) 1884 read 1004, n 1885 1004 format (v) 1886 if(n .le. 0)go to 450 1887 nij=n*(n+1)/2 1888 nm1=n-1 1889 do 300 i=1,n 1890 print 1000,i,i 1891 300 read 1006, (a(i,j),j=i,n) 1892 1006 format(v) 1893 1000 format(3h a(,i2,1h,,i2,3h) =) 1894 print 118 1895 print 119 1896 118 format(" Are any of the above a(i,j) elements typed incorrectly?") 1897 119 format(" If user wishes to correct an element, type yes, 1898 & otherwise type no") 1899 305 format(" Any corrections?") 1900 306 print 305 1901 307 read 1010, icy 1902 308 format(27h illegal command, try again) 1903 if("no" .eq. icy)go to 350 1904 315 if("yes" .eq. icy)go to 320 1905 316 print 308 1906 go to 306 1907 320 print 120 1908 120 format (" correct element by typing i subscript(row)") 1909 print 122 1910 122 format(" j subscript, value, carriage return") 1911 325 read 1008, i,j,atemp 1912 1008 format(v) 1913 335 if(i-j)340,340,336 1914 336 print 130 1915 130 format(" illegal subscript, i greater than j, or i or 1916 & j greater than n. try again") 1917 go to 325 1918 340 if(i-n)341,341,336 1919 341 if(j-n)342,342,336 1920 342 a(i,j)=atemp 1921 343 print 305 1922 read 1010, icy 1923 1010 format(v) 1924 if("no" .eq. icy)go to 350 1925 345 if("yes" .eq. icy)go to 325 1926 346 print 308 1927 go to 343 1928 350 na=25 1929 nb=25 1930 eps=0. 1931 do 352 i=1,n 1932 d(i)=a(i,i) 1933 do 352 j=i,n 1934 352 a(j,i)=a(i,j) 1935 call eig1(a,b,n,eps,am,ir,na,nb) 1936 369 format(//7h-Order=,i3) 1937 370 format(//2x,16h0 Eigenvalue,i3,16h Eigenvector/) 1938 371 format(1pe20.7,1pe19.7) 1939 372 format(1pe39.7) 1940 print 369,n 1941 do 400 i=1,n 1942 print 370,i 1943 print 371,a(i,i),b(1,i) 1944 do 400 j=2,n 1945 400 print 372,b(j,i) 1946 do 410 i=1,n 1947 a(i,i)=d(i) 1948 do 410 j=i,n 1949 410 a(i,j)=a(j,i) 1950 t=0. 1951 do 430 i=1,n 1952 do 420 j=1,n 1953 d(j)=0. 1954 do 420 k=1,n 1955 420 d(j)=d(j)+a(j,k)*b(k,i) 1956 do 430 j=1,n 1957 if(j-i)422,430,422 1958 422 ts=0. 1959 do 425 k=1,n 1960 425 ts=ts+b(k,j)*d(k) 1961 t=t+ts*ts 1962 430 continue 1963 print 250 1964 1965 250 format(" The sum of the squares of the off diagonal elements of") 1966 443 format(" xt a x =",1pe16.7," where xt = x-transpose") 1967 print 443,t 1968 go to 200 1969 450 stop 1970 end Subroutine eigsr NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 006720 automatic real array(25,25) ref 1839 1891 1920 1932 1934 1934 1935 1943 1947 1949 1949 1955 am 011262 automatic real array(25) ref 1839 1935 atemp 011404 automatic real ref 1911 1920 b 010101 automatic real array(25,25) ref 1839 1935 1943 1945 1955 1960 d 011344 automatic real array(25) ref 1839 1932 1947 1953 1955 1955 1960 eig1 internal subroutine constant on line 1396 ref 1935 eigsr entry point 021565 constant on line 1837 eps 011407 automatic real ref 1930 1935 i 011402 automatic integer ref 1889 1890 1890 1891 1891 1911 1913 1918 1920 1931 1932 1932 1932 1933 1934 1934 1941 1942 1943 1943 1943 1945 1946 1947 1947 1947 1948 1949 1949 1951 1955 1957 icy 011376 automatic character(4) ref 1840 1901 1903 1904 1922 1924 1925 ir 011313 automatic integer array(25) ref 1839 1935 iy 011375 automatic character(4) ref 1840 1845 1846 j 011403 automatic integer ref 1891 1891 1911 1913 1919 1920 1933 1934 1934 1944 1945 1948 1949 1949 1952 1953 1955 1955 1955 1956 1957 1960 k 011411 automatic integer ref 1954 1955 1955 1959 1960 1960 n 011377 automatic integer ref 1884 1886 1887 1887 1888 1889 1891 1918 1919 1931 1933 1935 1940 1941 1944 1946 1948 1951 1952 1954 1956 1959 na 011405 automatic integer ref 1928 1935 nb 011406 automatic integer ref 1929 1935 nij 011400 automatic integer ref 1887 nm1 011401 automatic integer ref 1888 t 011410 automatic real ref 1950 1961 1961 1967 ts 011412 automatic real ref 1958 1960 1960 1961 1961 LOC LABEL TYPE LINE REFERENCES 021605 1 executable 1841 2 format 1842 ref 1841 100 format 1844 ref 1843 102 format 1848 ref 1847 103 format 1854 ref 1853 106 format 1856 ref 1855 107 format 1864 ref 1863 108 format 1866 ref 1865 112 format 1868 ref 1867 114 format 1873 ref 1872 115 format 1876 ref 1875 118 format 1896 ref 1894 119 format 1897 ref 1895 120 format 1908 ref 1907 122 format 1910 ref 1909 130 format 1915 ref 1914 142 format 1850 ref 1849 150 format 1852 ref 1851 155 format ref 1857 1858 160 format ref 1859 1861 161 format ref 1860 1862 169 format ref 1870 1871 182 format ref 1878 1879 190 format ref 1880 1881 022027 200 executable 1882 used in transfer ref 1846 1968 201 format 1883 ref 1882 250 format 1965 ref 1963 022121 300 executable 1891 ref 1889 305 format ref 1899 1900 1921 022176 306 executable 1900 used in transfer ref 1906 022205 307 executable 1901 308 format ref 1902 1905 1926 022231 315 executable 1904 022236 316 executable 1905 022246 320 executable 1907 used in transfer ref 1904 022264 325 executable 1911 used in transfer ref 1917 1925 022315 335 executable 1913 022321 336 executable 1914 used in transfer ref 1913 1918 1919 022331 340 executable 1918 used in transfer ref 1913 1913 022335 341 executable 1919 used in transfer ref 1918 1918 022341 342 executable 1920 used in transfer ref 1919 1919 022347 343 executable 1921 used in transfer ref 1927 022402 345 executable 1925 022407 346 executable 1926 022417 350 executable 1928 used in transfer ref 1903 1924 022442 352 executable 1934 ref 1931 1933 369 format ref 1936 1940 370 format ref 1937 1942 371 format ref 1938 1943 372 format ref 1939 1945 022567 400 executable 1945 ref 1941 1944 022641 410 executable 1949 ref 1946 1948 022703 420 executable 1955 ref 1952 1954 022737 422 executable 1958 used in transfer ref 1957 1957 022745 425 executable 1960 ref 1959 022766 430 executable 1962 used in transfer ref 1951 1956 1957 443 format ref 1966 1967 023025 450 executable 1969 used in transfer ref 1886 1000 format 1893 ref 1890 1004 format 1885 ref 1884 1006 format 1892 ref 1891 1008 format 1912 ref 1911 1010 format 1923 ref 1845 1901 1922 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1837 021564 1841 021605 1843 021614 1845 021623 1846 021642 1847 021647 1849 021656 1851 021665 1853 021674 1855 021703 1858 021712 1861 021721 1862 021730 1863 021737 1865 021746 1867 021755 1871 021764 1872 021773 1875 022002 1879 022011 1881 022020 1882 022027 1884 022036 1886 022055 1887 022061 1888 022066 1889 022071 1890 022075 1891 022121 1894 022160 1895 022167 1900 022176 1901 022205 1903 022224 1904 022231 1905 022236 1906 022245 1907 022246 1909 022255 1911 022264 1913 022315 1914 022321 1917 022330 1918 022331 1919 022335 1920 022341 1921 022347 1922 022356 1924 022375 1925 022402 1926 022407 1927 022416 1928 022417 1929 022421 1930 022422 1931 022424 1932 022430 1933 022436 1934 022442 1935 022463 1940 022466 1941 022505 1942 022511 1943 022530 1944 022563 1945 022567 1946 022622 1947 022626 1948 022635 1949 022641 1950 022662 1951 022664 1952 022670 1953 022674 1954 022677 1955 022703 1956 022727 1957 022733 1958 022737 1959 022741 1960 022745 1961 022762 1962 022766 1963 022776 1967 023005 1968 023024 1969 023025 Subroutine gaspsamp 1971 subroutine gaspsamp 1972 c gaspsamp --- sample driver routines for gaspiia 1973 cSTART gecos.Wed1738.40 1974 dimension nset(60), qset(80) 1975 common id,im,init,jevnt,jmnit,mfa,mstop,mx,mxc,nclct,nhist, 1976 &noq,norpt,not,nprms,nrun,nruns,nstat,out,iseed,tnow, 1977 &tbeg,tfin,mxx,nprnt,ncrdr,nep,vnq(4),imm,maxqs,maxns 1978 common atrib(10),enq(4),inn(4),jcels(5,22),krank(4),maxnq(4),m 1979 &fe(4),mlc(4),mle(4),ncels(5),nq(4),param(20,4),qtime(4),ssuma 1980 &(10,5),suma(10,5),name(6),nproj,mon,nday,nyr,jclr,jtrib(12) 1981 common xist1,xist2,xisys,tld,tbd,xbuz(2),titem,cbalk,tisys,block 1982 external gasp (descriptors) 1983 xbuz(1)=1.0 1984 xbuz(2)=1.0 1985 xist1 = 4. 1986 xist2 = 1. 1987 xisys = 5. 1988 tld = 0. 1989 titem=0. 1990 cbalk = 0. 1991 block = 0. 1992 call gasp (nset, qset) 1993 stop 1994 end Subroutine gaspsamp NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 409 words ref 1975 1978 1981 block 000630 // real ref 1981 1991 cbalk 000626 // real ref 1981 1990 gasp internal subroutine constant on line 517 with descriptors ref 1982 1992 gaspsamp entry point 023030 constant on line 1971 nset 011414 automatic integer array(60) ref 1974 1992 qset 011510 automatic real array(80) ref 1974 1992 titem 000625 // real ref 1981 1989 tld 000621 // real ref 1981 1988 xbuz 000623 // real array(2) ref 1981 1983 1983 1984 xist1 000616 // real ref 1981 1985 xist2 000617 // real ref 1981 1986 xisys 000620 // real ref 1981 1987 NAMES DECLARED BUT NOT USED atrib 000042 // real array(10) declared 1978 enq 000054 // real array(4) declared 1978 id 000000 // integer declared 1975 im 000001 // integer declared 1975 imm 000037 // integer declared 1975 init 000002 // integer declared 1975 inn 000060 // integer array(4) declared 1978 iseed 000023 // integer declared 1975 jcels 000064 // integer array(5,22) declared 1978 jclr 000601 // integer declared 1978 jevnt 000003 // integer declared 1975 jmnit 000004 // integer declared 1975 jtrib 000602 // integer array(12) declared 1978 krank 000242 // integer array(4) declared 1978 maxnq 000246 // integer array(4) declared 1978 maxns 000041 // integer declared 1975 maxqs 000040 // integer declared 1975 mfa 000005 // integer declared 1975 mfe 000252 // integer array(4) declared 1978 mlc 000256 // integer array(4) declared 1978 mle 000262 // integer array(4) declared 1978 mon 000576 // integer declared 1978 mstop 000006 // integer declared 1975 mx 000007 // integer declared 1975 mxc 000010 // integer declared 1975 mxx 000027 // integer declared 1975 name 000567 // integer array(6) declared 1978 ncels 000266 // integer array(5) declared 1978 nclct 000011 // integer declared 1975 ncrdr 000031 // integer declared 1975 nday 000577 // integer declared 1978 nep 000032 // integer declared 1975 nhist 000012 // integer declared 1975 noq 000013 // integer declared 1975 norpt 000014 // integer declared 1975 not 000015 // integer declared 1975 nprms 000016 // integer declared 1975 nprnt 000030 // integer declared 1975 nproj 000575 // integer declared 1978 nq 000273 // integer array(4) declared 1978 nrun 000017 // integer declared 1975 nruns 000020 // integer declared 1975 nstat 000021 // integer declared 1975 nyr 000600 // integer declared 1978 out 000022 // real declared 1975 param 000277 // real array(20,4) declared 1978 qtime 000417 // real array(4) declared 1978 ssuma 000423 // real array(10,5) declared 1978 suma 000505 // real array(10,5) declared 1978 tbd 000622 // real declared 1981 tbeg 000025 // real declared 1975 tfin 000026 // real declared 1975 tisys 000627 // real declared 1981 tnow 000024 // real declared 1975 vnq 000033 // real array(4) declared 1975 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1971 023027 1983 023050 1984 023053 1985 023054 1986 023056 1987 023060 1988 023062 1989 023064 1990 023065 1991 023066 1992 023067 1993 023072 Subroutine kilter 1995 subroutine kilter 1996 c Modified Feb 1975 1997 c kilter - Out of kilter algorithm 1998 common arcs,i(100),j(100),cost(100),hi(100),lo(100),flow(100) 1999 dimension pi(100),na(100),nb(100) 2000 integer a,aok,cok,c,del,e,eps,src,snk 2001 integer flow,pi,arcs,cost,hi,lo 2002 integer cst,hibnd,bndlo,istat 2003 character fname*16 2004 double precision stat 2005 equivalence (istat,stat) 2006 external com_err_ (descriptors), attach (descriptors), detach 2007 iin=10 2008 print 999 2009 999 format(" Out of kilter algo.") 2010 do 108 jr=1,25 2011 i (jr)=0 2012 j (jr)=0 2013 hi (jr)=0 2014 lo (jr)=0 2015 cost(jr)=0 2016 108 flow(jr)=0 2017 nodes=1 2018 call attach (istat) 2019 if (istat) 3535,4545,3535 2020 3535 call com_err_(istat,"kilter","error in attach") 2021 stop 2022 4545 arcs=1 2023 109 read(iin,1,end=116)iwrd,k,l,cst,hibnd,bndlo 2024 1 format(v) 2025 cost(arcs)=cst 2026 hi(arcs)=hibnd 2027 lo(arcs)=bndlo 2028 i(arcs)=k 2029 j(arcs)=l 2030 if(l.gt.nodes)nodes=l 2031 arcs=arcs+1 2032 go to 109 2033 116 arcs=arcs-1 2034 do 5 m=1,arcs 2035 5 flow(m)=0 2036 do 11 m=1,nodes 2037 11 pi(m)=0 2038 do 161 k=1,100 2039 161 na(k)=0 2040 do 10 a=1,arcs 2041 if(lo(a).gt.hi(a)) go to 39 2042 10 continue 2043 c set inf to max available integer 2044 16 inf=999999 2045 aok=0 2046 c find out of kilter arc 2047 20 do 21 a=1,arcs 2048 ia=i(a) 2049 ja = j(a) 2050 c=cost(a)+pi( ia )-pi( ja ) 2051 if((flow(a).lt.lo(a)).or.(c.lt.0.and.flow(a).lt.hi(a))) go to 22 2052 if((flow(a).gt.hi(a)).or.(c.gt.0.and.flow(a).gt.lo(a))) go to 23 2053 21 continue 2054 c no remaining out of kilter arcs 2055 go to 38 2056 22 src=j(a) 2057 snk=i(a) 2058 e=+1 2059 go to 24 2060 23 src=i(a) 2061 snk=j(a) 2062 e=-1 2063 go to 24 2064 c attempt to bring out of kilter arcs into kilter 2065 24 if((a.eq.aok).and.(na(src).ne.0)) go to 25 2066 aok=a 2067 do 26 n=1,nodes 2068 na(n)= 0 2069 26 nb(n)=0 2070 na(src)=iabs(snk)*e 2071 nb(src)=iabs(aok)*e 2072 25 cok=c 2073 27 lab=0 2074 do 30 a=1,arcs 2075 ia=i(a) 2076 ja = j(a) 2077 if((na(ia).eq.0.and.na(ja).eq.0).or.(na(ia).ne.0 .and.na(ja).ne.0) 2078 &)goto 30 2079 c= cost(a)+pi(ia) - pi(ja) 2080 if(na(ia).eq.0) go to 28 2081 if(flow(a).ge.hi(a).or.(flow(a).ge.lo(a).and.c.gt.0))go to 30 2082 na(ja) = i(a) 2083 nb(ja) = a 2084 go to 29 2085 28 if(flow(a).le.lo(a).or.(flow(a).le.hi(a).and.c.lt.0))go to 30 2086 ia = i(a) 2087 na(ia) = -j(a) 2088 nb(ia) = -a 2089 29 lab = 1 2090 c node labeled, test for breakthru 2091 if(na(snk).ne.0) go to 33 2092 30 continue 2093 c no breakthru 2094 if(lab.ne.0) go to 27 2095 c determine change to pi vector 2096 del = inf 2097 do 31 a=1,arcs 2098 ia = i(a) 2099 ja =j(a) 2100 if((na(ia).eq.0.and.na(ja).eq.0).or.(na(ia).ne.0.and.na(ja).ne.0) 2101 &)goto 31 2102 c=cost(a)+pi(ia)-pi(ja) 2103 if(na(ja).eq.0.and.flow(a).lt.hi(a)) del= min0(del,c) 2104 if(na(ja).ne.0.and.flow(a).gt.lo(a)) del= min0(del,-c) 2105 31 continue 2106 ccok=cok 2107 if(del.eq.inf.and.(flow(aok).eq.hi(aok).or.flow(aok).eq.lo(aok))) 2108 &del=abs(ccok) 2109 if(del.eq.inf) go to 39 2110 c exit, no feasible flow pattern 2111 c change pi vector by computed del 2112 do 32 n=1,nodes 2113 if(na(n).eq.0) pi(n)=pi(n)+del 2114 32 continue 2115 c find another out-of-kilter arc 2116 go to 20 2117 c breakthru, compute incremental flow 2118 33 eps=inf 2119 ni=src 2120 34 nj=iabs(na(ni)) 2121 a=iabs(nb(ni)) 2122 c=cost(a)-isign(iabs(pi(ni) -pi(nj)),nb(ni)) 2123 if(nb(ni).lt.0) go to 35 2124 if(c.gt.0.and.flow(a).lt.lo(a)) eps=min0(eps,lo(a)-flow(a)) 2125 if(c.le.0.and.flow(a).lt.hi(a)) eps=min0(eps,hi(a)-flow(a)) 2126 go to 36 2127 35 if(c.lt.0.and.flow(a).gt.hi(a)) eps=min0(eps,flow(a)-hi(a)) 2128 if(c.ge.0.and.flow(a).gt.lo(a)) eps=min0(eps,flow(a)-lo(a)) 2129 36 ni=nj 2130 if(ni.ne.src) go to 34 2131 c change flow vector by computed eps 2132 37 nj=iabs(na(ni)) 2133 a=iabs(nb(ni)) 2134 flow(a)=flow(a)+isign(eps,nb(ni)) 2135 ni=nj 2136 if(ni.ne.src) go to 37 2137 c find another out of kilter arc 2138 aok=0 2139 go to 20 2140 39 print 995 2141 995 format(" solution infeasible") 2142 38 call koutput 2143 call detach 2144 stop 2145 end Subroutine kilter NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 012306 automatic integer ref 2000 2040 2041 2041 2047 2048 2049 2050 2051 2051 2051 2051 2052 2052 2052 2052 2056 2057 2060 2061 2065 2066 2074 2075 2076 2079 2081 2081 2081 2081 2082 2083 2085 2085 2085 2085 2086 2087 2088 2097 2098 2099 2102 2103 2103 2104 2104 2121 2122 2124 2124 2124 2124 2125 2125 2125 2125 2127 2127 2127 2127 2128 2128 2128 2128 2133 2134 2134 abs builtin ref 2107 aok 012307 automatic integer ref 2000 2045 2065 2066 2071 2107 2107 2107 2107 2138 arcs 000000 // integer ref 1998 2001 2022 2025 2026 2027 2028 2029 2031 2031 2033 2033 2034 2040 2047 2074 2097 attach external subroutine 010042 constant with descriptors ref 2006 2018 blnk*com common block name 601 words ref 1998 bndlo 012321 automatic integer ref 2002 2023 2027 c 012311 automatic integer ref 2000 2050 2051 2052 2072 2079 2081 2085 2102 2103 2104 2122 2124 2125 2127 2128 ccok 012336 automatic real ref 2106 2107 cok 012310 automatic integer ref 2000 2072 2106 com_err_ external subroutine 010040 constant with descriptors ref 2006 2020 cost 000311 // integer array(100) ref 1998 2001 2015 2025 2050 2079 2102 2122 cst 012317 automatic integer ref 2002 2023 2025 del 012312 automatic integer ref 2000 2096 2103 2103 2104 2104 2107 2107 2109 2113 detach external subroutine 010044 constant ref 2006 2143 e 012313 automatic integer ref 2000 2058 2062 2070 2071 eps 012314 automatic integer ref 2000 2118 2124 2124 2125 2125 2127 2127 2128 2128 2134 flow 000765 // integer array(100) ref 1998 2001 2016 2035 2051 2051 2052 2052 2081 2081 2085 2085 2103 2104 2107 2107 2124 2124 2125 2125 2127 2127 2128 2128 2134 2134 hi 000455 // integer array(100) ref 1998 2001 2013 2026 2041 2051 2052 2081 2085 2103 2107 2125 2125 2127 2127 hibnd 012320 automatic integer ref 2002 2023 2026 i 000001 // integer array(100) ref 1998 2011 2028 2048 2057 2060 2075 2082 2086 2098 ia 012332 automatic integer ref 2048 2050 2075 2077 2077 2079 2080 2086 2087 2088 2098 2100 2100 2102 iabs builtin integer ref 2070 2071 2120 2121 2122 2132 2133 iin 012322 automatic integer ref 2007 2007 2023 inf 012331 automatic integer ref 2044 2096 2107 2109 2118 isign builtin integer ref 2122 2134 istat 011630 automatic integer equivalenced ref 2002 2005 2018 2019 2020 iwrd 012325 automatic integer ref 2023 j 000145 // integer array(100) ref 1998 2012 2029 2049 2056 2061 2076 2087 2099 ja 012333 automatic integer ref 2049 2050 2076 2077 2077 2079 2082 2083 2099 2100 2100 2102 2103 2104 jr 012323 automatic integer ref 2010 2011 2012 2013 2014 2015 2016 k 012326 automatic integer ref 2023 2028 2038 2039 kilter entry point 023075 constant on line 1995 koutput internal subroutine constant ref 2142 l 012327 automatic integer ref 2023 2029 2030 2030 lab 012335 automatic integer ref 2073 2089 2094 lo 000621 // integer array(100) ref 1998 2001 2014 2027 2041 2051 2052 2081 2085 2104 2107 2124 2124 2128 2128 m 012330 automatic integer ref 2034 2035 2036 2037 min0 builtin integer ref 2103 2104 2124 2125 2127 2128 n 012334 automatic integer ref 2067 2068 2069 2112 2113 2113 2113 na 011776 automatic integer array(100) ref 1999 2039 2065 2068 2070 2077 2077 2077 2077 2080 2082 2087 2091 2100 2100 2100 2100 2103 2104 2113 2120 2132 nb 012142 automatic integer array(100) ref 1999 2069 2071 2083 2088 2121 2122 2123 2133 2134 ni 012337 automatic integer ref 2119 2120 2121 2122 2122 2123 2129 2130 2132 2133 2134 2135 2136 nj 012340 automatic integer ref 2120 2122 2129 2132 2135 nodes 012324 automatic integer ref 2017 2030 2030 2036 2067 2112 pi 011632 automatic integer array(100) ref 1999 2001 2037 2050 2050 2079 2079 2102 2102 2113 2113 2122 2122 snk 012316 automatic integer ref 2000 2057 2061 2070 2091 src 012315 automatic integer ref 2000 2056 2060 2065 2070 2071 2119 2130 2136 NAMES DECLARED BUT NOT USED fname character(16) declared 2003 stat 011630 automatic double precision equivalenced declared 2004 2005 LOC LABEL TYPE LINE REFERENCES 1 format 2024 ref 2023 023325 5 executable 2035 ref 2034 023374 10 executable 2042 ref 2040 023341 11 executable 2037 ref 2036 023400 16 executable 2044 023403 20 executable 2047 used in transfer ref 2116 2139 023463 21 executable 2053 ref 2047 023470 22 executable 2056 used in transfer ref 2051 023501 23 executable 2060 used in transfer ref 2052 023512 24 executable 2065 used in transfer ref 2059 2063 023560 25 executable 2072 used in transfer ref 2065 023536 26 executable 2069 ref 2067 023562 27 executable 2073 used in transfer ref 2094 023671 28 executable 2085 used in transfer ref 2080 023723 29 executable 2089 used in transfer ref 2084 023732 30 executable 2092 used in transfer ref 2074 2077 2081 2085 024054 31 executable 2105 used in transfer ref 2097 2100 024131 32 executable 2114 ref 2112 024136 33 executable 2118 used in transfer ref 2091 024142 34 executable 2120 used in transfer ref 2130 024244 35 executable 2127 used in transfer ref 2123 024310 36 executable 2129 used in transfer ref 2126 024315 37 executable 2132 used in transfer ref 2136 024355 38 executable 2142 used in transfer ref 2055 024346 39 executable 2140 used in transfer ref 2041 2109 023140 108 executable 2016 ref 2010 023213 109 executable 2023 used in transfer ref 2032 023314 116 executable 2033 used in transfer ref 2023 023352 161 executable 2039 ref 2038 995 format 2141 ref 2140 999 format 2009 ref 2008 023164 3535 executable 2020 used in transfer ref 2019 2019 023210 4545 executable 2022 used in transfer ref 2019 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1995 023074 2007 023115 2008 023117 2010 023126 2011 023130 2012 023134 2013 023135 2014 023136 2015 023137 2016 023140 2017 023145 2018 023147 2019 023161 2020 023164 2021 023206 2022 023210 2023 023213 2025 023265 2026 023271 2027 023274 2028 023277 2029 023302 2030 023305 2031 023311 2032 023313 2033 023314 2034 023321 2035 023325 2036 023335 2037 023341 2038 023350 2039 023352 2040 023361 2041 023366 2042 023374 2044 023400 2045 023402 2047 023403 2048 023410 2049 023414 2050 023416 2051 023424 2052 023442 2053 023463 2055 023467 2056 023470 2057 023474 2058 023476 2059 023500 2060 023501 2061 023505 2062 023507 2063 023511 2065 023512 2066 023525 2067 023527 2068 023533 2069 023536 2070 023543 2071 023552 2072 023560 2073 023562 2074 023563 2075 023570 2076 023574 2077 023576 2079 023624 2080 023634 2081 023640 2082 023661 2083 023666 2084 023670 2085 023671 2086 023712 2087 023716 2088 023721 2089 023723 2091 023725 2092 023732 2094 023736 2096 023742 2097 023744 2098 023751 2099 023755 2100 023757 2102 024005 2103 024015 2104 024033 2105 024054 2106 024060 2107 024063 2109 024111 2112 024115 2113 024121 2114 024131 2116 024135 2118 024136 2119 024140 2120 024142 2121 024150 2122 024155 2123 024173 2124 024177 2125 024221 2126 024243 2127 024244 2128 024266 2129 024310 2130 024312 2132 024315 2133 024323 2134 024330 2135 024337 2136 024341 2138 024344 2139 024345 2140 024346 2142 024355 2143 024360 2144 024366 Subroutine koutput 2146 cSTART koutput 2147 subroutine koutput 2148 common arcs,m(100),n(100),cost(100),hi(100),lo(100),flow(100) 2149 integer arcs,cost,hi,flow 2150 print 204 2151 204 format (//" Network status and minimum cost flow") 2152 200 print 201 2153 201 format(1h0,4x,"i",5x,"j",6x,"cost",5x,"u.bnd",5x,"l.bnd", 2154 &6x,"flow") 2155 do 202 i=1,arcs 2156 202 print 203,m(i),n(i),cost(i),hi(i),lo(i),flow(i) 2157 203 format(1h0,i5,i6,4i10) 2158 return 2159 end Subroutine koutput NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES arcs 000000 // integer ref 2148 2149 2155 blnk*com common block name 601 words ref 2148 cost 000311 // integer array(100) ref 2148 2149 2156 flow 000765 // integer array(100) ref 2148 2149 2156 hi 000455 // integer array(100) ref 2148 2149 2156 i 012342 automatic integer ref 2155 2156 2156 2156 2156 2156 2156 koutput entry point 024371 constant on line 2147 lo 000621 // integer array(100) ref 2148 2156 m 000001 // integer array(100) ref 2148 2156 n 000145 // integer array(100) ref 2148 2156 LOC LABEL TYPE LINE REFERENCES 024420 200 executable 2152 201 format 2153 ref 2152 024434 202 executable 2156 ref 2155 203 format 2157 ref 2156 204 format 2151 ref 2150 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2147 024370 2150 024411 2152 024420 2155 024427 2156 024434 2158 024517 Subroutine lnprog 2160 subroutine lnprog 2161 c lnprog -- Modified Feb 1975 2162 common t,t1,j,a(31,51),ci(31),cj(51),b(31),idc(51),idr(31) 2163 dimension isen(31),key(4) 2164 character ll*3,key*4,min*4,isen*1,fname*32 2165 double precision stat 2166 integer istat 2167 equivalence (istat,stat) 2168 external com_err_ (descriptors), attach (descriptors), detach 2169 lpdata=10 2170 data key,min/" ","<","=",">","min"/ 2171 print," Multics LP Program" 2172 print, " " 2173 call attach (istat) 2174 if (istat) 3535,3434,3535 2175 3535 call com_err_(istat,"lnprog","error in attach") 2176 stop 2177 3434 tol1=0.1e-5 2178 tol2=0.1e-4 2179 tol4=10.0e-6 2180 tol5=1.0e+25 2181 10 read(lpdata,11,end=999) (idr(i),i=1,10) 2182 11 format(10a4) 2183 read(lpdata,950)m,n,ll 2184 print 12,(idr(i), i=1,10) 2185 12 format(/10x,10a4/) 2186 read(lpdata,950)(cj(j),j=1,n) 2187 print 13,m,n 2188 13 format(10x,i2," ROWS x ",i2," COLS"/) 2189 do 1111 i=1,m 2190 read(lpdata,950)(a(i,j),j=1,n),isen(i),b(i),ci(i) 2191 1111 continue 2192 fmin=1.0 2193 if(ll .eq.min)fmin=-1.0 2194 40 do 70 j=1,n 2195 cj(j)=fmin*cj(j) 2196 70 idc(j)=10*j 2197 do 100 i=1,m 2198 ci(i)=fmin*ci(i); ll=isen(i); kr=10*i+1001 2199 if(ll.ne.key(4))go to 90 2200 80 kr=kr+2; b(i)=-b(i) 2201 do 85 j=1,n 2202 85 a(i,j)=-a(i,j) 2203 90 if(ll.ne.key(3))go to 100 2204 95 ci(i)=-tol5; kr=kr+1 2205 100 idr(i)=kr 2206 zm=0.0; infs=0 2207 do 130 i=1,m 2208 if(zm.le.b(i))go to 130 2209 2210 zm=b(i) 2211 130 continue 2212 if(zm)140,180,180 2213 140 zm=abs(zm); n=n+1 2214 do 160 i=1,m 2215 if(b(i) .lt.0.)go to 150 2216 a(i,n)=0.0 2217 go to 160 2218 150 b(i)=b(i)+zm; a(i,n)=1.0 2219 160 continue 2220 m=m+1; idr(m)=10*m+2002; idc(n)=9990 2221 do 170 j=1,n 2222 170 a(m,j)=0.0 2223 a(m,n)=1.0; b(m)=zm; ci(m)=-tol5; cj(n)=0.0 2224 180 print,"1=print iteration log, 2=suppress" 2225 read,ksw 2226 if(ksw-1)190,192,190 2227 190 ksw=2 2228 go to 200 2229 192 print," ITR V IN V OUT OBJ FUNCT" 2230 itr=0;k=0;l=0 2231 200 zm=0.0 2232 do 210 i=1,m 2233 210 zm=zm+b(i)*ci(i) 2234 go to (220,230),ksw 2235 220 print 900,itr,l/10,k/10,fmin*zm 2236 itr=itr+1 2237 230 dj=-tol1; kc=0 2238 do 250 j=1,n 2239 if(idc(j) .le.0)go to 250 2240 2241 t=zj(m) 2242 if(dj .le. t) go to 250 2243 dj=t; kc=j 2244 250 continue 2245 if(kc.le.0)go to 400 2246 ark=0.0;brk=1.0e35;kr=0;i=m 2247 do 290 l=1,m 2248 t=a(i,kc);if(t.le.0.)go to 290 2249 t1=b(i)/t 2250 if(brk-t1)290,270,280 2251 270 if(t-ark)290,290,282 2252 280 brk=t1 2253 282 ark=t 2254 kr=i 2255 290 i=i-1 2256 if(kr .le.0)go to 292 2257 if(tol2.le.ark)go to 295 2258 infs=1 2259 292 idc(kc)=-idc(kc) 2260 go to 230 2261 295 a(kr,kc)=0.0 2262 do 330 j=1,n 2263 if(j-kc)300,330,300 2264 300 if(a(kr,j))310,330,310 2265 310 zm=a(kr,j)/ark;a(kr,j)=zm 2266 do 320 i=1,m 2267 t=a(i,kc)*zm 2268 t1=a(i,j)-t 2269 320 a(i,j)=ezero(tol4) 2270 330 continue 2271 b(kr)=brk;if(brk.le.0.)go to 350 2272 do 340 i=1,m 2273 t=a(i,kc)*brk;t1=b(i)-t 2274 340 b(i)=ezero(tol4) 2275 350 a(kr,kc)=-1.0 2276 do 360 i=1,m 2277 360 a(i,kc)=-a(i,kc)/ark 2278 k=idr(kr);l=idc(kc);idr(kr)=l;idc(kc)=k 2279 t=ci(kr); ci(kr)=cj(kc); cj(kc)=t 2280 if(infs.le.0)go to 200 2281 do 380 j=1,n 2282 if(idc(j)) 370,380,380 2283 370 idc(j)=-idc(j) 2284 380 continue 2285 infs=0 2286 go to 200 2287 400 print 910,fmin*zm 2288 do 440 k=1,m 2289 nl=3000; i=0 2290 do 410 l=1,m 2291 if(nl.le.idr(l))go to 410 2292 nl=idr(l); i=l 2293 410 continue 2294 if(i.le.0)go to 440 2295 idr(i)=9990;kc=mod(nl,10)+1 2296 print 920,nl/10,key(kc),fmin*ci(i),b(i) 2297 440 continue 2298 print 930 2299 do 540 k=1,n 2300 nl=2000; j=0 2301 do 510 l=1,n 2302 if(nl.le.iabs(idc(l)))go to 510 2303 nl=idc(l); j=l 2304 510 continue 2305 if(j.le.0)go to 540 2306 idc(j)=9990;kc=iabs(mod(nl,10))+1 2307 if(cj(j)+tol5) 530,520,530 2308 520 cj(j)=0.0 2309 530 print 920,nl/10,key(kc),fmin*cj(j),zj(m) 2310 540 continue 2311 print, " " 2312 go to 10 2313 900 format(3i6,1pe15.5) 2314 910 format(/1x," OBJ. FUNCT. =",1pe15.5//" BAS VAR", 2315 & 4x,"OBJ. COEFF.",5x,"RESULT") 2316 920 format(6x,i3,a1,2(1pe15.5)) 2317 930 format(/1x,"N. BAS VAR",4x,"OBJ. COEFF.",5x,"RESULT") 2318 940 format(4h ,15a4,/4x,i2," rows x ",i2," cols") 2319 950 format(v) 2320 999 call detach 2321 stop 2322 end Subroutine lnprog NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000003 // real array(31,51) ref 2162 2190 2202 2202 2216 2218 2222 2223 2248 2261 2264 2265 2265 2267 2268 2269 2273 2275 2277 2277 abs builtin ref 2213 ark 012430 automatic real ref 2246 2251 2253 2257 2265 2277 attach external subroutine 010042 constant with descriptors ref 2168 2173 b 003202 // real array(31) ref 2162 2190 2200 2200 2208 2210 2215 2218 2218 2223 2233 2249 2271 2273 2274 2296 blnk*com common block name 1779 words ref 2162 brk 012431 automatic real ref 2246 2250 2252 2271 2271 2273 ci 003060 // real array(31) ref 2162 2190 2198 2198 2204 2223 2233 2279 2279 2296 cj 003117 // real array(51) ref 2162 2186 2195 2195 2223 2279 2279 2307 2308 2309 com_err_ external subroutine 010040 constant with descriptors ref 2168 2175 detach external subroutine 010044 constant ref 2168 2320 dj 012426 automatic real ref 2237 2242 2243 ezero internal function constant real ref 2269 2274 fmin 012416 automatic real ref 2192 2193 2195 2198 2235 2287 2296 2309 i 012413 automatic integer ref 2181 2181 2184 2184 2189 2190 2190 2190 2190 2197 2198 2198 2198 2198 2200 2200 2202 2202 2204 2205 2207 2208 2210 2214 2215 2216 2218 2218 2218 2232 2233 2233 2246 2248 2249 2254 2255 2255 2266 2267 2268 2269 2272 2273 2273 2274 2276 2277 2277 2289 2292 2294 2295 2296 2296 iabs builtin integer ref 2302 2306 idc 003241 // integer array(51) ref 2162 2196 2220 2239 2259 2259 2278 2278 2282 2283 2283 2302 2303 2306 idr 003324 // integer array(31) ref 2162 2181 2184 2205 2220 2278 2278 2291 2292 2295 infs 012421 automatic integer ref 2206 2258 2280 2285 isen 012346 automatic character(1) array(31) ref 2163 2164 2190 2198 istat 012344 automatic integer equivalenced ref 2166 2167 2173 2174 2175 itr 012423 automatic integer ref 2230 2235 2236 2236 j 000002 // integer ref 2162 2186 2186 2190 2190 2194 2195 2195 2196 2196 2201 2202 2202 2221 2222 2238 2239 2243 2262 2263 2264 2265 2265 2268 2269 2281 2282 2283 2283 2300 2303 2305 2306 2307 2308 2309 k 012424 automatic integer ref 2230 2235 2278 2278 2288 2299 kc 012427 automatic integer ref 2237 2243 2245 2248 2259 2259 2261 2263 2267 2273 2275 2277 2277 2278 2278 2279 2279 2295 2296 2306 2309 key 000210 automatic character(4) array(4) initialized ref 2163 2164 2170 2199 2203 2296 2309 kr 012417 automatic integer ref 2198 2200 2200 2204 2204 2205 2246 2254 2256 2261 2264 2265 2265 2271 2275 2278 2278 2279 2279 ksw 012422 automatic integer ref 2225 2226 2227 2234 l 012425 automatic integer ref 2230 2235 2247 2278 2278 2290 2291 2292 2292 2301 2302 2303 2303 ll 012405 automatic character(3) ref 2164 2183 2193 2198 2199 2203 lnprog entry point 024521 constant on line 2160 lpdata 012406 automatic integer ref 2169 2169 2181 2183 2186 2190 m 012414 automatic integer ref 2183 2187 2189 2197 2207 2214 2220 2220 2220 2220 2222 2223 2223 2223 2232 2241 2246 2247 2266 2272 2276 2288 2290 2309 min 000214 automatic character(4) initialized ref 2164 2170 2193 mod builtin ref 2295 2306 n 012415 automatic integer ref 2183 2186 2187 2190 2194 2201 2213 2213 2216 2218 2220 2221 2223 2223 2238 2262 2281 2299 2301 nl 012432 automatic integer ref 2289 2291 2292 2295 2296 2300 2302 2303 2306 2309 t 000000 // real ref 2162 2241 2242 2243 2248 2248 2249 2251 2253 2267 2268 2273 2273 2279 2279 t1 000001 // real ref 2162 2249 2250 2252 2268 2273 tol1 012407 automatic real ref 2177 2237 tol2 012410 automatic real ref 2178 2257 tol4 012411 automatic real ref 2179 2269 2274 tol5 012412 automatic real ref 2180 2204 2223 2307 zj internal function constant real ref 2241 2309 zm 012420 automatic real ref 2206 2208 2210 2212 2213 2213 2218 2223 2231 2233 2233 2235 2265 2265 2267 2287 NAMES DECLARED BUT NOT USED fname character(32) declared 2164 stat 012344 automatic double precision equivalenced declared 2165 2167 LOC LABEL TYPE LINE REFERENCES 024645 10 executable 2181 used in transfer ref 2312 11 format 2182 ref 2181 12 format 2185 ref 2184 13 format 2188 ref 2187 025110 40 executable 2194 025123 70 executable 2196 ref 2194 025161 80 executable 2200 025174 85 executable 2202 ref 2201 025213 90 executable 2203 used in transfer ref 2199 025220 95 executable 2204 025226 100 executable 2205 used in transfer ref 2197 2203 025257 130 executable 2211 used in transfer ref 2207 2208 025266 140 executable 2213 used in transfer ref 2212 025315 150 executable 2218 used in transfer ref 2215 025330 160 executable 2219 used in transfer ref 2214 2217 025352 170 executable 2222 ref 2221 025404 180 executable 2224 used in transfer ref 2212 2212 025442 190 executable 2227 used in transfer ref 2226 2226 025445 192 executable 2229 used in transfer ref 2226 025465 200 executable 2231 used in transfer ref 2228 2280 2286 025473 210 executable 2233 ref 2232 025515 220 executable 2235 used in transfer ref 2234 025565 230 executable 2237 used in transfer ref 2234 2260 025622 250 executable 2244 used in transfer ref 2238 2239 2242 025671 270 executable 2251 used in transfer ref 2250 025676 280 executable 2252 used in transfer ref 2250 025701 282 executable 2253 used in transfer ref 2251 025706 290 executable 2255 used in transfer ref 2247 2248 2250 2251 2251 025726 292 executable 2259 used in transfer ref 2256 025733 295 executable 2261 used in transfer ref 2257 025753 300 executable 2264 used in transfer ref 2263 2263 025763 310 executable 2265 used in transfer ref 2264 2264 026022 320 executable 2269 ref 2266 026043 330 executable 2270 used in transfer ref 2262 2263 2264 026076 340 executable 2274 ref 2272 026111 350 executable 2275 used in transfer ref 2271 026127 360 executable 2277 ref 2276 026204 370 executable 2283 used in transfer ref 2282 026211 380 executable 2284 used in transfer ref 2281 2282 2282 026220 400 executable 2287 used in transfer ref 2245 026271 410 executable 2293 used in transfer ref 2290 2291 026361 440 executable 2297 used in transfer ref 2288 2294 026427 510 executable 2304 used in transfer ref 2301 2302 026461 520 executable 2308 used in transfer ref 2307 026465 530 executable 2309 used in transfer ref 2307 2307 026537 540 executable 2310 used in transfer ref 2299 2305 900 format 2313 ref 2235 910 format 2314 ref 2287 920 format 2316 ref 2296 2309 930 format 2317 ref 2298 940 format ref 2318 950 format 2319 ref 2183 2186 2190 026561 999 executable 2320 used in transfer ref 2181 025073 1111 executable 2191 ref 2189 024636 3434 executable 2177 used in transfer ref 2174 024612 3535 executable 2175 used in transfer ref 2174 2174 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2160 024520 2169 024541 2171 024543 2172 024560 2173 024575 2174 024607 2175 024612 2176 024634 2177 024636 2178 024640 2179 024642 2180 024643 2181 024645 2183 024670 2184 024721 2186 024742 2187 024763 2189 025007 2190 025013 2191 025073 2192 025077 2193 025101 2194 025110 2195 025115 2196 025123 2197 025133 2198 025137 2198 025144 2198 025150 2199 025154 2200 025161 2200 025163 2201 025170 2202 025174 2203 025213 2204 025220 2204 025225 2205 025226 2206 025236 2206 025240 2207 025241 2208 025245 2210 025253 2211 025257 2212 025263 2213 025266 2213 025272 2214 025273 2215 025277 2216 025305 2217 025314 2218 025315 2218 025322 2219 025330 2220 025334 2220 025335 2220 025343 2221 025346 2222 025352 2223 025365 2223 025373 2223 025376 2223 025401 2224 025404 2225 025421 2226 025436 2227 025442 2228 025444 2229 025445 2230 025462 2230 025463 2230 025464 2231 025465 2232 025467 2233 025473 2234 025505 2235 025515 2236 025564 2237 025565 2237 025570 2238 025571 2239 025576 2241 025604 2242 025612 2243 025615 2243 025620 2244 025622 2245 025627 2246 025633 2246 025635 2246 025637 2246 025640 2247 025642 2248 025646 2248 025654 2249 025657 2250 025664 2251 025671 2252 025676 2253 025701 2254 025704 2255 025706 2256 025714 2257 025720 2258 025724 2259 025726 2260 025732 2261 025733 2262 025742 2263 025746 2264 025753 2265 025763 2265 025772 2266 026000 2267 026004 2268 026014 2269 026022 2270 026043 2271 026050 2271 026053 2272 026056 2273 026062 2273 026072 2274 026076 2275 026111 2276 026123 2277 026127 2278 026147 2278 026152 2278 026155 2278 026156 2279 026160 2279 026162 2279 026164 2280 026166 2281 026172 2282 026177 2283 026204 2284 026211 2285 026216 2286 026217 2287 026220 2288 026242 2289 026246 2289 026250 2290 026251 2291 026255 2292 026263 2292 026267 2293 026271 2294 026275 2295 026301 2295 026305 2296 026312 2297 026361 2298 026365 2299 026374 2300 026400 2300 026402 2301 026404 2302 026410 2303 026421 2303 026425 2304 026427 2305 026433 2306 026440 2306 026444 2307 026454 2308 026461 2309 026465 2310 026537 2311 026543 2312 026560 2320 026561 2321 026571 Function ezero 2323 c effective zero subroutine 2324 function ezero(tol4) 2325 common t,t1 2326 if(t)100,130,100 2327 100 if(t1)110,120,110 2328 110 if(abs(t1/t)-tol4)120,130,130 2329 120 ezero=0.0;return 2330 130 ezero=t1;return 2331 end Function ezero NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES abs builtin ref 2328 blnk*com common block name 2 words ref 2325 ezero entry point 026574 constant real on line 2324 ezero 012434 automatic real ref 2324 2329 2330 t 000000 // real ref 2325 2326 2328 t1 000001 // real ref 2325 2327 2328 2330 tol4 parameter position 1 real ref 2324 2328 LOC LABEL TYPE LINE REFERENCES 026620 100 executable 2327 used in transfer ref 2326 2326 026624 110 executable 2328 used in transfer ref 2327 2327 026634 120 executable 2329 used in transfer ref 2327 2328 026640 130 executable 2330 used in transfer ref 2326 2328 2328 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2324 026573 2326 026614 2327 026620 2328 026624 2329 026634 2329 026636 2330 026640 2330 026643 Function zj 2332 c compute (zj-cj) subroutine 2333 cSTART zj 2334 function zj(m) 2335 common t(2),j,a(31,51),ci(31),cj(51) 2336 zj=-cj(j) 2337 do 100 ne=1,m 2338 100 zj=zj+a(ne,j)*ci(ne) 2339 return 2340 end Function zj NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000003 // real array(31,51) ref 2335 2338 blnk*com common block name 1666 words ref 2335 ci 003060 // real array(31) ref 2335 2338 cj 003117 // real array(51) ref 2335 2336 j 000002 // integer ref 2335 2336 2338 m parameter position 1 integer ref 2334 2337 ne 012437 automatic integer ref 2337 2338 2338 zj 012436 automatic real ref 2334 2336 2336 2338 2338 zj entry point 026646 constant real on line 2334 NAMES DECLARED BUT NOT USED t 000000 // real array(2) declared 2335 LOC LABEL TYPE LINE REFERENCES 026677 100 executable 2338 ref 2337 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2334 026645 2336 026666 2337 026673 2338 026677 2339 026715 Subroutine maxflow 2341 subroutine maxflow 2342 c - maxflow mod. May 1975 2343 common cap(25,25),flo(25,25) 2344 dimension lab(25),eps(25),iscan(25) 2345 logical out; integer data 2346 character fname*32 2347 double precision stat 2348 integer istat 2349 equivalence (istat,stat) 2350 external com_err_ (descriptors), attach (descriptors), detach 2351 data=10 2352 n=25 2353 print 21 2354 21 format(/" M u l t i c s M A X - F L O W / M I N - C U T"/) 2355 call attach (istat) 2356 if (istat) 4545,4141,4545 2357 4545 call com_err_(stat,"maxflow","error in attach") 2358 stop 2359 4141 continue 2360 print 23 2361 23 format (/" Type 0 for trace if iterations, 1 for optimal solution only") 2362 read 1000, i;out=i.eq.0 2363 1000 format (v) 2364 read(10,3)lab 2365 3 format(25a2) 2366 print 4,lab 2367 4 format(/,20x,25a2,/) 2368 c initialization 2369 do 101 i=1,n 2370 lab(i)=0;eps(i)=0;iscan(i)=0 2371 do 101 j=1,n 2372 cap(i,j)=-9999. 2373 101 flo(i,j)=0. 2374 nn=0 2375 c read in arcs in following format:1=supersource node, 2376 c n=supersink node;on each line 2377 c line#,start node,end node,capacity,flow 2378 1 format(v) 2379 102 read(data,1,end=104)i,j,a1,a2 2380 cap(i,j)=a1 2381 flo(i,j)=a2 2382 if(j.gt.nn)nn=j 2383 go to 102 2384 104 lab(1)=9999 2385 eps(1)=9999.0 2386 n=nn 2387 if(out)call moutput(1,nn) 2388 105 do 113 j=1,nn 2389 c find a labeled, unscanned node. 2390 if(lab(j).eq.0) go to 114 2391 107 if(iscan(j).eq.1)goto 114 2392 c scan it. 2393 do 112 i=1,nn 2394 if(cap(j,i)+999.) 200,112,200 2395 200 if(lab(i).ne.0) go to 112 2396 ps=cap(j,i)-flo(j,i) 2397 if(ps.gt.0.0) go to 1091 2398 if(cap(i,j)+9999.) 210,112,210 2399 210 if(flo(i,j).ge.0.0) go to 112 2400 lab(i)=-j 2401 if(flo(j,i).lt.eps(j)) go to 110 2402 eps(i)=eps(j) 2403 go to 111 2404 1091 lab(i)=j 2405 if(ps.lt.eps(j)) go to 1092 2406 eps(i)=eps(j) 2407 go to 111 2408 1092 eps(i)=ps 2409 go to 111 2410 110 eps(i)=flo(j,i) 2411 111 if(lab(nn).ne.0) go to 1145 2412 112 continue 2413 iscan(j)=1 2414 114 continue 2415 113 continue 2416 c check to see if all nodes are scanned. 2417 do 1131 i=1,nn 2418 if(lab(i).eq.0) go to 1131 2419 if(iscan(i).eq.1) go to 1131 2420 go to 105 2421 1131 continue 2422 go to 990 2423 c sink node labelled, increase flow 2424 1145 add=eps(nn) 2425 115 jk=lab(nn) 2426 if(jk.gt.0)go to 116 2427 flo(jk,nn)=flo(jk,nn)-add 2428 go to 117 2429 116 flo(jk,nn)=flo(jk,nn)+add 2430 nn=lab(nn) 2431 117 if(lab(nn).eq.9999) go to 1171 2432 go to 115 2433 c back at the beginning, reinitialize 2434 1171 nn=n 2435 c a feasible flow has been found, tell the world 2436 if(out)call moutput(3,n) 2437 c reinitialize those things which need reinitialization 2438 do 118 i=2,nn 2439 lab(i)=0 2440 118 iscan(i)=0 2441 iscan(1)=0 2442 go to 105 2443 990 call moutput(2,n) 2444 end file 10 2445 call detach 2446 stop 2447 end Subroutine maxflow NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a1 012563 automatic real ref 2379 2380 a2 012564 automatic real ref 2379 2381 add 012566 automatic real ref 2424 2427 2429 attach external subroutine 010042 constant with descriptors ref 2350 2355 blnk*com common block name 1250 words ref 2343 cap 000000 // real array(25,25) ref 2343 2372 2380 2394 2396 2398 com_err_ external subroutine 010040 constant with descriptors ref 2350 2357 data 012556 automatic integer ref 2345 2351 2351 2379 detach external subroutine 010044 constant ref 2350 2445 eps 012473 automatic real array(25) ref 2344 2370 2385 2401 2402 2402 2405 2406 2406 2408 2410 2424 flo 001161 // real array(25,25) ref 2343 2373 2381 2396 2399 2401 2410 2427 2427 2429 2429 i 012560 automatic integer ref 2362 2362 2369 2370 2370 2370 2372 2373 2379 2380 2381 2393 2394 2395 2396 2396 2398 2399 2400 2401 2402 2404 2406 2408 2410 2410 2417 2418 2419 2438 2439 2440 iscan 012524 automatic integer array(25) ref 2344 2370 2391 2413 2419 2440 2441 istat 012440 automatic integer equivalenced ref 2348 2349 2355 2356 j 012561 automatic integer ref 2371 2372 2373 2379 2380 2381 2382 2382 2388 2390 2391 2394 2396 2396 2398 2399 2400 2401 2401 2402 2404 2405 2406 2410 2413 jk 012567 automatic integer ref 2425 2426 2427 2427 2429 2429 lab 012442 automatic integer array(25) ref 2344 2364 2366 2370 2384 2390 2395 2400 2404 2411 2418 2425 2430 2431 2439 maxflow entry point 026721 constant on line 2341 moutput internal subroutine constant ref 2387 2436 2443 n 012557 automatic integer ref 2352 2369 2371 2386 2434 2436 2443 nn 012562 automatic integer ref 2374 2382 2382 2386 2387 2388 2393 2411 2417 2424 2425 2427 2427 2429 2429 2430 2430 2431 2434 2438 out 012555 automatic logical ref 2345 2362 2387 2436 ps 012565 automatic real ref 2396 2397 2405 2408 stat 012440 automatic double precision equivalenced ref 2347 2349 2357 NAMES DECLARED BUT NOT USED fname character(32) declared 2346 LOC LABEL TYPE LINE REFERENCES 1 format ref 2378 2379 3 format 2365 ref 2364 4 format 2367 ref 2366 21 format 2354 ref 2353 23 format 2361 ref 2360 027140 101 executable 2373 ref 2369 2371 027157 102 executable 2379 used in transfer ref 2383 027242 104 executable 2384 used in transfer ref 2379 027257 105 executable 2388 used in transfer ref 2420 2442 027270 107 executable 2391 027421 110 executable 2410 used in transfer ref 2401 027430 111 executable 2411 used in transfer ref 2403 2407 2409 027435 112 executable 2412 used in transfer ref 2393 2394 2395 2398 2399 027444 113 executable 2415 ref 2388 027444 114 executable 2414 used in transfer ref 2390 2391 027477 115 executable 2425 used in transfer ref 2432 027521 116 executable 2429 used in transfer ref 2426 027540 117 executable 2431 used in transfer ref 2428 027564 118 executable 2440 ref 2438 027312 200 executable 2395 used in transfer ref 2394 2394 027347 210 executable 2399 used in transfer ref 2398 2398 027574 990 executable 2443 used in transfer ref 2422 1000 format 2363 ref 2362 027400 1091 executable 2404 used in transfer ref 2397 027415 1092 executable 2408 used in transfer ref 2405 027467 1131 executable 2421 used in transfer ref 2417 2418 2419 027474 1145 executable 2424 used in transfer ref 2411 027546 1171 executable 2434 used in transfer ref 2431 027015 4141 executable 2359 used in transfer ref 2356 026771 4545 executable 2357 used in transfer ref 2356 2356 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2341 026720 2351 026741 2352 026743 2353 026745 2355 026754 2356 026766 2357 026771 2358 027013 2359 027015 2360 027015 2362 027024 2362 027043 2364 027047 2366 027067 2369 027107 2370 027113 2370 027116 2370 027120 2371 027122 2372 027126 2373 027140 2374 027156 2379 027157 2380 027217 2381 027226 2382 027234 2383 027241 2384 027242 2385 027246 2386 027250 2387 027252 2388 027257 2390 027263 2391 027270 2393 027275 2394 027301 2395 027312 2396 027317 2397 027333 2398 027336 2399 027347 2400 027357 2401 027362 2402 027373 2403 027377 2404 027400 2405 027403 2406 027410 2407 027414 2408 027415 2409 027420 2410 027421 2411 027430 2412 027435 2413 027441 2414 027444 2415 027444 2417 027450 2418 027454 2419 027461 2420 027466 2421 027467 2422 027473 2424 027474 2425 027477 2426 027502 2427 027505 2428 027520 2429 027521 2430 027535 2431 027540 2432 027545 2434 027546 2436 027550 2438 027555 2439 027561 2440 027564 2441 027571 2442 027573 2443 027574 2444 027577 2445 027604 2446 027612 Subroutine moutput 2448 cSTART moutput 2449 subroutine moutput(k,n) 2450 common cap(25,25),flo(25,25) 2451 go to (15,20,30),k 2452 15 print 4 2453 go to 990 2454 20 print 5 2455 go to 990 2456 30 print 8 2457 990 flomax=0.0 2458 print 6 2459 do 992 i=1,n 2460 do 991 j=1,n 2461 if(cap(i,j)+9999.) 800,991,800 2462 800 print 7,i,j,cap(i,j),flo(i,j) 2463 if(j.eq.n) flomax=flomax+flo(i,j) 2464 991 continue 2465 992 continue 2466 print 10,flomax 2467 10 format (/20x," Max Flow is ",f10.5,//) 2468 4 format(/1x," Status of network at start"/) 2469 5 format(/1x," Status of network at optimal solution"/) 2470 6 format(5x,"Starting Node Ending Node Capacity Flow In Arc ") 2471 7 format(1h ,3x,i10,3x,i10,5x,f10.2,3x,f10.2) 2472 8 format(/1x," Status of network at a feasible solution",/) 2473 return 2474 end Subroutine moutput NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 1250 words ref 2450 cap 000000 // real array(25,25) ref 2450 2461 2462 flo 001161 // real array(25,25) ref 2450 2462 2463 flomax 012570 automatic real ref 2457 2463 2463 2466 i 012571 automatic integer ref 2459 2461 2462 2462 2462 2463 j 012572 automatic integer ref 2460 2461 2462 2462 2462 2463 2463 k parameter position 1 integer ref 2449 2451 moutput entry point 027615 constant on line 2449 n parameter position 2 integer ref 2449 2459 2460 2463 LOC LABEL TYPE LINE REFERENCES 4 format 2468 ref 2452 5 format 2469 ref 2454 6 format 2470 ref 2458 7 format 2471 ref 2462 8 format 2472 ref 2456 10 format 2467 ref 2466 027646 15 executable 2452 used in transfer ref 2451 027656 20 executable 2454 used in transfer ref 2451 027666 30 executable 2456 used in transfer ref 2451 027727 800 executable 2462 used in transfer ref 2461 2461 027675 990 executable 2457 used in transfer ref 2453 2455 030011 991 executable 2464 used in transfer ref 2460 2461 030015 992 executable 2465 ref 2459 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2449 027614 2451 027635 2452 027646 2453 027655 2454 027656 2455 027665 2456 027666 2457 027675 2458 027677 2459 027706 2460 027712 2461 027716 2462 027727 2463 027777 2464 030011 2465 030015 2466 030021 2473 030040 Subroutine mreg1 2475 subroutine mreg1 2476 c mreg1 Modified Feb 1975 2477 c 2478 dimension x(90,10),xsum(10),y(90),xmean(10),xpx(25,11), 2479 & label(25),xpy(10),xout(10),ll(10) 2480 character fnam*16 2481 integer fname,istat 2482 double precision stat 2483 equivalence (istat,stat) 2484 external com_err_ (descriptors), attach (descriptors), detach 2485 data iyes,inos/3hyes,2hno/ 2486 print," " 2487 print," M R E G 1" 2488 print," " 2489 1 print, "Do you want instructions? (Type yes or no)" 2490 read 100,iy 2491 2492 2493 fname=10 2494 100 format(a3) 2495 if(iyes-iy) 193,130,193 2496 130 print 132 2497 print 133 2498 print 134 2499 print 135 2500 print 136 2501 132 format(///"Multiple regression is an attempt to curve fit observed"/ 2502 &"data by the model:",//," Y-YMEAN = A(1)(X(1)-XMEAN)+....+A(P)(X(P)-XPMEAN)",//) 2503 133 format("Where:"//"YMEAN = mean of observed data."/"XIMEAN = mean of each independent variable.") 2504 134 format("The A(I) are unknown coefficients"/ 2505 &"determined by the least squares process."/) 2506 135 format(" The data is entered in matrix form:"// 2507 & " Y1 X11 X12...X1M"/ 2508 & " Y2 X21 X22...X2m"/ 2509 & " . . . ."/ 2510 & " Yn XN1 XN2...XNM 2511 &"//) 2512 136 format( "Y1 is the observed data while X11,X12,X1M are the"/ 2513 & "corresponding independent variables."//" 2514 &For the datafile option build the file without line numbers"/ 2515 &"but with the data in the same sequence as requisted in the terminal option."// 2516 &"Restrictions:"/ 2517 & " M must be .LE. 10 and N must be .LE. 90."/ 2518 & " Input is typed in with each element containing a decimal point"/ 2519 & " and commas seperating each element."// 2520 &"Now you try it. 2521 &"//) 2522 193 print,"Is data read from a file? (Type yes or no)" 2523 read 100,iy 2524 if(iyes-iy) 200,358,200 2525 200 print,"Number of observations?" 2526 read,n 2527 print,"Number of variates?" 2528 read,np 2529 141 format(/"Enter the data in the following way,"/5x"Y1,X11,", 2530 & "X12,...,X1M"/5X"Y2,X21,X22,...,X2M"/6X". . ."7X"."/5X, 2531 & "YN,XN1,XN2,...,XNM"//) 2532 print 141 2533 print," " 2534 do 290 i=1,n 2535 290 read,y(i),(x(i,j),j=1,np) 2536 299 print 301 2537 301 format(/"Are any of the above y(n),x(n,m) elements typed ", 2538 & "incorrectly?"/" (Type yes or no)") 2539 306 print,"Any corrections?" 2540 307 read 100,icy 2541 if(inos-icy) 315,350,315 2542 315 if(iyes-icy) 316,320,316 2543 316 print,"Illegal command, try again." 2544 go to 306 2545 320 print 321 2546 321 format(/"Correct element by typing n (row subscript),", 2547 & "comma,"/" m (column subscript),comma,y-value,", 2548 & "comma,"/" x-value,carriage return"/) 2549 325 read,i,j,ytemp,xtemp 2550 if(i-90) 335,335,336 2551 335 if(j-10) 342,342,336 2552 336 print 337 2553 337 format(/"Illegal subscript, m greater than 10, or n greater ", 2554 & "than 90, try again"/) 2555 go to 325 2556 342 y(i)=ytemp 2557 x(i,j)=xtemp 2558 343 print,"Any corrections?" 2559 read 100,icy 2560 if(inos-icy) 345,350,345 2561 345 if(iyes-icy) 346,325,346 2562 346 print,"illegal command, try again." 2563 go to 343 2564 358 call attach (istat) 2565 if (istat) 3434,4545,3434 2566 3434 call com_err_(istat,"mreg1","error in attach") 2567 stop 2568 4545 continue 2569 308 format (v) 2570 309 format(v) 2571 read(fname,309)n 2572 read(fname,309)np 2573 print," " 2574 do 348 i=1,n 2575 read(fname,308,err=348)y(i),(x(i,j),j=1,np) 2576 348 print 349,y(i),(x(i,j),j=1,np) 2577 349 format(6f11.6) 2578 call detach 2579 go to 299 2580 350 print 10 2581 10 format(//21x"MULTIPLE REGRESSION PROGRAM"//25x"YMEAN"9x, 2582 & "XMEAN") 2583 do 20 i=1,np 2584 20 xsum(i)=0. 2585 ysum=0. 2586 do 30 i=1,n 2587 ysum=ysum+y(i) 2588 do 30 k=1,np 2589 30 xsum(k)=xsum(k)+x(i,k) 2590 fn=n 2591 ymean=ysum/fn 2592 do 35 i=1,np 2593 35 xmean(i)=xsum(i)/fn 2594 print 15,ymean,(xmean(i),i=1,np) 2595 15 format(20x,1p1e14.6/(34x,1p1e14.6)) 2596 c convert data 2597 do 45 i=1,n 2598 do 40 j=1,np 2599 40 x(i,j)=x(i,j)-xmean(j) 2600 45 y(i)=y(i)-ymean 2601 50 print 52 2602 52 format(/,"Number of variates to consider?") 2603 read,nvr 2604 if(nvr.le.0)stop 2605 print,"Which ones?" 2606 read,(ll(i),i=1,nvr) 2607 np1=nvr+1 2608 c clear xpx array 2609 do 60 i=1,25 2610 do 60 j=1,11 2611 60 xpx(i,j)=0. 2612 c form cross products and sum 2613 do 72 ii=1,nvr 2614 i=ll(ii) 2615 do 72 jj=ii,nvr 2616 j=ll(jj) 2617 do 70 k=1,n 2618 70 xpx(ii,jj)=xpx(ii,jj)+x(k,i)*x(k,j) 2619 72 xpx(jj,ii)=xpx(ii,jj) 2620 c form right side of normal equations 2621 do 90 ii=1,nvr 2622 i=ll(ii) 2623 do 80 k=1,n 2624 80 xpx(ii,np1)=xpx(ii,np1)+y(k)*x(k,i) 2625 90 xpy(ii)=xpx(ii,np1) 2626 c solve normal equations 2627 call mmtinv(xpx,nvr,np1,label) 2628 sst=0. 2629 ssr=0. 2630 do 101 i=1,n 2631 101 sst=y(i)*y(i)+sst 2632 do 102 i=1,nvr 2633 102 ssr=ssr+xpx(i,np1)*xpy(i) 2634 sse=sst-ssr 2635 dfr=nvr 2636 dfe=n-nvr-1 2637 dft=n-1 2638 vsr=ssr/dfr 2639 vse=sse/dfe 2640 ftest=vsr/vse 2641 print,"Want to see predicted values? (Type yes or no)" 2642 4005 format(a3) 2643 read 4005,iq 2644 if(iyes-iq) 400,105,400 2645 c print read and predicted data 2646 105 print 2000 2647 do 131 i=1,n 2648 out=0. 2649 do 110 kk=1,nvr 2650 k=ll(kk) 2651 110 out=out+x(i,k)*xpx(kk,np1) 2652 out=out+ymean 2653 yout=y(i)+ymean 2654 131 print 3000,out,yout 2655 2000 format(//10x,36h CALCULATED OBSERVED/) 2656 3000 format(20x,1p2e14.6) 2657 400 nfe=dfe 2658 nm1=dft 2659 print 459 2660 459 format(///) 2661 print 460 2662 460 format(5x,65(1h.)) 2663 print 461 2664 461 format(5x,1h.11x,25h.DEGREE OF FREE. SUM OF , 2665 & "SQUARES. VARIANCE ESTIMATE.") 2666 print 500,nvr,ssr,vsr 2667 print 501,nfe,sse,vse 2668 500 format(5x,13h. Regression.i9,6h .,1p1e14.6,3h .1p1e16.6, 2669 & 4h .) 2670 501 format(5x,13h. Remainder .i9,6h ., 2671 & 1p1e14.6,3h .1p1e16.6,4h .) 2672 print 502,nm1,sst 2673 502 format(5x,13h. Total .i9,6h .1p1e14.6,3h .18x,2h .) 2674 print 460 2675 print 459 2676 print 465 2677 465 format(5x,26hLeast Square Coefficients 4x,12h Coefficient, 2678 & " t Confidence Band") 2679 do 510 i=1,nvr 2680 ser=sqrt(xpx(i,i)*vse) 2681 510 print 466,xpx(i,np1),ser 2682 466 format(13x,1p1e14.6,17x,1p1e14.6) 2683 print 459 2684 print 468,nvr,nfe,ftest 2685 468 format(5x,8hf Ratio(i3,1h,i3,22h degrees of freedom)=, 2686 & 1p1e14.6) 2687 print 459 2688 print 4003 2689 4003 format(10x,"Variance-Covariance-Matrix") 2690 do 469 i=1,nvr 2691 469 print 505,(xpx(i,j),j=i,nvr) 2692 505 format(14x,1p1e14.6) 2693 go to 50 2694 end Subroutine mreg1 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES attach external subroutine 010042 constant with descriptors ref 2484 2564 com_err_ external subroutine 010040 constant with descriptors ref 2484 2566 detach external subroutine 010044 constant ref 2484 2578 dfe 015305 automatic real ref 2636 2639 2657 dfr 015304 automatic real ref 2635 2638 dft 015306 automatic real ref 2637 2658 fn 015273 automatic real ref 2590 2591 2593 fname 015260 automatic integer ref 2481 2493 2571 2572 2575 ftest 015311 automatic real ref 2640 2684 i 015264 automatic integer ref 2534 2535 2535 2549 2550 2556 2557 2574 2575 2575 2576 2576 2583 2584 2586 2587 2589 2592 2593 2593 2594 2594 2597 2599 2599 2600 2600 2606 2606 2609 2611 2614 2618 2622 2624 2630 2631 2631 2632 2633 2633 2647 2651 2653 2679 2680 2680 2681 2690 2691 2691 icy 015266 automatic integer ref 2540 2541 2542 2559 2560 2561 ii 015277 automatic integer ref 2613 2614 2615 2618 2618 2619 2619 2621 2622 2624 2624 2625 2625 inos 000217 automatic integer initialized ref 2485 2541 2560 iq 015312 automatic integer ref 2643 2644 istat 012574 automatic integer equivalenced ref 2481 2483 2564 2565 2566 iy 015261 automatic integer ref 2490 2495 2523 2524 iyes 000216 automatic integer initialized ref 2485 2495 2524 2542 2561 2644 j 015265 automatic integer ref 2535 2535 2549 2551 2557 2575 2575 2576 2576 2598 2599 2599 2599 2610 2611 2616 2618 2691 2691 jj 015300 automatic integer ref 2615 2616 2618 2618 2619 2619 k 015272 automatic integer ref 2588 2589 2589 2589 2617 2618 2618 2623 2624 2624 2650 2651 kk 015314 automatic integer ref 2649 2650 2651 label 015203 automatic integer array(25) ref 2478 2627 ll 015246 automatic integer array(10) ref 2478 2606 2614 2616 2622 2650 mmtinv internal subroutine constant ref 2627 mreg1 entry point 030042 constant on line 2475 n 015262 automatic integer ref 2526 2534 2571 2574 2586 2590 2597 2617 2623 2630 2636 2637 2647 nfe 015316 automatic integer ref 2657 2667 2684 nm1 015317 automatic integer ref 2658 2672 np 015263 automatic integer ref 2528 2535 2572 2575 2576 2583 2588 2592 2594 2598 np1 015276 automatic integer ref 2607 2624 2624 2625 2627 2633 2651 2681 nvr 015275 automatic integer ref 2603 2604 2606 2607 2613 2615 2621 2627 2632 2635 2636 2649 2666 2679 2684 2690 2691 out 015313 automatic real ref 2648 2651 2651 2652 2652 2654 ser 015320 automatic real ref 2680 2681 sqrt builtin ref 2680 sse 015303 automatic real ref 2634 2639 2667 ssr 015302 automatic real ref 2629 2633 2633 2634 2638 2666 sst 015301 automatic real ref 2628 2631 2631 2634 2672 vse 015310 automatic real ref 2639 2640 2667 2680 vsr 015307 automatic real ref 2638 2640 2666 x 012576 automatic real array(90,10) ref 2478 2535 2557 2575 2576 2589 2599 2599 2618 2618 2624 2651 xmean 014546 automatic real array(10) ref 2478 2593 2594 2599 xpx 014560 automatic real array(25,11) ref 2478 2611 2618 2618 2619 2619 2624 2624 2625 2627 2633 2651 2680 2681 2691 xpy 015234 automatic real array(10) ref 2478 2625 2633 xsum 014402 automatic real array(10) ref 2478 2584 2589 2589 2593 xtemp 015270 automatic real ref 2549 2557 y 014414 automatic real array(90) ref 2478 2535 2556 2575 2576 2587 2600 2600 2624 2631 2631 2653 ymean 015274 automatic real ref 2591 2594 2600 2652 2653 yout 015315 automatic real ref 2653 2654 ysum 015271 automatic real ref 2585 2587 2587 2591 ytemp 015267 automatic real ref 2549 2556 NAMES DECLARED BUT NOT USED fnam character(16) declared 2480 stat 012574 automatic double precision equivalenced declared 2482 2483 xout array(10) declared 2478 LOC LABEL TYPE LINE REFERENCES 030131 1 executable 2489 10 format 2581 ref 2580 15 format 2595 ref 2594 031200 20 executable 2584 ref 2583 031225 30 executable 2589 ref 2586 2588 031255 35 executable 2593 ref 2592 031322 40 executable 2599 ref 2598 031341 45 executable 2600 ref 2597 031351 50 executable 2601 used in transfer ref 2693 52 format 2602 ref 2601 031444 60 executable 2611 ref 2609 2610 031504 70 executable 2618 ref 2617 031533 72 executable 2619 ref 2613 2615 031567 80 executable 2624 ref 2623 031613 90 executable 2625 ref 2621 100 format 2494 ref 2490 2523 2540 2559 031637 101 executable 2631 ref 2630 031654 102 executable 2633 ref 2632 031762 105 executable 2646 used in transfer ref 2644 032006 110 executable 2651 ref 2649 030173 130 executable 2496 used in transfer ref 2495 032033 131 executable 2654 ref 2647 132 format 2501 ref 2496 133 format 2503 ref 2497 134 format 2504 ref 2498 135 format 2506 ref 2499 136 format 2512 ref 2500 141 format ref 2529 2532 030236 193 executable 2522 used in transfer ref 2495 2495 030276 200 executable 2525 used in transfer ref 2524 2524 030412 290 executable 2535 ref 2534 030455 299 executable 2536 used in transfer ref 2579 301 format 2537 ref 2536 030464 306 executable 2539 used in transfer ref 2544 030501 307 executable 2540 308 format ref 2569 2575 309 format ref 2570 2571 2572 030524 315 executable 2542 used in transfer ref 2541 2541 030530 316 executable 2543 used in transfer ref 2542 2542 030546 320 executable 2545 used in transfer ref 2542 321 format 2546 ref 2545 030555 325 executable 2549 used in transfer ref 2555 2561 030615 335 executable 2551 used in transfer ref 2550 2550 030621 336 executable 2552 used in transfer ref 2550 2551 337 format 2553 ref 2552 030631 342 executable 2556 used in transfer ref 2551 2551 030642 343 executable 2558 used in transfer ref 2563 030702 345 executable 2561 used in transfer ref 2560 2560 030706 346 executable 2562 used in transfer ref 2561 2561 031107 348 executable 2576 used in transfer ref 2574 2575 349 format 2577 ref 2576 031165 350 executable 2580 used in transfer ref 2541 2560 030724 358 executable 2564 used in transfer ref 2524 032063 400 executable 2657 used in transfer ref 2644 2644 459 format 2660 ref 2659 2675 2683 2687 460 format 2662 ref 2661 2674 461 format 2664 ref 2663 465 format 2677 ref 2676 466 format 2682 ref 2681 468 format 2685 ref 2684 032406 469 executable 2691 ref 2690 500 format 2668 ref 2666 501 format 2670 ref 2667 502 format 2673 ref 2672 505 format 2692 ref 2691 032270 510 executable 2681 ref 2679 2000 format 2655 ref 2646 3000 format 2656 ref 2654 030741 3434 executable 2566 used in transfer ref 2565 2565 4003 format 2689 ref 2688 4005 format ref 2642 2643 030765 4545 executable 2568 used in transfer ref 2565 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2475 030041 2486 030062 2487 030077 2488 030114 2489 030131 2490 030146 2493 030165 2495 030167 2496 030173 2497 030202 2498 030211 2499 030220 2500 030227 2522 030236 2523 030253 2524 030272 2525 030276 2526 030313 2527 030330 2528 030345 2532 030362 2533 030371 2534 030406 2535 030412 2536 030455 2539 030464 2540 030501 2541 030520 2542 030524 2543 030530 2544 030545 2545 030546 2549 030555 2550 030611 2551 030615 2552 030621 2555 030630 2556 030631 2557 030634 2558 030642 2559 030657 2560 030676 2561 030702 2562 030706 2563 030723 2564 030724 2565 030736 2566 030741 2567 030763 2568 030765 2571 030765 2572 031004 2573 031023 2574 031040 2575 031044 2576 031107 2578 031156 2579 031164 2580 031165 2583 031174 2584 031200 2585 031207 2586 031211 2587 031215 2588 031221 2589 031225 2590 031244 2591 031247 2592 031251 2593 031255 2594 031265 2597 031312 2598 031316 2599 031322 2600 031341 2601 031351 2603 031360 2604 031375 2605 031402 2606 031417 2607 031435 2609 031440 2610 031442 2611 031444 2613 031462 2614 031466 2615 031471 2616 031475 2617 031500 2618 031504 2619 031533 2621 031554 2622 031560 2623 031563 2624 031567 2625 031613 2627 031625 2628 031630 2629 031632 2630 031633 2631 031637 2632 031650 2633 031654 2634 031671 2635 031674 2636 031677 2637 031705 2638 031712 2639 031715 2640 031720 2641 031722 2643 031737 2644 031756 2646 031762 2647 031771 2648 031775 2649 031777 2650 032003 2651 032006 2652 032024 2653 032027 2654 032033 2657 032063 2658 032066 2659 032071 2661 032100 2663 032107 2666 032116 2667 032147 2672 032200 2674 032224 2675 032233 2676 032242 2679 032251 2680 032255 2681 032270 2683 032324 2684 032333 2687 032364 2688 032373 2690 032402 2691 032406 2693 032445 Subroutine mmtinv 2695 c 2696 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 2697 c 2698 c matrix inverse subroutine 2699 c 2700 cSTART gecos.Tue1023.62 2701 2702 subroutine mmtinv(a,nrarg,ncarg,label) 2703 dimension a(25,999),label(999) 2704 nr=nrarg 2705 nc=ncarg 2706 do 11 j1=1,nr 2707 11 label(j1)=j1 2708 do 21 j1=1,nr 2709 temp=0.0 2710 do 13 j2=j1,nr 2711 if(abs(a(j2,j1))-temp) 13,12,12 2712 12 temp=abs(a(j2,j1)) 2713 ibig=j2 2714 13 continue 2715 if(ibig-j1) 27,16,14 2716 14 do 15 j2=1,nc 2717 temp=a(j1,j2) 2718 a(j1,j2)=a(ibig,j2) 2719 15 a(ibig,j2)=temp 2720 i=label(j1) 2721 label(j1)=label(ibig) 2722 label(ibig)=i 2723 16 temp=a(j1,j1) 2724 a(j1,j1)=1.0 2725 do 17 j2=1,nc 2726 17 a(j1,j2)=a(j1,j2)/temp 2727 do 20 j2=1,nr 2728 if(j2-j1) 18,20,18 2729 18 temp=a(j2,j1) 2730 a(j2,j1)=0.0 2731 do 19 j3=1,nc 2732 19 a(j2,j3)=a(j2,j3)-temp*a(j1,j3) 2733 20 continue 2734 21 continue 2735 n1=nr-1 2736 do 26 j1=1,n1 2737 do 23 j2=j1,nr 2738 if(label(j2)-j1) 23,22,23 2739 22 if(j2-j1) 27,26,24 2740 23 continue 2741 24 do 25 j3=1,nr 2742 temp=a(j3,j1) 2743 a(j3,j1)=a(j3,j2) 2744 25 a(j3,j2)=temp 2745 label(j2)=label(j1) 2746 26 continue 2747 27 return 2748 end Subroutine mmtinv NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a parameter position 1 real array(25,999) ref 2702 2703 2711 2712 2717 2718 2718 2719 2723 2724 2726 2726 2729 2730 2732 2732 2732 2742 2743 2743 2744 abs builtin ref 2711 2712 i 015330 automatic integer ref 2720 2722 ibig 015327 automatic integer ref 2713 2715 2718 2719 2721 2722 j1 015324 automatic integer ref 2706 2707 2707 2708 2710 2711 2712 2715 2717 2718 2720 2721 2723 2723 2724 2724 2726 2726 2728 2729 2730 2732 2736 2737 2738 2739 2742 2743 2745 j2 015326 automatic integer ref 2710 2711 2712 2713 2716 2717 2718 2718 2719 2725 2726 2726 2727 2728 2729 2730 2732 2732 2737 2738 2739 2743 2744 2745 j3 015331 automatic integer ref 2731 2732 2732 2732 2741 2742 2743 2743 2744 label parameter position 4 integer array(999) ref 2702 2703 2707 2720 2721 2721 2722 2738 2745 2745 mmtinv entry point 032447 constant on line 2702 n1 015332 automatic integer ref 2735 2736 nc 015323 automatic integer ref 2705 2716 2725 2731 ncarg parameter position 3 integer ref 2702 2705 nr 015322 automatic integer ref 2704 2704 2706 2708 2710 2727 2735 2737 2741 nrarg parameter position 2 integer ref 2702 2704 temp 015325 automatic real ref 2709 2711 2712 2717 2719 2723 2726 2729 2732 2742 2744 LOC LABEL TYPE LINE REFERENCES 032477 11 executable 2707 ref 2706 032531 12 executable 2712 used in transfer ref 2711 2711 032543 13 executable 2714 used in transfer ref 2710 2711 032554 14 executable 2716 used in transfer ref 2715 032577 15 executable 2719 ref 2716 032622 16 executable 2723 used in transfer ref 2715 032642 17 executable 2726 ref 2725 032671 18 executable 2729 used in transfer ref 2728 2728 032711 19 executable 2732 ref 2731 032736 20 executable 2733 used in transfer ref 2727 2728 032742 21 executable 2734 ref 2708 032767 22 executable 2739 used in transfer ref 2738 032774 23 executable 2740 used in transfer ref 2737 2738 2738 033000 24 executable 2741 used in transfer ref 2739 033023 25 executable 2744 ref 2741 033042 26 executable 2746 used in transfer ref 2736 2739 033046 27 executable 2747 used in transfer ref 2715 2739 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2702 032446 2704 032467 2705 032471 2706 032473 2707 032477 2708 032505 2709 032511 2710 032513 2711 032517 2712 032531 2713 032541 2714 032543 2715 032547 2716 032554 2717 032560 2718 032566 2719 032577 2720 032611 2721 032615 2722 032620 2723 032622 2724 032630 2725 032636 2726 032642 2727 032661 2728 032665 2729 032671 2730 032677 2731 032705 2732 032711 2733 032736 2734 032742 2735 032746 2736 032751 2737 032755 2738 032761 2739 032767 2740 032774 2741 033000 2742 033004 2743 033012 2744 033023 2745 033035 2746 033042 2747 033046 Subroutine orpol1 2749 subroutine orpol1 2750 c orpol Modified Feb 1975 2751 c ********** orpol .. contains *orpol1* and *orpol2* ************ 2752 c *****main program segment orpol1 2753 common y(100),x(100),rho(100),poly(35),alpha(30), 2754 & beta(30),coef(30),p0(100),p1(100),p2(100), 2755 &c(30),ll(30) 2756 character fname*16 2757 character yes*4,iy*4 2758 integer istat,orpol 2759 double precision stat 2760 equivalence (istat,stat) 2761 external com_err_ (descriptors), attach (descriptors), detach 2762 orpol=10 2763 yes="yes" 2764 print 2999 2765 2999 format(///" ORTHOGONAL POLYNOMIAL CURVE-FITTING") 2766 3000 format(//" Number of points, max degree?") 2767 3010 format(//" Is data to be read from a file? (Type 'yes','no' or 2768 & 'stop')") 2769 3001 format(" Type in dependent data?") 2770 3002 format(" Type in independent data?") 2771 3003 format(" Type in weights?") 2772 3004 format(" Dependent Data Mean =",1pe14.6) 2773 3005 format(//" DEGREE",9x,"ALPHA",9x,"BETA",9x,"COEFF", 2774 & 11x,"SSR") 2775 3007 format(v) 2776 3008 format(i4,5x,4(1pe14.6)) 2777 1 print 3010 2778 read 3007,iy 2779 if(iy.eq."stop")stop 2780 if(iy.eq.yes)go to 150 2781 3 print 3000 2782 read 3007,n,max 2783 mp1=max+1 2784 print 3001 2785 read 3007,(y(i),i=1,n) 2786 print 3002 2787 read 3007,(x(i),i=1,n) 2788 print 3003 2789 read 3007,(rho(i),i=1,n) 2790 4 fn=0. 2791 ta=0. 2792 ba=0. 2793 ysum=0. 2794 do 5 i=1,n 2795 fn=fn+rho(i) 2796 5 ysum=ysum+y(i)*rho(i) 2797 ymean=ysum/fn 2798 do 10 i=1,n 2799 ta=ta+rho(i)*x(i) 2800 10 ba=ba+rho(i) 2801 alpha(1)=ta/ba 2802 beta(1)=0. 2803 k=1 2804 ss=0. 2805 xpy=0. 2806 do 20 i=1,n 2807 p0(i)=1. 2808 p1(i)=p0(i)*x(i)-alpha(1)*p0(i) 2809 ss=ss+p1(i)*p1(i)*rho(i) 2810 y(i)=y(i)-ymean 2811 20 xpy=xpy+p1(i)*y(i)*rho(i) 2812 coef(1)=xpy/ss 2813 ssr=coef(1)*xpy 2814 print 3004,ymean 2815 print 3005 2816 print 3008,k,alpha(1),beta(1),coef(1),ssr 2817 if(max-1)25,61,25 2818 25 do 60 k=2,max 2819 bb=ba 2820 ba=0. 2821 ta=0. 2822 tb=0. 2823 do 30 i=1,n 2824 ta=ta+rho(i)*p1(i)*p1(i)*x(i) 2825 ba=ba+rho(i)*p1(i)*p1(i) 2826 30 tb=tb+rho(i)*x(i)*p1(i)*p0(i) 2827 alpha(k)=ta/ba 2828 beta(k)=tb/bb 2829 ss=0. 2830 xpy=0. 2831 do 40 i=1,n 2832 p2(i)=x(i)*p1(i)-alpha(k)*p1(i)-beta(k)*p0(i) 2833 ss=ss+p2(i)*p2(i)*rho(i) 2834 40 xpy=xpy+p2(i)*y(i)*rho(i) 2835 coef(k)=xpy/ss 2836 ssr=coef(k)*xpy 2837 print 3008,k,alpha(k),beta(k),coef(k),ssr 2838 do 50 j=1,n 2839 p0(j)=p1(j) 2840 50 p1(j)=p2(j) 2841 60 continue 2842 61 continue 2843 call orpol2(max,mp1,yes,ymean) 2844 go to 1 2845 150 call attach (istat) 2846 if (istat) 3535,4545,3535 2847 3535 call com_err_(istat,"orpol","error in attaching") 2848 stop 2849 4545 continue 2850 read(orpol,3007)n,max 2851 read(orpol,3007)(y(i),i=1,n) 2852 read(orpol,3007)(x(i),i=1,n) 2853 read(orpol,3007)(rho(i),i=1,n) 2854 call detach 2855 mp1=max+1 2856 go to 4 2857 end Subroutine orpol1 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alpha 000517 // real array(30) ref 2753 2801 2808 2816 2827 2832 2837 attach external subroutine 010042 constant with descriptors ref 2761 2845 ba 015347 automatic real ref 2792 2800 2800 2801 2819 2820 2825 2825 2827 bb 015356 automatic real ref 2819 2828 beta 000555 // real array(30) ref 2753 2802 2816 2828 2832 2837 blnk*com common block name 785 words ref 2753 coef 000613 // real array(30) ref 2753 2812 2813 2816 2835 2836 2837 com_err_ external subroutine 010040 constant with descriptors ref 2761 2847 detach external subroutine 010044 constant ref 2761 2854 fn 015345 automatic real ref 2790 2795 2795 2797 i 015344 automatic integer ref 2785 2785 2787 2787 2789 2789 2794 2795 2796 2796 2798 2799 2799 2800 2806 2807 2808 2808 2808 2808 2809 2809 2809 2810 2810 2811 2811 2811 2823 2824 2824 2824 2824 2825 2825 2825 2826 2826 2826 2826 2831 2832 2832 2832 2832 2832 2833 2833 2833 2834 2834 2834 2851 2851 2852 2852 2853 2853 istat 015334 automatic integer equivalenced ref 2758 2760 2845 2846 2847 iy 015337 automatic character(4) ref 2757 2778 2779 2780 j 015360 automatic integer ref 2838 2839 2839 2840 2840 k 015352 automatic integer ref 2803 2816 2818 2827 2828 2832 2832 2835 2836 2837 2837 2837 2837 max 015342 automatic integer ref 2782 2783 2817 2818 2843 2850 2855 mp1 015343 automatic integer ref 2783 2843 2855 n 015341 automatic integer ref 2782 2785 2787 2789 2794 2798 2806 2823 2831 2838 2850 2851 2852 2853 orpol 015340 automatic integer ref 2758 2762 2762 2850 2851 2852 2853 orpol1 entry point 033050 constant on line 2749 orpol2 internal subroutine constant ref 2843 p0 000651 // real array(100) ref 2753 2807 2808 2808 2826 2832 2839 p1 001015 // real array(100) ref 2753 2808 2809 2809 2811 2824 2824 2825 2825 2826 2832 2832 2839 2840 p2 001161 // real array(100) ref 2753 2832 2833 2833 2834 2840 rho 000310 // real array(100) ref 2753 2789 2795 2796 2799 2800 2809 2811 2824 2825 2826 2833 2834 2853 ss 015353 automatic real ref 2804 2809 2809 2812 2829 2833 2833 2835 ssr 015355 automatic real ref 2813 2816 2836 2837 ta 015346 automatic real ref 2791 2799 2799 2801 2821 2824 2824 2827 tb 015357 automatic real ref 2822 2826 2826 2828 x 000144 // real array(100) ref 2753 2787 2799 2808 2824 2826 2832 2852 xpy 015354 automatic real ref 2805 2811 2811 2812 2813 2830 2834 2834 2835 2836 y 000000 // real array(100) ref 2753 2785 2796 2810 2810 2811 2834 2851 yes 015336 automatic character(4) ref 2757 2763 2780 2843 ymean 015351 automatic real ref 2797 2810 2814 2843 ysum 015350 automatic real ref 2793 2796 2796 2797 NAMES DECLARED BUT NOT USED c 001325 // real array(30) declared 2753 fname character(16) declared 2756 ll 001363 // integer array(30) declared 2753 poly 000454 // real array(35) declared 2753 stat 015334 automatic double precision equivalenced declared 2759 2760 LOC LABEL TYPE LINE REFERENCES 033104 1 executable 2777 used in transfer ref 2844 033145 3 executable 2781 033313 4 executable 2790 used in transfer ref 2856 033331 5 executable 2796 ref 2794 033356 10 executable 2800 ref 2798 033427 20 executable 2811 ref 2806 033546 25 executable 2818 used in transfer ref 2817 2817 033601 30 executable 2826 ref 2823 033656 40 executable 2834 ref 2831 033753 50 executable 2840 ref 2838 033761 60 executable 2841 ref 2818 033765 61 executable 2842 used in transfer ref 2817 033771 150 executable 2845 used in transfer ref 2780 2999 format 2765 ref 2764 3000 format ref 2766 2781 3001 format ref 2769 2784 3002 format ref 2770 2786 3003 format ref 2771 2788 3004 format ref 2772 2814 3005 format ref 2773 2815 3007 format ref 2775 2778 2782 2785 2787 2789 2850 2851 2852 2853 3008 format ref 2776 2816 2837 3010 format ref 2767 2777 034006 3535 executable 2847 used in transfer ref 2846 2846 034032 4545 executable 2849 used in transfer ref 2846 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2749 033047 2762 033070 2763 033072 2764 033075 2777 033104 2778 033113 2779 033132 2780 033140 2781 033145 2782 033154 2783 033200 2784 033203 2785 033212 2786 033233 2787 033242 2788 033263 2789 033272 2790 033313 2791 033315 2792 033316 2793 033317 2794 033320 2795 033324 2796 033331 2797 033341 2798 033344 2799 033350 2800 033356 2801 033365 2802 033370 2803 033372 2804 033374 2805 033376 2806 033377 2807 033403 2808 033407 2809 033417 2810 033424 2811 033427 2812 033440 2813 033443 2814 033446 2815 033465 2816 033474 2817 033542 2818 033546 2819 033552 2820 033554 2821 033556 2822 033557 2823 033560 2824 033564 2825 033574 2826 033601 2827 033613 2828 033617 2829 033622 2830 033624 2831 033625 2832 033631 2833 033651 2834 033656 2835 033667 2836 033672 2837 033675 2838 033743 2839 033747 2840 033753 2841 033761 2842 033765 2843 033765 2844 033770 2845 033771 2846 034003 2847 034006 2848 034030 2849 034032 2850 034032 2851 034056 2852 034077 2853 034120 2854 034141 2855 034147 2856 034152 Subroutine orpol2 2858 c *****orpol2 segment****** 2859 cSTART orpol2 2860 subroutine orpol2(max,mp1,yes,ymean) 2861 common y(100),x(100),rho(100),poly(35),alpha(30), 2862 & beta(30),coef(30),p0(100),p1(100),p2(100), 2863 &c(30),ll(30) 2864 character yes*4,iy*4 2865 1000 format(//" Number and polynomials?") 2866 1010 format (/" Number, input points?") 2867 1020 format(//7x,"INPUT",10x,"OR OUTPUT",6x,"REG OUTPUT") 2868 1030 format (//" Finished? (yes or no)") 2869 1040 format(//" Regular Polynomial in Decreasing Degree") 2870 1050 format(//" Number, set of values") 2871 1060 format(v) 2872 1 continue 2873 print 1000 2874 read 1060,m,(ll(i),i=1,m) 2875 do 20 i=1,max 2876 20 c(i)=0. 2877 do 25 i=1,m 2878 j=ll(i) 2879 25 c(j)=coef(j) 2880 do 30 i=1,mp1 2881 p0(i)=0. 2882 p1(i)=0. 2883 p2(i)=0. 2884 30 rho(i)=0. 2885 p0(i)=1. 2886 p1(i)=1. 2887 p1(2)=-alpha(1) 2888 k=2 2889 rho(1)=coef(1) 2890 rho(2)=-alpha(1)*coef(1) 2891 if (max-1)40,120,40 2892 40 continue 2893 kp1=k+1 2894 km1=k-1 2895 2896 50 do 60 i=1,k 2897 60 p2(i)=p1(i) 2898 do 70 i=1,k 2899 70 p2(i+1)=p2(i+1)-alpha(k)*p1(i) 2900 do 80 i=1,km1 2901 80 p2(i+2)=p2(i+2)-beta(k)*p0(i) 2902 lk =k+1 2903 do 85 i=1,k 2904 lk=lk-1 2905 85 rho(lk+1)=rho(lk) 2906 rho(1)=0. 2907 do 90 i=1,kp1 2908 90 rho(i)=rho(i)+p2(i)*c(k) 2909 if (max-k) 100,120,100 2910 100 do 105 i=1,k 2911 105 p0(i)=p1(i) 2912 do 106 i=1,kp1 2913 106 p1(i)=p2(i) 2914 do 107 i=1,max 2915 107 p2(i)=0. 2916 k=k+1 2917 go to 40 2918 120 print 1040 2919 rho(mp1)=rho(mp1)+ymean 2920 print 1090, (rho(i),i=1,mp1) 2921 1090 format((e16.8)) 2922 print 1050 2923 read 1060,mt,(x(i),i=1,mt) 2924 print 1020 2925 do 220 i=1,mt 2926 ans=rho(1) 2927 do 130 l=2,mp1 2928 130 ans=ans*x(i)+rho(l) 2929 poly(1)=1. 2930 poly(2)=x(i)-alpha(1) 2931 if(max-1) 180,195,180 2932 180 do 190 k1=3,mp1 2933 190 poly(k1)=x(i)*poly(k1-1)-alpha(k1-1)*poly(k1-1)-beta(k1-1)*poly(k1-2) 2934 195 pred=ymean 2935 do 200 i1=1,m 2936 j=ll(i1) 2937 200 pred=pred+coef(j)*poly(j+1) 2938 220 print 1022, x(i),pred,ans 2939 1022 format(e16.8,e16.8,e16.8) 2940 print 1030 2941 read 1060, iy 2942 if(iy.ne.yes) go to 1 2943 250 return 2944 end Subroutine orpol2 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alpha 000517 // real array(30) ref 2861 2887 2890 2899 2930 2933 ans 015373 automatic real ref 2926 2928 2928 2938 beta 000555 // real array(30) ref 2861 2901 2933 blnk*com common block name 785 words ref 2861 c 001325 // real array(30) ref 2861 2876 2879 2908 coef 000613 // real array(30) ref 2861 2879 2889 2890 2937 i 015364 automatic integer ref 2874 2874 2875 2876 2877 2878 2880 2881 2882 2883 2884 2885 2886 2896 2897 2897 2898 2899 2899 2899 2900 2901 2901 2901 2903 2907 2908 2908 2908 2910 2911 2911 2912 2913 2913 2914 2915 2920 2920 2923 2923 2925 2928 2930 2933 2938 i1 015377 automatic integer ref 2935 2936 iy 015362 automatic character(4) ref 2864 2941 2942 j 015365 automatic integer ref 2878 2879 2879 2936 2937 2937 k 015366 automatic integer ref 2888 2893 2894 2896 2898 2899 2901 2902 2903 2908 2909 2910 2916 2916 k1 015375 automatic integer ref 2932 2933 2933 2933 2933 2933 2933 km1 015370 automatic integer ref 2894 2900 kp1 015367 automatic integer ref 2893 2907 2912 l 015374 automatic integer ref 2927 2928 lk 015371 automatic integer ref 2902 2904 2904 2905 2905 ll 001363 // integer array(30) ref 2861 2874 2878 2936 m 015363 automatic integer ref 2874 2874 2877 2935 max parameter position 1 integer ref 2860 2875 2891 2909 2914 2931 mp1 parameter position 2 integer ref 2860 2880 2919 2919 2920 2927 2932 mt 015372 automatic integer ref 2923 2923 2925 orpol2 entry point 034154 constant on line 2860 p0 000651 // real array(100) ref 2861 2881 2885 2901 2911 p1 001015 // real array(100) ref 2861 2882 2886 2887 2897 2899 2911 2913 p2 001161 // real array(100) ref 2861 2883 2897 2899 2899 2901 2901 2908 2913 2915 poly 000454 // real array(35) ref 2861 2929 2930 2933 2933 2933 2933 2937 pred 015376 automatic real ref 2934 2937 2937 2938 rho 000310 // real array(100) ref 2861 2884 2889 2890 2905 2905 2906 2908 2908 2919 2919 2920 2926 2928 x 000144 // real array(100) ref 2861 2923 2928 2930 2933 2938 yes parameter position 3 character(4) ref 2860 2864 2942 ymean parameter position 4 real ref 2860 2919 2934 NAMES DECLARED BUT NOT USED y 000000 // real array(100) declared 2861 LOC LABEL TYPE LINE REFERENCES 034174 1 executable 2872 used in transfer ref 2942 034235 20 executable 2876 ref 2875 034255 25 executable 2879 ref 2877 034276 30 executable 2884 ref 2880 034325 40 executable 2892 used in transfer ref 2891 2891 2917 034333 50 executable 2896 034337 60 executable 2897 ref 2896 034353 70 executable 2899 ref 2898 034376 80 executable 2901 ref 2900 034426 85 executable 2905 ref 2903 034447 90 executable 2908 ref 2907 034466 100 executable 2910 used in transfer ref 2909 2909 034472 105 executable 2911 ref 2910 034506 106 executable 2913 ref 2912 034522 107 executable 2915 ref 2914 034534 120 executable 2918 used in transfer ref 2891 2909 034650 130 executable 2928 ref 2927 034674 180 executable 2932 used in transfer ref 2931 2931 034700 190 executable 2933 ref 2932 034734 195 executable 2934 used in transfer ref 2931 034746 200 executable 2937 ref 2935 034760 220 executable 2938 ref 2925 035053 250 executable 2943 1000 format ref 2865 2873 1010 format ref 2866 1020 format ref 2867 2924 1022 format 2939 ref 2938 1030 format ref 2868 2940 1040 format ref 2869 2918 1050 format ref 2870 2922 1060 format ref 2871 2874 2923 2941 1090 format 2921 ref 2920 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2860 034153 2872 034174 2873 034174 2874 034203 2875 034231 2876 034235 2877 034245 2878 034251 2879 034255 2880 034264 2881 034270 2882 034274 2883 034275 2884 034276 2885 034303 2886 034305 2887 034306 2888 034311 2889 034313 2890 034315 2891 034321 2892 034325 2893 034325 2894 034330 2896 034333 2897 034337 2898 034347 2899 034353 2900 034372 2901 034376 2902 034415 2903 034420 2904 034424 2905 034426 2906 034441 2907 034443 2908 034447 2909 034462 2910 034466 2911 034472 2912 034502 2913 034506 2914 034516 2915 034522 2916 034532 2917 034533 2918 034534 2919 034543 2920 034550 2922 034571 2923 034600 2924 034626 2925 034635 2926 034641 2927 034644 2928 034650 2929 034663 2930 034665 2931 034670 2932 034674 2933 034700 2934 034734 2935 034736 2936 034742 2937 034746 2938 034760 2940 035017 2941 035026 2942 035045 2943 035053 Subroutine shortest 2945 subroutine shortest 2946 c Shortest -- modified Feb 1975 2947 common a(25,25),d(25,25),nicid(25,25) 2948 dimension icon(25) 2949 character fname*16 2950 integer istat 2951 double precision stat 2952 equivalence (istat,stat) 2953 external com_err_ (descriptors), attach (descriptors), detach 2954 print 5 2955 5 format(//,20x,"S H O R T E S T"/) 2956 iin=10 2957 print,"1=TRACE ITER., 0=ANSWERS ONLY, -1=MIN SPAN TREE ONLY" 2958 read,iout 2959 call attach (istat) 2960 if (istat) 3535,4545,3535 2961 3535 call com_err_(istat,"shortest","error in attach") 2962 stop 2963 4545 read(iin,3)icon 2964 3 format(25a2) 2965 print 4,icon 2966 4 format(//,2x,25a2/) 2967 do 1 i=1,25 2968 do 1 j=1,25 2969 nicid(i,j)=0 2970 1 d(i,j)=0.0 2971 nn=0 2972 100 read(iin,2,end=1000)i,j,a1 2973 2 format(v) 2974 nicid(i,j)=1 2975 d(i,j)=a1 2976 if(j.gt.nn)nn=j 2977 go to 100 2978 1000 if(-1.eq.iout)go to 1060 2979 do 101 i=1,25 2980 101 a(1,i)=0.0 2981 do 102 i=2,nn 2982 if(nicid(1,i).ne.0) go to 1012 2983 a(i,1)=9999.0 2984 go to 102 2985 1012 a(i,1)=d(1,i) 2986 102 continue 2987 k=1 2988 if(iout.eq.1)call soutput(1,nn,3,k) 2989 103 k=k+1 2990 ifin=1 2991 do 105 i=2,nn 2992 xlst=a(i,k-1) 2993 valu=9999.0 2994 do 104 j=1,nn 2995 kk=nicid(i,j) 2996 if(i.gt.j)kk=nicid(j,i) 2997 if(kk.eq.0) go to 104 2998 r=d(j,i) 2999 if(j.gt.i) r=d(i,j) 3000 hold=a(j,k-1)+r 3001 if(hold.ge.valu) go to 104 3002 valu=hold 3003 104 continue 3004 a(i,k)=valu 3005 if(valu-xlst) 106,105,106 3006 106 ifin = 0 3007 105 continue 3008 if(iout.eq.1)call soutput(1,nn,3,k) 3009 if(ifin)1051,103,1051 3010 1051 call soutput(2,nn,3,k) 3011 c minimal spanning tree algorithm 3012 3013 1060 m=1 3014 icon(1)=1 3015 1071 hold=999999.0 3016 do 108 i=1,m 3017 k=icon(i) 3018 do 108 j=1,nn 3019 do 1072 l=1,m 3020 if(j.eq.icon(l)) go to 108 3021 1072 continue 3022 if(k-j)1073,108,1074 3023 1073 if(nicid(k,j).eq.0) go to 108 3024 if(d(k,j).gt.hold) go to 108 3025 hold=d(k,j) 3026 go to 1075 3027 1074 if(nicid(j,k).eq.0) go to 108 3028 if(d(j,k).gt.hold) go to 108 3029 hold=d(j,k) 3030 1075 io=k 3031 jo=j 3032 108 continue 3033 m=m+1 3034 if(m.gt.nn) go to 1081 3035 if(io.gt.jo) go to 1082 3036 nicid(io,jo)=2 3037 1082 nicid(jo,io)=2 3038 icon(m)=jo 3039 go to 1071 3040 1081 call soutput(0,nn,4,0) 3041 call detach 3042 stop 3043 end Subroutine shortest NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000000 // real array(25,25) ref 2947 2980 2983 2985 2992 3000 3004 a1 015440 automatic real ref 2972 2975 attach external subroutine 010042 constant with descriptors ref 2953 2959 blnk*com common block name 1875 words ref 2947 com_err_ external subroutine 010040 constant with descriptors ref 2953 2961 d 001161 // real array(25,25) ref 2947 2970 2975 2985 2998 2999 3024 3025 3028 3029 detach external subroutine 010044 constant ref 2953 3041 hold 015447 automatic real ref 3000 3001 3002 3015 3024 3025 3028 3029 i 015435 automatic integer ref 2967 2969 2970 2972 2974 2975 2979 2980 2981 2982 2983 2985 2985 2991 2992 2995 2996 2996 2998 2999 2999 3004 3016 3017 icon 015402 automatic integer array(25) ref 2948 2963 2965 3014 3017 3020 3038 ifin 015442 automatic integer ref 2990 3006 3009 iin 015433 automatic integer ref 2956 2963 2972 io 015452 automatic integer ref 3030 3035 3036 3037 iout 015434 automatic integer ref 2958 2978 2988 3008 istat 015400 automatic integer equivalenced ref 2950 2952 2959 2960 2961 j 015436 automatic integer ref 2968 2969 2970 2972 2974 2975 2976 2976 2994 2995 2996 2996 2998 2999 2999 3000 3018 3020 3022 3023 3024 3025 3027 3028 3029 3031 jo 015453 automatic integer ref 3031 3035 3036 3037 3038 k 015441 automatic integer ref 2987 2988 2989 2989 2992 3000 3004 3008 3010 3017 3022 3023 3024 3025 3027 3028 3029 3030 kk 015445 automatic integer ref 2995 2996 2997 l 015451 automatic integer ref 3019 3020 m 015450 automatic integer ref 3013 3016 3019 3033 3033 3034 3038 nicid 002342 // integer array(25,25) ref 2947 2969 2974 2982 2995 2996 3023 3027 3036 3037 nn 015437 automatic integer ref 2971 2976 2976 2981 2988 2991 2994 3008 3010 3018 3034 3040 r 015446 automatic real ref 2998 2999 3000 shortest entry point 035055 constant on line 2945 soutput internal subroutine constant ref 2988 3008 3010 3040 valu 015444 automatic real ref 2993 3001 3002 3004 3005 xlst 015443 automatic real ref 2992 3005 NAMES DECLARED BUT NOT USED fname character(16) declared 2949 stat 015400 automatic double precision equivalenced declared 2951 2952 LOC LABEL TYPE LINE REFERENCES 035254 1 executable 2970 ref 2967 2968 2 format 2973 ref 2972 3 format 2964 ref 2963 4 format 2966 ref 2965 5 format 2955 ref 2954 035273 100 executable 2972 used in transfer ref 2977 035361 101 executable 2980 ref 2979 035422 102 executable 2986 used in transfer ref 2981 2984 035435 103 executable 2989 used in transfer ref 3009 035537 104 executable 3003 used in transfer ref 2994 2997 3001 035556 105 executable 3007 used in transfer ref 2991 3005 035555 106 executable 3006 used in transfer ref 3005 3005 035723 108 executable 3032 used in transfer ref 3016 3018 3020 3022 3023 3024 3027 3028 035351 1000 executable 2978 used in transfer ref 2972 035414 1012 executable 2985 used in transfer ref 2982 035573 1051 executable 3010 used in transfer ref 3009 3009 035576 1060 executable 3013 used in transfer ref 2978 035601 1071 executable 3015 used in transfer ref 3039 035627 1072 executable 3021 ref 3019 035640 1073 executable 3023 used in transfer ref 3022 035670 1074 executable 3027 used in transfer ref 3022 035717 1075 executable 3030 used in transfer ref 3026 035766 1081 executable 3040 used in transfer ref 3034 035753 1082 executable 3037 used in transfer ref 3035 035155 3535 executable 2961 used in transfer ref 2960 2960 035201 4545 executable 2963 used in transfer ref 2960 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2945 035054 2954 035075 2956 035104 2957 035106 2958 035123 2959 035140 2960 035152 2961 035155 2962 035177 2963 035201 2965 035221 2967 035241 2968 035243 2969 035245 2970 035254 2971 035272 2972 035273 2974 035326 2975 035335 2976 035343 2977 035350 2978 035351 2979 035357 2980 035361 2981 035373 2982 035377 2983 035407 2984 035413 2985 035414 2986 035422 2987 035426 2988 035430 2989 035435 2990 035436 2991 035440 2992 035444 2993 035453 2994 035455 2995 035461 2996 035467 2997 035477 2998 035503 2999 035511 3000 035521 3001 035532 3002 035535 3003 035537 3004 035543 3005 035552 3006 035555 3007 035556 3008 035562 3009 035570 3010 035573 3013 035576 3014 035600 3015 035601 3016 035603 3017 035607 3018 035612 3019 035616 3020 035622 3021 035627 3022 035633 3023 035640 3024 035651 3025 035661 3026 035667 3027 035670 3028 035701 3029 035711 3030 035717 3031 035721 3032 035723 3033 035733 3034 035734 3035 035740 3036 035744 3037 035753 3038 035762 3039 035765 3040 035766 3041 035771 3042 035777 Subroutine soutput 3044 cSTART soutput 3045 c Modified Feb 1975 3046 subroutine soutput(k,nn,iwhr,kk) 3047 common a(25,25),d(25,25),nicid(25,25) 3048 if(iwhr .eq.4)goto 300 3049 c soutput routine for shortest path algorithm 3050 go to (1041,1040),k 3051 1040 print 42,kk 3052 go to 1042 3053 1041 print 41,kk 3054 1042 print 34 3055 j=1 3056 do 1043 i=2,nn 3057 1043 print 7,j,i,a(i,kk) 3058 7 format(/3x,i10,3x,i10,f10.2,3x,f10.2) 3059 go to(1045,1044),k 3060 1044 print 43 3061 43 format(/4x,"THE SHORTEST PATHS FROM ARC ONE ARE:") 3062 print 44 3063 44 format(/3x,13hSTARTING NODE,2x,11hENDING NODE,2x,10hARC LENGTH) 3064 do 108 i=1,nn 3065 do 107 j=1,nn 3066 kx=nicid(i,j) 3067 if(i.gt.j)kx=nicid(j,i) 3068 if(kx.eq.0)go to 107 3069 r=d(j,i) 3070 if(j.gt.i) r=d(i,j) 3071 if(abs(a(i,kk)-a(j,kk))-r) 107,105,107 3072 105 if(i.lt.j)print 7,i,j,d(i,j) 3073 107 continue 3074 108 continue 3075 1045 return 3076 34 format(/3x,13hSTARTING NODE,2x,11hENDING NODE,2x,8hDISTANCE) 3077 41 format(/3x,32h STATUS OF NETWORK AT ITERATION ,i2) 3078 42 format (/"SHORTEST DISTANCE NODE 1 TO ALL OTHERS, ITERATION ",i2) 3079 431 format(/"THE MINIMAL SPANNING TREE CONSISTS OF THE FOLLOWING ARCS:") 3080 300 print 431;print 34 3081 do 302 i=1,nn 3082 do 302 j=1,nn 3083 if(i.le.j.and.nicid(i,j).eq.2)print 7,i,j,d(i,j) 3084 302 continue 3085 return 3086 end Subroutine soutput NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES a 000000 // real array(25,25) ref 3047 3057 3071 3071 abs builtin ref 3071 blnk*com common block name 1875 words ref 3047 d 001161 // real array(25,25) ref 3047 3069 3070 3072 3083 i 015455 automatic integer ref 3056 3057 3057 3064 3066 3067 3067 3069 3070 3070 3071 3072 3072 3072 3081 3083 3083 3083 3083 iwhr parameter position 3 integer ref 3046 3048 j 015454 automatic integer ref 3055 3057 3065 3066 3067 3067 3069 3070 3070 3071 3072 3072 3072 3082 3083 3083 3083 3083 k parameter position 1 integer ref 3046 3050 3059 kk parameter position 4 integer ref 3046 3051 3053 3057 3071 3071 kx 015456 automatic integer ref 3066 3067 3068 nicid 002342 // integer array(25,25) ref 3047 3066 3067 3083 nn parameter position 2 integer ref 3046 3056 3064 3065 3081 3082 r 015457 automatic real ref 3069 3070 3071 soutput entry point 036002 constant on line 3046 LOC LABEL TYPE LINE REFERENCES 7 format 3058 ref 3057 3072 3083 34 format 3076 ref 3054 3080 41 format 3077 ref 3053 42 format 3078 ref 3051 43 format 3061 ref 3060 44 format 3063 ref 3062 036272 105 executable 3072 used in transfer ref 3071 036333 107 executable 3073 used in transfer ref 3065 3068 3071 3071 036337 108 executable 3074 ref 3064 036344 300 executable 3080 used in transfer ref 3048 036446 302 executable 3084 ref 3081 3082 431 format ref 3079 3080 036036 1040 executable 3051 used in transfer ref 3050 036056 1041 executable 3053 used in transfer ref 3050 036075 1042 executable 3054 used in transfer ref 3052 036112 1043 executable 3057 ref 3056 036164 1044 executable 3060 used in transfer ref 3059 036343 1045 executable 3075 used in transfer ref 3059 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3046 036001 3048 036022 3050 036026 3051 036036 3052 036055 3053 036056 3054 036075 3055 036104 3056 036106 3057 036112 3059 036154 3060 036164 3062 036173 3064 036202 3065 036206 3066 036212 3067 036220 3068 036230 3069 036234 3070 036242 3071 036252 3072 036272 3073 036333 3074 036337 3075 036343 3080 036344 3080 036353 3081 036362 3082 036366 3083 036372 3084 036446 3085 036456 Subroutine smlrp 3087 subroutine smlrp 3088 c smlrp - stepwise multiple linear regression Feb 1975 3089 cSTART gecos.Fri1636.11 3090 common c(20,20),avg(20),sos(20) 3091 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3092 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3093 common kr,fe,fc,fr,dof,cl,see 3094 common fname 3095 external com_err_(descriptors), detach, smlrpattach (descriptors) 3096 character fname*16 3097 character vlab*4,kx*4,nam*4,nal1*4,nal2*4,temp*4 3098 character kod*3(20) 3099 double precision stat 3100 dimension ktr(80),iv1(80),iv2(80),iv3(80),temp(20) 3101 real na3 3102 integer ph,vi(29),yes,no,pi,sct,dof,four 3103 integer istat 3104 equivalence(istat,stat) 3105 data bad,yes,no,sct,lbk/-1e12,89,78,65536," ["/ 3106 3107 data kod/"ADD","SUB","MPY","DVD","RCP","MOV","EXP","TEN","LGN","LOG","SIN","COS","TNH","SQR","CON","END",4*"0"/ 3108 lrdata=10; four=11 3109 c initialize 3110 3939 continue 3111 print 120 3112 120 format(/10x" STEPWISE MULTIPLE LINEAR REGRESSION PROGRAM") 3113 print 1 3114 1 format (//) 3115 ks4=1 3116 ks6=1 3117 10 ks1=1 3118 ks2=1 3119 ks3=1 3120 ks5=1 3121 kr=0 3122 rewind four 3123 nal2=" " 3124 c 3125 c read data file name 3126 c 3127 fname = " " 3128 call smlrpattach(istat, fname) 3129 if (istat) 4545,3535,4545 3130 4545 call com_err_(istat,"smlrp","error attaching file") 3131 c 3132 c read no. of initial variables 3133 c 3134 3535 read(lrdata,21)nv 3135 21 format (v) 3136 nr=nv 3137 print 901, nr 3138 if(nr.gt.20)go to 800 3139 na3=0 3140 nt=0 3141 c 3142 c test for transformation code 3143 c 3144 idum=0 3145 227 read(lrdata,21) nam,kdum 3146 idum=idum+1 3147 if(nam.eq."LABL" .or. nam.eq."LABE")go to 38 3148 if(nam.eq."TRNF" .or. nam.eq."TRAN")go to 229 3149 go to 46 3150 229 nr=kdum 3151 print 905, nr 3152 if ((nr .lt. 2) .or. (nr .gt. 20)) go to 815 3153 ks5=2 3154 ker=0 3155 c 3156 c read and process transformation codes 3157 c 3158 do 34 l=1,81 3159 20 na1=0 3160 na2=0 3161 na3=0 3162 na4=0 3163 read (lrdata,21) nal1,na2,na3,na4 3164 idum=idum+1 3165 do 25 i=1,16 3166 if (nal1 .eq. kod(i)) go to 30 3167 25 continue 3168 27 ker=1 3169 print 907, nal1,na2,na3,na4 3170 3171 go to 20 3172 30 if (nal1 .eq. "END") go to 36 3173 if (nal1 .ne. "CON") go to 32 3174 obs(na2)=na3 3175 go to 20 3176 32 nt=nt+1 3177 ktr(nt)=i 3178 if ((na2 .lt. 1) .or. (na2 .gt. 30)) go to 27 3179 iv1(nt)=na2 3180 if ((na3 .lt. 1) .or. (na3 .gt. 30)) go to 27 3181 iv2(nt)=na3 3182 if ((i .lt. 5) .and. ((na4 .lt. 1) .or. (na4 .gt. 30))) 3183 & go to 27 3184 iv3(nt)=na4 3185 34 continue 3186 print 2 3187 2 format (39h *** no "end" following transformations) 3188 go to 540 3189 36 if (ker .gt. 0) go to 540 3190 nal2=" " 3191 go to 227 3192 c 3193 c test for variable labels 3194 c 3195 38 itv=kdum 3196 do 40 i=1,nr 3197 vlab(i)=" " 3198 40 continue 3199 c 3200 c read and store labels 3201 c 3202 42 ks7=3 3203 3204 k=itv+1 3205 read (lrdata,21) (temp(i), i=1,k) 3206 idum=idum+1 3207 do 44 i=1,k 3208 if (temp(i) .eq. "ELAB") go to 46 3209 vlab(i)=temp(i) 3210 44 continue 3211 print 3 3212 3 format (33h *** no "endlbl" following labels) 3213 go to 540 3214 c 3215 c initialize arrays 3216 c 3217 46 do 48 i=1,nr 3218 avg(i)=0.0 3219 vl(i)=1.0e35 3220 vh(i)=-1.0e35 3221 48 continue 3222 ker=0 3223 c 3224 c read raw observed data 3225 c 3226 do 145 k=1,999 3227 do 50 i=1,nr 3228 50 obs(i)=1e12 3229 read (lrdata,21,end=150) (obs(i), i=1,nv) 3230 go to (100,55), ks5 3231 c 3232 c transform raw data 3233 c 3234 55 do 90 j=1,nt 3235 l=ktr(j) 3236 na1=iv1(j) 3237 na2=iv2(j) 3238 na3=iv3(j) 3239 go to (61,62,63,64,65,66,67,68,69,70,71,72,73,74),l 3240 61 obs(na3)=obs(na1)+obs(na2) 3241 go to 90 3242 62 obs(na3)=obs(na1)-obs(na2) 3243 go to 90 3244 63 obs(na3)=obs(na1)*obs(na2) 3245 go to 90 3246 64 obs(na3)=obs(na1)/obs(na2) 3247 go to 90 3248 65 obs(na2)=1.0/obs(na1) 3249 go to 90 3250 66 obs(na2)=obs(na1) 3251 go to 90 3252 67 obs(na2)=exp(obs(na1)) 3253 go to 90 3254 68 obs(na2)=10.**(obs(na1)) 3255 go to 90 3256 69 obs(na2)=alog(obs(na1)) 3257 go to 90 3258 70 obs(na2)=0.4343*alog(obs(na1)) 3259 go to 90 3260 71 obs(na2)=sin(obs(na1)) 3261 go to 90 3262 72 obs(na2)=cos(obs(na1)) 3263 go to 90 3264 73 obs(na2)=tanh(obs(na1)) 3265 go to 90 3266 74 obs(na2)=sqrt(obs(na1)) 3267 90 continue 3268 100 write (four,21) (obs(i), i=1,nr) 3269 c 3270 c accumulate variable sums 3271 c 3272 do 145 i=1,nr 3273 x=obs(i) 3274 if(x-1e12) 140,139,140 3275 139 ker=1 3276 print 903, i, k 3277 go to 145 3278 140 avg(i)=avg(i)+x 3279 if (x .lt. vl(i)) vl(i)=x 3280 if (x .gt. vh(i)) vh(i)=x 3281 145 continue 3282 150 nob=k-1 3283 print 902, nob 3284 if (ker .gt. 0) go to 540 3285 c 3286 c read means print switch 3287 c 3288 nal1="no" 3289 print 4 3290 4 format (/" MEANS?") 3291 read 1001, nal1 3292 if ((nal1 .eq. "no") .or. (nal1 .eq. "NO")) ks1=2 3293 c 3294 c compute averages 3295 c 3296 x=nob 3297 do 155 i=1,nr 3298 155 avg(i)=avg(i)/x 3299 160 rewind four 3300 do 165 j=1,nr 3301 do 165 i=1,nr 3302 165 c(i,j)=0.0 3303 c 3304 c compute covariance matrix 3305 c 3306 do 170 k=1,nob 3307 read (four,21) (obs(i), i=1,nr) 3308 do 170 i=1,nr 3309 x=obs(i)-avg(i) 3310 do 170 j=1,nr 3311 c(i,j)=c(i,j)+x*(obs(j)-avg(j)) 3312 170 continue 3313 dof=nob-1 3314 ker=0 3315 go to (175,180), ks1 3316 175 print 904 3317 c 3318 c compute std-deviations 3319 c 3320 180 do 190 i=1,nr 3321 x=c(i,i) 3322 sos(i)=c(i,i) 3323 std=sqrt(x/dof) 3324 if (std .ge. 1.0e-5) go to 5 3325 ker=1 3326 ks1=1 3327 5 go to (185,190), ks1 3328 c 3329 c print means & std-dev 3330 c 3331 185 print 906, i,vlab(i),avg(i),std,vl(i),vh(i) 3332 190 continue 3333 if (ker .gt. 0) go to 805 3334 c 3335 c read correlation matrix print switch 3336 c 3337 go to (192,200), ks2 3338 192 nal1="no" 3339 print 6 3340 6 format(//" CORR. MATRIX") 3341 read 1001, nal1 3342 if ((nal1 .eq. "no") .or. (nal1 .eq. "NO")) ks2=2 3343 go to (195,200), ks2 3344 195 print 908, (lbk,j,j=1,nr) 3345 c 3346 c compute correlation matrix 3347 c 3348 200 do 215 i=1,nr 3349 x=sos(i) 3350 do 205 j=1,nr 3351 205 c(i,j)=c(i,j)/sqrt(x*sos(j)) 3352 go to (210,215), ks2 3353 c 3354 c print correlation matrix 3355 c 3356 210 print 910, i,(c(i,j), j=1,i) 3357 215 continue 3358 ks1=2 3359 ks2=2 3360 220 do 222 i=1,nr 3361 ph(i)=-1 3362 vi(i)=0 3363 222 continue 3364 3365 print 7 3366 7 format(/" ENTER NO. of 'X' VARS., THEN INDEX of 'Y' VAR.") 3367 print 8 3368 8 format (" FOLLOWED by INDICES of all 'X' VARS.") 3369 c 3370 c select variables for regression analysis 3371 c 3372 read 1020, ni,id,(vi(k), k=1,ni) 3373 1020 format(v) 3374 k=ni+1 3375 if (k .gt. nr) go to 220 3376 if ((nob-k) .lt. 1) go to 810 3377 do 228 k=1,ni 3378 i=vi(k) 3379 l=iabs(i) 3380 if (l .gt. nr) go to 220 3381 if (i) 226,220,224 3382 224 ph(i)=0 3383 go to 228 3384 226 ph(l)=-2 3385 228 continue 3386 if ((id .lt. 1) .or. (id .gt. nr)) go to 220 3387 if (-1 .ne. ph(id)) go to 220 3388 ph(id)=99 3389 np=0 3390 ns=0 3391 230 fc=0.0 3392 fe=0.0 3393 cl=0.0 3394 x=0.0 3395 tol=1.0e-4 3396 print 126 3397 126 format(/" ENTER F OR CL") 3398 go to (231,232), ks6 3399 231 print 9 3400 9 format(" FOR: CRITICAL F-VALUE or CONFIDENCE LEVEL") 3401 ks6=2 3402 c 3403 c read critical-f or confidence level 3404 c 3405 232 read 1001, nal1 3406 if ((nal1 .eq. "CL") .or. (nal1 .eq. "cl")) go to 233 3407 print 127 3408 127 format(/" ENTER CRTICAL-F") 3409 read 1010, fe 3410 go to 234 3411 233 print 125 3412 125 format(/" ENTER CONFIDENCE LEVEL") 3413 read 1010, cl 3414 1010 format(v) 3415 if (cl .ge. 1.0) go to 233 3416 234 fc=frat(dof) 3417 ks3=1 3418 kr=kr+1 3419 nal1="no" 3420 c 3421 c read stepwise printout switch 3422 c 3423 print 128 3424 128 format (/" STEPWISE RESULTS?") 3425 read 1001, nal1 3426 call print2 3427 if ((nal1 .eq. "no") .or. (nal1 .eq. "NO")) ks3 =2 3428 go to (240,235), ks3 3429 235 print 924 3430 c 3431 c pivot on forced variables 3432 c 3433 240 do 245 i=1,nr 3434 if (-2 .ne. ph(i)) go to 245 3435 if (c(i,i) .lt. tol) go to 245 3436 pi=i 3437 call pivot(3) 3438 245 continue 3439 if (np) 260,260,250 3440 c 3441 c select variable for deletion 3442 c 3443 250 call selpvt(2) 3444 if (pi .eq. 0) go to 260 3445 call pivot(2) 3446 go to 250 3447 c 3448 c select variable for addition 3449 c 3450 260 call selpvt(1) 3451 if (pi .eq. 0) go to 300 3452 call pivot(1) 3453 go to 250 3454 300 if (np .gt. 0) go to 310 3455 print 22 3456 22 format (29h *** no significant variables) 3457 go to 230 3458 310 go to (330,320), ks3 3459 c 3460 c print regression results 3461 c 3462 320 call print 3463 330 call print2 3464 nal1="no" 3465 print 11 3466 11 format (/" RESIDUALS?") 3467 c 3468 c read residual printout switch 3469 c 3470 read 1001, nal1 3471 1001 format (v) 3472 if ((nal1 .eq. "no").or.(nal1 .eq. "NO")) go to 500 3473 rewind four 3474 c 3475 c compute & print residual summary 3476 c 3477 print 918 3478 s=0.0 3479 do 410 k=1,nob 3480 read (four,21) (obs(i), i=1,nr) 3481 x=vl(id) 3482 do 400 j=1,nr 3483 3484 l=ph(j) 3485 if ((l .lt. 1) .or. (l .gt. 2)) go to 400 3486 x=x+vl(j)*obs(j) 3487 400 continue 3488 dr=obs(id)-x 3489 s=s+dr*dr 3490 pd=100.0*dr/x 3491 print 920, k,obs(id),x,dr,pd,s 3492 410 continue 3493 500 print 12 3494 12 format (/" ENTER A 1,2,3 or 4") 3495 go to (510,520), ks4 3496 510 print 13 3497 13 format(" FOR: 1 - SELECT NEW DATA FILE",/6x,"2 - SELECT NEW VARIABLES", 3498 &/6x,"3 - SELECT NEW 'F' or 'CL'",/6x,"4 - END OF RUN") 3499 ks4=2 3500 c 3501 c read "loop" back switch 3502 c 3503 520 read 2000, k 3504 2000 format (v) 3505 go to (530,160,230,540), k 3506 530 rewind lrdata 3507 continue 3508 go to 10 3509 540 continue 3510 rewind lrdata 3511 rewind four 3512 call detach 3513 stop 3514 800 print 14 3515 14 format (38h *** too many variables, maximum is 20) 3516 go to 540 3517 805 print 15 3518 15 format (42h *** one or more std-dev = 0.0, check data) 3519 go to 540 3520 810 k=k+1 3521 print 950, ni,k 3522 go to 540 3523 815 print 16 3524 16 format (33h *** no. of tranf. vars. in error) 3525 go to 540 3526 901 format (/,i4," Initial Variables") 3527 902 format (i4," Observations") 3528 903 format(" *** Variable",i3,", Observation",i3,", is missing") 3529 904 format (/" VAR LABEL",7x,"MEAN",7x,"STD-DEV",8x,"MIN",10x,"MAX"/) 3530 905 format (i4," Transformed Variables") 3531 906 format (i4,a8,2f12.4,1p2e13.4) 3532 907 format (/" *** TRANF. ERROR",a10,i5,f8.4,i5) 3533 908 format (/" CORRELATION MATRIX"//(4x,8(a5,i2,"]"))) 3534 910 format (" [",i2,"]"/(4x,8f8.3)) 3535 918 format(/" OBS",6x,"Y-OBS",7x,"Y-CALC",7x,"ERROR",5x,"-ERR",6x,"C-ER^2"/) 3536 920 format (i4,3f12.4,f9.2,f12.4) 3537 924 format (/" STEP VAR:LABEL F-CRIT DOF",4x,"R-SQ",9x,"SEE"/) 3538 950 format (/" *** MINIMUM NO. OF OBSERVATIONS FOR",i3,"VARIABLES IS",i3) 3539 end Subroutine smlrp NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alog builtin ref 3256 3258 avg 000620 // real array(20) ref 3090 3218 3278 3278 3298 3298 3309 3311 3331 blnk*com common block name 570 words ref 3090 3091 3092 3093 3094 c 000000 // real array(20,20) ref 3090 3302 3311 3311 3321 3322 3351 3351 3356 3435 cl 001064 // real ref 3093 3393 3413 3415 com_err_ external subroutine 010040 constant with descriptors ref 3095 3130 cos builtin ref 3262 detach external subroutine 010044 constant ref 3095 3512 dof 001063 // integer ref 3093 3102 3313 3323 3416 dr 016301 automatic real ref 3488 3489 3489 3490 3491 exp builtin ref 3252 fc 001061 // real ref 3093 3391 3416 fe 001060 // real ref 3093 3392 3409 fname 001066 // character(16) ref 3094 3096 3127 3128 four 016247 automatic integer ref 3102 3108 3122 3268 3299 3307 3473 3480 3511 frat internal function constant real ref 3416 i 016267 automatic integer ref 3165 3166 3177 3182 3196 3197 3205 3205 3207 3208 3209 3209 3217 3218 3219 3220 3227 3228 3229 3229 3268 3268 3272 3273 3276 3278 3278 3279 3279 3280 3280 3297 3298 3298 3301 3302 3307 3307 3308 3309 3309 3311 3311 3320 3321 3321 3322 3322 3322 3331 3331 3331 3331 3331 3348 3349 3351 3351 3356 3356 3356 3360 3361 3362 3378 3379 3381 3382 3433 3434 3435 3435 3436 3480 3480 iabs builtin integer ref 3379 id 001051 // integer ref 3092 3372 3386 3386 3387 3388 3481 3488 3491 idum 016260 automatic integer ref 3144 3146 3146 3164 3164 3206 3206 istat 015460 automatic integer equivalenced ref 3103 3104 3128 3129 3130 itv 016270 automatic integer ref 3195 3204 iv1 015631 automatic integer array(80) ref 3100 3179 3236 iv2 015751 automatic integer array(80) ref 3100 3181 3237 iv3 016071 automatic integer array(80) ref 3100 3184 3238 j 016273 automatic integer ref 3234 3235 3236 3237 3238 3300 3302 3310 3311 3311 3311 3311 3344 3344 3350 3351 3351 3351 3356 3356 3482 3484 3486 3486 k 016272 automatic integer ref 3204 3205 3207 3226 3276 3282 3306 3372 3372 3374 3375 3376 3376 3377 3378 3479 3491 3503 3505 3520 3520 3521 kdum 016261 automatic integer ref 3145 3150 3195 ker 016262 automatic integer ref 3154 3168 3189 3222 3275 3284 3314 3325 3333 kod 000220 automatic character(3) array(20) initialized ref 3098 3107 3166 kr 001057 // integer ref 3093 3121 3418 3418 ks1 016253 automatic integer ref 3117 3292 3315 3326 3327 3358 ks2 016254 automatic integer ref 3118 3337 3342 3343 3352 3359 ks3 001055 // integer ref 3092 3119 3417 3427 3428 3458 ks4 016251 automatic integer ref 3115 3495 3499 ks5 016255 automatic integer ref 3120 3153 3230 ks6 016252 automatic integer ref 3116 3398 3401 ks7 016271 automatic integer ref 3202 ktr 015511 automatic integer array(80) ref 3100 3177 3235 l 016263 automatic integer ref 3158 3235 3239 3379 3380 3384 3484 3485 3485 lbk 000244 automatic integer initialized ref 3105 3344 lrdata 016250 automatic integer ref 3108 3108 3134 3145 3163 3205 3229 3506 3510 na1 016264 automatic integer ref 3159 3236 3240 3242 3244 3246 3248 3250 3252 3254 3256 3258 3260 3262 3264 3266 na2 016265 automatic integer ref 3160 3163 3169 3174 3178 3178 3179 3237 3240 3242 3244 3246 3248 3250 3252 3254 3256 3258 3260 3262 3264 3266 na3 016211 automatic real ref 3101 3139 3161 3163 3169 3174 3180 3180 3181 3238 3240 3242 3244 3246 na4 016266 automatic integer ref 3162 3163 3169 3182 3182 3184 nal1 015463 automatic character(4) ref 3097 3163 3166 3169 3172 3173 3288 3291 3292 3292 3338 3341 3342 3342 3405 3406 3406 3419 3425 3427 3427 3464 3470 3472 3472 nal2 015464 automatic character(4) ref 3097 3123 3190 nam 015462 automatic character(4) ref 3097 3145 3147 3147 3148 3148 ni 016277 automatic integer ref 3372 3372 3374 3377 3521 nob 016275 automatic integer ref 3282 3283 3296 3306 3313 3376 3479 np 001047 // integer ref 3092 3389 3439 3454 nr 001046 // integer ref 3092 3136 3137 3138 3150 3151 3152 3152 3196 3217 3227 3268 3272 3297 3300 3301 3307 3308 3310 3320 3344 3348 3350 3360 3375 3380 3386 3433 3480 3482 ns 001050 // integer ref 3092 3390 nt 016257 automatic integer ref 3140 3176 3176 3177 3179 3181 3184 3234 nv 016256 automatic integer ref 3134 3136 3229 obs 000740 // real array(30) ref 3091 3174 3228 3229 3240 3240 3240 3242 3242 3242 3244 3244 3244 3246 3246 3246 3248 3248 3250 3250 3252 3252 3254 3254 3256 3256 3258 3258 3260 3260 3262 3262 3264 3264 3266 3266 3268 3273 3307 3309 3311 3480 3486 3488 3491 pd 016302 automatic real ref 3490 3491 ph 001022 // integer array(20) ref 3091 3102 3361 3382 3384 3387 3388 3434 3484 pi 001052 // integer ref 3092 3102 3436 3444 3451 pivot internal subroutine constant ref 3437 3445 3452 print internal subroutine constant ref 3462 print2 internal subroutine constant ref 3426 3463 s 016300 automatic real ref 3478 3489 3489 3491 selpvt internal subroutine constant ref 3443 3450 sin builtin ref 3260 smlrp entry point 036460 constant on line 3087 smlrpattach external subroutine 010050 constant with descriptors ref 3095 3128 sos 000644 // real array(20) ref 3090 3322 3349 3351 sqrt builtin ref 3266 3323 3351 std 016276 automatic real ref 3323 3324 3331 tanh builtin ref 3264 temp 015465 automatic character(4) array(20) ref 3097 3100 3205 3208 3209 tol 001056 // real ref 3092 3395 3435 vh 000714 // real array(20) ref 3091 3220 3280 3280 3331 vi 016212 automatic integer array(29) ref 3102 3362 3372 3378 vl 000670 // real array(20) ref 3091 3219 3279 3279 3331 3481 3486 vlab 000776 // character(4) array(20) ref 3091 3097 3197 3209 3331 x 016274 automatic real ref 3273 3274 3278 3279 3279 3280 3280 3296 3298 3309 3311 3321 3323 3349 3351 3394 3481 3486 3486 3488 3490 3491 NAMES DECLARED BUT NOT USED bad real initialized declared 3105 fr 001062 // real declared 3093 kx character(4) declared 3097 nd 001053 // integer declared 3092 no integer initialized declared 3102 3105 sct integer initialized declared 3102 3105 see 001065 // real declared 3093 sgn 001054 // real declared 3092 stat 015460 automatic double precision equivalenced declared 3099 3104 yes integer initialized declared 3102 3105 LOC LABEL TYPE LINE REFERENCES 1 format 3114 ref 3113 2 format 3187 ref 3186 3 format 3212 ref 3211 4 format 3290 ref 3289 040417 5 executable 3327 used in transfer ref 3324 6 format 3340 ref 3339 7 format 3366 ref 3365 8 format 3368 ref 3367 9 format 3400 ref 3399 036525 10 executable 3117 used in transfer ref 3508 11 format 3466 ref 3465 12 format 3494 ref 3493 13 format 3497 ref 3496 14 format 3515 ref 3514 15 format 3518 ref 3517 16 format 3524 ref 3523 037007 20 executable 3159 used in transfer ref 3171 3175 21 format 3135 ref 3134 3145 3163 3205 3229 3268 3307 3480 22 format 3456 ref 3455 037064 25 executable 3167 ref 3165 037070 27 executable 3168 used in transfer ref 3178 3180 3182 037131 30 executable 3172 used in transfer ref 3166 037150 32 executable 3176 used in transfer ref 3173 037231 34 executable 3185 ref 3158 037245 36 executable 3189 used in transfer ref 3172 037255 38 executable 3195 used in transfer ref 3147 037272 40 executable 3198 ref 3196 037276 42 executable 3202 037346 44 executable 3210 ref 3207 037362 46 executable 3217 used in transfer ref 3149 3208 037377 48 executable 3221 ref 3217 037413 50 executable 3228 ref 3227 037456 55 executable 3234 used in transfer ref 3230 037520 61 executable 3240 used in transfer ref 3239 037532 62 executable 3242 used in transfer ref 3239 037544 63 executable 3244 used in transfer ref 3239 037556 64 executable 3246 used in transfer ref 3239 037570 65 executable 3248 used in transfer ref 3239 037577 66 executable 3250 used in transfer ref 3239 037605 67 executable 3252 used in transfer ref 3239 037620 68 executable 3254 used in transfer ref 3239 037634 69 executable 3256 used in transfer ref 3239 037647 70 executable 3258 used in transfer ref 3239 037663 71 executable 3260 used in transfer ref 3239 037676 72 executable 3262 used in transfer ref 3239 037711 73 executable 3264 used in transfer ref 3239 037725 74 executable 3266 used in transfer ref 3239 037737 90 executable 3267 used in transfer ref 3234 3241 3243 3245 3247 3249 3251 3253 3255 3257 3259 3261 3263 3265 037743 100 executable 3268 used in transfer ref 3230 120 format 3112 ref 3111 125 format 3412 ref 3411 126 format 3397 ref 3396 127 format 3408 ref 3407 128 format 3424 ref 3423 040000 139 executable 3275 used in transfer ref 3274 040027 140 executable 3278 used in transfer ref 3274 3274 040052 145 executable 3281 used in transfer ref 3226 3272 3277 040062 150 executable 3282 used in transfer ref 3229 040170 155 executable 3298 ref 3297 040201 160 executable 3299 used in transfer ref 3505 040220 165 executable 3302 ref 3300 3301 040321 170 executable 3312 ref 3306 3308 3310 040351 175 executable 3316 used in transfer ref 3315 040360 180 executable 3320 used in transfer ref 3315 040427 185 executable 3331 used in transfer ref 3327 040504 190 executable 3332 used in transfer ref 3320 3327 040524 192 executable 3338 used in transfer ref 3337 040602 195 executable 3344 used in transfer ref 3343 040637 200 executable 3348 used in transfer ref 3337 3343 040654 205 executable 3351 ref 3350 040721 210 executable 3356 used in transfer ref 3352 040762 215 executable 3357 used in transfer ref 3348 3352 040771 220 executable 3360 used in transfer ref 3375 3380 3381 3386 3387 041004 222 executable 3363 ref 3360 041120 224 executable 3382 used in transfer ref 3381 041125 226 executable 3384 used in transfer ref 3381 036666 227 executable 3145 used in transfer ref 3191 041131 228 executable 3385 used in transfer ref 3377 3383 036744 229 executable 3150 used in transfer ref 3148 041164 230 executable 3391 used in transfer ref 3457 3505 041213 231 executable 3399 used in transfer ref 3398 041224 232 executable 3405 used in transfer ref 3398 041307 233 executable 3411 used in transfer ref 3406 3415 041343 234 executable 3416 used in transfer ref 3410 041446 235 executable 3429 used in transfer ref 3428 041455 240 executable 3433 used in transfer ref 3428 041506 245 executable 3438 used in transfer ref 3433 3434 3435 041516 250 executable 3443 used in transfer ref 3439 3446 3453 041532 260 executable 3450 used in transfer ref 3439 3439 3444 041546 300 executable 3454 used in transfer ref 3451 041563 310 executable 3458 used in transfer ref 3454 041574 320 executable 3462 used in transfer ref 3458 041577 330 executable 3463 used in transfer ref 3458 041745 400 executable 3487 used in transfer ref 3482 3485 042037 410 executable 3492 ref 3479 042043 500 executable 3493 used in transfer ref 3472 042062 510 executable 3496 used in transfer ref 3495 042073 520 executable 3503 used in transfer ref 3495 042124 530 executable 3506 used in transfer ref 3505 042132 540 executable 3509 used in transfer ref 3188 3189 3213 3284 3505 3516 3519 3522 3525 042154 800 executable 3514 used in transfer ref 3138 042164 805 executable 3517 used in transfer ref 3333 042174 810 executable 3520 used in transfer ref 3376 042222 815 executable 3523 used in transfer ref 3152 901 format 3526 ref 3137 902 format 3527 ref 3283 903 format 3528 ref 3276 904 format 3529 ref 3316 905 format 3530 ref 3151 906 format 3531 ref 3331 907 format 3532 ref 3169 908 format 3533 ref 3344 910 format 3534 ref 3356 918 format 3535 ref 3477 920 format 3536 ref 3491 924 format 3537 ref 3429 950 format 3538 ref 3521 1001 format 3471 ref 3291 3341 3405 3425 3470 1010 format 3414 ref 3409 3413 1020 format 3373 ref 3372 2000 format 3504 ref 3503 036613 3535 executable 3134 used in transfer ref 3129 036504 3939 executable 3110 036571 4545 executable 3130 used in transfer ref 3129 3129 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3087 036457 3108 036500 3108 036502 3110 036504 3111 036504 3113 036513 3115 036522 3116 036524 3117 036525 3118 036527 3119 036530 3120 036532 3121 036533 3122 036534 3123 036541 3127 036544 3128 036550 3129 036566 3130 036571 3134 036613 3136 036632 3137 036635 3138 036655 3139 036662 3140 036664 3144 036665 3145 036666 3146 036712 3147 036713 3148 036727 3149 036743 3150 036744 3151 036747 3152 036767 3153 037002 3154 037004 3158 037005 3159 037007 3160 037010 3161 037011 3162 037013 3163 037014 3164 037052 3165 037053 3166 037055 3167 037064 3168 037070 3169 037072 3171 037130 3172 037131 3173 037136 3174 037143 3175 037147 3176 037150 3177 037151 3178 037154 3179 037166 3180 037171 3181 037203 3182 037207 3184 037226 3185 037231 3186 037235 3188 037244 3189 037245 3190 037251 3191 037254 3195 037255 3196 037257 3197 037264 3198 037272 3202 037276 3204 037300 3205 037303 3206 037323 3207 037324 3208 037330 3209 037337 3210 037346 3211 037352 3213 037361 3217 037362 3218 037367 3219 037373 3220 037375 3221 037377 3222 037403 3226 037404 3227 037406 3228 037413 3229 037423 3230 037446 3234 037456 3235 037462 3236 037465 3237 037467 3238 037471 3239 037474 3240 037520 3241 037531 3242 037532 3243 037543 3244 037544 3245 037555 3246 037556 3247 037567 3248 037570 3249 037576 3250 037577 3251 037604 3252 037605 3253 037617 3254 037620 3255 037633 3256 037634 3257 037646 3258 037647 3259 037662 3260 037663 3261 037675 3262 037676 3263 037710 3264 037711 3265 037724 3266 037725 3267 037737 3268 037743 3272 037764 3273 037771 3274 037775 3275 040000 3276 040002 3277 040026 3278 040027 3279 040034 3280 040042 3281 040052 3282 040062 3283 040067 3284 040106 3288 040112 3289 040115 3291 040124 3292 040143 3296 040160 3297 040163 3298 040170 3299 040201 3300 040206 3301 040213 3302 040220 3306 040237 3307 040243 3308 040264 3309 040271 3310 040276 3311 040302 3312 040321 3313 040335 3314 040340 3315 040341 3316 040351 3320 040360 3321 040365 3322 040373 3323 040401 3324 040411 3325 040414 3326 040416 3327 040417 3331 040427 3332 040504 3333 040510 3337 040514 3338 040524 3339 040527 3341 040536 3342 040555 3343 040572 3344 040602 3348 040637 3349 040644 3350 040650 3351 040654 3352 040711 3356 040721 3357 040762 3358 040766 3359 040770 3360 040771 3361 040776 3362 041002 3363 041004 3365 041010 3367 041017 3372 041026 3374 041061 3375 041064 3376 041070 3377 041075 3378 041101 3379 041104 3380 041110 3381 041114 3382 041120 3383 041124 3384 041125 3385 041131 3386 041135 3387 041150 3388 041156 3389 041162 3390 041163 3391 041164 3392 041167 3393 041170 3394 041171 3395 041172 3396 041174 3398 041203 3399 041213 3401 041222 3405 041224 3406 041243 3407 041257 3409 041266 3410 041306 3411 041307 3413 041316 3415 041336 3416 041343 3417 041360 3418 041362 3419 041363 3423 041366 3425 041375 3426 041414 3427 041417 3428 041435 3429 041446 3433 041455 3434 041462 3435 041470 3436 041500 3437 041503 3438 041506 3439 041512 3443 041516 3444 041521 3445 041526 3446 041531 3450 041532 3451 041535 3452 041542 3453 041545 3454 041546 3455 041553 3457 041562 3458 041563 3462 041574 3463 041577 3464 041602 3465 041605 3470 041614 3472 041633 3473 041647 3477 041654 3478 041663 3479 041665 3480 041671 3481 041712 3482 041716 3484 041722 3485 041726 3486 041737 3487 041745 3488 041751 3489 041756 3490 041761 3491 041765 3492 042037 3493 042043 3495 042052 3496 042062 3499 042071 3503 042073 3505 042112 3506 042124 3507 042131 3508 042131 3509 042132 3510 042132 3511 042137 3512 042144 3513 042152 3514 042154 3516 042163 3517 042164 3519 042173 3520 042174 3521 042175 3522 042221 3523 042222 3525 042231 Function frat 3540 c compute f-value routine 3541 c 3542 function frat(d) 3543 common c(20,20),avg(20),sos(20) 3544 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3545 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3546 common kr,fe,fc,fr,dof,cl,see 3547 integer ph,pi,dof,d 3548 c 3549 c d - degrees of freedom 3550 c cl - confidence level 3551 c fe - entered f-value 3552 c 3553 if(cl) 100,100,200 3554 100 frat=fe 3555 return 3556 200 if(fc) 300,300,400 3557 300 p=(1.0-cl)/2.0 3558 t=sqrt(alog(1.0/p**2)) 3559 x2=t*(t*(0.001308*t+0.189269)+1.432788)+1.0 3560 x=t-(t*(0.010328*t+0.802853)+2.515517)/x2 3561 x2=x*x 3562 c1=(x2+1.)/4. 3563 c2=(x2*(5.*x2+16.)+3.)/96. 3564 c3=(x2*(x2*(3.*x2+19.)+17.)-15.)/384. 3565 c4=(x2*(x2*(x2*(79.*x2+776.)+1482.)-1920.)-945.)/92160. 3566 400 t=x*((((c4/d+c3)/d+c2)/d+c1)/d+1.0) 3567 frat=t*t 3568 return 3569 end Function frat NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES alog builtin ref 3558 blnk*com common block name 566 words ref 3543 3544 3545 3546 c1 016311 automatic real ref 3562 3566 c2 016312 automatic real ref 3563 3566 c3 016313 automatic real ref 3564 3566 c4 016314 automatic real ref 3565 3566 cl 001064 // real ref 3546 3553 3557 3557 d parameter position 1 integer ref 3542 3547 3566 3566 3566 3566 fc 001061 // real ref 3546 3556 fe 001060 // real ref 3546 3554 frat 016304 automatic real ref 3542 3554 3567 frat entry point constant real on line 3542 p 016305 automatic real ref 3557 3558 sqrt builtin ref 3558 t 016306 automatic real ref 3558 3559 3559 3559 3560 3560 3560 3566 3567 3567 x 016310 automatic real ref 3560 3561 3561 3566 x2 016307 automatic real ref 3559 3560 3561 3562 3563 3563 3564 3564 3564 3565 3565 3565 3565 NAMES DECLARED BUT NOT USED avg 000620 // real array(20) declared 3543 c 000000 // real array(20,20) declared 3543 dof 001063 // integer declared 3546 3547 fr 001062 // real declared 3546 id 001051 // integer declared 3545 kr 001057 // integer declared 3546 ks3 001055 // integer declared 3545 nd 001053 // integer declared 3545 np 001047 // integer declared 3545 nr 001046 // integer declared 3545 ns 001050 // integer declared 3545 obs 000740 // real array(30) declared 3544 ph 001022 // integer array(20) declared 3544 3547 pi 001052 // integer declared 3545 3547 see 001065 // real declared 3546 sgn 001054 // real declared 3545 sos 000644 // real array(20) declared 3543 tol 001056 // real declared 3545 vh 000714 // real array(20) declared 3544 vl 000670 // real array(20) declared 3544 vlab 000776 // real array(20) declared 3544 LOC LABEL TYPE LINE REFERENCES 042257 100 executable 3554 used in transfer ref 3553 3553 042264 200 executable 3556 used in transfer ref 3553 042270 300 executable 3557 used in transfer ref 3556 3556 042370 400 executable 3566 used in transfer ref 3556 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3542 042232 3553 042253 3554 042257 3555 042262 3556 042264 3557 042270 3558 042275 3559 042310 3560 042317 3561 042330 3562 042332 3563 042335 3564 042344 3565 042355 3566 042370 3567 042415 3568 042417 Subroutine pivot 3570 3571 c matrix pivot routine 3572 c 3573 subroutine pivot(l) 3574 common c(20,20),avg(20),sos(20) 3575 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3576 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3577 common kr,fe,fc,fr,dof,cl,see 3578 character vlab*4,kx*4 3579 integer ph,pi,dof 3580 c 3581 c l=1, forward pivot 3582 c l=2, backward pivot 3583 c l=3, forced pivot 3584 c pi - pivot index 3585 c 3586 ks=l 3587 k=pi 3588 ark=c(k,k) 3589 c(k,k)=0.0 3590 do 300 j=1,nr 3591 if(ph(j)) 300,100,100 3592 100 if(c(k,j)) 150,300,150 3593 150 t=c(k,j)/ark 3594 c(k,j)=c(k,j)/ark 3595 do 200 i=1,nr 3596 200 c(i,j)=c(i,j)-c(i,k)*t 3597 300 continue 3598 c(k,k)=-1.0 3599 do 400 i=1,nr 3600 c(i,k)=-c(i,k)/ark 3601 400 continue 3602 go to (410,420,405),ks 3603 405 kx=" *" 3604 ph(k)=2 3605 go to 415 3606 410 kx=" +" 3607 ph(k)=1 3608 415 np=np+1 3609 dof=dof-1.0 3610 go to 430 3611 420 kx=" -" 3612 ph(k)=0 3613 3614 np=np-1 3615 dof=dof+1.0 3616 430 ns=ns+1 3617 fc=frat(dof) 3618 dr=c(id,id) 3619 r2=1.0-dr 3620 see=sqrt(dr*sos(id)/dof) 3621 go to (440,450),ks3 3622 440 print 900 3623 450 print 910,ns,kx,k,vlab(k),fc,dof,r2,see 3624 go to (460,500),ks3 3625 460 call print 3626 500 return 3627 900 format (//" STEP VAR:LABEL F-CRIT DOF",6x,"R-SQ",9x,"SEE"/) 3628 910 format (i4,a4,i2,":",a6,f9.2,i6,f10.4,f12.4) 3629 end Subroutine pivot NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES ark 016321 automatic real ref 3588 3593 3594 3600 blnk*com common block name 566 words ref 3574 3575 3576 3577 c 000000 // real array(20,20) ref 3574 3588 3589 3592 3593 3594 3594 3596 3596 3596 3598 3600 3600 3618 dof 001063 // integer ref 3577 3579 3609 3609 3615 3615 3617 3620 3623 dr 016325 automatic real ref 3618 3619 3620 fc 001061 // real ref 3577 3617 3623 frat internal function constant on line 3542 real ref 3617 i 016324 automatic integer ref 3595 3596 3596 3596 3599 3600 3600 id 001051 // integer ref 3576 3618 3618 3620 j 016322 automatic integer ref 3590 3591 3592 3593 3594 3594 3596 3596 k 016320 automatic integer ref 3587 3588 3588 3589 3589 3592 3593 3594 3594 3596 3598 3598 3600 3600 3604 3607 3612 3623 3623 ks 016317 automatic integer ref 3586 3586 3602 ks3 001055 // integer ref 3576 3621 3624 kx 016316 automatic character(4) ref 3578 3603 3606 3611 3623 l parameter position 1 integer ref 3573 3586 np 001047 // integer ref 3576 3608 3608 3614 3614 nr 001046 // integer ref 3576 3590 3595 3599 ns 001050 // integer ref 3576 3616 3616 3623 ph 001022 // integer array(20) ref 3575 3579 3591 3604 3607 3612 pi 001052 // integer ref 3576 3579 3587 pivot entry point constant on line 3573 print internal subroutine constant ref 3625 r2 016326 automatic real ref 3619 3623 see 001065 // real ref 3577 3620 3623 sos 000644 // real array(20) ref 3574 3620 sqrt builtin ref 3620 t 016323 automatic real ref 3593 3596 vlab 000776 // character(4) array(20) ref 3575 3578 3623 NAMES DECLARED BUT NOT USED avg 000620 // real array(20) declared 3574 cl 001064 // real declared 3577 fe 001060 // real declared 3577 fr 001062 // real declared 3577 kr 001057 // integer declared 3577 nd 001053 // integer declared 3576 obs 000740 // real array(30) declared 3575 sgn 001054 // real declared 3576 tol 001056 // real declared 3576 vh 000714 // real array(20) declared 3575 vl 000670 // real array(20) declared 3575 LOC LABEL TYPE LINE REFERENCES 042472 100 executable 3592 used in transfer ref 3591 3591 042502 150 executable 3593 used in transfer ref 3592 3592 042527 200 executable 3596 ref 3595 042555 300 executable 3597 used in transfer ref 3590 3591 3592 042613 400 executable 3601 ref 3599 042630 405 executable 3603 used in transfer ref 3602 042640 410 executable 3606 used in transfer ref 3602 042647 415 executable 3608 used in transfer ref 3605 042660 420 executable 3611 used in transfer ref 3602 042677 430 executable 3616 used in transfer ref 3610 042752 440 executable 3622 used in transfer ref 3621 042761 450 executable 3623 used in transfer ref 3621 043062 460 executable 3625 used in transfer ref 3624 043065 500 executable 3626 used in transfer ref 3624 900 format 3627 ref 3622 910 format 3628 ref 3623 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3573 042421 3586 042442 3587 042444 3588 042447 3589 042453 3590 042461 3591 042465 3592 042472 3593 042502 3594 042511 3595 042523 3596 042527 3597 042555 3598 042561 3599 042573 3600 042577 3601 042613 3602 042617 3603 042630 3604 042633 3605 042637 3606 042640 3607 042643 3608 042647 3609 042651 3610 042657 3611 042660 3612 042663 3614 042667 3615 042671 3616 042677 3617 042701 3618 042715 3619 042722 3620 042725 3621 042742 3622 042752 3623 042761 3624 043051 3625 043062 3626 043065 Subroutine print 3630 c print regression results routine 3631 c 3632 subroutine print 3633 common c(20,20),avg(20),sos(20) 3634 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3635 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3636 common kr,fe,fc,fr,dof,cl,see 3637 character vlab*4,kx*4 3638 integer ph,pi,dof 3639 print 900 3640 s=0.0 3641 do 100 i=1,nr 3642 l=ph(i) 3643 c 3644 if((l .lt. 1) .or. (l .gt. 2)) go to 100 3645 x=c(i,id)*sqrt(sos(id)/sos(i)) 3646 vl(i)=c(i,id)*sqrt(sos(id)/sos(i)) 3647 serc=see*sqrt(c(i,i)/sos(i)) 3648 fi=x/serc 3649 fi=fi*fi 3650 if((serc .lt. 1.0e-8) .and. (serc .ge. 0.0)) fi=9999.99 3651 print 910,i,vlab(i),x,serc,fi,c(i,id) 3652 s=s+x*avg(i) 3653 100 continue 3654 vl(id)=avg(id)-s 3655 print 920, vl(id) 3656 return 3657 900 format(//" VAR LABEL",6x,"COEFFICIENT",5x,"STD-ERR",5x,"F-RATIO",6x,"BETA-WT"/) 3658 910 format(i4,a8,f16.6,f13.4,f11.2,f13.4) 3659 920 format (" CONS",8x,f16.6) 3660 end Subroutine print NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES avg 000620 // real array(20) ref 3633 3652 3654 blnk*com common block name 566 words ref 3633 3634 3635 3636 c 000000 // real array(20,20) ref 3633 3645 3646 3647 3651 fi 016335 automatic real ref 3648 3649 3649 3649 3650 3651 i 016331 automatic integer ref 3641 3642 3645 3645 3646 3646 3646 3647 3647 3647 3651 3651 3651 3652 id 001051 // integer ref 3635 3645 3645 3646 3646 3651 3654 3654 3655 l 016332 automatic integer ref 3642 3644 3644 nr 001046 // integer ref 3635 3641 ph 001022 // integer array(20) ref 3634 3638 3642 print entry point constant on line 3632 s 016330 automatic real ref 3640 3652 3652 3654 see 001065 // real ref 3636 3647 serc 016334 automatic real ref 3647 3648 3650 3650 3651 sos 000644 // real array(20) ref 3633 3645 3645 3646 3646 3647 sqrt builtin ref 3645 3646 3647 vl 000670 // real array(20) ref 3634 3646 3654 3655 vlab 000776 // character(4) array(20) ref 3634 3637 3651 x 016333 automatic real ref 3645 3648 3651 3652 NAMES DECLARED BUT NOT USED cl 001064 // real declared 3636 dof 001063 // integer declared 3636 3638 fc 001061 // real declared 3636 fe 001060 // real declared 3636 fr 001062 // real declared 3636 kr 001057 // integer declared 3636 ks3 001055 // integer declared 3635 kx character(4) declared 3637 nd 001053 // integer declared 3635 np 001047 // integer declared 3635 ns 001050 // integer declared 3635 obs 000740 // real array(30) declared 3634 pi 001052 // integer declared 3635 3638 sgn 001054 // real declared 3635 tol 001056 // real declared 3635 vh 000714 // real array(20) declared 3634 LOC LABEL TYPE LINE REFERENCES 043327 100 executable 3653 used in transfer ref 3641 3644 900 format 3657 ref 3639 910 format 3658 ref 3651 920 format 3659 ref 3655 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3632 043066 3639 043107 3640 043116 3641 043120 3642 043125 3644 043131 3645 043142 3646 043165 3647 043210 3648 043224 3649 043226 3650 043230 3651 043243 3652 043322 3653 043327 3654 043333 3655 043341 3656 043362 Subroutine print2 3661 c print summary line routine 3662 c 3663 subroutine print2 3664 common c(20,20),avg(20),sos(20) 3665 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3666 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3667 common kr,fe,fc,fr,dof,cl,see 3668 common fname 3669 integer dof,ph,pi 3670 character fname*16 3671 lrdata=10 3672 x=sos(id)*c(id,id) 3673 print 700,fname,kr,id,vlab(id),cl,dof,x 3674 700 format(//2x,a16,":",i2," DEP-VAR=",i2,":",a6," CL=",f4.2," DOF=",i3," RSS=",f13.4) 3675 return 3676 end Subroutine print2 NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 570 words ref 3664 3665 3666 3667 3668 c 000000 // real array(20,20) ref 3664 3672 cl 001064 // real ref 3667 3673 dof 001063 // integer ref 3667 3669 3673 fname 001066 // character(16) ref 3668 3670 3673 id 001051 // integer ref 3666 3672 3672 3672 3673 3673 kr 001057 // integer ref 3667 3673 lrdata 016336 automatic integer ref 3671 3671 print2 entry point constant on line 3663 sos 000644 // real array(20) ref 3664 3672 vlab 000776 // real array(20) ref 3665 3673 x 016337 automatic real ref 3672 3673 NAMES DECLARED BUT NOT USED avg 000620 // real array(20) declared 3664 fc 001061 // real declared 3667 fe 001060 // real declared 3667 fr 001062 // real declared 3667 ks3 001055 // integer declared 3666 nd 001053 // integer declared 3666 np 001047 // integer declared 3666 nr 001046 // integer declared 3666 ns 001050 // integer declared 3666 obs 000740 // real array(30) declared 3665 ph 001022 // integer array(20) declared 3665 3669 pi 001052 // integer declared 3666 3669 see 001065 // real declared 3667 sgn 001054 // real declared 3666 tol 001056 // real declared 3666 vh 000714 // real array(20) declared 3665 vl 000670 // real array(20) declared 3665 LOC LABEL TYPE LINE REFERENCES 700 format 3674 ref 3673 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3663 043363 3671 043404 3672 043406 3673 043416 3675 043502 Subroutine selpvt 3677 c select pivot variable routine 3678 c 3679 subroutine selpvt(n) 3680 common c(20,20),avg(20),sos(20) 3681 common vl(20),vh(20),obs(30),vlab(20),ph(20) 3682 common nr,np,ns,id,pi,nd,sgn,ks3,tol 3683 common kr,fe,fc,fr,dof,cl,see 3684 integer ph,pi,dof 3685 c 3686 c n=1, select variable for forward addition 3687 c n=2, select variable for backward deletion 3688 c 3689 3690 10 pi=0 3691 go to (20,30),n 3692 20 l=0 3693 fr=frat(dof-1) 3694 go to 100 3695 30 l=1 3696 fr=fc 3697 100 do 350 i=1,nr 3698 if(ph(i) .ne. l) go to 350 3699 if(c(i,i) .lt. tol) go to (350,400),n 3700 dr=c(i,id)*c(i,id)/c(i,i) 3701 go to (200,250),n 3702 200 x=c(id,id)-dr 3703 ft=dr*(dof-1.0)/x 3704 if((x .lt. 1.0e-8) .and. (x .ge. 0.0)) ft=9999.99 3705 if(ft .lt. fr) go to 350 3706 go to 300 3707 250 ft=dr*dof/c(id,id) 3708 x=c(id,id) 3709 if((x .lt. 1.0e-8) .and. (x .ge. 0.0)) ft=9999.99 3710 if(ft .ge. fr) go to 350 3711 300 fr=ft 3712 pi=i 3713 350 continue 3714 return 3715 400 pi=i 3716 call pivot(2) 3717 ph(i)=-1 3718 go to 10 3719 end Subroutine selpvt NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES blnk*com common block name 566 words ref 3680 3681 3682 3683 c 000000 // real array(20,20) ref 3680 3699 3700 3700 3700 3702 3707 3708 dof 001063 // integer ref 3683 3684 3693 3703 3707 dr 016342 automatic real ref 3700 3702 3703 3707 fc 001061 // real ref 3683 3696 fr 001062 // real ref 3683 3693 3696 3705 3710 3711 frat internal function constant on line 3542 real ref 3693 ft 016344 automatic real ref 3703 3704 3705 3707 3709 3710 3711 i 016341 automatic integer ref 3697 3698 3699 3699 3700 3700 3700 3700 3712 3715 3717 id 001051 // integer ref 3682 3700 3700 3702 3702 3707 3707 3708 3708 l 016340 automatic integer ref 3692 3695 3698 n parameter position 1 integer ref 3679 3691 3699 3701 nr 001046 // integer ref 3682 3697 ph 001022 // integer array(20) ref 3681 3684 3698 3717 pi 001052 // integer ref 3682 3684 3690 3690 3712 3715 pivot internal subroutine constant on line 3573 ref 3716 selpvt entry point constant on line 3679 tol 001056 // real ref 3682 3699 x 016343 automatic real ref 3702 3703 3704 3704 3708 3709 3709 NAMES DECLARED BUT NOT USED avg 000620 // real array(20) declared 3680 cl 001064 // real declared 3683 fe 001060 // real declared 3683 kr 001057 // integer declared 3683 ks3 001055 // integer declared 3682 nd 001053 // integer declared 3682 np 001047 // integer declared 3682 ns 001050 // integer declared 3682 obs 000740 // real array(30) declared 3681 see 001065 // real declared 3683 sgn 001054 // real declared 3682 sos 000644 // real array(20) declared 3680 vh 000714 // real array(20) declared 3681 vl 000670 // real array(20) declared 3681 vlab 000776 // real array(20) declared 3681 LOC LABEL TYPE LINE REFERENCES 043524 10 executable 3690 used in transfer ref 3718 043536 20 executable 3692 used in transfer ref 3691 043552 30 executable 3695 used in transfer ref 3691 043557 100 executable 3697 used in transfer ref 3694 043643 200 executable 3702 used in transfer ref 3701 043701 250 executable 3707 used in transfer ref 3701 043741 300 executable 3711 used in transfer ref 3706 043746 350 executable 3713 used in transfer ref 3697 3698 3699 3705 3710 043753 400 executable 3715 used in transfer ref 3699 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3679 043503 3690 043524 3691 043526 3692 043536 3693 043537 3694 043551 3695 043552 3696 043554 3697 043557 3698 043564 3699 043572 3700 043611 3701 043633 3702 043643 3703 043652 3704 043660 3705 043673 3706 043700 3707 043701 3708 043715 3709 043722 3710 043734 3711 043741 3712 043744 3713 043746 3714 043752 3715 043753 3716 043756 3717 043761 3718 043765 Subroutine stat 3720 subroutine stat 3721 c stat 3722 c Modified Feb 1975 3723 dimension x(1000),y(1000) 3724 character key*4 3725 character fname*16 3726 double precision xstati 3727 integer istati,stati 3728 equivalence(istati,xstati) 3729 external com_err_ (descriptors), attach (descriptors), detach 3730 1 print 9000 3731 read 1000, key 3732 if((key .eq. "yes") .or. (key .eq. "YES")) go to 2 3733 if((key .eq. "no") .or. (key .eq. "NO")) go to 3 3734 go to 80 3735 2 stati=10 3736 call attach (istati) 3737 if (istati) 3535,4545,3535 3738 3535 call com_err_(istati,"stati","error in attach") 3739 stop 3740 4545 read(stati,1000)n,idelt,(x(k),k=1,n) 3741 1000 format(v) 3742 call detach 3743 go to 4 3744 3 print 9001 3745 read 1000, n,idelt 3746 print 9002 3747 read 1000, (x(k),k=1,n) 3748 4 i = 0 3749 sum=0. 3750 svr=0. 3751 sd2=0. 3752 sd3=0. 3753 sd4=0. 3754 if (n-1) 80,80,6 3755 6 m = n-1 3756 do 8 k=1,n 3757 y(k) = x(k) 3758 8 sum = sum+x(k) 3759 do 24 k=1,m 3760 i=k+1 3761 do 24 j=i,n 3762 if (y(k)-y(j)) 24,24,12 3763 12 str = y(k) 3764 y(k) = y(j) 3765 y(j) = str 3766 24 continue 3767 avg = sum/n 3768 do 28 k=1,n 3769 d1 = (x(k)-avg) 3770 d2 = d1*d1 3771 d3 = d1*d2 3772 d4 = d2*d2 3773 sd2 = sd2+d2 3774 sd3 = sd3+d3 3775 28 sd4 = sd4+d4 3776 uvr = sd2/n 3777 s=sqrt(uvr) 3778 avr = uvr*n/(n-1) 3779 asd=sqrt(avr) 3780 xn=n 3781 skw=sqrt(xn)*sd3/sd2**1.5 3782 xkt = n*sd4/sd2**2 3783 l = n/2+1 3784 xmd = y(l) 3785 rng = y(n)-y(1) 3786 z1=s/sqrt(float(n-1)) 3787 uclv = n*s**2 3788 40 print 9004,n,avg,xmd,rng,uvr,s 3789 print 9005,avr,asd,skw,xkt 3790 print 9006,avg,z1,avg,z1 3791 print 9007,uclv,uclv 3792 z2 = 100./(n+1) 3793 z3=(-8.)*s+avg 3794 print 9008 3795 do 60 k=1,n,idelt 3796 cpr = k*z2 3797 cnm=anpf(z3,y(k),avg,s) 3798 dif = cnm*100.-cpr 3799 60 print 9012,k,x(k),y(k),cpr,cnm,dif 3800 print 9016 3801 go to 1 3802 80 stop 3803 9000 format(///" Is data to be read from a file? (Type yes, no or stop)") 3804 9001 format(/" Type number of data points (n), and the print increment ") 3805 9002 format(/" Type in n data points"/) 3806 9004 format(//15x"DESCRIPTIVE STATISTICS FOR A SINGLE" 3807 & ," SAMPLE"///" Number of observations ",45(1h.),i4,//, 3808 & " Mean = xbr = sum(x(i))/n ",34(1h.),1pe13.6//" Median ", 3809 & 52(1h.)1pe13.6//" Range ",53(1h.)1pe13.6//" Unadjusted ", 3810 & "(biased) variance ="/2x,"sum((x(i)-xbr)**2)/n = uvr ", 3811 & 31(1h.),1pe13.6//" Unadjusted standard deviation = ", 3812 & "sqrt(uvr) = s ",13(1h.),1pe13.6/) 3813 9005 format(" Adjusted (unbiased) variance = uvr*n/(n-1) = avr ", 3814 & 10(1h.)1pe13.6//" Adjusted standard deviation = sqrt(avr) " 3815 & 19(1h.)1pe13.6//" Skewness = sum((x(i)-xbr)**3)/(n*", 3816 & "uvr**1.5) ",16(1h.),1pe13.6//" Kurtosis = ", 3817 & "sum((x(i)-xbr)**4)/(n*uvr**2) ",18(1h.),1pe13.6//) 3818 9006 format(" Upper confidence limit on mean ="/9x,3hxbr,8x, 3819 & 14h+ t(n-1 d.f.)*2x,11hs/sqrt(n-1)/3x,1pe14.6,17x,1pe14.6//, 3820 & " Lower confidence limit on mean ="/9x,3hxbr,8x,9h- t(n-1 d, 3821 & 5h.f.)*,2x,11hs/sqrt(n-1)/3x,1pe14.6,17x,1pe14.6//," Upper confidence limit of variance =") 3822 9007 format(2x,"n*s**2 divided by chi-square", 3823 & " (right"/2x,"tail critical region) with n-1 d.f., ", 3824 & "n*s**2 ",12(1h.),1pe13.6//" Lower confidence limit on ", 3825 & "variance =",/2x,"n*s**2 divided by chi-square (left"/2x, 3826 & "tail critical region) with n-1 d.f., n*s**2 ", 3827 & 12(1h.),1pe13.6) 3828 9008 format(/16x,40(1h*)/, 3829 & /,23x,7hORDERED,7x,10hCUMULATIVE,3x,10hCUMULATIVE/, 3830 & 10x,4hDATA,10x,4hDATA,9x,10hPERCENTAGE,5x,6hNORMAL,4x, 3831 & 10hDIFFERENCE/) 3832 9012 format(i4,1p2e14.6,0pf13.3,2pf13.3,0pf14.4) 3833 9016 format(//) 3834 end Subroutine stat NAMES USED IN THIS PROGRAM UNIT NAME TYPE OF NAME LOC STORAGE ATTRIBUTES AND REFERENCES anpf internal function constant on line 2 real ref 3797 asd 022316 automatic real ref 3779 3789 attach external subroutine 010042 constant with descriptors ref 3729 3736 avg 022306 automatic real ref 3767 3769 3788 3790 3790 3793 3797 avr 022315 automatic real ref 3778 3779 3789 cnm 022332 automatic real ref 3797 3798 3799 com_err_ external subroutine 010040 constant with descriptors ref 3729 3738 cpr 022331 automatic real ref 3796 3798 3799 d1 022307 automatic real ref 3769 3770 3770 3771 d2 022310 automatic real ref 3770 3771 3772 3772 3773 d3 022311 automatic real ref 3771 3774 d4 022312 automatic real ref 3772 3775 detach external subroutine 010044 constant ref 3729 3742 dif 022333 automatic real ref 3798 3799 float builtin double precision ref 3786 i 022275 automatic integer ref 3748 3760 3761 idelt 022273 automatic integer ref 3740 3745 3795 istati 016346 automatic integer equivalenced ref 3727 3728 3736 3737 3738 j 022304 automatic integer ref 3761 3762 3764 3765 k 022274 automatic integer ref 3740 3740 3747 3747 3756 3757 3757 3758 3759 3760 3762 3763 3764 3768 3769 3795 3796 3797 3799 3799 3799 key 022270 automatic character(4) ref 3724 3731 3732 3732 3733 3733 l 022322 automatic integer ref 3783 3784 m 022303 automatic integer ref 3755 3759 n 022272 automatic integer ref 3740 3740 3745 3747 3754 3755 3756 3761 3767 3768 3776 3778 3778 3780 3782 3783 3785 3786 3787 3788 3792 3795 rng 022324 automatic real ref 3785 3788 s 022314 automatic real ref 3777 3786 3787 3788 3793 3797 sd2 022300 automatic real ref 3751 3773 3773 3776 3781 3782 sd3 022301 automatic real ref 3752 3774 3774 3781 sd4 022302 automatic real ref 3753 3775 3775 3782 skw 022320 automatic real ref 3781 3789 sqrt builtin ref 3777 3779 3781 3786 stat entry point constant on line 3720 stati 022271 automatic integer ref 3727 3735 3740 str 022305 automatic real ref 3763 3765 sum 022276 automatic real ref 3749 3758 3758 3767 svr 022277 automatic real ref 3750 uclv 022326 automatic real ref 3787 3791 3791 uvr 022313 automatic real ref 3776 3777 3778 3788 x 016350 automatic real array(1000) ref 3723 3740 3747 3757 3758 3769 3799 xkt 022321 automatic real ref 3782 3789 xmd 022323 automatic real ref 3784 3788 xn 022317 automatic real ref 3780 3781 y 020320 automatic real array(1000) ref 3723 3757 3762 3762 3763 3764 3764 3765 3784 3785 3785 3797 3799 z1 022325 automatic real ref 3786 3790 3790 z2 022327 automatic real ref 3792 3796 z3 022330 automatic real ref 3793 3797 NAMES DECLARED BUT NOT USED fname character(16) declared 3725 xstati 016346 automatic double precision equivalenced declared 3726 3728 LOC LABEL TYPE LINE REFERENCES 044007 1 executable 3730 used in transfer ref 3801 044066 2 executable 3735 used in transfer ref 3732 044172 3 executable 3744 used in transfer ref 3733 044254 4 executable 3748 used in transfer ref 3743 044271 6 executable 3755 used in transfer ref 3754 044302 8 executable 3758 ref 3756 044331 12 executable 3763 used in transfer ref 3762 044341 24 executable 3766 used in transfer ref 3759 3761 3762 3762 044402 28 executable 3775 ref 3768 044524 40 executable 3788 044776 60 executable 3799 ref 3795 045064 80 executable 3802 used in transfer ref 3734 3754 3754 1000 format 3741 ref 3731 3740 3745 3747 044105 3535 executable 3738 used in transfer ref 3737 3737 044131 4545 executable 3740 used in transfer ref 3737 9000 format 3803 ref 3730 9001 format 3804 ref 3744 9002 format 3805 ref 3746 9004 format 3806 ref 3788 9005 format 3813 ref 3789 9006 format 3818 ref 3790 9007 format 3822 ref 3791 9008 format 3828 ref 3794 9012 format 3832 ref 3799 9016 format 3833 ref 3800 LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3720 043766 3730 044007 3731 044016 3732 044035 3733 044051 3734 044065 3735 044066 3736 044070 3737 044102 3738 044105 3739 044127 3740 044131 3742 044163 3743 044171 3744 044172 3745 044201 3746 044225 3747 044234 3748 044254 3749 044255 3750 044257 3751 044260 3752 044261 3753 044262 3754 044264 3755 044271 3756 044273 3757 044277 3758 044302 3759 044311 3760 044315 3761 044320 3762 044323 3763 044331 3764 044334 3765 044337 3766 044341 3767 044351 3768 044355 3769 044361 3770 044365 3771 044367 3772 044371 3773 044374 3774 044377 3775 044402 3776 044411 3777 044415 3778 044422 3779 044434 3780 044441 3781 044444 3782 044463 3783 044473 3784 044477 3785 044501 3786 044505 3787 044515 3788 044524 3789 044574 3790 044632 3791 044670 3792 044714 3793 044722 3794 044727 3795 044736 3796 044745 3797 044751 3798 044773 3799 044776 3800 045054 3801 045063 3802 045064 OBJECT SEGMENT SUMMARY STORAGE REQUIREMENTS FOR THIS PROGRAM Object Text Link Symbol Defs Static Start 0 0 46000 56636 56052 46010 Length 61246 45777 10052 2374 563 10024 Stack frame is 10992 (decimal) words. ENTRY POINT LOC ATTRIBUTES amax 005406 on line 578 ref in colct 609 ref in tmst 872 amin 005443 on line 585 ref in colct 608 ref in tmst 871 ampb1 017312 on line 1581 ampb2 017547 on line 1625 anpf 000232 on line 2 ref in stat 3797 arrvl 013666 on line 1228 ref in events 1219 beta 000374 on line 17 ref in tdist 451 457 colct 005500 on line 593 ref in endsv 1324 1328 corrl2 021107 on line 1773 datan 005621 on line 613 ref in gasp 528 540 drand 007032 on line 693 ref in datan 621 653 ref in arrvl 1237 1253 ref in endsv 1286 1297 1335 eig1 015567 on line 1396 ref in eigsr 1935 eigsr 021565 on line 1837 endsm 015336 on line 1369 ref in events 1223 endsv 014163 on line 1267 ref in events 1221 ref in endsm 1384 errf 001153 on line 106 ref in anpf 9 9 11 11 error 007065 on line 699 ref in gasp 528 561 ref in colct 601 603 ref in datan 621 625 ref in filem 759 763 ref in tmst 863 865 ref in set 953 1111 ref in rmove 1123 1126 ref in arrvl 1247 ref in endsv 1291 1340 ref in endsm 1379 events 013567 on line 1209 ref in gasp 528 550 ezero 026574 on line 2324 ref in lnprog 2269 2274 filem 007576 on line 751 ref in datan 621 665 ref in arrvl 1240 1257 1262 ref in endsv 1289 1300 1307 1312 1318 1338 frat 742233 on line 3542 ref in smlrp 3416 ref in pivot 3617 ref in selpvt 3693 ftion 000723 on line 70 ref in beta 34 ref in gbeta 63 64 gasp 005014 on line 517 ref in gaspsamp 1982 1992 gaspsamp 023030 on line 1971 gbeta 000600 on line 53 ref in beta 23 24 30 33 histo 007735 on line 776 ref in endsv 1325 1329 kilter 023075 on line 1995 koutput 024371 on line 2147 ref in kilter 2142 linefit 001403 on line 145 lineq 001530 on line 166 lnprog 024521 on line 2160 maxflow 026721 on line 2341 mmtinv 032447 on line 2702 ref in mreg1 2627 montr 010061 on line 799 ref in gasp 528 542 562 572 moutput 027615 on line 2449 ref in maxflow 2387 2436 2443 mreg1 030042 on line 2475 mtinv 002410 on line 236 ref in secant 1725 mtmpy 003044 on line 296 orpol1 033050 on line 2749 orpol2 034154 on line 2860 ref in orpol1 2843 otput 015232 on line 1348 ref in gasp 528 556 pivot 742422 on line 3573 ref in smlrp 3437 3445 3452 ref in selpvt 3716 plot 003446 on line 349 print 743067 on line 3632 ref in smlrp 3462 ref in pivot 3625 print2 743364 on line 3663 ref in smlrp 3426 3463 prntq 013073 on line 1141 ref in sumry 884 941 randu 013472 on line 1197 ref in drand 694 695 rkpb1 004415 on line 461 ref in ampb1 1584 1617 rkpb2 004537 on line 481 ref in ampb2 1627 1647 rmove 012740 on line 1115 ref in gasp 528 545 ref in endsv 1296 1334 1344 ref in endsm 1380 rndnrm 004102 on line 422 secant 020164 on line 1690 selpvt 743504 on line 3679 ref in smlrp 3443 3450 set 011556 on line 945 ref in datan 621 662 ref in filem 759 772 ref in rmove 1123 1137 shortest 035055 on line 2945 smlrp 036460 on line 3087 soutput 036002 on line 3046 ref in shortest 2988 3008 3010 3040 stat 743767 on line 3720 sumry 010654 on line 876 ref in gasp 528 555 tdist 004315 on line 445 ref in corrl2 1831 tmst 010527 on line 855 ref in arrvl 1245 1251 ref in endsv 1284 1293 1301 1314 1316 1320 1331 1342 ref in endsm 1386 1387 1388 1389 xmax 013530 on line 1201 ref in set 1015 zj 026646 on line 2334 ref in lnprog 2241 2309 EXTERNAL REFERENCE LOC ATTRIBUTES attach 010042 in gasp ref 528 535 in kilter ref 2006 2018 in lnprog ref 2168 2173 in maxflow ref 2350 2355 in mreg1 ref 2484 2564 in orpol1 ref 2761 2845 in shortest ref 2953 2959 in stat ref 3729 3736 com_err_ 010040 in gasp ref 528 537 in kilter ref 2006 2020 in lnprog ref 2168 2175 in maxflow ref 2350 2357 in mreg1 ref 2484 2566 in orpol1 ref 2761 2847 in shortest ref 2953 2961 in smlrp ref 3095 3130 in stat ref 3729 3738 detach 010044 in gasp ref 528 575 in kilter ref 2006 2143 in lnprog ref 2168 2320 in maxflow ref 2350 2445 in mreg1 ref 2484 2578 in orpol1 ref 2761 2854 in shortest ref 2953 3041 in smlrp ref 3095 3512 in stat ref 3729 3742 exit 010046 in datan ref 621 639 in histo ref 783 787 in sumry ref 884 897 flat 010034 in rndnrm ref 423 423 in randu ref 1198 smlrpattach 010050 in smlrp ref 3095 3128 COMMON BLOCK LOC LENGTH REFERENCES blnk*com 010036 398 declared 519 522 398 declared 595 598 398 declared 615 618 398 declared 701 704 398 declared 753 756 398 declared 777 780 398 declared 801 804 398 declared 857 860 398 declared 878 881 398 declared 947 950 398 declared 1117 1120 398 declared 1143 1146 409 declared 1230 1233 1236 409 declared 1269 1272 1275 409 declared 1350 1353 1356 409 declared 1371 1374 1377 409 declared 1975 1978 1981 601 declared 1998 601 declared 2148 1779 declared 2162 2 declared 2325 1666 declared 2335 1250 declared 2343 1250 declared 2450 785 declared 2753 785 declared 2861 1875 declared 2947 1875 declared 3047 570 declared 3090 3091 3092 3093 3094 566 declared 3543 3544 3545 3546 566 declared 3574 3575 3576 3577 566 declared 3633 3634 3635 3636 570 declared 3664 3665 3666 3667 3668 566 declared 3680 3681 3682 3683 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved