Source module last modified on Mon, 8 May 2006, 23:39;
HTML image of Fortran source automatically generated by
for2html on Mon, 29 May 2006, 15:06.
#//////////////////////////////////////////////////////////////////////
#////
#//// R E S T R A X 4.7
#////
#//// TAS configuration: read and convert parameters
#////
#////
#//////////////////////////////////////////////////////////////////////
#----------------------------------------------------
SUBROUTINE TAS_READCFG(sarg)
# Read *.cfg file
# 1) try CFGNAME
# 2) try 'default.cfg'
# 3) create default 'default.cfg' and read it
#----------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'res_cfg.inc'
character*(*) sarg
integer*4 u,iretry,i,ierr,il,n1,n2,ii,ll,ird
parameter (u=22)
character*128 line,name
integer*4 READ_MIRROR
100 format(a60)
101 format(a)
102 format( 'A new file default.cfg is created in current directory',
& ' with default values.')
103 format( 'Cannot find configuration file ',a,//,
& 'trying default.cfg... ')
201 format(
1 'title (max.60 characters) :'/
2 'default setup '/
3 'source (shape,diameter,width,height):'/
4 '0 10. 8. 8. '/
5 'n-guide (present, distance,length,hor1,hor2,ver1,ver2,',
* 'ro[m-1], gh, gv [Ni nat.], refh, refv):'/
6 '0 10. 6300. 2.5 2.5 15. 15. 2.4E-4 1 1 1 1'/
5 'monochromator (chi,aniz.,poiss.,thick.,height,length,',
* 'segments hor. & vert.):'/
7 '0.0 1 0.3 0.3 12.0 10.0 1 3 '/
8 'analyzer (chi,aniz.,poiss.,thick.,height,length,',
* 'segments hor. & vert.):'/
9 '0.0 1 0.3 0.3 12.0 10.0 1 3 '/
d 'detector (shape,diameter,width,height):'/
1 '1 4.0 3.0 5.0'/
2 'distances (l1,l2,l3,l4):'/
3 '900. 210. 150. 70.'/
6 '1st collimator (distance,length,hor1,hor2,ver1,ver2,',
* 'ro[m-1], gh, gv [Ni nat.], refh, refv):'/
7 '236. 534. 8.05 5. 9.05 11. 0. 0. 0. 1 1'/
8 '2nd collimator (distance,length,hor1,hor2,ver1,ver2,',
* 'ro[m-1], gh, gv [Ni nat.], refh, refv):'/
9 '87. 35. 4. 4. 7. 7. 0. 0. 0. 1 1'/
d '3nd collimator (distance,length,hor1,hor2,ver1,ver2,',
* 'ro[m-1], gh, gv [Ni nat.], refh, refv):'/
1 '60. 35. 4. 4. 7. 7. 0. 0. 0. 1 1'/
2 '4th collimator (distance,length,hor1,hor2,ver1,ver2,',
* 'ro[m-1], gh, gv [Ni nat.], refh, refv):'/
3 '35. 20. 4. 4. 12. 12. 0. 0. 0. 1 1')
iretry=0
call BOUNDS(sarg,ii,ll)
if (ll.gt.0) name=sarg(ii:ii+ll-1)
select case (ll)
case(0) ! empty argument: offer the current file and ask user
name=cfgname
ird=1
case default ! try argument as the filename
name=sarg(ii:ii+ll-1)
ird=0
end select
1 call OPENRESFILE(name, 'cfg',u,ird,0,name,ierr)
2 if(ierr.ne.0) then
if (name.ne. ' ') then ! try dialog
name= ' '
goto 1
else if(name(1:11).ne. 'default.cfg') then ! try default.cfg
write(sout,103)
name= 'default.cfg'
goto 1
else if (iretry.eq.0) then ! create new default.cfg
write(sout,102)
iretry=1
goto 10
else
goto 999
endif
endif
il=0
read(u,*,err=19)
il=il+1
read(u,100,err=19) cfgtitle
il=il+1
read(u,*,err=19)
il=il+1
tsrc=300.d0
read(u,101) line
read(line,*,err=701) nsrc,dsrc,wsrc,hsrc,tsrc
goto 702
701 read(line,*,err=19) nsrc,dsrc,wsrc,hsrc
tsrc=0
702 il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_col(i,1),i=1,12)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_cry(i,1),i=1,8)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_cry(i,2),i=1,8)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) ndet,ddet,wdet,hdet
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_dis(i),i=1,4)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_col(i,2),i=2,12)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_col(i,3),i=2,12)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_col(i,4),i=2,12)
il=il+1
read(u,*,err=19)
il=il+1
read(u,*,err=19) (tas_col(i,5),i=2,12)
close(u)
call BOUNDS(name,ii,ll)
cfgname=name(ii:ii+ll-1)
goto 50
# retry with default.cfg
19 write(sout,*) 'Error in the configuration file, line ',il+1
ierr=1
goto 2
# create new default.cfg
10 open(u,file= 'default.cfg',status= 'NEW',err=999)
write(u,201)
close(u)
go to 1
# file read, do some converisons
50 continue
call BOUNDS(cfgname,i,il)
write(sout,*) 'Configuration updated: ',cfgname(i:i+il-1)
# GAMA is in mrad/A
# RO is in mm^-1
il=0
do i=1,5
tas_col(c_gamah,i)=tas_col(c_gamah,i)*gammani
tas_col(c_gamav,i)=tas_col(c_gamav,i)*gammani
tas_col(c_roh,i)=tas_col(c_roh,i)/1000.
n1=READ_MIRROR(tas_col(c_gamah,i)) ! try to read mirror lookup table
n2=READ_MIRROR(tas_col(c_gamav,i))
if(n1.lt.0.or.n2.lt.0) il=-1
enddo
# if the mirror lookup table is full, clear the table and read CFG again
if(il.lt.0) then
n1=READ_MIRROR(-1.d0)
goto 1
endif
return
999 write(smes,998)
998 format( 'Fatal error: cannot create configuration file',/,
* 'Check privileges or disk space !')
stop
end
#--------------------------------------------------------------------------
SUBROUTINE TAS_TO_NESS
# Conversion of parameters from CFG and RESCAL fields to NESS
# TAS is defined with inverted primary spectrometer - tracing starts at the sample!
#--------------------------------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'rescal.inc'
INCLUDE 'res_cfg.inc'
# INCLUDE 'ness_common.inc'
INCLUDE 'restrax.inc'
logical*4 useguide
logical*4 emod
common /mode/ emod
real*8 ld,dum,ei0,ef0
integer*4 i
#/// general setting: scattering triangle, etc...
if (tsrc.gt.0) stemp=tsrc
stp.nfx=res_dat(i_fx)
stp.sm=res_dat(i_sm)
stp.ss=res_dat(i_ss)
stp.sa=res_dat(i_sa)
stp.kfix=res_dat(i_kfix)
stp.e=res_dat(i_en)
call QNORM(res_dat(i_qh),dum,stp.q)
# write(*,*) 'TAS_TO_NESS 1'
if (res_dat(i_fx).eq.1.) then
ei0=hsqov2m*res_dat(i_kfix)**2
ef0=ei0-stp.e
else
ef0=hsqov2m*res_dat(i_kfix)**2
ei0=ef0+stp.e
end if
if (ei0.le.0.or.ef0.le.0) goto 999
stp.ki=sqrt(ei0/hsqov2m)
stp.kf=sqrt(ef0/hsqov2m)
#/// sample:
smos=res_dat(i_etas)*minute/sqrt8ln2
# write(*,*) 'TAS_TO_NESS 2'
sam.name= 'sample'
sam.shape=1
sam.dist=0.
sam.axi=0.
do i=1,3
sou.sta(i)=0.
sou.gon(i)=0.
enddo
sam.size(1)=res_dat(i_sdi)*10.
sam.size(3)=res_dat(i_sdi)*10.
sam.size(2)=res_dat(i_shi)*10.
#/// Soller collimators
guide.frame.name= 'guide'
sol1.frame.name= 'col1'
sol2.frame.name= 'col2'
sol3.frame.name= 'col3'
sol4.frame.name= 'col4'
#xxxxxxxxxCxxxxxxxxxCxxxxxxxxxCxxxxxxxxxCxxxxxxxxxCxxxxxxxxxCxxxxxxxxxCx
ld=tas_col(c_dist,2)+tas_col(c_len,2)
call CREATE_COL(sol1,2,tas_dis(1)-ld,-1,0)
useguide=(tas_col(c_use,1).gt.0.and.tas_col(c_len,1).gt.0)
if (useguide) then
call CREATE_COL(guide,1,ld,-1,0)
else
call CREATE_COL(guide,1,1.d0,-1,0)
endif
# write(*,*) 'TAS_TO_NESS 3'
ld=tas_dis(2)-tas_col(c_dist,3)-tas_col(c_len,3)
call CREATE_COL(sol2,3,ld,-1,0)
# write(*,*) 'TAS_TO_NESS 4'
call CREATE_COL(sol3,4,tas_col(c_dist,4),1,0)
# write(*,*) 'TAS_TO_NESS 5'
call CREATE_COL(sol4,5,tas_col(c_dist,5),1,0)
# write(*,*) 'TAS_TO_NESS 6'
#/// monochromator:
mon.frame.name= 'monochromator'
call CREATE_CRY(mon,1,tas_dis(2)-sol2.frame.dist/10.,-1)
# write(*,*) 'TAS_TO_NESS 7'
if (stp.sm.lt.0) then
mon.frame.gon(1)=mon.thb-mon.chi+pi/2
sol1.frame.axi=mon.thb*2.
else if (stp.sm.gt.0) then
mon.frame.gon(1)=-mon.thb-mon.chi-pi/2
sol1.frame.axi=-mon.thb*2.
else
mon.frame.gon(1)=0. ! if SM=0, then a filter is considered instead of the analyzer
mon.thb=0. ! CRYST_GO recognizes this case if THB=0
sol1.frame.axi=0. ! dhkl determines the edge position, kc=pi/dhkl
mon.chi=pi/2.
mon.rh=0.
mon.rv=0.
mon.hmos=0.
mon.vmos=0.
endif
# set index where crystal takes random numbers from /RAND/ X array
mon.dnrnd=7
#/// source:
sou.name= 'source'
if(nsrc.eq.0) then
sou.shape=2
sou.size(1)=dsrc*10.
sou.size(2)=dsrc*10.
sou.size(3)=0.1
else
sou.shape=3
sou.size(1)=wsrc*10.
sou.size(2)=hsrc*10.
sou.size(3)=0.1
endif
sou.axi=0.
if (useguide) then
sou.dist=(tas_col(c_dist,1)+tas_col(c_len,1))*10.
else
# SOU.DIST is measured between SOURCE and GUIDE exit
# TAS_DIS(1) is measured between GUIDE exit and SOL1 entry
sou.dist=(tas_col(c_dist,2)+tas_col(c_len,2))*10.
sou.dist=sou.dist-guide.frame.dist
endif
do i=1,3
sou.sta(i)=0.
sou.gon(i)=0.
enddo
#/// analyzer:
ana.frame.name= 'analyzer'
# write(*,*) 'TAS_TO_NESS ',(TAS_CRY(I,2),I=1,8)
call CREATE_CRY(ana,2,tas_dis(3)-sol3.frame.dist/10.,1)
# write(*,*) 'TAS_TO_NESS 8'
if(stp.sa.eq.0) then
ana.frame.gon(1)=0. ! if SA=0, then a filter is considered instead of the analyzer
ana.thb=0. ! CRYST_GO recognizes this case if THB=0
sol4.frame.axi=0. ! dhkl determines the edge position, kc=2*pi/dhkl
ana.chi=pi/2.
ana.rh=0.
ana.rv=0.
ana.hmos=0
ana.vmos=0
else if(cfgmode.eq.1) then ! Option with scondary spectrometer turned up
if (stp.sa.gt.0) then
ana.frame.gon(1)=pi/2
ana.frame.gon(2)=-pi/2
ana.frame.gon(3)=ana.thb-ana.chi
sol4.frame.axi=0
sol4.frame.axv=-ana.thb*2.
else if (stp.sa.lt.0) then
ana.frame.gon(1)=-pi/2
ana.frame.gon(2)=+pi/2
ana.frame.gon(3)=-ana.thb+ana.chi
sol4.frame.axi=0
sol4.frame.axv=ana.thb*2.
endif
else
ana.frame.gon(2)=0
ana.frame.gon(3)=0
if (stp.sa.gt.0) then
ana.frame.gon(1)=ana.thb-ana.chi+pi/2.
sol4.frame.axi=ana.thb*2.
sol4.frame.axv=0
else if (stp.sa.lt.0) then
ana.frame.gon(1)=-ana.thb-ana.chi-pi/2.
sol4.frame.axi=-ana.thb*2.
sol4.frame.axv=0
endif
endif
# set index where crystal takes random numbers from /RAND/ X array
ana.dnrnd=8
#/// dector:
det.name= 'detector'
if(ndet.eq.0) then
det.shape=2
det.size(1)=ddet*10.
det.size(2)=ddet*10.
det.size(3)=0.1
else
det.shape=3
det.size(1)=wdet*10.
det.size(2)=hdet*10.
det.size(3)=0.1
endif
det.axi=0.
det.dist=tas_dis(4)*10.-sol4.frame.dist
do 30 i=1,3
det.sta(i)=0.
det.gon(i)=0.
30 continue
if((stp.sm.eq.0).or.(stp.sa.eq.0)) then
stp.e=hsqov2m*(stp.ki**2-stp.kf**2)
endif
sol2.bint=stp.tauf*hovm**2*stp.ki**3/2.d0/gammal*1.d7
sol3.bint=stp.tauf*hovm**2*stp.kf**3/2.d0/gammal*1.d7
mon.typ=0
if(emod) then
ana.typ=1
else
ana.typ=0
endif
# write(*,*) 'TAS_TO_NESS 9'
call SPEC_INITALL ! Initialize all TAS components
# write(*,*) 'TAS_TO_NESS'
# CALL WRITE_SETUP(20)
# write(*,*) 'TAS_TO_NESS OK'
return
999 write(smes,*) 'CHECK SCATTERING TRIANGLE !!!'
end
#---------------------------------------------------------
SUBROUTINE CREATE_CRY(cr,ic,cdist,dir)
# CR ... structure of CRYSTAL type
# IC ... index of the component (1=mono, 2=anal)
# CDIST ... distance in [cm] !!
# DIR ... direction downstream >0 or up-stream <0
#---------------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'rescal.inc'
INCLUDE 'restrax.inc'
INCLUDE 'res_cfg.inc'
integer*4 ic,dir
real*8 cdist
record /CRYSTAL/ cr
#/// monochromator:
cr.frame.shape=3
cr.frame.size(1)=tas_cry(c_x,ic)*10.
cr.frame.size(2)=tas_cry(c_y,ic)*10.
cr.frame.size(3)=tas_cry(c_z,ic)*10.
cr.frame.dist=cdist*10.
cr.frame.axi=0.
cr.chi=-dir*tas_cry(c_chi,ic)*deg
cr.dhkl=res_dat(i_dm+ic-1)
# write(*,*) 'CREATE ',CR.FRAME.NAME(1:6),CR.DHKL,STP.KI,STP.KF
if (ic.eq.1) then
cr.thb=asin(pi/cr.dhkl/stp.ki)
cr.lambda=2*pi/stp.ki
else
cr.thb=asin(pi/cr.dhkl/stp.kf)
cr.lambda=2*pi/stp.kf
endif
cr.rh=res_dat(i_romh+(ic-1)*2)/1000.
cr.rv=res_dat(i_romv+(ic-1)*2)/1000.
cr.hmos=res_dat(i_etam+ic-1)*minute/sqrt8ln2
cr.vmos=cr.hmos*tas_cry(c_ani,ic)
cr.poi=tas_cry(c_poi,ic)
cr.vol=1.6016
cr.fhkl=2.3527
cr.mi=0.d0 ! absorption is neglected
cr.nh=nint(tas_cry(c_nh,ic))
cr.nv=nint(tas_cry(c_nv,ic))
end
#---------------------------------------------------------
SUBROUTINE CREATE_COL(sol,ic,cdist,dir,pol)
# SOL ... structure of BENDER type
# IC ... index of the component (1=guide .. 5=SOL4)
# CDIST ... distance in [cm] !!
# DIR ... direction downstream >0 or up-stream <0
# POL ... polarization (0 means no polarization)
#---------------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'rescal.inc'
INCLUDE 'restrax.inc'
INCLUDE 'res_cfg.inc'
integer*4 i,ic,dir,pol,READ_MIRROR,n1,n2
record /BENDER/ sol
real*8 z,cdist,lng,a,b
sol.curv=tas_col(c_roh,ic)
sol.ghlu=tas_col(c_gamah,ic)
sol.ghru=tas_col(c_gamah,ic)
if (pol.eq.0) then
sol.ghld=tas_col(c_gamah,ic)
sol.ghrd=tas_col(c_gamah,ic)
else
sol.ghld=0
sol.ghrd=0
endif
sol.gvt=tas_col(c_gamav,ic)
sol.gvb=tas_col(c_gamav,ic)
sol.rhlu=tas_col(c_refh,ic)
sol.rhld=tas_col(c_refh,ic)
sol.rhru=tas_col(c_refh,ic)
sol.rhrd=tas_col(c_refh,ic)
sol.rvt=tas_col(c_refv,ic)
sol.rvb=tas_col(c_refv,ic)
n1=READ_MIRROR(tas_col(c_gamah,ic))
n2=READ_MIRROR(tas_col(c_gamav,ic))
sol.nhlu=n1
sol.nhld=n1
sol.nhru=n1
sol.nhrd=n1
sol.nvt=n2
sol.nvb=n2
sol.frame.axi=0.
sol.frame.axv=0.
do 10 i=1,3
sol.frame.sta(i)=0.
sol.frame.gon(i)=0.
10 continue
sol.frame.shape=3
sol.frame.dist=cdist*10.
if (dir.gt.0) then
sol.frame.size(1)=tas_col(c_hor1,ic)*10.
sol.frame.size(2)=tas_col(c_ver1,ic)*10.
sol.w2=tas_col(c_hor2,ic)*10.
sol.h2=tas_col(c_ver2,ic)*10.
else
sol.frame.size(1)=tas_col(c_hor2,ic)*10.
sol.frame.size(2)=tas_col(c_ver2,ic)*10.
sol.w2=tas_col(c_hor1,ic)*10.
sol.h2=tas_col(c_ver1,ic)*10.
endif
sol.frame.size(3)=tas_col(c_len,ic)*10.
sol.nlv=1
sol.dlh=0.08
sol.dlv=0.08
lng=sol.frame.size(3)
if (ic.eq.1) then
if (tas_col(c_use,ic).le.0) then
a=0
b=0
else
a=1000.
b=1000.
endif
else
a=res_dat(i_alf1+ic-2)
b=res_dat(i_bet1+ic-2)
endif
if((a.gt.0).and.(lng.gt.0)) then
if(a.lt.500.) then
z=lng*2.0*(a*minute+sol.dlh/lng)
sol.nlh=nint((sol.frame.size(1)+sol.w2)/z)
else
sol.nlh=1
endif
if(sol.nlh.le.0) sol.nlh=1
if (b.gt.0.and.b.lt.500) then
z=lng*2.0*(b*minute+sol.dlv/lng)
sol.nlv=nint((sol.frame.size(2)+sol.h2)/z)
endif
else
sol.frame.size(1)=1000.
sol.frame.size(2)=1000.
sol.frame.size(3)=0.
sol.w2=sol.frame.size(1)
sol.h2=sol.frame.size(2)
sol.nlh=1
sol.nlv=1
endif
return
end
#----------------------------------------------------
SUBROUTINE TAS_TO_TRAX
# Convert RESTRAX data to TRAX arrays
#----------------------------------------------------
implicit none
INCLUDE 'const.inc'
INCLUDE 'inout.inc'
INCLUDE 'rescal.inc'
INCLUDE 'restrax.inc'
INCLUDE 'trax.inc'
real*8 dum
integer*4 i
logical*4 useguide
# scattering triangle
homega=res_dat(i_en)
if (res_dat(i_fx).eq.1.) then
nefix=1
ei0=res_dat(i_kfix)**2*hsqovm/2.
ef0=ei0-homega
else
nefix=2
ef0=res_dat(i_kfix)**2*hsqovm/2.
ei0=ef0+homega
end if
if (ei0.le.0.or.ef0.le.0) goto 999
vki=sqrt(ei0*2./hsqovm)
vkf=sqrt(ef0*2./hsqovm)
call QNORM(res_dat(i_qh),dum,vq0)
#
ets=res_dat(i_etas)
if (ets.eq.0.) ets=0.00833333
hisam=0.
his=hisam*tdr
isc=res_dat(i_ss)
nsam=0
diasam=res_dat(i_sdi)
wsam=res_dat(i_sdi)
thsam=res_dat(i_sdi)
hsam=res_dat(i_shi)
if (diasam.eq.0) diasam=0.01
if (hsam.eq.0) hsam=0.01
#
etm=res_dat(i_etam)
if (etm.eq.0.) etm=0.00833333
himon=mon.chi/tdr
if (mon.hmos.gt.0) then
anrm=mon.vmos/mon.hmos
else
anrm=1
endif
wmon=mon.frame.size(1)/10.
hmon=mon.frame.size(2)/10.
thmon=mon.frame.size(3)/10.
rohm=res_dat(i_romh)/100.
rovm=res_dat(i_romv)/100.
cryd(1)=res_dat(i_dm)
poiss(1)=mon.poi
im=nint(res_dat(i_sm))
# analyzer
eta=res_dat(i_etaa)
if (eta.eq.0.) eta=0.00833333
hiana=-ana.chi/tdr
if (ana.hmos.gt.0) then
anra=ana.vmos/ana.hmos
else
anra=1
endif
wana=ana.frame.size(1)/10.
hana=ana.frame.size(2)/10.
thana=ana.frame.size(3)/10.
roha=res_dat(i_roah)/100.
rova=res_dat(i_roav)/100.
cryd(2)=res_dat(i_da)
poiss(2)=ana.poi
ia=res_dat(i_sa)
# source
if(sou.shape.eq.2) then
nsou=0
diasou=sou.size(1)/10.
else
nsou=1
diasou=sou.size(1)/10.
wsou=sou.size(1)/10.
hsou=sou.size(2)/10.
endif
srctemp=stemp
# detector
if(det.shape.eq.2) then
ndet=0
diadet=det.size(1)/10.
else
ndet=1
diadet=det.size(1)/10.
wdet=det.size(1)/10.
hdet=det.size(2)/10.
endif
# neutron guide:
useguide=(guide.ghlu.gt.0.and.guide.frame.size(3).gt.0)
if (useguide) then
gamacr=guide.ghlu
nguide=1
else
nguide=0
gamacr=0
endif
# Soller collimators
do i=1,4
alpha(i)=res_dat(i+i_alf1-1)
beta(i)=res_dat(i+i_bet1-1)
enddo
# //// if ALPHA(I)<500 then the coarse collimator is ignored
# //// if ALPHA(I)>=500 then the Soller collimator is ignored
# //// if ALPHA(I)=0 then no collimation is considered
nfm=-1
nfs=-1
nfa=-1
nfd=-1
if (alpha(1).ge.500.) then
alpha(1)=0.
nfm=1
end if
if (alpha(2).ge.500.) then
alpha(2)=0.
nfs=1
end if
if (alpha(3).ge.500.) then
alpha(3)=0.
nfa=1
end if
if (alpha(4).ge.500.) then
alpha(4)=0.
nfd=1
end if
# distances
if (guide.frame.size(3).gt.0) then
vl0=(sol1.frame.dist+guide.frame.dist)/10.
else
vl0=(sol1.frame.dist+guide.frame.dist+sou.dist)/10.
endif
vl1=(sol2.frame.dist+mon.frame.dist)/10.
vl2=(sol3.frame.dist+ana.frame.dist)/10.
vl3=(sol4.frame.dist+det.dist)/10.
# collimator 1
if (sol1.frame.size(3).le.0) then
nfm=-1
else
nfm=1
vlsm=sol1.frame.size(3)/10.
hdm1=sol1.w2/10.
hdm2=sol1.frame.size(1)/10.
vdm1=sol1.h2/10.
vdm2=sol1.frame.size(2)/10.
vlcanm=vl0-(sol1.frame.size(3)+sol1.frame.dist)/10.
endif
# collimator 2
if (sol2.frame.size(3).le.0) then
nfs=-1
else
nfs=1
vlms=sol2.frame.size(3)/10.
hds1=sol2.w2/10.
hds2=sol2.frame.size(1)/10.
vds1=sol2.h2/10.
vds2=sol2.frame.size(2)/10.
vlcans=(mon.frame.dist-sol2.frame.size(3))/10.
endif
# collimator 3
if (sol3.frame.size(3).le.0) then
nfa=-1
else
nfa=1
vlsa=sol3.frame.size(3)/10.
hda1=sol3.frame.size(1)/10.
hda2=sol3.w2/10.
vda1=sol3.frame.size(2)/10
vda2=sol3.h2/10.
vlcana=sol3.frame.dist/10.
endif
# collimator 4
if (sol4.frame.size(3).le.0) then
nfd=-1
else
nfd=1
vlad=sol4.frame.size(3)/10.
hdd1=sol4.frame.size(1)/10.
hdd2=sol4.w2/10.
vdd1=sol4.frame.size(2)/10
vdd2=sol4.h2/10.
vlcand=sol4.frame.dist/10.
endif
if (vlsm.le.0) nfm=-1
if (vlms.le.0) nfs=-1
if (vlsa.le.0) nfa=-1
if (vlad.le.0) nfd=-1
return
999 write(smes,*) 'CHECK SCATTERING TRIANGLE !!!'
end