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