145 lines
3.0 KiB
Fortran
145 lines
3.0 KiB
Fortran
subroutine dat_fit3
|
|
c -------------------
|
|
|
|
external dat_fit3_desc
|
|
external dat_fit3_read
|
|
|
|
external handler
|
|
|
|
integer dtype/0/
|
|
|
|
call dat_init_desc(dtype, dat_fit3_desc)
|
|
call dat_init_read(dtype, dat_fit3_read)
|
|
return
|
|
|
|
entry dat_fit3_replace(handler)
|
|
call dat_init_read(dtype, handler)
|
|
end
|
|
|
|
|
|
subroutine dat_fit3_desc(text)
|
|
! ------------------------------
|
|
character*(*) text ! (out) description
|
|
|
|
! type description
|
|
! ----------------------------------
|
|
text='FIT3 Fit data file'
|
|
end
|
|
|
|
|
|
subroutine dat_fit3_read
|
|
1 (lun, forced, nread, putval, nmax, xx, yy, ss, ww)
|
|
! ----------------------------------------------------
|
|
implicit none
|
|
|
|
integer lun ! (in) logical unit number (file will be closed if successful)
|
|
integer forced ! 0: read only if type is sure; 1: forced read
|
|
integer nread ! (out) >=0: = number of points read, file closed
|
|
! -1: not correct type, file rewinded
|
|
! -2: correct type, but unreadable, file rewinded
|
|
external putval ! (in) subroutine to put name/value pairs.
|
|
! for numeric data: call putval('name', value) ! value must be real
|
|
! for character data: call putval('name=text', 0.0)
|
|
integer nmax ! max. number of points
|
|
real xx(*) ! x-values
|
|
real yy(*) ! y-values
|
|
real ss(*) ! sigma
|
|
real ww(*) ! weights (original monitor)
|
|
|
|
! local
|
|
integer n,nu0,i,j,ififu0
|
|
real ymon0
|
|
character line*132
|
|
external dat_fit3_val
|
|
real y, s
|
|
|
|
|
|
read(lun, '(A)',err=100,end=100) line
|
|
|
|
if (line(1:8) .ne. 'FitSave ' .or. line(9:11) .lt. '3.3') goto 100
|
|
|
|
if (line(9:11) .lt. '3.4') then
|
|
read(lun,*,err=100,end=100) ! filename
|
|
endif
|
|
nu0=0
|
|
read(lun, *, err=99,end=99) nu0,ififu0
|
|
do i=1,nu0
|
|
read(lun,*,err=99,end=99)
|
|
enddo
|
|
if (ififu0 .eq. 7) read(lun,*,err=99,end=99)
|
|
|
|
if (line(9:11) .lt. '3.4') then
|
|
|
|
n=0
|
|
ymon0=0
|
|
read(lun, *, err=99,end=99) n,ymon0
|
|
if (ymon0 .le. 0) ymon0=1
|
|
call putval('Monitor', ymon0)
|
|
|
|
else
|
|
|
|
call dat_delimiters(';', '=', '''')
|
|
|
|
10 read(lun, '(a)', err=99,end=99) line
|
|
call str_trim(line, line, i)
|
|
if (line(1:i) .eq. ' ') goto 19
|
|
j=1
|
|
11 if (line(j:j) .eq. ' ') then
|
|
j=j+1
|
|
goto 11
|
|
endif
|
|
call dat_group(j-1, putval)
|
|
call dat_intprt(line(j:i), dat_fit3_val, putval)
|
|
goto 10
|
|
19 continue
|
|
|
|
endif
|
|
|
|
i=0
|
|
20 i=i+1
|
|
if (i .gt. nmax) then
|
|
print *,'too many data points --> truncated'
|
|
goto 29
|
|
endif
|
|
read(lun,'(a)',err=99,end=29) line
|
|
j=index(line,'/') ! for compatibility with versions 3.3 and older
|
|
if (j .gt. 0) line(j:)=' ' ! "
|
|
! read(line,'(bn,4f20.0,i20)') xx(i),y,s,ww(i),j
|
|
read(line,*,err=99,end=99) xx(i),y,s,ww(i),j
|
|
ss(i)=s
|
|
yy(i)=y
|
|
nread=i
|
|
goto 20
|
|
|
|
29 close(lun)
|
|
return
|
|
|
|
99 print *,'error in FitSave file'
|
|
nread=-2
|
|
rewind lun
|
|
return
|
|
|
|
100 nread=-1
|
|
rewind lun
|
|
end
|
|
|
|
|
|
subroutine dat_fit3_val(str, val, putval)
|
|
|
|
character*(*) str
|
|
real val
|
|
external putval
|
|
|
|
integer i
|
|
|
|
if (val .eq. 0) then
|
|
i=index(str, '=')
|
|
else
|
|
i=0
|
|
endif
|
|
if (i .gt. 1) then
|
|
if (str(1:i-1) .eq. 'File') return
|
|
endif
|
|
call putval(str, val)
|
|
end
|