126 lines
2.9 KiB
Fortran
126 lines
2.9 KiB
Fortran
subroutine dat_xys
|
|
c ------------------
|
|
|
|
external dat_xys_desc
|
|
external dat_xys_read
|
|
|
|
integer dtype/0/
|
|
|
|
call dat_init_desc(dtype, dat_xys_desc)
|
|
call dat_init_read(dtype, dat_xys_read)
|
|
end
|
|
|
|
|
|
subroutine dat_xys_desc(text, opt)
|
|
c ----------------------------------
|
|
|
|
implicit none
|
|
|
|
! arguments dat_xys_desc
|
|
character*(*) text ! (out) description
|
|
character*(*) opt ! (out) options description
|
|
|
|
! arguments dat_xys_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,ymon
|
|
integer i,j,l,errcnt
|
|
character line*132
|
|
|
|
|
|
c type description
|
|
c ----------------------------------
|
|
text='XYS (x,y,sigma) table, ev. with header'
|
|
opt='mon: monitor'
|
|
return
|
|
|
|
|
|
entry dat_xys_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
|
|
read(line, *, err=25, end=21) x,y,s,s
|
|
25 if (j .eq. 0 .and. i .le. 30) goto 22 ! header line
|
|
goto 29
|
|
21 j=j+1 ! count good line (exactly 3 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 XYS'
|
|
rewind lun
|
|
return
|
|
26 if (j .lt. i/2) goto 29
|
|
28 rewind lun
|
|
endif
|
|
|
|
call dat_start_options
|
|
ymon=0
|
|
call dat_real_option('mon', ymon)
|
|
nread=0
|
|
errcnt=0
|
|
call putval('Monitor', 0.0)
|
|
|
|
1 read(lun, '(a)', end=9,err=9) line
|
|
if (nread .ge. nmax) goto 5
|
|
read(line, *, err=7,end=7) x,y,s
|
|
nread=nread+1
|
|
if (s .eq. 0) then
|
|
ww(nread)=1.
|
|
s=1
|
|
else
|
|
ww(nread)=1.0/abs(s)
|
|
endif
|
|
ss(nread)=s
|
|
yy(nread)=y
|
|
xx(nread)=x
|
|
goto 1
|
|
|
|
5 errcnt=errcnt+1
|
|
print *,'DAT_XYS: 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 inquire(lun, name=line)
|
|
call sys_parse(line, l, line, '.', 0)
|
|
if (errcnt .gt. 0) then
|
|
print '(x,a,i5,2a,a1)','DAT_XYS: ',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
|