Skip to content

Commit

Permalink
added ccc() in OE gfile and defining FMIRR=10: preparing CRL
Browse files Browse the repository at this point in the history
  • Loading branch information
srio committed Sep 28, 2011
1 parent 9ee46f1 commit b4c65b9
Show file tree
Hide file tree
Showing 9 changed files with 585 additions and 28 deletions.
1 change: 1 addition & 0 deletions LOG.TXT
Expand Up @@ -51,3 +51,4 @@ START STEP7 cleaning *.f90
START STEP8 mv preprocessors routines to math


See log in git repository...
4 changes: 2 additions & 2 deletions Makefile
Expand Up @@ -12,8 +12,8 @@
# setenv LD_LIBRARY_PATH .
# use FC=g95

FC = g95
#FC = gfortran
#FC = g95
FC = gfortran
CC = gcc
#CC = gcc-mp-4.4
CCP = g++
Expand Down
5 changes: 3 additions & 2 deletions gfile.f90
Expand Up @@ -215,9 +215,10 @@ function GfSetValueReal (g1, variableName, variable) result(iOut)
iOut = GfIsDefined(g1,variableName,j)

if (iOut) then
! WARNING: The format may give problems!!!!
! todo: WARNING: The format may give problems!!!!
! write(g1%variableValues(j),fmt="(f20.5)") variable
write(g1%variableValues(j),fmt="(g20.5)") variable
! write(g1%variableValues(j),fmt="(g20.5)") variable
write(g1%variableValues(j),fmt="(g30.15)") variable
endif


Expand Down
355 changes: 355 additions & 0 deletions oe.nml

Large diffs are not rendered by default.

61 changes: 38 additions & 23 deletions shadow_kernel_precpp.F90
Expand Up @@ -262,7 +262,7 @@ Module shadow_kernel
!!-- COMMON /MIRROR / RLEN,RLEN1,RLEN2,CCC(10),RMIRR,CONE_A, &
!!-- AXMAJ,AXMIN,AFOCI,ECCENT,R_MAJ,R_MIN, &
!!-- RWIDX,RWIDX1,RWIDX2,PARAM, &
real(kind=skr),dimension(10) :: ccc
!!ccc real(kind=skr),dimension(10) :: ccc
!!-- PCOEFF(0:4,0:4,0:4),CIL_ANG,ELL_THE
real(kind=skr),dimension(0:4,0:4,0:4) :: pcoeff
!!-- COMMON /GRATING/ RULING,ORDER,BETA,PHOT_CENT,R_LAMBDA, &
Expand Down Expand Up @@ -3325,14 +3325,16 @@ SUBROUTINE MSETUP (IWHICH)
! C
! C clear array
! C
DO 100 I=1,10
100 CCC(I) = 0.0D0
! DO 100 I=1,10
! 100 CCC(I) = 0.0D0
IF (FMIRR.NE.10) CCC=0.0D0

! C
! C Computes the mirror parameters for all cases
! C
! C 1 2 3 4 5 6 7 8 9
! C 1 2 3 4 5 6 7 8 9 10
! C
GO TO (1,2,3,4,5,5,7,8,9) FMIRR
GO TO (1,2,3,4,5,5,7,8,9,10) FMIRR

1 CONTINUE
! C
Expand Down Expand Up @@ -3589,19 +3591,26 @@ SUBROUTINE MSETUP (IWHICH)
CALL READPOLY (FILE_MIR, IERR)
IF (IERR.NE.0) CALL LEAVE &
('MSETUP','Return error from READPOLY',IERR)
! C
! C Conic coefficients defined externally (therefore do nothing here)
! C
10 CONTINUE
!! print *,">>Using FMIRR=10"
!! OPEN (25,FILE="ccc.inp",STATUS='OLD',IOSTAT=IOSTAT)
!! IF (IOSTAT.EQ.0) THEN
!! write(*,*) ">>Using conic coefficients from file ccc.inp"
!! DO I=1,10
!! read(25,*) TMP
!! CCC(I)=TMP
!! END DO
!! CLOSE(25)
!! ELSE
!! print *,'>>File not found: ccc.inp'
!! END IF

