139 lines
2.5 KiB
Forth
139 lines
2.5 KiB
Forth
subroutine fit_multiply(scale,n)
|
|
|
|
implicit none
|
|
|
|
include 'fit.inc'
|
|
|
|
real scale(*)
|
|
integer n
|
|
|
|
integer i,j,m
|
|
|
|
m=max(1,n)
|
|
if (n .eq. 0) then
|
|
do i=nxmin,nxmax
|
|
YVAL(i)=YVAL(i)*scale(1)
|
|
sig(i)=sig(i)*scale(1)
|
|
enddo
|
|
else
|
|
do i=nxmin,nxmax
|
|
j=iset(i)
|
|
if (j .lt. m) then
|
|
YVAL(i)=YVAL(i)*scale(j)
|
|
sig(i)=sig(i)*scale(j)
|
|
endif
|
|
enddo
|
|
endif
|
|
return
|
|
|
|
|
|
entry fit_add(scale, n)
|
|
|
|
m=max(1,n)
|
|
if (n .eq. 0) then
|
|
do i=nxmin,nxmax
|
|
YVAL(i)=YVAL(i)+scale(1)
|
|
enddo
|
|
else
|
|
do i=nxmin,nxmax
|
|
j=iset(i)
|
|
if (j .lt. m) then
|
|
YVAL(i)=YVAL(i)+scale(j)
|
|
endif
|
|
enddo
|
|
endif
|
|
end
|
|
|
|
|
|
subroutine fit_trans(xaxis, lambda)
|
|
|
|
implicit none
|
|
|
|
character xaxis*(*)
|
|
real lambda
|
|
|
|
include 'fit.inc'
|
|
|
|
character ax*1, from*16, to*16
|
|
integer i,l,lt
|
|
real xout, yfact, lam
|
|
|
|
call sym_get_str('XAxis', l, from)
|
|
1 call str_lowcase(ax, from(1:1))
|
|
if (ax .eq. 'q') then
|
|
from='Q'
|
|
l=1
|
|
to='2-theta,d'
|
|
lt=9
|
|
else if (ax .eq. 'd') then
|
|
from='d'
|
|
l=1
|
|
to='2-theta,Q'
|
|
lt=9
|
|
else if (ax .eq. 't' .or. ax .eq. '2') then
|
|
from='2-theta'
|
|
l=7
|
|
to='Q,d'
|
|
lt=3
|
|
else
|
|
print '(X,3A)','axis ',from(1:l),' is unknown'
|
|
print '(X,A,$)','Convert from (Q,d,2-theta): '
|
|
read(*,'(a)',err=9,end=9) from
|
|
call str_trim(from, from, l)
|
|
goto 1
|
|
endif
|
|
|
|
if (xaxis .eq. ' ') then
|
|
ax=to(1:1)
|
|
call sym_get_real('lambda', lam)
|
|
print '(X,3A,$)','Convert from ',from(1:l)
|
|
1 ,' to (',to(1:lt),'): '
|
|
read(*,'(a)',err=9,end=9) to
|
|
call str_trim(to, to, lt)
|
|
if (to .eq. ' ') then
|
|
to=ax
|
|
endif
|
|
if (lam .eq. 0) lam=lambda
|
|
if (lam .eq. 0) then
|
|
print '(X,A,$)','lambda: '
|
|
else
|
|
print '(X,A,f8.3,A,$)','lambda [',lam,']: '
|
|
endif
|
|
read(*,'(f40.0)',err=9,end=9) lam
|
|
if (lam .eq. 0) then
|
|
call sym_get_real('lambda', lam)
|
|
else
|
|
call sym_put_real('lambda', lam)
|
|
endif
|
|
else
|
|
if (lambda .ne. 0) then
|
|
lam=lambda
|
|
call sym_put_real('lambda', lam)
|
|
else
|
|
call sym_get_real('lambda', lam)
|
|
endif
|
|
to=xaxis
|
|
endif
|
|
call str_lowcase(ax, to(1:1))
|
|
if (ax .eq. 'q') then
|
|
to='Q'
|
|
else if (ax .eq. 'd') then
|
|
to='d'
|
|
else if (ax .eq. 't' .or. ax .eq. '2') then
|
|
to='2-theta'
|
|
else
|
|
call str_trim(to, to, lt)
|
|
print '(X,3A)','axis ',to(1:lt),' is unknown'
|
|
return
|
|
endif
|
|
call dat_powder_init(lam, from, to)
|
|
if (to .eq. ' ') RETURN
|
|
if (xaxis .ne. ' ')
|
|
1 print '(X,4A)','Convert from ',from(1:l),' to ',to
|
|
call sym_put_str('XAxis', to)
|
|
do i=nxmin,nxmax
|
|
call dat_powder_trf(xval(i), xout, yfact)
|
|
xval(i)=xout
|
|
enddo
|
|
9 end
|