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