Initial commit
This commit is contained in:
198
gen/dat_2t.f
Normal file
198
gen/dat_2t.f
Normal file
@ -0,0 +1,198 @@
|
||||
subroutine dat_2t
|
||||
c -----------------
|
||||
|
||||
external dat_2t_desc
|
||||
! external dat_2t_high ! this line for raw data files only
|
||||
external dat_2t_read
|
||||
|
||||
integer dtype/0/
|
||||
|
||||
call dat_init_desc(dtype, dat_2t_desc)
|
||||
call dat_init_read(dtype, dat_2t_read)
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_2t_desc(text)
|
||||
! ----------------------------
|
||||
character*(*) text ! (out) description
|
||||
|
||||
! type description
|
||||
! ----------------------------------
|
||||
text='2T 2T format (LLB Saclay)'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_2t_opts
|
||||
! ----------------------
|
||||
print '(x,a)'
|
||||
1,'x: x-axis, y: y-axis'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_2t_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 mcol
|
||||
parameter (mcol=32)
|
||||
|
||||
character header*1024
|
||||
character line*1024, xaxis*8, yaxis*8, name*8, col1*8
|
||||
real values(32), s, y, ymon
|
||||
real tt, tm, ts, td
|
||||
integer i,j,l,ncol,ccol,xcol,tcol
|
||||
|
||||
|
||||
nread=0
|
||||
read(lun,'(a)',err=98,end=98) header
|
||||
if (forced .le. 0) then
|
||||
if (header(1:11) .ne. '# qh') goto 100
|
||||
endif
|
||||
header(1:1)=' '
|
||||
read(lun,'(a)',err=98,end=98) line
|
||||
if (line(1:1) .ne. '#') goto 100
|
||||
line(1:1)=' '
|
||||
|
||||
xaxis=' '
|
||||
yaxis=' '
|
||||
|
||||
call dat_start_options
|
||||
call dat_str_option('x', xaxis)
|
||||
call dat_str_option('y', yaxis)
|
||||
|
||||
call str_upcase(xaxis, xaxis)
|
||||
call str_upcase(yaxis, yaxis)
|
||||
|
||||
call putval('Instrument=2T',0.0)
|
||||
|
||||
call dat_group(2, putval)
|
||||
do i=1,mcol
|
||||
values(i)=0.0
|
||||
enddo
|
||||
ncol=0
|
||||
i=1
|
||||
read(line, *, err=15,end=15) values
|
||||
15 call str_get_elem(header, i, name)
|
||||
if (name .ne. ' ') then
|
||||
ncol=ncol+1
|
||||
if (name .eq. 'm') then
|
||||
name='Monitor'
|
||||
ymon=values(ncol)
|
||||
call putval('Preset=m', 0.0)
|
||||
else if (name .eq. 't') then
|
||||
name='Monitor'
|
||||
ymon=values(ncol)
|
||||
call putval('Preset=t', 0.0)
|
||||
endif
|
||||
call putval(name, values(ncol))
|
||||
goto 15
|
||||
endif
|
||||
|
||||
read(lun, '(a)') line
|
||||
if (line(1:1) .ne. '#') goto 100
|
||||
read(lun, '(a)') line
|
||||
if (line(1:1) .ne. '#') goto 100
|
||||
line(1:1)=' '
|
||||
|
||||
12 i=1
|
||||
line(len(line):len(line))=' '
|
||||
ncol=0
|
||||
ccol=0
|
||||
xcol=0
|
||||
tcol=0
|
||||
col1=' '
|
||||
31 do while (line(i:i) .eq. ' ')
|
||||
i=i+1
|
||||
if (i .gt. len(line)) goto 39
|
||||
enddo
|
||||
l=i
|
||||
do while (line(i:i) .ne. ' ')
|
||||
i=i+1
|
||||
enddo
|
||||
ncol=ncol+1
|
||||
if (ncol .eq. 1) col1=line(l:i)
|
||||
if (line(l:i) .eq. yaxis .or. yaxis .eq. ' '
|
||||
1 .and. line(l:i) .eq. 'comptage') ccol=ncol
|
||||
if (line(l:i) .eq. xaxis) xcol=ncol
|
||||
if (line(l:i) .eq. 'K') tcol=ncol
|
||||
goto 31
|
||||
|
||||
39 if (yaxis .eq. ' ') yaxis='comptage'
|
||||
if (ccol .eq. 0) then
|
||||
print *,'no values found for ',yaxis
|
||||
goto 99
|
||||
endif
|
||||
if (xcol .eq. 0) then
|
||||
if (xaxis .ne. ' ') then
|
||||
print *,'no values found for ',xaxis,', take ',col1
|
||||
endif
|
||||
xcol=1
|
||||
xaxis=col1
|
||||
endif
|
||||
|
||||
call dat_group(2, putval)
|
||||
call putval('XAxis='//xaxis, 0.0)
|
||||
call putval('YAxis='//yaxis, 0.0)
|
||||
call dat_group(1, putval)
|
||||
|
||||
l=min(mcol,max(xcol,ccol,tcol))
|
||||
tm=0
|
||||
ts=0
|
||||
|
||||
4 read(lun,*,err=19,end=9) (values(j),j=1,l)
|
||||
if (nread .ge. nmax) goto 29
|
||||
y=values(ccol)
|
||||
if (y .gt. 0) then
|
||||
s=sqrt(y) ! statistical error of detector
|
||||
else
|
||||
s=1
|
||||
endif
|
||||
nread=nread+1
|
||||
xx(nread)=values(xcol)
|
||||
yy(nread)=y
|
||||
ss(nread)=s
|
||||
ww(nread)=ymon
|
||||
if (tcol .ne. 0) then
|
||||
tt=values(tcol)
|
||||
td=(tt-tm)/nread
|
||||
tm=tm+td ! mean temp.
|
||||
ts=ts+(tt-tm)**2+td*td*(nread-1) ! sum of (temp(i)-mean)**2
|
||||
endif
|
||||
goto 4
|
||||
|
||||
9 close(lun)
|
||||
call putval('Monitor', ymon)
|
||||
if (tcol .ne. 0) then
|
||||
call putval('Temp', tm)
|
||||
if (nread .gt. 1) call putval('dTemp', sqrt(ts/(nread-1)))
|
||||
endif
|
||||
return
|
||||
|
||||
19 print *,'DAT_2T: error at point ',nread
|
||||
goto 4
|
||||
29 print *,'DAT_2T: too many points'
|
||||
goto 100
|
||||
98 if (forced .le. 0) goto 100
|
||||
99 print *,'DAT_2T: error during read'
|
||||
rewind lun
|
||||
nread=-2
|
||||
return
|
||||
100 nread=-1
|
||||
rewind lun
|
||||
end
|
||||
Reference in New Issue
Block a user