Initial commit
This commit is contained in:
290
gen/dat_lnsp.f
Normal file
290
gen/dat_lnsp.f
Normal file
@ -0,0 +1,290 @@
|
||||
subroutine dat_lnsp
|
||||
c -------------------
|
||||
|
||||
external dat_lnsp_desc
|
||||
external dat_lnsp_opts
|
||||
external dat_lnsp_read
|
||||
|
||||
integer dtype/0/
|
||||
|
||||
call dat_init_desc(dtype, dat_lnsp_desc)
|
||||
call dat_init_opts(dtype, dat_lnsp_opts)
|
||||
call dat_init_read(dtype, dat_lnsp_read)
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_lnsp_desc(text)
|
||||
! ------------------------------
|
||||
character*(*) text ! (out) description
|
||||
|
||||
! type description
|
||||
! ----------------------------------
|
||||
text='LNSP LNS powder Ascii format (DMC, HRPT)'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_lnsp_opts
|
||||
! ------------------------
|
||||
print '(x,a)'
|
||||
1,'x: xaxis (2theta,d,Q), default= 2theta'
|
||||
1,'lambda: used for transformation, if not given if file'
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_lnsp_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
|
||||
character line*132, title*80, short*8
|
||||
character date*20, preset*4, instr*8
|
||||
character xaxis*64
|
||||
integer npk
|
||||
integer i, l, j
|
||||
real ymon
|
||||
real meastime, lambda, temp, dtemp
|
||||
real uur
|
||||
real xmin, xstep, xend, xval, fact
|
||||
real yint(0:99)
|
||||
logical overflow
|
||||
external dat_lnsp_val
|
||||
|
||||
|
||||
nread=0
|
||||
preset=' '
|
||||
overflow=.false.
|
||||
xstep=0
|
||||
ymon=0
|
||||
|
||||
read(lun,'(a)',err=900,end=900) line
|
||||
rewind lun
|
||||
|
||||
i=index(line, ',')
|
||||
if (i .gt. 1 .and. i .le. 9) then
|
||||
instr=line(1:i-1)
|
||||
else
|
||||
instr=' '
|
||||
endif
|
||||
if (instr .eq. ' ') then
|
||||
if (line(32:40) .eq. 'Phase No:') then ! fullprof sub output
|
||||
read(line(1:31), *, err=901,end=901) xmin, xstep, xend
|
||||
title=line(32:)
|
||||
read(lun,*,err=901,end=901)
|
||||
instr='fp'
|
||||
else
|
||||
if (forced .le. 0 .and. line(64:67) .ne. 'YTIM') then
|
||||
inquire(lun, name=line)
|
||||
call sys_parse(short, l, line, ' ', 2)
|
||||
call str_upcase(short(1:4), short(1:4))
|
||||
if (short(1:4) .ne. '.DMC') goto 900
|
||||
endif
|
||||
instr='DMC'
|
||||
endif
|
||||
elseif (instr .ne. 'DMC' .and. instr .ne. 'HRPT'
|
||||
1 .and. instr .ne. 'LNSP') then
|
||||
goto 900
|
||||
endif
|
||||
|
||||
call dat_start_options
|
||||
xaxis=' '
|
||||
call dat_str_option('x', xaxis)
|
||||
lambda=0.0
|
||||
call dat_real_option('lambda', lambda)
|
||||
|
||||
call dat_group(1, putval)
|
||||
if (instr .eq. 'fp') goto 108
|
||||
|
||||
read(lun,'(a)',err=99,end=99) line
|
||||
if (line(64:67) .eq. 'YTIM') then ! old header
|
||||
date=' '
|
||||
meastime=0.0
|
||||
read(line, '(21x,a20,27x,f8.0)', err=101,end=101) date, meastime
|
||||
101 read(lun, '(a)',err=901,end=99) title
|
||||
if (title(67:69) .eq. 'WL:') then
|
||||
if (lambda .eq. 0.0) then
|
||||
read(title(70:80), *, err=102,end=99) lambda
|
||||
endif
|
||||
title(67:)=' '
|
||||
102 continue
|
||||
endif
|
||||
temp=0
|
||||
dtemp=0
|
||||
uur=0
|
||||
read(lun, '(3f8.0,8x,f8.0,3x,f5.0,8x,f8.0,5x,f8.0)'
|
||||
1 , err=103,end=99)
|
||||
1 xmin, xstep, xend, temp, dtemp, uur, ymon
|
||||
103 if (temp .ne. 0) then
|
||||
call putval('Temp', temp)
|
||||
if (dtemp .ne. 0) call putval('dTemp', dtemp)
|
||||
endif
|
||||
if (date .ne. ' ') call putval('Date='//date, 0.0)
|
||||
call dat_group(2, putval)
|
||||
if (meastime .ne. 0) call putval('MeasTime', meastime)
|
||||
if (uur .ne. 0) call putval('MuR', uur)
|
||||
if (ymon .gt. 0) ymon=ymon*1000.
|
||||
else ! new header
|
||||
title=line(6:)
|
||||
read(lun,'(a)',err=99,end=99) line
|
||||
call dat_delimiters(',','=','''')
|
||||
call dat_intprt(line, dat_lnsp_val, putval)
|
||||
read(lun,'(a)',err=99,end=99) line
|
||||
read(line, *, err=107,end=107) xmin, xstep, xend, ymon
|
||||
107 j=index(line, ',')
|
||||
call dat_delimiters(',','=',' ')
|
||||
if (j .ne. 0 .and. line(j+1:) .ne. ' ') then
|
||||
call dat_intprt(line(j+1:), dat_lnsp_val, putval)
|
||||
endif
|
||||
endif
|
||||
108 if (xstep .eq. 0) goto 901
|
||||
|
||||
if (ymon .gt. 0) then
|
||||
preset='MN'
|
||||
elseif (ymon .lt. 0) then
|
||||
ymon=-ymon
|
||||
preset='TI'
|
||||
else
|
||||
ymon=0. ! was 1.
|
||||
endif
|
||||
|
||||
call dat_group(3, putval)
|
||||
if (preset .ne. ' ') call putval('Preset='//preset, 0.0)
|
||||
if (lambda .eq. 0.0) then
|
||||
call sym_get_real('lambda', lambda)
|
||||
else if (lambda .ne. 0.0) then
|
||||
call putval('lambda', lambda)
|
||||
endif
|
||||
call dat_powder_init(lambda, '2theta', xaxis)
|
||||
|
||||
if (xstep .eq. 0) goto 901
|
||||
npk=nint((xend-xmin)/xstep)+1
|
||||
|
||||
! read intensity block
|
||||
do i=0,npk-1,10
|
||||
read(lun, '(10F8.0)', err=902,end=902) (yint(j),j=0,9)
|
||||
do j=0,min(9,npk-1-i)
|
||||
if (nread .ge. nmax) then
|
||||
if (.not. overflow) then
|
||||
print *,'DAT_LNSP: Too many datapoints, truncated'
|
||||
overflow=.true.
|
||||
endif
|
||||
else
|
||||
xval=xmin+nread*xstep
|
||||
nread=nread+1
|
||||
call dat_powder_trf(xval, xx(nread), fact)
|
||||
yy(nread)=yint(j)*fact
|
||||
ww(nread)=fact
|
||||
if (yint(j) .gt. 0) then
|
||||
ss(nread)=sqrt(yint(j))
|
||||
else
|
||||
ss(nread)=0.0
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! read sigma block
|
||||
yint(0)=0
|
||||
do i=1,npk,10
|
||||
read(lun, '(10F8.0)', err=290,end=290) (yint(j),j=0,9)
|
||||
do j=0,9
|
||||
if (i+j .ge. nread) goto 202
|
||||
ss(i+j)=yint(j)
|
||||
enddo
|
||||
enddo
|
||||
202 goto 500
|
||||
|
||||
290 if (i .le. 1 .and. yint(0) .eq. 0) then
|
||||
if (instr .ne. 'fp') then
|
||||
print *,'--- Old LNSP format, no sigma block'
|
||||
endif
|
||||
else
|
||||
print *,'--- Error in sigma block'
|
||||
endif
|
||||
|
||||
500 do i=1,nread
|
||||
if (ss(i) .eq. 0.0) then
|
||||
ss(i)=1.0
|
||||
else
|
||||
ss(i)=ss(i)*ww(i)
|
||||
endif
|
||||
ww(i)=ymon
|
||||
enddo
|
||||
call dat_group(3, putval)
|
||||
if (xaxis .eq. ' ') then
|
||||
call putval('XAxis=2-Theta [deg]', 0.0)
|
||||
else
|
||||
call putval('XAxis='//xaxis, 0.0)
|
||||
endif
|
||||
call putval('YAxis=Intensity', 0.0)
|
||||
call dat_group(1, putval)
|
||||
call putval('Monitor', ymon)
|
||||
call str_trim(title, title, l)
|
||||
call putval('Title='//title(1:l), 0.0)
|
||||
call putval('Instrument='//instr, 0.0)
|
||||
call sym_read(lun, dat_lnsp_val)
|
||||
|
||||
990 close(lun)
|
||||
return
|
||||
|
||||
! error messages
|
||||
|
||||
900 nread=-1
|
||||
rewind lun
|
||||
return
|
||||
|
||||
901 print *,'DAT_LNSP: Error in header'
|
||||
goto 990
|
||||
|
||||
902 print *,'DAT_LNSP: Error in intensity block'
|
||||
goto 990
|
||||
|
||||
99 print *,'DAT_LNSP: error during read'
|
||||
rewind lun
|
||||
nread=-2
|
||||
return
|
||||
end
|
||||
|
||||
|
||||
subroutine dat_lnsp_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 .eq. 0) then ! numeric
|
||||
if (str .eq. 'T') then
|
||||
call putval('Temp', val)
|
||||
return
|
||||
elseif (str .eq. 'dT') then
|
||||
call putval('dTemp', val)
|
||||
return
|
||||
elseif (str .eq. ' ') then
|
||||
return
|
||||
endif
|
||||
else
|
||||
if (str(1:i) .eq. 'Filelist=') return
|
||||
endif
|
||||
call putval(str, val)
|
||||
end
|
||||
Reference in New Issue
Block a user