134 lines
2.9 KiB
Fortran
134 lines
2.9 KiB
Fortran
subroutine dat_5c2
|
|
c ------------------
|
|
|
|
external dat_5c2_desc
|
|
external dat_5c2_opts
|
|
external dat_5c2_read
|
|
|
|
integer dtype/0/
|
|
|
|
call dat_init_desc(dtype, dat_5c2_desc)
|
|
call dat_init_opts(dtype, dat_5c2_opts)
|
|
call dat_init_read(dtype, dat_5c2_read)
|
|
end
|
|
|
|
|
|
subroutine dat_5c2_desc(text)
|
|
! -----------------------------
|
|
character*(*) text ! (out) description
|
|
|
|
! type description
|
|
! ----------------------------------
|
|
text='5C2 Saclay instrument 5c2'
|
|
end
|
|
|
|
|
|
subroutine dat_5c2_opts
|
|
! -----------------------
|
|
print '(x,a)'
|
|
1,'from,to: dataset range'
|
|
end
|
|
|
|
|
|
subroutine dat_5c2_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, idx, n, i1, i2, j, idum
|
|
real h, k, l, step, rdum
|
|
real ymon
|
|
character line*132
|
|
|
|
|
|
read(lun, '(a)', err=100, end=100) line
|
|
if (line(1:6) .ne. 'File= ') then
|
|
if (forced .le. 0) goto 100
|
|
rewind lun
|
|
endif
|
|
|
|
call dat_start_options
|
|
i1=0
|
|
call dat_int_option('from', i1)
|
|
i2=0
|
|
call dat_int_option('to', i2)
|
|
if (i2 .eq. 0) then
|
|
if (i1 .eq. 0) then
|
|
i1=1
|
|
else
|
|
i2=i1
|
|
endif
|
|
endif
|
|
|
|
call dat_get_index(idx)
|
|
if (idx .eq. 0) then
|
|
if (i2 .gt. i1) then
|
|
print *,'for 5C2 files only one dataset allowed'
|
|
endif
|
|
else
|
|
i1=i1+idx-1
|
|
if (i1 .gt. i2 .and. i2 .ne. 0) goto 98
|
|
endif
|
|
|
|
do i=1,6
|
|
read(lun, *, err=100, end=100)
|
|
enddo
|
|
ymon=0
|
|
do i=1,i1
|
|
read(lun, *, end=97, err=99) h,k,l,idum,rdum,rdum,idum,n
|
|
read(lun, *, end=99, err=99) rdum,rdum,rdum,step
|
|
read(lun,'(20f5.0)',err=99,end=99) (yy(j),j=1,n),(ww(j),j=1,n)
|
|
enddo
|
|
|
|
if (n .gt. nmax) goto 99
|
|
do j=1,n
|
|
ss(j)=sqrt(max(1.0,yy(j)))
|
|
xx(j)=(j-n/2-1)*step
|
|
ymon=ymon+ww(j)
|
|
enddo
|
|
ymon=ymon/n
|
|
|
|
write(line,'(3(a,f8.3))') 'h=',h,' k=',k,' l=',l
|
|
call putval('Monitor', ymon)
|
|
call putval('Title='//line, 0.0)
|
|
call putval('h', h)
|
|
call putval('k', k)
|
|
call putval('l', l)
|
|
call putval('step', step)
|
|
call putval('XAxis=omega',0.0)
|
|
|
|
write(line, '(i4)') i1
|
|
call putval('Range='//line,0.0)
|
|
|
|
close(lun)
|
|
nread=n
|
|
return
|
|
|
|
97 print *,'DAT_5C2: Only ',n,' scans in this file'
|
|
98 nread=-2
|
|
rewind lun
|
|
return
|
|
99 print *,'DAT_5C2: error during read'
|
|
nread=-2
|
|
rewind lun
|
|
return
|
|
|
|
100 nread=-1
|
|
rewind lun
|
|
end
|