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