139 lines
3.0 KiB
Fortran
139 lines
3.0 KiB
Fortran
subroutine dat_inx
|
|
c ------------------
|
|
|
|
external dat_inx_desc
|
|
external dat_inx_opts
|
|
external dat_inx_read
|
|
|
|
integer dtype/0/
|
|
|
|
call dat_init_desc(dtype, dat_inx_desc)
|
|
call dat_init_opts(dtype, dat_inx_opts)
|
|
call dat_init_read(dtype, dat_inx_read)
|
|
end
|
|
|
|
|
|
subroutine dat_inx_desc(text)
|
|
! -----------------------------
|
|
character*(*) text ! (out) description
|
|
|
|
! type description
|
|
! ----------------------------------
|
|
text='INX INX output files'
|
|
end
|
|
|
|
|
|
subroutine dat_inx_opts
|
|
! -----------------------
|
|
print '(x,a)'
|
|
1,'from,to: dataset range'
|
|
end
|
|
|
|
|
|
subroutine dat_inx_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, n, i1, i2, j, idx
|
|
integer nlines, nzone(6)
|
|
real angle, einc, qinc, temp, dTau, x, y, s
|
|
character line*132
|
|
|
|
|
|
read(lun, '(8i5)', err=100,end=100) nlines, nzone, nread
|
|
n=0
|
|
do i=1,5
|
|
n=n+nzone(i)
|
|
enddo
|
|
if (nzone(1) .ne. 1 .or. nzone(2) .ne. 2
|
|
1 .or. n .ne. nlines-nread) then
|
|
if (forced .le. 0) goto 100
|
|
endif
|
|
|
|
call dat_start_options
|
|
i1=1
|
|
call dat_int_option('from', i1)
|
|
i2=i1
|
|
call dat_int_option('to', i2)
|
|
|
|
call dat_get_index(idx)
|
|
|
|
if (idx .eq. 0) then
|
|
if (i2 .gt. i1) then
|
|
print *,'for INX files only one dataset allowed'
|
|
endif
|
|
else
|
|
i1=i1+idx-1
|
|
if (i1 .gt. i1) goto 98
|
|
endif
|
|
|
|
write(line(1:3), '(i3)') i1
|
|
call putval('Range='//line(1:3),0.0)
|
|
do i=1,i1-1
|
|
do j=1,nlines
|
|
read(lun,*,err=99,end=99)
|
|
enddo
|
|
read(lun, '(8i5)', err=99,end=99) nlines, nzone, nread
|
|
enddo
|
|
|
|
read(lun, '(a)', err=99,end=99) line
|
|
call putval('Title='//line,0.0)
|
|
read(lun, '(f7.0,2f8.0,f9.0,f6.0)', err=99,end=99)
|
|
1 angle, einc, qinc, temp
|
|
call putval('two_theta', angle)
|
|
call putval('Ei', einc)
|
|
call putval('Temp', temp)
|
|
read(lun, '(24x,f8.0)', err=99,end=99) dTau
|
|
call putval('dTau', dTau)
|
|
|
|
n=nlines-nread-3
|
|
do i=1,n
|
|
read(lun,*,err=99,end=99)
|
|
enddo
|
|
j=0
|
|
do i=1,nread
|
|
read(lun, *, err=20,end=29) x,y,s
|
|
if (s .gt. 0.0) then
|
|
if (j .ge. nmax) then
|
|
print *,'DAT_INX: too many data points, truncated'
|
|
goto 29
|
|
endif
|
|
j=j+1
|
|
ww(j)=1.0
|
|
ss(j)=s
|
|
yy(j)=y
|
|
xx(j)=x
|
|
endif
|
|
20 continue
|
|
enddo
|
|
29 nread=j
|
|
|
|
call putval('Monitor', 0.0)
|
|
close(lun)
|
|
return
|
|
|
|
99 print *,'DAT_INX: error during read'
|
|
98 nread=-2
|
|
rewind lun
|
|
return
|
|
|
|
100 nread=-1
|
|
rewind lun
|
|
end
|