68 lines
1.6 KiB
Fortran
68 lines
1.6 KiB
Fortran
subroutine FIT_REL(K0)
|
|
C ----------------------
|
|
include 'fit.inc'
|
|
|
|
integer k0
|
|
logical done
|
|
integer n1,n2,k,i
|
|
|
|
C-- K0 = NUMBER OF PARAMETER TO BE RELEASED
|
|
C-- K0 = 0 MEANS RELEASE ALL PARAMETERS
|
|
|
|
if (k0 .eq. 0) then
|
|
n1=1
|
|
n2=nu
|
|
elseif (k0 .le. 0 .or. k0 .gt. nu) then
|
|
write(isyswr,'(4X,A,I3)') 'Illegal parameter no.:',k0
|
|
return
|
|
elseif (ififu .eq. 6 .and. k0 .gt. 2) then
|
|
write(isyswr,'(4X,A,I3)') 'Can not release this parameter'
|
|
return
|
|
else
|
|
n1=k0
|
|
n2=k0
|
|
endif
|
|
|
|
write(isyswr,*)
|
|
|
|
done=.false.
|
|
do k=n1,n2
|
|
if (lcode(k) .le. 0) then
|
|
if (icsw(k) .lt. 0) then ! special correlation
|
|
if (k0 .ne. 0) then
|
|
i=icto(k)
|
|
icsw(i)=-1 ! cor. parameter i
|
|
icto(i)=k
|
|
if (lcode(i) .gt. 0) lcode(i)=-lcode(i)
|
|
write(isyswr,'(4X,3A)') pnam(i),' depends now on ',pnam(k)
|
|
lcode(k)=-lcode(k)
|
|
if (lcode(k) .eq. 0) lcode(k)=1
|
|
if (icsw(k) .lt. 0) icsw(k)=0
|
|
endif
|
|
else
|
|
if (icsw(k) .eq. 0) then
|
|
write(isyswr,'(4X,2A)') pnam(k),' released'
|
|
else
|
|
write(isyswr,'(4X,2A)') pnam(k)
|
|
1 ,' released from correlation'
|
|
icsw(k)=0
|
|
endif
|
|
lcode(k)=-lcode(k)
|
|
if (lcode(k) .eq. 0) lcode(k)=1
|
|
done=.true.
|
|
endif
|
|
if (ififu .eq. 1 .and. u(k) .eq. 0) then
|
|
if (mod(k,5) .eq. 1) then
|
|
u(k)=u(k+1)/10
|
|
elseif( mod(k,5) .eq. 2) then
|
|
u(k)=u(k-1)/10
|
|
endif
|
|
endif
|
|
elseif (k0 .ne. 0) then
|
|
write(isyswr,'(4x,2a)') pnam(k)
|
|
1 ,' is not fixed or correlated'
|
|
endif
|
|
enddo
|
|
call extoin
|
|
end
|