235 lines
4.0 KiB
Fortran
235 lines
4.0 KiB
Fortran
subroutine fit_auto
|
|
|
|
implicit none
|
|
|
|
include 'fit.inc'
|
|
|
|
call fit_findauto
|
|
call fit_set(0,0.0,0.0,0.0,0.0)
|
|
end
|
|
|
|
|
|
|
|
subroutine fit_findauto
|
|
|
|
implicit none
|
|
|
|
include 'fit.inc'
|
|
|
|
real wid, ewid, u5, yk, yk1, yk2, xk1, xk2, xd
|
|
character str*32
|
|
integer l,i,k
|
|
|
|
real voigt
|
|
|
|
l=0
|
|
|
|
if (lcode(3) .eq. 0) then
|
|
xd = 1.0e37
|
|
yk = 0
|
|
do i=nxmin,nxmax ! find neareset x-value
|
|
if (abs(xval(i)-u(3)) .lt. xd) then
|
|
xd=abs(xval(i)-u(3))
|
|
yk = YVAL(i)
|
|
k = i
|
|
endif
|
|
enddo
|
|
else
|
|
yk = 0.
|
|
k = (nxmin + nxmax) / 2 ! initialize k for bad cases
|
|
do i=nxmin,nxmax ! find max. intensity
|
|
if (YVAL(i) .gt. yk) then
|
|
yk = YVAL(i)
|
|
k = i
|
|
endif
|
|
enddo
|
|
endif
|
|
if (yk .le. 0) then
|
|
yk=1.0
|
|
endif
|
|
yk1 = yk
|
|
xk1=nxmin
|
|
do i=nxmin,k ! find min. int. left
|
|
if (YVAL(i) .ne. 0. .and. YVAL(i) .lt. yk1) then
|
|
yk1 = YVAL(i)
|
|
xk1 = xval(i)
|
|
endif
|
|
enddo
|
|
yk2 = yk
|
|
xk2=nxmax
|
|
do i=k,nxmax ! find min. int. right
|
|
if (YVAL(i) .ne. 0. .and. YVAL(i) .lt. yk2) then
|
|
yk2 = YVAL(i)
|
|
xk2 = xval(i)
|
|
endif
|
|
enddo
|
|
if (lcode(2) .le. 0 .and. u(2) .eq. 0) then ! background horizontal
|
|
if (lcode(1) .gt. 0) then ! Bgr .not. fixed
|
|
u(1)=(yk1+yk2)/2
|
|
werr(1) = max(1e-5,yk2/100,yk1/100,u(1)/10)
|
|
l=l+4
|
|
str(l-3:l)=psho(1)
|
|
endif
|
|
else
|
|
if (lcode(2) .gt. 0) then ! dBg/dX not fixed
|
|
u(2) = (yk2-yk1)/(xk2-xk1)
|
|
werr(2) = max(1e-5,abs((yk2+yk2)/(xk2-xk1))/100.,abs(u(2)/10))
|
|
l=l+4
|
|
str(l-3:l)=psho(2)
|
|
endif
|
|
if (lcode(1) .gt. 0) then ! Bgr. not fixed
|
|
u(1) = yk1+(xval(k)-xk1)*u(2)
|
|
werr(1) = max(1e-5,yk2/100,yk1/100,u(1)/10)
|
|
l=l+4
|
|
str(l-3:l)=psho(1)
|
|
endif
|
|
endif
|
|
|
|
u5=u(5)
|
|
u(5)=0.0
|
|
call fit_findhw(k, xval(k), wid, ewid)
|
|
u(5)=u5
|
|
|
|
if (lcode(3) .gt. 0) then
|
|
u(3)=xval(k)
|
|
werr(3)=ewid
|
|
l=l+4
|
|
str(l-3:l)=psho(3)
|
|
endif
|
|
|
|
if (lcode(7) .gt. 0) then
|
|
if (lcode(6) .gt. 0) then
|
|
u(6)=wid/10.
|
|
werr(6)=ewid
|
|
l=l+4
|
|
str(l-3:l)=psho(6)
|
|
endif
|
|
u(7)=wid
|
|
werr(7)=ewid
|
|
l=l+4
|
|
str(l-3:l)=psho(7)
|
|
elseif (lcode(6) .gt. 0) then
|
|
u(6)=wid
|
|
werr(6)=ewid
|
|
l=l+4
|
|
str(l-3:l)=psho(6)
|
|
endif
|
|
|
|
if (lcode(4) .gt. 0) then
|
|
u(4) = yk-u(1)
|
|
werr(4) = max(1e-5, abs(sig(k)))
|
|
l=l+4
|
|
str(l-3:l)=psho(4)
|
|
elseif (lcode(5) .gt. 0) then
|
|
u(4) = yk-u(1)
|
|
werr(4) = max(1e-5, abs(sig(k)))
|
|
yk=voigt(0.0,u(6),u(7))
|
|
u(5)=u(4)/yk
|
|
werr(5)=werr(4)/yk
|
|
l=l+4
|
|
str(l-3:l)=psho(5)
|
|
endif
|
|
|
|
if (l .gt. 0 .and. isyswr .ne. 0) then
|
|
write(isyswr,'(x,2a)') 'Auto parameters: ',str(1:l)
|
|
endif
|
|
end
|
|
|
|
|
|
|
|
subroutine fit_findhw(ipos, pos, hw, hwe)
|
|
|
|
implicit none
|
|
|
|
include 'fit.inc'
|
|
|
|
integer ipos
|
|
real pos, hw, hwe
|
|
|
|
real tm,t0,t,d,dd,x1,x2,halfmax
|
|
integer m,i,i1,i2
|
|
|
|
real fifun ! function
|
|
|
|
if (ipos .eq. 0) then
|
|
|
|
! find nearest point to pos
|
|
m=nxmin
|
|
d=abs(xval(nxmin)-pos)
|
|
do i=nxmin,nxmax
|
|
dd=abs(xval(i)-pos)
|
|
if (dd .lt. d) then
|
|
m=i
|
|
d=dd
|
|
endif
|
|
enddo
|
|
|
|
else
|
|
|
|
m=ipos
|
|
|
|
endif
|
|
|
|
if (nu .eq. 2) then
|
|
u(3)=pos
|
|
nu=3 ! fifun won't use u(3) if nu=2 (workaround)
|
|
endif
|
|
|
|
! find points > half height left
|
|
|
|
1 tm=(YVAL(m)-fifun(xval(m)))
|
|
t0=tm
|
|
halfmax=t0/2
|
|
do i=m-1,nxmin,-1
|
|
t=YVAL(i)-fifun(xval(i))
|
|
if (t .gt. tm) then ! pos was not good
|
|
m=i
|
|
goto 1
|
|
endif
|
|
if (t .le. halfmax) then
|
|
i1=i
|
|
if (t0-t .eq. 0.0) then
|
|
d=0
|
|
else
|
|
d=(xval(i1+1)-xval(i1))/(t0-t)
|
|
endif
|
|
goto 2
|
|
endif
|
|
t0=t
|
|
enddo
|
|
i1=nxmin
|
|
d=0
|
|
2 x1=xval(i1)+(halfmax-t)*d
|
|
|
|
! find points > half height right
|
|
|
|
t0=tm
|
|
do i=m+1,nxmax
|
|
t=YVAL(i)-fifun(xval(i))
|
|
if (t .gt. tm) then ! pos was not good
|
|
m=i
|
|
goto 1
|
|
endif
|
|
if (t .le. halfmax) then
|
|
i2=i
|
|
if (t0 - t0 .eq. 0) then
|
|
d=0
|
|
else
|
|
d=(xval(i2)-xval(i2-1))/(t0-t)
|
|
endif
|
|
goto 3
|
|
endif
|
|
t0=t
|
|
enddo
|
|
i2=nxmax
|
|
d=0
|
|
3 x2=xval(i2)-(halfmax-t)*d
|
|
if (x2 - x1 .eq. 0.0) then
|
|
x2=xval(nxmax)
|
|
x1=xval(nxmin)
|
|
endif
|
|
hw=max(abs(xval(min(m+1,nxmax))-xval(max(1,m-1)))/2,abs(x2-x1))
|
|
hwe=hw*0.1
|
|
if (nu .eq. 3) nu=2 ! put back fifun
|
|
end
|