Initial commit

gen/dat_d1a.f

@@ -0,0 +1,118 @@
+	subroutine dat_d1a
+c	-------------------
+
+	external dat_d1a_desc
+	external dat_d1a_read
+
+	integer dtype/0/
+
+	call dat_init_desc(dtype, dat_d1a_desc)
+	call dat_init_read(dtype, dat_d1a_read)
+	end
+
+
+	subroutine dat_d1a_desc(text)
+!	-----------------------------
+	character*(*) text  ! (out) description
+
+!             type    description
+!             ----------------------------------
+	text='D1A     ILL D1A6 data format'
+	end
+
+
+	subroutine dat_d1a_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
+	character line*132, title*80
+	integer j,i,ndet,l
+	integer ival(2,10)
+	real temp, xstep, thmin, ymon
+
+	nread=0
+	xstep=0
+	ymon=0
+
+	read(lun,'(a)',err=900,end=900) line
+
+	if (line(1:4) .ne. 'D1A6') then
+	  rewind lun
+	  goto 900
+	endif
+	
+	call dat_start_options
+
+	call dat_group(1, putval)
+
+	title=line(6:)
+        read(lun,'(16x,f8.0,i8)', err=901,end=901) xstep, ndet
+        read(lun,'(f8.0)', err=901,end=901) thmin
+        read(lun,'(f8.0,8x,f8.0)', err=901,end=901) ymon, temp
+		
+	if (xstep .eq. 0) goto 901
+
+        j=-1
+1       read(lun,'(10(i2,i6))',err=902,end=9) ival
+        if (ival(2,1) .eq. -1000) goto 9
+        do i=1,10
+          if (ival(1,i) .gt. 0 .and. ival(2,i) .ge. 0) then
+            if (nread .ge. nmax) then
+              print *,'DAT_LNSP: Too many datapoints, truncated'
+	      goto 9
+	    endif
+            nread=nread+1
+            xx(nread)=(i+j)*xstep+thmin
+            yy(nread)=ival(2,i)
+            ss(nread)=max(1.0,sqrt(yy(nread)/float(ival(1,i))))
+            ww(nread)=ymon*ival(1,i)
+          endif
+        enddo
+        j=j+10
+        goto 1
+
+9	call dat_group(3, putval)
+	call putval('XAxis=2-Theta [deg]', 0.0)
+	call putval('YAxis=Intensity', 0.0)
+	call dat_group(1, putval)
+	call putval('Monitor', ymon)
+	call str_trim(title, title, l)
+	call putval('Title='//title(1:l), 0.0)
+	call putval('Temp', temp)
+
+990	close(lun)
+	return
+
+! error messages
+
+900	nread=-1
+	rewind lun
+	return
+	
+901	print *,'DAT_D1A: Error in header'
+	goto 990
+
+902	print *,'DAT_D1A: Error in intensity block'
+	goto 990
+
+99	print *,'DAT_D1A: error during read'
+	rewind lun
+	nread=-2
+	return
+	end