Initial commit

gen/fit_set.f

@@ -0,0 +1,81 @@
+        subroutine FIT_SET(k,uk,wk,a,b)
+c       -------------------------------
+
+	include 'fit.inc'
+
+	integer k
+	real uk, wk, a, b
+
+	if (k .eq. 0) goto 90
+
+	if (k.gt.nu .or. k.le.0) then
+	  write(isyswr,'(4x,a,i3)') 'Illegal parameter no.:',k
+	  return
+	endif
+
+	if (icsw(k) .gt. 0) then
+	  icsw(k)=0
+	elseif (icsw(k) .lt. 0) then
+	  write(isyswr, '(x,4a)') pnam(k), ' not changed (depends on ',
+	1                         pnam(icto(k)),')'
+	  return
+	endif
+
+	u(k)=uk
+	if (wk .gt. 0) werr(k)=wk	  
+	if (wk .eq. 0 .or. ififu .eq. 6 .and. k .gt. 2) then
+	  lcode(k)=-1
+	  if (werr(k) .ne. 0) werrs(k)=werr(k)
+	  werr(k)=0
+	endif
+
+	if (a .ne. 0 .or. b .ne. -1.0) then
+	  call fit_lim(k, a, b)
+	  return
+	endif
+
+90	call extoin
+	call fit_check_range
+        call fnctn(x,amin)	
+	end
+
+
+
+	subroutine FIT_LIM(k, a, b)
+c	---------------------------
+
+	include 'fit.inc'
+
+	integer k
+	real a, b
+
+	if (k.gt.nu .or. k.le.0) then
+	  write(isyswr,'(4x,a,i3)') 'Illegal parameter no.:',k
+	  return
+	endif
+	
+	if (a .lt. b) then
+	  lcode(k)=sign(4, lcode(k))
+	  alim(k)=a
+	  blim(k)=b
+	  if (u(k)-werr(k) .lt. a) then
+	    alim(k)=u(k)-werr(k)
+	    write(isyswr,'(x,2A,f14.5)')
+	1     pnam(k), ': Lower limit changed to ',alim(k)
+	  endif
+	  if (u(k)+werr(k) .gt. b) then
+	    blim(k)=u(k)+werr(k)
+	    write(isyswr,'(x,2A,f14.5)')
+	1     pnam(k), ': Upper limit changed to ',blim(k)
+	  endif
+	elseif (a .eq. 0 .and. b .eq. 0) then
+	  lcode(k)=sign(1, lcode(k))
+	else
+	  write(isyswr,'(x,a,2e10.2)')
+	1   'low limit must be lower than high limit',a,b
+	endif
+
+	call extoin
+	call fit_check_range
+        call fnctn(x,amin)
+  	end