Files
fit/pgm/clamp.f
2022-08-19 15:22:33 +02:00

153 lines
4.0 KiB
Fortran

program mclamp
* mclamp = multi convert to lamp format
* ^^^^^^ ^ ^ ^^^^
* preparation program for 3d plots in LAMP
* converts all the data formats recognized by FIT into LAMP format
*
* > myfit clamp.f
* > mv a.out clamp
* 6.2.01 LK / 26.8.02 MZ
*
* To be done:
* - if the input files do not have the same x-range, the output may be wrong
* - instead of 'number of files to merge' a tolerance in temperature
* should be given, and clamp should merge automatically
*
implicit none
real int1(4000),tth(4000),step,y(1000),tem(1000)
integer i,j,f,l,n,np,flag,int2(4000)
integer merg, numor1, numor2
real rnum, ymon
character*20 sample
character*1024 list
character*4 yflag
call fit_init
do i=1,4000
int1(i)=0.
enddo
print *,'number of files to merge:'
read(*,'(i20)') merg
if (merg .le. 0) merg=1
print *,'step for merge [0.025]'
read(*,'(f20.0)') step
if (step .eq. 0) step=0.025
open(1,file='LAMPascii',status='unknown')
call dat_ask_filelist(list,' ')
flag=0
np=0
n=0
ymon=0
do f=1,1000*merg
call fit_dat_silent
call fit_dat_next_opt(list,flag,0,step) ! DAT
call fit_get_real('Numor', rnum)
numor1=nint(rnum)
if (flag .eq. 0) goto 100
do j=2,merg
call fit_dat_silent
call fit_dat_next_opt(list,flag,3,step) ! LINK & MERGE
if (flag.eq.0) goto 50
enddo
call fit_get_real('Numor', rnum)
50 numor2=nint(rnum)
print *,'read numors',numor1,' to',numor2
call fit_merge(step)
if (ymon .eq. 0) then
call fit_auto_mon
call fit_get_real('Monitor', ymon)
else
call fit_mon(ymon)
endif
call fit_get_real('temp',tem(f))
call fit_get_str('sample',l,sample)
call fit_get_array('X',tth,4000,np)
call fit_get_array('Y',int1,4000,np)
do i=1,4000
int2(i)=nint(int1(i))
enddo
write(1,'(6i12)')(int2(j),j=1,np)
n=n+1
enddo
100 continue
close(1)
yflag='1'
105 print '(x,a)', 'x-axis: 2Theta'
print '(x,2a)', 'y-axis: File number [1] or Temperature [2]'
& ,' (default: 1): '
read(*,'(a)') yflag
print *
if (yflag.eq.' ') yflag='1'
if ((yflag.ne.'1').and.(yflag.ne.'2')) goto 105
open(3,file='LAMP',status='unknown')
write(3,'(x,a)')'LAMP_FORMAT'
write(3,'(x,a)')'HEADER FILE written by the LAMP APPLICATION'
write(3,*)
write(3,*)
write(3,'(x,a)')'DATA_FILE: LAMPascii'
write(3,'(x,a)')'SOURCE: clamp'
write(3,'(x,a)')'HISTORY: DMC/HRPT'
write(3,*)
write(3,'(x,a,i9)')'X_SIZE:',np
write(3,'(x,a,i9)')'Y_SIZE:',n
write(3,'(x,a,i9)')'Z_SIZE:',1
write(3,'(x,a)')'FORMAT: Ascii'
write(3,'(x,a)')'TYPE: (3 )Long Integer'
write(3,*)
write(3,'(x,a,i4,a,i3,a)')'MIN,MAX VALUES: w 1: Long dim =',np,
& ' * ',n,' min=0 max=9999'
write(3,*)
write(3,'(x,2a)')'TITLES: ',sample
write(3,'(x,a)')' X: 2Theta'
if (yflag.eq.'1') write(3,'(x,a)')' Y: File Number'
if (yflag.eq.'2') write(3,'(x,a)')' Y: Temperature'
write(3,'(x,a)')' Z: Counts'
write(3,*)
write(3,'(x,a)')'PARAMETERS:'
write(3,'(x,a)')'----------'
write(3,'(x,2a)')'Sample Name= ',sample
write(3,'(x,a)')'Temperature= '
write(3,*)
write(3,'(x,a)')'X_COORDINATES:'
write(3,'(x,a)')'-------------'
write(3,'(6f13.4)')(tth(j),j=1,np)
write(3,*)
write(3,'(x,a)')'Y_COORDINATES:'
write(3,'(x,a)')'-------------'
do i=1,n
y(i)=i
enddo
if (yflag.eq.'1') then
write(3,'(6f13.4)')(y(j),j=1,n)
else
write(3,'(6f13.4)')(tem(j),j=1,n)
endif
close(3)
end