Initial commit

gen/dat_fit3.f

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