subroutine dat_xysm c ------------------ external dat_xysm_desc external dat_xysm_read integer dtype/0/ call dat_init_desc(dtype, dat_xysm_desc) call dat_init_read(dtype, dat_xysm_read) end subroutine dat_xysm_desc(text, opt) c ---------------------------------- implicit none ! arguments dat_xysm_desc character*(*) text ! (out) description character*(*) opt ! (out) options description ! arguments dat_xysm_read 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 real none parameter (none=-8.7654e29) real x,y,s,m,ymon integer i,j,l,errcnt character line*132 c type description c ---------------------------------- text='XYSM (x,y,sigma,monitor) table, ev. with header' opt=' ' return entry dat_xysm_read(lun, forced, nread, putval, nmax, xx,yy,ss,ww) ! ------------------------------------------------------------------ ! check 10 lines (up to 30 header lines) for containing exactly three numeric values if (forced .eq. 0) then read(lun,'(a)', err=29, end=26) line i=1 j=0 20 read(line, *, err=25, end=25) x,y,s,m read(line, *, err=25, end=21) x,y,s,m,m 25 if (j .eq. 0 .and. i .le. 30) goto 22 ! header line goto 29 21 j=j+1 ! count good line (exactly 4 numbers) 22 read(lun,'(a)', err=29, end=26) line i=i+1 ! count line if (j .lt. 10) goto 20 goto 28 29 nread=-1 c print *,j,i,' check XYSM' rewind lun return 26 if (j .lt. i/2) goto 29 28 rewind lun endif nread=0 errcnt=0 ymon=0 1 read(lun, '(a)', end=9,err=9) line if (line(1:1) .eq. '#' .or. line .eq. ' ') goto 1 if (nread .ge. nmax) goto 5 read(line, *, err=7,end=7) x,y,s,m if (m .eq. 0) m=1.0 nread=nread+1 xx(nread)=x yy(nread)=y ss(nread)=max(s,y*1e-6,1e-6) ww(nread)=m ymon=max(ymon,m) goto 1 5 errcnt=errcnt+1 print *,'DAT_XYSM: File too long' goto 9 7 if (nread .gt. 0) then ! count error only if not header errcnt=errcnt+1 if (errcnt .le. 10) then print *,'Error in line ',nread+1 endif endif goto 1 9 call putval('Monitor', ymon) do i=1,nread yy(i)=yy(i)*ymon/ww(i) ss(i)=ss(i)*ymon/ww(i) ww(i)=ymon enddo if (errcnt .gt. 0) then inquire(lun, name=line) call sys_parse(line, l, line, '.', 0) print '(x,a,i5,2a,a1)','DAT_XYSM: ',errcnt, 1 ' errors during read ', line(1:max(1,l)), 7 endif if (nread .eq. 0) then rewind lun nread=-1 else close(lun) endif end