subroutine dat_sics c ------------------- external dat_sics_desc external dat_sics_opts external dat_get_datanumber external dat_sics_read integer dtype/0/ call dat_init_desc(dtype, dat_sics_desc) call dat_init_opts(dtype, dat_sics_opts) call dat_init_high(dtype, dat_get_datanumber) call dat_init_read(dtype, dat_sics_read) end subroutine dat_sics_desc(text) ! ------------------------------ character*(*) text ! (out) description ! type description ! ---------------------------------- text='SICS SICS-ASCII (TOPSI,TriCS)' end subroutine dat_sics_opts ! ------------------------ print '(x,a)' 1,'x,y: x-axis and y-axis column name' end subroutine dat_sics_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) real y,s,r,f,ymon,values(mcol),val integer i,j,l,errcnt,ncol,ycol,pcol,xcol,ycol2,ipol,xcol0 integer iostat, lz logical pol character line*132, preset*16, col2*16 character xaxis*16, xaxis0*16, yaxis*16, yaxis2*16 read(lun,'(a)',err=100,end=100) line if (line(1:16) .eq. '##SICS ASCII at ') then call putval('Instrument='//line(17:),0.0) else i=index(line,'Data File ****') if (i .eq. 0) i=index(line,'SCAN File ****') if (i .eq. 0) then if (forced .le. 0) goto 100 else j=index(line,'*** ') if (j .lt. i) call putval('Instrument='//line(j+4:i-2),0.0) endif endif nread=0 errcnt=0 xcol=0 xcol0=0 1 read(lun, '(a)', err=99,end=99) line iostat=1 if (line(1:20) .ne. 'Scanning Variables: ' 1 .and. line(1:20) .ne. 'scanning variables: ') then i=index(line,'=') if (i .le. 1) goto 1 call str_first_nonblank(line(i+1:), j) call str_trim(line(1:i-1), line(1:i-1), l) iostat=1 if (line(1:l) .eq. 'Sample Name') then l=6 elseif (line(1:l) .eq. 'Original Filename' .or. 1 line(1:l) .eq. 'original_filename') then goto 1 elseif (line(1:l) .eq. 'Title' .or. 1 line(1:l) .eq. 'title') then call dat_group(1, putval) elseif (line(1:13) .eq. 'File Creation' .or. 1 line(1:4) .eq. 'date') then line(1:l)='Date' l=4 else if (line(i+j:i+j) .eq. '-' .or. 1 line(i+j:i+j) .ge. '0' .and. 1 line(i+j:i+j) .le. '9') then if (line(1:l) .eq. 'Sample Theta') then line(1:l)='2-theta' l=7 else if (line(1:l) .eq. 'Temperature' .or. 1 line(1:l) .eq. 'temp') then line(1:l)='Temp' l=4 endif lz=index(line(1:l),' ') if (lz .ne. 0) then if (line(lz:lz+4) .eq. ' zero') then l=lz+1 line(1:l)='Z'//line(1:lz) else line(1:l)=line(lz+1:l) l=l-lz endif endif if (index(line(i+j:),':') .ne. 0) then iostat=1 else read(line(i+j:), *, iostat=iostat) val endif endif if (iostat .eq. 0) then call putval(line(1:l), val) else call putval(line(1:l)//'='//line(i+j:), 0.0) endif if (line(1:l) .eq. 'wavelength') then call dat_group(2, putval) endif goto 1 endif l=index(line, 'Steps:') if (l .gt. 0) then do j=1,mcol values(j)=0 enddo read(line(l+6:), *,iostat=iostat) values do j=1,mcol if (values(j) .ne. 0) then xcol0=j+1 goto 19 endif enddo endif l=index(line(21:), ',') if (l .eq. 0) l=10 xaxis=line(21:20+l-1) 19 continue read(lun, '(a)', err=99,end=99) line l=index(line, 'Mode: ') if (l .ne. 0) then preset=line(l+6:) l=index(preset, ',') if (l .eq. 0) goto 99 preset(l:)=' ' call putval('Preset='//preset, 0.0) l=index(line, 'Preset') if (l .eq. 0) goto 99 read(line(l+6:), *, err=99,end=99) ymon pol=.false. else ! polarized scan 22 read(lun, '(a)', err=99,end=99) line if (line(1:17) .eq. 'zero for plotting') goto 22 preset='mn' ymon=0 pol=.true. endif ipol=1 yaxis2=' ' call dat_start_options i=0 call dat_str_option('x', xaxis) yaxis='Counts' call dat_str_option('y', yaxis) call dat_str_option('y2', yaxis2) if (yaxis .eq. '1') then if (pol) then yaxis='up' else yaxis='Monitor1' endif elseif (yaxis .eq. '2') then if (pol) then yaxis='dn' else yaxis='Monitor2' endif elseif (yaxis .eq. '3') then yaxis='Monitor3' else if (yaxis .eq. 'Counts') then if (pol) then yaxis='up' yaxis2='dn' ipol=2 endif endif read(lun,'(a)',err=99,end=99) line i=1 line(len(line):len(line))=' ' ncol=0 ycol=0 ycol2=0 pcol=0 col2=' ' 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. 2) col2=line(l:i) if (line(l:i) .eq. yaxis .and. ycol .eq. 0) then ycol=ncol elseif (line(l:i) .eq. yaxis2 .and. ycol2 .eq. 0) then ycol2=ncol elseif (line(l:i) .eq. preset .or. 1 line(l:i) .eq. 'Monitor1' .and. preset .eq. 'Monitor') then pcol=ncol elseif (line(l:i) .eq. xaxis) then xcol=ncol elseif (xcol0 .eq. ncol) then xaxis0 = line(l:i) endif goto 31 39 if (ycol .eq. 0) goto 99 if (xcol .eq. 0) then if (xcol0 .ne. 0) then xcol = xcol0 xaxis = xaxis0 else xcol=2 xaxis=col2 endif endif call dat_group(1, putval) call putval('XAxis='//xaxis, 0.0) call putval('YAxis='//yaxis, 0.0) if (ycol2 .eq. 0) ipol=1 l=min(mcol,max(xcol,pcol,ycol,ycol2)) 40 read(lun,'(a)',end=88,err=88) line if (line .eq. ' ') goto 40 if (line .eq. 'END-OF-DATA') goto 88 read(line,*,err=99,end=99) (values(j),j=1,l) if (nread .ge. nmax) goto 29 if (pcol .eq. 0) then if (ymon .eq. 0) ymon=1. r=ymon else r=values(pcol) 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 do i=1,ipol nread=nread+1 xx(nread)=values(xcol) if (i .eq. 1) then y=values(ycol) else y=values(ycol2) endif 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 enddo goto 40 29 print *,'too many points - truncated' 88 close(lun) if (ipol .gt. 0) then call fit_dat_table(1, ipol, (nread+ipol-1)/ipol) endif call putval('NP', nread*1.0) call putval('Monitor', ymon) return 99 nread=-2 rewind lun print *,'DAT_SICS: error during read' call putval('Monitor', 0.0) return 100 nread=-1 rewind lun call putval('Monitor', 0.0) end