Initial commit
This commit is contained in:
234
gen/fit_auto.f
Normal file
234
gen/fit_auto.f
Normal file
@ -0,0 +1,234 @@
|
||||
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
|
||||
Reference in New Issue
Block a user