211 lines
5.2 KiB
Fortran
211 lines
5.2 KiB
Fortran
program csc
|
|
|
|
* convert single crystal data
|
|
* ^ ^ ^
|
|
*
|
|
* converts any data format read by FIT to inputfile for
|
|
* TVtueb (E2, HMI Berlin)
|
|
*
|
|
* > myfit -o csc csc.f
|
|
*
|
|
* Nov.03 L.Keller
|
|
* Dec.03 M.Zolliker (merged DMC + HRPT Version, 1 pass)
|
|
|
|
implicit none
|
|
|
|
! max. number of files, max. number of points
|
|
integer mf,mp
|
|
parameter (mf=2000,mp=1600)
|
|
|
|
real int1(mp),tth(mp)
|
|
real tem(mf),omega(mf),mon(mf),tth0(mf)
|
|
real lambda,dtth,lasttth,lastint
|
|
real reverse,omegasign
|
|
integer i,j,f,l,n,np,flag,nfiles,linstr
|
|
integer intall(mp,mf), int2(mp)
|
|
character*32 sample,owner,date,title,instr
|
|
character*1024 list
|
|
|
|
call fit_init
|
|
|
|
call dat_ask_filelist(list,' ')
|
|
|
|
flag=0
|
|
|
|
call fit_dat_next(list,flag)
|
|
|
|
call fit_get_real('lambda',lambda)
|
|
call fit_get_str('owner',l,owner)
|
|
call fit_get_str('sample',l,sample)
|
|
call fit_get_str('title',l,title)
|
|
call fit_get_str('date',l,date)
|
|
|
|
call fit_get_str('instrument',linstr,instr)
|
|
if (instr .eq. 'DMC') then
|
|
omegasign=-1 ! Vorzeichenwechsel von A3
|
|
dtth=0.2
|
|
reverse=-1 ! for historical reasons, revert output
|
|
np=400
|
|
elseif (instr .eq. 'HRPT') then
|
|
omegasign=1
|
|
dtth=0.1
|
|
reverse=-1
|
|
np=1600
|
|
else
|
|
write(*,*) 'unknown instrument: ',instr
|
|
stop
|
|
endif
|
|
|
|
write(*,*)
|
|
write(*,*)'processing ...'
|
|
write(*,*)
|
|
|
|
do f=1,mf
|
|
|
|
call fit_get_real('a3',omega(f))
|
|
call fit_get_real('temp',tem(f))
|
|
call fit_get_real('smon',mon(f))
|
|
|
|
call fit_get_array('X',tth,mp,n)
|
|
call fit_get_array('Y',int1,mp,n)
|
|
|
|
j=0
|
|
lasttth=tth(1)
|
|
lastint=int1(1)
|
|
do i=1,n
|
|
do while ((tth(i)-lasttth)/dtth .gt. 1.5) ! step is higher than 1.5 times step
|
|
j=j+1
|
|
intall(j,f)=nint((lastint+int1(i))*0.5)
|
|
lasttth=lasttth+dtth
|
|
enddo
|
|
j=j+1
|
|
lastint=int1(i)
|
|
intall(j,f)=nint(lastint)
|
|
lasttth=tth(i)
|
|
enddo
|
|
! check if step and number of points is correct
|
|
if (nint((tth(n)-tth(1))/dtth) .ne. np-1 .or. j .ne. np) then
|
|
print *,'step ',dtth,' np ',j
|
|
print *,'theta-range', tth(1), tth(n)
|
|
print *,'mismatch'
|
|
stop
|
|
endif
|
|
tth0(f)=tth(1)
|
|
|
|
! print '(''+'',i5)',f
|
|
print '(a1,i5,a1,$)','+',f,13
|
|
|
|
call fit_dat_silent
|
|
call fit_dat_next(list,flag)
|
|
|
|
if (flag.eq.0) then
|
|
nfiles=f
|
|
goto 100
|
|
endif
|
|
|
|
enddo
|
|
write(*,*)'too many files - fatal error'
|
|
stop
|
|
100 continue
|
|
write(*,*)
|
|
nfiles=f
|
|
|
|
open(1,file='csc.asc',status='unknown')
|
|
print *,'create csc.asc'
|
|
|
|
write(1,'(a14)')'SYS$SYSDEVICE:'
|
|
write(1,*)
|
|
write(1,'(a6,a64)')'NUMOR ',list
|
|
write(1,*)
|
|
write(1,'(3a)')'EXPTYPE ',instr(1:linstr),',SINQ'
|
|
write(1,*)
|
|
write(1,'(a3,x,a32)')'USN',owner
|
|
write(1,*)
|
|
write(1,'(a3,x,F6.4)')'WAV',lambda
|
|
write(1,*)
|
|
write(1,'(a,i6,a)') 'WIND W1= 1,',np,
|
|
& ' W2= 0, 0 W3= 0, W4= 0, 0'
|
|
write(1,*)
|
|
write(1,'(a9)')'PASS TTHS'
|
|
write(1,*)
|
|
write(1,'(a9)')'PRO T_SAM'
|
|
write(1,*)
|
|
write(1,'(a8,i12)')'MM1 MON=',nint(mon(1))
|
|
write(1,*)
|
|
write(1,'(a,e12.5,a,e12.5,a,e12.5)')
|
|
& 'RELA TTHS=',1.0*np,',',1.0*np,',',reverse*dtth
|
|
write(1,*)
|
|
write(1,'(a3,x,a32)')'SAM',sample
|
|
write(1,*)
|
|
write(1,'(a5,x,a32)')'TITLE',title
|
|
write(1,*)
|
|
write(1,'(a10,i6,x,a4)')'SETV STEP=',nfiles,'OMGS'
|
|
write(1,*)
|
|
write(1,'(a12,e12.5)')'READ T_MEAN=',tem(1)
|
|
write(1,*)
|
|
write(1,'(a4,x,a32)')'DATE',date
|
|
write(1,*)
|
|
write(1,'(a3,x,a32)')'COM',title
|
|
write(1,*)
|
|
write(1,*)
|
|
|
|
|
|
do f=1,nfiles
|
|
|
|
if (reverse .lt. 0) then
|
|
j=np
|
|
do i=1,np
|
|
int2(j)=intall(i,f)
|
|
tth(j)=tth0(f)+dtth*(i-1)
|
|
j=j-1
|
|
enddo
|
|
else
|
|
do i=1,np
|
|
int2(i)=intall(i,f)
|
|
tth(i)=tth0(f)+dtth*(i-1)
|
|
enddo
|
|
endif
|
|
|
|
write(1,'(a9)')'SETVALUES'
|
|
write(1,'(a4,F12.4)')'OMGS',omegasign*omega(f)
|
|
write(1,*)
|
|
write(1,*)
|
|
write(1,'(a14)')'PROTOCOLVALUES'
|
|
write(1,'(a5,F12.4)')'T_SAM',tem(f)
|
|
write(1,*)
|
|
write(1,*)
|
|
write(1,'(a13)')'MASTER1VALUES'
|
|
write(1,'(a3)')'MM1'
|
|
write(1,'(a3,i12)')'MON',nint(mon(f))
|
|
write(1,'(a3)')'SL1'
|
|
write(1,'(a4,F12.4)')'TTHS',tth0(f)
|
|
write(1,'(a4)')'LDET'
|
|
write(1,'(a2)')'W1'
|
|
|
|
do i=1,np,10
|
|
write(1,'(x,i4,a1,F7.2,10I12)')i,'/',tth(i),
|
|
& (int2(j),j=i,min(np,i+9))
|
|
enddo
|
|
|
|
write(1,'(a18,a27,a15)')'PEAK','BACKGROUND','INTEGRAL'
|
|
write(1,'(F12.4,4i12)')0.0,0,0,0,1
|
|
write(1,'(a16)')'TIM1 1'
|
|
write(1,*)
|
|
write(1,*)
|
|
write(1,'(a14)')'PROTOCOLVALUES'
|
|
write(1,'(a5,F12.4)')'T_SAM',tem(f)
|
|
write(1,*)
|
|
write(1,*)
|
|
|
|
enddo
|
|
200 continue
|
|
|
|
write(1,'(a14)')'DATE 01-JAN-01'
|
|
write(1,*)
|
|
write(1,'(a13)')'TIME 01:01:01'
|
|
write(1,*)
|
|
|
|
close(1)
|
|
|
|
end
|