95 lines
2.1 KiB
Fortran
95 lines
2.1 KiB
Fortran
program addei
|
|
|
|
implicit none
|
|
|
|
integer i, n, listflag, l, iostat, numor, j, la, lo
|
|
character*1024 list
|
|
character*256 filename
|
|
character*256 outname
|
|
character line*256, axis*8
|
|
real fx,kfix,val,en(999),ei
|
|
|
|
call fit_init
|
|
|
|
list=' '
|
|
call sys_get_cmdpar(list, l)
|
|
if (list .eq. ' ') then
|
|
call dat_ask_filelist(list,' ')
|
|
endif
|
|
listflag=0
|
|
|
|
c treat no more than 9999 files
|
|
do i=1,9999
|
|
|
|
call fit_dat_options('x=en')
|
|
call fit_dat_silent
|
|
call fit_dat_next(list,listflag)
|
|
c exit loop when finished
|
|
if (listflag.eq.0) goto 999
|
|
call fit_get_real('Numor', val)
|
|
numor = val
|
|
call fit_get_real('FX', fx)
|
|
call fit_get_real('KFIX', kfix)
|
|
ei=kfix*kfix*2.072
|
|
call fit_get_array('x', en, 999, n)
|
|
call fit_get_str('File', l, filename)
|
|
do j=l,1,-1
|
|
if (filename(j:j) .eq. '/') then
|
|
outname=filename(j+1:l)
|
|
lo=l-j
|
|
goto 200
|
|
endif
|
|
enddo
|
|
outname=filename
|
|
lo=l
|
|
200 continue
|
|
call fit_get_str('XAxis', la, axis)
|
|
if (axis .ne. 'EN') then
|
|
print *,outname(1:lo),'(column EN not found)'
|
|
goto 900
|
|
endif
|
|
call sys_open(1, filename(1:l), 'r', iostat)
|
|
if (iostat .ne. 0) then
|
|
print *,'can not open ',filename(1:l)
|
|
goto 999
|
|
endif
|
|
|
|
if (outname(lo:lo) .eq. 'c') then
|
|
outname(lo:lo) = 't'
|
|
else
|
|
outname(lo:lo) = 'c'
|
|
endif
|
|
call sys_open(2, outname(1:lo), 'w', iostat)
|
|
if (iostat .ne. 0) then
|
|
print *,'can not create ',outname(1:lo)
|
|
goto 999
|
|
endif
|
|
print *,outname(1:lo),' created'
|
|
read(1, '(a)', iostat=iostat) line
|
|
call str_trim(line, line, l)
|
|
do while (iostat .eq. 0 .and. line(1:4) .ne. 'DATA')
|
|
write(2,'(a)') line(1:l)
|
|
read(1, '(a)', iostat=iostat) line
|
|
enddo
|
|
read(1, '(a)', iostat=iostat) line
|
|
call str_trim(line, line, l)
|
|
write(2, '(2a)') line(1:l),' EI'
|
|
call str_trim(line, line, l)
|
|
do j=1,n
|
|
read(1, '(a)', iostat=iostat) line
|
|
if (iostat .ne. 0) goto 900
|
|
if (fx .eq. 1) then
|
|
write(2,'(a,f10.4)') line(1:l),ei
|
|
else
|
|
write(2,'(a,f10.4)') line(1:l),ei-en(j)
|
|
endif
|
|
enddo
|
|
close(1)
|
|
close(2)
|
|
900 continue
|
|
enddo
|
|
|
|
999 continue
|
|
|
|
end
|