Files
fit/gen/fit_set.f
2022-08-19 15:22:33 +02:00

82 lines
1.6 KiB
Fortran

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