Initial commit

gen/fit_rel.f

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