Initial commit

gen/dat_inx.f

@@ -0,0 +1,138 @@
+	subroutine dat_inx
+c	------------------
+
+	external dat_inx_desc
+	external dat_inx_opts
+	external dat_inx_read
+
+	integer dtype/0/
+
+	call dat_init_desc(dtype, dat_inx_desc)
+	call dat_init_opts(dtype, dat_inx_opts)
+	call dat_init_read(dtype, dat_inx_read)
+	end
+
+
+	subroutine dat_inx_desc(text)
+!	-----------------------------
+	character*(*) text  ! (out) description
+
+!             type    description
+!             ----------------------------------
+	text='INX     INX output files'
+	end
+
+
+	subroutine dat_inx_opts
+!	-----------------------
+	print '(x,a)'
+	1,'from,to: dataset range'
+	end
+
+
+	subroutine dat_inx_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 i, n, i1, i2, j, idx
+	integer nlines, nzone(6)
+	real angle, einc, qinc, temp, dTau, x, y, s
+	character line*132
+
+
+	read(lun, '(8i5)', err=100,end=100) nlines, nzone, nread
+	n=0
+	do i=1,5
+	  n=n+nzone(i)
+	enddo
+	if (nzone(1) .ne. 1 .or. nzone(2) .ne. 2
+	1 .or. n .ne. nlines-nread) then
+	  if (forced .le. 0) goto 100
+	endif
+
+	call dat_start_options
+	i1=1
+	call dat_int_option('from', i1)
+	i2=i1
+	call dat_int_option('to', i2)
+
+	call dat_get_index(idx)
+
+	if (idx .eq. 0) then
+	  if (i2 .gt. i1) then
+	    print *,'for INX files only one dataset allowed'
+	  endif
+	else
+	  i1=i1+idx-1
+	  if (i1 .gt. i1) goto 98
+	endif
+
+	write(line(1:3), '(i3)') i1
+	call putval('Range='//line(1:3),0.0)
+	do i=1,i1-1
+	  do j=1,nlines
+	    read(lun,*,err=99,end=99)
+	  enddo
+	  read(lun, '(8i5)', err=99,end=99) nlines, nzone, nread
+	enddo
+
+	read(lun, '(a)', err=99,end=99) line
+	call putval('Title='//line,0.0)
+	read(lun, '(f7.0,2f8.0,f9.0,f6.0)', err=99,end=99)
+	1 angle, einc, qinc, temp
+	call putval('two_theta', angle)
+	call putval('Ei', einc)
+	call putval('Temp', temp)
+	read(lun, '(24x,f8.0)', err=99,end=99) dTau
+	call putval('dTau', dTau)
+
+	n=nlines-nread-3
+	do i=1,n
+	  read(lun,*,err=99,end=99)
+	enddo
+	j=0
+	do i=1,nread
+	  read(lun, *, err=20,end=29) x,y,s
+	  if (s .gt. 0.0) then
+	    if (j .ge. nmax) then
+	      print *,'DAT_INX: too many data points, truncated'
+	      goto 29
+	    endif
+	    j=j+1
+	    ww(j)=1.0
+	    ss(j)=s
+	    yy(j)=y
+	    xx(j)=x
+	  endif
+20	  continue
+	enddo
+29	nread=j	
+
+	call putval('Monitor', 0.0)
+	close(lun)
+	return
+
+99	print *,'DAT_INX: error during read'
+98	nread=-2
+	rewind lun
+	return
+
+100	nread=-1
+	rewind lun
+	end