127 lines
3.0 KiB
Fortran
127 lines
3.0 KiB
Fortran
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
|