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