468 lines
11 KiB
Fortran
468 lines
11 KiB
Fortran
subroutine dat_tasmad
|
|
c ---------------------
|
|
external dat_tasmad_desc
|
|
external dat_tasmad_opts
|
|
external dat_tasmad_read
|
|
external dat_get_datanumber
|
|
|
|
integer dtype/0/
|
|
|
|
call dat_init_desc(dtype, dat_tasmad_desc)
|
|
call dat_init_opts(dtype, dat_tasmad_opts)
|
|
call dat_init_read(dtype, dat_tasmad_read)
|
|
call dat_init_high(dtype, dat_get_datanumber)
|
|
end
|
|
|
|
|
|
subroutine dat_tasmad_desc(text)
|
|
c --------------------------------
|
|
character*(*) text ! (out) description
|
|
|
|
text='TASMAD DrueChaL, TASP and ILL TAS'
|
|
end
|
|
|
|
subroutine dat_tasmad_opts
|
|
c --------------------------
|
|
print '(x,a)'
|
|
1,'p1,p2: polarisation'
|
|
1,'x: column to be used as x-axis *'
|
|
1,'y: column to be used as y-axis (default: CNTS)'
|
|
1,'mon: column to be used as Monitor (default: M1 or TIME)'
|
|
end
|
|
|
|
|
|
subroutine dat_tasmad_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
|
|
real none
|
|
integer mcol
|
|
parameter (none=-8.7654e29, mcol=32)
|
|
|
|
character line*160, preset*4, old*6, col2*8
|
|
real values(mcol), r, f, s, y, ymon, tm, ts, td
|
|
integer r1,r2
|
|
integer i,j,l,ncol,ccol,pcol,xcol,tcol,pacol
|
|
integer ip,ip1,ip2
|
|
character word*32
|
|
integer muco, mubgr
|
|
real codemu
|
|
real mucode(36)
|
|
|
|
external dat_tasmad_val
|
|
|
|
! common
|
|
real tt, tem, mon, tim, qe(4)
|
|
character xaxis*8, yaxis*8, monam*8
|
|
integer mode
|
|
common /dat_tasmad_com/tt, tem, mon, tim, mode, xaxis, qe
|
|
|
|
|
|
xaxis=' '
|
|
preset=' '
|
|
old=' '
|
|
nread=0
|
|
read(lun,'(a)',err=100,end=100) line
|
|
if (line(1:16) .eq. 'RRRRRRRRRRRRRRRR') then
|
|
1 read(lun,'(a)',err=100,end=100) line
|
|
if (line(1:16) .ne. 'VVVVVVVVVVVVVVVV') goto 1
|
|
read(lun,'(a)',err=100,end=100) line
|
|
elseif (line(1:7) .ne. 'INSTR: ') then
|
|
if (forced .le. 0) goto 100
|
|
endif
|
|
tt=none
|
|
tem=none
|
|
mon=none
|
|
tim=none
|
|
mubgr=-1
|
|
muco=0
|
|
call dat_delimiters(',', '=', '''')
|
|
12 if (line(1:6) .eq. 'INSTR:') then
|
|
call dat_group(1, putval)
|
|
call putval('Instrument='//line(8:19), 0.0)
|
|
elseif (line(1:6) .eq. 'USER_:') then
|
|
call dat_group(1, putval)
|
|
call putval('User='//line(8:80), 0.0)
|
|
elseif (line(1:6) .eq. 'DATE_:') then
|
|
call dat_group(1, putval)
|
|
call putval('Date='//line(8:80), 0.0)
|
|
elseif (line(1:6) .eq. 'TITLE:') then
|
|
call dat_group(1, putval)
|
|
call putval('Title='//line(8:80), 0.0)
|
|
elseif (line(1:6) .eq. 'STEPS:' .or.
|
|
1 line(1:6) .eq. 'POSQE:' .or.
|
|
1 line(1:6) .eq. 'VARIA:' .or.
|
|
1 line(1:6) .eq. 'ZEROS:' .or.
|
|
1 line(1:6) .eq. 'PARAM:') then
|
|
call dat_group(2, putval)
|
|
old=line(1:6)
|
|
j=7
|
|
mode=index('SZ',line(1:1)) ! mode=0: normal, 1: steps, 2: zeros (see dat_tasmad_val)
|
|
call dat_intprt(line(7:), dat_tasmad_val, putval)
|
|
|
|
elseif (line(1:6) .eq. 'DATA_:') then
|
|
goto 20
|
|
elseif (line(1:6) .eq. 'EXPNO:' .or.
|
|
1 line(1:6) .eq. 'LOCAL:' .or.
|
|
1 line(1:6) .eq. 'COMND:') then
|
|
call dat_group(2, putval)
|
|
call str_trim(line, line, l)
|
|
if (l .ge. 8) call putval(line(1:5)//'='//line(8:l), 0.0)
|
|
elseif (line(1:6) .eq. 'POLAN:') then
|
|
call str_trim(line, line, l)
|
|
if (l .lt. len(line)) l=l+1
|
|
if (muco .ge. 0) then
|
|
j=1
|
|
call str_get_elem(line(7:l), j, word)
|
|
if (word .ne. 'muco' .and. word .ne. '#muco') then
|
|
if (word .eq. '#signal') then
|
|
call dat_group(1, putval)
|
|
call putval('mukind=signal',0.0)
|
|
mubgr=0
|
|
goto 19
|
|
endif
|
|
if (word .eq. '#background') then
|
|
call dat_group(1, putval)
|
|
call putval('mukind=background',0.0)
|
|
mubgr=1
|
|
goto 19
|
|
endif
|
|
muco=-1
|
|
goto 19
|
|
endif
|
|
if (muco .eq. 0) then
|
|
if (mubgr .eq. -1) then
|
|
mubgr = 0
|
|
call dat_group(1, putval)
|
|
call putval('mukind=single', 0.0)
|
|
endif
|
|
do i=1,36
|
|
mucode(i) = 0
|
|
enddo
|
|
endif
|
|
muco=muco+1
|
|
if (muco .gt. 36) then
|
|
if (muco .eq. 37) then
|
|
print *,'DAT_TASMAD: too many POLAN muco lines'
|
|
endif
|
|
goto 19
|
|
endif
|
|
call str_get_elem(line(7:l), j, word)
|
|
if (word(1:1) .eq. '-') then
|
|
codemu=3.0
|
|
word=word(2:)
|
|
else
|
|
codemu=1.0
|
|
endif
|
|
i = index('x y z ', word(1:2))
|
|
if (i .eq. 0) then
|
|
print *,'DAT_TASMAD: 1st arg bad ',line(7:l)
|
|
endif
|
|
! increase codemu by 0, 30 or 60 for x, y or z
|
|
codemu = codemu + (i - 1) * 15
|
|
call str_get_elem(line(7:l), j, word)
|
|
if (word(1:1) .eq. '-') then
|
|
codemu=codemu+1
|
|
word=word(2:)
|
|
endif
|
|
i = index('x y z ', word(1:2))
|
|
if (i .eq. 0) then
|
|
print *,'DAT_TASMAD: 2nd arg bad ',line(7:l)
|
|
endif
|
|
! increase codemu by 10, 20 or 30 for x, y or z
|
|
mucode(muco) = codemu + mubgr * 0.1 + (i + 1) * 5
|
|
|
|
c the coding for the x-value ip.b is:
|
|
c where i is 1..9 for xx, yx, yz, zy, yy, zy, xz, yz, zz
|
|
c p is 1..4 for ++, +-, -+, --
|
|
c b is 0 for signal and 1 for background
|
|
|
|
endif
|
|
elseif (line(1:6) .ne. 'FILE_:' .and. line(1:6) .ne. 'FORMT:'
|
|
1 .and. line(1:6).ne.' ') then
|
|
! if (line(6:6) .ne. ':') goto 100
|
|
call str_trim(line, line, l)
|
|
print *,'DAT_TASMAD: superflous line: ',line(1:l)
|
|
endif
|
|
19 continue
|
|
read(lun,'(a)',err=99,end=99) line
|
|
goto 12
|
|
|
|
20 continue
|
|
call dat_group(1, putval)
|
|
ymon=0
|
|
if (mon .eq. none) then
|
|
if (tim .eq. none) then
|
|
print *,'DAT_TASMAD: neither TI nor MN present'
|
|
goto 100
|
|
endif
|
|
ymon=tim
|
|
preset='TIME'
|
|
call putval('Preset=TIME', 0.0)
|
|
else
|
|
ymon=mon
|
|
preset='M1'
|
|
call putval('Preset=M1', 0.0)
|
|
endif
|
|
|
|
!----- options ------
|
|
yaxis=' '
|
|
monam=' '
|
|
call dat_start_options
|
|
r1=0
|
|
call dat_int_option('p1', r1)
|
|
r2=0
|
|
call dat_int_option('p2', r2)
|
|
call dat_str_option('x', xaxis)
|
|
call dat_str_option('y', yaxis)
|
|
call dat_str_option('mon', monam)
|
|
|
|
call str_upcase(xaxis, xaxis)
|
|
call str_upcase(yaxis, yaxis)
|
|
call str_upcase(monam, monam)
|
|
!----- end options ------
|
|
|
|
if (monam .eq. ' ') then
|
|
monam=preset
|
|
elseif (preset .ne. monam) then
|
|
ymon=0
|
|
endif
|
|
|
|
21 read(lun,'(a)',err=99,end=99) line
|
|
if (line .eq. ' ') goto 21
|
|
i=1
|
|
line(len(line):len(line))=' '
|
|
ncol=0
|
|
ccol=0
|
|
pcol=0
|
|
xcol=0
|
|
tcol=0
|
|
pacol=0
|
|
col2=' '
|
|
if (yaxis .eq. ' ') yaxis='CNTS'
|
|
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. 2) col2=line(l:i)
|
|
if (line(l:i) .eq. yaxis) ccol=ncol
|
|
if (line(l:i) .eq. monam) pcol=ncol
|
|
if (line(l:i) .eq. xaxis) xcol=ncol
|
|
if (line(l:i) .eq. 'TEM') tcol=ncol
|
|
if (line(l:i) .eq. 'TT' .and. tcol .eq. 0) tcol=ncol
|
|
if (line(l:i) .eq. 'PAL') pacol=ncol
|
|
goto 31
|
|
|
|
39 if (ccol .eq. 0) then
|
|
print *,'no values found for ',yaxis
|
|
goto 99
|
|
endif
|
|
if (pcol .eq. 0) then
|
|
if (monam .eq. ' ') monam='Monitor'
|
|
print *,'no values found for ',monam
|
|
goto 99
|
|
endif
|
|
if (xcol .eq. 0) then
|
|
if (xaxis .ne. ' ') then
|
|
print *,'no values found for ',xaxis,', take ',col2
|
|
endif
|
|
xcol=2
|
|
xaxis=col2
|
|
endif
|
|
|
|
if (pacol .ne. 0) then
|
|
if (r1 .gt. 9 .or. r2 .gt. 9) then
|
|
r1=0
|
|
print *,'DAT_TASMAD: illegal PAL index'
|
|
elseif (r1 .le. 0) then
|
|
r1=0
|
|
else
|
|
line(1:3)=char(ichar('0')+r1)
|
|
if (r2 .eq. r1) r2=0
|
|
if (r2 .ne. 0) then
|
|
line(2:3)=','//char(ichar('0')+r2)
|
|
endif
|
|
call putval('Range='//line(1:3),0.0)
|
|
call putval('Pal',0.1*r1+0.01*r2)
|
|
endif
|
|
endif
|
|
call putval('XAxis='//xaxis, 0.0)
|
|
call putval('YAxis=Intensity', 0.0)
|
|
call dat_group(1, putval)
|
|
|
|
tm=0
|
|
ts=0
|
|
l=min(mcol,max(xcol,pcol,ccol,tcol))
|
|
ip=0
|
|
ip1=0
|
|
ip2=0
|
|
40 read(lun,*,err=89,end=88) (values(j),j=1,l)
|
|
if (pacol .ne. 0) then
|
|
if (r1 .eq. 0) then
|
|
ip=nint(values(pacol))
|
|
else
|
|
ip=0
|
|
if (abs(values(pacol)-r1) .gt. 1e-3 .and.
|
|
1 abs(values(pacol)-r2) .gt. 1e-3) goto 40 ! do not read when PAL value does not match
|
|
endif
|
|
endif
|
|
if (nread .ge. nmax) goto 29
|
|
y=values(ccol)
|
|
r=values(pcol)
|
|
if (ymon .eq. 0) then
|
|
ymon=r
|
|
if (r .eq. 0) r=1.
|
|
endif
|
|
if (r .le. 0.0) r=ymon
|
|
f=ymon/r
|
|
if (f .le. 0.0) f=1.0
|
|
if (y .gt. 0) then
|
|
s=sqrt(y) ! statistical error of detector
|
|
else
|
|
s=1
|
|
endif
|
|
nread=nread+1
|
|
if (ip .ne. 0) then
|
|
ip1=ip1+1
|
|
if (ip .ne. ip1) then
|
|
if (ip2 .eq. 0) then
|
|
ip2=ip1-1
|
|
elseif (ip .ne. 1 .and. ip2 .ne. ip1-1) then
|
|
print *,'DAT_TASMAD: PAL code not in order'
|
|
ip2=1
|
|
endif
|
|
ip1=1
|
|
endif
|
|
endif
|
|
if (muco .ne. 0 .and. xcol .eq. pacol) then
|
|
xx(nread) = mucode(nint(values(pacol)))
|
|
else
|
|
xx(nread)=values(xcol)
|
|
endif
|
|
yy(nread)=y*f
|
|
ss(nread)=s*f
|
|
ww(nread)=r
|
|
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
|
|
c print *,'temp',tt,tm,ts
|
|
endif
|
|
goto 40
|
|
|
|
88 close(lun)
|
|
if (ip2 .ne. 0) then
|
|
call fit_dat_table(1, ip2, (nread+ip2-1)/ip2)
|
|
endif
|
|
call putval('Monitor', ymon)
|
|
if (tcol .ne. 0) then
|
|
call putval('Temp', tm)
|
|
if (nread .gt. 1) call putval('dTemp', sqrt(ts/(nread-1)))
|
|
tm = tt
|
|
elseif (tem .eq. none .and. tt .ne. none) then
|
|
call putval('Temp', tt)
|
|
endif
|
|
if (muco .ne. 0) then
|
|
call dat_group(3, putval)
|
|
if (mubgr .eq. 1) then
|
|
call putval('QH_B', qe(1))
|
|
call putval('QK_B', qe(2))
|
|
call putval('QL_B', qe(3))
|
|
call putval('EN_B', qe(4))
|
|
call putval('TEMP_B', tm)
|
|
else
|
|
call putval('QH_S', qe(1))
|
|
call putval('QK_S', qe(2))
|
|
call putval('QL_S', qe(3))
|
|
call putval('EN_S', qe(4))
|
|
call putval('TEMP_S', tm)
|
|
endif
|
|
endif
|
|
return
|
|
|
|
89 print *,'DAT_TASMAD: error at point ',nread
|
|
goto 40
|
|
29 print *,'DAT_TASMAD: too many points'
|
|
goto 100
|
|
99 print *,'DAT_TASMAD: error during read'
|
|
rewind lun
|
|
nread=-2
|
|
return
|
|
|
|
100 rewind lun
|
|
nread=-1
|
|
end
|
|
|
|
|
|
subroutine dat_tasmad_val(str, val, putval)
|
|
|
|
character*(*) str
|
|
real val
|
|
external putval
|
|
|
|
integer i
|
|
|
|
real tt, tem, mon, tim, qe(4)
|
|
character xaxis*8, zstr*8
|
|
integer mode
|
|
common /dat_tasmad_com/tt, tem, mon, tim, mode, xaxis, qe
|
|
|
|
if (val .eq. 0) then
|
|
i=index(str, '=')
|
|
else
|
|
i=0
|
|
endif
|
|
if (i .eq. 0) then ! numeric
|
|
if (mode .eq. 1) then ! steps
|
|
if (val .ne. 0 .and. xaxis .eq. ' ') then ! get first step not zero
|
|
xaxis=str(2:)
|
|
endif
|
|
elseif (mode .eq. 2) then ! zeros
|
|
zstr(1:1)='Z'
|
|
zstr(2:)=str
|
|
call putval(zstr, val)
|
|
return
|
|
elseif (str .eq. 'TT') then
|
|
tt=val
|
|
elseif (str .eq. 'Temp') then
|
|
tem=val
|
|
elseif (str .eq. 'MN' .or. str .eq. 'mn') then
|
|
mon=val
|
|
elseif (str .eq. 'TI' .or. str .eq. 'ti') then
|
|
tim=val
|
|
elseif (str .eq. 'QH') then
|
|
qe(1)=val
|
|
elseif (str .eq. 'QK') then
|
|
qe(2)=val
|
|
elseif (str .eq. 'QL') then
|
|
qe(3)=val
|
|
elseif (str .eq. 'EN') then
|
|
qe(4)=val
|
|
endif
|
|
endif
|
|
call putval(str, val)
|
|
end
|