GO TO 3000
3000 CONTINUE

!srio
!srio OPEN (25,FILE="ccc.inp",STATUS='OLD',IOSTAT=IOSTAT)
!srio IF (IOSTAT.EQ.0) THEN
!srio write(*,*) ">>Using conic coefficients from file ccc.inp"
!srio DO I=1,10
!srio read(25,*) TMP
!srio CCC(I)=TMP
!srio END DO
!srio CLOSE(25)
!srio
!srio END IF

! C
! C Set to zero the coeff. involving X for the cylinder case, after
Expand All @@ -3611,6 +3620,8 @@ SUBROUTINE MSETUP (IWHICH)
COS_CIL = COS(CIL_ANG)
SIN_CIL = SIN(CIL_ANG)
IF (FCYL.EQ.1) THEN
if (fmirr.eq.10) &
print *,'MSETUP: warning: using cylindrical shape (FCYL=1) with external coefficients (FMIRR=10)'
A_1 = CCC(1)
A_2 = CCC(2)
A_3 = CCC(3)
Expand Down Expand Up @@ -3640,6 +3651,8 @@ SUBROUTINE MSETUP (IWHICH)
! C Set the correct mirror convexity.
! C
IF (F_CONVEX.NE.0) THEN
if (fmirr.eq.10) &
print *,'MSETUP: warning: inverting convexity (F_CONVEX=1) with external coefficients (FMIRR=10)'
CCC(5) = - CCC(5)
CCC(6) = - CCC(6)
CCC(9) = - CCC(9)
Expand All @@ -3652,11 +3665,13 @@ SUBROUTINE MSETUP (IWHICH)
! C variables are reset to zero here, leaving the START.xx file unchanged.
! C
! C
! Csrio write(*,*) ">>>>>>>>>>> FINAL: <<<<<<<<<<<<<"
! Csrio DO I=1,10
! Csrio write(*,*) "CCC[",i,"]=",CCC(I)
! Csrio END DO
! Csrio write(*,*) ">>>>>>>>>>> END FINAL: <<<<<<<<<<<<<"
!! write(*,*) ">>>>>>>>>>> FINAL: <<<<<<<<<<<<<"
!! DO I=1,10
!! write(*,*) "CCC[",i,"]=",CCC(I)
!! write(27,*) CCC(I)
!! END DO
!! write(*,*) "CCC coeff copied to unit 27"
!! write(*,*) ">>>>>>>>>>> END FINAL: <<<<<<<<<<<<<"
IF (F_MOVE.EQ.0) THEN
X_ROT = 0.0D0
Y_ROT = 0.0D0
Expand Down Expand Up @@ -3842,7 +3857,7 @@ SUBROUTINE MSETUP (IWHICH)
WRITE(6,*) 'Exit from MSETUP'

! D WRITE (17,*) '--------------------------------------------'
! D WRITE (17,*) 'MSETUP INPUT'
! D WRITE (17,*) '!MSETUP INPUT'
! D WRITE (17,*) IWHICH,FDIM,FMIRR,FCYL,F_MOVE
! D WRITE (17,*) COSDEL,SINDEL,COSTHE,SINTHE
! D WRITE (17,*) SSOUR,SIMAG
Expand Down Expand Up @@ -7248,7 +7263,7 @@ Subroutine MIRROR1 (RAY,AP,PHASE,I_WHICH)
!srio ANGLE_OUT = DACOSD(TEMP1)
ANGLE_IN = TODEG*ACOS(TEMP)
ANGLE_OUT = TODEG*ACOS(TEMP1)
write(*,*) ">>>> in mirror: angle_in,angle_out: ",ANGLE_IN,ANGLE_OUT
!write(*,*) ">>>> in mirror: angle_in,angle_out: ",ANGLE_IN,ANGLE_OUT
END IF

