Initial commit

gen/fit_multiply.f

@@ -0,0 +1,138 @@
+	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