subroutine dat_fit3 c ------------------- external dat_fit3_desc external dat_fit3_read external handler integer dtype/0/ call dat_init_desc(dtype, dat_fit3_desc) call dat_init_read(dtype, dat_fit3_read) return entry dat_fit3_replace(handler) call dat_init_read(dtype, handler) end subroutine dat_fit3_desc(text) ! ------------------------------ character*(*) text ! (out) description ! type description ! ---------------------------------- text='FIT3 Fit data file' end subroutine dat_fit3_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 n,nu0,i,j,ififu0 real ymon0 character line*132 external dat_fit3_val real y, s read(lun, '(A)',err=100,end=100) line if (line(1:8) .ne. 'FitSave ' .or. line(9:11) .lt. '3.3') goto 100 if (line(9:11) .lt. '3.4') then read(lun,*,err=100,end=100) ! filename endif nu0=0 read(lun, *, err=99,end=99) nu0,ififu0 do i=1,nu0 read(lun,*,err=99,end=99) enddo if (ififu0 .eq. 7) read(lun,*,err=99,end=99) if (line(9:11) .lt. '3.4') then n=0 ymon0=0 read(lun, *, err=99,end=99) n,ymon0 if (ymon0 .le. 0) ymon0=1 call putval('Monitor', ymon0) else call dat_delimiters(';', '=', '''') 10 read(lun, '(a)', err=99,end=99) line call str_trim(line, line, i) if (line(1:i) .eq. ' ') goto 19 j=1 11 if (line(j:j) .eq. ' ') then j=j+1 goto 11 endif call dat_group(j-1, putval) call dat_intprt(line(j:i), dat_fit3_val, putval) goto 10 19 continue endif i=0 20 i=i+1 if (i .gt. nmax) then print *,'too many data points --> truncated' goto 29 endif read(lun,'(a)',err=99,end=29) line j=index(line,'/') ! for compatibility with versions 3.3 and older if (j .gt. 0) line(j:)=' ' ! " ! read(line,'(bn,4f20.0,i20)') xx(i),y,s,ww(i),j read(line,*,err=99,end=99) xx(i),y,s,ww(i),j ss(i)=s yy(i)=y nread=i goto 20 29 close(lun) return 99 print *,'error in FitSave file' nread=-2 rewind lun return 100 nread=-1 rewind lun end subroutine dat_fit3_val(str, val, putval) character*(*) str real val external putval integer i if (val .eq. 0) then i=index(str, '=') else i=0 endif if (i .gt. 1) then if (str(1:i-1) .eq. 'File') return endif call putval(str, val) end