subroutine central(fi,v,dist,rmsmin,fimin,vmin) common dtr,num,um,konst,coord(350,2,2),xyz(350,3),const(4,100), 1dkeep(350) common /work/ zkeep(350),x(350),y(350),z(350),d(350),filler(13300) 1,crit vmic=v*254.0 sfi=sin(fi*dtr) cfi=cos(fi*dtr) do 16 i=1,num x(i)=(coord(i,1,1)+coord(i,2,1))/(2.0*cfi) y(i)=(coord(i,1,2)+coord(i,2,2))/2.0 del=-(coord(i,2,1)-coord(i,1,1)) z(i)=del/(2.0*sfi) q=1.0/(1.0-(del/(2.0*vmic*sfi))) if(abs(v).gt.45.0) q=1.0 x(i)=x(i)*q y(i)=y(i)*q z(i)=z(i)*q 16 continue sdsq=0.0 sd=0.0 sm=0.0 sn=0.0 jot=0 do 10 k=1,konst i1=const(1,k) i2=const(3,k) j1=abs(const(2,k)) inc=1 if(const(2,k).lt.0.0) inc=-1 stand=const(4,k) stcay1=stand*crit stcay2=stand/(crit*crit) do 17 i=i1,i2 j=j1+(i-i1)*inc if(j.gt.num) go to 17 jot=jot+1 if(dist.gt.0.0) filler(jot)=0.0 dsq=((x(j)-x(i))**2)+((y(j)-y(i))**2)+((z(j)-z(i))**2) p=sqrt(dsq) if(k.eq.1) d(i)=p if(dist.eq.0.0) go to 11 if((dist.lt.0.0).and.(filler(jot).eq.0.0)) go to 17 if((dist.lt.0.0).and.(filler(jot).ne.0.0)) go to 11 r=p*dist if((r.gt.stcay1).or.(r.lt.stcay2)) go to 17 11 sd=sd+p*stand sdsq=sdsq+p*p sm=sm+stand*stand sn=sn+1.0 if(dist.gt.0.0) filler(jot)=1.0 17 continue 10 continue cay=sd/sdsq drms=cay*cay*sdsq-2.0*cay*sd+sm drms=sqrt(drms/sn) write(6,96) fi,v,drms,sn 96 format(1x,f7.3,f8.3,e12.5,f8.0) if(rmsmin.eq.0.0) go to 19 if(drms.gt.rmsmin) return 19 do 20 i=1,num xyz(i,1)=x(i) xyz(i,2)=y(i) xyz(i,3)=z(i) dkeep(i)=d(i) zkeep(i)=z(i) 20 continue dist=cay rmsmin=drms fimin=fi vmin=v return end