Initial commit

gen/dat_5c2.f

@@ -0,0 +1,133 @@
+	subroutine dat_5c2
+c	------------------
+
+	external dat_5c2_desc
+	external dat_5c2_opts
+	external dat_5c2_read
+
+	integer dtype/0/
+
+	call dat_init_desc(dtype, dat_5c2_desc)
+	call dat_init_opts(dtype, dat_5c2_opts)
+	call dat_init_read(dtype, dat_5c2_read)
+	end
+
+
+	subroutine dat_5c2_desc(text)
+!	-----------------------------
+	character*(*) text  ! (out) description
+
+!             type    description
+!             ----------------------------------
+	text='5C2     Saclay instrument 5c2'
+	end
+
+
+	subroutine dat_5c2_opts
+!	-----------------------
+	print '(x,a)'
+	1,'from,to: dataset range'
+	end
+
+
+	subroutine dat_5c2_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, idx, n, i1, i2, j, idum
+	real h, k, l, step, rdum
+	real ymon
+	character line*132
+
+
+	read(lun, '(a)', err=100, end=100) line
+	if (line(1:6) .ne. 'File= ') then
+	  if (forced .le. 0) goto 100
+	  rewind lun
+	endif
+
+	call dat_start_options
+	i1=0
+	call dat_int_option('from', i1)
+	i2=0
+	call dat_int_option('to', i2)
+	if (i2 .eq. 0) then
+	  if (i1 .eq. 0) then
+	    i1=1
+	  else
+	    i2=i1
+	  endif
+	endif
+
+	call dat_get_index(idx)
+	if (idx .eq. 0) then
+	  if (i2 .gt. i1) then
+	    print *,'for 5C2 files only one dataset allowed'
+	  endif
+	else
+	  i1=i1+idx-1
+	  if (i1 .gt. i2 .and. i2 .ne. 0) goto 98
+	endif
+
+	do i=1,6
+	  read(lun, *, err=100, end=100)
+	enddo
+	ymon=0
+	do i=1,i1
+	  read(lun, *, end=97, err=99) h,k,l,idum,rdum,rdum,idum,n
+	  read(lun, *, end=99, err=99) rdum,rdum,rdum,step
+          read(lun,'(20f5.0)',err=99,end=99) (yy(j),j=1,n),(ww(j),j=1,n)
+	enddo
+
+	if (n .gt. nmax) goto 99
+	do j=1,n
+	  ss(j)=sqrt(max(1.0,yy(j)))
+	  xx(j)=(j-n/2-1)*step
+	  ymon=ymon+ww(j)
+	enddo
+	ymon=ymon/n
+
+	write(line,'(3(a,f8.3))') 'h=',h,'  k=',k,'  l=',l
+	call putval('Monitor', ymon)
+	call putval('Title='//line, 0.0)
+	call putval('h', h)
+	call putval('k', k)
+	call putval('l', l)
+	call putval('step', step)
+	call putval('XAxis=omega',0.0)
+
+	write(line, '(i4)') i1
+	call putval('Range='//line,0.0)
+
+        close(lun)
+        nread=n
+	return
+
+97	print *,'DAT_5C2: Only ',n,' scans in this file'
+98	nread=-2
+	rewind lun
+	return
+99	print *,'DAT_5C2: error during read'
+	nread=-2
+	rewind lun
+	return
+
+100	nread=-1
+	rewind lun
+	end