subroutine refine(kr) dimension a(20,20),b(20),c(20),s(100,2) integer t common dtr,num,um,konst,coord(350,2,2),xyz(350,3),const(4,100), 1dkeep(350) common /work/ zobs(350),trix(35,20,20),rhs(35,20),crit w=1.0 max=(num+9)/10 kop1=konst+1 do 31 k=1,kop1 s(k,1)=0.0 s(k,2)=0.0 31 continue do 13 m=1,35 do 14 i=1,20 rhs(m,i)=0.0 do 15 j=1,20 trix(m,i,j)=0.0 15 continue 14 continue 13 continue 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 dobs=const(4,k) do 11 i=i1,i2 j=j1+(i-i1)*inc if(j.gt.num) go to 11 dsq=0.0 do 12 l=1,3 dsq=dsq+(xyz(i,l)-xyz(j,l))**2 12 continue dcalc=sqrt(dsq) s(k,1)=s(k,1)+(dobs-dcalc)**2 s(k,2)=s(k,2)+1.0 diff=xyz(i,kr)-xyz(j,kr) dzi=diff/dcalc dzj=-diff/dcalc m=(i+9)/10 n=m-1 im=i-(m-1)*10 in=i-(n-1)*10 jm=j-(m-1)*10 jn=j-(n-1)*10 if((jm.gt.20).or.(jm.lt.1)) m=0 if((jn.gt.20).or.(jn.lt.1)) n=0 if(m.eq.0) go to 19 trix(m,im,im)=trix(m,im,im)+dzi*dzi trix(m,im,jm)=trix(m,im,jm)+dzi*dzj trix(m,jm,im)=trix(m,jm,im)+dzj*dzi trix(m,jm,jm)=trix(m,jm,jm)+dzj*dzj rhs(m,im)=rhs(m,im)+(dobs-dcalc)*dzi rhs(m,jm)=rhs(m,jm)+(dobs-dcalc)*dzj 19 if(n.eq.0) go to 11 trix(n,in,in)=trix(n,in,in)+dzi*dzi trix(n,in,jn)=trix(n,in,jn)+dzi*dzj trix(n,jn,in)=trix(n,jn,in)+dzj*dzi trix(n,jn,jn)=trix(n,jn,jn)+dzj*dzj rhs(n,in)=rhs(n,in)+(dobs-dcalc)*dzi rhs(n,jn)=rhs(n,jn)+(dobs-dcalc)*dzj 11 continue 10 continue if(w.eq.0) go to 17 do 18 i=1,num dobs=zobs(i) dcalc=xyz(i,kr) s(kop1,1)=s(kop1,1)+(dobs-dcalc)**2 s(kop1,2)=s(kop1,2)+1.0 m=(i+9)/10 n=m-1 im=i-(m-1)*10 in=i-(n-1)*10 trix(m,im,im)=trix(m,im,im)+w*w rhs(m,im)=rhs(m,im)+w*(dobs-dcalc) if(n.eq.0) go to 18 trix(n,in,in)=trix(n,in,in)+w*w rhs(n,in)=rhs(n,in)+w*(dobs-dcalc) 18 continue c c end routine c 17 write(6,96) 96 format(///' shifts') do 20 i=1,num,10 m=(i+9)/10 k=i+19 if(k.gt.num) k=num do 21 i1=i,k l1=i1-i+1 do 22 j1=i,k l2=j1-i+1 a(l1,l2)=trix(m,l1,l2) 22 continue b(l1)=rhs(m,l1) 21 continue n=k-i+1 call lineq1(a,b,c,20,n,1,t) write(6,99) i,(c(ii),ii=1,n) 99 format(1x,i4,3x,20f5.1) k=i+9 if(k.gt.num) k=num do 23 j=i,k l=j-i+1 xyz(j,kr)=xyz(j,kr)+c(l) 23 continue 20 continue write(6,97) 97 format(///' constraint rms(a.) num') do 32 k=1,kop1 if(s(k,2).eq.0) go to 33 s(k,1)=sqrt(s(k,1)/s(k,2)) 33 write(6,98) k,s(k,1),s(k,2) 98 format(1x,i10,f9.2,f5.0) 32 continue do 39 i=1,num j=i+1 if(j.gt.num) go to 39 dsq=0.0 do 38 l=1,3 dsq=dsq+(xyz(i,l)-xyz(j,l))**2 38 continue dkeep(i)=sqrt(dsq) 39 continue return end