119 lines
2.8 KiB
Fortran
119 lines
2.8 KiB
Fortran
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
|