Initial commit
This commit is contained in:
168
gen/dat_fda.f
Normal file
168
gen/dat_fda.f
Normal file
@ -0,0 +1,168 @@
|
||||
subroutine dat_fda
|
||||
c --------------------
|
||||
|
||||
external dat_fda_desc
|
||||
external dat_fda_opts
|
||||
external dat_fda_read
|
||||
|
||||
integer dtype/0/
|
||||
|
||||
call dat_init_desc(dtype, dat_fda_desc)
|
||||
call dat_init_opts(dtype, dat_fda_opts)
|
||||
call dat_init_read(dtype, dat_fda_read)
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_fda_desc(text)
|
||||
! -------------------------------
|
||||
character*(*) text ! (out) description
|
||||
|
||||
! type description
|
||||
! ----------------------------------
|
||||
text='FDA FDA (focus data analysis) output files'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_fda_opts
|
||||
! -----------------------
|
||||
print '(x,a)'
|
||||
1,'from,to: dataset range'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_fda_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, i1, i2, j, idx, m, j0, ipdp, iset, iostat
|
||||
real x, y, s, gval, f
|
||||
character line*132, zaxis*132
|
||||
|
||||
zaxis='z'
|
||||
read(lun, '(a)',err=100,end=100) line
|
||||
if (line(1:4) .ne. '#FDA' .and.
|
||||
1 line .ne. '#DAVE ASCII OUTPUT') goto 100
|
||||
1 read(lun, '(a)', err=100, end=100) line
|
||||
i = index(line,':')
|
||||
if (i .gt. 1) then
|
||||
call str_lowcase(line(1:i), line(1:i))
|
||||
if (line(i+1:i+1) .eq. ' ') i=i+1
|
||||
if (line(1:i) .eq. '#instrument:') then
|
||||
call putval('Instrument='//line(i+1:), 0.0)
|
||||
else if (line(1:i) .eq. '#sample:') then
|
||||
call putval('Sample='//line(i+1:), 0.0)
|
||||
else if (line(1:i) .eq. '#title:') then
|
||||
call putval('Title='//line(i+1:), 0.0)
|
||||
else if (line(1:i) .eq. '#x units:') then
|
||||
call putval('XAxis='//line(i+1:), 0.0)
|
||||
else if (line(1:i) .eq. '#y units:') then
|
||||
call putval('YAxis='//line(i+1:), 0.0)
|
||||
else if (line(1:i) .eq. '#group label:') then
|
||||
call putval('ZAxis='//line(i+1:), 0.0)
|
||||
zaxis = line(i+1:)
|
||||
else if (line(1:12) .eq. '#temperature') then
|
||||
f = 0
|
||||
read(line(i+1:), *, iostat=iostat) f
|
||||
if (f .ne. 0) call putval('Temp', f)
|
||||
endif
|
||||
else
|
||||
call str_lowcase(line, line)
|
||||
endif
|
||||
if (line .ne. '#begin') goto 1
|
||||
|
||||
call fit_dat_pdp_idx(zaxis, ipdp)
|
||||
|
||||
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
|
||||
i2=999999
|
||||
else
|
||||
i2=i1
|
||||
endif
|
||||
endif
|
||||
call dat_get_index(idx)
|
||||
if (idx .ne. 0) then
|
||||
i1=i1+idx-1
|
||||
i2=i1
|
||||
endif
|
||||
|
||||
j=0
|
||||
iset=1
|
||||
gval=0
|
||||
m=0
|
||||
|
||||
3 read(lun, '(a)', err=90, end=90) line
|
||||
4 call str_lowcase(line, line)
|
||||
if (line(1:13) .eq. '#group value:') then
|
||||
gval=0
|
||||
read(line(14:), *, err=41, end=41) gval
|
||||
41 continue
|
||||
endif
|
||||
if (line(1:1) .eq. '#') goto 3
|
||||
|
||||
j0=j
|
||||
|
||||
5 continue
|
||||
read(line, *, err=20,end=20) x,y,s
|
||||
if (s .gt. 0.0 .and. iset .ge. i1) then
|
||||
if (j .ge. nmax) then
|
||||
i2=iset
|
||||
print *,'DAT_FDA: too many data points, truncated'
|
||||
goto 29
|
||||
endif
|
||||
j=j+1
|
||||
ww(j)=1.0
|
||||
ss(j)=s
|
||||
yy(j)=y
|
||||
xx(j)=x
|
||||
endif
|
||||
20 continue
|
||||
read(lun, '(a)', err=29, end=29) line
|
||||
if (line(1:1) .ne. '#') goto 5
|
||||
|
||||
29 iset=iset+1
|
||||
|
||||
if (j .gt. j0) then
|
||||
m=m+1
|
||||
if (ipdp .ne. 0) then
|
||||
call fit_dat_pdp_set(ipdp, m, gval)
|
||||
endif
|
||||
call fit_dat_table(m, 1, j-j0)
|
||||
endif
|
||||
if (iset .le. i2) goto 4
|
||||
|
||||
90 nread=j
|
||||
call putval('Monitor', 0.0)
|
||||
close(lun)
|
||||
return
|
||||
|
||||
99 print *,'DAT_FDA: error during read'
|
||||
98 nread=-2
|
||||
rewind lun
|
||||
return
|
||||
|
||||
100 nread=-1
|
||||
rewind lun
|
||||
end
|
||||
Reference in New Issue
Block a user