Initial commit
This commit is contained in:
170
gen/dat_ccl.f
Normal file
170
gen/dat_ccl.f
Normal file
@ -0,0 +1,170 @@
|
||||
subroutine dat_ccl
|
||||
c ------------------
|
||||
|
||||
external dat_ccl_desc
|
||||
external dat_ccl_opts
|
||||
external dat_ccl_read
|
||||
|
||||
integer dtype/0/
|
||||
|
||||
call dat_init_desc(dtype, dat_ccl_desc)
|
||||
call dat_init_opts(dtype, dat_ccl_opts)
|
||||
call dat_init_read(dtype, dat_ccl_read)
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_ccl_desc(text)
|
||||
! -----------------------------
|
||||
character*(*) text ! (out) description
|
||||
|
||||
! type description
|
||||
! ----------------------------------
|
||||
text='CCL TriCS single detector multiscan'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_ccl_opts
|
||||
! -----------------------
|
||||
print '(x,a)'
|
||||
1,'from,to: dataset range'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_ccl_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, nranges, i1, i2, j, m, cnt(10)
|
||||
real temp, h, k, l, step, offset, junk, mf
|
||||
real twoth, omega, chi, phi, ymon
|
||||
character line*132, date*20, tail*32
|
||||
|
||||
|
||||
read(lun, '(a)', err=100, end=100) line
|
||||
if (line(1:3) .ne. 'CCL') then
|
||||
if (forced .le. 0) goto 100
|
||||
rewind lun
|
||||
endif
|
||||
|
||||
if (line(4:) .eq. ' ') then ! new syntax
|
||||
do while (line(1:6) .ne. '# data'
|
||||
1 .and. line(1:5) .ne. '#data')
|
||||
read(lun, '(a)', err=100, end=100) line
|
||||
enddo
|
||||
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 CCL files only one dataset allowed'
|
||||
endif
|
||||
else
|
||||
i1=i1+idx-1
|
||||
if (i1 .gt. i2 .and. i2 .ne. 0) goto 98
|
||||
endif
|
||||
|
||||
nranges=0
|
||||
do i=1,i1-1
|
||||
nranges=i-1
|
||||
read(lun, *, err=97, end=97)
|
||||
read(lun, *, err=99, end=99) nread
|
||||
do j=1,nread,10
|
||||
read(lun,*,err=99, end=99)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
if (nread .ge. nmax) goto 99
|
||||
ymon=1
|
||||
read(lun, '(a)', err=97, end=97) line
|
||||
read(line, *, err=33, end=33) junk,h,k,l,twoth,omega,chi,phi
|
||||
1 ,junk,junk
|
||||
33 read(lun, '(i3,f8.0,f10.0,f8.0,x,a)', err=99, end=99)
|
||||
1 nread, step , ymon, temp, tail
|
||||
i=index(tail,':')
|
||||
mf=-9999
|
||||
if (i .gt. 13) then
|
||||
date=tail(i-13:)
|
||||
if (tail(1:12) .ne. ' -0.000000') then
|
||||
read(tail, *, err=34, end=34) mf
|
||||
34 endif
|
||||
else
|
||||
date=tail
|
||||
endif
|
||||
|
||||
write(line,'(3(a,f8.3))') 'h=',h,' k=',k,' l=',l
|
||||
call putval('Monitor', ymon)
|
||||
call putval('Temp', temp)
|
||||
call putval('Date='//date, 0.0)
|
||||
call putval('Title='//line, 0.0)
|
||||
call putval('two_theta', twoth)
|
||||
call putval('omega', omega)
|
||||
call putval('chi', chi)
|
||||
call putval('phi', phi)
|
||||
call putval('h', h)
|
||||
call putval('k', k)
|
||||
call putval('l', l)
|
||||
call putval('step', step)
|
||||
if (mf .ne. -9999) then
|
||||
call putval('magfield', mf)
|
||||
endif
|
||||
call putval('XAxis=omega',0.0)
|
||||
|
||||
write(line, '(i4)') i1
|
||||
call putval('Range='//line,0.0)
|
||||
|
||||
offset=omega-0.5*step*(nread+1)
|
||||
do j=1,nread,10
|
||||
read(lun,'(10i8)',err=99, end=99) cnt
|
||||
do m=j,min(nread,j+9)
|
||||
xx(m)=offset+step*m
|
||||
yy(m)=cnt(m-j+1)
|
||||
ss(m)=sqrt(float(max(1,cnt(m-j+1))))
|
||||
ww(m)=ymon
|
||||
enddo
|
||||
enddo
|
||||
|
||||
close(lun)
|
||||
return
|
||||
|
||||
97 print *,'DAT_CCL: Only ',nranges,' scans in this file'
|
||||
98 nread=-2
|
||||
rewind lun
|
||||
return
|
||||
99 print *,'DAT_CCL: error during read'
|
||||
nread=-2
|
||||
rewind lun
|
||||
return
|
||||
|
||||
100 nread=-1
|
||||
rewind lun
|
||||
end
|
||||
Reference in New Issue
Block a user