CALL FA_ROTBACK (PF_OUT,PPOUT,PF_CENT,PF_BNOR,PF_TAU,PF_NOR)
Expand Down
1 change: 1 addition & 0 deletions shadow_oe.def
Expand Up @@ -185,6 +185,7 @@ EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,RZ_SLIT,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(int,integer,ski,T_INT,SCR_NUMBER,"%d",'(I)',ADIM,0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,SL_DIS,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,THICK,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,CCC,"%lf",'(F)',ADIM,0.0)

#undef EXPAND_OE_SCALAR
#undef EXPAND_OE_ARRAYS
Expand Down
1 change: 1 addition & 0 deletions shadow_oe_without_repetitions.def
Expand Up @@ -185,6 +185,7 @@ EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,RZ_SLIT,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(int,integer,ski,T_INT,SCR_NUMBER,"%d",'(I)',ADIM,0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,SL_DIS,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,THICK,"%lf",'(F)',ADIM,0.0)
EXPAND_OE_ARRAYS(double,real,skr,T_DOUBLE,CCC,"%lf",'(F)',ADIM,0.0)

#undef EXPAND_OE_SCALAR
#undef EXPAND_OE_ARRAYS
Expand Down
25 changes: 24 additions & 1 deletion shadow_postprocessors.f90
Expand Up @@ -346,6 +346,7 @@ SUBROUTINE MirInfo
character(len=8) :: date
character(len=10) :: time
character(len=5) :: zone
character(len=2) :: stmp
integer,dimension(8) :: values

! todo: check that this is also defined in shadow_kernel...
Expand All @@ -363,7 +364,7 @@ SUBROUTINE MirInfo
type1(7) ='HYPERBOLICAL'
type1(8) ='CONICAL '
type1(9) ='POLYNOMIAL '
type1(10) =' '
type1(10) ='CONIC EXTNAL'
type1(11) =' '
type1(12) =' '

Expand Down Expand Up @@ -661,6 +662,28 @@ SUBROUTINE MirInfo
WRITE (20,*) ' Y: ',p1%Y_ROT*TODEG
WRITE (20,*) ' Z: ',p1%Z_ROT*TODEG
END IF

!
! write conic coefficients
!
IF ((p1%FMIRR.EQ.1).OR.(p1%FMIRR.EQ.2).OR.(p1%FMIRR.EQ.4).OR. &
(p1%FMIRR.EQ.5).OR.(p1%FMIRR.EQ.7).OR.(p1%FMIRR.EQ.8).OR. &
(p1%FMIRR.EQ.9).OR.(p1%FMIRR.EQ.10)) THEN

WRITE (20,*) ' '
WRITE (20,*) TOPLIN
WRITE (20,*) 'OE surface in form of conic equation: '
WRITE (20,*) ' c[1]*X^2 + c[2]*Y^2 + c[3]*Z^2 + '
WRITE (20,*) ' c[4]*X*Y + c[5]*Y*Z + c[6]*X*Z + '
WRITE (20,*) ' c[7]*X + c[8]*Y + c[9]*Z + c[10] = 0 '
WRITE (20,*) ' with '
DO j=1,10
Write( stmp, '(i2)' ) j
stmp = adjustl(stmp)
WRITE (20,*) ' c['//trim(stmp)//'] =',p1%ccc(j)
END DO
END IF

