136 lines
3.5 KiB
Fortran
136 lines
3.5 KiB
Fortran
subroutine svdfit(x,y,z,sig,ndata,a,ma,u,v,w,mp,np,chisq)
|
|
implicit real*8 (a-h,o-z)
|
|
parameter(nmax=327680,mmax=10,tol=1.e-12)
|
|
dimension x(ndata),y(ndata),z(ndata),sig(ndata),a(ma),v(np,np),
|
|
* u(mp,np),w(np),b(nmax),afunc(mmax)
|
|
c type *,'evaluating basis functions...'
|
|
do 12 i=1,ndata
|
|
call funcs(x(i),y(i),afunc,ma)
|
|
tmp=1./sig(i)
|
|
do 11 j=1,ma
|
|
u(i,j)=afunc(j)*tmp
|
|
11 continue
|
|
b(i)=z(i)*tmp
|
|
12 continue
|
|
c type *,'SVD...'
|
|
call svdcmp(u,ndata,ma,mp,np,w,v)
|
|
wmax=0.
|
|
do 13 j=1,ma
|
|
if(w(j).gt.wmax)wmax=w(j)
|
|
13 continue
|
|
thresh=tol*wmax
|
|
c type *,'eigen value threshold',thresh
|
|
do 14 j=1,ma
|
|
c type *,j,w(j)
|
|
if(w(j).lt.thresh)w(j)=0.
|
|
14 continue
|
|
c type *,'calculating coefficients...'
|
|
call svbksb(u,w,v,ndata,ma,mp,np,b,a)
|
|
chisq=0.
|
|
c type *,'evaluating chi square...'
|
|
do 16 i=1,ndata
|
|
call funcs(x(i),y(i),afunc,ma)
|
|
sum=0.
|
|
do 15 j=1,ma
|
|
sum=sum+a(j)*afunc(j)
|
|
15 continue
|
|
chisq=chisq+((z(i)-sum)/sig(i))**2
|
|
16 continue
|
|
return
|
|
end
|
|
|
|
|
|
subroutine doppler(n_ra,l1,l2,image1,f_d,dbuf)
|
|
|
|
implicit none
|
|
integer n_ra
|
|
complex*8 image1(N_RA,*)
|
|
integer*4 ia,ir,i,j,jj,l1,l2
|
|
real*4 wgth
|
|
real*4 f_est
|
|
real*4 f_d(N_RA)
|
|
real*4 pi
|
|
complex*8 dbuf(N_RA)
|
|
integer*4 rinc
|
|
data pi /3.141592653/
|
|
|
|
write(6,*) ' '
|
|
write(6,*) ' doppler estimation as a function of range :'
|
|
|
|
rinc = nint(float(n_ra)/n_ra)
|
|
|
|
cc Doppler estimation
|
|
|
|
do i = 1,n_ra
|
|
dbuf(i) = (0.0,0.0)
|
|
enddo
|
|
do ia=l1+1,l2-1
|
|
c wgth = abs(sin(pi*ia/float(2*(l2-l1))))
|
|
wgth = 1.0
|
|
do ir = rinc+2,n_ra-2,rinc
|
|
jj = ir/rinc
|
|
do j = ir-rinc+1-2,ir-rinc+1+2
|
|
dbuf(jj) = dbuf(jj)
|
|
2 + wgth*image1(j,ia)*conjg(image1(j,ia-1))
|
|
enddo ! j-loop
|
|
enddo ! ir-loop
|
|
enddo ! ia-loop
|
|
|
|
c Doppler ambiguity resolution
|
|
|
|
do jj = rinc+2,n_ra-2
|
|
c bjs 8/8/2005
|
|
c atan2d is not a standard intrinsic function
|
|
c and is not currently suppored by gnufortran
|
|
c so changed to sued atan2() standard intrinsic
|
|
c f_est = atan2d(aimag(dbuf(jj)),real(dbuf(jj)))/360.
|
|
f_est = atan2(aimag(dbuf(jj)),real(dbuf(jj)))/(2.*3.14159265358979323846)
|
|
if(jj .ne. rinc+2)then
|
|
if(abs(f_est-f_d(jj-1)) .gt. .5)then
|
|
f_est = f_est + sign(1.0,f_d(jj-1)-f_est)
|
|
endif
|
|
endif
|
|
f_d(jj)= f_est
|
|
end do
|
|
f_d(1) = f_d(3)
|
|
f_d(2) = f_d(3)
|
|
f_d(n_ra-1) = f_d(n_ra-2)
|
|
f_d(n_ra) = f_d(n_ra-2)
|
|
|
|
return
|
|
end
|
|
|
|
subroutine covsrt(covar,ncvm,ma,lista,mfit)
|
|
implicit real*8 (a-h,o-z)
|
|
dimension covar(ncvm,ncvm),lista(mfit)
|
|
do 12 j=1,ma-1
|
|
do 11 i=j+1,ma
|
|
covar(i,j)=0.
|
|
11 continue
|
|
12 continue
|
|
do 14 i=1,mfit-1
|
|
do 13 j=i+1,mfit
|
|
if(lista(j).gt.lista(i)) then
|
|
covar(lista(j),lista(i))=covar(i,j)
|
|
else
|
|
covar(lista(i),lista(j))=covar(i,j)
|
|
endif
|
|
13 continue
|
|
14 continue
|
|
swap=covar(1,1)
|
|
do 15 j=1,ma
|
|
covar(1,j)=covar(j,j)
|
|
covar(j,j)=0.
|
|
15 continue
|
|
covar(lista(1),lista(1))=swap
|
|
do 16 j=2,mfit
|
|
covar(lista(j),lista(j))=covar(1,j)
|
|
16 continue
|
|
do 18 j=2,ma
|
|
do 17 i=1,j-1
|
|
covar(i,j)=covar(j,i)
|
|
17 continue
|
|
18 continue
|
|
return
|
|
end
|