Initial commit

gen/fit_array.f

@@ -0,0 +1,92 @@
+	subroutine fit_get_array(name, array, maxn, retn)
+
+	character name*(*)
+	integer maxn, retn
+	real array(maxn)
+
+	include 'fit.inc'
+
+	integer m, l
+	character nam*16
+
+	m=maxn
+	call str_upcase(nam, name)
+	call str_trim(nam, nam, l)
+	goto (1,98,2,98,3,98,4,98,5,98,6) index('P E X Y S W ',nam(1:l+1))
+98	retn=0
+
+1	if (ni .lt. 0) call fit_print(2) ! recalc exp.int
+	call fit_cop_array0(u, nu+ni, array, m)
+	goto 99
+
+2	if (ni .lt. 0) call fit_print(2) ! recalc exp.int
+	call fit_cop_array0(werr, nu+ni, array, m)
+	goto 99
+
+3	call fit_cop_array0(xval(nxmin), nxmax-nxmin+1, array, m)
+	goto 99
+
+4	call fit_cop_array0(YVAL(nxmin), nxmax-nxmin+1, array, m)
+	goto 99
+
+5	call fit_cop_array0(sig(nxmin), nxmax-nxmin+1, array, m)
+	goto 99
+
+6	call fit_cop_array0(rmon(nxmin), nxmax-nxmin+1, array, m)
+	goto 99
+
+99	retn=m
+	end
+
+
+	subroutine fit_put_array(name, array, maxn)
+
+	character name*(*)
+	integer maxn
+	real array(maxn)
+
+	include 'fit.inc'
+
+	integer m, l
+	character nam*16
+
+	m=nxmax-nxmin+1
+	if (maxn .ne. m)
+	1 stop 'FIT_PUT_ARRAY: array length must not change'
+	
+	call str_upcase(nam, name)
+	call str_trim(nam, nam, l)
+	goto (1,98,2,98,3,98,4,98,5,98,6) index('P E X Y S W ',nam(1:l+1))
+98	stop 'FIT_PUT_ARRAY: illegal array name'
+
+1	stop 'FIT_PUT_ARRAY: array P not allowed, use FIT_SET'
+
+2	stop 'FIT_PUT_ARRAY: array E not allowed, use FIT_SET'
+
+3	call fit_cop_array0(array, maxn, xval(nxmin), m)
+	goto 99
+
+4	call fit_cop_array0(array, maxn, YVAL(nxmin), m)
+	goto 99
+
+5	call fit_cop_array0(array, maxn, sig(nxmin), m)
+	goto 99
+
+6	call fit_cop_array0(array, maxn, rmon(nxmin), m)
+	goto 99
+
+99	end
+
+
+	subroutine fit_cop_array0(src, nsrc, array, maxn)
+
+	integer maxn, nsrc
+	real array(maxn), src(nsrc)
+
+	integer i
+
+	do i=1,min(maxn, nsrc)
+	  array(i)=src(i)
+	enddo
+	maxn=nsrc
+	end