WRITE (20,*) TOPLIN
WRITE (20,*) '*************** E N', &
' D ***************'
Expand Down
160 changes: 160 additions & 0 deletions source.nml
@@ -0,0 +1,160 @@
$tsour
fdistr = 2 - defines source angle distribution types:
Available options are: flat(1),uniform(2),
gaussian(3), synchrotron(4), conical(5), exact
synchrotron(6).
fgrid = 0 - defines source modelling type --
spatial/momentum space. Options are:
RANDOM/RANDOM (0), GRID/GRID (1), GRID/RANDOM
(2), RANDOM/GRID (3), ELLIPSE in phase/RANDOM on
the ellipse (4), ELLIPSE in phase/GRID on the
ellipse (5).
fsour = 0 - spatial source type/shape in X-Z plane. Options are:
point (0), rectangle (1), ellipse (2), gaussian
(3).
fsource_depth = 1 - defines the source depth (Y). Options
are: no depth (1), flat depth (2),
gaussian (3), synchrotron depth (4).
f_coher = 0 - if generating the A vectors, defines
whether the light is incoherent (0), or
coherent (1).
f_color = 1 - photon energy distribution type. Options
are: single energy (1), mutliple
discrete energies, up to 10 energies
(2), uniform energy distribution (3).
f_phot = 0 - defines whether the photon energy will be
specified in eV (0) or Angstroms (1).
f_pol = 0 - for synchrotron and wiggler sources defines the
polarization component of interest: parallel (1),
perpendicular (2), total (3).
f_polar = 1 - flag defining whether or not to generate
the A vectors: yes (1), no (0).
f_opd = 0 - flag defining whether or not to save the optical
paths (OPD): yes (1), no (0).
f_wiggler = 0 - source type. Options: regular/bending
magnet/synchrotron (0), wiggler (1),
undulator (2).
f_bound_sour = 0 - flag defining whether or not to optimize
the source: yes (1), no (0).
f_sr_type = 0 - for synchrotron sources, distribution in
terms of: photons (0), or power
distribution (1).
istar1 = 478291 - seed for random number generator, odd.
npoint = 5000 - number of random rays (0-5000).
ncol = 0 - source generation routines will fill in the
number of columns in your source.
n_circle = 0 - for fgrid=1,3 and fdistr=5; number of
grid points along each circle.
n_color = 0 - for f_color=2, number of discrete lines
in energy, maximum = 10.
n_cone = 0 - for fgrid=1,3 and fdistr=5; number of grid
points along the radius(number of concentric circles).
ido_vx = 1 - for fgrid=1,3; number of grid points in
horizontal angle distribution.
ido_vz = 1 - for fgrid=1,3; number of grid points in vertical
angle distribution.
ido_x_s = 1 - for fgrid=1,2; fsour=1 points along x,
fsour=2 number of concentric ellipses.
ido_y_s = 1 - for fgrid=1,2; number of points along
depth (Y).
ido_z_s = 1 - for fgrid=1,2; fsour=1 points along z,
fsour=2 number of concentric ellipses.
ido_xl = 0 - for fgrid=4,5; number of sigma levels in X for
phase space ellipse source.
ido_xn = 0 - for fgrid=5; number of rays/sigma level in X
ido_zl = 0 - for fgrid=4,5; number of sigma levels in X for
phase space ellipse source.
ido_zn = 0 - for fgrid=5; number of rays/sigma level in Z.
sigxl1 = 0.0000000000000000E+00 - for fgrid=4,5; values for sigma
sigxl2 = 0.0000000000000000E+00 levels in X.
sigxl3 = 0.0000000000000000E+00
sigxl4 = 0.0000000000000000E+00
sigxl5 = 0.0000000000000000E+00
sigxl6 = 0.0000000000000000E+00
sigxl7 = 0.0000000000000000E+00
sigxl8 = 0.0000000000000000E+00
sigxl9 = 0.0000000000000000E+00
sigxl10 = 0.0000000000000000E+00
sigzl1 = 0.0000000000000000E+00 - for fgrid=4,5; values for sigma
sigzl2 = 0.0000000000000000E+00 levels in Z.
sigzl3 = 0.0000000000000000E+00
sigzl4 = 0.0000000000000000E+00
sigzl5 = 0.0000000000000000E+00
sigzl6 = 0.0000000000000000E+00
sigzl7 = 0.0000000000000000E+00
sigzl8 = 0.0000000000000000E+00
sigzl9 = 0.0000000000000000E+00
sigzl10 = 0.0000000000000000E+00
conv_fact = 0.0000000000000000E+00 - for fwiggler=1; conversion
factor from meters to user units.
cone_max = 0.0000000000000000E+00 - for fdistr=5; maximum half
divergence.
cone_min = 0.0000000000000000E+00 - for fdistr=5; minimum half
divergence.
epsi_dx = 0.0000000000000000E+00 - for fdistr=4,6 or fwiggler=1;
in X, the distance from the waist
that the emittance value corresponds
to, signed.
epsi_dz = 0.0000000000000000E+00 - for fdistr=4,6 or fwiggler=1;
in Z, the distance from the
waist that the emittance value
corresponds to, signed.
epsi_x = 0.0000000000000000E+00 - for fdistr=4,6 or fwiggler=1; the
beam emittance in units of radians*length
units used so far. (in X)
epsi_z = 0.0000000000000000E+00 - for fdistr=4,6 or fwiggler=1; the
beam emittance (in Z) in units of
radians*length units used so far.
hdiv1 = 0.0000000000000000E+00 - horizontal divergence in +X (radians).
hdiv2 = 0.0000000000000000E+00 - horizontal divergence in -X (radians).
ph1 = 11160.00000000000 - photon energy: f_color=1 desired
energy, f_color=2 first energy line,
f_color=3 minimum energy.
ph2 = 0.0000000000000000E+00 - photon energy: f_color=2 second energy
line, f_color=3 maximum energy.
ph3 = 0.0000000000000000E+00 - photon energy: f_color=2 third energy
line.
ph4 = 0.0000000000000000E+00
ph5 = 0.0000000000000000E+00
ph6 = 0.0000000000000000E+00
ph7 = 0.0000000000000000E+00
ph8 = 0.0000000000000000E+00
ph9 = 0.0000000000000000E+00
ph10 = 0.0000000000000000E+00
bener = 0.0000000000000000E+00 - for fdistr=4,6 or f_wiggler=1;
Electron beam energy (GeV).
pol_angle = 0.0000000000000000E+00 - for f_polar=1; phase
difference in degrees.
pol_deg = 0.0000000000000000E+00 - for f_polar=1; degree of
polarization (between 0 and 1).
r_aladdin = 0.0000000000000000E+00 - for fdistr=4,6 or f_wiggler=1;
bending magnet radius in units
of length used for source
size, CCW rings negative.
r_magnet = 0.0000000000000000E+00 - for fdistr=4,6 or f_wiggler=1;
bending magnet radius (m).
sigdix = 0.0000000000000000E+00 - for fdistr=3; sigma (radians)for horizontal
divergence (gaussian angle distribution).
sigdiz = 0.0000000000000000E+00 - for fdistr=3; sigma (radians) for vertical
divergence (gaussian angle distribution).
sigmax = 0.0000000000000000E+00 - for fsour=3; sigma in X
sigmay = 0.0000000000000000E+00 - for fsource_depth=3; sigma in Y
sigmaz = 0.0000000000000000E+00 - for fsour=3; sigma in Z
vdiv1 = 6.0000000000000002E-05 - vertical divergence in +Z (radians).
vdiv2 = 6.0000000000000002E-05 - vertical divergence in -Z (radians).
wxsou = 0.0000000000000000E+00 - for fsour=1,2; source width (X).
wysou = 0.0000000000000000E+00 - for fsource_depth=2; source depth (Y).
wzsou = 0.0000000000000000E+00 - for fsour=1,2; source height (Z).
file_traj = - for fwiggler=1,2; filename containing
'' the electron trajectoryfor wigglers or
the CDF's for undulators. (from
make_id).
file_source = - filled in by source generation.
''
file_bound = - for f_bound_sour=1; file containing
'' the output of reflag and histo3.
oe_number = 0 - the last variables are set in the
idummy = 0 source generation and recorded in
dummy = 0.0000000000000000E+00 END.00 file. They should be left
f_new = 0 alone.
$end

0 comments on commit b4c65b9

Please sign in to comment.