Initial commit
This commit is contained in:
317
gen/dat_sics.f
Normal file
317
gen/dat_sics.f
Normal file
@ -0,0 +1,317 @@
|
||||
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
|
||||
Reference in New Issue
Block a user