Initial commit
This commit is contained in:
233
gen/dat_frm.f
Normal file
233
gen/dat_frm.f
Normal file
@ -0,0 +1,233 @@
|
||||
subroutine dat_frm
|
||||
c ------------------
|
||||
|
||||
external dat_frm_desc
|
||||
external dat_frm_opts
|
||||
external dat_frm_read
|
||||
|
||||
integer dtype/0/
|
||||
|
||||
call dat_init_desc(dtype, dat_frm_desc)
|
||||
call dat_init_opts(dtype, dat_frm_opts)
|
||||
call dat_init_read(dtype, dat_frm_read)
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_frm_desc(text)
|
||||
! -----------------------------
|
||||
character*(*) text ! (out) description
|
||||
|
||||
! type description
|
||||
! ----------------------------------
|
||||
text='FRM PUMA & PANDA at FRM2 Munich'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_frm_opts
|
||||
! -----------------------
|
||||
print '(x,a)'
|
||||
1,'x: x-axis (default: first column or first variable'
|
||||
1,' with step in Qscan)'
|
||||
1,'y: y-axis (default: last column)'
|
||||
1,'mon: monitor (default: mon1)'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_frm_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=64)
|
||||
real y,s,r,f,ymon,values(mcol)
|
||||
integer i,j,l,errcnt,ncol
|
||||
integer xcol,ycol,mncol
|
||||
integer iostat
|
||||
character line*1024
|
||||
character xaxis*16, yaxis*16, moncol*16, col1*16
|
||||
integer headcnt
|
||||
real qh,qk,ql,en,dh,dk,dl,de
|
||||
|
||||
headcnt=0
|
||||
1 read(lun,'(a)',err=100,end=100) line
|
||||
headcnt=headcnt+1
|
||||
if (line(1:15) .eq. 'filename : ') then
|
||||
goto 1
|
||||
else if (line(1:15) .eq. 'created at : ') then
|
||||
call putval('Date='//line(16:), 0.0)
|
||||
goto 1
|
||||
else if (line(1:15) .eq. 'instrument : ') then
|
||||
call putval('Instrument='//line(16:), 0.0)
|
||||
goto 1
|
||||
else if (line(1:15) .eq. 'user : ') then
|
||||
call putval('User='//line(16:), 0.0)
|
||||
goto 1
|
||||
else if (line(14:15) .eq. ': ') then
|
||||
goto 1
|
||||
endif
|
||||
if (headcnt .lt. 3 .and. forced .le. 0) goto 100
|
||||
|
||||
call dat_start_options
|
||||
xaxis=' '
|
||||
call dat_str_option('x', xaxis)
|
||||
yaxis=' '
|
||||
call dat_str_option('y', yaxis)
|
||||
moncol=' '
|
||||
call dat_str_option('mon', moncol)
|
||||
if (moncol .eq. ' ') then
|
||||
moncol='mon1'
|
||||
elseif (moncol .gt. '0' .and. moncol .le. '9') then
|
||||
moncol='mon'//moncol(1:)
|
||||
endif
|
||||
|
||||
2 read(lun,'(a)',err=100,end=100) line
|
||||
if (line(1:10) .ne. 'scan data:') goto 2
|
||||
|
||||
nread=0
|
||||
errcnt=0
|
||||
|
||||
read(lun, '(a)', err=99,end=99) line
|
||||
if (xaxis .eq. ' ') then
|
||||
i = index(line, 'Qscan')
|
||||
if (i .ne. 0 .and. xaxis .eq. ' ') then
|
||||
line=line(i+5:)
|
||||
i=index(line,'(')
|
||||
if (i .ne. 0) line(i:i)=' '
|
||||
i=index(line,')')
|
||||
if (i .ne. 0) line(i:i)=' '
|
||||
read(line, *, iostat=iostat) qh,qk,ql,en,dh,dk,dl,de
|
||||
call putval('QH', qh)
|
||||
call putval('QK', qk)
|
||||
call putval('QL', ql)
|
||||
call putval('EN', en)
|
||||
call putval('DQH', qh)
|
||||
call putval('DQK', dk)
|
||||
call putval('DQL', dl)
|
||||
call putval('DEN', de)
|
||||
if (dh .ne. 0) then
|
||||
xaxis='h'
|
||||
elseif (dk .ne. 0) then
|
||||
xaxis='k'
|
||||
elseif (dl .ne. 0) then
|
||||
xaxis='l'
|
||||
elseif (de .ne. 0) then
|
||||
xaxis='E'
|
||||
endif
|
||||
else
|
||||
! ignore other scan types
|
||||
endif
|
||||
endif
|
||||
|
||||
read(lun,'(a)',err=99,end=99) line
|
||||
|
||||
i=1
|
||||
line(len(line):len(line))=' '
|
||||
ncol=0
|
||||
xcol=0
|
||||
ycol=0
|
||||
mncol=0
|
||||
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
|
||||
if (line(l:i) .eq. ';') goto 31
|
||||
ncol=ncol+1
|
||||
if (ncol .eq. 1) col1=line(l:i)
|
||||
if (line(l:i) .eq. yaxis .and. ycol .eq. 0) then
|
||||
ycol=ncol
|
||||
elseif (line(l:i) .eq. xaxis .and. xcol .eq. 0) then
|
||||
xcol=ncol
|
||||
elseif (line(l:i) .eq. moncol .and. mncol .eq. 0) then
|
||||
mncol=ncol
|
||||
endif
|
||||
goto 31
|
||||
|
||||
39 if (ycol .eq. 0) then
|
||||
ycol=ncol
|
||||
yaxis=line(l:)
|
||||
endif
|
||||
if (xcol .eq. 0) then
|
||||
xcol=1
|
||||
xaxis=col1
|
||||
endif
|
||||
|
||||
call putval('XAxis='//xaxis, 0.0)
|
||||
call putval('YAxis='//yaxis, 0.0)
|
||||
|
||||
! ignore units
|
||||
read(lun, '(a)', err=99,end=99) line
|
||||
ymon=0
|
||||
l=min(mcol,max(xcol,ycol,mncol))
|
||||
|
||||
40 read(lun,'(a)',end=88,err=88) line
|
||||
if (line(2:5) .eq. '****') goto 88
|
||||
i=index(line,';')
|
||||
if (i .ne. 0) line(i:i)=' '
|
||||
|
||||
read(line,*,err=99,end=99) (values(j),j=1,l)
|
||||
if (nread .ge. nmax) goto 29
|
||||
|
||||
if (mncol .eq. 0) then
|
||||
if (ymon .eq. 0) ymon=1.
|
||||
r=ymon
|
||||
else
|
||||
r=values(mncol)
|
||||
if (r .gt. 0) then
|
||||
if (ymon .eq. 0) ymon=r
|
||||
else
|
||||
if (ymon .eq. 0) ymon=1.
|
||||
r=ymon
|
||||
endif
|
||||
endif
|
||||
f=ymon/r
|
||||
if (f .le. 0.0) f=1.0
|
||||
|
||||
nread=nread+1
|
||||
xx(nread)=values(xcol)
|
||||
y=values(ycol)
|
||||
if (y .gt. 0) then
|
||||
s=sqrt(y) ! statistical error of detector
|
||||
else
|
||||
s=1
|
||||
endif
|
||||
yy(nread)=y*f
|
||||
ss(nread)=s*f
|
||||
ww(nread)=r
|
||||
goto 40
|
||||
|
||||
29 print *,'too many points - truncated'
|
||||
88 close(lun)
|
||||
call putval('NP', nread*1.0)
|
||||
call putval('Monitor', ymon)
|
||||
return
|
||||
|
||||
99 nread=-2
|
||||
rewind lun
|
||||
print *,'DAT_FRM: error during read'
|
||||
call putval('Monitor', 0.0)
|
||||
return
|
||||
|
||||
100 nread=-1
|
||||
rewind lun
|
||||
call putval('Monitor', 0.0)
|
||||
end
|
||||
Reference in New Issue
Block a user