subroutine dat_2t c ----------------- external dat_2t_desc ! external dat_2t_high ! this line for raw data files only external dat_2t_read integer dtype/0/ call dat_init_desc(dtype, dat_2t_desc) call dat_init_read(dtype, dat_2t_read) end subroutine dat_2t_desc(text) ! ---------------------------- character*(*) text ! (out) description ! type description ! ---------------------------------- text='2T 2T format (LLB Saclay)' end subroutine dat_2t_opts ! ---------------------- print '(x,a)' 1,'x: x-axis, y: y-axis' end subroutine dat_2t_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=32) character header*1024 character line*1024, xaxis*8, yaxis*8, name*8, col1*8 real values(32), s, y, ymon real tt, tm, ts, td integer i,j,l,ncol,ccol,xcol,tcol nread=0 read(lun,'(a)',err=98,end=98) header if (forced .le. 0) then if (header(1:11) .ne. '# qh') goto 100 endif header(1:1)=' ' read(lun,'(a)',err=98,end=98) line if (line(1:1) .ne. '#') goto 100 line(1:1)=' ' xaxis=' ' yaxis=' ' call dat_start_options call dat_str_option('x', xaxis) call dat_str_option('y', yaxis) call str_upcase(xaxis, xaxis) call str_upcase(yaxis, yaxis) call putval('Instrument=2T',0.0) call dat_group(2, putval) do i=1,mcol values(i)=0.0 enddo ncol=0 i=1 read(line, *, err=15,end=15) values 15 call str_get_elem(header, i, name) if (name .ne. ' ') then ncol=ncol+1 if (name .eq. 'm') then name='Monitor' ymon=values(ncol) call putval('Preset=m', 0.0) else if (name .eq. 't') then name='Monitor' ymon=values(ncol) call putval('Preset=t', 0.0) endif call putval(name, values(ncol)) goto 15 endif read(lun, '(a)') line if (line(1:1) .ne. '#') goto 100 read(lun, '(a)') line if (line(1:1) .ne. '#') goto 100 line(1:1)=' ' 12 i=1 line(len(line):len(line))=' ' ncol=0 ccol=0 xcol=0 tcol=0 col1=' ' 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. 1) col1=line(l:i) if (line(l:i) .eq. yaxis .or. yaxis .eq. ' ' 1 .and. line(l:i) .eq. 'comptage') ccol=ncol if (line(l:i) .eq. xaxis) xcol=ncol if (line(l:i) .eq. 'K') tcol=ncol goto 31 39 if (yaxis .eq. ' ') yaxis='comptage' if (ccol .eq. 0) then print *,'no values found for ',yaxis goto 99 endif if (xcol .eq. 0) then if (xaxis .ne. ' ') then print *,'no values found for ',xaxis,', take ',col1 endif xcol=1 xaxis=col1 endif call dat_group(2, putval) call putval('XAxis='//xaxis, 0.0) call putval('YAxis='//yaxis, 0.0) call dat_group(1, putval) l=min(mcol,max(xcol,ccol,tcol)) tm=0 ts=0 4 read(lun,*,err=19,end=9) (values(j),j=1,l) if (nread .ge. nmax) goto 29 y=values(ccol) if (y .gt. 0) then s=sqrt(y) ! statistical error of detector else s=1 endif nread=nread+1 xx(nread)=values(xcol) yy(nread)=y ss(nread)=s ww(nread)=ymon 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 endif goto 4 9 close(lun) call putval('Monitor', ymon) if (tcol .ne. 0) then call putval('Temp', tm) if (nread .gt. 1) call putval('dTemp', sqrt(ts/(nread-1))) endif return 19 print *,'DAT_2T: error at point ',nread goto 4 29 print *,'DAT_2T: too many points' goto 100 98 if (forced .le. 0) goto 100 99 print *,'DAT_2T: error during read' rewind lun nread=-2 return 100 nread=-1 rewind lun end