93 lines
1.7 KiB
Fortran
93 lines
1.7 KiB
Fortran
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
|