From 8dfdeabf136819348975e9d97235e45ad056454d Mon Sep 17 00:00:00 2001
From: kamischi <karl-michael.schindler@web.de>
Date: Fri, 13 Jan 2023 17:08:23 +0100
Subject: [PATCH] Initial commit
First tests works and a source code listing with number of execution for each line is obtained, but some more refinements, like automation and similar, are required.
---
source/f90/fcat-analysis/Makefile | 87 +
source/f90/fcat-analysis/bosin | 6 +
source/f90/fcat-analysis/boson_all-fcat.f90 | 1609 +++++++++++++
source/f90/fcat-analysis/boson_all.f90 | 972 ++++++++
source/f90/fcat-analysis/bosonf90_fcat_output | 1104 +++++++++
source/f90/fcat-analysis/bosou | 853 +++++++
source/f90/fcat-analysis/eels_all-fcat.f90 | 2085 +++++++++++++++++
source/f90/fcat-analysis/eels_all.f90 | 1353 +++++++++++
source/f90/fcat-analysis/eelsf90_fcat_output | 1142 +++++++++
source/f90/fcat-analysis/eelsin | 16 +
source/f90/fcat-analysis/eelsou | 328 +++
11 files changed, 9555 insertions(+)
create mode 100644 source/f90/fcat-analysis/Makefile
create mode 100644 source/f90/fcat-analysis/bosin
create mode 100644 source/f90/fcat-analysis/boson_all-fcat.f90
create mode 100644 source/f90/fcat-analysis/boson_all.f90
create mode 100644 source/f90/fcat-analysis/bosonf90_fcat_output
create mode 100644 source/f90/fcat-analysis/bosou
create mode 100644 source/f90/fcat-analysis/eels_all-fcat.f90
create mode 100644 source/f90/fcat-analysis/eels_all.f90
create mode 100644 source/f90/fcat-analysis/eelsf90_fcat_output
create mode 100644 source/f90/fcat-analysis/eelsin
create mode 100644 source/f90/fcat-analysis/eelsou
diff --git a/source/f90/fcat-analysis/Makefile b/source/f90/fcat-analysis/Makefile
new file mode 100644
index 0000000..a519b00
--- /dev/null
+++ b/source/f90/fcat-analysis/Makefile
@@ -0,0 +1,87 @@
+.SUFFIXES: .c .f .f90 .F90 .for .FOR .ftn .FTN .o
+
+# the fortran compiler
+FC = gfortran
+
+# the options for the fortran compiler
+# FFLAGS = -fbounds-check
+# FFLAGS = -O3 -ff2c -gw
+FFLAGS = -g -gdwarf-2 -fbounds-check -fcheck=all -fdiagnostics-color=auto
+
+# fcat tool
+FCAT = fcat
+
+# Stuff for the python modules
+# Python3 and its numpy must be installed.
+PYTHON3 = python3
+
+# the implicit rule for compiling for files
+# %.o: %.for ; $(FC) $(FFLAGS) -c -o $@ $<
+#%-fcat.f90: %.f90 ; fcat -count %.f90 > %-fcat.f90
+%.o: %-fcat.f90 ; $(FC) $(FFLAGS) -c $<
+%_mod.mod: %.f90 ; $(FC) $(FFLAGS) -c $<
+
+all: boson eels eels-boson pylibs
+
+bosonmods = sicot_mod.mod sintr_mod.mod rcffi_mod.mod
+doboson-fcat.f90: doboson.f90
+ $(FCAT) -count doboson.f90 > doboson-fcat.f90
+doboson.o: doboson-fcat.f90 $(bosonmods)
+
+sicot_mod.mod: sintr_mod.mod
+
+bosonsubs = doboson.o respon.o sicot.o sintr.o rcffi.o o1.o o2.o
+boson-fcat.f90: boson.f90
+ $(FCAT) -count boson.f90 > boson-fcat.f90
+boson: boson-fcat.f90 change_working_dir.o $(bosonsubs) $(bosonmods)
+ $(FC) $(FFLAGS) -o bosonf90 boson-fcat.f90 change_working_dir.o $(bosonsubs)
+
+eelsmods = quanc8_mod.mod queels_mod.mod seteps_mod.mod
+doeels-fcat.f90: doeels.f90
+ $(FCAT) -count doeels.f90 > doeels-fcat.f90
+doeels.o: doeels-fcat.f90 $(eelsmods)
+
+queels_mod.mod: quanc8_mod.mod fint1_mod.mod fint2_mod.mod fint3_mod.mod
+quanc8_mod.mod: fun_mod.mod
+fint1_mod.mod: surlos_mod.mod
+fint2_mod.mod: surlos_mod.mod
+fint3_mod.mod: surlos_mod.mod
+
+eelssubs = doeels.o usurlo.o quanc8.o fun.o queels.o fint1.o fint2.o fint3.o surlos.o seteps.o phint.o qrat.o
+eels-fcat.f90: eels.f90
+ $(FCAT) -count eels.f90 > eels-fcat.f90
+eels: eels-fcat.f90 change_working_dir.o $(eelssubs) $(eelsmods)
+ $(FC) $(FFLAGS) -o eelsf90 eels-fcat.f90 change_working_dir.o $(eelssubs)
+
+eels-boson: eels-boson.f90 change_working_dir.o $(eelssubs) $(eelsmods) $(bosonsubs) $(bosonmods)
+ $(FC) $(FFLAGS) -o eels-boson eels-boson.f90 change_working_dir.o $(eelssubs) $(bosonsubs)
+
+pylibs: doeels-py doboson-py
+
+doeels-py: doeels.f90 quanc8.f90 surlos.f90 fint1.f90 fint2.f90 fint3.f90 queels.f90 phint.f90 qrat.f90 usurlo.f90
+ $(PYTHON3) -m numpy.f2py -c seteps.f90 doeels.f90 quanc8.f90 surlos.f90 fint1.f90 fint2.f90 fint3.f90 queels.f90 phint.f90 qrat.f90 usurlo.f90 -m doeels
+
+doboson-py: doboson.f90 sicot.f90 sintr.f90 rcffi.f90 respon.f90 o1.f90 o2.f90
+ $(PYTHON3) -m numpy.f2py -c o1.f90 o2.f90 sintr.f90 rcffi.f90 respon.f90 sicot.f90 doboson.f90 -m doboson
+
+fcat: eelsf90 bosonf90
+ ./eelsf90 > eelsf90_fcat_output
+ fcat -count eels.f90 eelsf90_fcat_output
+# fcat -report eels.f90 eelsf90_fcat_output
+ ./bosonf90 > bosonf90_fcat_output
+ fcat -count boson.f90 bosonf90_fcat_output
+ fcat -count doboson.f90 bosonf90_fcat_output
+# fcat -report boson.f90 bosonf90_fcat_output
+
+clean:
+ rm -f *.o
+ rm -rf *.dSYM
+ rm -rf *.mod
+ rm -rf *.so
+ rm -rf *-fcat.*
+ rm -f bosonf90 bosonf90.exe
+ rm -f eelsf90 eelsf90.exe
+ rm -f eels-boson eels-boson.exe
+
+.PHONY: all clean pylibs fcat
+
diff --git a/source/f90/fcat-analysis/bosin b/source/f90/fcat-analysis/bosin
new file mode 100644
index 0000000..7dd3315
--- /dev/null
+++ b/source/f90/fcat-analysis/bosin
@@ -0,0 +1,6 @@
+ 300.0 t
+ 25.0 width
+ 0.5 gauss
+ 0.3 asym
+-500.0 emin
+1200.0 emax
diff --git a/source/f90/fcat-analysis/boson_all-fcat.f90 b/source/f90/fcat-analysis/boson_all-fcat.f90
new file mode 100644
index 0000000..9660331
--- /dev/null
+++ b/source/f90/fcat-analysis/boson_all-fcat.f90
@@ -0,0 +1,1609 @@
+program boson
+
+! *******************************************************************
+! * *
+! * perform the quantum-mechanical complement to the classical step *
+! * of the dielectric theory of eels in specular geometry using a *
+! * suitable thermodynamical average of the quantized surface *
+! * harmonic oscillators *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ integer, parameter :: mmax=14, nmax=2**mmax
+ double precision :: asym, emax, emin, gauss, t, width, wmin, wmax, y
+ double precision :: p2(nmax)
+ integer :: i, np, ioStatus
+ character (len = 72) :: comment(2)
+ double precision, allocatable :: xout(:), yout(:)
+ integer :: nout
+
+! *** read input parameters
+
+ call FCAT_boson_all(1)
+ call change_working_dir()
+ call FCAT_boson_all(2)
+ open(unit = 13, file = 'bosin')
+! target temperature (Kelvin)
+ call FCAT_boson_all(3)
+ read(13, *) t
+! width of the instrumental response (cm**-1)
+ call FCAT_boson_all(4)
+ read(13, *) width
+! fraction of gaussian for the instrumental response
+ call FCAT_boson_all(5)
+ read(13, *) gauss
+! asymmetry of the instrumental response
+ call FCAT_boson_all(6)
+ read(13, *) asym
+! lower and upper energy losses for this computation (cm**-1)
+ call FCAT_boson_all(7)
+ read(13, *) emin
+ call FCAT_boson_all(8)
+ read(13, *) emax
+ call FCAT_boson_all(9)
+ close(unit=13)
+
+ call FCAT_boson_all(10)
+ write(*,*) 'program boson (September 2020)'
+ call FCAT_boson_all(11)
+ write(*,'(a, f6.1, a, f7.2, a)') ' t =', t, ' K, width =', width, ' cm**-1'
+ call FCAT_boson_all(12)
+ write(*,'(a, f5.2, a, f5.2)') ' gauss =', gauss, ', asym =', asym
+ call FCAT_boson_all(13)
+ write(*,'(a, g11.4, a, g11.4, a)') ' energy losses from', emin, ' to', emax, ' cm**-1'
+
+! *** read the table of values of the classical loss spectrum
+
+ call FCAT_boson_all(14)
+ open(unit = 12, file = 'eelsou')
+ call FCAT_boson_all(15)
+ read(12, '(a48)') comment(1)
+ call FCAT_boson_all(16)
+ read(12, '(a72)') comment(2)
+ call FCAT_boson_all(17)
+ np = 0
+ call FCAT_boson_all(18)
+ do
+ call FCAT_boson_all(19)
+ read(12, *, IOSTAT = ioStatus) wmax, y
+ call FCAT_boson_all(20)
+ if (ioStatus /= 0) exit
+ call FCAT_boson_all(21)
+ if (wmax < 0.0d0) cycle
+ call FCAT_boson_all(22)
+ np = np + 1
+ call FCAT_boson_all(23)
+ p2(np) = y
+ call FCAT_boson_all(24)
+ if (np == 1) wmin = wmax
+ call FCAT_boson_all(25)
+ if (np < nmax) cycle
+ call FCAT_boson_all(26)
+ enddo
+ call FCAT_boson_all(27)
+ close(unit = 12)
+
+ call FCAT_boson_all(28)
+ if (np <= 0) then
+ call FCAT_boson_all_rep()
+ stop '*** no input values for pcl ***'
+ endif
+
+ call FCAT_boson_all(29)
+ write(*,*) comment(2)
+ call FCAT_boson_all(30)
+ write(*,'(a, i6, a, g15.7, a, g15.7)') ' read', np, ' values of pcl from', wmin, ' to', wmax
+
+! length calculation for xout, yout.
+!
+ call FCAT_boson_all(31)
+ nout = 2**14
+ call FCAT_boson_all(32)
+ allocate (xout(nout))
+ call FCAT_boson_all(33)
+ allocate (yout(nout))
+
+ call FCAT_boson_all(34)
+ call doboson(t, width, gauss, asym, emin, emax, wmin, wmax, np, p2, xout, yout, nout)
+
+ call FCAT_boson_all(35)
+ open(unit = 14, file = 'bosou')
+ call FCAT_boson_all(36)
+ write(14, '(a, a, f6.1, a, f5.2)') comment(1), 'T =', t, ' GAUSS =', gauss
+ call FCAT_boson_all(37)
+ write(14, *) comment(2)
+ call FCAT_boson_all(38)
+ do i = 1, nout
+ call FCAT_boson_all(39)
+ write(14, '(2e15.7)') xout(i), yout(i)
+ call FCAT_boson_all(40)
+ end do
+ call FCAT_boson_all(41)
+ close(unit = 14)
+ call FCAT_boson_all(42)
+ write(*,*) nout, ' values written on disk'
+
+ call FCAT_boson_all(43)
+ deallocate (xout, yout)
+ call FCAT_boson_all(44)
+ call FCAT_boson_all_rep()
+ stop
+ call FCAT_boson_all_rep()
+end program boson
+subroutine change_working_dir()
+
+! This routine gets the first argument of the commandline and takes it
+! as the path to change the working directory
+! used intrinsic routines:
+! iarg returns the number of commandline arguments without the program cname.
+! chdir changes the directory and returns 0 on success.
+! trim removes blanks from strings.
+
+ character (len = 256) :: argument
+ integer :: status
+
+ call FCAT_boson_all(45)
+ if (iargc() == 1) then
+ call FCAT_boson_all(46)
+ call getarg(1, argument)
+ call FCAT_boson_all(47)
+ status = chdir(trim(argument))
+ call FCAT_boson_all(48)
+ if (status /= 0) then
+ call FCAT_boson_all(49)
+ write (*,*) '*** change directory failed ***'
+ call FCAT_boson_all(50)
+ write (*,*) 'directory tried: ', trim(argument)
+ call FCAT_boson_all(51)
+ write (*,*) 'error code (see: man chdir): ', status
+ call FCAT_boson_all(52)
+ write (*,*) 'continuing in the start directory'
+ call FCAT_boson_all(53)
+ end if
+ call FCAT_boson_all(54)
+ end if
+
+ call FCAT_boson_all(55)
+ return
+end subroutine change_working_dir
+double precision function respon(w, width)
+
+!*******************************************************************
+! *
+! instrumental response of the spectrometer for the frequency w *
+! width is the full width at half maximum of the response function *
+! *
+!*******************************************************************
+
+ implicit none
+ double precision, intent(in) :: w, width
+
+ double precision :: u
+
+ call FCAT_boson_all(56)
+ u = 1.25d0 * w / width
+ call FCAT_boson_all(57)
+ if (u <= -1.0d0 .or. u >= 2.0d0) then
+ call FCAT_boson_all(58)
+ respon = 0.0d0
+ elseif (u > 1.0d0) then
+ call FCAT_boson_all(59)
+ call FCAT_boson_all(60)
+ respon = 4.0d0 + 2 * dsqrt((u - 1.0d0)**3) - 3 * u
+ elseif (u > 0.0d0) then
+ call FCAT_boson_all(61)
+ call FCAT_boson_all(62)
+ respon = 2.0d0 - 4 * dsqrt(u**3) + 3 * u
+ else
+ call FCAT_boson_all(63)
+ call FCAT_boson_all(64)
+ respon = 2 * dsqrt((u + 1.0d0)**3)
+ call FCAT_boson_all(65)
+ endif
+ call FCAT_boson_all(66)
+ return
+ call FCAT_boson_all_rep()
+end function respon
+module sicot_mod
+contains
+subroutine sicot(f, m, h, x0)
+
+! *******************************************************************
+! * *
+! * integral transform g(y, x0) of a real function f(x) defined by *
+! * *
+! * g(x0, y) = integral of f(x)/tanh(x/x0)*(1-cos(x*y)) dx *
+! * *
+! * f(x) is tabulated on the mesh of points xj = (j-1/2)*h , *
+! * j = 1, 2, ..., n , with n = 2**m *
+! * g(x0, y) is computed on the mesh of points yk = k*2pi/(n*h) , *
+! * k = 0, 1, 2, ..., n-1 *
+! * *
+! * input ... *
+! * f(j) contains the value of f(xj) , j = 1, 2, ..., n *
+! * m is such that n = 2**iabs(m) *
+! * h is the step size (must be positive) *
+! * *
+! * output ... *
+! * f(k+1) contains g(x0, yk), k = 0, 1, ..., n-1 *
+! * *
+! * computing remarks ... *
+! * f is a real array with dimension n or more *
+! * it is supposed that f(x) is zero for x > n*h *
+! * external reference : sintr (sine transform of a real function). *
+! * *
+! *******************************************************************
+
+ use sintr_mod
+
+ implicit none
+
+ double precision, intent(in out) :: f(*)
+ integer, intent(in) :: m
+ double precision, intent(in) :: h
+ double precision, intent(in) :: x0
+
+ double precision :: a, b, c, d, e, s, sa
+ integer :: i, j, msign, n
+
+ logical :: debug
+
+ call FCAT_boson_all(67)
+ debug = .false.
+ call FCAT_boson_all(68)
+ if (m == 0) then
+ call FCAT_boson_all(69)
+ f(1) = 0.0d0
+ call FCAT_boson_all(70)
+ return
+ call FCAT_boson_all(71)
+ endif
+
+ call FCAT_boson_all(72)
+ if (h <= 0.0d0) then
+ call FCAT_boson_all(73)
+ if (debug) write(*,*) ' *** incorrect step size in <sicot>, h =', h, ' ***'
+ call FCAT_boson_all(74)
+ call FCAT_boson_all_rep()
+ stop
+ call FCAT_boson_all(75)
+ endif
+
+ call FCAT_boson_all(76)
+ if (x0 < 0.0d0) then
+ call FCAT_boson_all(77)
+ if (debug) write(*,*) ' *** incorrect input in <sicot>, x0 =', x0, ' ***'
+ call FCAT_boson_all(78)
+ call FCAT_boson_all_rep()
+ stop
+ call FCAT_boson_all(79)
+ endif
+
+ call FCAT_boson_all(80)
+ n = 2**iabs(m)
+
+! *** evaluate the integral from xj to infinity of f(x)/tanh(x/x0) dx
+! and store the result in f(j)
+
+ call FCAT_boson_all(81)
+ c = 0.0d0
+ call FCAT_boson_all(82)
+ if (x0 > h / 16) then
+ call FCAT_boson_all(83)
+ c = dexp(-h / x0)
+ call FCAT_boson_all(84)
+ endif
+ call FCAT_boson_all(85)
+ s = 1.0d0 - c
+ call FCAT_boson_all(86)
+ e = c**2
+ call FCAT_boson_all(87)
+ a = 0.25d0 * h
+ call FCAT_boson_all(88)
+ b = 0.25d0 * x0
+ call FCAT_boson_all(89)
+ do i = 1, n
+ call FCAT_boson_all(90)
+ if (i < n) then
+ call FCAT_boson_all(91)
+ f(i) = f(i) + f(i+1)
+ call FCAT_boson_all(92)
+ endif
+ call FCAT_boson_all(93)
+ d = a
+ call FCAT_boson_all(94)
+ if (s /= 1.0d0) then
+ call FCAT_boson_all(95)
+ sa = s
+ call FCAT_boson_all(96)
+ c = c * e
+ call FCAT_boson_all(97)
+ s = 1.0d0 - c
+ call FCAT_boson_all(98)
+ d = d + b * dlog(s / sa)
+ call FCAT_boson_all(99)
+ endif
+ call FCAT_boson_all(100)
+ f(i) = f(i) * d
+ call FCAT_boson_all(101)
+ enddo
+
+ call FCAT_boson_all(102)
+ j = n
+ call FCAT_boson_all(103)
+ do i = 2, n
+ call FCAT_boson_all(104)
+ j = j - 1
+ call FCAT_boson_all(105)
+ f(j) = f(j) + f(j + 1)
+ call FCAT_boson_all(106)
+ enddo
+! alternative, but not yet tested:
+! do j = n - 1, 1, -1
+! f(j) = f(j) + f(j + 1)
+! enddo
+ call FCAT_boson_all(107)
+ msign = -iabs(m)
+ call FCAT_boson_all(108)
+ call sintr(f, msign, h)
+ call FCAT_boson_all(109)
+ return
+end subroutine sicot
+end module sicot_mod
+module sintr_mod
+contains
+subroutine sintr(f, msign, h)
+
+! *******************************************************************
+! * *
+! * integral sine transform of a real function f(x) *
+! * *
+! * g(y) = integral from zero to infinity of f(x)*sin(x*y) dx *
+! * if msign >= 0 or *
+! * g(y) = y * integral from zero to infinity of f(x)*sin(x*y) dx *
+! * if msign < 0 *
+! * *
+! * f(x) is tabulated on the mesh of points xj = (j-1/2)*h , *
+! * j = 1, 2, ..., n , with n = 2**iabs(msig) *
+! * g(y) is computed on the mesh of points yk = k*2pi/(n*h) , *
+! * k = 0, 1, 2, ..., n-1 *
+! * *
+! * input ... *
+! * f(j) contains the value of f(xj) , j = 1, 2, ..., n *
+! * msign is such that n = 2**iabs(msign) *
+! * h is the step size (must be positive) *
+! * *
+! * output ... *
+! * f(k+1) contains g(yk), k = 0, 1, ..., n-1 *
+! * *
+! * computing remarks ... *
+! * f is a real array with dimension n or more *
+! * it is supposed that f(x) is zero for x > n*h *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ double precision, intent(in out) :: f(*)
+ integer, intent(in) :: msign
+ double precision, intent(in) :: h
+
+ double precision :: a, c, ca, d, e, fnp1, s, sa, ti, ti1, ti2, tr, tr1, tr2
+ double precision :: ui, ur, wi, wr
+ integer :: i, i2, ip2, j, j2, k, l, le, le1, m2, n, n2, nm1, nv2
+
+ logical :: debug
+
+ call FCAT_boson_all(110)
+ debug = .false.
+ call FCAT_boson_all(111)
+ if (h <= 0.0d0) then
+ call FCAT_boson_all(112)
+ if (debug) write(*,*) ' *** incorrect step size in <sintr>, h: ', h, ' ***'
+ call FCAT_boson_all(113)
+ call FCAT_boson_all_rep()
+ stop
+ call FCAT_boson_all(114)
+ endif
+
+ call FCAT_boson_all(115)
+ if (msign == 0) then
+ call FCAT_boson_all(116)
+ f(1) = 0.0d0
+ call FCAT_boson_all(117)
+ return
+ call FCAT_boson_all(118)
+ endif
+
+! *** for j and k = 0, 1, 2 ... n/2-1, compute
+! s1 = sum ( f(2*j+1)*cos(4*pi*k*j/n) - f(2*j+2)*sin(4*pi*k*j/n) )
+! s2 = sum ( f(2*j+1)*sin(4*pi*k*j/n) + f(2*j+2)*cos(4*pi*k*j/n) )
+! store s1 in f(2*k+1) and s2 in f(2*k+2)
+! (adapted from cfft routine, cern library member d704)
+
+ call FCAT_boson_all(119)
+ m2 = iabs(msign) - 1
+ call FCAT_boson_all(120)
+ n = 2**m2
+ call FCAT_boson_all(121)
+ if (n /= 1) then
+ call FCAT_boson_all(122)
+ nv2 = n / 2
+ call FCAT_boson_all(123)
+ nm1 = n - 1
+ call FCAT_boson_all(124)
+ j = 1
+ call FCAT_boson_all(125)
+ do i = 1, nm1
+ call FCAT_boson_all(126)
+ if (i < j) then
+ call FCAT_boson_all(127)
+ i2 = i + i
+ call FCAT_boson_all(128)
+ j2 = j + j
+ call FCAT_boson_all(129)
+ ti = f(j2)
+ call FCAT_boson_all(130)
+ f(j2) = f(i2)
+ call FCAT_boson_all(131)
+ f(i2) = ti
+ call FCAT_boson_all(132)
+ i2 = i2 - 1
+ call FCAT_boson_all(133)
+ j2 = j2 - 1
+ call FCAT_boson_all(134)
+ tr = f(j2)
+ call FCAT_boson_all(135)
+ f(j2) = f(i2)
+ call FCAT_boson_all(136)
+ f(i2) = tr
+ call FCAT_boson_all(137)
+ endif
+ call FCAT_boson_all(138)
+ k = nv2
+ call FCAT_boson_all(139)
+ do while (j > k)
+ call FCAT_boson_all(140)
+ j = j - k
+ call FCAT_boson_all(141)
+ k = k / 2
+ call FCAT_boson_all(142)
+ enddo
+ call FCAT_boson_all(143)
+ j = j + k
+ call FCAT_boson_all(144)
+ enddo
+ call FCAT_boson_all(145)
+ do i = 1, n, 2
+ call FCAT_boson_all(146)
+ i2 = i + i
+ call FCAT_boson_all(147)
+ ti = f(i2 + 2)
+ call FCAT_boson_all(148)
+ f(i2 + 2) = f(i2) - ti
+ call FCAT_boson_all(149)
+ f(i2) = f(i2) + ti
+ call FCAT_boson_all(150)
+ i2 = i2 - 1
+ call FCAT_boson_all(151)
+ tr = f(i2 + 2)
+ call FCAT_boson_all(152)
+ f(i2 + 2) = f(i2) - tr
+ call FCAT_boson_all(153)
+ f(i2) = f(i2) + tr
+ call FCAT_boson_all(154)
+ enddo
+ call FCAT_boson_all(155)
+ if (m2 /= 1) then
+ call FCAT_boson_all(156)
+ c = 0.0d0
+ call FCAT_boson_all(157)
+ s = 1.0d0
+ call FCAT_boson_all(158)
+ le = 2
+ call FCAT_boson_all(159)
+ do l = 2, m2
+ call FCAT_boson_all(160)
+ wr = c
+ call FCAT_boson_all(161)
+ wi = s
+ call FCAT_boson_all(162)
+ ur = wr
+ call FCAT_boson_all(163)
+ ui = wi
+ call FCAT_boson_all(164)
+ c = dsqrt(c * 0.5d0 + 0.5d0 )
+ call FCAT_boson_all(165)
+ s = s / (c + c)
+ call FCAT_boson_all(166)
+ le1 = le
+ call FCAT_boson_all(167)
+ le = le1 + le1
+ call FCAT_boson_all(168)
+ do i = 1, n, le
+ call FCAT_boson_all(169)
+ i2 = i + i
+ call FCAT_boson_all(170)
+ ip2 = i2 + le
+ call FCAT_boson_all(171)
+ ti = f(ip2)
+ call FCAT_boson_all(172)
+ f(ip2) = f(i2) - ti
+ call FCAT_boson_all(173)
+ f(i2) = f(i2) + ti
+ call FCAT_boson_all(174)
+ i2 = i2 - 1
+ call FCAT_boson_all(175)
+ ip2 = ip2 - 1
+ call FCAT_boson_all(176)
+ tr = f(ip2)
+ call FCAT_boson_all(177)
+ f(ip2) = f(i2) - tr
+ call FCAT_boson_all(178)
+ f(i2) = f(i2) + tr
+ call FCAT_boson_all(179)
+ enddo
+ call FCAT_boson_all(180)
+ do j = 2, le1
+ call FCAT_boson_all(181)
+ do i = j, n, le
+ call FCAT_boson_all(182)
+ i2 = i + i
+ call FCAT_boson_all(183)
+ ip2 = i2 + le
+ call FCAT_boson_all(184)
+ tr = f(ip2 - 1) * ur - f(ip2) * ui
+ call FCAT_boson_all(185)
+ ti = f(ip2) * ur + f(ip2 - 1) * ui
+ call FCAT_boson_all(186)
+ f(ip2) = f(i2) - ti
+ call FCAT_boson_all(187)
+ f(i2) = f(i2) + ti
+ call FCAT_boson_all(188)
+ i2 = i2 - 1
+ call FCAT_boson_all(189)
+ ip2 = ip2 - 1
+ call FCAT_boson_all(190)
+ f(ip2) = f(i2) - tr
+ call FCAT_boson_all(191)
+ f(i2) = f(i2) + tr
+ call FCAT_boson_all(192)
+ enddo
+ call FCAT_boson_all(193)
+ tr = ur * wr - ui * wi
+ call FCAT_boson_all(194)
+ ui = ui * wr + ur * wi
+ call FCAT_boson_all(195)
+ ur = tr
+ call FCAT_boson_all(196)
+ enddo
+ call FCAT_boson_all(197)
+ enddo
+ call FCAT_boson_all(198)
+ endif
+ call FCAT_boson_all(199)
+ endif
+
+! *** for j and k = 0, 1 ... n-1, transform the array f so obtained into
+! sum f(j+1)*cos(2*pi*k*j/n) and sum f(j+1)*sin(2*pi*k*j/n)
+! and multiply the results by (1 - cos(2*pi*k/n)) and sin(2*pi*k/n)
+
+ call FCAT_boson_all(200)
+ fnp1 = 4 * (f(1) - f(2))
+ call FCAT_boson_all(201)
+ a = 3.141592653589793238d0 / n
+ call FCAT_boson_all(202)
+ n2 = n + 1
+ call FCAT_boson_all(203)
+ n = 2 * n
+ call FCAT_boson_all(204)
+ if (n2 /= 2) then
+ call FCAT_boson_all(205)
+ c = 1.0d0
+ call FCAT_boson_all(206)
+ s = 0.0d0
+ call FCAT_boson_all(207)
+ ca = dcos(a)
+ call FCAT_boson_all(208)
+ sa = dsin(a)
+ call FCAT_boson_all(209)
+ k = n + 1
+ call FCAT_boson_all(210)
+ do j = 3, n2, 2
+ call FCAT_boson_all(211)
+ k = k - 2
+ call FCAT_boson_all(212)
+ d = c
+ call FCAT_boson_all(213)
+ c = d * ca - s * sa
+ call FCAT_boson_all(214)
+ s = d * sa + s * ca
+ call FCAT_boson_all(215)
+ tr1 = f(j) + f(k)
+ call FCAT_boson_all(216)
+ ti1 = f(j + 1) - f(k + 1)
+ call FCAT_boson_all(217)
+ d = f(j) - f(k)
+ call FCAT_boson_all(218)
+ e = f(j + 1) + f(k + 1)
+ call FCAT_boson_all(219)
+ tr2 = d * s + e * c
+ call FCAT_boson_all(220)
+ ti2 = e * s - d * c
+ call FCAT_boson_all(221)
+ f(j) = (1.0d0 - c) * (tr1 + tr2)
+ call FCAT_boson_all(222)
+ f(j + 1) = s * (ti1 + ti2)
+ call FCAT_boson_all(223)
+ f(k) = (1.0d0 + c) * (tr1 - tr2)
+ call FCAT_boson_all(224)
+ f(k + 1) = s * (ti2 - ti1)
+ call FCAT_boson_all(225)
+ enddo
+ call FCAT_boson_all(226)
+ n2 = n2 - 1
+ call FCAT_boson_all(227)
+ do j = 2, n2
+ call FCAT_boson_all(228)
+ j2 = j + j
+ call FCAT_boson_all(229)
+ f(j) = f(j2 - 1) + f(j2)
+ call FCAT_boson_all(230)
+ enddo
+ call FCAT_boson_all(231)
+ do j = 2, n2
+ call FCAT_boson_all(232)
+ f(n + 2 - j) = f(j)
+ call FCAT_boson_all(233)
+ enddo
+ call FCAT_boson_all(234)
+ n2 = n2 + 1
+ call FCAT_boson_all(235)
+ endif
+ call FCAT_boson_all(236)
+ f(n2) = fnp1
+ call FCAT_boson_all(237)
+ if (msign >= 0) then
+
+! *** normalization
+
+ call FCAT_boson_all(238)
+ c = 0.0d0
+ call FCAT_boson_all(239)
+ a = (a + a) / h
+ call FCAT_boson_all(240)
+ do j = 2, n
+ call FCAT_boson_all(241)
+ c = c + a
+ call FCAT_boson_all(242)
+ f(j) = f(j) / c
+ call FCAT_boson_all(243)
+ enddo
+ call FCAT_boson_all(244)
+ endif
+ call FCAT_boson_all(245)
+ f(1) = 0.0d0
+ call FCAT_boson_all(246)
+ return
+end subroutine sintr
+end module sintr_mod
+module rcffi_mod
+contains
+subroutine rcffi(ar, ai, msign, h)
+
+! *******************************************************************
+! * *
+! * using a radix-two fast-fourier-transform technique, rcffi *
+! * computes the fourier integral transform of a real function *
+! * f(x) or the inverse fourier transform of a complex function *
+! * such that g(-y) = conj(g(y)). *
+! * (adapted from cfft routine, cern library member d704) *
+! * *
+! * g(y) = integral f(x) * cexp(-i * x * y) dx (msign < 0) *
+! * *
+! * f(x) = 1 / (2 * pi) integral g(y) * cexp(+i * y * x) dy (msign > 0) *
+! * *
+! * f(x) is tabulated on the meshes of points defined by *
+! * xj = j * hx and -xj = -j * hx, j = 0, +1, ..., n-2, n-1 *
+! * ar(j+1) contains f(+xj) and ai(j+1) contains f(-xj) *
+! * (input when msign < 0 , output when msign >0) *
+! * ar(1) may be different from ai(1) *
+! * *
+! * g(y) is tabulated on the mesh of points defined by *
+! * yk = k * hy , k = 0, 1, ..., n - 2, n - 1 *
+! * ar(j+1) contains real(g(yk)) and ai(j+1) contains aimag(g(yk)) *
+! * (output when msign > 0 , input when msign < 0) *
+! * remark : g(-yk) = conj(g(+yk)) *
+! * *
+! * n = 2**iabs(msign) (msign is an input) *
+! * *
+! * the step sizes satisfy *
+! * hy = (2 * pi) / (n * hx) or hx = (2 * pi) / (n * hy) *
+! * h is an input (h = hx if msign < 0 , h = hy if msign > 0) *
+! * h must be positive *
+! * *
+! * ar and ai are two real arrays with dimension n (input and *
+! * output) *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ double precision, intent(in out) :: ar(*)
+ double precision, intent(in out) :: ai(*)
+ integer, intent(in) :: msign
+ double precision, intent(in) :: h
+
+ double precision :: a, as, c, s, t, ti, tr, ui, ur, wi, wr
+ integer :: i, ip, j, k, l, le, le1, m, n, nm1, nv2
+ logical :: debug
+
+ call FCAT_boson_all(247)
+ debug = .false.
+ call FCAT_boson_all(248)
+ as = 0.0d0
+ call FCAT_boson_all(249)
+ if (msign == 0) then
+ call FCAT_boson_all(250)
+ return
+ call FCAT_boson_all(251)
+ endif
+
+ call FCAT_boson_all(252)
+ if (h <= 0.0d0) then
+ call FCAT_boson_all(253)
+ if (debug) write(*,*) ' *** negative step size in <rcffi>, h = ', h, ' *** '
+ call FCAT_boson_all(254)
+ call FCAT_boson_all_rep()
+ stop
+ call FCAT_boson_all(255)
+ endif
+
+! *** initialization
+
+ call FCAT_boson_all(256)
+ m = iabs(msign)
+ call FCAT_boson_all(257)
+ n = 2**m
+ call FCAT_boson_all(258)
+ if (msign > 0) then
+ call FCAT_boson_all(259)
+ ar(1) = 0.5d0 * ar(1)
+ else
+ call FCAT_boson_all(260)
+ call FCAT_boson_all(261)
+ as = ar(1) - ai(1)
+ call FCAT_boson_all(262)
+ ar(1) = 0.5d0 * (ar(1) + ai(1))
+ call FCAT_boson_all(263)
+ do i = 2, n
+ call FCAT_boson_all(264)
+ ar(i) = ar(i) + ai(n - i + 2)
+ call FCAT_boson_all(265)
+ enddo
+ call FCAT_boson_all(266)
+ do i = 1, n
+ call FCAT_boson_all(267)
+ ai(i) = 0.0d0
+ call FCAT_boson_all(268)
+ enddo
+ call FCAT_boson_all(269)
+ endif
+! *** discrete fast-fourier transform
+ call FCAT_boson_all(270)
+ nv2 = n / 2
+ call FCAT_boson_all(271)
+ nm1 = n - 1
+ call FCAT_boson_all(272)
+ j = 1
+ call FCAT_boson_all(273)
+ do i = 1, nm1
+ call FCAT_boson_all(274)
+ if (i < j) then
+ call FCAT_boson_all(275)
+ tr = ar(j)
+ call FCAT_boson_all(276)
+ ar(j) = ar(i)
+ call FCAT_boson_all(277)
+ ar(i) = tr
+ call FCAT_boson_all(278)
+ ti = ai(j)
+ call FCAT_boson_all(279)
+ ai(j) = ai(i)
+ call FCAT_boson_all(280)
+ ai(i) = ti
+ call FCAT_boson_all(281)
+ endif
+ call FCAT_boson_all(282)
+ k = nv2
+ call FCAT_boson_all(283)
+ do while (j > k)
+ call FCAT_boson_all(284)
+ j = j - k
+ call FCAT_boson_all(285)
+ k = k / 2
+ call FCAT_boson_all(286)
+ enddo
+ call FCAT_boson_all(287)
+ j = j + k
+ call FCAT_boson_all(288)
+ enddo
+ call FCAT_boson_all(289)
+ do i = 1, n, 2
+ call FCAT_boson_all(290)
+ tr = ar(i + 1)
+ call FCAT_boson_all(291)
+ ar(i + 1) = ar(i) - tr
+ call FCAT_boson_all(292)
+ ar(i) = ar(i) + tr
+ call FCAT_boson_all(293)
+ ti = ai(i + 1)
+ call FCAT_boson_all(294)
+ ai(i + 1) = ai(i) - ti
+ call FCAT_boson_all(295)
+ ai(i) = ai(i) + ti
+ call FCAT_boson_all(296)
+ enddo
+ call FCAT_boson_all(297)
+ if (m == 1) return
+ call FCAT_boson_all(298)
+ c = 0.0d0
+ call FCAT_boson_all(299)
+ s = dble(isign(1, msign))
+ call FCAT_boson_all(300)
+ le = 2
+ call FCAT_boson_all(301)
+ do l = 2, m
+ call FCAT_boson_all(302)
+ wr = c
+ call FCAT_boson_all(303)
+ ur = wr
+ call FCAT_boson_all(304)
+ wi = s
+ call FCAT_boson_all(305)
+ ui = wi
+ call FCAT_boson_all(306)
+ c = dsqrt(c * 0.5d0 + 0.5d0)
+ call FCAT_boson_all(307)
+ s = wi / (c + c)
+ call FCAT_boson_all(308)
+ le1 = le
+ call FCAT_boson_all(309)
+ le = le1 + le1
+ call FCAT_boson_all(310)
+ do i = 1, n, le
+ call FCAT_boson_all(311)
+ ip = i + le1
+ call FCAT_boson_all(312)
+ tr = ar(ip)
+ call FCAT_boson_all(313)
+ ar(ip) = ar(i) - tr
+ call FCAT_boson_all(314)
+ ar(i) = ar(i) + tr
+ call FCAT_boson_all(315)
+ ti = ai(ip)
+ call FCAT_boson_all(316)
+ ai(ip) = ai(i) - ti
+ call FCAT_boson_all(317)
+ ai(i) = ai(i) + ti
+ call FCAT_boson_all(318)
+ enddo
+ call FCAT_boson_all(319)
+ do j = 2, le1
+ call FCAT_boson_all(320)
+ do i = j, n, le
+ call FCAT_boson_all(321)
+ ip = i + le1
+ call FCAT_boson_all(322)
+ tr = ar(ip) * ur - ai(ip) * ui
+ call FCAT_boson_all(323)
+ ti = ar(ip) * ui + ai(ip) * ur
+ call FCAT_boson_all(324)
+ ar(ip) = ar(i) - tr
+ call FCAT_boson_all(325)
+ ar(i) = ar(i) + tr
+ call FCAT_boson_all(326)
+ ai(ip) = ai(i) - ti
+ call FCAT_boson_all(327)
+ ai(i) = ai(i) + ti
+ call FCAT_boson_all(328)
+ enddo
+ call FCAT_boson_all(329)
+ tr = ur
+ call FCAT_boson_all(330)
+ ur = tr * wr - ui * wi
+ call FCAT_boson_all(331)
+ ui = tr * wi + ui * wr
+ call FCAT_boson_all(332)
+ enddo
+ call FCAT_boson_all(333)
+ enddo
+
+! *** correction of the discrete fft, using a trapezoidal approximation
+! *** for the variations of the input function
+
+ call FCAT_boson_all(334)
+ c = h
+ call FCAT_boson_all(335)
+ if (msign >= 0) then
+ call FCAT_boson_all(336)
+ c = c / 3.141592653589793238d0
+ call FCAT_boson_all(337)
+ ai(1) = ar(1)
+ call FCAT_boson_all(338)
+ do i = 2, n
+ call FCAT_boson_all(339)
+ ai(i) = ar(n - i + 2)
+ call FCAT_boson_all(340)
+ enddo
+ call FCAT_boson_all(341)
+ endif
+ call FCAT_boson_all(342)
+ ar(1) = c * ar(1)
+ call FCAT_boson_all(343)
+ ai(1) = c * ai(1)
+ call FCAT_boson_all(344)
+ a = 3.141592653589793238d0 / n
+ call FCAT_boson_all(345)
+ wr = dcos(a)
+ call FCAT_boson_all(346)
+ wi = dsin(a)
+ call FCAT_boson_all(347)
+ t = dsqrt(c)
+ call FCAT_boson_all(348)
+ a = a / t
+ call FCAT_boson_all(349)
+ c = 0.0d0
+ call FCAT_boson_all(350)
+ ur = 1.0d0
+ call FCAT_boson_all(351)
+ ui = 0.0d0
+ call FCAT_boson_all(352)
+ do i = 2, n
+ call FCAT_boson_all(353)
+ c = c + a
+ call FCAT_boson_all(354)
+ tr = ur
+ call FCAT_boson_all(355)
+ ur = wr * tr - wi * ui
+ call FCAT_boson_all(356)
+ ui = wi * tr + wr * ui
+ call FCAT_boson_all(357)
+ ti = ui / c
+ call FCAT_boson_all(358)
+ tr = ti**2
+ call FCAT_boson_all(359)
+ ar(i) = ar(i) * tr
+ call FCAT_boson_all(360)
+ ai(i) = ai(i) * tr
+ call FCAT_boson_all(361)
+ if (msign <= 0) then
+ call FCAT_boson_all(362)
+ if (as /= 0.0d0) then
+ call FCAT_boson_all(363)
+ ai(i) = ai(i) - as * (t - ur * ti) / (2 * c)
+ call FCAT_boson_all(364)
+ endif
+ call FCAT_boson_all(365)
+ endif
+ call FCAT_boson_all(366)
+ enddo
+ call FCAT_boson_all(367)
+ return
+end subroutine rcffi
+end module rcffi_mod
+subroutine doboson(t, width, gauss, asym, emin, emax, wmin, wmax, np, p, xout, yout, nout)
+
+! *******************************************************************
+! * *
+! * perform the quantum-mechanical complement to the classical step *
+! * of the dielectric theory of eels in specular geometry using a *
+! * suitable thermodynamical average of the quantized surface *
+! * harmonic oscillators *
+! * *
+! * t: Target temperature *
+! * width: Width of instrumental response (cm**-1) *
+! * gauss: Fraction of gaussian for the instrumental response *
+! * asym: Asymmetry of the instrumental response *
+! * emin: Lower loss energy for this computation (cm**-1) *
+! * emax: Upper loss energy for this computation (cm**-1) *
+! * wmin: Lower loss energy of the eels computation (cm**-1) *
+! * wmax: Upper loss energy of the eels computation (cm**-1) *
+! * np: Number of points of the eels computation *
+! * p: Intensities of the eels computation *
+! * xout: Energies of this computation *
+! * yout: Intensities of this computation *
+! * nout: Number of points of this computation *
+! *******************************************************************
+
+ use rcffi_mod
+ use sicot_mod
+ use sintr_mod
+
+ implicit none
+
+ double precision, intent(in) :: t, width, gauss, asym, emin, emax, wmin
+ double precision, intent(in out) :: wmax
+ integer, intent(in) :: np
+ double precision, intent(in) :: p(np)
+ double precision, intent(in out) :: xout(nout), yout(nout)
+ integer, intent(in out) :: nout
+
+ integer, parameter :: mmax = 14, nmax = 2**mmax
+ double precision :: a, a1, a2, alfa, anorm, b, cp2, dwn, fac, fi
+ double precision :: fm, fm0, fm1, fp1, fmpic, fp, fp0, fppic, fr, g1, g2
+ double precision :: h, pi, sigma, sp2, test, u
+ double precision :: wmpic, wppic, wn, x, x1, x2, x3
+ double precision :: o1, o2, respon
+
+ external o1, o2
+
+ integer :: i, imax, imin, istep, j, jmin, jmax, m, n
+ logical :: picm, picp
+ double precision, allocatable :: p1(:), p2(:)
+ double precision :: r1(nmax), r2(nmax)
+
+ logical :: debug
+
+! remark : the two arrays r1 and r2 are used for fourier
+! transforming the user-supplied instrumental response of the
+! spectrometer that has to be coded in the external routine
+! respon called when the input parameter gauss is < 0 or > 1.
+! with 0 <= gauss <= 1, r1 and r2 are not used.
+
+! *** rational approximations for ei(u) * exp(-u) + e1(u) * exp(+u)
+! *** in the intervals (0, 1.3) and (1.3, infinity) <accuracy : 4.e-04>
+! *** used for fourier transforming half-lorentzian functions
+
+
+ call FCAT_boson_all(368)
+ debug = .false.
+ call FCAT_boson_all(369)
+ data fm1 / 0.0d0 /, fp1 / 0.0d0 /
+ call FCAT_boson_all(370)
+ pi = 4 * datan(1.0d0)
+
+ call FCAT_boson_all(371)
+ dwn = (wmax - wmin) / (np - 1)
+
+! *** redefine the frequency interval (0, wmax) to be used for the
+! *** fourier transforms
+
+ call FCAT_boson_all(372)
+ if (debug) write(*,*) 'wmin: ', wmin, 'wmax: ', wmax, 'dwn: ', dwn
+ call FCAT_boson_all(373)
+ jmin = int(0.5d0 + wmin / dwn)
+ call FCAT_boson_all(374)
+ if ((jmin - 0.5d0) * dwn < wmin) then
+ call FCAT_boson_all(375)
+ jmin = jmin + 1
+ call FCAT_boson_all(376)
+ endif
+ call FCAT_boson_all(377)
+ fac = ((jmin - 0.5d0) * dwn - wmin) / dwn
+ call FCAT_boson_all(378)
+ jmax = int(0.5d0 + wmax / dwn)
+ call FCAT_boson_all(379)
+ test = dmax1(1.5d0 * dabs(emin), 1.5d0 * dabs(emax), 6 * wmax)
+ call FCAT_boson_all(380)
+ n = 2
+ call FCAT_boson_all(381)
+ do m = 2, mmax
+ call FCAT_boson_all(382)
+ n = 2 * n
+ call FCAT_boson_all(383)
+ wmax = n * dwn
+ call FCAT_boson_all(384)
+ if (wmax >= test) exit
+ call FCAT_boson_all(385)
+ enddo
+ call FCAT_boson_all(386)
+ if (wmax < test) then
+ call FCAT_boson_all(387)
+ m = mmax
+ call FCAT_boson_all(388)
+ n = nmax
+ call FCAT_boson_all(389)
+ wmax = n * dwn
+ call FCAT_boson_all(390)
+ if (debug) write(*,*) ' +++ n has been fixed at', nmax, ' = 2**', mmax, ' +++'
+ call FCAT_boson_all(391)
+ endif
+ call FCAT_boson_all(392)
+ if (debug) then
+ call FCAT_boson_all(393)
+ write(*,*) ' classical spectrum redefined from 0.0 to', wmax
+ call FCAT_boson_all(394)
+ write(*,*) ' step size =', dwn, ', ', n, ' (= 2**', m, ') points'
+ call FCAT_boson_all(395)
+ endif
+
+ call FCAT_boson_all(396)
+ allocate (p1(n))
+ call FCAT_boson_all(397)
+ allocate (p2(n))
+
+ call FCAT_boson_all(398)
+ p1 = 0
+
+! *** interpolate pcl on a suitable mesh in (0, wmax)
+ call FCAT_boson_all(399)
+ i = 1
+ call FCAT_boson_all(400)
+ do j = jmin, min(jmax, n)
+ call FCAT_boson_all(401)
+ p1(j) = p(i) + fac * (p(i + 1) - p(i))
+ call FCAT_boson_all(402)
+ i = i + 1
+ call FCAT_boson_all(403)
+ enddo
+
+ call FCAT_boson_all(404)
+ p2 = p1
+
+! *** characteristic function f(tau)
+
+ call FCAT_boson_all(405)
+ call sicot(p1, m, dwn, 1.39d0 * t)
+ call FCAT_boson_all(406)
+ call sintr(p2, m, dwn)
+ call FCAT_boson_all(407)
+ h = (pi + pi) / wmax
+ call FCAT_boson_all(408)
+ if (gauss < 0.0d0 .or. gauss > 1.0d0) then
+
+! *** broaden the spectrum by convoluting the characteristic function
+! *** with a user-supplied response function (arbitrary normalization)
+
+ call FCAT_boson_all(409)
+ if (debug) write(*,*) '==> switch to a user-supplied instrumental response'
+ call FCAT_boson_all(410)
+ alfa = dmax1(4 * dwn, width)
+ call FCAT_boson_all(411)
+ if (alfa > width) then
+ call FCAT_boson_all(412)
+ if (debug) write(*,*) ' +++ width has been enlarged to', alfa, ' +++'
+ call FCAT_boson_all(413)
+ endif
+ call FCAT_boson_all(414)
+ if (alfa < 10 * dwn) then
+ call FCAT_boson_all(415)
+ if (debug) then
+ call FCAT_boson_all(416)
+ write(*,*) ' ... poor representation of the response function ...'
+ call FCAT_boson_all(417)
+ write(*,*) 'the step size (', dwn, ') should be reduced'
+ call FCAT_boson_all(418)
+ endif
+ call FCAT_boson_all(419)
+ endif
+! make a table of the response function
+ call FCAT_boson_all(420)
+ r1(1) = respon(0.0d0, alfa)
+ call FCAT_boson_all(421)
+ r2(1) = r1(1)
+ call FCAT_boson_all(422)
+ do i = 2, n
+ call FCAT_boson_all(423)
+ x = (i - 1) * dwn
+ call FCAT_boson_all(424)
+ r1(i) = respon( x, alfa)
+ call FCAT_boson_all(425)
+ r2(i) = respon(-x, alfa)
+ call FCAT_boson_all(426)
+ enddo
+! fourier transform it
+ call FCAT_boson_all(427)
+ call rcffi(r1, r2, -m, dwn)
+! normalization of the response function, and convolution
+ call FCAT_boson_all(428)
+ anorm = r1(1)
+ call FCAT_boson_all(429)
+ do i = 1, n
+ call FCAT_boson_all(430)
+ fac = dexp(-p1(i)) / anorm
+ call FCAT_boson_all(431)
+ cp2 = fac * dcos(p2(i))
+ call FCAT_boson_all(432)
+ sp2 = fac * dsin(p2(i))
+ call FCAT_boson_all(433)
+ p1(i) = r1(i) * cp2 + r2(i) * sp2
+ call FCAT_boson_all(434)
+ p2(i) = r2(i) * cp2 - r1(i) * sp2
+ call FCAT_boson_all(435)
+ enddo
+ call FCAT_boson_all(436)
+ alfa = alfa / 2
+
+ else
+
+! *** broaden the spectrum by convoluting the characteristic function by
+! *** a weighted sum of a lorentzian and a gaussian response functions
+
+ call FCAT_boson_all(437)
+ call FCAT_boson_all(438)
+ alfa = dmax1(1.5d0 * dwn, width)
+ call FCAT_boson_all(439)
+ if (alfa > width) then
+ call FCAT_boson_all(440)
+ if (debug) write(*,*) ' +++ width has been enlarged to', alfa, ' +++'
+ call FCAT_boson_all(441)
+ endif
+ call FCAT_boson_all(442)
+ if (alfa > 0.5d0 * wmax / pi) then
+ call FCAT_boson_all(443)
+ call FCAT_boson_all_rep()
+ stop '*** width is too large, nothing done ***'
+ call FCAT_boson_all(444)
+ endif
+ call FCAT_boson_all(445)
+ alfa = 0.5d0 * alfa
+ call FCAT_boson_all(446)
+ sigma = alfa / 1.66511d0
+ call FCAT_boson_all(447)
+ a1 = (1.0d0 - asym) / 2 * (1.0d0 - gauss)
+ call FCAT_boson_all(448)
+ a2 = (1.0d0 + asym) / 2 * (1.0d0 - gauss)
+ call FCAT_boson_all(449)
+ if (a1 < 0.0d0 .or. a2 < 0.0d0) then
+ call FCAT_boson_all(450)
+ call FCAT_boson_all_rep()
+ stop '*** invalid input : asym should be in (-1, +1) ***'
+ call FCAT_boson_all(451)
+ endif
+ call FCAT_boson_all(452)
+ g1 = (1.0d0 - asym) * alfa
+ call FCAT_boson_all(453)
+ g2 = (1.0d0 + asym) * alfa
+ call FCAT_boson_all(454)
+ p1(1) = 1.0d0
+ call FCAT_boson_all(455)
+ p2(1) = 0.0d0
+ call FCAT_boson_all(456)
+ do i = 2, n
+ call FCAT_boson_all(457)
+ x = (i - 1) * h
+ call FCAT_boson_all(458)
+ fr = 0.0d0
+ call FCAT_boson_all(459)
+ fi = 0.0d0
+ call FCAT_boson_all(460)
+ if (a1 /= 0.0d0) then
+ call FCAT_boson_all(461)
+ x1 = g1 * x
+ call FCAT_boson_all(462)
+ if (x1 <= 100.0d0) then
+ call FCAT_boson_all(463)
+ fr = a1 * dexp(-x1)
+ call FCAT_boson_all(464)
+ endif
+ call FCAT_boson_all(465)
+ if (a1 /= a2) then
+ call FCAT_boson_all(466)
+ if (x1 <= 1.3d0) then
+ call FCAT_boson_all(467)
+ fi = a1 * o1(x1)
+ else
+ call FCAT_boson_all(468)
+ call FCAT_boson_all(469)
+ fi = a1 * o2(x1)
+ call FCAT_boson_all(470)
+ endif
+ call FCAT_boson_all(471)
+ endif
+ call FCAT_boson_all(472)
+ endif
+ call FCAT_boson_all(473)
+ if (a2 /= 0.0d0) then
+ call FCAT_boson_all(474)
+ x2 = g2 * x
+ call FCAT_boson_all(475)
+ if (x2 <= 100.0d0) then
+ call FCAT_boson_all(476)
+ fr = fr + a2 * dexp(-x2)
+ call FCAT_boson_all(477)
+ endif
+ call FCAT_boson_all(478)
+ if (a2 /= a1) then
+ call FCAT_boson_all(479)
+ if (x2 <= 1.3d0) then
+ call FCAT_boson_all(480)
+ fi = fi - a2 * o1(x2)
+ else
+ call FCAT_boson_all(481)
+ call FCAT_boson_all(482)
+ fi = fi - a2 * o2(x2)
+ call FCAT_boson_all(483)
+ endif
+ call FCAT_boson_all(484)
+ endif
+ call FCAT_boson_all(485)
+ endif
+ call FCAT_boson_all(486)
+ if (gauss /= 0.0d0) then
+ call FCAT_boson_all(487)
+ x3 = sigma * x
+ call FCAT_boson_all(488)
+ if (x3 <= 10.0d0) then
+ call FCAT_boson_all(489)
+ fr = fr + gauss * dexp(-x3**2)
+ call FCAT_boson_all(490)
+ endif
+ call FCAT_boson_all(491)
+ endif
+ call FCAT_boson_all(492)
+ fi = fi / pi
+ call FCAT_boson_all(493)
+ fac = dexp(-p1(i))
+ call FCAT_boson_all(494)
+ cp2 = fac * dcos(p2(i))
+ call FCAT_boson_all(495)
+ sp2 = fac * dsin(p2(i))
+ call FCAT_boson_all(496)
+ p1(i) = fr * cp2 + fi * sp2
+ call FCAT_boson_all(497)
+ p2(i) = fi * cp2 - fr * sp2
+ call FCAT_boson_all(498)
+ enddo
+ call FCAT_boson_all(499)
+ if (dabs(fi) > 1.0d-03) then
+ call FCAT_boson_all(500)
+ if (debug) then
+ call FCAT_boson_all(501)
+ write(*,*) ' ... poor representation of the response function ...'
+ call FCAT_boson_all(502)
+ write(*,*) 'the step size (', dwn, ') should be reduced'
+ call FCAT_boson_all(503)
+ endif
+ call FCAT_boson_all(504)
+ endif
+ call FCAT_boson_all(505)
+ endif
+
+! *** full eels spectrum
+
+ call FCAT_boson_all(506)
+ call rcffi(p1, p2, m, h)
+
+! *** output
+
+ call FCAT_boson_all(507)
+ istep = max(int(alfa / dwn / 10), 1)
+ call FCAT_boson_all(508)
+ nout = 0
+ call FCAT_boson_all(509)
+ if (emin <= 0.0d0) then
+ call FCAT_boson_all(510)
+ imin = n - int(dabs(emin) / dwn)
+ call FCAT_boson_all(511)
+ if ((imin - n) * dwn < emin) then
+ call FCAT_boson_all(512)
+ imin = imin + 1
+ call FCAT_boson_all(513)
+ endif
+ call FCAT_boson_all(514)
+ do i = imin, n
+ call FCAT_boson_all(515)
+ j = n - i
+ call FCAT_boson_all(516)
+ if (mod(j, istep) > 0) cycle
+ call FCAT_boson_all(517)
+ x = -j * dwn
+ call FCAT_boson_all(518)
+ if (x > emax) exit
+ call FCAT_boson_all(519)
+ nout = nout + 1
+ call FCAT_boson_all(520)
+ xout(nout)= x
+ call FCAT_boson_all(521)
+ yout(nout)= p2(j + 1)
+ call FCAT_boson_all(522)
+ enddo
+ call FCAT_boson_all(523)
+ endif
+ call FCAT_boson_all(524)
+ if (x <= emax) then
+ call FCAT_boson_all(525)
+ if (emax >= dwn) then
+ call FCAT_boson_all(526)
+ imax = int(emax / dwn) + 1
+ call FCAT_boson_all(527)
+ if ((imax - 1) * dwn > emax) then
+ call FCAT_boson_all(528)
+ imax = imax - 1
+ call FCAT_boson_all(529)
+ endif
+ call FCAT_boson_all(530)
+ if (imax >= 2) then
+ call FCAT_boson_all(531)
+ do i = 2, imax
+ call FCAT_boson_all(532)
+ if (mod(i - 1, istep) > 0) cycle
+ call FCAT_boson_all(533)
+ x = (i - 1) * dwn
+ call FCAT_boson_all(534)
+ if (x < emin) cycle
+ call FCAT_boson_all(535)
+ nout = nout + 1
+ call FCAT_boson_all(536)
+ xout(nout) = x
+ call FCAT_boson_all(537)
+ yout(nout) = p1(i)
+ call FCAT_boson_all(538)
+ enddo
+ call FCAT_boson_all(539)
+ endif
+ call FCAT_boson_all(540)
+ endif
+ call FCAT_boson_all(541)
+ endif
+ call FCAT_boson_all(542)
+ if (debug) write(*,*) nout, ' values, step size =', istep * dwn
+
+! *** analyze the spectrum
+
+ call FCAT_boson_all(543)
+ if (debug) write(*,*) ' peak location amplitude'
+ call FCAT_boson_all(544)
+ wn = 0.0d0
+ call FCAT_boson_all(545)
+ fm = p1(1)
+ call FCAT_boson_all(546)
+ fp = p2(1)
+ call FCAT_boson_all(547)
+ if (p2(2) < fp .and. p1(2) < fp) then
+ call FCAT_boson_all(548)
+ if (debug) write(*, '(f13.2, e13.4)') wn, fp
+ call FCAT_boson_all(549)
+ endif
+ call FCAT_boson_all(550)
+ fac = 5.0d-06 * fp * dwn
+ call FCAT_boson_all(551)
+ imax = 2 + int(dmax1(dabs(emin), dabs(emax)) / dwn)
+ call FCAT_boson_all(552)
+ do i = 2, imax
+ call FCAT_boson_all(553)
+ fm0 = fm1
+ call FCAT_boson_all(554)
+ fp0 = fp1
+ call FCAT_boson_all(555)
+ fm1 = fm
+ call FCAT_boson_all(556)
+ fp1 = fp
+ call FCAT_boson_all(557)
+ fm = p2(i)
+ call FCAT_boson_all(558)
+ fp = p1(i)
+ call FCAT_boson_all(559)
+ if (i == 2) cycle
+ call FCAT_boson_all(560)
+ picm = .false.
+ call FCAT_boson_all(561)
+ picp = .false.
+ call FCAT_boson_all(562)
+ wn = (i - 1) * dwn
+ call FCAT_boson_all(563)
+ if ((fm1 >= fm0) .and. (fm1 >= fm)) then
+ call FCAT_boson_all(564)
+ a = (fm1 - fm0) + (fm1 - fm)
+ call FCAT_boson_all(565)
+ if (a >= fac) then
+ call FCAT_boson_all(566)
+ b = 0.5d0 * ((fm1 - fm0) + 3 * (fm1 - fm))
+ call FCAT_boson_all(567)
+ u = b / a
+ call FCAT_boson_all(568)
+ wmpic = -wn + u * dwn
+ call FCAT_boson_all(569)
+ fmpic = fm + 0.5d0 * b * u
+ call FCAT_boson_all(570)
+ picm = .true.
+ call FCAT_boson_all(571)
+ endif
+ call FCAT_boson_all(572)
+ endif
+ call FCAT_boson_all(573)
+ if ((fp1 >= fp0) .and. (fp1 >= fp)) then
+ call FCAT_boson_all(574)
+ a = (fp1 - fp0) + (fp1 - fp)
+ call FCAT_boson_all(575)
+ if (a >= fac) then
+ call FCAT_boson_all(576)
+ b = 0.5d0 * ((fp1 - fp0) + 3 * (fp1 - fp))
+ call FCAT_boson_all(577)
+ u = b / a
+ call FCAT_boson_all(578)
+ wppic = wn - u * dwn
+ call FCAT_boson_all(579)
+ fppic = fp + 0.5d0 * b * u
+ call FCAT_boson_all(580)
+ picp = .true.
+ call FCAT_boson_all(581)
+ if (picp) then
+ call FCAT_boson_all(582)
+ if (picm) then
+ call FCAT_boson_all(583)
+ if (debug) write(*, '(2(f13.2, e13.4, 5x))') wppic, fppic, wmpic, fmpic
+ else
+ call FCAT_boson_all(584)
+ call FCAT_boson_all(585)
+ if (debug) write(*, '(f13.2, e13.4)') wppic, fppic
+ call FCAT_boson_all(586)
+ endif
+ call FCAT_boson_all(587)
+ endif
+ call FCAT_boson_all(588)
+ endif
+ call FCAT_boson_all(589)
+ endif
+ call FCAT_boson_all(590)
+ if (picm .and. (.not. picp)) then
+ call FCAT_boson_all(591)
+ if (debug) write(*, '(33x, f13.2, e13.4)') wmpic, fmpic
+ call FCAT_boson_all(592)
+ endif
+ call FCAT_boson_all(593)
+ enddo
+ call FCAT_boson_all(594)
+ deallocate (p1)
+ call FCAT_boson_all(595)
+ deallocate (p2)
+ call FCAT_boson_all(596)
+ return
+end subroutine doboson
+double precision function o1(u)
+
+ implicit none
+
+ double precision, intent(in) :: u
+ double precision :: u2
+
+ call FCAT_boson_all(597)
+ u2 = u**2
+ call FCAT_boson_all(598)
+ o1 = -dsinh(u) * dlog(u2) + u * ((0.03114d0 * u2 + 0.41666d0) * u2 + 0.84557d0)
+
+ call FCAT_boson_all(599)
+ return
+end function o1
+double precision function o2(u)
+
+ implicit none
+
+ double precision, intent(in) :: u
+ double precision :: u2
+
+ call FCAT_boson_all(600)
+ u2 = 1 / u**2
+ call FCAT_boson_all(601)
+ o2 = (((202.91d0 * u2 + 932.21d0) * u2 + 41.740d0) * u2 + 2.0d0) / &
+ (((540.88d0 * u2 + 345.67d0) * u2 + 18.961d0) * u2 + 1.0d0) / u
+
+ call FCAT_boson_all(602)
+ return
+end function o2
+ module FCAT_boson_all_mod
+ double precision,dimension (603):: &
+ & FCAT_boson_all_counter = 0
+ integer :: FCAT_boson_all_nline = 602
+ end module FCAT_boson_all_mod
+ subroutine FCAT_boson_all(n)
+ use FCAT_boson_all_mod
+ integer :: n
+ FCAT_boson_all_counter(n) = &
+ & FCAT_boson_all_counter(n) + 1
+ if (FCAT_boson_all_counter(n) == 1) then
+ write(*,"(a,i10)") "FCAT_boson_all_",n
+ endif
+ end subroutine FCAT_boson_all
+ subroutine FCAT_boson_all_rep()
+ use FCAT_boson_all_mod
+ integer :: i
+ do i = 1, FCAT_boson_all_nline
+ write(*,"(a,i10,i10)") &
+ & "FCAT_boson_all_count",i, &
+ & int(FCAT_boson_all_counter(i)+0.1)
+ end do
+ end subroutine FCAT_boson_all_rep
diff --git a/source/f90/fcat-analysis/boson_all.f90 b/source/f90/fcat-analysis/boson_all.f90
new file mode 100644
index 0000000..67edb5b
--- /dev/null
+++ b/source/f90/fcat-analysis/boson_all.f90
@@ -0,0 +1,972 @@
+program boson
+
+! *******************************************************************
+! * *
+! * perform the quantum-mechanical complement to the classical step *
+! * of the dielectric theory of eels in specular geometry using a *
+! * suitable thermodynamical average of the quantized surface *
+! * harmonic oscillators *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ integer, parameter :: mmax=14, nmax=2**mmax
+ double precision :: asym, emax, emin, gauss, t, width, wmin, wmax, y
+ double precision :: p2(nmax)
+ integer :: i, np, ioStatus
+ character (len = 72) :: comment(2)
+ double precision, allocatable :: xout(:), yout(:)
+ integer :: nout
+
+! *** read input parameters
+
+ call change_working_dir()
+ open(unit = 13, file = 'bosin')
+! target temperature (Kelvin)
+ read(13, *) t
+! width of the instrumental response (cm**-1)
+ read(13, *) width
+! fraction of gaussian for the instrumental response
+ read(13, *) gauss
+! asymmetry of the instrumental response
+ read(13, *) asym
+! lower and upper energy losses for this computation (cm**-1)
+ read(13, *) emin
+ read(13, *) emax
+ close(unit=13)
+
+ write(*,*) 'program boson (September 2020)'
+ write(*,'(a, f6.1, a, f7.2, a)') ' t =', t, ' K, width =', width, ' cm**-1'
+ write(*,'(a, f5.2, a, f5.2)') ' gauss =', gauss, ', asym =', asym
+ write(*,'(a, g11.4, a, g11.4, a)') ' energy losses from', emin, ' to', emax, ' cm**-1'
+
+! *** read the table of values of the classical loss spectrum
+
+ open(unit = 12, file = 'eelsou')
+ read(12, '(a48)') comment(1)
+ read(12, '(a72)') comment(2)
+ np = 0
+ do
+ read(12, *, IOSTAT = ioStatus) wmax, y
+ if (ioStatus /= 0) exit
+ if (wmax < 0.0d0) cycle
+ np = np + 1
+ p2(np) = y
+ if (np == 1) wmin = wmax
+ if (np < nmax) cycle
+ enddo
+ close(unit = 12)
+
+ if (np <= 0) stop '*** no input values for pcl ***'
+
+ write(*,*) comment(2)
+ write(*,'(a, i6, a, g15.7, a, g15.7)') ' read', np, ' values of pcl from', wmin, ' to', wmax
+
+! length calculation for xout, yout.
+!
+ nout = 2**14
+ allocate (xout(nout))
+ allocate (yout(nout))
+
+ call doboson(t, width, gauss, asym, emin, emax, wmin, wmax, np, p2, xout, yout, nout)
+
+ open(unit = 14, file = 'bosou')
+ write(14, '(a, a, f6.1, a, f5.2)') comment(1), 'T =', t, ' GAUSS =', gauss
+ write(14, *) comment(2)
+ do i = 1, nout
+ write(14, '(2e15.7)') xout(i), yout(i)
+ end do
+ close(unit = 14)
+ write(*,*) nout, ' values written on disk'
+
+ deallocate (xout, yout)
+ stop
+end program boson
+subroutine change_working_dir()
+
+! This routine gets the first argument of the commandline and takes it
+! as the path to change the working directory
+! used intrinsic routines:
+! iarg returns the number of commandline arguments without the program cname.
+! chdir changes the directory and returns 0 on success.
+! trim removes blanks from strings.
+
+ character (len = 256) :: argument
+ integer :: status
+
+ if (iargc() == 1) then
+ call getarg(1, argument)
+ status = chdir(trim(argument))
+ if (status /= 0) then
+ write (*,*) '*** change directory failed ***'
+ write (*,*) 'directory tried: ', trim(argument)
+ write (*,*) 'error code (see: man chdir): ', status
+ write (*,*) 'continuing in the start directory'
+ end if
+ end if
+
+ return
+end subroutine change_working_dir
+double precision function respon(w, width)
+
+!*******************************************************************
+! *
+! instrumental response of the spectrometer for the frequency w *
+! width is the full width at half maximum of the response function *
+! *
+!*******************************************************************
+
+ implicit none
+ double precision, intent(in) :: w, width
+
+ double precision :: u
+
+ u = 1.25d0 * w / width
+ if (u <= -1.0d0 .or. u >= 2.0d0) then
+ respon = 0.0d0
+ elseif (u > 1.0d0) then
+ respon = 4.0d0 + 2 * dsqrt((u - 1.0d0)**3) - 3 * u
+ elseif (u > 0.0d0) then
+ respon = 2.0d0 - 4 * dsqrt(u**3) + 3 * u
+ else
+ respon = 2 * dsqrt((u + 1.0d0)**3)
+ endif
+ return
+end function respon
+module sicot_mod
+contains
+subroutine sicot(f, m, h, x0)
+
+! *******************************************************************
+! * *
+! * integral transform g(y, x0) of a real function f(x) defined by *
+! * *
+! * g(x0, y) = integral of f(x)/tanh(x/x0)*(1-cos(x*y)) dx *
+! * *
+! * f(x) is tabulated on the mesh of points xj = (j-1/2)*h , *
+! * j = 1, 2, ..., n , with n = 2**m *
+! * g(x0, y) is computed on the mesh of points yk = k*2pi/(n*h) , *
+! * k = 0, 1, 2, ..., n-1 *
+! * *
+! * input ... *
+! * f(j) contains the value of f(xj) , j = 1, 2, ..., n *
+! * m is such that n = 2**iabs(m) *
+! * h is the step size (must be positive) *
+! * *
+! * output ... *
+! * f(k+1) contains g(x0, yk), k = 0, 1, ..., n-1 *
+! * *
+! * computing remarks ... *
+! * f is a real array with dimension n or more *
+! * it is supposed that f(x) is zero for x > n*h *
+! * external reference : sintr (sine transform of a real function). *
+! * *
+! *******************************************************************
+
+ use sintr_mod
+
+ implicit none
+
+ double precision, intent(in out) :: f(*)
+ integer, intent(in) :: m
+ double precision, intent(in) :: h
+ double precision, intent(in) :: x0
+
+ double precision :: a, b, c, d, e, s, sa
+ integer :: i, j, msign, n
+
+ logical :: debug
+
+ debug = .false.
+ if (m == 0) then
+ f(1) = 0.0d0
+ return
+ endif
+
+ if (h <= 0.0d0) then
+ if (debug) write(*,*) ' *** incorrect step size in <sicot>, h =', h, ' ***'
+ stop
+ endif
+
+ if (x0 < 0.0d0) then
+ if (debug) write(*,*) ' *** incorrect input in <sicot>, x0 =', x0, ' ***'
+ stop
+ endif
+
+ n = 2**iabs(m)
+
+! *** evaluate the integral from xj to infinity of f(x)/tanh(x/x0) dx
+! and store the result in f(j)
+
+ c = 0.0d0
+ if (x0 > h / 16) then
+ c = dexp(-h / x0)
+ endif
+ s = 1.0d0 - c
+ e = c**2
+ a = 0.25d0 * h
+ b = 0.25d0 * x0
+ do i = 1, n
+ if (i < n) then
+ f(i) = f(i) + f(i+1)
+ endif
+ d = a
+ if (s /= 1.0d0) then
+ sa = s
+ c = c * e
+ s = 1.0d0 - c
+ d = d + b * dlog(s / sa)
+ endif
+ f(i) = f(i) * d
+ enddo
+
+ j = n
+ do i = 2, n
+ j = j - 1
+ f(j) = f(j) + f(j + 1)
+ enddo
+! alternative, but not yet tested:
+! do j = n - 1, 1, -1
+! f(j) = f(j) + f(j + 1)
+! enddo
+ msign = -iabs(m)
+ call sintr(f, msign, h)
+ return
+end subroutine sicot
+end module sicot_mod
+module sintr_mod
+contains
+subroutine sintr(f, msign, h)
+
+! *******************************************************************
+! * *
+! * integral sine transform of a real function f(x) *
+! * *
+! * g(y) = integral from zero to infinity of f(x)*sin(x*y) dx *
+! * if msign >= 0 or *
+! * g(y) = y * integral from zero to infinity of f(x)*sin(x*y) dx *
+! * if msign < 0 *
+! * *
+! * f(x) is tabulated on the mesh of points xj = (j-1/2)*h , *
+! * j = 1, 2, ..., n , with n = 2**iabs(msig) *
+! * g(y) is computed on the mesh of points yk = k*2pi/(n*h) , *
+! * k = 0, 1, 2, ..., n-1 *
+! * *
+! * input ... *
+! * f(j) contains the value of f(xj) , j = 1, 2, ..., n *
+! * msign is such that n = 2**iabs(msign) *
+! * h is the step size (must be positive) *
+! * *
+! * output ... *
+! * f(k+1) contains g(yk), k = 0, 1, ..., n-1 *
+! * *
+! * computing remarks ... *
+! * f is a real array with dimension n or more *
+! * it is supposed that f(x) is zero for x > n*h *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ double precision, intent(in out) :: f(*)
+ integer, intent(in) :: msign
+ double precision, intent(in) :: h
+
+ double precision :: a, c, ca, d, e, fnp1, s, sa, ti, ti1, ti2, tr, tr1, tr2
+ double precision :: ui, ur, wi, wr
+ integer :: i, i2, ip2, j, j2, k, l, le, le1, m2, n, n2, nm1, nv2
+
+ logical :: debug
+
+ debug = .false.
+ if (h <= 0.0d0) then
+ if (debug) write(*,*) ' *** incorrect step size in <sintr>, h: ', h, ' ***'
+ stop
+ endif
+
+ if (msign == 0) then
+ f(1) = 0.0d0
+ return
+ endif
+
+! *** for j and k = 0, 1, 2 ... n/2-1, compute
+! s1 = sum ( f(2*j+1)*cos(4*pi*k*j/n) - f(2*j+2)*sin(4*pi*k*j/n) )
+! s2 = sum ( f(2*j+1)*sin(4*pi*k*j/n) + f(2*j+2)*cos(4*pi*k*j/n) )
+! store s1 in f(2*k+1) and s2 in f(2*k+2)
+! (adapted from cfft routine, cern library member d704)
+
+ m2 = iabs(msign) - 1
+ n = 2**m2
+ if (n /= 1) then
+ nv2 = n / 2
+ nm1 = n - 1
+ j = 1
+ do i = 1, nm1
+ if (i < j) then
+ i2 = i + i
+ j2 = j + j
+ ti = f(j2)
+ f(j2) = f(i2)
+ f(i2) = ti
+ i2 = i2 - 1
+ j2 = j2 - 1
+ tr = f(j2)
+ f(j2) = f(i2)
+ f(i2) = tr
+ endif
+ k = nv2
+ do while (j > k)
+ j = j - k
+ k = k / 2
+ enddo
+ j = j + k
+ enddo
+ do i = 1, n, 2
+ i2 = i + i
+ ti = f(i2 + 2)
+ f(i2 + 2) = f(i2) - ti
+ f(i2) = f(i2) + ti
+ i2 = i2 - 1
+ tr = f(i2 + 2)
+ f(i2 + 2) = f(i2) - tr
+ f(i2) = f(i2) + tr
+ enddo
+ if (m2 /= 1) then
+ c = 0.0d0
+ s = 1.0d0
+ le = 2
+ do l = 2, m2
+ wr = c
+ wi = s
+ ur = wr
+ ui = wi
+ c = dsqrt(c * 0.5d0 + 0.5d0 )
+ s = s / (c + c)
+ le1 = le
+ le = le1 + le1
+ do i = 1, n, le
+ i2 = i + i
+ ip2 = i2 + le
+ ti = f(ip2)
+ f(ip2) = f(i2) - ti
+ f(i2) = f(i2) + ti
+ i2 = i2 - 1
+ ip2 = ip2 - 1
+ tr = f(ip2)
+ f(ip2) = f(i2) - tr
+ f(i2) = f(i2) + tr
+ enddo
+ do j = 2, le1
+ do i = j, n, le
+ i2 = i + i
+ ip2 = i2 + le
+ tr = f(ip2 - 1) * ur - f(ip2) * ui
+ ti = f(ip2) * ur + f(ip2 - 1) * ui
+ f(ip2) = f(i2) - ti
+ f(i2) = f(i2) + ti
+ i2 = i2 - 1
+ ip2 = ip2 - 1
+ f(ip2) = f(i2) - tr
+ f(i2) = f(i2) + tr
+ enddo
+ tr = ur * wr - ui * wi
+ ui = ui * wr + ur * wi
+ ur = tr
+ enddo
+ enddo
+ endif
+ endif
+
+! *** for j and k = 0, 1 ... n-1, transform the array f so obtained into
+! sum f(j+1)*cos(2*pi*k*j/n) and sum f(j+1)*sin(2*pi*k*j/n)
+! and multiply the results by (1 - cos(2*pi*k/n)) and sin(2*pi*k/n)
+
+ fnp1 = 4 * (f(1) - f(2))
+ a = 3.141592653589793238d0 / n
+ n2 = n + 1
+ n = 2 * n
+ if (n2 /= 2) then
+ c = 1.0d0
+ s = 0.0d0
+ ca = dcos(a)
+ sa = dsin(a)
+ k = n + 1
+ do j = 3, n2, 2
+ k = k - 2
+ d = c
+ c = d * ca - s * sa
+ s = d * sa + s * ca
+ tr1 = f(j) + f(k)
+ ti1 = f(j + 1) - f(k + 1)
+ d = f(j) - f(k)
+ e = f(j + 1) + f(k + 1)
+ tr2 = d * s + e * c
+ ti2 = e * s - d * c
+ f(j) = (1.0d0 - c) * (tr1 + tr2)
+ f(j + 1) = s * (ti1 + ti2)
+ f(k) = (1.0d0 + c) * (tr1 - tr2)
+ f(k + 1) = s * (ti2 - ti1)
+ enddo
+ n2 = n2 - 1
+ do j = 2, n2
+ j2 = j + j
+ f(j) = f(j2 - 1) + f(j2)
+ enddo
+ do j = 2, n2
+ f(n + 2 - j) = f(j)
+ enddo
+ n2 = n2 + 1
+ endif
+ f(n2) = fnp1
+ if (msign >= 0) then
+
+! *** normalization
+
+ c = 0.0d0
+ a = (a + a) / h
+ do j = 2, n
+ c = c + a
+ f(j) = f(j) / c
+ enddo
+ endif
+ f(1) = 0.0d0
+ return
+end subroutine sintr
+end module sintr_mod
+module rcffi_mod
+contains
+subroutine rcffi(ar, ai, msign, h)
+
+! *******************************************************************
+! * *
+! * using a radix-two fast-fourier-transform technique, rcffi *
+! * computes the fourier integral transform of a real function *
+! * f(x) or the inverse fourier transform of a complex function *
+! * such that g(-y) = conj(g(y)). *
+! * (adapted from cfft routine, cern library member d704) *
+! * *
+! * g(y) = integral f(x) * cexp(-i * x * y) dx (msign < 0) *
+! * *
+! * f(x) = 1 / (2 * pi) integral g(y) * cexp(+i * y * x) dy (msign > 0) *
+! * *
+! * f(x) is tabulated on the meshes of points defined by *
+! * xj = j * hx and -xj = -j * hx, j = 0, +1, ..., n-2, n-1 *
+! * ar(j+1) contains f(+xj) and ai(j+1) contains f(-xj) *
+! * (input when msign < 0 , output when msign >0) *
+! * ar(1) may be different from ai(1) *
+! * *
+! * g(y) is tabulated on the mesh of points defined by *
+! * yk = k * hy , k = 0, 1, ..., n - 2, n - 1 *
+! * ar(j+1) contains real(g(yk)) and ai(j+1) contains aimag(g(yk)) *
+! * (output when msign > 0 , input when msign < 0) *
+! * remark : g(-yk) = conj(g(+yk)) *
+! * *
+! * n = 2**iabs(msign) (msign is an input) *
+! * *
+! * the step sizes satisfy *
+! * hy = (2 * pi) / (n * hx) or hx = (2 * pi) / (n * hy) *
+! * h is an input (h = hx if msign < 0 , h = hy if msign > 0) *
+! * h must be positive *
+! * *
+! * ar and ai are two real arrays with dimension n (input and *
+! * output) *
+! * *
+! *******************************************************************
+
+ implicit none
+
+ double precision, intent(in out) :: ar(*)
+ double precision, intent(in out) :: ai(*)
+ integer, intent(in) :: msign
+ double precision, intent(in) :: h
+
+ double precision :: a, as, c, s, t, ti, tr, ui, ur, wi, wr
+ integer :: i, ip, j, k, l, le, le1, m, n, nm1, nv2
+ logical :: debug
+
+ debug = .false.
+ as = 0.0d0
+ if (msign == 0) then
+ return
+ endif
+
+ if (h <= 0.0d0) then
+ if (debug) write(*,*) ' *** negative step size in <rcffi>, h = ', h, ' *** '
+ stop
+ endif
+
+! *** initialization
+
+ m = iabs(msign)
+ n = 2**m
+ if (msign > 0) then
+ ar(1) = 0.5d0 * ar(1)
+ else
+ as = ar(1) - ai(1)
+ ar(1) = 0.5d0 * (ar(1) + ai(1))
+ do i = 2, n
+ ar(i) = ar(i) + ai(n - i + 2)
+ enddo
+ do i = 1, n
+ ai(i) = 0.0d0
+ enddo
+ endif
+! *** discrete fast-fourier transform
+ nv2 = n / 2
+ nm1 = n - 1
+ j = 1
+ do i = 1, nm1
+ if (i < j) then
+ tr = ar(j)
+ ar(j) = ar(i)
+ ar(i) = tr
+ ti = ai(j)
+ ai(j) = ai(i)
+ ai(i) = ti
+ endif
+ k = nv2
+ do while (j > k)
+ j = j - k
+ k = k / 2
+ enddo
+ j = j + k
+ enddo
+ do i = 1, n, 2
+ tr = ar(i + 1)
+ ar(i + 1) = ar(i) - tr
+ ar(i) = ar(i) + tr
+ ti = ai(i + 1)
+ ai(i + 1) = ai(i) - ti
+ ai(i) = ai(i) + ti
+ enddo
+ if (m == 1) return
+ c = 0.0d0
+ s = dble(isign(1, msign))
+ le = 2
+ do l = 2, m
+ wr = c
+ ur = wr
+ wi = s
+ ui = wi
+ c = dsqrt(c * 0.5d0 + 0.5d0)
+ s = wi / (c + c)
+ le1 = le
+ le = le1 + le1
+ do i = 1, n, le
+ ip = i + le1
+ tr = ar(ip)
+ ar(ip) = ar(i) - tr
+ ar(i) = ar(i) + tr
+ ti = ai(ip)
+ ai(ip) = ai(i) - ti
+ ai(i) = ai(i) + ti
+ enddo
+ do j = 2, le1
+ do i = j, n, le
+ ip = i + le1
+ tr = ar(ip) * ur - ai(ip) * ui
+ ti = ar(ip) * ui + ai(ip) * ur
+ ar(ip) = ar(i) - tr
+ ar(i) = ar(i) + tr
+ ai(ip) = ai(i) - ti
+ ai(i) = ai(i) + ti
+ enddo
+ tr = ur
+ ur = tr * wr - ui * wi
+ ui = tr * wi + ui * wr
+ enddo
+ enddo
+
+! *** correction of the discrete fft, using a trapezoidal approximation
+! *** for the variations of the input function
+
+ c = h
+ if (msign >= 0) then
+ c = c / 3.141592653589793238d0
+ ai(1) = ar(1)
+ do i = 2, n
+ ai(i) = ar(n - i + 2)
+ enddo
+ endif
+ ar(1) = c * ar(1)
+ ai(1) = c * ai(1)
+ a = 3.141592653589793238d0 / n
+ wr = dcos(a)
+ wi = dsin(a)
+ t = dsqrt(c)
+ a = a / t
+ c = 0.0d0
+ ur = 1.0d0
+ ui = 0.0d0
+ do i = 2, n
+ c = c + a
+ tr = ur
+ ur = wr * tr - wi * ui
+ ui = wi * tr + wr * ui
+ ti = ui / c
+ tr = ti**2
+ ar(i) = ar(i) * tr
+ ai(i) = ai(i) * tr
+ if (msign <= 0) then
+ if (as /= 0.0d0) then
+ ai(i) = ai(i) - as * (t - ur * ti) / (2 * c)
+ endif
+ endif
+ enddo
+ return
+end subroutine rcffi
+end module rcffi_mod
+subroutine doboson(t, width, gauss, asym, emin, emax, wmin, wmax, np, p, xout, yout, nout)
+
+! *******************************************************************
+! * *
+! * perform the quantum-mechanical complement to the classical step *
+! * of the dielectric theory of eels in specular geometry using a *
+! * suitable thermodynamical average of the quantized surface *
+! * harmonic oscillators *
+! * *
+! * t: Target temperature *
+! * width: Width of instrumental response (cm**-1) *
+! * gauss: Fraction of gaussian for the instrumental response *
+! * asym: Asymmetry of the instrumental response *
+! * emin: Lower loss energy for this computation (cm**-1) *
+! * emax: Upper loss energy for this computation (cm**-1) *
+! * wmin: Lower loss energy of the eels computation (cm**-1) *
+! * wmax: Upper loss energy of the eels computation (cm**-1) *
+! * np: Number of points of the eels computation *
+! * p: Intensities of the eels computation *
+! * xout: Energies of this computation *
+! * yout: Intensities of this computation *
+! * nout: Number of points of this computation *
+! *******************************************************************
+
+ use rcffi_mod
+ use sicot_mod
+ use sintr_mod
+
+ implicit none
+
+ double precision, intent(in) :: t, width, gauss, asym, emin, emax, wmin
+ double precision, intent(in out) :: wmax
+ integer, intent(in) :: np
+ double precision, intent(in) :: p(np)
+ double precision, intent(in out) :: xout(nout), yout(nout)
+ integer, intent(in out) :: nout
+
+ integer, parameter :: mmax = 14, nmax = 2**mmax
+ double precision :: a, a1, a2, alfa, anorm, b, cp2, dwn, fac, fi
+ double precision :: fm, fm0, fm1, fp1, fmpic, fp, fp0, fppic, fr, g1, g2
+ double precision :: h, pi, sigma, sp2, test, u
+ double precision :: wmpic, wppic, wn, x, x1, x2, x3
+ double precision :: o1, o2, respon
+
+ external o1, o2
+
+ integer :: i, imax, imin, istep, j, jmin, jmax, m, n
+ logical :: picm, picp
+ double precision, allocatable :: p1(:), p2(:)
+ double precision :: r1(nmax), r2(nmax)
+
+ logical :: debug
+
+! remark : the two arrays r1 and r2 are used for fourier
+! transforming the user-supplied instrumental response of the
+! spectrometer that has to be coded in the external routine
+! respon called when the input parameter gauss is < 0 or > 1.
+! with 0 <= gauss <= 1, r1 and r2 are not used.
+
+! *** rational approximations for ei(u) * exp(-u) + e1(u) * exp(+u)
+! *** in the intervals (0, 1.3) and (1.3, infinity) <accuracy : 4.e-04>
+! *** used for fourier transforming half-lorentzian functions
+
+
+ debug = .false.
+ data fm1 / 0.0d0 /, fp1 / 0.0d0 /
+ pi = 4 * datan(1.0d0)
+
+ dwn = (wmax - wmin) / (np - 1)
+
+! *** redefine the frequency interval (0, wmax) to be used for the
+! *** fourier transforms
+
+ if (debug) write(*,*) 'wmin: ', wmin, 'wmax: ', wmax, 'dwn: ', dwn
+ jmin = int(0.5d0 + wmin / dwn)
+ if ((jmin - 0.5d0) * dwn < wmin) then
+ jmin = jmin + 1
+ endif
+ fac = ((jmin - 0.5d0) * dwn - wmin) / dwn
+ jmax = int(0.5d0 + wmax / dwn)
+ test = dmax1(1.5d0 * dabs(emin), 1.5d0 * dabs(emax), 6 * wmax)
+ n = 2
+ do m = 2, mmax
+ n = 2 * n
+ wmax = n * dwn
+ if (wmax >= test) exit
+ enddo
+ if (wmax < test) then
+ m = mmax
+ n = nmax
+ wmax = n * dwn
+ if (debug) write(*,*) ' +++ n has been fixed at', nmax, ' = 2**', mmax, ' +++'
+ endif
+ if (debug) then
+ write(*,*) ' classical spectrum redefined from 0.0 to', wmax
+ write(*,*) ' step size =', dwn, ', ', n, ' (= 2**', m, ') points'
+ endif
+
+ allocate (p1(n))
+ allocate (p2(n))
+
+ p1 = 0
+
+! *** interpolate pcl on a suitable mesh in (0, wmax)
+ i = 1
+ do j = jmin, min(jmax, n)
+ p1(j) = p(i) + fac * (p(i + 1) - p(i))
+ i = i + 1
+ enddo
+
+ p2 = p1
+
+! *** characteristic function f(tau)
+
+ call sicot(p1, m, dwn, 1.39d0 * t)
+ call sintr(p2, m, dwn)
+ h = (pi + pi) / wmax
+ if (gauss < 0.0d0 .or. gauss > 1.0d0) then
+
+! *** broaden the spectrum by convoluting the characteristic function
+! *** with a user-supplied response function (arbitrary normalization)
+
+ if (debug) write(*,*) '==> switch to a user-supplied instrumental response'
+ alfa = dmax1(4 * dwn, width)
+ if (alfa > width) then
+ if (debug) write(*,*) ' +++ width has been enlarged to', alfa, ' +++'
+ endif
+ if (alfa < 10 * dwn) then
+ if (debug) then
+ write(*,*) ' ... poor representation of the response function ...'
+ write(*,*) 'the step size (', dwn, ') should be reduced'
+ endif
+ endif
+! make a table of the response function
+ r1(1) = respon(0.0d0, alfa)
+ r2(1) = r1(1)
+ do i = 2, n
+ x = (i - 1) * dwn
+ r1(i) = respon( x, alfa)
+ r2(i) = respon(-x, alfa)
+ enddo
+! fourier transform it
+ call rcffi(r1, r2, -m, dwn)
+! normalization of the response function, and convolution
+ anorm = r1(1)
+ do i = 1, n
+ fac = dexp(-p1(i)) / anorm
+ cp2 = fac * dcos(p2(i))
+ sp2 = fac * dsin(p2(i))
+ p1(i) = r1(i) * cp2 + r2(i) * sp2
+ p2(i) = r2(i) * cp2 - r1(i) * sp2
+ enddo
+ alfa = alfa / 2
+
+ else
+
+! *** broaden the spectrum by convoluting the characteristic function by
+! *** a weighted sum of a lorentzian and a gaussian response functions
+
+ alfa = dmax1(1.5d0 * dwn, width)
+ if (alfa > width) then
+ if (debug) write(*,*) ' +++ width has been enlarged to', alfa, ' +++'
+ endif
+ if (alfa > 0.5d0 * wmax / pi) then
+ stop '*** width is too large, nothing done ***'
+ endif
+ alfa = 0.5d0 * alfa
+ sigma = alfa / 1.66511d0
+ a1 = (1.0d0 - asym) / 2 * (1.0d0 - gauss)
+ a2 = (1.0d0 + asym) / 2 * (1.0d0 - gauss)
+ if (a1 < 0.0d0 .or. a2 < 0.0d0) then
+ stop '*** invalid input : asym should be in (-1, +1) ***'
+ endif
+ g1 = (1.0d0 - asym) * alfa
+ g2 = (1.0d0 + asym) * alfa
+ p1(1) = 1.0d0
+ p2(1) = 0.0d0
+ do i = 2, n
+ x = (i - 1) * h
+ fr = 0.0d0
+ fi = 0.0d0
+ if (a1 /= 0.0d0) then
+ x1 = g1 * x
+ if (x1 <= 100.0d0) then
+ fr = a1 * dexp(-x1)
+ endif
+ if (a1 /= a2) then
+ if (x1 <= 1.3d0) then
+ fi = a1 * o1(x1)
+ else
+ fi = a1 * o2(x1)
+ endif
+ endif
+ endif
+ if (a2 /= 0.0d0) then
+ x2 = g2 * x
+ if (x2 <= 100.0d0) then
+ fr = fr + a2 * dexp(-x2)
+ endif
+ if (a2 /= a1) then
+ if (x2 <= 1.3d0) then
+ fi = fi - a2 * o1(x2)
+ else
+ fi = fi - a2 * o2(x2)
+ endif
+ endif
+ endif
+ if (gauss /= 0.0d0) then
+ x3 = sigma * x
+ if (x3 <= 10.0d0) then
+ fr = fr + gauss * dexp(-x3**2)
+ endif
+ endif
+ fi = fi / pi
+ fac = dexp(-p1(i))
+ cp2 = fac * dcos(p2(i))
+ sp2 = fac * dsin(p2(i))
+ p1(i) = fr * cp2 + fi * sp2
+ p2(i) = fi * cp2 - fr * sp2
+ enddo
+ if (dabs(fi) > 1.0d-03) then
+ if (debug) then
+ write(*,*) ' ... poor representation of the response function ...'
+ write(*,*) 'the step size (', dwn, ') should be reduced'
+ endif
+ endif
+ endif
+
+! *** full eels spectrum
+
+ call rcffi(p1, p2, m, h)
+
+! *** output
+
+ istep = max(int(alfa / dwn / 10), 1)
+ nout = 0
+ if (emin <= 0.0d0) then
+ imin = n - int(dabs(emin) / dwn)
+ if ((imin - n) * dwn < emin) then
+ imin = imin + 1
+ endif
+ do i = imin, n
+ j = n - i
+ if (mod(j, istep) > 0) cycle
+ x = -j * dwn
+ if (x > emax) exit
+ nout = nout + 1
+ xout(nout)= x
+ yout(nout)= p2(j + 1)
+ enddo
+ endif
+ if (x <= emax) then
+ if (emax >= dwn) then
+ imax = int(emax / dwn) + 1
+ if ((imax - 1) * dwn > emax) then
+ imax = imax - 1
+ endif
+ if (imax >= 2) then
+ do i = 2, imax
+ if (mod(i - 1, istep) > 0) cycle
+ x = (i - 1) * dwn
+ if (x < emin) cycle
+ nout = nout + 1
+ xout(nout) = x
+ yout(nout) = p1(i)
+ enddo
+ endif
+ endif
+ endif
+ if (debug) write(*,*) nout, ' values, step size =', istep * dwn
+
+! *** analyze the spectrum
+
+ if (debug) write(*,*) ' peak location amplitude'
+ wn = 0.0d0
+ fm = p1(1)
+ fp = p2(1)
+ if (p2(2) < fp .and. p1(2) < fp) then
+ if (debug) write(*, '(f13.2, e13.4)') wn, fp
+ endif
+ fac = 5.0d-06 * fp * dwn
+ imax = 2 + int(dmax1(dabs(emin), dabs(emax)) / dwn)
+ do i = 2, imax
+ fm0 = fm1
+ fp0 = fp1
+ fm1 = fm
+ fp1 = fp
+ fm = p2(i)
+ fp = p1(i)
+ if (i == 2) cycle
+ picm = .false.
+ picp = .false.
+ wn = (i - 1) * dwn
+ if ((fm1 >= fm0) .and. (fm1 >= fm)) then
+ a = (fm1 - fm0) + (fm1 - fm)
+ if (a >= fac) then
+ b = 0.5d0 * ((fm1 - fm0) + 3 * (fm1 - fm))
+ u = b / a
+ wmpic = -wn + u * dwn
+ fmpic = fm + 0.5d0 * b * u
+ picm = .true.
+ endif
+ endif
+ if ((fp1 >= fp0) .and. (fp1 >= fp)) then
+ a = (fp1 - fp0) + (fp1 - fp)
+ if (a >= fac) then
+ b = 0.5d0 * ((fp1 - fp0) + 3 * (fp1 - fp))
+ u = b / a
+ wppic = wn - u * dwn
+ fppic = fp + 0.5d0 * b * u
+ picp = .true.
+ if (picp) then
+ if (picm) then
+ if (debug) write(*, '(2(f13.2, e13.4, 5x))') wppic, fppic, wmpic, fmpic
+ else
+ if (debug) write(*, '(f13.2, e13.4)') wppic, fppic
+ endif
+ endif
+ endif
+ endif
+ if (picm .and. (.not. picp)) then
+ if (debug) write(*, '(33x, f13.2, e13.4)') wmpic, fmpic
+ endif
+ enddo
+ deallocate (p1)
+ deallocate (p2)
+ return
+end subroutine doboson
+double precision function o1(u)
+
+ implicit none
+
+ double precision, intent(in) :: u
+ double precision :: u2
+
+ u2 = u**2
+ o1 = -dsinh(u) * dlog(u2) + u * ((0.03114d0 * u2 + 0.41666d0) * u2 + 0.84557d0)
+
+ return
+end function o1
+double precision function o2(u)
+
+ implicit none
+
+ double precision, intent(in) :: u
+ double precision :: u2
+
+ u2 = 1 / u**2
+ o2 = (((202.91d0 * u2 + 932.21d0) * u2 + 41.740d0) * u2 + 2.0d0) / &
+ (((540.88d0 * u2 + 345.67d0) * u2 + 18.961d0) * u2 + 1.0d0) / u
+
+ return
+end function o2
diff --git a/source/f90/fcat-analysis/bosonf90_fcat_output b/source/f90/fcat-analysis/bosonf90_fcat_output
new file mode 100644
index 0000000..ba191d0
--- /dev/null
+++ b/source/f90/fcat-analysis/bosonf90_fcat_output
@@ -0,0 +1,1104 @@
+FCAT_boson_all_ 1
+FCAT_boson_all_ 45
+FCAT_boson_all_ 55
+FCAT_boson_all_ 2
+FCAT_boson_all_ 3
+FCAT_boson_all_ 4
+FCAT_boson_all_ 5
+FCAT_boson_all_ 6
+FCAT_boson_all_ 7
+FCAT_boson_all_ 8
+FCAT_boson_all_ 9
+FCAT_boson_all_ 10
+ program boson (September 2020)
+FCAT_boson_all_ 11
+ t = 300.0 K, width = 25.00 cm**-1
+FCAT_boson_all_ 12
+ gauss = 0.50, asym = 0.30
+FCAT_boson_all_ 13
+ energy losses from -500.0 to 1200. cm**-1
+FCAT_boson_all_ 14
+FCAT_boson_all_ 15
+FCAT_boson_all_ 16
+FCAT_boson_all_ 17
+FCAT_boson_all_ 18
+FCAT_boson_all_ 19
+FCAT_boson_all_ 20
+FCAT_boson_all_ 21
+FCAT_boson_all_ 22
+FCAT_boson_all_ 23
+FCAT_boson_all_ 24
+FCAT_boson_all_ 25
+FCAT_boson_all_ 27
+FCAT_boson_all_ 28
+FCAT_boson_all_ 29
+ WFW: MnO layer on metal
+FCAT_boson_all_ 30
+ read 326 values of pcl from 50.00000 to 700.0000
+FCAT_boson_all_ 31
+FCAT_boson_all_ 32
+FCAT_boson_all_ 33
+FCAT_boson_all_ 34
+FCAT_boson_all_ 368
+FCAT_boson_all_ 369
+FCAT_boson_all_ 370
+FCAT_boson_all_ 371
+FCAT_boson_all_ 372
+FCAT_boson_all_ 373
+FCAT_boson_all_ 374
+FCAT_boson_all_ 375
+FCAT_boson_all_ 376
+FCAT_boson_all_ 377
+FCAT_boson_all_ 378
+FCAT_boson_all_ 379
+FCAT_boson_all_ 380
+FCAT_boson_all_ 381
+FCAT_boson_all_ 382
+FCAT_boson_all_ 383
+FCAT_boson_all_ 384
+FCAT_boson_all_ 385
+FCAT_boson_all_ 386
+FCAT_boson_all_ 392
+FCAT_boson_all_ 396
+FCAT_boson_all_ 397
+FCAT_boson_all_ 398
+FCAT_boson_all_ 399
+FCAT_boson_all_ 400
+FCAT_boson_all_ 401
+FCAT_boson_all_ 402
+FCAT_boson_all_ 403
+FCAT_boson_all_ 404
+FCAT_boson_all_ 405
+FCAT_boson_all_ 67
+FCAT_boson_all_ 68
+FCAT_boson_all_ 72
+FCAT_boson_all_ 76
+FCAT_boson_all_ 80
+FCAT_boson_all_ 81
+FCAT_boson_all_ 82
+FCAT_boson_all_ 83
+FCAT_boson_all_ 84
+FCAT_boson_all_ 85
+FCAT_boson_all_ 86
+FCAT_boson_all_ 87
+FCAT_boson_all_ 88
+FCAT_boson_all_ 89
+FCAT_boson_all_ 90
+FCAT_boson_all_ 91
+FCAT_boson_all_ 92
+FCAT_boson_all_ 93
+FCAT_boson_all_ 94
+FCAT_boson_all_ 95
+FCAT_boson_all_ 96
+FCAT_boson_all_ 97
+FCAT_boson_all_ 98
+FCAT_boson_all_ 99
+FCAT_boson_all_ 100
+FCAT_boson_all_ 101
+FCAT_boson_all_ 102
+FCAT_boson_all_ 103
+FCAT_boson_all_ 104
+FCAT_boson_all_ 105
+FCAT_boson_all_ 106
+FCAT_boson_all_ 107
+FCAT_boson_all_ 108
+FCAT_boson_all_ 110
+FCAT_boson_all_ 111
+FCAT_boson_all_ 115
+FCAT_boson_all_ 119
+FCAT_boson_all_ 120
+FCAT_boson_all_ 121
+FCAT_boson_all_ 122
+FCAT_boson_all_ 123
+FCAT_boson_all_ 124
+FCAT_boson_all_ 125
+FCAT_boson_all_ 126
+FCAT_boson_all_ 138
+FCAT_boson_all_ 139
+FCAT_boson_all_ 143
+FCAT_boson_all_ 144
+FCAT_boson_all_ 127
+FCAT_boson_all_ 128
+FCAT_boson_all_ 129
+FCAT_boson_all_ 130
+FCAT_boson_all_ 131
+FCAT_boson_all_ 132
+FCAT_boson_all_ 133
+FCAT_boson_all_ 134
+FCAT_boson_all_ 135
+FCAT_boson_all_ 136
+FCAT_boson_all_ 137
+FCAT_boson_all_ 140
+FCAT_boson_all_ 141
+FCAT_boson_all_ 142
+FCAT_boson_all_ 145
+FCAT_boson_all_ 146
+FCAT_boson_all_ 147
+FCAT_boson_all_ 148
+FCAT_boson_all_ 149
+FCAT_boson_all_ 150
+FCAT_boson_all_ 151
+FCAT_boson_all_ 152
+FCAT_boson_all_ 153
+FCAT_boson_all_ 154
+FCAT_boson_all_ 155
+FCAT_boson_all_ 156
+FCAT_boson_all_ 157
+FCAT_boson_all_ 158
+FCAT_boson_all_ 159
+FCAT_boson_all_ 160
+FCAT_boson_all_ 161
+FCAT_boson_all_ 162
+FCAT_boson_all_ 163
+FCAT_boson_all_ 164
+FCAT_boson_all_ 165
+FCAT_boson_all_ 166
+FCAT_boson_all_ 167
+FCAT_boson_all_ 168
+FCAT_boson_all_ 169
+FCAT_boson_all_ 170
+FCAT_boson_all_ 171
+FCAT_boson_all_ 172
+FCAT_boson_all_ 173
+FCAT_boson_all_ 174
+FCAT_boson_all_ 175
+FCAT_boson_all_ 176
+FCAT_boson_all_ 177
+FCAT_boson_all_ 178
+FCAT_boson_all_ 179
+FCAT_boson_all_ 180
+FCAT_boson_all_ 181
+FCAT_boson_all_ 182
+FCAT_boson_all_ 183
+FCAT_boson_all_ 184
+FCAT_boson_all_ 185
+FCAT_boson_all_ 186
+FCAT_boson_all_ 187
+FCAT_boson_all_ 188
+FCAT_boson_all_ 189
+FCAT_boson_all_ 190
+FCAT_boson_all_ 191
+FCAT_boson_all_ 192
+FCAT_boson_all_ 193
+FCAT_boson_all_ 194
+FCAT_boson_all_ 195
+FCAT_boson_all_ 196
+FCAT_boson_all_ 197
+FCAT_boson_all_ 198
+FCAT_boson_all_ 199
+FCAT_boson_all_ 200
+FCAT_boson_all_ 201
+FCAT_boson_all_ 202
+FCAT_boson_all_ 203
+FCAT_boson_all_ 204
+FCAT_boson_all_ 205
+FCAT_boson_all_ 206
+FCAT_boson_all_ 207
+FCAT_boson_all_ 208
+FCAT_boson_all_ 209
+FCAT_boson_all_ 210
+FCAT_boson_all_ 211
+FCAT_boson_all_ 212
+FCAT_boson_all_ 213
+FCAT_boson_all_ 214
+FCAT_boson_all_ 215
+FCAT_boson_all_ 216
+FCAT_boson_all_ 217
+FCAT_boson_all_ 218
+FCAT_boson_all_ 219
+FCAT_boson_all_ 220
+FCAT_boson_all_ 221
+FCAT_boson_all_ 222
+FCAT_boson_all_ 223
+FCAT_boson_all_ 224
+FCAT_boson_all_ 225
+FCAT_boson_all_ 226
+FCAT_boson_all_ 227
+FCAT_boson_all_ 228
+FCAT_boson_all_ 229
+FCAT_boson_all_ 230
+FCAT_boson_all_ 231
+FCAT_boson_all_ 232
+FCAT_boson_all_ 233
+FCAT_boson_all_ 234
+FCAT_boson_all_ 235
+FCAT_boson_all_ 236
+FCAT_boson_all_ 237
+FCAT_boson_all_ 245
+FCAT_boson_all_ 246
+FCAT_boson_all_ 109
+FCAT_boson_all_ 406
+FCAT_boson_all_ 238
+FCAT_boson_all_ 239
+FCAT_boson_all_ 240
+FCAT_boson_all_ 241
+FCAT_boson_all_ 242
+FCAT_boson_all_ 243
+FCAT_boson_all_ 244
+FCAT_boson_all_ 407
+FCAT_boson_all_ 408
+FCAT_boson_all_ 437
+FCAT_boson_all_ 438
+FCAT_boson_all_ 439
+FCAT_boson_all_ 442
+FCAT_boson_all_ 445
+FCAT_boson_all_ 446
+FCAT_boson_all_ 447
+FCAT_boson_all_ 448
+FCAT_boson_all_ 449
+FCAT_boson_all_ 452
+FCAT_boson_all_ 453
+FCAT_boson_all_ 454
+FCAT_boson_all_ 455
+FCAT_boson_all_ 456
+FCAT_boson_all_ 457
+FCAT_boson_all_ 458
+FCAT_boson_all_ 459
+FCAT_boson_all_ 460
+FCAT_boson_all_ 461
+FCAT_boson_all_ 462
+FCAT_boson_all_ 463
+FCAT_boson_all_ 464
+FCAT_boson_all_ 465
+FCAT_boson_all_ 466
+FCAT_boson_all_ 467
+FCAT_boson_all_ 597
+FCAT_boson_all_ 598
+FCAT_boson_all_ 599
+FCAT_boson_all_ 471
+FCAT_boson_all_ 472
+FCAT_boson_all_ 473
+FCAT_boson_all_ 474
+FCAT_boson_all_ 475
+FCAT_boson_all_ 476
+FCAT_boson_all_ 477
+FCAT_boson_all_ 478
+FCAT_boson_all_ 479
+FCAT_boson_all_ 480
+FCAT_boson_all_ 484
+FCAT_boson_all_ 485
+FCAT_boson_all_ 486
+FCAT_boson_all_ 487
+FCAT_boson_all_ 488
+FCAT_boson_all_ 489
+FCAT_boson_all_ 490
+FCAT_boson_all_ 491
+FCAT_boson_all_ 492
+FCAT_boson_all_ 493
+FCAT_boson_all_ 494
+FCAT_boson_all_ 495
+FCAT_boson_all_ 496
+FCAT_boson_all_ 497
+FCAT_boson_all_ 498
+FCAT_boson_all_ 481
+FCAT_boson_all_ 482
+FCAT_boson_all_ 600
+FCAT_boson_all_ 601
+FCAT_boson_all_ 602
+FCAT_boson_all_ 483
+FCAT_boson_all_ 468
+FCAT_boson_all_ 469
+FCAT_boson_all_ 470
+FCAT_boson_all_ 499
+FCAT_boson_all_ 505
+FCAT_boson_all_ 506
+FCAT_boson_all_ 247
+FCAT_boson_all_ 248
+FCAT_boson_all_ 249
+FCAT_boson_all_ 252
+FCAT_boson_all_ 256
+FCAT_boson_all_ 257
+FCAT_boson_all_ 258
+FCAT_boson_all_ 259
+FCAT_boson_all_ 270
+FCAT_boson_all_ 271
+FCAT_boson_all_ 272
+FCAT_boson_all_ 273
+FCAT_boson_all_ 274
+FCAT_boson_all_ 282
+FCAT_boson_all_ 283
+FCAT_boson_all_ 287
+FCAT_boson_all_ 288
+FCAT_boson_all_ 275
+FCAT_boson_all_ 276
+FCAT_boson_all_ 277
+FCAT_boson_all_ 278
+FCAT_boson_all_ 279
+FCAT_boson_all_ 280
+FCAT_boson_all_ 281
+FCAT_boson_all_ 284
+FCAT_boson_all_ 285
+FCAT_boson_all_ 286
+FCAT_boson_all_ 289
+FCAT_boson_all_ 290
+FCAT_boson_all_ 291
+FCAT_boson_all_ 292
+FCAT_boson_all_ 293
+FCAT_boson_all_ 294
+FCAT_boson_all_ 295
+FCAT_boson_all_ 296
+FCAT_boson_all_ 297
+FCAT_boson_all_ 298
+FCAT_boson_all_ 299
+FCAT_boson_all_ 300
+FCAT_boson_all_ 301
+FCAT_boson_all_ 302
+FCAT_boson_all_ 303
+FCAT_boson_all_ 304
+FCAT_boson_all_ 305
+FCAT_boson_all_ 306
+FCAT_boson_all_ 307
+FCAT_boson_all_ 308
+FCAT_boson_all_ 309
+FCAT_boson_all_ 310
+FCAT_boson_all_ 311
+FCAT_boson_all_ 312
+FCAT_boson_all_ 313
+FCAT_boson_all_ 314
+FCAT_boson_all_ 315
+FCAT_boson_all_ 316
+FCAT_boson_all_ 317
+FCAT_boson_all_ 318
+FCAT_boson_all_ 319
+FCAT_boson_all_ 320
+FCAT_boson_all_ 321
+FCAT_boson_all_ 322
+FCAT_boson_all_ 323
+FCAT_boson_all_ 324
+FCAT_boson_all_ 325
+FCAT_boson_all_ 326
+FCAT_boson_all_ 327
+FCAT_boson_all_ 328
+FCAT_boson_all_ 329
+FCAT_boson_all_ 330
+FCAT_boson_all_ 331
+FCAT_boson_all_ 332
+FCAT_boson_all_ 333
+FCAT_boson_all_ 334
+FCAT_boson_all_ 335
+FCAT_boson_all_ 336
+FCAT_boson_all_ 337
+FCAT_boson_all_ 338
+FCAT_boson_all_ 339
+FCAT_boson_all_ 340
+FCAT_boson_all_ 341
+FCAT_boson_all_ 342
+FCAT_boson_all_ 343
+FCAT_boson_all_ 344
+FCAT_boson_all_ 345
+FCAT_boson_all_ 346
+FCAT_boson_all_ 347
+FCAT_boson_all_ 348
+FCAT_boson_all_ 349
+FCAT_boson_all_ 350
+FCAT_boson_all_ 351
+FCAT_boson_all_ 352
+FCAT_boson_all_ 353
+FCAT_boson_all_ 354
+FCAT_boson_all_ 355
+FCAT_boson_all_ 356
+FCAT_boson_all_ 357
+FCAT_boson_all_ 358
+FCAT_boson_all_ 359
+FCAT_boson_all_ 360
+FCAT_boson_all_ 361
+FCAT_boson_all_ 366
+FCAT_boson_all_ 367
+FCAT_boson_all_ 507
+FCAT_boson_all_ 508
+FCAT_boson_all_ 509
+FCAT_boson_all_ 510
+FCAT_boson_all_ 511
+FCAT_boson_all_ 514
+FCAT_boson_all_ 515
+FCAT_boson_all_ 516
+FCAT_boson_all_ 517
+FCAT_boson_all_ 518
+FCAT_boson_all_ 519
+FCAT_boson_all_ 520
+FCAT_boson_all_ 521
+FCAT_boson_all_ 522
+FCAT_boson_all_ 523
+FCAT_boson_all_ 524
+FCAT_boson_all_ 525
+FCAT_boson_all_ 526
+FCAT_boson_all_ 527
+FCAT_boson_all_ 530
+FCAT_boson_all_ 531
+FCAT_boson_all_ 532
+FCAT_boson_all_ 533
+FCAT_boson_all_ 534
+FCAT_boson_all_ 535
+FCAT_boson_all_ 536
+FCAT_boson_all_ 537
+FCAT_boson_all_ 538
+FCAT_boson_all_ 539
+FCAT_boson_all_ 540
+FCAT_boson_all_ 541
+FCAT_boson_all_ 542
+FCAT_boson_all_ 543
+FCAT_boson_all_ 544
+FCAT_boson_all_ 545
+FCAT_boson_all_ 546
+FCAT_boson_all_ 547
+FCAT_boson_all_ 548
+FCAT_boson_all_ 549
+FCAT_boson_all_ 550
+FCAT_boson_all_ 551
+FCAT_boson_all_ 552
+FCAT_boson_all_ 553
+FCAT_boson_all_ 554
+FCAT_boson_all_ 555
+FCAT_boson_all_ 556
+FCAT_boson_all_ 557
+FCAT_boson_all_ 558
+FCAT_boson_all_ 559
+FCAT_boson_all_ 560
+FCAT_boson_all_ 561
+FCAT_boson_all_ 562
+FCAT_boson_all_ 563
+FCAT_boson_all_ 573
+FCAT_boson_all_ 590
+FCAT_boson_all_ 593
+FCAT_boson_all_ 564
+FCAT_boson_all_ 565
+FCAT_boson_all_ 566
+FCAT_boson_all_ 567
+FCAT_boson_all_ 568
+FCAT_boson_all_ 569
+FCAT_boson_all_ 570
+FCAT_boson_all_ 571
+FCAT_boson_all_ 572
+FCAT_boson_all_ 591
+FCAT_boson_all_ 592
+FCAT_boson_all_ 574
+FCAT_boson_all_ 575
+FCAT_boson_all_ 576
+FCAT_boson_all_ 577
+FCAT_boson_all_ 578
+FCAT_boson_all_ 579
+FCAT_boson_all_ 580
+FCAT_boson_all_ 581
+FCAT_boson_all_ 582
+FCAT_boson_all_ 584
+FCAT_boson_all_ 585
+FCAT_boson_all_ 586
+FCAT_boson_all_ 587
+FCAT_boson_all_ 588
+FCAT_boson_all_ 589
+FCAT_boson_all_ 594
+FCAT_boson_all_ 595
+FCAT_boson_all_ 596
+FCAT_boson_all_ 35
+FCAT_boson_all_ 36
+FCAT_boson_all_ 37
+FCAT_boson_all_ 38
+FCAT_boson_all_ 39
+FCAT_boson_all_ 40
+FCAT_boson_all_ 41
+FCAT_boson_all_ 42
+ 851 values written on disk
+FCAT_boson_all_ 43
+FCAT_boson_all_ 44
+FCAT_boson_all_count 1 1
+FCAT_boson_all_count 2 1
+FCAT_boson_all_count 3 1
+FCAT_boson_all_count 4 1
+FCAT_boson_all_count 5 1
+FCAT_boson_all_count 6 1
+FCAT_boson_all_count 7 1
+FCAT_boson_all_count 8 1
+FCAT_boson_all_count 9 1
+FCAT_boson_all_count 10 1
+FCAT_boson_all_count 11 1
+FCAT_boson_all_count 12 1
+FCAT_boson_all_count 13 1
+FCAT_boson_all_count 14 1
+FCAT_boson_all_count 15 1
+FCAT_boson_all_count 16 1
+FCAT_boson_all_count 17 1
+FCAT_boson_all_count 18 1
+FCAT_boson_all_count 19 327
+FCAT_boson_all_count 20 327
+FCAT_boson_all_count 21 326
+FCAT_boson_all_count 22 326
+FCAT_boson_all_count 23 326
+FCAT_boson_all_count 24 326
+FCAT_boson_all_count 25 326
+FCAT_boson_all_count 26 0
+FCAT_boson_all_count 27 1
+FCAT_boson_all_count 28 1
+FCAT_boson_all_count 29 1
+FCAT_boson_all_count 30 1
+FCAT_boson_all_count 31 1
+FCAT_boson_all_count 32 1
+FCAT_boson_all_count 33 1
+FCAT_boson_all_count 34 1
+FCAT_boson_all_count 35 1
+FCAT_boson_all_count 36 1
+FCAT_boson_all_count 37 1
+FCAT_boson_all_count 38 1
+FCAT_boson_all_count 39 851
+FCAT_boson_all_count 40 851
+FCAT_boson_all_count 41 1
+FCAT_boson_all_count 42 1
+FCAT_boson_all_count 43 1
+FCAT_boson_all_count 44 1
+FCAT_boson_all_count 45 1
+FCAT_boson_all_count 46 0
+FCAT_boson_all_count 47 0
+FCAT_boson_all_count 48 0
+FCAT_boson_all_count 49 0
+FCAT_boson_all_count 50 0
+FCAT_boson_all_count 51 0
+FCAT_boson_all_count 52 0
+FCAT_boson_all_count 53 0
+FCAT_boson_all_count 54 0
+FCAT_boson_all_count 55 1
+FCAT_boson_all_count 56 0
+FCAT_boson_all_count 57 0
+FCAT_boson_all_count 58 0
+FCAT_boson_all_count 59 0
+FCAT_boson_all_count 60 0
+FCAT_boson_all_count 61 0
+FCAT_boson_all_count 62 0
+FCAT_boson_all_count 63 0
+FCAT_boson_all_count 64 0
+FCAT_boson_all_count 65 0
+FCAT_boson_all_count 66 0
+FCAT_boson_all_count 67 1
+FCAT_boson_all_count 68 1
+FCAT_boson_all_count 69 0
+FCAT_boson_all_count 70 0
+FCAT_boson_all_count 71 0
+FCAT_boson_all_count 72 1
+FCAT_boson_all_count 73 0
+FCAT_boson_all_count 74 0
+FCAT_boson_all_count 75 0
+FCAT_boson_all_count 76 1
+FCAT_boson_all_count 77 0
+FCAT_boson_all_count 78 0
+FCAT_boson_all_count 79 0
+FCAT_boson_all_count 80 1
+FCAT_boson_all_count 81 1
+FCAT_boson_all_count 82 1
+FCAT_boson_all_count 83 1
+FCAT_boson_all_count 84 1
+FCAT_boson_all_count 85 1
+FCAT_boson_all_count 86 1
+FCAT_boson_all_count 87 1
+FCAT_boson_all_count 88 1
+FCAT_boson_all_count 89 1
+FCAT_boson_all_count 90 4096
+FCAT_boson_all_count 91 4095
+FCAT_boson_all_count 92 4095
+FCAT_boson_all_count 93 4096
+FCAT_boson_all_count 94 4096
+FCAT_boson_all_count 95 3902
+FCAT_boson_all_count 96 3902
+FCAT_boson_all_count 97 3902
+FCAT_boson_all_count 98 3902
+FCAT_boson_all_count 99 3902
+FCAT_boson_all_count 100 4096
+FCAT_boson_all_count 101 4096
+FCAT_boson_all_count 102 1
+FCAT_boson_all_count 103 1
+FCAT_boson_all_count 104 4095
+FCAT_boson_all_count 105 4095
+FCAT_boson_all_count 106 4095
+FCAT_boson_all_count 107 1
+FCAT_boson_all_count 108 1
+FCAT_boson_all_count 109 1
+FCAT_boson_all_count 110 2
+FCAT_boson_all_count 111 2
+FCAT_boson_all_count 112 0
+FCAT_boson_all_count 113 0
+FCAT_boson_all_count 114 0
+FCAT_boson_all_count 115 2
+FCAT_boson_all_count 116 0
+FCAT_boson_all_count 117 0
+FCAT_boson_all_count 118 0
+FCAT_boson_all_count 119 2
+FCAT_boson_all_count 120 2
+FCAT_boson_all_count 121 2
+FCAT_boson_all_count 122 2
+FCAT_boson_all_count 123 2
+FCAT_boson_all_count 124 2
+FCAT_boson_all_count 125 2
+FCAT_boson_all_count 126 4094
+FCAT_boson_all_count 127 1984
+FCAT_boson_all_count 128 1984
+FCAT_boson_all_count 129 1984
+FCAT_boson_all_count 130 1984
+FCAT_boson_all_count 131 1984
+FCAT_boson_all_count 132 1984
+FCAT_boson_all_count 133 1984
+FCAT_boson_all_count 134 1984
+FCAT_boson_all_count 135 1984
+FCAT_boson_all_count 136 1984
+FCAT_boson_all_count 137 1984
+FCAT_boson_all_count 138 4094
+FCAT_boson_all_count 139 4094
+FCAT_boson_all_count 140 4072
+FCAT_boson_all_count 141 4072
+FCAT_boson_all_count 142 4072
+FCAT_boson_all_count 143 4094
+FCAT_boson_all_count 144 4094
+FCAT_boson_all_count 145 2
+FCAT_boson_all_count 146 2048
+FCAT_boson_all_count 147 2048
+FCAT_boson_all_count 148 2048
+FCAT_boson_all_count 149 2048
+FCAT_boson_all_count 150 2048
+FCAT_boson_all_count 151 2048
+FCAT_boson_all_count 152 2048
+FCAT_boson_all_count 153 2048
+FCAT_boson_all_count 154 2048
+FCAT_boson_all_count 155 2
+FCAT_boson_all_count 156 2
+FCAT_boson_all_count 157 2
+FCAT_boson_all_count 158 2
+FCAT_boson_all_count 159 2
+FCAT_boson_all_count 160 20
+FCAT_boson_all_count 161 20
+FCAT_boson_all_count 162 20
+FCAT_boson_all_count 163 20
+FCAT_boson_all_count 164 20
+FCAT_boson_all_count 165 20
+FCAT_boson_all_count 166 20
+FCAT_boson_all_count 167 20
+FCAT_boson_all_count 168 20
+FCAT_boson_all_count 169 2046
+FCAT_boson_all_count 170 2046
+FCAT_boson_all_count 171 2046
+FCAT_boson_all_count 172 2046
+FCAT_boson_all_count 173 2046
+FCAT_boson_all_count 174 2046
+FCAT_boson_all_count 175 2046
+FCAT_boson_all_count 176 2046
+FCAT_boson_all_count 177 2046
+FCAT_boson_all_count 178 2046
+FCAT_boson_all_count 179 2046
+FCAT_boson_all_count 180 20
+FCAT_boson_all_count 181 4072
+FCAT_boson_all_count 182 18434
+FCAT_boson_all_count 183 18434
+FCAT_boson_all_count 184 18434
+FCAT_boson_all_count 185 18434
+FCAT_boson_all_count 186 18434
+FCAT_boson_all_count 187 18434
+FCAT_boson_all_count 188 18434
+FCAT_boson_all_count 189 18434
+FCAT_boson_all_count 190 18434
+FCAT_boson_all_count 191 18434
+FCAT_boson_all_count 192 18434
+FCAT_boson_all_count 193 4072
+FCAT_boson_all_count 194 4072
+FCAT_boson_all_count 195 4072
+FCAT_boson_all_count 196 4072
+FCAT_boson_all_count 197 20
+FCAT_boson_all_count 198 2
+FCAT_boson_all_count 199 2
+FCAT_boson_all_count 200 2
+FCAT_boson_all_count 201 2
+FCAT_boson_all_count 202 2
+FCAT_boson_all_count 203 2
+FCAT_boson_all_count 204 2
+FCAT_boson_all_count 205 2
+FCAT_boson_all_count 206 2
+FCAT_boson_all_count 207 2
+FCAT_boson_all_count 208 2
+FCAT_boson_all_count 209 2
+FCAT_boson_all_count 210 2
+FCAT_boson_all_count 211 2048
+FCAT_boson_all_count 212 2048
+FCAT_boson_all_count 213 2048
+FCAT_boson_all_count 214 2048
+FCAT_boson_all_count 215 2048
+FCAT_boson_all_count 216 2048
+FCAT_boson_all_count 217 2048
+FCAT_boson_all_count 218 2048
+FCAT_boson_all_count 219 2048
+FCAT_boson_all_count 220 2048
+FCAT_boson_all_count 221 2048
+FCAT_boson_all_count 222 2048
+FCAT_boson_all_count 223 2048
+FCAT_boson_all_count 224 2048
+FCAT_boson_all_count 225 2048
+FCAT_boson_all_count 226 2
+FCAT_boson_all_count 227 2
+FCAT_boson_all_count 228 4094
+FCAT_boson_all_count 229 4094
+FCAT_boson_all_count 230 4094
+FCAT_boson_all_count 231 2
+FCAT_boson_all_count 232 4094
+FCAT_boson_all_count 233 4094
+FCAT_boson_all_count 234 2
+FCAT_boson_all_count 235 2
+FCAT_boson_all_count 236 2
+FCAT_boson_all_count 237 2
+FCAT_boson_all_count 238 1
+FCAT_boson_all_count 239 1
+FCAT_boson_all_count 240 1
+FCAT_boson_all_count 241 4095
+FCAT_boson_all_count 242 4095
+FCAT_boson_all_count 243 4095
+FCAT_boson_all_count 244 1
+FCAT_boson_all_count 245 2
+FCAT_boson_all_count 246 2
+FCAT_boson_all_count 247 1
+FCAT_boson_all_count 248 1
+FCAT_boson_all_count 249 1
+FCAT_boson_all_count 250 0
+FCAT_boson_all_count 251 0
+FCAT_boson_all_count 252 1
+FCAT_boson_all_count 253 0
+FCAT_boson_all_count 254 0
+FCAT_boson_all_count 255 0
+FCAT_boson_all_count 256 1
+FCAT_boson_all_count 257 1
+FCAT_boson_all_count 258 1
+FCAT_boson_all_count 259 1
+FCAT_boson_all_count 260 0
+FCAT_boson_all_count 261 0
+FCAT_boson_all_count 262 0
+FCAT_boson_all_count 263 0
+FCAT_boson_all_count 264 0
+FCAT_boson_all_count 265 0
+FCAT_boson_all_count 266 0
+FCAT_boson_all_count 267 0
+FCAT_boson_all_count 268 0
+FCAT_boson_all_count 269 0
+FCAT_boson_all_count 270 1
+FCAT_boson_all_count 271 1
+FCAT_boson_all_count 272 1
+FCAT_boson_all_count 273 1
+FCAT_boson_all_count 274 4095
+FCAT_boson_all_count 275 2016
+FCAT_boson_all_count 276 2016
+FCAT_boson_all_count 277 2016
+FCAT_boson_all_count 278 2016
+FCAT_boson_all_count 279 2016
+FCAT_boson_all_count 280 2016
+FCAT_boson_all_count 281 2016
+FCAT_boson_all_count 282 4095
+FCAT_boson_all_count 283 4095
+FCAT_boson_all_count 284 4083
+FCAT_boson_all_count 285 4083
+FCAT_boson_all_count 286 4083
+FCAT_boson_all_count 287 4095
+FCAT_boson_all_count 288 4095
+FCAT_boson_all_count 289 1
+FCAT_boson_all_count 290 2048
+FCAT_boson_all_count 291 2048
+FCAT_boson_all_count 292 2048
+FCAT_boson_all_count 293 2048
+FCAT_boson_all_count 294 2048
+FCAT_boson_all_count 295 2048
+FCAT_boson_all_count 296 2048
+FCAT_boson_all_count 297 1
+FCAT_boson_all_count 298 1
+FCAT_boson_all_count 299 1
+FCAT_boson_all_count 300 1
+FCAT_boson_all_count 301 1
+FCAT_boson_all_count 302 11
+FCAT_boson_all_count 303 11
+FCAT_boson_all_count 304 11
+FCAT_boson_all_count 305 11
+FCAT_boson_all_count 306 11
+FCAT_boson_all_count 307 11
+FCAT_boson_all_count 308 11
+FCAT_boson_all_count 309 11
+FCAT_boson_all_count 310 11
+FCAT_boson_all_count 311 2047
+FCAT_boson_all_count 312 2047
+FCAT_boson_all_count 313 2047
+FCAT_boson_all_count 314 2047
+FCAT_boson_all_count 315 2047
+FCAT_boson_all_count 316 2047
+FCAT_boson_all_count 317 2047
+FCAT_boson_all_count 318 2047
+FCAT_boson_all_count 319 11
+FCAT_boson_all_count 320 4083
+FCAT_boson_all_count 321 20481
+FCAT_boson_all_count 322 20481
+FCAT_boson_all_count 323 20481
+FCAT_boson_all_count 324 20481
+FCAT_boson_all_count 325 20481
+FCAT_boson_all_count 326 20481
+FCAT_boson_all_count 327 20481
+FCAT_boson_all_count 328 20481
+FCAT_boson_all_count 329 4083
+FCAT_boson_all_count 330 4083
+FCAT_boson_all_count 331 4083
+FCAT_boson_all_count 332 4083
+FCAT_boson_all_count 333 11
+FCAT_boson_all_count 334 1
+FCAT_boson_all_count 335 1
+FCAT_boson_all_count 336 1
+FCAT_boson_all_count 337 1
+FCAT_boson_all_count 338 1
+FCAT_boson_all_count 339 4095
+FCAT_boson_all_count 340 4095
+FCAT_boson_all_count 341 1
+FCAT_boson_all_count 342 1
+FCAT_boson_all_count 343 1
+FCAT_boson_all_count 344 1
+FCAT_boson_all_count 345 1
+FCAT_boson_all_count 346 1
+FCAT_boson_all_count 347 1
+FCAT_boson_all_count 348 1
+FCAT_boson_all_count 349 1
+FCAT_boson_all_count 350 1
+FCAT_boson_all_count 351 1
+FCAT_boson_all_count 352 1
+FCAT_boson_all_count 353 4095
+FCAT_boson_all_count 354 4095
+FCAT_boson_all_count 355 4095
+FCAT_boson_all_count 356 4095
+FCAT_boson_all_count 357 4095
+FCAT_boson_all_count 358 4095
+FCAT_boson_all_count 359 4095
+FCAT_boson_all_count 360 4095
+FCAT_boson_all_count 361 4095
+FCAT_boson_all_count 362 0
+FCAT_boson_all_count 363 0
+FCAT_boson_all_count 364 0
+FCAT_boson_all_count 365 0
+FCAT_boson_all_count 366 4095
+FCAT_boson_all_count 367 1
+FCAT_boson_all_count 368 1
+FCAT_boson_all_count 369 1
+FCAT_boson_all_count 370 1
+FCAT_boson_all_count 371 1
+FCAT_boson_all_count 372 1
+FCAT_boson_all_count 373 1
+FCAT_boson_all_count 374 1
+FCAT_boson_all_count 375 1
+FCAT_boson_all_count 376 1
+FCAT_boson_all_count 377 1
+FCAT_boson_all_count 378 1
+FCAT_boson_all_count 379 1
+FCAT_boson_all_count 380 1
+FCAT_boson_all_count 381 1
+FCAT_boson_all_count 382 11
+FCAT_boson_all_count 383 11
+FCAT_boson_all_count 384 11
+FCAT_boson_all_count 385 10
+FCAT_boson_all_count 386 1
+FCAT_boson_all_count 387 0
+FCAT_boson_all_count 388 0
+FCAT_boson_all_count 389 0
+FCAT_boson_all_count 390 0
+FCAT_boson_all_count 391 0
+FCAT_boson_all_count 392 1
+FCAT_boson_all_count 393 0
+FCAT_boson_all_count 394 0
+FCAT_boson_all_count 395 0
+FCAT_boson_all_count 396 1
+FCAT_boson_all_count 397 1
+FCAT_boson_all_count 398 1
+FCAT_boson_all_count 399 1
+FCAT_boson_all_count 400 1
+FCAT_boson_all_count 401 325
+FCAT_boson_all_count 402 325
+FCAT_boson_all_count 403 325
+FCAT_boson_all_count 404 1
+FCAT_boson_all_count 405 1
+FCAT_boson_all_count 406 1
+FCAT_boson_all_count 407 1
+FCAT_boson_all_count 408 1
+FCAT_boson_all_count 409 0
+FCAT_boson_all_count 410 0
+FCAT_boson_all_count 411 0
+FCAT_boson_all_count 412 0
+FCAT_boson_all_count 413 0
+FCAT_boson_all_count 414 0
+FCAT_boson_all_count 415 0
+FCAT_boson_all_count 416 0
+FCAT_boson_all_count 417 0
+FCAT_boson_all_count 418 0
+FCAT_boson_all_count 419 0
+FCAT_boson_all_count 420 0
+FCAT_boson_all_count 421 0
+FCAT_boson_all_count 422 0
+FCAT_boson_all_count 423 0
+FCAT_boson_all_count 424 0
+FCAT_boson_all_count 425 0
+FCAT_boson_all_count 426 0
+FCAT_boson_all_count 427 0
+FCAT_boson_all_count 428 0
+FCAT_boson_all_count 429 0
+FCAT_boson_all_count 430 0
+FCAT_boson_all_count 431 0
+FCAT_boson_all_count 432 0
+FCAT_boson_all_count 433 0
+FCAT_boson_all_count 434 0
+FCAT_boson_all_count 435 0
+FCAT_boson_all_count 436 0
+FCAT_boson_all_count 437 1
+FCAT_boson_all_count 438 1
+FCAT_boson_all_count 439 1
+FCAT_boson_all_count 440 0
+FCAT_boson_all_count 441 0
+FCAT_boson_all_count 442 1
+FCAT_boson_all_count 443 0
+FCAT_boson_all_count 444 0
+FCAT_boson_all_count 445 1
+FCAT_boson_all_count 446 1
+FCAT_boson_all_count 447 1
+FCAT_boson_all_count 448 1
+FCAT_boson_all_count 449 1
+FCAT_boson_all_count 450 0
+FCAT_boson_all_count 451 0
+FCAT_boson_all_count 452 1
+FCAT_boson_all_count 453 1
+FCAT_boson_all_count 454 1
+FCAT_boson_all_count 455 1
+FCAT_boson_all_count 456 1
+FCAT_boson_all_count 457 4095
+FCAT_boson_all_count 458 4095
+FCAT_boson_all_count 459 4095
+FCAT_boson_all_count 460 4095
+FCAT_boson_all_count 461 4095
+FCAT_boson_all_count 462 4095
+FCAT_boson_all_count 463 4095
+FCAT_boson_all_count 464 4095
+FCAT_boson_all_count 465 4095
+FCAT_boson_all_count 466 4095
+FCAT_boson_all_count 467 193
+FCAT_boson_all_count 468 3902
+FCAT_boson_all_count 469 3902
+FCAT_boson_all_count 470 3902
+FCAT_boson_all_count 471 4095
+FCAT_boson_all_count 472 4095
+FCAT_boson_all_count 473 4095
+FCAT_boson_all_count 474 4095
+FCAT_boson_all_count 475 4095
+FCAT_boson_all_count 476 4095
+FCAT_boson_all_count 477 4095
+FCAT_boson_all_count 478 4095
+FCAT_boson_all_count 479 4095
+FCAT_boson_all_count 480 104
+FCAT_boson_all_count 481 3991
+FCAT_boson_all_count 482 3991
+FCAT_boson_all_count 483 3991
+FCAT_boson_all_count 484 4095
+FCAT_boson_all_count 485 4095
+FCAT_boson_all_count 486 4095
+FCAT_boson_all_count 487 4095
+FCAT_boson_all_count 488 4095
+FCAT_boson_all_count 489 1736
+FCAT_boson_all_count 490 1736
+FCAT_boson_all_count 491 4095
+FCAT_boson_all_count 492 4095
+FCAT_boson_all_count 493 4095
+FCAT_boson_all_count 494 4095
+FCAT_boson_all_count 495 4095
+FCAT_boson_all_count 496 4095
+FCAT_boson_all_count 497 4095
+FCAT_boson_all_count 498 4095
+FCAT_boson_all_count 499 1
+FCAT_boson_all_count 500 0
+FCAT_boson_all_count 501 0
+FCAT_boson_all_count 502 0
+FCAT_boson_all_count 503 0
+FCAT_boson_all_count 504 0
+FCAT_boson_all_count 505 1
+FCAT_boson_all_count 506 1
+FCAT_boson_all_count 507 1
+FCAT_boson_all_count 508 1
+FCAT_boson_all_count 509 1
+FCAT_boson_all_count 510 1
+FCAT_boson_all_count 511 1
+FCAT_boson_all_count 512 0
+FCAT_boson_all_count 513 0
+FCAT_boson_all_count 514 1
+FCAT_boson_all_count 515 251
+FCAT_boson_all_count 516 251
+FCAT_boson_all_count 517 251
+FCAT_boson_all_count 518 251
+FCAT_boson_all_count 519 251
+FCAT_boson_all_count 520 251
+FCAT_boson_all_count 521 251
+FCAT_boson_all_count 522 251
+FCAT_boson_all_count 523 1
+FCAT_boson_all_count 524 1
+FCAT_boson_all_count 525 1
+FCAT_boson_all_count 526 1
+FCAT_boson_all_count 527 1
+FCAT_boson_all_count 528 0
+FCAT_boson_all_count 529 0
+FCAT_boson_all_count 530 1
+FCAT_boson_all_count 531 1
+FCAT_boson_all_count 532 600
+FCAT_boson_all_count 533 600
+FCAT_boson_all_count 534 600
+FCAT_boson_all_count 535 600
+FCAT_boson_all_count 536 600
+FCAT_boson_all_count 537 600
+FCAT_boson_all_count 538 600
+FCAT_boson_all_count 539 1
+FCAT_boson_all_count 540 1
+FCAT_boson_all_count 541 1
+FCAT_boson_all_count 542 1
+FCAT_boson_all_count 543 1
+FCAT_boson_all_count 544 1
+FCAT_boson_all_count 545 1
+FCAT_boson_all_count 546 1
+FCAT_boson_all_count 547 1
+FCAT_boson_all_count 548 1
+FCAT_boson_all_count 549 1
+FCAT_boson_all_count 550 1
+FCAT_boson_all_count 551 1
+FCAT_boson_all_count 552 1
+FCAT_boson_all_count 553 601
+FCAT_boson_all_count 554 601
+FCAT_boson_all_count 555 601
+FCAT_boson_all_count 556 601
+FCAT_boson_all_count 557 601
+FCAT_boson_all_count 558 601
+FCAT_boson_all_count 559 601
+FCAT_boson_all_count 560 600
+FCAT_boson_all_count 561 600
+FCAT_boson_all_count 562 600
+FCAT_boson_all_count 563 600
+FCAT_boson_all_count 564 2
+FCAT_boson_all_count 565 2
+FCAT_boson_all_count 566 2
+FCAT_boson_all_count 567 2
+FCAT_boson_all_count 568 2
+FCAT_boson_all_count 569 2
+FCAT_boson_all_count 570 2
+FCAT_boson_all_count 571 2
+FCAT_boson_all_count 572 2
+FCAT_boson_all_count 573 600
+FCAT_boson_all_count 574 2
+FCAT_boson_all_count 575 2
+FCAT_boson_all_count 576 2
+FCAT_boson_all_count 577 2
+FCAT_boson_all_count 578 2
+FCAT_boson_all_count 579 2
+FCAT_boson_all_count 580 2
+FCAT_boson_all_count 581 2
+FCAT_boson_all_count 582 2
+FCAT_boson_all_count 583 0
+FCAT_boson_all_count 584 2
+FCAT_boson_all_count 585 2
+FCAT_boson_all_count 586 2
+FCAT_boson_all_count 587 2
+FCAT_boson_all_count 588 2
+FCAT_boson_all_count 589 2
+FCAT_boson_all_count 590 600
+FCAT_boson_all_count 591 2
+FCAT_boson_all_count 592 2
+FCAT_boson_all_count 593 600
+FCAT_boson_all_count 594 1
+FCAT_boson_all_count 595 1
+FCAT_boson_all_count 596 1
+FCAT_boson_all_count 597 297
+FCAT_boson_all_count 598 297
+FCAT_boson_all_count 599 297
+FCAT_boson_all_count 600 7893
+FCAT_boson_all_count 601 7893
+FCAT_boson_all_count 602 7893
diff --git a/source/f90/fcat-analysis/bosou b/source/f90/fcat-analysis/bosou
new file mode 100644
index 0000000..b994389
--- /dev/null
+++ b/source/f90/fcat-analysis/bosou
@@ -0,0 +1,853 @@
+e0 = 4.00 theta = 60.0 phia = 1.80 phib = 1.80 T = 300.0 GAUSS = 0.50
+ WFW: MnO layer on metal
+ -0.5000000E+03 0.3452968E-03
+ -0.4980000E+03 0.3096233E-03
+ -0.4960000E+03 0.2765199E-03
+ -0.4940000E+03 0.2465110E-03
+ -0.4920000E+03 0.2198104E-03
+ -0.4900000E+03 0.1963923E-03
+ -0.4880000E+03 0.1760658E-03
+ -0.4860000E+03 0.1585408E-03
+ -0.4840000E+03 0.1434824E-03
+ -0.4820000E+03 0.1305498E-03
+ -0.4800000E+03 0.1194226E-03
+ -0.4780000E+03 0.1098142E-03
+ -0.4760000E+03 0.1014780E-03
+ -0.4740000E+03 0.9420631E-04
+ -0.4720000E+03 0.8782735E-04
+ -0.4700000E+03 0.8219977E-04
+ -0.4680000E+03 0.7720751E-04
+ -0.4660000E+03 0.7275503E-04
+ -0.4640000E+03 0.6876333E-04
+ -0.4620000E+03 0.6516681E-04
+ -0.4600000E+03 0.6191080E-04
+ -0.4580000E+03 0.5894968E-04
+ -0.4560000E+03 0.5624528E-04
+ -0.4540000E+03 0.5376568E-04
+ -0.4520000E+03 0.5148408E-04
+ -0.4500000E+03 0.4937799E-04
+ -0.4480000E+03 0.4742845E-04
+ -0.4460000E+03 0.4561937E-04
+ -0.4440000E+03 0.4393703E-04
+ -0.4420000E+03 0.4236963E-04
+ -0.4400000E+03 0.4090692E-04
+ -0.4380000E+03 0.3953993E-04
+ -0.4360000E+03 0.3826073E-04
+ -0.4340000E+03 0.3706226E-04
+ -0.4320000E+03 0.3593821E-04
+ -0.4300000E+03 0.3488289E-04
+ -0.4280000E+03 0.3389117E-04
+ -0.4260000E+03 0.3295840E-04
+ -0.4240000E+03 0.3208033E-04
+ -0.4220000E+03 0.3125311E-04
+ -0.4200000E+03 0.3047323E-04
+ -0.4180000E+03 0.2973743E-04
+ -0.4160000E+03 0.2904276E-04
+ -0.4140000E+03 0.2838647E-04
+ -0.4120000E+03 0.2776603E-04
+ -0.4100000E+03 0.2717911E-04
+ -0.4080000E+03 0.2662352E-04
+ -0.4060000E+03 0.2609726E-04
+ -0.4040000E+03 0.2559846E-04
+ -0.4020000E+03 0.2512539E-04
+ -0.4000000E+03 0.2467645E-04
+ -0.3980000E+03 0.2425017E-04
+ -0.3960000E+03 0.2384519E-04
+ -0.3940000E+03 0.2346026E-04
+ -0.3920000E+03 0.2309425E-04
+ -0.3900000E+03 0.2274612E-04
+ -0.3880000E+03 0.2241493E-04
+ -0.3860000E+03 0.2209980E-04
+ -0.3840000E+03 0.2179995E-04
+ -0.3820000E+03 0.2151465E-04
+ -0.3800000E+03 0.2124324E-04
+ -0.3780000E+03 0.2098511E-04
+ -0.3760000E+03 0.2073966E-04
+ -0.3740000E+03 0.2050635E-04
+ -0.3720000E+03 0.2028465E-04
+ -0.3700000E+03 0.2007407E-04
+ -0.3680000E+03 0.1987411E-04
+ -0.3660000E+03 0.1968431E-04
+ -0.3640000E+03 0.1950421E-04
+ -0.3620000E+03 0.1933338E-04
+ -0.3600000E+03 0.1917141E-04
+ -0.3580000E+03 0.1901791E-04
+ -0.3560000E+03 0.1887250E-04
+ -0.3540000E+03 0.1873487E-04
+ -0.3520000E+03 0.1860470E-04
+ -0.3500000E+03 0.1848174E-04
+ -0.3480000E+03 0.1836574E-04
+ -0.3460000E+03 0.1825650E-04
+ -0.3440000E+03 0.1815385E-04
+ -0.3420000E+03 0.1805766E-04
+ -0.3400000E+03 0.1796779E-04
+ -0.3380000E+03 0.1788413E-04
+ -0.3360000E+03 0.1780659E-04
+ -0.3340000E+03 0.1773507E-04
+ -0.3320000E+03 0.1766946E-04
+ -0.3300000E+03 0.1760965E-04
+ -0.3280000E+03 0.1755552E-04
+ -0.3260000E+03 0.1750693E-04
+ -0.3240000E+03 0.1746372E-04
+ -0.3220000E+03 0.1742572E-04
+ -0.3200000E+03 0.1739276E-04
+ -0.3180000E+03 0.1736463E-04
+ -0.3160000E+03 0.1734118E-04
+ -0.3140000E+03 0.1732221E-04
+ -0.3120000E+03 0.1730758E-04
+ -0.3100000E+03 0.1729714E-04
+ -0.3080000E+03 0.1729079E-04
+ -0.3060000E+03 0.1728845E-04
+ -0.3040000E+03 0.1729007E-04
+ -0.3020000E+03 0.1729562E-04
+ -0.3000000E+03 0.1730513E-04
+ -0.2980000E+03 0.1731861E-04
+ -0.2960000E+03 0.1733612E-04
+ -0.2940000E+03 0.1735771E-04
+ -0.2920000E+03 0.1738345E-04
+ -0.2900000E+03 0.1741339E-04
+ -0.2880000E+03 0.1744758E-04
+ -0.2860000E+03 0.1748606E-04
+ -0.2840000E+03 0.1752884E-04
+ -0.2820000E+03 0.1757592E-04
+ -0.2800000E+03 0.1762729E-04
+ -0.2780000E+03 0.1768294E-04
+ -0.2760000E+03 0.1774282E-04
+ -0.2740000E+03 0.1780692E-04
+ -0.2720000E+03 0.1787520E-04
+ -0.2700000E+03 0.1794766E-04
+ -0.2680000E+03 0.1802431E-04
+ -0.2660000E+03 0.1810518E-04
+ -0.2640000E+03 0.1819033E-04
+ -0.2620000E+03 0.1827984E-04
+ -0.2600000E+03 0.1837384E-04
+ -0.2580000E+03 0.1847243E-04
+ -0.2560000E+03 0.1857577E-04
+ -0.2540000E+03 0.1868399E-04
+ -0.2520000E+03 0.1879725E-04
+ -0.2500000E+03 0.1891567E-04
+ -0.2480000E+03 0.1903936E-04
+ -0.2460000E+03 0.1916841E-04
+ -0.2440000E+03 0.1930287E-04
+ -0.2420000E+03 0.1944276E-04
+ -0.2400000E+03 0.1958807E-04
+ -0.2380000E+03 0.1973876E-04
+ -0.2360000E+03 0.1989479E-04
+ -0.2340000E+03 0.2005610E-04
+ -0.2320000E+03 0.2022264E-04
+ -0.2300000E+03 0.2039436E-04
+ -0.2280000E+03 0.2057128E-04
+ -0.2260000E+03 0.2075344E-04
+ -0.2240000E+03 0.2094093E-04
+ -0.2220000E+03 0.2113394E-04
+ -0.2200000E+03 0.2133269E-04
+ -0.2180000E+03 0.2153749E-04
+ -0.2160000E+03 0.2174873E-04
+ -0.2140000E+03 0.2196683E-04
+ -0.2120000E+03 0.2219230E-04
+ -0.2100000E+03 0.2242567E-04
+ -0.2080000E+03 0.2266752E-04
+ -0.2060000E+03 0.2291842E-04
+ -0.2040000E+03 0.2317896E-04
+ -0.2020000E+03 0.2344971E-04
+ -0.2000000E+03 0.2373122E-04
+ -0.1980000E+03 0.2402397E-04
+ -0.1960000E+03 0.2432842E-04
+ -0.1940000E+03 0.2464494E-04
+ -0.1920000E+03 0.2497383E-04
+ -0.1900000E+03 0.2531531E-04
+ -0.1880000E+03 0.2566953E-04
+ -0.1860000E+03 0.2603657E-04
+ -0.1840000E+03 0.2641649E-04
+ -0.1820000E+03 0.2680934E-04
+ -0.1800000E+03 0.2721521E-04
+ -0.1780000E+03 0.2763424E-04
+ -0.1760000E+03 0.2806669E-04
+ -0.1740000E+03 0.2851293E-04
+ -0.1720000E+03 0.2897345E-04
+ -0.1700000E+03 0.2944887E-04
+ -0.1680000E+03 0.2993988E-04
+ -0.1660000E+03 0.3044725E-04
+ -0.1640000E+03 0.3097179E-04
+ -0.1620000E+03 0.3151431E-04
+ -0.1600000E+03 0.3207563E-04
+ -0.1580000E+03 0.3265654E-04
+ -0.1560000E+03 0.3325780E-04
+ -0.1540000E+03 0.3388016E-04
+ -0.1520000E+03 0.3452434E-04
+ -0.1500000E+03 0.3519111E-04
+ -0.1480000E+03 0.3588127E-04
+ -0.1460000E+03 0.3659572E-04
+ -0.1440000E+03 0.3733548E-04
+ -0.1420000E+03 0.3810173E-04
+ -0.1400000E+03 0.3889585E-04
+ -0.1380000E+03 0.3971946E-04
+ -0.1360000E+03 0.4057443E-04
+ -0.1340000E+03 0.4146285E-04
+ -0.1320000E+03 0.4238711E-04
+ -0.1300000E+03 0.4334984E-04
+ -0.1280000E+03 0.4435388E-04
+ -0.1260000E+03 0.4540229E-04
+ -0.1240000E+03 0.4649831E-04
+ -0.1220000E+03 0.4764533E-04
+ -0.1200000E+03 0.4884688E-04
+ -0.1180000E+03 0.5010658E-04
+ -0.1160000E+03 0.5142819E-04
+ -0.1140000E+03 0.5281557E-04
+ -0.1120000E+03 0.5427275E-04
+ -0.1100000E+03 0.5580396E-04
+ -0.1080000E+03 0.5741367E-04
+ -0.1060000E+03 0.5910673E-04
+ -0.1040000E+03 0.6088841E-04
+ -0.1020000E+03 0.6276452E-04
+ -0.1000000E+03 0.6474155E-04
+ -0.9800000E+02 0.6682671E-04
+ -0.9600000E+02 0.6902811E-04
+ -0.9400000E+02 0.7135482E-04
+ -0.9200000E+02 0.7381694E-04
+ -0.9000000E+02 0.7642568E-04
+ -0.8800000E+02 0.7919333E-04
+ -0.8600000E+02 0.8213320E-04
+ -0.8400000E+02 0.8525948E-04
+ -0.8200000E+02 0.8858697E-04
+ -0.8000000E+02 0.9213072E-04
+ -0.7800000E+02 0.9590558E-04
+ -0.7600000E+02 0.9992564E-04
+ -0.7400000E+02 0.1042039E-03
+ -0.7200000E+02 0.1087518E-03
+ -0.7000000E+02 0.1135798E-03
+ -0.6800000E+02 0.1186979E-03
+ -0.6600000E+02 0.1241176E-03
+ -0.6400000E+02 0.1298540E-03
+ -0.6200000E+02 0.1359290E-03
+ -0.6000000E+02 0.1423754E-03
+ -0.5800000E+02 0.1492430E-03
+ -0.5600000E+02 0.1566063E-03
+ -0.5400000E+02 0.1645789E-03
+ -0.5200000E+02 0.1733361E-03
+ -0.5000000E+02 0.1831428E-03
+ -0.4800000E+02 0.1943430E-03
+ -0.4600000E+02 0.2073412E-03
+ -0.4400000E+02 0.2226383E-03
+ -0.4200000E+02 0.2409165E-03
+ -0.4000000E+02 0.2631544E-03
+ -0.3800000E+02 0.2908084E-03
+ -0.3600000E+02 0.3260767E-03
+ -0.3400000E+02 0.3722523E-03
+ -0.3200000E+02 0.4341508E-03
+ -0.3000000E+02 0.5185654E-03
+ -0.2800000E+02 0.6346525E-03
+ -0.2600000E+02 0.7941015E-03
+ -0.2400000E+02 0.1010909E-02
+ -0.2200000E+02 0.1300592E-02
+ -0.2000000E+02 0.1678744E-02
+ -0.1800000E+02 0.2159029E-02
+ -0.1600000E+02 0.2750887E-02
+ -0.1400000E+02 0.3457422E-02
+ -0.1200000E+02 0.4273833E-02
+ -0.1000000E+02 0.5186110E-02
+ -0.8000000E+01 0.6167983E-02
+ -0.6000000E+01 0.7171389E-02
+ -0.4000000E+01 0.8104983E-02
+ -0.2000000E+01 0.8808949E-02
+ -0.0000000E+00 0.9080436E-02
+ 0.2000000E+01 0.8941075E-02
+ 0.4000000E+01 0.8530095E-02
+ 0.6000000E+01 0.7895152E-02
+ 0.8000000E+01 0.7108290E-02
+ 0.1000000E+02 0.6243762E-02
+ 0.1200000E+02 0.5367473E-02
+ 0.1400000E+02 0.4532139E-02
+ 0.1600000E+02 0.3774725E-02
+ 0.1800000E+02 0.3116302E-02
+ 0.2000000E+02 0.2564007E-02
+ 0.2200000E+02 0.2114287E-02
+ 0.2400000E+02 0.1756575E-02
+ 0.2600000E+02 0.1476697E-02
+ 0.2800000E+02 0.1259619E-02
+ 0.3000000E+02 0.1091316E-02
+ 0.3200000E+02 0.9598154E-03
+ 0.3400000E+02 0.8555692E-03
+ 0.3600000E+02 0.7713585E-03
+ 0.3800000E+02 0.7019506E-03
+ 0.4000000E+02 0.6436657E-03
+ 0.4200000E+02 0.5939571E-03
+ 0.4400000E+02 0.5510598E-03
+ 0.4600000E+02 0.5137159E-03
+ 0.4800000E+02 0.4809719E-03
+ 0.5000000E+02 0.4520361E-03
+ 0.5200000E+02 0.4262364E-03
+ 0.5400000E+02 0.4030380E-03
+ 0.5600000E+02 0.3820141E-03
+ 0.5800000E+02 0.3628162E-03
+ 0.6000000E+02 0.3451661E-03
+ 0.6200000E+02 0.3288457E-03
+ 0.6400000E+02 0.3136867E-03
+ 0.6600000E+02 0.2995597E-03
+ 0.6800000E+02 0.2863645E-03
+ 0.7000000E+02 0.2740222E-03
+ 0.7200000E+02 0.2624682E-03
+ 0.7400000E+02 0.2516470E-03
+ 0.7600000E+02 0.2415089E-03
+ 0.7800000E+02 0.2320077E-03
+ 0.8000000E+02 0.2230999E-03
+ 0.8200000E+02 0.2147440E-03
+ 0.8400000E+02 0.2069010E-03
+ 0.8600000E+02 0.1995340E-03
+ 0.8800000E+02 0.1926087E-03
+ 0.9000000E+02 0.1860930E-03
+ 0.9200000E+02 0.1799576E-03
+ 0.9400000E+02 0.1741752E-03
+ 0.9600000E+02 0.1687209E-03
+ 0.9800000E+02 0.1635714E-03
+ 0.1000000E+03 0.1587053E-03
+ 0.1020000E+03 0.1541031E-03
+ 0.1040000E+03 0.1497462E-03
+ 0.1060000E+03 0.1456177E-03
+ 0.1080000E+03 0.1417019E-03
+ 0.1100000E+03 0.1379843E-03
+ 0.1120000E+03 0.1344515E-03
+ 0.1140000E+03 0.1310913E-03
+ 0.1160000E+03 0.1278923E-03
+ 0.1180000E+03 0.1248445E-03
+ 0.1200000E+03 0.1219384E-03
+ 0.1220000E+03 0.1191658E-03
+ 0.1240000E+03 0.1165190E-03
+ 0.1260000E+03 0.1139912E-03
+ 0.1280000E+03 0.1115760E-03
+ 0.1300000E+03 0.1092677E-03
+ 0.1320000E+03 0.1070612E-03
+ 0.1340000E+03 0.1049515E-03
+ 0.1360000E+03 0.1029341E-03
+ 0.1380000E+03 0.1010045E-03
+ 0.1400000E+03 0.9915866E-04
+ 0.1420000E+03 0.9739251E-04
+ 0.1440000E+03 0.9570216E-04
+ 0.1460000E+03 0.9408378E-04
+ 0.1480000E+03 0.9253368E-04
+ 0.1500000E+03 0.9104823E-04
+ 0.1520000E+03 0.8962394E-04
+ 0.1540000E+03 0.8825744E-04
+ 0.1560000E+03 0.8694550E-04
+ 0.1580000E+03 0.8568505E-04
+ 0.1600000E+03 0.8447319E-04
+ 0.1620000E+03 0.8330721E-04
+ 0.1640000E+03 0.8218457E-04
+ 0.1660000E+03 0.8110298E-04
+ 0.1680000E+03 0.8006032E-04
+ 0.1700000E+03 0.7905471E-04
+ 0.1720000E+03 0.7808453E-04
+ 0.1740000E+03 0.7714839E-04
+ 0.1760000E+03 0.7624517E-04
+ 0.1780000E+03 0.7537404E-04
+ 0.1800000E+03 0.7453444E-04
+ 0.1820000E+03 0.7372604E-04
+ 0.1840000E+03 0.7294869E-04
+ 0.1860000E+03 0.7220234E-04
+ 0.1880000E+03 0.7148690E-04
+ 0.1900000E+03 0.7080220E-04
+ 0.1920000E+03 0.7014794E-04
+ 0.1940000E+03 0.6952361E-04
+ 0.1960000E+03 0.6892856E-04
+ 0.1980000E+03 0.6836201E-04
+ 0.2000000E+03 0.6782306E-04
+ 0.2020000E+03 0.6731077E-04
+ 0.2040000E+03 0.6682420E-04
+ 0.2060000E+03 0.6636244E-04
+ 0.2080000E+03 0.6592463E-04
+ 0.2100000E+03 0.6551002E-04
+ 0.2120000E+03 0.6511793E-04
+ 0.2140000E+03 0.6474777E-04
+ 0.2160000E+03 0.6439904E-04
+ 0.2180000E+03 0.6407128E-04
+ 0.2200000E+03 0.6376409E-04
+ 0.2220000E+03 0.6347709E-04
+ 0.2240000E+03 0.6320991E-04
+ 0.2260000E+03 0.6296217E-04
+ 0.2280000E+03 0.6273348E-04
+ 0.2300000E+03 0.6252343E-04
+ 0.2320000E+03 0.6233160E-04
+ 0.2340000E+03 0.6215757E-04
+ 0.2360000E+03 0.6200089E-04
+ 0.2380000E+03 0.6186115E-04
+ 0.2400000E+03 0.6173794E-04
+ 0.2420000E+03 0.6163091E-04
+ 0.2440000E+03 0.6153974E-04
+ 0.2460000E+03 0.6146416E-04
+ 0.2480000E+03 0.6140397E-04
+ 0.2500000E+03 0.6135903E-04
+ 0.2520000E+03 0.6132927E-04
+ 0.2540000E+03 0.6131466E-04
+ 0.2560000E+03 0.6131524E-04
+ 0.2580000E+03 0.6133108E-04
+ 0.2600000E+03 0.6136228E-04
+ 0.2620000E+03 0.6140895E-04
+ 0.2640000E+03 0.6147122E-04
+ 0.2660000E+03 0.6154920E-04
+ 0.2680000E+03 0.6164300E-04
+ 0.2700000E+03 0.6175271E-04
+ 0.2720000E+03 0.6187839E-04
+ 0.2740000E+03 0.6202011E-04
+ 0.2760000E+03 0.6217790E-04
+ 0.2780000E+03 0.6235180E-04
+ 0.2800000E+03 0.6254185E-04
+ 0.2820000E+03 0.6274812E-04
+ 0.2840000E+03 0.6297070E-04
+ 0.2860000E+03 0.6320972E-04
+ 0.2880000E+03 0.6346536E-04
+ 0.2900000E+03 0.6373786E-04
+ 0.2920000E+03 0.6402752E-04
+ 0.2940000E+03 0.6433471E-04
+ 0.2960000E+03 0.6465986E-04
+ 0.2980000E+03 0.6500346E-04
+ 0.3000000E+03 0.6536604E-04
+ 0.3020000E+03 0.6574819E-04
+ 0.3040000E+03 0.6615053E-04
+ 0.3060000E+03 0.6657369E-04
+ 0.3080000E+03 0.6701832E-04
+ 0.3100000E+03 0.6748508E-04
+ 0.3120000E+03 0.6797461E-04
+ 0.3140000E+03 0.6848757E-04
+ 0.3160000E+03 0.6902460E-04
+ 0.3180000E+03 0.6958631E-04
+ 0.3200000E+03 0.7017334E-04
+ 0.3220000E+03 0.7078633E-04
+ 0.3240000E+03 0.7142590E-04
+ 0.3260000E+03 0.7209274E-04
+ 0.3280000E+03 0.7278754E-04
+ 0.3300000E+03 0.7351105E-04
+ 0.3320000E+03 0.7426409E-04
+ 0.3340000E+03 0.7504753E-04
+ 0.3360000E+03 0.7586235E-04
+ 0.3380000E+03 0.7670961E-04
+ 0.3400000E+03 0.7759046E-04
+ 0.3420000E+03 0.7850615E-04
+ 0.3440000E+03 0.7945805E-04
+ 0.3460000E+03 0.8044759E-04
+ 0.3480000E+03 0.8147631E-04
+ 0.3500000E+03 0.8254583E-04
+ 0.3520000E+03 0.8365783E-04
+ 0.3540000E+03 0.8481408E-04
+ 0.3560000E+03 0.8601642E-04
+ 0.3580000E+03 0.8726677E-04
+ 0.3600000E+03 0.8856713E-04
+ 0.3620000E+03 0.8991960E-04
+ 0.3640000E+03 0.9132642E-04
+ 0.3660000E+03 0.9278996E-04
+ 0.3680000E+03 0.9431276E-04
+ 0.3700000E+03 0.9589758E-04
+ 0.3720000E+03 0.9754738E-04
+ 0.3740000E+03 0.9926542E-04
+ 0.3760000E+03 0.1010552E-03
+ 0.3780000E+03 0.1029206E-03
+ 0.3800000E+03 0.1048658E-03
+ 0.3820000E+03 0.1068954E-03
+ 0.3840000E+03 0.1090142E-03
+ 0.3860000E+03 0.1112276E-03
+ 0.3880000E+03 0.1135413E-03
+ 0.3900000E+03 0.1159614E-03
+ 0.3920000E+03 0.1184946E-03
+ 0.3940000E+03 0.1211478E-03
+ 0.3960000E+03 0.1239285E-03
+ 0.3980000E+03 0.1268447E-03
+ 0.4000000E+03 0.1299052E-03
+ 0.4020000E+03 0.1331190E-03
+ 0.4040000E+03 0.1364960E-03
+ 0.4060000E+03 0.1400471E-03
+ 0.4080000E+03 0.1437837E-03
+ 0.4100000E+03 0.1477184E-03
+ 0.4120000E+03 0.1518651E-03
+ 0.4140000E+03 0.1562386E-03
+ 0.4160000E+03 0.1608556E-03
+ 0.4180000E+03 0.1657340E-03
+ 0.4200000E+03 0.1708938E-03
+ 0.4220000E+03 0.1763569E-03
+ 0.4240000E+03 0.1821475E-03
+ 0.4260000E+03 0.1882920E-03
+ 0.4280000E+03 0.1948198E-03
+ 0.4300000E+03 0.2017631E-03
+ 0.4320000E+03 0.2091574E-03
+ 0.4340000E+03 0.2170418E-03
+ 0.4360000E+03 0.2254596E-03
+ 0.4380000E+03 0.2344586E-03
+ 0.4400000E+03 0.2440922E-03
+ 0.4420000E+03 0.2544203E-03
+ 0.4440000E+03 0.2655108E-03
+ 0.4460000E+03 0.2774416E-03
+ 0.4480000E+03 0.2903030E-03
+ 0.4500000E+03 0.3042011E-03
+ 0.4520000E+03 0.3192623E-03
+ 0.4540000E+03 0.3356383E-03
+ 0.4560000E+03 0.3535136E-03
+ 0.4580000E+03 0.3731137E-03
+ 0.4600000E+03 0.3947157E-03
+ 0.4620000E+03 0.4186620E-03
+ 0.4640000E+03 0.4453757E-03
+ 0.4660000E+03 0.4753797E-03
+ 0.4680000E+03 0.5093211E-03
+ 0.4700000E+03 0.5480015E-03
+ 0.4720000E+03 0.5924178E-03
+ 0.4740000E+03 0.6438161E-03
+ 0.4760000E+03 0.7037579E-03
+ 0.4780000E+03 0.7741990E-03
+ 0.4800000E+03 0.8575741E-03
+ 0.4820000E+03 0.9568757E-03
+ 0.4840000E+03 0.1075710E-02
+ 0.4860000E+03 0.1218300E-02
+ 0.4880000E+03 0.1389410E-02
+ 0.4900000E+03 0.1594143E-02
+ 0.4920000E+03 0.1837594E-02
+ 0.4940000E+03 0.2124326E-02
+ 0.4960000E+03 0.2457680E-02
+ 0.4980000E+03 0.2838945E-02
+ 0.5000000E+03 0.3266423E-02
+ 0.5020000E+03 0.3734473E-02
+ 0.5040000E+03 0.4232566E-02
+ 0.5060000E+03 0.4744462E-02
+ 0.5080000E+03 0.5247711E-02
+ 0.5100000E+03 0.5713943E-02
+ 0.5120000E+03 0.6110792E-02
+ 0.5140000E+03 0.6406226E-02
+ 0.5160000E+03 0.6574874E-02
+ 0.5180000E+03 0.6603823E-02
+ 0.5200000E+03 0.6494748E-02
+ 0.5220000E+03 0.6261819E-02
+ 0.5240000E+03 0.5927589E-02
+ 0.5260000E+03 0.5518942E-02
+ 0.5280000E+03 0.5063713E-02
+ 0.5300000E+03 0.4587997E-02
+ 0.5320000E+03 0.4114229E-02
+ 0.5340000E+03 0.3660045E-02
+ 0.5360000E+03 0.3237908E-02
+ 0.5380000E+03 0.2855357E-02
+ 0.5400000E+03 0.2515688E-02
+ 0.5420000E+03 0.2218880E-02
+ 0.5440000E+03 0.1962582E-02
+ 0.5460000E+03 0.1743021E-02
+ 0.5480000E+03 0.1555753E-02
+ 0.5500000E+03 0.1396222E-02
+ 0.5520000E+03 0.1260125E-02
+ 0.5540000E+03 0.1143616E-02
+ 0.5560000E+03 0.1043392E-02
+ 0.5580000E+03 0.9566884E-03
+ 0.5600000E+03 0.8812301E-03
+ 0.5620000E+03 0.8151622E-03
+ 0.5640000E+03 0.7569737E-03
+ 0.5660000E+03 0.7054304E-03
+ 0.5680000E+03 0.6595187E-03
+ 0.5700000E+03 0.6184023E-03
+ 0.5720000E+03 0.5813883E-03
+ 0.5740000E+03 0.5479014E-03
+ 0.5760000E+03 0.5174633E-03
+ 0.5780000E+03 0.4896756E-03
+ 0.5800000E+03 0.4642067E-03
+ 0.5820000E+03 0.4407796E-03
+ 0.5840000E+03 0.4191627E-03
+ 0.5860000E+03 0.3991610E-03
+ 0.5880000E+03 0.3806098E-03
+ 0.5900000E+03 0.3633681E-03
+ 0.5920000E+03 0.3473146E-03
+ 0.5940000E+03 0.3323434E-03
+ 0.5960000E+03 0.3183615E-03
+ 0.5980000E+03 0.3052864E-03
+ 0.6000000E+03 0.2930441E-03
+ 0.6020000E+03 0.2815681E-03
+ 0.6040000E+03 0.2707986E-03
+ 0.6060000E+03 0.2606811E-03
+ 0.6080000E+03 0.2511662E-03
+ 0.6100000E+03 0.2422087E-03
+ 0.6120000E+03 0.2337677E-03
+ 0.6140000E+03 0.2258054E-03
+ 0.6160000E+03 0.2182876E-03
+ 0.6180000E+03 0.2111827E-03
+ 0.6200000E+03 0.2044618E-03
+ 0.6220000E+03 0.1980982E-03
+ 0.6240000E+03 0.1920676E-03
+ 0.6260000E+03 0.1863474E-03
+ 0.6280000E+03 0.1809170E-03
+ 0.6300000E+03 0.1757574E-03
+ 0.6320000E+03 0.1708511E-03
+ 0.6340000E+03 0.1661820E-03
+ 0.6360000E+03 0.1617354E-03
+ 0.6380000E+03 0.1574977E-03
+ 0.6400000E+03 0.1534564E-03
+ 0.6420000E+03 0.1496002E-03
+ 0.6440000E+03 0.1459183E-03
+ 0.6460000E+03 0.1424010E-03
+ 0.6480000E+03 0.1390392E-03
+ 0.6500000E+03 0.1358246E-03
+ 0.6520000E+03 0.1327491E-03
+ 0.6540000E+03 0.1298054E-03
+ 0.6560000E+03 0.1269865E-03
+ 0.6580000E+03 0.1242857E-03
+ 0.6600000E+03 0.1216967E-03
+ 0.6620000E+03 0.1192134E-03
+ 0.6640000E+03 0.1168298E-03
+ 0.6660000E+03 0.1145400E-03
+ 0.6680000E+03 0.1123381E-03
+ 0.6700000E+03 0.1102180E-03
+ 0.6720000E+03 0.1081730E-03
+ 0.6740000E+03 0.1061961E-03
+ 0.6760000E+03 0.1042792E-03
+ 0.6780000E+03 0.1024134E-03
+ 0.6800000E+03 0.1005888E-03
+ 0.6820000E+03 0.9879459E-04
+ 0.6840000E+03 0.9701925E-04
+ 0.6860000E+03 0.9525119E-04
+ 0.6880000E+03 0.9347928E-04
+ 0.6900000E+03 0.9169359E-04
+ 0.6920000E+03 0.8988629E-04
+ 0.6940000E+03 0.8805305E-04
+ 0.6960000E+03 0.8619579E-04
+ 0.6980000E+03 0.8432743E-04
+ 0.7000000E+03 0.8247696E-04
+ 0.7020000E+03 0.8068208E-04
+ 0.7040000E+03 0.7897018E-04
+ 0.7060000E+03 0.7736054E-04
+ 0.7080000E+03 0.7586660E-04
+ 0.7100000E+03 0.7449496E-04
+ 0.7120000E+03 0.7324590E-04
+ 0.7140000E+03 0.7211449E-04
+ 0.7160000E+03 0.7109202E-04
+ 0.7180000E+03 0.7016753E-04
+ 0.7200000E+03 0.6932917E-04
+ 0.7220000E+03 0.6856534E-04
+ 0.7240000E+03 0.6786542E-04
+ 0.7260000E+03 0.6722024E-04
+ 0.7280000E+03 0.6662223E-04
+ 0.7300000E+03 0.6606532E-04
+ 0.7320000E+03 0.6554479E-04
+ 0.7340000E+03 0.6505702E-04
+ 0.7360000E+03 0.6459922E-04
+ 0.7380000E+03 0.6416923E-04
+ 0.7400000E+03 0.6376534E-04
+ 0.7420000E+03 0.6338615E-04
+ 0.7440000E+03 0.6303047E-04
+ 0.7460000E+03 0.6269726E-04
+ 0.7480000E+03 0.6238562E-04
+ 0.7500000E+03 0.6209471E-04
+ 0.7520000E+03 0.6182380E-04
+ 0.7540000E+03 0.6157224E-04
+ 0.7560000E+03 0.6133942E-04
+ 0.7580000E+03 0.6112483E-04
+ 0.7600000E+03 0.6092800E-04
+ 0.7620000E+03 0.6074854E-04
+ 0.7640000E+03 0.6058609E-04
+ 0.7660000E+03 0.6044035E-04
+ 0.7680000E+03 0.6031108E-04
+ 0.7700000E+03 0.6019808E-04
+ 0.7720000E+03 0.6010116E-04
+ 0.7740000E+03 0.6002021E-04
+ 0.7760000E+03 0.5995510E-04
+ 0.7780000E+03 0.5990575E-04
+ 0.7800000E+03 0.5987209E-04
+ 0.7820000E+03 0.5985407E-04
+ 0.7840000E+03 0.5985163E-04
+ 0.7860000E+03 0.5986475E-04
+ 0.7880000E+03 0.5989338E-04
+ 0.7900000E+03 0.5993753E-04
+ 0.7920000E+03 0.5999717E-04
+ 0.7940000E+03 0.6007233E-04
+ 0.7960000E+03 0.6016303E-04
+ 0.7980000E+03 0.6026932E-04
+ 0.8000000E+03 0.6039129E-04
+ 0.8020000E+03 0.6052904E-04
+ 0.8040000E+03 0.6068271E-04
+ 0.8060000E+03 0.6085247E-04
+ 0.8080000E+03 0.6103855E-04
+ 0.8100000E+03 0.6124118E-04
+ 0.8120000E+03 0.6146063E-04
+ 0.8140000E+03 0.6169723E-04
+ 0.8160000E+03 0.6195129E-04
+ 0.8180000E+03 0.6222319E-04
+ 0.8200000E+03 0.6251330E-04
+ 0.8220000E+03 0.6282203E-04
+ 0.8240000E+03 0.6314977E-04
+ 0.8260000E+03 0.6349697E-04
+ 0.8280000E+03 0.6386406E-04
+ 0.8300000E+03 0.6425149E-04
+ 0.8320000E+03 0.6465974E-04
+ 0.8340000E+03 0.6508928E-04
+ 0.8360000E+03 0.6554063E-04
+ 0.8380000E+03 0.6601431E-04
+ 0.8400000E+03 0.6651089E-04
+ 0.8420000E+03 0.6703098E-04
+ 0.8440000E+03 0.6757521E-04
+ 0.8460000E+03 0.6814426E-04
+ 0.8480000E+03 0.6873889E-04
+ 0.8500000E+03 0.6935987E-04
+ 0.8520000E+03 0.7000808E-04
+ 0.8540000E+03 0.7068440E-04
+ 0.8560000E+03 0.7138984E-04
+ 0.8580000E+03 0.7212541E-04
+ 0.8600000E+03 0.7289224E-04
+ 0.8620000E+03 0.7369148E-04
+ 0.8640000E+03 0.7452439E-04
+ 0.8660000E+03 0.7539226E-04
+ 0.8680000E+03 0.7629648E-04
+ 0.8700000E+03 0.7723849E-04
+ 0.8720000E+03 0.7821984E-04
+ 0.8740000E+03 0.7924215E-04
+ 0.8760000E+03 0.8030714E-04
+ 0.8780000E+03 0.8141662E-04
+ 0.8800000E+03 0.8257254E-04
+ 0.8820000E+03 0.8377697E-04
+ 0.8840000E+03 0.8503212E-04
+ 0.8860000E+03 0.8634037E-04
+ 0.8880000E+03 0.8770426E-04
+ 0.8900000E+03 0.8912653E-04
+ 0.8920000E+03 0.9061011E-04
+ 0.8940000E+03 0.9215817E-04
+ 0.8960000E+03 0.9377410E-04
+ 0.8980000E+03 0.9546156E-04
+ 0.9000000E+03 0.9722446E-04
+ 0.9020000E+03 0.9906701E-04
+ 0.9040000E+03 0.1009937E-03
+ 0.9060000E+03 0.1030094E-03
+ 0.9080000E+03 0.1051194E-03
+ 0.9100000E+03 0.1073291E-03
+ 0.9120000E+03 0.1096445E-03
+ 0.9140000E+03 0.1120722E-03
+ 0.9160000E+03 0.1146190E-03
+ 0.9180000E+03 0.1172924E-03
+ 0.9200000E+03 0.1201004E-03
+ 0.9220000E+03 0.1230519E-03
+ 0.9240000E+03 0.1261562E-03
+ 0.9260000E+03 0.1294237E-03
+ 0.9280000E+03 0.1328656E-03
+ 0.9300000E+03 0.1364940E-03
+ 0.9320000E+03 0.1403223E-03
+ 0.9340000E+03 0.1443651E-03
+ 0.9360000E+03 0.1486384E-03
+ 0.9380000E+03 0.1531596E-03
+ 0.9400000E+03 0.1579482E-03
+ 0.9420000E+03 0.1630252E-03
+ 0.9440000E+03 0.1684141E-03
+ 0.9460000E+03 0.1741407E-03
+ 0.9480000E+03 0.1802336E-03
+ 0.9500000E+03 0.1867246E-03
+ 0.9520000E+03 0.1936492E-03
+ 0.9540000E+03 0.2010468E-03
+ 0.9560000E+03 0.2089619E-03
+ 0.9580000E+03 0.2174447E-03
+ 0.9600000E+03 0.2265519E-03
+ 0.9620000E+03 0.2363483E-03
+ 0.9640000E+03 0.2469080E-03
+ 0.9660000E+03 0.2583164E-03
+ 0.9680000E+03 0.2706721E-03
+ 0.9700000E+03 0.2840898E-03
+ 0.9720000E+03 0.2987029E-03
+ 0.9740000E+03 0.3146676E-03
+ 0.9760000E+03 0.3321665E-03
+ 0.9780000E+03 0.3514140E-03
+ 0.9800000E+03 0.3726613E-03
+ 0.9820000E+03 0.3962029E-03
+ 0.9840000E+03 0.4223838E-03
+ 0.9860000E+03 0.4516070E-03
+ 0.9880000E+03 0.4843414E-03
+ 0.9900000E+03 0.5211304E-03
+ 0.9920000E+03 0.5625979E-03
+ 0.9940000E+03 0.6094525E-03
+ 0.9960000E+03 0.6624858E-03
+ 0.9980000E+03 0.7225628E-03
+ 0.1000000E+04 0.7905998E-03
+ 0.1002000E+04 0.8675256E-03
+ 0.1004000E+04 0.9542229E-03
+ 0.1006000E+04 0.1051446E-02
+ 0.1008000E+04 0.1159712E-02
+ 0.1010000E+04 0.1279176E-02
+ 0.1012000E+04 0.1409475E-02
+ 0.1014000E+04 0.1549584E-02
+ 0.1016000E+04 0.1697666E-02
+ 0.1018000E+04 0.1850956E-02
+ 0.1020000E+04 0.2005707E-02
+ 0.1022000E+04 0.2157215E-02
+ 0.1024000E+04 0.2299978E-02
+ 0.1026000E+04 0.2427991E-02
+ 0.1028000E+04 0.2535212E-02
+ 0.1030000E+04 0.2616136E-02
+ 0.1032000E+04 0.2666411E-02
+ 0.1034000E+04 0.2683366E-02
+ 0.1036000E+04 0.2666322E-02
+ 0.1038000E+04 0.2616639E-02
+ 0.1040000E+04 0.2537482E-02
+ 0.1042000E+04 0.2433400E-02
+ 0.1044000E+04 0.2309810E-02
+ 0.1046000E+04 0.2172464E-02
+ 0.1048000E+04 0.2026978E-02
+ 0.1050000E+04 0.1878467E-02
+ 0.1052000E+04 0.1731286E-02
+ 0.1054000E+04 0.1588905E-02
+ 0.1056000E+04 0.1453872E-02
+ 0.1058000E+04 0.1327875E-02
+ 0.1060000E+04 0.1211846E-02
+ 0.1062000E+04 0.1106104E-02
+ 0.1064000E+04 0.1010503E-02
+ 0.1066000E+04 0.9245697E-03
+ 0.1068000E+04 0.8476281E-03
+ 0.1070000E+04 0.7788930E-03
+ 0.1072000E+04 0.7175447E-03
+ 0.1074000E+04 0.6627784E-03
+ 0.1076000E+04 0.6138360E-03
+ 0.1078000E+04 0.5700232E-03
+ 0.1080000E+04 0.5307161E-03
+ 0.1082000E+04 0.4953621E-03
+ 0.1084000E+04 0.4634758E-03
+ 0.1086000E+04 0.4346338E-03
+ 0.1088000E+04 0.4084679E-03
+ 0.1090000E+04 0.3846588E-03
+ 0.1092000E+04 0.3629301E-03
+ 0.1094000E+04 0.3430429E-03
+ 0.1096000E+04 0.3247904E-03
+ 0.1098000E+04 0.3079937E-03
+ 0.1100000E+04 0.2924981E-03
+ 0.1102000E+04 0.2781692E-03
+ 0.1104000E+04 0.2648903E-03
+ 0.1106000E+04 0.2525596E-03
+ 0.1108000E+04 0.2410878E-03
+ 0.1110000E+04 0.2303969E-03
+ 0.1112000E+04 0.2204176E-03
+ 0.1114000E+04 0.2110887E-03
+ 0.1116000E+04 0.2023556E-03
+ 0.1118000E+04 0.1941697E-03
+ 0.1120000E+04 0.1864870E-03
+ 0.1122000E+04 0.1792683E-03
+ 0.1124000E+04 0.1724777E-03
+ 0.1126000E+04 0.1660831E-03
+ 0.1128000E+04 0.1600551E-03
+ 0.1130000E+04 0.1543668E-03
+ 0.1132000E+04 0.1489940E-03
+ 0.1134000E+04 0.1439143E-03
+ 0.1136000E+04 0.1391073E-03
+ 0.1138000E+04 0.1345543E-03
+ 0.1140000E+04 0.1302379E-03
+ 0.1142000E+04 0.1261425E-03
+ 0.1144000E+04 0.1222535E-03
+ 0.1146000E+04 0.1185574E-03
+ 0.1148000E+04 0.1150418E-03
+ 0.1150000E+04 0.1116955E-03
+ 0.1152000E+04 0.1085077E-03
+ 0.1154000E+04 0.1054688E-03
+ 0.1156000E+04 0.1025697E-03
+ 0.1158000E+04 0.9980210E-04
+ 0.1160000E+04 0.9715813E-04
+ 0.1162000E+04 0.9463057E-04
+ 0.1164000E+04 0.9221265E-04
+ 0.1166000E+04 0.8989801E-04
+ 0.1168000E+04 0.8768067E-04
+ 0.1170000E+04 0.8555500E-04
+ 0.1172000E+04 0.8351561E-04
+ 0.1174000E+04 0.8155738E-04
+ 0.1176000E+04 0.7967535E-04
+ 0.1178000E+04 0.7786472E-04
+ 0.1180000E+04 0.7612073E-04
+ 0.1182000E+04 0.7443869E-04
+ 0.1184000E+04 0.7281384E-04
+ 0.1186000E+04 0.7124134E-04
+ 0.1188000E+04 0.6971618E-04
+ 0.1190000E+04 0.6823318E-04
+ 0.1192000E+04 0.6678695E-04
+ 0.1194000E+04 0.6537190E-04
+ 0.1196000E+04 0.6398235E-04
+ 0.1198000E+04 0.6261263E-04
+ 0.1200000E+04 0.6125731E-04
diff --git a/source/f90/fcat-analysis/eels_all-fcat.f90 b/source/f90/fcat-analysis/eels_all-fcat.f90
new file mode 100644
index 0000000..69f447c
--- /dev/null
+++ b/source/f90/fcat-analysis/eels_all-fcat.f90
@@ -0,0 +1,2085 @@
+program eels
+
+! ******************************************************************
+! * *
+! * compute the classical eels spectrum of an arbitrary plane- *
+! * statified medium made from isotropic materials in specular *
+! * geometry using the dielectric theory of eels. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision :: e0, theta, phia, phib, wmin, wmax, dw
+ integer :: i, j, jos, k, l, layers, neps, nper, nw
+ logical :: user
+ character (len = 72) :: comment(2)
+ character (len = 10) :: contrl, mode
+
+ double precision, allocatable :: thick(:), epsinf(:), osc(:, :)
+ integer, allocatable :: nos(:)
+ character (len = 10), allocatable :: name(:)
+ double precision, allocatable :: wn_array(:), f(:)
+
+ integer :: old_size_1, old_size_2
+ double precision, allocatable :: tmp_osc(:, :)
+ integer :: ioStatus
+
+! integer, parameter :: name_length = 10
+! *** read spectrometer parameters
+
+ call FCAT_eels_all(1)
+ call change_working_dir()
+ call FCAT_eels_all(2)
+ open(unit = 11, file = 'eelsin')
+! impact energy (ev)
+ call FCAT_eels_all(3)
+ read(11, *) e0
+! incidence angle (%)
+ call FCAT_eels_all(4)
+ read(11, *) theta
+! angular apertures of the elliptic detector (%)
+ call FCAT_eels_all(5)
+ read(11, *) phia
+ call FCAT_eels_all(6)
+ read(11, *) phib
+! energy-loss interval and step size (cm**-1)
+ call FCAT_eels_all(7)
+ read(11, *) wmin
+ call FCAT_eels_all(8)
+ read(11, *) wmax
+ call FCAT_eels_all(9)
+ read(11, *) dw
+! comment lines
+ call FCAT_eels_all(10)
+ read(11, '(a72)') (comment(k), k = 1, 2)
+
+ call FCAT_eels_all(11)
+ write(*,*) 'program eels (September 2020)'
+ call FCAT_eels_all(12)
+ write(*,'(a, f6.2, a, f5.1, a, f5.2, a, f5.2, a)') &
+ ' e0 = ', e0, ' eV, theta = ', theta, '°, phia = ', &
+ phia, '°, phib = ', phib, '°'
+ call FCAT_eels_all(13)
+ write(*,'(a, g11.4, a, g11.4, a, g11.4, a)') &
+ ' energy losses from', wmin, ' to', wmax, ', step = ', dw, ' cm**-1'
+ call FCAT_eels_all(14)
+ write(*,*) comment(1)
+ call FCAT_eels_all(15)
+ write(*,*) comment(2)
+
+ call FCAT_eels_all(16)
+ if (phia <= 0.0d0 .or. phib <= 0.0d0) then
+ call FCAT_eels_all(17)
+ call FCAT_eels_all_rep()
+ stop '*** wrong input ***'
+ call FCAT_eels_all(18)
+ endif
+ call FCAT_eels_all(19)
+ if (e0 <= 0.0d0 .or. theta + phia >= 90.0d0) then
+ call FCAT_eels_all(20)
+ call FCAT_eels_all_rep()
+ stop '*** bad input ***'
+ call FCAT_eels_all(21)
+ endif
+
+! *** read target specifications
+
+ call FCAT_eels_all(22)
+ read(11, *) layers, nper, mode
+ call FCAT_eels_all(23)
+ user = layers == 0
+ call FCAT_eels_all(24)
+ if (.not. user) then
+ call FCAT_eels_all(25)
+ neps = layers
+ call FCAT_eels_all(26)
+ if (nper == -1) then
+ call FCAT_eels_all(27)
+ neps = layers + 1
+ call FCAT_eels_all(28)
+ nper = 1
+ call FCAT_eels_all(29)
+ write(*,*) 'the substrate is a anisotropic uniaxial material'
+ call FCAT_eels_all(30)
+ endif
+ call FCAT_eels_all(31)
+ if (layers < 0 .or. nper < 1 .or. nper > layers) then
+ call FCAT_eels_all(32)
+ call FCAT_eels_all_rep()
+ stop '*** invalid target specifications ***'
+ call FCAT_eels_all(33)
+ endif
+ call FCAT_eels_all(34)
+ write(6, 101) layers, nper
+ call FCAT_eels_all(35)
+ jos = 0
+ call FCAT_eels_all(36)
+ allocate (name(neps), thick(neps), epsinf(neps), nos(neps))
+ call FCAT_eels_all(37)
+ do l = 1, neps
+ call FCAT_eels_all(38)
+ if (l <= layers) then
+ call FCAT_eels_all(39)
+ read(11, 102) name(l), thick(l)
+ call FCAT_eels_all(40)
+ endif
+ call FCAT_eels_all(41)
+ read(11, *) epsinf(l), nos(l)
+ call FCAT_eels_all(42)
+ write(6, 103)
+ call FCAT_eels_all(43)
+ if (nos(l) <= 0) then
+ call FCAT_eels_all(44)
+ if (l <= layers) write(6, 104) l, name(l), thick(l), epsinf(l)
+ call FCAT_eels_all(45)
+ if (l > layers) write(6, 105) epsinf(l)
+ else
+ call FCAT_eels_all(46)
+ call FCAT_eels_all(47)
+ do j = 1, nos(l)
+ call FCAT_eels_all(48)
+ if (.not. allocated(osc)) then
+ call FCAT_eels_all(49)
+ allocate(osc(3, nos(l)))
+ else if (j == 1) then
+ ! call extend3(osc, nos(j))
+ call FCAT_eels_all(50)
+ call FCAT_eels_all(51)
+ old_size_1 = size(osc, 1)
+ call FCAT_eels_all(52)
+ old_size_2 = size(osc, 2)
+ call FCAT_eels_all(53)
+ allocate(tmp_osc(old_size_1, old_size_2 + nos(l)))
+ call FCAT_eels_all(54)
+ tmp_osc(1:old_size_1, 1:old_size_2) = osc
+ call FCAT_eels_all(55)
+ deallocate(osc)
+ call FCAT_eels_all(56)
+ call move_alloc(tmp_osc, osc)
+ call FCAT_eels_all(57)
+ endif
+ call FCAT_eels_all(58)
+ jos = jos + 1
+ call FCAT_eels_all(59)
+ read(11, *) (osc(k, jos), k = 1, 3)
+ call FCAT_eels_all(60)
+ if ((j == nos(l) / 2 + 1) .and. (nos(l) > 1)) then
+ call FCAT_eels_all(61)
+ write(6, 106)
+ call FCAT_eels_all(62)
+ write(6, 107)
+ call FCAT_eels_all(63)
+ endif
+ call FCAT_eels_all(64)
+ if (j == 1) then
+ call FCAT_eels_all(65)
+ if (l <= layers) then
+ call FCAT_eels_all(66)
+ write(6, 104) l, name(l), thick(l), epsinf(l), (osc(i, jos), i = 1, 3)
+ else
+ call FCAT_eels_all(67)
+ call FCAT_eels_all(68)
+ write(6, 105) epsinf(l), (osc(i, jos), i = 1, 3)
+ call FCAT_eels_all(69)
+ endif
+ else
+ call FCAT_eels_all(70)
+ call FCAT_eels_all(71)
+ write(6, 108) (osc(i, jos), i = 1, 3)
+ call FCAT_eels_all(72)
+ endif
+ call FCAT_eels_all(73)
+ enddo
+ call FCAT_eels_all(74)
+ endif
+ call FCAT_eels_all(75)
+ enddo
+ call FCAT_eels_all(76)
+ write(*,*)
+ call FCAT_eels_all(77)
+ read(11, 102, IOSTAT = ioStatus) contrl
+ call FCAT_eels_all(78)
+ if (ioStatus /= 0) then
+ call FCAT_eels_all(79)
+ contrl = ''
+ call FCAT_eels_all(80)
+ endif
+ call FCAT_eels_all(81)
+ endif
+
+ call FCAT_eels_all(82)
+ close (unit = 11)
+
+ call FCAT_eels_all(83)
+ nw = 1 + int((wmax - wmin) / dw)
+ call FCAT_eels_all(84)
+ allocate (wn_array(nw), f(nw))
+
+ call FCAT_eels_all(85)
+ call doeels(e0, theta, phia, phib, wmin, wmax, dw, comment, size(comment), &
+ layers, neps, nper, name, size(name), thick, epsinf, nos, osc, size(osc, 2),&
+ contrl, mode, wn_array, f, size(wn_array))
+
+ call FCAT_eels_all(86)
+ open (unit = 12, file = 'eelsou')
+ call FCAT_eels_all(87)
+ write (12, 207) e0, theta, phia, phib, comment(1)
+ call FCAT_eels_all(88)
+ do i = 1, nw
+ call FCAT_eels_all(89)
+ write (12, 211) wn_array(i), f(i)
+ call FCAT_eels_all(90)
+ enddo
+ call FCAT_eels_all(91)
+ close (unit = 12)
+
+ call FCAT_eels_all(92)
+ call FCAT_eels_all_rep()
+ stop
+
+ call FCAT_eels_all(93)
+101 format(i3, ' layer(s), nper = ', i2//' l', 2x, 'material', 7x, &
+ 'thickness', 5x, 'epsinf', 4x, 'wto , wp', 5x, 'q', 7x, 'gam/wto')
+ call FCAT_eels_all(94)
+102 format(a10, d15.5)
+ call FCAT_eels_all(95)
+103 format(1x, 72('-'))
+ call FCAT_eels_all(96)
+104 format(1x, i3, 2x, a10, g15.3, f10.4, f12.4, f10.4, f9.4)
+ call FCAT_eels_all(97)
+105 format(31x, f10.4, f12.4, f10.4, f9.4)
+ call FCAT_eels_all(98)
+106 format(45x, 'wlo , wp', 5x, 'q', 7x, 'gam/wlo')
+ call FCAT_eels_all(99)
+107 format(45x, 28('-'))
+ call FCAT_eels_all(100)
+108 format(41x, f12.4, f10.4, f9.4)
+ call FCAT_eels_all(101)
+207 format('e0 =', f6.2, ' theta =', f5.1, ' phia =', f5.2, ' phib =', f5.2 / a72)
+ call FCAT_eels_all(102)
+211 format(2e15.7)
+ call FCAT_eels_all_rep()
+end program eels
+
+double precision function qrat(x, alpha, beta, c1, c2)
+
+ implicit none
+
+ double precision, intent(in) :: x, alpha, beta, c1, c2
+
+ call FCAT_eels_all(103)
+ qrat = (1.0d0 + x * (beta + c1 * x)) / ((1.0d0 + x * (beta + c2 * x)) * (1.0d0 + alpha * x)**2)
+
+ call FCAT_eels_all(104)
+ return
+ call FCAT_eels_all_rep()
+end function qrat
+
+double precision function usurlo(dq, wn)
+
+! ******************************************************************
+! * *
+! * user-supplied dielectric surface loss function aimag(g(dq, wn)) *
+! * input arguments : *
+! * dq : modulus of the two-dimensional surface wave vector *
+! * (angstroem**-1) *
+! * wn : frequency (cm**-1) *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+
+ call FCAT_eels_all(105)
+ usurlo = 1.0d0
+ call FCAT_eels_all(106)
+ return
+end function usurlo
+double precision function surlos(dk, eps, thick, layers, nper)
+
+! ******************************************************************
+! * *
+! * eels surface loss function for an arbitrary multilayered target*
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+
+ integer :: lmax
+ logical :: static, zero, skip
+ integer :: lstart, n
+ double precision, allocatable :: arg(:)
+ double precision :: argmin, argmax, cn, cnm1, epsmac, sn, snm1, tn
+ double complex :: a, b, csi, pnm2, pnm1, pn, pp, qnm2, qnm1, qn, qp, z
+
+ common / mulayr / argmin, argmax, epsmac
+
+ zero(z) = (dble(z) == 0.0d0) .and. (dimag(z) == 0.0d0)
+
+! write (*,*) 'surlos:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ call FCAT_eels_all(107)
+ lmax = size(eps)
+ call FCAT_eels_all(108)
+ allocate (arg(lmax))
+ call FCAT_eels_all(109)
+ lstart = layers - nper + 1
+ call FCAT_eels_all(110)
+ static = .true.
+ call FCAT_eels_all(111)
+ skip = .false.
+
+ call FCAT_eels_all(112)
+ do n = 1, layers
+ call FCAT_eels_all(113)
+ arg(n) = dk * thick(n)
+ call FCAT_eels_all(114)
+ if (arg(n) > argmax .or. zero(eps(n))) then
+ call FCAT_eels_all(115)
+ csi = eps(n)
+ call FCAT_eels_all(116)
+ skip = .true.
+ call FCAT_eels_all(117)
+ exit
+ call FCAT_eels_all(118)
+ endif
+ call FCAT_eels_all(119)
+ static = .not. (n >= lstart .and. arg(n) > argmin)
+ call FCAT_eels_all(120)
+ enddo
+
+ call FCAT_eels_all(121)
+ if (.not. skip) then
+! *** periodic continued fraction, period = nper
+
+ call FCAT_eels_all(122)
+ do ! Do loop is only for the option to skip out of it.
+ call FCAT_eels_all(123)
+ if (nper <= 1) then
+ call FCAT_eels_all(124)
+ csi = eps(layers)
+ else
+ call FCAT_eels_all(125)
+ call FCAT_eels_all(126)
+ if (static) then
+ call FCAT_eels_all(127)
+ pn = 0.0d0
+ call FCAT_eels_all(128)
+ qn = 0.0d0
+ call FCAT_eels_all(129)
+ do n = lstart, layers
+ call FCAT_eels_all(130)
+ pn = pn + thick(n) * eps(n)
+ call FCAT_eels_all(131)
+ qn = qn + thick(n) / eps(n)
+ call FCAT_eels_all(132)
+ enddo
+ call FCAT_eels_all(133)
+ if (zero(qn)) then
+ call FCAT_eels_all(134)
+ n = lstart
+ call FCAT_eels_all(135)
+ if (n <= 1) then
+ call FCAT_eels_all(136)
+ surlos = 0.0d0
+ call FCAT_eels_all(137)
+ return
+ call FCAT_eels_all(138)
+ endif
+ call FCAT_eels_all(139)
+ n = n - 1
+ call FCAT_eels_all(140)
+ csi = eps(n) / dtanh(arg(n))
+ call FCAT_eels_all(141)
+ exit
+ call FCAT_eels_all(142)
+ endif ! zero(qn)
+ call FCAT_eels_all(143)
+ csi = cdsqrt(pn / qn)
+ call FCAT_eels_all(144)
+ if ((dimag(csi) < 0.0d0) .and. (dble(qn) < 0.0d0)) then
+ call FCAT_eels_all(145)
+ csi = -csi
+ call FCAT_eels_all(146)
+ endif
+ else ! static
+ call FCAT_eels_all(147)
+ call FCAT_eels_all(148)
+ cn = dcosh(arg(lstart))
+ call FCAT_eels_all(149)
+ sn = dsinh(arg(lstart))
+ call FCAT_eels_all(150)
+ pnm1 = 1.0d0
+ call FCAT_eels_all(151)
+ pn = cn
+ call FCAT_eels_all(152)
+ pp = eps(lstart) * sn
+ call FCAT_eels_all(153)
+ qnm1 = 0.0d0
+ call FCAT_eels_all(154)
+ qn = sn / eps(lstart)
+ call FCAT_eels_all(155)
+ qp = pn
+ call FCAT_eels_all(156)
+ do n = lstart + 1, layers
+ call FCAT_eels_all(157)
+ cnm1 = cn
+ call FCAT_eels_all(158)
+ snm1 = sn
+ call FCAT_eels_all(159)
+ cn = dcosh(arg(n))
+ call FCAT_eels_all(160)
+ sn = dsinh(arg(n))
+ call FCAT_eels_all(161)
+ a = eps(n) * sn
+ call FCAT_eels_all(162)
+ pp = cn * pp + a * pn
+ call FCAT_eels_all(163)
+ qp = cn * qp + a * qn
+ call FCAT_eels_all(164)
+ b = (eps(n - 1) / eps(n)) * (sn / snm1)
+ call FCAT_eels_all(165)
+ a = cnm1 * b + cn
+ call FCAT_eels_all(166)
+ pnm2 = pnm1
+ call FCAT_eels_all(167)
+ pnm1 = pn
+ call FCAT_eels_all(168)
+ qnm2 = qnm1
+ call FCAT_eels_all(169)
+ qnm1 = qn
+ call FCAT_eels_all(170)
+ pn = a * pnm1 - b * pnm2
+ call FCAT_eels_all(171)
+ qn = a * qnm1 - b * qnm2
+ call FCAT_eels_all(172)
+ enddo
+ call FCAT_eels_all(173)
+ if (zero(qn)) then
+ call FCAT_eels_all(174)
+ a = qp - pn
+ call FCAT_eels_all(175)
+ if (zero(a)) then
+ call FCAT_eels_all(176)
+ n = lstart
+ call FCAT_eels_all(177)
+ if (n <= 1) then
+ call FCAT_eels_all(178)
+ surlos = 0.0d0
+ call FCAT_eels_all(179)
+ return
+ call FCAT_eels_all(180)
+ endif
+ call FCAT_eels_all(181)
+ n = n - 1
+ call FCAT_eels_all(182)
+ csi = eps(n) / dtanh(arg(n))
+ call FCAT_eels_all(183)
+ exit
+ call FCAT_eels_all(184)
+ endif
+ call FCAT_eels_all(185)
+ csi = pp / a
+ else
+ call FCAT_eels_all(186)
+ call FCAT_eels_all(187)
+ a = 0.5d0 * (pn - qp) / qn
+ call FCAT_eels_all(188)
+ b = cdsqrt(a**2 + pp / qn)
+ call FCAT_eels_all(189)
+ pn = a - pn / qn
+ call FCAT_eels_all(190)
+ if (cdabs(pn + b) > cdabs(pn - b)) then
+ call FCAT_eels_all(191)
+ b = -b
+ call FCAT_eels_all(192)
+ endif
+ call FCAT_eels_all(193)
+ csi = a + b
+ call FCAT_eels_all(194)
+ endif ! zero(qn)
+ call FCAT_eels_all(195)
+ endif ! static
+! *** small-dk limit of the periodic tail
+
+ call FCAT_eels_all(196)
+ endif ! nper <= 1
+
+ call FCAT_eels_all(197)
+ n = lstart
+
+ call FCAT_eels_all(198)
+ exit
+ call FCAT_eels_all(199)
+ enddo
+ call FCAT_eels_all(200)
+ endif ! .not. skip
+
+! *** backward algorithm
+
+ call FCAT_eels_all(201)
+ do
+ call FCAT_eels_all(202)
+ n = n - 1
+ call FCAT_eels_all(203)
+ if (n <= 0) then
+ call FCAT_eels_all(204)
+ a = csi + 1.0d0
+ call FCAT_eels_all(205)
+ if (zero(a)) then
+ call FCAT_eels_all(206)
+ surlos = 2 / epsmac
+ else
+ call FCAT_eels_all(207)
+ call FCAT_eels_all(208)
+ surlos = dimag(-2 / a)
+ call FCAT_eels_all(209)
+ endif
+ call FCAT_eels_all(210)
+ return
+ call FCAT_eels_all(211)
+ endif ! n <= 0
+
+ call FCAT_eels_all(212)
+ if (arg(n) /= 0.0d0) then
+ call FCAT_eels_all(213)
+ tn = dtanh(arg(n))
+ call FCAT_eels_all(214)
+ b = eps(n) + csi * tn
+ call FCAT_eels_all(215)
+ if (zero(b)) then
+ call FCAT_eels_all(216)
+ surlos = 0.0d0
+ call FCAT_eels_all(217)
+ return
+ call FCAT_eels_all(218)
+ endif
+ call FCAT_eels_all(219)
+ csi = eps(n) * (csi + tn * eps(n)) / b
+ call FCAT_eels_all(220)
+ endif
+ call FCAT_eels_all(221)
+ enddo
+end function surlos
+double precision function phint(phi, a, u)
+
+! ******************************************************************
+! * *
+! * evaluate the integral from zero to phi of *
+! * *
+! * u 2 *
+! * ( ----------------------------- ) dphi *
+! * 2 2 *
+! * (1 - a * u * cos(phi)) + u *
+! * *
+! * for 0 <= phi <= pi , u >= 0 and a >= 0 *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: phi
+ double precision, intent(in) :: a
+ double precision, intent(in) :: u
+
+ double precision :: ai, ar, bi, br, c, cpr, d, e, esr, pi, qr, ri, rm, root
+ double precision :: rp, rr, s, spr, tm, tp, u2, x, zeta, zetai, zetar, zr
+
+ call FCAT_eels_all(222)
+ pi = 3.141592653589793238d0
+ call FCAT_eels_all(223)
+ c = dcos(phi)
+ call FCAT_eels_all(224)
+ s = dsin(phi)
+ call FCAT_eels_all(225)
+ u2 = u**2
+ call FCAT_eels_all(226)
+ e = a*u
+ call FCAT_eels_all(227)
+ if (u < 1.0d0 .and. e < 1.0d-02 * (1.0d0 + u2)) then
+ call FCAT_eels_all(228)
+ zr = 1.0d0 + u2
+ call FCAT_eels_all(229)
+ esr = e / zr
+ call FCAT_eels_all(230)
+ phint = u2 / zr**2 * ((( (4.0d0 / 3.0d0) * (2.0d0 + c**2) * s * (5.0d0 - 3 * u2) * &
+ esr + (phi + c * s) * (5.0d0 - u2)) * esr + 4 * s) * esr + phi)
+ else
+ call FCAT_eels_all(231)
+ call FCAT_eels_all(232)
+ rm = dsqrt((1.0d0 - e)**2 + u2)
+ call FCAT_eels_all(233)
+ tm = 0.5d0 * datan2(u, 1.0d0 - e)
+ call FCAT_eels_all(234)
+ rp = dsqrt((1.0d0 + e)**2 + u2)
+ call FCAT_eels_all(235)
+ tp = 0.5d0 * datan2(u, 1.0d0 + e)
+ call FCAT_eels_all(236)
+ root = dsqrt(rm * rp)
+ call FCAT_eels_all(237)
+ cpr = dcos(tm + tp)
+ call FCAT_eels_all(238)
+ spr = dsin(tm + tp)
+ call FCAT_eels_all(239)
+ x = 0.0d0 ! ensure initialization
+ call FCAT_eels_all(240)
+ if (c >= 0.0d0) then
+ call FCAT_eels_all(241)
+ x = s / (1.0d0 + c)
+ elseif (dabs(s) > 1.0d-07) then
+ call FCAT_eels_all(242)
+ call FCAT_eels_all(243)
+ x = (1.0d0 - c) / s
+ call FCAT_eels_all(244)
+ endif
+ call FCAT_eels_all(245)
+ if ((c >= 0.0d0) .or. (dabs(s) > 1.0d-07)) then
+ call FCAT_eels_all(246)
+ zeta = dsqrt(rm / rp)
+ call FCAT_eels_all(247)
+ zetar = -zeta * dsin(tm - tp)
+ call FCAT_eels_all(248)
+ zetai = zeta * dcos(tm - tp)
+ call FCAT_eels_all(249)
+ br = 0.5d0 * dlog(((zetar + x)**2 + zetai**2) / ((zetar - x)**2 + zetai**2))
+ call FCAT_eels_all(250)
+ bi = datan2(zetai, zetar + x) - datan2(zetai, zetar - x)
+ call FCAT_eels_all(251)
+ rr = -(br * spr - bi * cpr) / root
+ call FCAT_eels_all(252)
+ ri = -(bi * spr + br * cpr) / root
+ call FCAT_eels_all(253)
+ d = e * s / ((1.0d0 - e * c)**2 + u2)
+ call FCAT_eels_all(254)
+ ar = d * (1.0d0 - e * c) - rr + u * ri
+ call FCAT_eels_all(255)
+ ai = -d * u - ri - u * rr
+ else
+ call FCAT_eels_all(256)
+ call FCAT_eels_all(257)
+ rr = -pi / root * cpr
+ call FCAT_eels_all(258)
+ ri = pi / root * spr
+ call FCAT_eels_all(259)
+ ar = -rr + u * ri
+ call FCAT_eels_all(260)
+ ai = -ri - u * rr
+ call FCAT_eels_all(261)
+ endif
+ call FCAT_eels_all(262)
+ qr = (ar * (cpr - spr) * (cpr + spr) + 2 * ai * cpr * spr) / (rm * rp)
+ call FCAT_eels_all(263)
+ phint = 0.5d0 * (ri / u - qr)
+ call FCAT_eels_all(264)
+ endif
+ call FCAT_eels_all(265)
+ return
+end function phint
+double precision function fint1(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from 0.0 to pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: acoef, bcoef, ccoef, cospsi, den, dif, dlimf, e, elleps
+ double precision :: pi, rom, rop, ru, sinpsi, sum, um, t
+ double precision :: tanpsi, wn, u2
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+ data pi / 3.141592653589793238d0 /
+
+! write (*,*) 'fint1:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ call FCAT_eels_all(266)
+ if (u == 0.0d0) then
+ call FCAT_eels_all(267)
+ fint1 = 0.0d0
+ call FCAT_eels_all(268)
+ return
+ call FCAT_eels_all(269)
+ endif
+ call FCAT_eels_all(270)
+ e = tanpsi * u
+ call FCAT_eels_all(271)
+ u2 = u**2
+ call FCAT_eels_all(272)
+ rom = (1.0d0 - e)**2 + u2
+ call FCAT_eels_all(273)
+ rop = (1.0d0 + e)**2 + u2
+ call FCAT_eels_all(274)
+ sum = rop + rom
+ call FCAT_eels_all(275)
+ rom = dsqrt(rom)
+ call FCAT_eels_all(276)
+ rop = dsqrt(rop)
+ call FCAT_eels_all(277)
+ dif = rop - rom
+ call FCAT_eels_all(278)
+ den = dsqrt((2.0d0 - dif) * (2.0d0 + dif)) * rop * rom
+ call FCAT_eels_all(279)
+ fint1 = pi * u2 * (4 * sum - dif**2 * (sum - rop * rom)) / den**3
+ call FCAT_eels_all(280)
+ if (rational) then
+ call FCAT_eels_all(281)
+ return
+ call FCAT_eels_all(282)
+ endif
+ call FCAT_eels_all(283)
+ if (user) then
+ call FCAT_eels_all(284)
+ fint1 = fint1 * usurlo(ru * u, wn)
+ else
+ call FCAT_eels_all(285)
+ call FCAT_eels_all(286)
+ fint1 = fint1 * surlos(ru * u, eps, thick, layers, nper)
+ call FCAT_eels_all(287)
+ if (dlimf > 0.0d0) then
+ call FCAT_eels_all(288)
+ t = ru * u * dlimf
+ call FCAT_eels_all(289)
+ fint1 = fint1 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ call FCAT_eels_all(290)
+ endif
+ call FCAT_eels_all(291)
+ endif
+ call FCAT_eels_all(292)
+ return
+end function fint1
+double precision function fint2(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from 0.0 to phi < pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: a, arg, b, b2, c, ccoef, cospsi, dlimf, elleps, phi
+ double precision :: phint, ru, sinpsi, um, t, tanpsi, wn, x
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / a, b, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'fint2:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ call FCAT_eels_all(293)
+ if (u == 0.0d0) then
+ call FCAT_eels_all(294)
+ fint2 = 0.0d0
+ call FCAT_eels_all(295)
+ return
+ call FCAT_eels_all(296)
+ endif
+ call FCAT_eels_all(297)
+ b2 = b**2
+ call FCAT_eels_all(298)
+ c = (1.0d0 - elleps) * (cospsi * u)**2 + (b - ccoef) * (b + ccoef)
+ call FCAT_eels_all(299)
+ if (dabs(a * c) > 1.0d-03 * b2) then
+ call FCAT_eels_all(300)
+ x = (b - dsqrt(b2 - a * c)) / a
+ else
+ call FCAT_eels_all(301)
+ call FCAT_eels_all(302)
+ x = a * c / b2
+ call FCAT_eels_all(303)
+ x = 0.5d0 * c * (1.d0 + 0.25d0 * x * (1.d0 + 0.5d0 * x * (1.d0 + 0.625d0 * x))) / b
+ call FCAT_eels_all(304)
+ endif
+ call FCAT_eels_all(305)
+ arg = x / u
+ call FCAT_eels_all(306)
+ if (dabs(arg) > 1.0d0) then
+ call FCAT_eels_all(307)
+ arg = dsign(1.0d0, arg)
+ call FCAT_eels_all(308)
+ endif
+ call FCAT_eels_all(309)
+ phi = dacos(arg)
+ call FCAT_eels_all(310)
+ fint2 = phint(phi, tanpsi, u)
+ call FCAT_eels_all(311)
+ if (rational) then
+ call FCAT_eels_all(312)
+ return
+ call FCAT_eels_all(313)
+ endif
+ call FCAT_eels_all(314)
+ if (user) then
+ call FCAT_eels_all(315)
+ fint2 = fint2 * usurlo(ru * u, wn)
+ else
+ call FCAT_eels_all(316)
+ call FCAT_eels_all(317)
+ fint2 = fint2 * surlos(ru * u, eps, thick, layers, nper)
+ call FCAT_eels_all(318)
+ if (dlimf > 0.0d0) then
+ call FCAT_eels_all(319)
+ t = ru * u * dlimf
+ call FCAT_eels_all(320)
+ fint2 = fint2 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ call FCAT_eels_all(321)
+ endif
+ call FCAT_eels_all(322)
+ endif
+ call FCAT_eels_all(323)
+ return
+end function fint2
+double precision function fint3(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from phi1 > 0 to phi2 < pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: a, arg, b, ccoef, cospsi, dlimf, elleps, phi1, phi2
+ double precision :: phint, sinpsi, rac, ru, um, t, tanpsi, wn
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / a, b, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'fint3:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ call FCAT_eels_all(324)
+ if (u == 0.0d0) then
+ call FCAT_eels_all(325)
+ fint3 = 0.0d0
+ call FCAT_eels_all(326)
+ return
+ call FCAT_eels_all(327)
+ endif
+ call FCAT_eels_all(328)
+ rac = dsign(1.0d0, a) * cospsi * dsqrt((1.0d0 - elleps) * a * (um - u) * (um + u))
+ call FCAT_eels_all(329)
+ arg = (b - rac) / (u * a)
+ call FCAT_eels_all(330)
+ if (dabs(arg) > 1.0d0) arg = dsign(1.0d0, arg)
+ call FCAT_eels_all(331)
+ phi2 = dacos(arg)
+ call FCAT_eels_all(332)
+ fint3 = phint(phi2, tanpsi, u)
+ call FCAT_eels_all(333)
+ arg = (b + rac) / (u * a)
+ call FCAT_eels_all(334)
+ if (dabs(arg) > 1.0d0) arg = dsign(1.0d0, arg)
+ call FCAT_eels_all(335)
+ phi1 = dacos(arg)
+ call FCAT_eels_all(336)
+ fint3 = fint3 - phint(phi1, tanpsi, u)
+ call FCAT_eels_all(337)
+ if (rational) return
+ call FCAT_eels_all(338)
+ if (user) then
+ call FCAT_eels_all(339)
+ fint3 = fint3 * usurlo(ru * u, wn)
+ else
+ call FCAT_eels_all(340)
+ call FCAT_eels_all(341)
+ fint3 = fint3 * surlos(ru * u, eps, thick, layers, nper)
+ call FCAT_eels_all(342)
+ if (dlimf > 0.0d0) then
+ call FCAT_eels_all(343)
+ t = ru * u * dlimf
+ call FCAT_eels_all(344)
+ fint3 = fint3 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ call FCAT_eels_all(345)
+ endif
+ call FCAT_eels_all(346)
+ endif
+ call FCAT_eels_all(347)
+ return
+end function fint3
+double precision function fun(phi)
+
+! ******************************************************************
+! * *
+! * integrand of the expression of the 1st order term in the *
+! * expansion of the eels integral for a homogeneous target. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: phi
+
+ logical :: user, rational
+ double precision :: acoef, bcoef, ccoef, cospsi, dlimf, elleps, ru
+ double precision :: sinphi, sinpsi, tanpsi, um, wn
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+ call FCAT_eels_all(348)
+ sinphi = dsin(phi)
+ call FCAT_eels_all(349)
+ fun = dsqrt((1.0d0 - elleps + elleps * sinphi**2) * &
+ (1.0d0 - sinpsi * sinphi) * &
+ (1.0d0 + sinpsi * sinphi))
+ call FCAT_eels_all(350)
+ return
+end function fun
+subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+
+! estimate the integral of fun(x) from a to b
+! to a user provided tolerance.
+! an automatic adaptive routine based on
+! the 8-panel newton-cotes rule (g. forsythe et al, 1977, p. 92)
+!
+! input ..
+!
+! fun the name of the integrand function subprogram fun(x).
+! a the lower limit of integration.
+! b the upper limit of integration.(b may be less than a.)
+! relerr a relative error tolerance. (should be non-negative)
+! abserr an absolute error tolerance. (should be non-negative)
+!
+! output ..
+!
+! result an approximation to the integral hopefully satisfying the
+! least stringent of the two error tolerances.
+! errest an estimate of the magnitude of the actual error.
+! nofun the number of function values used in calculation of result.
+! flag a reliability indicator. if flag is zero, then result
+! probably satisfies the error tolerance. if flag is
+! xxx.yyy , then xxx = the number of intervals which have
+! not converged and 0.yyy = the fraction of the interval
+! left to do when the limit on nofun was approached.
+
+ implicit none
+
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+
+ double precision :: w0, w1, w2, w3, w4, area, x0, f0, stone, step, cor11, temp
+ double precision :: qprev, qnow, qdiff, qleft, esterr, tolerr
+ double precision :: qright(31), f(16), x(16), fsave(8, 30), xsave(8, 30)
+ double precision :: dabs, dmax1
+
+ integer :: levmin, levmax, levout, nomax, nofin, lev, nim, i, j
+
+! *** stage 1 *** general initialization
+! set constants.
+
+! write (*,*) 'quanc8:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ call FCAT_eels_all(351)
+ levmin = 1
+ call FCAT_eels_all(352)
+ levmax = 30
+ call FCAT_eels_all(353)
+ levout = 6
+ call FCAT_eels_all(354)
+ nomax = 5000
+ call FCAT_eels_all(355)
+ nofin = nomax - 8 * (levmax - levout + 2**(levout + 1))
+
+! trouble when nofun reaches nofin
+
+ call FCAT_eels_all(356)
+ w0 = 3956.0d0 / 14175.0d0
+ call FCAT_eels_all(357)
+ w1 = 23552.0d0 / 14175.0d0
+ call FCAT_eels_all(358)
+ w2 = -3712.0d0 / 14175.0d0
+ call FCAT_eels_all(359)
+ w3 = 41984.0d0 / 14175.0d0
+ call FCAT_eels_all(360)
+ w4 = -18160.0d0 / 14175.0d0
+
+! initialize running sums to zero.
+
+ call FCAT_eels_all(361)
+ flag = 0.0d0
+ call FCAT_eels_all(362)
+ result = 0.0d0
+ call FCAT_eels_all(363)
+ cor11 = 0.0d0
+ call FCAT_eels_all(364)
+ errest = 0.0d0
+ call FCAT_eels_all(365)
+ area = 0.0d0
+ call FCAT_eels_all(366)
+ nofun = 0
+ call FCAT_eels_all(367)
+ if (a == b) return
+
+! *** stage 2 *** initialization for first interval
+
+ call FCAT_eels_all(368)
+ lev = 0
+ call FCAT_eels_all(369)
+ nim = 1
+ call FCAT_eels_all(370)
+ x0 = a
+ call FCAT_eels_all(371)
+ x(16) = b
+ call FCAT_eels_all(372)
+ qprev = 0.0d0
+ call FCAT_eels_all(373)
+ f0 = fun(x0, eps, thick, layers, nper, size(eps))
+ call FCAT_eels_all(374)
+ stone = (b - a) / 16
+ call FCAT_eels_all(375)
+ x(8) = (x0 + x(16)) / 2
+ call FCAT_eels_all(376)
+ x(4) = (x0 + x(8)) / 2
+ call FCAT_eels_all(377)
+ x(12) = (x(8) + x(16)) / 2
+ call FCAT_eels_all(378)
+ x(2) = (x0 + x(4)) / 2
+ call FCAT_eels_all(379)
+ x(6) = (x(4) + x(8)) / 2
+ call FCAT_eels_all(380)
+ x(10) = (x(8) + x(12)) / 2
+ call FCAT_eels_all(381)
+ x(14) = (x(12) + x(16)) / 2
+ call FCAT_eels_all(382)
+ do j = 2, 16, 2
+ call FCAT_eels_all(383)
+ f(j) = fun(x(j), eps, thick, layers, nper, size(eps))
+ call FCAT_eels_all(384)
+ enddo
+ call FCAT_eels_all(385)
+ nofun = 9
+
+ call FCAT_eels_all(386)
+ do
+
+! *** stage 3 *** central calculation
+! requires qprev, x0, x2, x4, ..., x16, f0, f2, f4, ..., f16.
+! calculates x1, x3, ...x15, f1, f3, ...f15, qleft, qright, qnow, qdiff, area.
+
+ call FCAT_eels_all(387)
+ x(1) = (x0 + x(2)) / 2
+ call FCAT_eels_all(388)
+ f(1) = fun(x(1), eps, thick, layers, nper, size(eps))
+ call FCAT_eels_all(389)
+ do j = 3, 15, 2
+ call FCAT_eels_all(390)
+ x(j) = (x(j - 1) + x(j + 1)) / 2
+ call FCAT_eels_all(391)
+ f(j) = fun(x(j), eps, thick, layers, nper, size(eps))
+ call FCAT_eels_all(392)
+ enddo
+ call FCAT_eels_all(393)
+ nofun = nofun + 8
+ call FCAT_eels_all(394)
+ step = (x(16) - x0) / 16.0d0
+ call FCAT_eels_all(395)
+ qleft = (w0 * (f0 + f(8)) + w1 * (f(1) + f(7)) + w2 * (f(2) + f(6)) &
+ + w3 * (f(3) + f(5)) + w4 * f(4)) * step
+ call FCAT_eels_all(396)
+ qright(lev + 1) = (w0 * (f(8) + f(16)) + w1 * (f(9) + f(15)) + w2 * (f(10) + f(14)) &
+ + w3 * (f(11) + f(13)) + w4 * f(12)) * step
+ call FCAT_eels_all(397)
+ qnow = qleft + qright(lev + 1)
+ call FCAT_eels_all(398)
+ qdiff = qnow - qprev
+ call FCAT_eels_all(399)
+ area = area + qdiff
+
+! *** stage 4 *** interval convergence test
+
+ call FCAT_eels_all(400)
+ esterr = dabs(qdiff) / 1023
+ call FCAT_eels_all(401)
+ tolerr = dmax1(abserr, relerr * dabs(area)) * (step / stone)
+
+ call FCAT_eels_all(402)
+ if (lev >= levmin) then
+ call FCAT_eels_all(403)
+ if (lev >= levmax) then
+! current level is levmax.
+ call FCAT_eels_all(404)
+ flag = flag + 1.0d0
+ else
+ call FCAT_eels_all(405)
+ call FCAT_eels_all(406)
+ if (nofun > nofin) then
+! *** stage 6 *** trouble section
+! number of function values is about to exceed limit.
+ call FCAT_eels_all(407)
+ nofin = 2 * nofin
+ call FCAT_eels_all(408)
+ levmax = levout
+ call FCAT_eels_all(409)
+ flag = flag + (b - x0) / (b - a)
+ else
+ call FCAT_eels_all(410)
+ call FCAT_eels_all(411)
+ if (esterr > tolerr) then
+! *** stage 5 *** no convergence
+! locate next interval.
+ call FCAT_eels_all(412)
+ nim = 2 * nim
+ call FCAT_eels_all(413)
+ lev = lev + 1
+! store right hand elements for future use.
+ call FCAT_eels_all(414)
+ do i = 1, 8
+ call FCAT_eels_all(415)
+ fsave(i, lev) = f(i + 8)
+ call FCAT_eels_all(416)
+ xsave(i, lev) = x(i + 8)
+ call FCAT_eels_all(417)
+ enddo
+! assemble left hand elements for immediate use.
+ call FCAT_eels_all(418)
+ qprev = qleft
+ call FCAT_eels_all(419)
+ do i = 1, 8
+ call FCAT_eels_all(420)
+ f(18 - 2 * i) = f(9 - i)
+ call FCAT_eels_all(421)
+ x(18 - 2 * i) = x(9 - i)
+ call FCAT_eels_all(422)
+ enddo
+ call FCAT_eels_all(423)
+ cycle
+ call FCAT_eels_all(424)
+ endif
+ call FCAT_eels_all(425)
+ endif
+ call FCAT_eels_all(426)
+ endif
+
+! *** stage 7 *** interval converged
+! add contributions into running sums.
+ call FCAT_eels_all(427)
+ result = result + qnow
+ call FCAT_eels_all(428)
+ errest = errest + esterr
+ call FCAT_eels_all(429)
+ cor11 = cor11 + qdiff / 1023
+! locate next interval.
+ call FCAT_eels_all(430)
+ do while (nim /= 2 * (nim / 2))
+ call FCAT_eels_all(431)
+ nim = nim / 2
+ call FCAT_eels_all(432)
+ lev = lev - 1
+ call FCAT_eels_all(433)
+ enddo
+ call FCAT_eels_all(434)
+ nim = nim + 1
+
+ call FCAT_eels_all(435)
+ if (lev <= 0) exit
+
+! assemble elements required for the next interval.
+ call FCAT_eels_all(436)
+ qprev = qright(lev)
+ call FCAT_eels_all(437)
+ x0 = x(16)
+ call FCAT_eels_all(438)
+ f0 = f(16)
+ call FCAT_eels_all(439)
+ do i = 1, 8
+ call FCAT_eels_all(440)
+ f(2*i) = fsave(i, lev)
+ call FCAT_eels_all(441)
+ x(2*i) = xsave(i, lev)
+ call FCAT_eels_all(442)
+ enddo
+ call FCAT_eels_all(443)
+ cycle
+ else
+! *** stage 5 *** no convergence
+! locate next interval.
+ call FCAT_eels_all(444)
+ call FCAT_eels_all(445)
+ nim = 2 * nim
+ call FCAT_eels_all(446)
+ lev = lev + 1
+! store right hand elements for future use.
+ call FCAT_eels_all(447)
+ do i = 1, 8
+ call FCAT_eels_all(448)
+ fsave(i, lev) = f(i + 8)
+ call FCAT_eels_all(449)
+ xsave(i, lev) = x(i + 8)
+ call FCAT_eels_all(450)
+ enddo
+! assemble left hand elements for immediate use.
+ call FCAT_eels_all(451)
+ qprev = qleft
+ call FCAT_eels_all(452)
+ do i = 1, 8
+ call FCAT_eels_all(453)
+ f(18 - 2 * i) = f(9 - i)
+ call FCAT_eels_all(454)
+ x(18 - 2 * i) = x(9 - i)
+ call FCAT_eels_all(455)
+ enddo
+ call FCAT_eels_all(456)
+ endif
+
+ call FCAT_eels_all(457)
+ enddo
+
+ ! *** stage 8 *** finalize and return
+ call FCAT_eels_all(458)
+ result = result + cor11
+
+! make sure errest not less than roundoff level.
+ call FCAT_eels_all(459)
+ if (errest /= 0.0d0) then
+ call FCAT_eels_all(460)
+ temp = dabs(result) + errest
+ call FCAT_eels_all(461)
+ do while (temp == dabs(result))
+ call FCAT_eels_all(462)
+ errest = 2 * errest
+ call FCAT_eels_all(463)
+ temp = dabs(result) + errest
+ call FCAT_eels_all(464)
+ enddo
+ call FCAT_eels_all(465)
+ endif
+ call FCAT_eels_all(466)
+ return
+end subroutine quanc8
+subroutine queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+
+! ******************************************************************
+! * *
+! * perform q-space integration for computing the eels spectrum of *
+! * a isotropic target using polar coordinates. *
+! * *
+! * x is the dimensionless energy loss hbar*omega/(2*e0*phia) *
+! * aerr and rerr are the desired absolute and relative accuracies *
+! * facru*x is the units of wavevectors omega/v_perpendicular *
+! * f is the q-integral multiplied by (2/pi)**2 *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: x
+ double precision, intent(out) :: f
+ double precision, intent(in out) :: aerr
+ double precision, intent(in out) :: rerr
+ double precision, intent(in) :: facru
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+
+ logical :: rational, user
+ double precision :: acoef, bcoef, ccoef, cospsi, dlimf, elleps
+ double precision :: error, flag, ru, sinpsi
+ double precision :: u1, u2, um, ut, tanpsi, wn, y
+ integer :: ie, nofu
+ dimension error(3), flag(3)
+
+ interface
+ double precision function fint1(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint1
+ double precision function fint2(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint2
+ double precision function fint3(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint3
+ subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+ end subroutine quanc8
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'queels:'
+! write (*,*) 'eps: ', size(eps)
+! write (*,*) 'thick: ', size(thick)
+
+ call FCAT_eels_all(467)
+ f = 0.0d0
+ call FCAT_eels_all(468)
+ if (x <= 0.0d0) then
+ call FCAT_eels_all(469)
+ return
+ call FCAT_eels_all(470)
+ endif
+ call FCAT_eels_all(471)
+ ru = facru * x
+ call FCAT_eels_all(472)
+ ccoef = cospsi**2 / x
+ call FCAT_eels_all(473)
+ ut = ccoef - bcoef
+ call FCAT_eels_all(474)
+ u1 = dabs(ut)
+ call FCAT_eels_all(475)
+ u2 = ccoef + bcoef
+ call FCAT_eels_all(476)
+ if (ut > 0.0d0) then
+ call FCAT_eels_all(477)
+ call quanc8(fint1, 0.0d0, u1, aerr, rerr, y, error(1), nofu, flag(1), eps, thick, layers, nper)
+ call FCAT_eels_all(478)
+ f = y
+ else
+ call FCAT_eels_all(479)
+ call FCAT_eels_all(480)
+ flag(1) = 0.0d0
+ call FCAT_eels_all(481)
+ endif
+ call FCAT_eels_all(482)
+ if (u2 > u1) then
+ call FCAT_eels_all(483)
+ call quanc8(fint2, u1, u2, aerr, rerr, y, error(2), nofu, flag(2), eps, thick, layers, nper)
+ call FCAT_eels_all(484)
+ f = f + y
+ else
+ call FCAT_eels_all(485)
+ call FCAT_eels_all(486)
+ flag(2) = 0.0d0
+ call FCAT_eels_all(487)
+ endif
+ call FCAT_eels_all(488)
+ if (dabs(acoef) > x * (1.0d0 - elleps) * bcoef) then
+ call FCAT_eels_all(489)
+ um = dsqrt(ccoef / x / (1.0d0 - elleps) + bcoef**2 / acoef)
+ call FCAT_eels_all(490)
+ if (um > u2) then
+ call FCAT_eels_all(491)
+ call quanc8(fint3, u2, um, aerr, rerr, y, error(3), nofu, flag(3), eps, thick, layers, nper)
+ call FCAT_eels_all(492)
+ f = f + y
+ call FCAT_eels_all(493)
+ endif
+ call FCAT_eels_all(494)
+ if (um < u1) then
+ call FCAT_eels_all(495)
+ call quanc8(fint3, um, u1, aerr, rerr, y, error(3), nofu, flag(3), eps, thick, layers, nper)
+ call FCAT_eels_all(496)
+ f = f - y
+ call FCAT_eels_all(497)
+ endif
+ else
+ call FCAT_eels_all(498)
+ call FCAT_eels_all(499)
+ flag(3) = 0.0d0
+ call FCAT_eels_all(500)
+ endif
+ call FCAT_eels_all(501)
+ do ie = 1, 3
+ call FCAT_eels_all(502)
+ if (flag(ie) == 0.0d0) cycle
+ call FCAT_eels_all(503)
+ write(*,*) ' +++ flag(', ie, ') =', flag(ie), ', error =', error(ie), ' +++'
+ call FCAT_eels_all(504)
+ if (flag(ie) - aint(flag(ie)) > 0.5d-02) then
+ call FCAT_eels_all(505)
+ call FCAT_eels_all_rep()
+ stop '*** execution aborted ***'
+ call FCAT_eels_all(506)
+ endif
+ call FCAT_eels_all(507)
+ enddo
+ call FCAT_eels_all(508)
+ f = (2 / 3.141592653589793238d0)**2 * f
+ call FCAT_eels_all(509)
+ return
+end subroutine queels
+subroutine seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+
+! ******************************************************************
+! * *
+! * set up long-wavelength dielectric functions of the layers for *
+! * the present frequency wn (in cm**-1) *
+! * *
+! ******************************************************************
+
+ implicit none
+ integer, intent(in) :: neps
+ integer, intent(in) :: nos(:)
+ double precision, intent(in) :: osc(:, :)
+ double precision, intent(in) :: epsinf(:)
+ double precision, intent(in) :: wn
+ character (len=10), intent(in) :: name(:)
+ character (len=10), intent(in) :: mode
+
+ double complex, intent(in out) :: eps(:)
+ integer, intent(in) :: layers
+
+ double precision :: argmin, argmax, epsmac, x
+ double complex :: deno, nomi
+ integer :: j, k, l, m
+
+ common / mulayr / argmin, argmax, epsmac
+
+! write (*,*) 'seteps:'
+! write (*,*) 'nos: ', size(nos)
+! write (*,*) 'osc: ', size(osc)
+! write (*,*) 'epsinf: ', size(epsinf)
+! write (*,*) 'name: ', size(name)
+! write (*,*) 'eps: ', size(eps)
+! write (*,*) 'thick: ', size(thick)
+
+ call FCAT_eels_all(510)
+ j = 0
+ call FCAT_eels_all(511)
+ do l = 1, neps
+ call FCAT_eels_all(512)
+ m = nos(l)/2
+ call FCAT_eels_all(513)
+ nomi = dcmplx(1.0d0, 0.0d0)
+ call FCAT_eels_all(514)
+ deno = dcmplx(1.0d0, 0.0d0)
+ call FCAT_eels_all(515)
+ if (mode == 'kurosawa') then
+ call FCAT_eels_all(516)
+ do k = 1, m
+ call FCAT_eels_all(517)
+ j = j + 1
+! since osc(1,*) and wn are real, the following should be equivalent
+! Check required.
+! Furthermore the first term can be rewritten as
+! (osc(1, j + m) - wn) * (osc(1, j + m) + wn)
+! nomi = nomi * cmplx(osc(1, j + m)**2 - wn**2, - wn * osc(3, j + m))
+ call FCAT_eels_all(518)
+ nomi = nomi * (osc(1, j + m)**2 - wn**2 - dcmplx(0.0d0, wn * osc(3, j + m)))
+ call FCAT_eels_all(519)
+ deno = deno * (osc(1, j )**2 - wn**2 - dcmplx(0.0d0, wn * osc(3, j )))
+ call FCAT_eels_all(520)
+ enddo
+ call FCAT_eels_all(521)
+ eps(l) = epsinf(l) * nomi / deno
+ elseif (name(l) == 'metal') then
+ call FCAT_eels_all(522)
+ call FCAT_eels_all(523)
+ j = j + 1
+! suggestion for replacement
+! eps(l) = -osc(1, j)**2 / cmplx(wn**2, wn * osc(3, j))
+ call FCAT_eels_all(524)
+ eps(l) = -osc(1, j)**2 / ( wn**2 + dcmplx(0.0d0, wn * osc(3, j)) )
+ else
+ call FCAT_eels_all(525)
+ call FCAT_eels_all(526)
+ eps(l) = epsinf(l)
+! The original version had this additional loop. It seems, it has been removed
+! because all cases of nos(l) > 1 are treated in case 1 above
+ call FCAT_eels_all(527)
+ do k = 1, nos(l)
+ call FCAT_eels_all(528)
+ j = j + 1
+ call FCAT_eels_all(529)
+ x = wn / osc(1, j)
+ call FCAT_eels_all(530)
+ deno = x * dcmplx(x, osc(3, j))
+ call FCAT_eels_all(531)
+ if (osc(2, j) >= 0.0d0) then
+ call FCAT_eels_all(532)
+ deno = 1.0d0 - deno
+ call FCAT_eels_all(533)
+ endif
+ call FCAT_eels_all(534)
+ if (cdabs(deno) == 0.0d0) then
+ call FCAT_eels_all(535)
+ deno = epsmac
+ call FCAT_eels_all(536)
+ endif
+ call FCAT_eels_all(537)
+ eps(l) = eps(l) + osc(2, j) / deno
+ call FCAT_eels_all(538)
+ enddo
+ call FCAT_eels_all(539)
+ endif
+ call FCAT_eels_all(540)
+ enddo
+ call FCAT_eels_all(541)
+ if (neps == layers + 1) then
+! the substrate is a anisotropic uniaxial material
+ call FCAT_eels_all(542)
+ eps(layers) = cdsqrt(eps(layers) * eps(layers + 1))
+ call FCAT_eels_all(543)
+ if (dimag(eps(layers)) < 0.0d0) then
+ call FCAT_eels_all(544)
+ eps(layers) = -eps(layers)
+ call FCAT_eels_all(545)
+ endif
+ call FCAT_eels_all(546)
+ endif
+ call FCAT_eels_all(547)
+ return
+end subroutine seteps
+subroutine doeels (e0, theta, phia, phib, wmin, wmax, dw, comment, comment_size, &
+ layers, neps, nper, name, name_size, thick, epsinf, nos, osc, osc_size,&
+ contrl, mode, wn_array, f_array, wn_array_size)
+
+! ******************************************************************
+! * *
+! * compute the classical eels spectrum of an arbitrary plane- *
+! * statified medium made from isotropic materials in specular *
+! * geometry using the dielectric theory of eels. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ integer, parameter :: nt = 5
+
+ double precision, intent(in) :: e0, theta, phia, phib, wmin, wmax, dw
+ character (len = 72) :: comment(comment_size)
+ character (len = 10) :: name(name_size)
+ double precision, intent(in) :: thick(name_size), epsinf(name_size), osc(3, osc_size)
+ character (len = 10) :: contrl, mode
+ integer, intent(in) :: comment_size, name_size, osc_size, wn_array_size
+ integer, intent(in out) :: layers, nper, nos(name_size)
+ double precision, intent(in out) :: wn_array(wn_array_size), f_array(wn_array_size)
+
+ logical :: rational, user, debug
+ integer :: i, iw, neps, nofu, nout, nw, lmax
+ double precision :: a, acoef, aerr, alpha, argmin, argmax, b, bcoef, beta, &
+ c1, c2, ccoef, cospsi, dlimf, dx, elleps, ener, epsmac, facru, f, f0, &
+ f1, fpic, fun, pi, prefac, psia, psii, qrat, rerr, ru, sinpsi, t, &
+ tanpsi, table, um, widt, wn, wpic, x, xmin, xmax, z, z1, z2
+ double complex, allocatable :: eps(:)
+ dimension table(nt)
+
+ external fun, qrat
+
+ interface
+ subroutine queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ double precision, intent(in) :: x
+ double precision, intent(out) :: f
+ double precision, intent(in out) :: aerr
+ double precision, intent(in out) :: rerr
+ double precision, intent(in) :: facru
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end subroutine queels
+ subroutine seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+ integer, intent(in) :: neps
+ integer, intent(in) :: nos(:)
+ double precision, intent(in) :: osc(:, :)
+ double precision, intent(in) :: epsinf(:)
+ double precision, intent(in) :: wn
+ character (len=10), intent(in) :: name(:)
+ character (len=10), intent(in) :: mode
+ double complex, intent(in out) :: eps(:)
+ integer, intent(in) :: layers
+ end subroutine seteps
+ subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+ end subroutine quanc8
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+ common / mulayr / argmin, argmax, epsmac
+
+ data aerr / 0.0d0 /, rerr / 1.0d-06 /, f / 0.0d0 /, f1 / 0.0d0 /
+
+ call FCAT_eels_all(548)
+ debug = .false.
+ call FCAT_eels_all(549)
+ if (debug) then
+ call FCAT_eels_all(550)
+ write (*,*) 'doeels:'
+ call FCAT_eels_all(551)
+ write (*,*) 'comment: ', size(comment)
+ call FCAT_eels_all(552)
+ write (*,*) 'name: ', size(name)
+ call FCAT_eels_all(553)
+ write (*,*) 'thick: ', size(thick)
+ call FCAT_eels_all(554)
+ write (*,*) 'epsinf: ', size(epsinf)
+ call FCAT_eels_all(555)
+ write (*,*) 'osc: ', size(osc), size(osc, 1), size(osc, 2)
+ call FCAT_eels_all(556)
+ write (*,*) 'nos: ', size(nos)
+ call FCAT_eels_all(557)
+ write (*,*) 'wn_array: ', size(wn_array)
+ call FCAT_eels_all(558)
+ write (*,*) 'f_array: ', size(f_array)
+ call FCAT_eels_all(559)
+ endif
+
+! *** machine-dependent constants
+! *** epsmac + 1.0 = epsmac , cosh(argmin) = 1.0 , tanh(argmax) = 1.0
+
+ call FCAT_eels_all(560)
+ pi = 4 * datan(1.0d0)
+ call FCAT_eels_all(561)
+ epsmac = 1.0d0
+ call FCAT_eels_all(562)
+ do while (1.0d0 + epsmac > 1.0d0)
+ call FCAT_eels_all(563)
+ epsmac = epsmac / 2
+ call FCAT_eels_all(564)
+ enddo
+ call FCAT_eels_all(565)
+ argmin = dsqrt(2 * epsmac)
+ call FCAT_eels_all(566)
+ argmax = 0.5d0 * dlog(2 / epsmac)
+
+ call FCAT_eels_all(567)
+ dlimf = 0.0d0
+ call FCAT_eels_all(568)
+ rational = .false.
+
+! *** read target specifications
+
+ call FCAT_eels_all(569)
+ user = layers == 0
+ call FCAT_eels_all(570)
+ if (user) then
+
+ call FCAT_eels_all(571)
+ if (layers == 1) rational = .true.
+ call FCAT_eels_all(572)
+ if (contrl == 'image') then
+! *** image-charge screening factor
+ call FCAT_eels_all(573)
+ if (layers == 1 .and. neps == 2) then
+ call FCAT_eels_all(574)
+ dlimf = dsqrt(epsinf(1) * epsinf(2))
+ else
+ call FCAT_eels_all(575)
+ call FCAT_eels_all(576)
+ dlimf = epsinf(1)
+ call FCAT_eels_all(577)
+ endif
+ call FCAT_eels_all(578)
+ dlimf = (dlimf - 1.0d0) / (dlimf + 1.0d0)
+ call FCAT_eels_all(579)
+ endif
+ call FCAT_eels_all(580)
+ endif
+
+! *** initialize constants
+
+ call FCAT_eels_all(581)
+ lmax = size(thick)
+ call FCAT_eels_all(582)
+ nw = size(wn_array)
+ call FCAT_eels_all(583)
+ if (debug) write (*,*) 'lmax: ', lmax
+ call FCAT_eels_all(584)
+ allocate(eps(lmax))
+ call FCAT_eels_all(585)
+ if (debug) write (*,*) 'eps: ', size(eps)
+ call FCAT_eels_all(586)
+ nout = 1 + nw / 20
+ call FCAT_eels_all(587)
+ ener = 8065 * e0
+ call FCAT_eels_all(588)
+ psia = phia / 180 * pi
+ call FCAT_eels_all(589)
+ psii = theta / 180 * pi
+ call FCAT_eels_all(590)
+ cospsi = dcos(psii)
+ call FCAT_eels_all(591)
+ sinpsi = dsin(psii)
+ call FCAT_eels_all(592)
+ tanpsi = dtan(psii)
+ call FCAT_eels_all(593)
+ prefac = dsqrt(255500 / e0)/(137 * cospsi)
+ call FCAT_eels_all(594)
+ facru = psia / cospsi * dsqrt(0.2624664d0 * e0)
+ call FCAT_eels_all(595)
+ elleps = (1.0d0 - phia / phib) * (1.0d0 + phia / phib)
+ call FCAT_eels_all(596)
+ acoef = sinpsi**2 + elleps * cospsi**2
+ call FCAT_eels_all(597)
+ bcoef = sinpsi * cospsi
+ call FCAT_eels_all(598)
+ if (dlimf > 0.0d0) then
+ call FCAT_eels_all(599)
+ rational = .false.
+ call FCAT_eels_all(600)
+ if (debug) write(*,*) ' = > electron attracted by an image charge = ', dlimf
+! *** dlimf : half the length unit imposed by the image force
+ call FCAT_eels_all(601)
+ dlimf = 1.80d0 * dlimf/(e0 * cospsi**2)
+ call FCAT_eels_all(602)
+ endif
+ call FCAT_eels_all(603)
+ if (debug) write (*,*) 'rational: ', rational
+ call FCAT_eels_all(604)
+ if (rational) then
+
+! *** set up coefficients for the rational approximation to the integral
+
+ call FCAT_eels_all(605)
+ if (debug) write(*,*) ' = > set up a rational approximation to the integral'
+ call FCAT_eels_all(606)
+ call quanc8(fun, 0.0d0, pi / 2, aerr, rerr, alpha, c1, nofu, c2, eps, thick, layers, nper)
+ call FCAT_eels_all(607)
+ alpha = (2 / pi)**2 * alpha
+ call FCAT_eels_all(608)
+ c1 = 2 / pi / dsqrt(1.0d0 - elleps) * sinpsi * alpha**2
+ call FCAT_eels_all(609)
+ if (c1 > 0.99d0) then
+ call FCAT_eels_all(610)
+ if (debug) write(*,*) ' ===> cannot do it'
+ call FCAT_eels_all(611)
+ rational = .false.
+ else
+ call FCAT_eels_all(612)
+ call FCAT_eels_all(613)
+ c2 = 3 * alpha**2 / (1.0d0 - c1)
+ call FCAT_eels_all(614)
+ c1 = c1 * c2
+ call FCAT_eels_all(615)
+ xmin = wmin / (2 * ener * psia)
+ call FCAT_eels_all(616)
+ xmax = wmax / (2 * ener * psia)
+ call FCAT_eels_all(617)
+ if (xmin <= 0.0d0) xmin = 0.0d0
+ call FCAT_eels_all(618)
+ dx = dmax1(0.02d0, (xmax - xmin) / nt)
+ call FCAT_eels_all(619)
+ z1 = 0.0d0
+ call FCAT_eels_all(620)
+ z2 = 0.0d0
+ call FCAT_eels_all(621)
+ do i = 1, nt
+ call FCAT_eels_all(622)
+ x = xmin + i * dx
+ call FCAT_eels_all(623)
+ call queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ call FCAT_eels_all(624)
+ table(i) = f
+ call FCAT_eels_all(625)
+ f = f * (1.0d0 + alpha * x)**2
+ call FCAT_eels_all(626)
+ if (dabs(c2 * f - c1) < c2 * rerr) cycle
+ call FCAT_eels_all(627)
+ z = (1.0d0 - f) / (c2 * f - c1)
+ call FCAT_eels_all(628)
+ if (z <= 0.0d0) cycle
+ call FCAT_eels_all(629)
+ z1 = z1 + x * z * (x**2 - z)
+ call FCAT_eels_all(630)
+ z2 = z2 + (x * z)**2
+ call FCAT_eels_all(631)
+ enddo
+ call FCAT_eels_all(632)
+ if (z2 == 0.0d0) then
+ call FCAT_eels_all(633)
+ if (debug) write(*,*) ' ===> cannot do it'
+ call FCAT_eels_all(634)
+ rational = .false.
+ else
+ call FCAT_eels_all(635)
+ call FCAT_eels_all(636)
+ beta = z1 / z2
+ call FCAT_eels_all(637)
+ z = 0.0d0
+ call FCAT_eels_all(638)
+ do i = 1, nt
+ call FCAT_eels_all(639)
+ x = xmin + i * dx
+ call FCAT_eels_all(640)
+ z = z + (table(i) - qrat(x, alpha, beta, c1, c2))**2
+ call FCAT_eels_all(641)
+ enddo
+ call FCAT_eels_all(642)
+ z = dsqrt(z) / nt
+ call FCAT_eels_all(643)
+ if (z > 5.0d-03) then
+ call FCAT_eels_all(644)
+ if (debug) write(*,*) ' ===> cannot do it'
+ call FCAT_eels_all(645)
+ rational = .false.
+ else
+ call FCAT_eels_all(646)
+ call FCAT_eels_all(647)
+ if (debug) write(*, 100) alpha, c1, c2, beta, z
+ call FCAT_eels_all(648)
+ endif ! z > 5.0d-03
+ call FCAT_eels_all(649)
+ endif ! z2 == 0.0d0
+ call FCAT_eels_all(650)
+ endif ! c1 > 0.99d0
+ call FCAT_eels_all(651)
+ endif ! rational
+
+! *** loop over the energy losses
+
+ call FCAT_eels_all(652)
+ if (debug) write(*, 110)
+ call FCAT_eels_all(653)
+ do iw = 1, nw
+ call FCAT_eels_all(654)
+ f0 = f1
+ call FCAT_eels_all(655)
+ f1 = f
+ call FCAT_eels_all(656)
+ f = 0.0d0
+ call FCAT_eels_all(657)
+ wn = wmin + (iw - 1) * dw
+! if (debug) write (*,*) 'wn: ', wn
+ call FCAT_eels_all(658)
+ if (wn >= 0.0d0) then
+ call FCAT_eels_all(659)
+ if (wn /= 0.0d0) then
+ call FCAT_eels_all(660)
+ if (.not. user) call seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+
+ call FCAT_eels_all(661)
+ x = wn / (2 * ener * psia)
+ call FCAT_eels_all(662)
+ if (rational) then
+ call FCAT_eels_all(663)
+ f = qrat(x, alpha, beta, c1, c2) * dimag(-2 / (1.0d0 + eps(1)))
+ else
+ call FCAT_eels_all(664)
+ call FCAT_eels_all(665)
+ call queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ call FCAT_eels_all(666)
+ endif
+ call FCAT_eels_all(667)
+ f = prefac * f / wn
+ call FCAT_eels_all(668)
+ endif ! wn /= 0.0d0
+
+ call FCAT_eels_all(669)
+ wn_array(iw) = wn
+ call FCAT_eels_all(670)
+ f_array(iw) = f
+
+! *** localize a peak using a parabolic interpolation
+
+ call FCAT_eels_all(671)
+ if ((iw >= 3) .and. (f1 - f0 > aerr) .and. (f1 - f > aerr)) then
+ call FCAT_eels_all(672)
+ a = (f1 - f0) + (f1 - f)
+ call FCAT_eels_all(673)
+ if (a > 4 * rerr * f1) then
+ call FCAT_eels_all(674)
+ b = 0.5d0 * (f1 - f0 + 3 * (f1 - f))
+ call FCAT_eels_all(675)
+ t = b / a
+ call FCAT_eels_all(676)
+ wpic = wn - t * dw
+ call FCAT_eels_all(677)
+ fpic = f + 0.5d0 * b * t
+ call FCAT_eels_all(678)
+ widt = dsqrt(8 * fpic / a) * dw
+ call FCAT_eels_all(679)
+ if (debug) write(*, 120) wpic, fpic, widt
+ call FCAT_eels_all(680)
+ endif ! a > 4 * rerr * f1
+ call FCAT_eels_all(681)
+ endif ! iw >= 3 ...
+ call FCAT_eels_all(682)
+ endif ! wn >= 0.0d0
+ call FCAT_eels_all(683)
+ if (mod(iw, nout) == 0) then
+ call FCAT_eels_all(684)
+ if (debug) write(*, 130) 100 * iw / nw, wn, f
+ call FCAT_eels_all(685)
+ endif
+ call FCAT_eels_all(686)
+ enddo
+ call FCAT_eels_all(687)
+ return
+ call FCAT_eels_all(688)
+100 format(5x, 'alpha = ', f9.4, 4x, 'c1 = ', f9.4, 4x, 'c2 = ', f9.4, 4x, &
+ 'beta = ', f9.4/5x, 'accuracy = ', e9.2)
+ call FCAT_eels_all(689)
+110 format(//' run (%) wn (cm**-1) pcl(wn) (cm) |', &
+ ' peak location amplitude width')
+ call FCAT_eels_all(690)
+120 format(40x, f10.2, d12.4, f10.2)
+ call FCAT_eels_all(691)
+130 format(2x, f5.1, 3x, f11.3, d14.5)
+end subroutine doeels
+subroutine change_working_dir()
+
+! This routine gets the first argument of the commandline and takes it
+! as the path to change the working directory
+! used intrinsic routines:
+! iarg returns the number of commandline arguments without the program cname.
+! chdir changes the directory and returns 0 on success.
+! trim removes blanks from strings.
+
+ character (len = 256) :: argument
+ integer :: status
+
+ call FCAT_eels_all(692)
+ if (iargc() == 1) then
+ call FCAT_eels_all(693)
+ call getarg(1, argument)
+ call FCAT_eels_all(694)
+ status = chdir(trim(argument))
+ call FCAT_eels_all(695)
+ if (status /= 0) then
+ call FCAT_eels_all(696)
+ write (*,*) '*** change directory failed ***'
+ call FCAT_eels_all(697)
+ write (*,*) 'directory tried: ', trim(argument)
+ call FCAT_eels_all(698)
+ write (*,*) 'error code (see: man chdir): ', status
+ call FCAT_eels_all(699)
+ write (*,*) 'continuing in the start directory'
+ call FCAT_eels_all(700)
+ end if
+ call FCAT_eels_all(701)
+ end if
+
+ call FCAT_eels_all(702)
+ return
+end subroutine change_working_dir
+ module FCAT_eels_all_mod
+ double precision,dimension (703):: &
+ & FCAT_eels_all_counter = 0
+ integer :: FCAT_eels_all_nline = 702
+ end module FCAT_eels_all_mod
+ subroutine FCAT_eels_all(n)
+ use FCAT_eels_all_mod
+ integer :: n
+ FCAT_eels_all_counter(n) = &
+ & FCAT_eels_all_counter(n) + 1
+ if (FCAT_eels_all_counter(n) == 1) then
+ write(*,"(a,i10)") "FCAT_eels_all_",n
+ endif
+ end subroutine FCAT_eels_all
+ subroutine FCAT_eels_all_rep()
+ use FCAT_eels_all_mod
+ integer :: i
+ do i = 1, FCAT_eels_all_nline
+ write(*,"(a,i10,i10)") &
+ & "FCAT_eels_all_count",i, &
+ & int(FCAT_eels_all_counter(i)+0.1)
+ end do
+ end subroutine FCAT_eels_all_rep
diff --git a/source/f90/fcat-analysis/eels_all.f90 b/source/f90/fcat-analysis/eels_all.f90
new file mode 100644
index 0000000..7c7eab5
--- /dev/null
+++ b/source/f90/fcat-analysis/eels_all.f90
@@ -0,0 +1,1353 @@
+program eels
+
+! ******************************************************************
+! * *
+! * compute the classical eels spectrum of an arbitrary plane- *
+! * statified medium made from isotropic materials in specular *
+! * geometry using the dielectric theory of eels. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision :: e0, theta, phia, phib, wmin, wmax, dw
+ integer :: i, j, jos, k, l, layers, neps, nper, nw
+ logical :: user
+ character (len = 72) :: comment(2)
+ character (len = 10) :: contrl, mode
+
+ double precision, allocatable :: thick(:), epsinf(:), osc(:, :)
+ integer, allocatable :: nos(:)
+ character (len = 10), allocatable :: name(:)
+ double precision, allocatable :: wn_array(:), f(:)
+
+ integer :: old_size_1, old_size_2
+ double precision, allocatable :: tmp_osc(:, :)
+ integer :: ioStatus
+
+! integer, parameter :: name_length = 10
+! *** read spectrometer parameters
+
+ call change_working_dir()
+ open(unit = 11, file = 'eelsin')
+! impact energy (ev)
+ read(11, *) e0
+! incidence angle (%)
+ read(11, *) theta
+! angular apertures of the elliptic detector (%)
+ read(11, *) phia
+ read(11, *) phib
+! energy-loss interval and step size (cm**-1)
+ read(11, *) wmin
+ read(11, *) wmax
+ read(11, *) dw
+! comment lines
+ read(11, '(a72)') (comment(k), k = 1, 2)
+
+ write(*,*) 'program eels (September 2020)'
+ write(*,'(a, f6.2, a, f5.1, a, f5.2, a, f5.2, a)') &
+ ' e0 = ', e0, ' eV, theta = ', theta, '°, phia = ', &
+ phia, '°, phib = ', phib, '°'
+ write(*,'(a, g11.4, a, g11.4, a, g11.4, a)') &
+ ' energy losses from', wmin, ' to', wmax, ', step = ', dw, ' cm**-1'
+ write(*,*) comment(1)
+ write(*,*) comment(2)
+
+ if (phia <= 0.0d0 .or. phib <= 0.0d0) then
+ stop '*** wrong input ***'
+ endif
+ if (e0 <= 0.0d0 .or. theta + phia >= 90.0d0) then
+ stop '*** bad input ***'
+ endif
+
+! *** read target specifications
+
+ read(11, *) layers, nper, mode
+ user = layers == 0
+ if (.not. user) then
+ neps = layers
+ if (nper == -1) then
+ neps = layers + 1
+ nper = 1
+ write(*,*) 'the substrate is a anisotropic uniaxial material'
+ endif
+ if (layers < 0 .or. nper < 1 .or. nper > layers) then
+ stop '*** invalid target specifications ***'
+ endif
+ write(6, 101) layers, nper
+ jos = 0
+ allocate (name(neps), thick(neps), epsinf(neps), nos(neps))
+ do l = 1, neps
+ if (l <= layers) then
+ read(11, 102) name(l), thick(l)
+ endif
+ read(11, *) epsinf(l), nos(l)
+ write(6, 103)
+ if (nos(l) <= 0) then
+ if (l <= layers) write(6, 104) l, name(l), thick(l), epsinf(l)
+ if (l > layers) write(6, 105) epsinf(l)
+ else
+ do j = 1, nos(l)
+ if (.not. allocated(osc)) then
+ allocate(osc(3, nos(l)))
+ else if (j == 1) then
+ ! call extend3(osc, nos(j))
+ old_size_1 = size(osc, 1)
+ old_size_2 = size(osc, 2)
+ allocate(tmp_osc(old_size_1, old_size_2 + nos(l)))
+ tmp_osc(1:old_size_1, 1:old_size_2) = osc
+ deallocate(osc)
+ call move_alloc(tmp_osc, osc)
+ endif
+ jos = jos + 1
+ read(11, *) (osc(k, jos), k = 1, 3)
+ if ((j == nos(l) / 2 + 1) .and. (nos(l) > 1)) then
+ write(6, 106)
+ write(6, 107)
+ endif
+ if (j == 1) then
+ if (l <= layers) then
+ write(6, 104) l, name(l), thick(l), epsinf(l), (osc(i, jos), i = 1, 3)
+ else
+ write(6, 105) epsinf(l), (osc(i, jos), i = 1, 3)
+ endif
+ else
+ write(6, 108) (osc(i, jos), i = 1, 3)
+ endif
+ enddo
+ endif
+ enddo
+ write(*,*)
+ read(11, 102, IOSTAT = ioStatus) contrl
+ if (ioStatus /= 0) then
+ contrl = ''
+ endif
+ endif
+
+ close (unit = 11)
+
+ nw = 1 + int((wmax - wmin) / dw)
+ allocate (wn_array(nw), f(nw))
+
+ call doeels(e0, theta, phia, phib, wmin, wmax, dw, comment, size(comment), &
+ layers, neps, nper, name, size(name), thick, epsinf, nos, osc, size(osc, 2),&
+ contrl, mode, wn_array, f, size(wn_array))
+
+ open (unit = 12, file = 'eelsou')
+ write (12, 207) e0, theta, phia, phib, comment(1)
+ do i = 1, nw
+ write (12, 211) wn_array(i), f(i)
+ enddo
+ close (unit = 12)
+
+ stop
+
+101 format(i3, ' layer(s), nper = ', i2//' l', 2x, 'material', 7x, &
+ 'thickness', 5x, 'epsinf', 4x, 'wto , wp', 5x, 'q', 7x, 'gam/wto')
+102 format(a10, d15.5)
+103 format(1x, 72('-'))
+104 format(1x, i3, 2x, a10, g15.3, f10.4, f12.4, f10.4, f9.4)
+105 format(31x, f10.4, f12.4, f10.4, f9.4)
+106 format(45x, 'wlo , wp', 5x, 'q', 7x, 'gam/wlo')
+107 format(45x, 28('-'))
+108 format(41x, f12.4, f10.4, f9.4)
+207 format('e0 =', f6.2, ' theta =', f5.1, ' phia =', f5.2, ' phib =', f5.2 / a72)
+211 format(2e15.7)
+end program eels
+
+double precision function qrat(x, alpha, beta, c1, c2)
+
+ implicit none
+
+ double precision, intent(in) :: x, alpha, beta, c1, c2
+
+ qrat = (1.0d0 + x * (beta + c1 * x)) / ((1.0d0 + x * (beta + c2 * x)) * (1.0d0 + alpha * x)**2)
+
+ return
+end function qrat
+
+double precision function usurlo(dq, wn)
+
+! ******************************************************************
+! * *
+! * user-supplied dielectric surface loss function aimag(g(dq, wn)) *
+! * input arguments : *
+! * dq : modulus of the two-dimensional surface wave vector *
+! * (angstroem**-1) *
+! * wn : frequency (cm**-1) *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+
+ usurlo = 1.0d0
+ return
+end function usurlo
+double precision function surlos(dk, eps, thick, layers, nper)
+
+! ******************************************************************
+! * *
+! * eels surface loss function for an arbitrary multilayered target*
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+
+ integer :: lmax
+ logical :: static, zero, skip
+ integer :: lstart, n
+ double precision, allocatable :: arg(:)
+ double precision :: argmin, argmax, cn, cnm1, epsmac, sn, snm1, tn
+ double complex :: a, b, csi, pnm2, pnm1, pn, pp, qnm2, qnm1, qn, qp, z
+
+ common / mulayr / argmin, argmax, epsmac
+
+ zero(z) = (dble(z) == 0.0d0) .and. (dimag(z) == 0.0d0)
+
+! write (*,*) 'surlos:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ lmax = size(eps)
+ allocate (arg(lmax))
+ lstart = layers - nper + 1
+ static = .true.
+ skip = .false.
+
+ do n = 1, layers
+ arg(n) = dk * thick(n)
+ if (arg(n) > argmax .or. zero(eps(n))) then
+ csi = eps(n)
+ skip = .true.
+ exit
+ endif
+ static = .not. (n >= lstart .and. arg(n) > argmin)
+ enddo
+
+ if (.not. skip) then
+! *** periodic continued fraction, period = nper
+
+ do ! Do loop is only for the option to skip out of it.
+ if (nper <= 1) then
+ csi = eps(layers)
+ else
+ if (static) then
+ pn = 0.0d0
+ qn = 0.0d0
+ do n = lstart, layers
+ pn = pn + thick(n) * eps(n)
+ qn = qn + thick(n) / eps(n)
+ enddo
+ if (zero(qn)) then
+ n = lstart
+ if (n <= 1) then
+ surlos = 0.0d0
+ return
+ endif
+ n = n - 1
+ csi = eps(n) / dtanh(arg(n))
+ exit
+ endif ! zero(qn)
+ csi = cdsqrt(pn / qn)
+ if ((dimag(csi) < 0.0d0) .and. (dble(qn) < 0.0d0)) then
+ csi = -csi
+ endif
+ else ! static
+ cn = dcosh(arg(lstart))
+ sn = dsinh(arg(lstart))
+ pnm1 = 1.0d0
+ pn = cn
+ pp = eps(lstart) * sn
+ qnm1 = 0.0d0
+ qn = sn / eps(lstart)
+ qp = pn
+ do n = lstart + 1, layers
+ cnm1 = cn
+ snm1 = sn
+ cn = dcosh(arg(n))
+ sn = dsinh(arg(n))
+ a = eps(n) * sn
+ pp = cn * pp + a * pn
+ qp = cn * qp + a * qn
+ b = (eps(n - 1) / eps(n)) * (sn / snm1)
+ a = cnm1 * b + cn
+ pnm2 = pnm1
+ pnm1 = pn
+ qnm2 = qnm1
+ qnm1 = qn
+ pn = a * pnm1 - b * pnm2
+ qn = a * qnm1 - b * qnm2
+ enddo
+ if (zero(qn)) then
+ a = qp - pn
+ if (zero(a)) then
+ n = lstart
+ if (n <= 1) then
+ surlos = 0.0d0
+ return
+ endif
+ n = n - 1
+ csi = eps(n) / dtanh(arg(n))
+ exit
+ endif
+ csi = pp / a
+ else
+ a = 0.5d0 * (pn - qp) / qn
+ b = cdsqrt(a**2 + pp / qn)
+ pn = a - pn / qn
+ if (cdabs(pn + b) > cdabs(pn - b)) then
+ b = -b
+ endif
+ csi = a + b
+ endif ! zero(qn)
+ endif ! static
+! *** small-dk limit of the periodic tail
+
+ endif ! nper <= 1
+
+ n = lstart
+
+ exit
+ enddo
+ endif ! .not. skip
+
+! *** backward algorithm
+
+ do
+ n = n - 1
+ if (n <= 0) then
+ a = csi + 1.0d0
+ if (zero(a)) then
+ surlos = 2 / epsmac
+ else
+ surlos = dimag(-2 / a)
+ endif
+ return
+ endif ! n <= 0
+
+ if (arg(n) /= 0.0d0) then
+ tn = dtanh(arg(n))
+ b = eps(n) + csi * tn
+ if (zero(b)) then
+ surlos = 0.0d0
+ return
+ endif
+ csi = eps(n) * (csi + tn * eps(n)) / b
+ endif
+ enddo
+end function surlos
+double precision function phint(phi, a, u)
+
+! ******************************************************************
+! * *
+! * evaluate the integral from zero to phi of *
+! * *
+! * u 2 *
+! * ( ----------------------------- ) dphi *
+! * 2 2 *
+! * (1 - a * u * cos(phi)) + u *
+! * *
+! * for 0 <= phi <= pi , u >= 0 and a >= 0 *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: phi
+ double precision, intent(in) :: a
+ double precision, intent(in) :: u
+
+ double precision :: ai, ar, bi, br, c, cpr, d, e, esr, pi, qr, ri, rm, root
+ double precision :: rp, rr, s, spr, tm, tp, u2, x, zeta, zetai, zetar, zr
+
+ pi = 3.141592653589793238d0
+ c = dcos(phi)
+ s = dsin(phi)
+ u2 = u**2
+ e = a*u
+ if (u < 1.0d0 .and. e < 1.0d-02 * (1.0d0 + u2)) then
+ zr = 1.0d0 + u2
+ esr = e / zr
+ phint = u2 / zr**2 * ((( (4.0d0 / 3.0d0) * (2.0d0 + c**2) * s * (5.0d0 - 3 * u2) * &
+ esr + (phi + c * s) * (5.0d0 - u2)) * esr + 4 * s) * esr + phi)
+ else
+ rm = dsqrt((1.0d0 - e)**2 + u2)
+ tm = 0.5d0 * datan2(u, 1.0d0 - e)
+ rp = dsqrt((1.0d0 + e)**2 + u2)
+ tp = 0.5d0 * datan2(u, 1.0d0 + e)
+ root = dsqrt(rm * rp)
+ cpr = dcos(tm + tp)
+ spr = dsin(tm + tp)
+ x = 0.0d0 ! ensure initialization
+ if (c >= 0.0d0) then
+ x = s / (1.0d0 + c)
+ elseif (dabs(s) > 1.0d-07) then
+ x = (1.0d0 - c) / s
+ endif
+ if ((c >= 0.0d0) .or. (dabs(s) > 1.0d-07)) then
+ zeta = dsqrt(rm / rp)
+ zetar = -zeta * dsin(tm - tp)
+ zetai = zeta * dcos(tm - tp)
+ br = 0.5d0 * dlog(((zetar + x)**2 + zetai**2) / ((zetar - x)**2 + zetai**2))
+ bi = datan2(zetai, zetar + x) - datan2(zetai, zetar - x)
+ rr = -(br * spr - bi * cpr) / root
+ ri = -(bi * spr + br * cpr) / root
+ d = e * s / ((1.0d0 - e * c)**2 + u2)
+ ar = d * (1.0d0 - e * c) - rr + u * ri
+ ai = -d * u - ri - u * rr
+ else
+ rr = -pi / root * cpr
+ ri = pi / root * spr
+ ar = -rr + u * ri
+ ai = -ri - u * rr
+ endif
+ qr = (ar * (cpr - spr) * (cpr + spr) + 2 * ai * cpr * spr) / (rm * rp)
+ phint = 0.5d0 * (ri / u - qr)
+ endif
+ return
+end function phint
+double precision function fint1(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from 0.0 to pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: acoef, bcoef, ccoef, cospsi, den, dif, dlimf, e, elleps
+ double precision :: pi, rom, rop, ru, sinpsi, sum, um, t
+ double precision :: tanpsi, wn, u2
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+ data pi / 3.141592653589793238d0 /
+
+! write (*,*) 'fint1:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ if (u == 0.0d0) then
+ fint1 = 0.0d0
+ return
+ endif
+ e = tanpsi * u
+ u2 = u**2
+ rom = (1.0d0 - e)**2 + u2
+ rop = (1.0d0 + e)**2 + u2
+ sum = rop + rom
+ rom = dsqrt(rom)
+ rop = dsqrt(rop)
+ dif = rop - rom
+ den = dsqrt((2.0d0 - dif) * (2.0d0 + dif)) * rop * rom
+ fint1 = pi * u2 * (4 * sum - dif**2 * (sum - rop * rom)) / den**3
+ if (rational) then
+ return
+ endif
+ if (user) then
+ fint1 = fint1 * usurlo(ru * u, wn)
+ else
+ fint1 = fint1 * surlos(ru * u, eps, thick, layers, nper)
+ if (dlimf > 0.0d0) then
+ t = ru * u * dlimf
+ fint1 = fint1 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ endif
+ endif
+ return
+end function fint1
+double precision function fint2(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from 0.0 to phi < pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: a, arg, b, b2, c, ccoef, cospsi, dlimf, elleps, phi
+ double precision :: phint, ru, sinpsi, um, t, tanpsi, wn, x
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / a, b, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'fint2:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ if (u == 0.0d0) then
+ fint2 = 0.0d0
+ return
+ endif
+ b2 = b**2
+ c = (1.0d0 - elleps) * (cospsi * u)**2 + (b - ccoef) * (b + ccoef)
+ if (dabs(a * c) > 1.0d-03 * b2) then
+ x = (b - dsqrt(b2 - a * c)) / a
+ else
+ x = a * c / b2
+ x = 0.5d0 * c * (1.d0 + 0.25d0 * x * (1.d0 + 0.5d0 * x * (1.d0 + 0.625d0 * x))) / b
+ endif
+ arg = x / u
+ if (dabs(arg) > 1.0d0) then
+ arg = dsign(1.0d0, arg)
+ endif
+ phi = dacos(arg)
+ fint2 = phint(phi, tanpsi, u)
+ if (rational) then
+ return
+ endif
+ if (user) then
+ fint2 = fint2 * usurlo(ru * u, wn)
+ else
+ fint2 = fint2 * surlos(ru * u, eps, thick, layers, nper)
+ if (dlimf > 0.0d0) then
+ t = ru * u * dlimf
+ fint2 = fint2 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ endif
+ endif
+ return
+end function fint2
+double precision function fint3(u, eps, thick, layers, nper, eps_size)
+
+! ******************************************************************
+! * *
+! * integration over the azimutal angle from phi1 > 0 to phi2 < pi *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+
+ logical :: rational, user
+ double precision :: a, arg, b, ccoef, cospsi, dlimf, elleps, phi1, phi2
+ double precision :: phint, sinpsi, rac, ru, um, t, tanpsi, wn
+
+ interface
+ double precision function usurlo(dq, wn)
+ double precision, intent(in) :: dq
+ double precision, intent(in) :: wn
+ end function usurlo
+ double precision function surlos(dk, eps, thick, layers, nper)
+ double precision, intent(in) :: dk
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end function surlos
+ end interface
+
+ common / param / a, b, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'fint3:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ if (u == 0.0d0) then
+ fint3 = 0.0d0
+ return
+ endif
+ rac = dsign(1.0d0, a) * cospsi * dsqrt((1.0d0 - elleps) * a * (um - u) * (um + u))
+ arg = (b - rac) / (u * a)
+ if (dabs(arg) > 1.0d0) arg = dsign(1.0d0, arg)
+ phi2 = dacos(arg)
+ fint3 = phint(phi2, tanpsi, u)
+ arg = (b + rac) / (u * a)
+ if (dabs(arg) > 1.0d0) arg = dsign(1.0d0, arg)
+ phi1 = dacos(arg)
+ fint3 = fint3 - phint(phi1, tanpsi, u)
+ if (rational) return
+ if (user) then
+ fint3 = fint3 * usurlo(ru * u, wn)
+ else
+ fint3 = fint3 * surlos(ru * u, eps, thick, layers, nper)
+ if (dlimf > 0.0d0) then
+ t = ru * u * dlimf
+ fint3 = fint3 * (1.d0 + t * dlog(t / (t + 0.26d0)))**2 / (1.d0 + 1.40d0 * t)
+ endif
+ endif
+ return
+end function fint3
+double precision function fun(phi)
+
+! ******************************************************************
+! * *
+! * integrand of the expression of the 1st order term in the *
+! * expansion of the eels integral for a homogeneous target. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: phi
+
+ logical :: user, rational
+ double precision :: acoef, bcoef, ccoef, cospsi, dlimf, elleps, ru
+ double precision :: sinphi, sinpsi, tanpsi, um, wn
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+ sinphi = dsin(phi)
+ fun = dsqrt((1.0d0 - elleps + elleps * sinphi**2) * &
+ (1.0d0 - sinpsi * sinphi) * &
+ (1.0d0 + sinpsi * sinphi))
+ return
+end function fun
+subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+
+! estimate the integral of fun(x) from a to b
+! to a user provided tolerance.
+! an automatic adaptive routine based on
+! the 8-panel newton-cotes rule (g. forsythe et al, 1977, p. 92)
+!
+! input ..
+!
+! fun the name of the integrand function subprogram fun(x).
+! a the lower limit of integration.
+! b the upper limit of integration.(b may be less than a.)
+! relerr a relative error tolerance. (should be non-negative)
+! abserr an absolute error tolerance. (should be non-negative)
+!
+! output ..
+!
+! result an approximation to the integral hopefully satisfying the
+! least stringent of the two error tolerances.
+! errest an estimate of the magnitude of the actual error.
+! nofun the number of function values used in calculation of result.
+! flag a reliability indicator. if flag is zero, then result
+! probably satisfies the error tolerance. if flag is
+! xxx.yyy , then xxx = the number of intervals which have
+! not converged and 0.yyy = the fraction of the interval
+! left to do when the limit on nofun was approached.
+
+ implicit none
+
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+
+ double precision :: w0, w1, w2, w3, w4, area, x0, f0, stone, step, cor11, temp
+ double precision :: qprev, qnow, qdiff, qleft, esterr, tolerr
+ double precision :: qright(31), f(16), x(16), fsave(8, 30), xsave(8, 30)
+ double precision :: dabs, dmax1
+
+ integer :: levmin, levmax, levout, nomax, nofin, lev, nim, i, j
+
+! *** stage 1 *** general initialization
+! set constants.
+
+! write (*,*) 'quanc8:'
+! write (*,*) 'thick: ', size(thick)
+! write (*,*) 'eps: ', size(eps)
+
+ levmin = 1
+ levmax = 30
+ levout = 6
+ nomax = 5000
+ nofin = nomax - 8 * (levmax - levout + 2**(levout + 1))
+
+! trouble when nofun reaches nofin
+
+ w0 = 3956.0d0 / 14175.0d0
+ w1 = 23552.0d0 / 14175.0d0
+ w2 = -3712.0d0 / 14175.0d0
+ w3 = 41984.0d0 / 14175.0d0
+ w4 = -18160.0d0 / 14175.0d0
+
+! initialize running sums to zero.
+
+ flag = 0.0d0
+ result = 0.0d0
+ cor11 = 0.0d0
+ errest = 0.0d0
+ area = 0.0d0
+ nofun = 0
+ if (a == b) return
+
+! *** stage 2 *** initialization for first interval
+
+ lev = 0
+ nim = 1
+ x0 = a
+ x(16) = b
+ qprev = 0.0d0
+ f0 = fun(x0, eps, thick, layers, nper, size(eps))
+ stone = (b - a) / 16
+ x(8) = (x0 + x(16)) / 2
+ x(4) = (x0 + x(8)) / 2
+ x(12) = (x(8) + x(16)) / 2
+ x(2) = (x0 + x(4)) / 2
+ x(6) = (x(4) + x(8)) / 2
+ x(10) = (x(8) + x(12)) / 2
+ x(14) = (x(12) + x(16)) / 2
+ do j = 2, 16, 2
+ f(j) = fun(x(j), eps, thick, layers, nper, size(eps))
+ enddo
+ nofun = 9
+
+ do
+
+! *** stage 3 *** central calculation
+! requires qprev, x0, x2, x4, ..., x16, f0, f2, f4, ..., f16.
+! calculates x1, x3, ...x15, f1, f3, ...f15, qleft, qright, qnow, qdiff, area.
+
+ x(1) = (x0 + x(2)) / 2
+ f(1) = fun(x(1), eps, thick, layers, nper, size(eps))
+ do j = 3, 15, 2
+ x(j) = (x(j - 1) + x(j + 1)) / 2
+ f(j) = fun(x(j), eps, thick, layers, nper, size(eps))
+ enddo
+ nofun = nofun + 8
+ step = (x(16) - x0) / 16.0d0
+ qleft = (w0 * (f0 + f(8)) + w1 * (f(1) + f(7)) + w2 * (f(2) + f(6)) &
+ + w3 * (f(3) + f(5)) + w4 * f(4)) * step
+ qright(lev + 1) = (w0 * (f(8) + f(16)) + w1 * (f(9) + f(15)) + w2 * (f(10) + f(14)) &
+ + w3 * (f(11) + f(13)) + w4 * f(12)) * step
+ qnow = qleft + qright(lev + 1)
+ qdiff = qnow - qprev
+ area = area + qdiff
+
+! *** stage 4 *** interval convergence test
+
+ esterr = dabs(qdiff) / 1023
+ tolerr = dmax1(abserr, relerr * dabs(area)) * (step / stone)
+
+ if (lev >= levmin) then
+ if (lev >= levmax) then
+! current level is levmax.
+ flag = flag + 1.0d0
+ else
+ if (nofun > nofin) then
+! *** stage 6 *** trouble section
+! number of function values is about to exceed limit.
+ nofin = 2 * nofin
+ levmax = levout
+ flag = flag + (b - x0) / (b - a)
+ else
+ if (esterr > tolerr) then
+! *** stage 5 *** no convergence
+! locate next interval.
+ nim = 2 * nim
+ lev = lev + 1
+! store right hand elements for future use.
+ do i = 1, 8
+ fsave(i, lev) = f(i + 8)
+ xsave(i, lev) = x(i + 8)
+ enddo
+! assemble left hand elements for immediate use.
+ qprev = qleft
+ do i = 1, 8
+ f(18 - 2 * i) = f(9 - i)
+ x(18 - 2 * i) = x(9 - i)
+ enddo
+ cycle
+ endif
+ endif
+ endif
+
+! *** stage 7 *** interval converged
+! add contributions into running sums.
+ result = result + qnow
+ errest = errest + esterr
+ cor11 = cor11 + qdiff / 1023
+! locate next interval.
+ do while (nim /= 2 * (nim / 2))
+ nim = nim / 2
+ lev = lev - 1
+ enddo
+ nim = nim + 1
+
+ if (lev <= 0) exit
+
+! assemble elements required for the next interval.
+ qprev = qright(lev)
+ x0 = x(16)
+ f0 = f(16)
+ do i = 1, 8
+ f(2*i) = fsave(i, lev)
+ x(2*i) = xsave(i, lev)
+ enddo
+ cycle
+ else
+! *** stage 5 *** no convergence
+! locate next interval.
+ nim = 2 * nim
+ lev = lev + 1
+! store right hand elements for future use.
+ do i = 1, 8
+ fsave(i, lev) = f(i + 8)
+ xsave(i, lev) = x(i + 8)
+ enddo
+! assemble left hand elements for immediate use.
+ qprev = qleft
+ do i = 1, 8
+ f(18 - 2 * i) = f(9 - i)
+ x(18 - 2 * i) = x(9 - i)
+ enddo
+ endif
+
+ enddo
+
+ ! *** stage 8 *** finalize and return
+ result = result + cor11
+
+! make sure errest not less than roundoff level.
+ if (errest /= 0.0d0) then
+ temp = dabs(result) + errest
+ do while (temp == dabs(result))
+ errest = 2 * errest
+ temp = dabs(result) + errest
+ enddo
+ endif
+ return
+end subroutine quanc8
+subroutine queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+
+! ******************************************************************
+! * *
+! * perform q-space integration for computing the eels spectrum of *
+! * a isotropic target using polar coordinates. *
+! * *
+! * x is the dimensionless energy loss hbar*omega/(2*e0*phia) *
+! * aerr and rerr are the desired absolute and relative accuracies *
+! * facru*x is the units of wavevectors omega/v_perpendicular *
+! * f is the q-integral multiplied by (2/pi)**2 *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ double precision, intent(in) :: x
+ double precision, intent(out) :: f
+ double precision, intent(in out) :: aerr
+ double precision, intent(in out) :: rerr
+ double precision, intent(in) :: facru
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+
+ logical :: rational, user
+ double precision :: acoef, bcoef, ccoef, cospsi, dlimf, elleps
+ double precision :: error, flag, ru, sinpsi
+ double precision :: u1, u2, um, ut, tanpsi, wn, y
+ integer :: ie, nofu
+ dimension error(3), flag(3)
+
+ interface
+ double precision function fint1(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint1
+ double precision function fint2(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint2
+ double precision function fint3(u, eps, thick, layers, nper, eps_size)
+ double precision, intent(in) :: u
+ integer, intent(in) :: layers, nper, eps_size
+ double complex, intent(in) :: eps(eps_size)
+ double precision, intent(in) :: thick(eps_size)
+ end function fint3
+ subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+ end subroutine quanc8
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+
+! write (*,*) 'queels:'
+! write (*,*) 'eps: ', size(eps)
+! write (*,*) 'thick: ', size(thick)
+
+ f = 0.0d0
+ if (x <= 0.0d0) then
+ return
+ endif
+ ru = facru * x
+ ccoef = cospsi**2 / x
+ ut = ccoef - bcoef
+ u1 = dabs(ut)
+ u2 = ccoef + bcoef
+ if (ut > 0.0d0) then
+ call quanc8(fint1, 0.0d0, u1, aerr, rerr, y, error(1), nofu, flag(1), eps, thick, layers, nper)
+ f = y
+ else
+ flag(1) = 0.0d0
+ endif
+ if (u2 > u1) then
+ call quanc8(fint2, u1, u2, aerr, rerr, y, error(2), nofu, flag(2), eps, thick, layers, nper)
+ f = f + y
+ else
+ flag(2) = 0.0d0
+ endif
+ if (dabs(acoef) > x * (1.0d0 - elleps) * bcoef) then
+ um = dsqrt(ccoef / x / (1.0d0 - elleps) + bcoef**2 / acoef)
+ if (um > u2) then
+ call quanc8(fint3, u2, um, aerr, rerr, y, error(3), nofu, flag(3), eps, thick, layers, nper)
+ f = f + y
+ endif
+ if (um < u1) then
+ call quanc8(fint3, um, u1, aerr, rerr, y, error(3), nofu, flag(3), eps, thick, layers, nper)
+ f = f - y
+ endif
+ else
+ flag(3) = 0.0d0
+ endif
+ do ie = 1, 3
+ if (flag(ie) == 0.0d0) cycle
+ write(*,*) ' +++ flag(', ie, ') =', flag(ie), ', error =', error(ie), ' +++'
+ if (flag(ie) - aint(flag(ie)) > 0.5d-02) then
+ stop '*** execution aborted ***'
+ endif
+ enddo
+ f = (2 / 3.141592653589793238d0)**2 * f
+ return
+end subroutine queels
+subroutine seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+
+! ******************************************************************
+! * *
+! * set up long-wavelength dielectric functions of the layers for *
+! * the present frequency wn (in cm**-1) *
+! * *
+! ******************************************************************
+
+ implicit none
+ integer, intent(in) :: neps
+ integer, intent(in) :: nos(:)
+ double precision, intent(in) :: osc(:, :)
+ double precision, intent(in) :: epsinf(:)
+ double precision, intent(in) :: wn
+ character (len=10), intent(in) :: name(:)
+ character (len=10), intent(in) :: mode
+
+ double complex, intent(in out) :: eps(:)
+ integer, intent(in) :: layers
+
+ double precision :: argmin, argmax, epsmac, x
+ double complex :: deno, nomi
+ integer :: j, k, l, m
+
+ common / mulayr / argmin, argmax, epsmac
+
+! write (*,*) 'seteps:'
+! write (*,*) 'nos: ', size(nos)
+! write (*,*) 'osc: ', size(osc)
+! write (*,*) 'epsinf: ', size(epsinf)
+! write (*,*) 'name: ', size(name)
+! write (*,*) 'eps: ', size(eps)
+! write (*,*) 'thick: ', size(thick)
+
+ j = 0
+ do l = 1, neps
+ m = nos(l)/2
+ nomi = dcmplx(1.0d0, 0.0d0)
+ deno = dcmplx(1.0d0, 0.0d0)
+ if (mode == 'kurosawa') then
+ do k = 1, m
+ j = j + 1
+! since osc(1,*) and wn are real, the following should be equivalent
+! Check required.
+! Furthermore the first term can be rewritten as
+! (osc(1, j + m) - wn) * (osc(1, j + m) + wn)
+! nomi = nomi * cmplx(osc(1, j + m)**2 - wn**2, - wn * osc(3, j + m))
+ nomi = nomi * (osc(1, j + m)**2 - wn**2 - dcmplx(0.0d0, wn * osc(3, j + m)))
+ deno = deno * (osc(1, j )**2 - wn**2 - dcmplx(0.0d0, wn * osc(3, j )))
+ enddo
+ eps(l) = epsinf(l) * nomi / deno
+ elseif (name(l) == 'metal') then
+ j = j + 1
+! suggestion for replacement
+! eps(l) = -osc(1, j)**2 / cmplx(wn**2, wn * osc(3, j))
+ eps(l) = -osc(1, j)**2 / ( wn**2 + dcmplx(0.0d0, wn * osc(3, j)) )
+ else
+ eps(l) = epsinf(l)
+! The original version had this additional loop. It seems, it has been removed
+! because all cases of nos(l) > 1 are treated in case 1 above
+ do k = 1, nos(l)
+ j = j + 1
+ x = wn / osc(1, j)
+ deno = x * dcmplx(x, osc(3, j))
+ if (osc(2, j) >= 0.0d0) then
+ deno = 1.0d0 - deno
+ endif
+ if (cdabs(deno) == 0.0d0) then
+ deno = epsmac
+ endif
+ eps(l) = eps(l) + osc(2, j) / deno
+ enddo
+ endif
+ enddo
+ if (neps == layers + 1) then
+! the substrate is a anisotropic uniaxial material
+ eps(layers) = cdsqrt(eps(layers) * eps(layers + 1))
+ if (dimag(eps(layers)) < 0.0d0) then
+ eps(layers) = -eps(layers)
+ endif
+ endif
+ return
+end subroutine seteps
+subroutine doeels (e0, theta, phia, phib, wmin, wmax, dw, comment, comment_size, &
+ layers, neps, nper, name, name_size, thick, epsinf, nos, osc, osc_size,&
+ contrl, mode, wn_array, f_array, wn_array_size)
+
+! ******************************************************************
+! * *
+! * compute the classical eels spectrum of an arbitrary plane- *
+! * statified medium made from isotropic materials in specular *
+! * geometry using the dielectric theory of eels. *
+! * *
+! ******************************************************************
+
+ implicit none
+
+ integer, parameter :: nt = 5
+
+ double precision, intent(in) :: e0, theta, phia, phib, wmin, wmax, dw
+ character (len = 72) :: comment(comment_size)
+ character (len = 10) :: name(name_size)
+ double precision, intent(in) :: thick(name_size), epsinf(name_size), osc(3, osc_size)
+ character (len = 10) :: contrl, mode
+ integer, intent(in) :: comment_size, name_size, osc_size, wn_array_size
+ integer, intent(in out) :: layers, nper, nos(name_size)
+ double precision, intent(in out) :: wn_array(wn_array_size), f_array(wn_array_size)
+
+ logical :: rational, user, debug
+ integer :: i, iw, neps, nofu, nout, nw, lmax
+ double precision :: a, acoef, aerr, alpha, argmin, argmax, b, bcoef, beta, &
+ c1, c2, ccoef, cospsi, dlimf, dx, elleps, ener, epsmac, facru, f, f0, &
+ f1, fpic, fun, pi, prefac, psia, psii, qrat, rerr, ru, sinpsi, t, &
+ tanpsi, table, um, widt, wn, wpic, x, xmin, xmax, z, z1, z2
+ double complex, allocatable :: eps(:)
+ dimension table(nt)
+
+ external fun, qrat
+
+ interface
+ subroutine queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ double precision, intent(in) :: x
+ double precision, intent(out) :: f
+ double precision, intent(in out) :: aerr
+ double precision, intent(in out) :: rerr
+ double precision, intent(in) :: facru
+ double complex, intent(in) :: eps(:)
+ double precision, intent(in) :: thick(:)
+ integer, intent(in) :: layers, nper
+ end subroutine queels
+ subroutine seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+ integer, intent(in) :: neps
+ integer, intent(in) :: nos(:)
+ double precision, intent(in) :: osc(:, :)
+ double precision, intent(in) :: epsinf(:)
+ double precision, intent(in) :: wn
+ character (len=10), intent(in) :: name(:)
+ character (len=10), intent(in) :: mode
+ double complex, intent(in out) :: eps(:)
+ integer, intent(in) :: layers
+ end subroutine seteps
+ subroutine quanc8(fun, a, b, abserr, relerr, result, errest, nofun, flag, eps, thick, layers, nper)
+ double precision :: fun
+ double precision, intent(in) :: a
+ double precision, intent(in) :: b
+ double precision, intent(in out) :: abserr
+ double precision, intent(in) :: relerr
+ double precision, intent(out) :: result
+ double precision, intent(out) :: errest
+ integer, intent(out) :: nofun
+ double precision, intent(out) :: flag
+
+ external fun
+
+ double precision, intent(in) :: thick(:)
+ double complex, intent(in) :: eps(:)
+ integer, intent(in) :: layers, nper
+ end subroutine quanc8
+ end interface
+
+ common / param / acoef, bcoef, ccoef, elleps, cospsi, sinpsi, tanpsi, &
+ ru, um, dlimf, wn, user, rational
+ common / mulayr / argmin, argmax, epsmac
+
+ data aerr / 0.0d0 /, rerr / 1.0d-06 /, f / 0.0d0 /, f1 / 0.0d0 /
+
+ debug = .false.
+ if (debug) then
+ write (*,*) 'doeels:'
+ write (*,*) 'comment: ', size(comment)
+ write (*,*) 'name: ', size(name)
+ write (*,*) 'thick: ', size(thick)
+ write (*,*) 'epsinf: ', size(epsinf)
+ write (*,*) 'osc: ', size(osc), size(osc, 1), size(osc, 2)
+ write (*,*) 'nos: ', size(nos)
+ write (*,*) 'wn_array: ', size(wn_array)
+ write (*,*) 'f_array: ', size(f_array)
+ endif
+
+! *** machine-dependent constants
+! *** epsmac + 1.0 = epsmac , cosh(argmin) = 1.0 , tanh(argmax) = 1.0
+
+ pi = 4 * datan(1.0d0)
+ epsmac = 1.0d0
+ do while (1.0d0 + epsmac > 1.0d0)
+ epsmac = epsmac / 2
+ enddo
+ argmin = dsqrt(2 * epsmac)
+ argmax = 0.5d0 * dlog(2 / epsmac)
+
+ dlimf = 0.0d0
+ rational = .false.
+
+! *** read target specifications
+
+ user = layers == 0
+ if (user) then
+
+ if (layers == 1) rational = .true.
+ if (contrl == 'image') then
+! *** image-charge screening factor
+ if (layers == 1 .and. neps == 2) then
+ dlimf = dsqrt(epsinf(1) * epsinf(2))
+ else
+ dlimf = epsinf(1)
+ endif
+ dlimf = (dlimf - 1.0d0) / (dlimf + 1.0d0)
+ endif
+ endif
+
+! *** initialize constants
+
+ lmax = size(thick)
+ nw = size(wn_array)
+ if (debug) write (*,*) 'lmax: ', lmax
+ allocate(eps(lmax))
+ if (debug) write (*,*) 'eps: ', size(eps)
+ nout = 1 + nw / 20
+ ener = 8065 * e0
+ psia = phia / 180 * pi
+ psii = theta / 180 * pi
+ cospsi = dcos(psii)
+ sinpsi = dsin(psii)
+ tanpsi = dtan(psii)
+ prefac = dsqrt(255500 / e0)/(137 * cospsi)
+ facru = psia / cospsi * dsqrt(0.2624664d0 * e0)
+ elleps = (1.0d0 - phia / phib) * (1.0d0 + phia / phib)
+ acoef = sinpsi**2 + elleps * cospsi**2
+ bcoef = sinpsi * cospsi
+ if (dlimf > 0.0d0) then
+ rational = .false.
+ if (debug) write(*,*) ' = > electron attracted by an image charge = ', dlimf
+! *** dlimf : half the length unit imposed by the image force
+ dlimf = 1.80d0 * dlimf/(e0 * cospsi**2)
+ endif
+ if (debug) write (*,*) 'rational: ', rational
+ if (rational) then
+
+! *** set up coefficients for the rational approximation to the integral
+
+ if (debug) write(*,*) ' = > set up a rational approximation to the integral'
+ call quanc8(fun, 0.0d0, pi / 2, aerr, rerr, alpha, c1, nofu, c2, eps, thick, layers, nper)
+ alpha = (2 / pi)**2 * alpha
+ c1 = 2 / pi / dsqrt(1.0d0 - elleps) * sinpsi * alpha**2
+ if (c1 > 0.99d0) then
+ if (debug) write(*,*) ' ===> cannot do it'
+ rational = .false.
+ else
+ c2 = 3 * alpha**2 / (1.0d0 - c1)
+ c1 = c1 * c2
+ xmin = wmin / (2 * ener * psia)
+ xmax = wmax / (2 * ener * psia)
+ if (xmin <= 0.0d0) xmin = 0.0d0
+ dx = dmax1(0.02d0, (xmax - xmin) / nt)
+ z1 = 0.0d0
+ z2 = 0.0d0
+ do i = 1, nt
+ x = xmin + i * dx
+ call queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ table(i) = f
+ f = f * (1.0d0 + alpha * x)**2
+ if (dabs(c2 * f - c1) < c2 * rerr) cycle
+ z = (1.0d0 - f) / (c2 * f - c1)
+ if (z <= 0.0d0) cycle
+ z1 = z1 + x * z * (x**2 - z)
+ z2 = z2 + (x * z)**2
+ enddo
+ if (z2 == 0.0d0) then
+ if (debug) write(*,*) ' ===> cannot do it'
+ rational = .false.
+ else
+ beta = z1 / z2
+ z = 0.0d0
+ do i = 1, nt
+ x = xmin + i * dx
+ z = z + (table(i) - qrat(x, alpha, beta, c1, c2))**2
+ enddo
+ z = dsqrt(z) / nt
+ if (z > 5.0d-03) then
+ if (debug) write(*,*) ' ===> cannot do it'
+ rational = .false.
+ else
+ if (debug) write(*, 100) alpha, c1, c2, beta, z
+ endif ! z > 5.0d-03
+ endif ! z2 == 0.0d0
+ endif ! c1 > 0.99d0
+ endif ! rational
+
+! *** loop over the energy losses
+
+ if (debug) write(*, 110)
+ do iw = 1, nw
+ f0 = f1
+ f1 = f
+ f = 0.0d0
+ wn = wmin + (iw - 1) * dw
+! if (debug) write (*,*) 'wn: ', wn
+ if (wn >= 0.0d0) then
+ if (wn /= 0.0d0) then
+ if (.not. user) call seteps(neps, nos, osc, epsinf, wn, name, eps, layers, mode)
+
+ x = wn / (2 * ener * psia)
+ if (rational) then
+ f = qrat(x, alpha, beta, c1, c2) * dimag(-2 / (1.0d0 + eps(1)))
+ else
+ call queels(x, f, aerr, rerr, facru, eps, thick, layers, nper)
+ endif
+ f = prefac * f / wn
+ endif ! wn /= 0.0d0
+
+ wn_array(iw) = wn
+ f_array(iw) = f
+
+! *** localize a peak using a parabolic interpolation
+
+ if ((iw >= 3) .and. (f1 - f0 > aerr) .and. (f1 - f > aerr)) then
+ a = (f1 - f0) + (f1 - f)
+ if (a > 4 * rerr * f1) then
+ b = 0.5d0 * (f1 - f0 + 3 * (f1 - f))
+ t = b / a
+ wpic = wn - t * dw
+ fpic = f + 0.5d0 * b * t
+ widt = dsqrt(8 * fpic / a) * dw
+ if (debug) write(*, 120) wpic, fpic, widt
+ endif ! a > 4 * rerr * f1
+ endif ! iw >= 3 ...
+ endif ! wn >= 0.0d0
+ if (mod(iw, nout) == 0) then
+ if (debug) write(*, 130) 100 * iw / nw, wn, f
+ endif
+ enddo
+ return
+100 format(5x, 'alpha = ', f9.4, 4x, 'c1 = ', f9.4, 4x, 'c2 = ', f9.4, 4x, &
+ 'beta = ', f9.4/5x, 'accuracy = ', e9.2)
+110 format(//' run (%) wn (cm**-1) pcl(wn) (cm) |', &
+ ' peak location amplitude width')
+120 format(40x, f10.2, d12.4, f10.2)
+130 format(2x, f5.1, 3x, f11.3, d14.5)
+end subroutine doeels
+subroutine change_working_dir()
+
+! This routine gets the first argument of the commandline and takes it
+! as the path to change the working directory
+! used intrinsic routines:
+! iarg returns the number of commandline arguments without the program cname.
+! chdir changes the directory and returns 0 on success.
+! trim removes blanks from strings.
+
+ character (len = 256) :: argument
+ integer :: status
+
+ if (iargc() == 1) then
+ call getarg(1, argument)
+ status = chdir(trim(argument))
+ if (status /= 0) then
+ write (*,*) '*** change directory failed ***'
+ write (*,*) 'directory tried: ', trim(argument)
+ write (*,*) 'error code (see: man chdir): ', status
+ write (*,*) 'continuing in the start directory'
+ end if
+ end if
+
+ return
+end subroutine change_working_dir
diff --git a/source/f90/fcat-analysis/eelsf90_fcat_output b/source/f90/fcat-analysis/eelsf90_fcat_output
new file mode 100644
index 0000000..9e9b62d
--- /dev/null
+++ b/source/f90/fcat-analysis/eelsf90_fcat_output
@@ -0,0 +1,1142 @@
+FCAT_eels_all_ 1
+FCAT_eels_all_ 692
+FCAT_eels_all_ 702
+FCAT_eels_all_ 2
+FCAT_eels_all_ 3
+FCAT_eels_all_ 4
+FCAT_eels_all_ 5
+FCAT_eels_all_ 6
+FCAT_eels_all_ 7
+FCAT_eels_all_ 8
+FCAT_eels_all_ 9
+FCAT_eels_all_ 10
+FCAT_eels_all_ 11
+ program eels (September 2020)
+FCAT_eels_all_ 12
+ e0 = 4.00 eV, theta = 60.0°, phia = 1.80°, phib = 1.80°
+FCAT_eels_all_ 13
+ energy losses from 50.00 to 700.0 , step = 2.000 cm**-1
+FCAT_eels_all_ 14
+ WFW: MnO layer on metal
+FCAT_eels_all_ 15
+
+FCAT_eels_all_ 16
+FCAT_eels_all_ 19
+FCAT_eels_all_ 22
+FCAT_eels_all_ 23
+FCAT_eels_all_ 24
+FCAT_eels_all_ 25
+FCAT_eels_all_ 26
+FCAT_eels_all_ 31
+FCAT_eels_all_ 34
+ 2 layer(s), nper = 1
+
+ l material thickness epsinf wto , wp q gam/wto
+FCAT_eels_all_ 35
+FCAT_eels_all_ 36
+FCAT_eels_all_ 37
+FCAT_eels_all_ 38
+FCAT_eels_all_ 39
+FCAT_eels_all_ 40
+FCAT_eels_all_ 41
+FCAT_eels_all_ 42
+ ------------------------------------------------------------------------
+FCAT_eels_all_ 43
+FCAT_eels_all_ 46
+FCAT_eels_all_ 47
+FCAT_eels_all_ 48
+FCAT_eels_all_ 49
+FCAT_eels_all_ 58
+FCAT_eels_all_ 59
+FCAT_eels_all_ 60
+FCAT_eels_all_ 64
+FCAT_eels_all_ 65
+FCAT_eels_all_ 66
+ 1 MnO 994. 4.9500 269.0000 16.0000 0.0500
+FCAT_eels_all_ 73
+FCAT_eels_all_ 74
+FCAT_eels_all_ 75
+ ------------------------------------------------------------------------
+FCAT_eels_all_ 50
+FCAT_eels_all_ 51
+FCAT_eels_all_ 52
+FCAT_eels_all_ 53
+FCAT_eels_all_ 54
+FCAT_eels_all_ 55
+FCAT_eels_all_ 56
+FCAT_eels_all_ 57
+ 2 Platinum 0.100E+04 8.9000 160000.0000 -1.0000 0.1200
+FCAT_eels_all_ 76
+
+FCAT_eels_all_ 77
+FCAT_eels_all_ 78
+FCAT_eels_all_ 79
+FCAT_eels_all_ 80
+FCAT_eels_all_ 81
+FCAT_eels_all_ 82
+FCAT_eels_all_ 83
+FCAT_eels_all_ 84
+FCAT_eels_all_ 85
+FCAT_eels_all_ 548
+FCAT_eels_all_ 549
+FCAT_eels_all_ 560
+FCAT_eels_all_ 561
+FCAT_eels_all_ 562
+FCAT_eels_all_ 563
+FCAT_eels_all_ 564
+FCAT_eels_all_ 565
+FCAT_eels_all_ 566
+FCAT_eels_all_ 567
+FCAT_eels_all_ 568
+FCAT_eels_all_ 569
+FCAT_eels_all_ 570
+FCAT_eels_all_ 581
+FCAT_eels_all_ 582
+FCAT_eels_all_ 583
+FCAT_eels_all_ 584
+FCAT_eels_all_ 585
+FCAT_eels_all_ 586
+FCAT_eels_all_ 587
+FCAT_eels_all_ 588
+FCAT_eels_all_ 589
+FCAT_eels_all_ 590
+FCAT_eels_all_ 591
+FCAT_eels_all_ 592
+FCAT_eels_all_ 593
+FCAT_eels_all_ 594
+FCAT_eels_all_ 595
+FCAT_eels_all_ 596
+FCAT_eels_all_ 597
+FCAT_eels_all_ 598
+FCAT_eels_all_ 603
+FCAT_eels_all_ 604
+FCAT_eels_all_ 652
+FCAT_eels_all_ 653
+FCAT_eels_all_ 654
+FCAT_eels_all_ 655
+FCAT_eels_all_ 656
+FCAT_eels_all_ 657
+FCAT_eels_all_ 658
+FCAT_eels_all_ 659
+FCAT_eels_all_ 660
+FCAT_eels_all_ 510
+FCAT_eels_all_ 511
+FCAT_eels_all_ 512
+FCAT_eels_all_ 513
+FCAT_eels_all_ 514
+FCAT_eels_all_ 515
+FCAT_eels_all_ 525
+FCAT_eels_all_ 526
+FCAT_eels_all_ 527
+FCAT_eels_all_ 528
+FCAT_eels_all_ 529
+FCAT_eels_all_ 530
+FCAT_eels_all_ 531
+FCAT_eels_all_ 532
+FCAT_eels_all_ 533
+FCAT_eels_all_ 534
+FCAT_eels_all_ 537
+FCAT_eels_all_ 538
+FCAT_eels_all_ 539
+FCAT_eels_all_ 540
+FCAT_eels_all_ 541
+FCAT_eels_all_ 547
+FCAT_eels_all_ 661
+FCAT_eels_all_ 662
+FCAT_eels_all_ 664
+FCAT_eels_all_ 665
+FCAT_eels_all_ 467
+FCAT_eels_all_ 468
+FCAT_eels_all_ 471
+FCAT_eels_all_ 472
+FCAT_eels_all_ 473
+FCAT_eels_all_ 474
+FCAT_eels_all_ 475
+FCAT_eels_all_ 476
+FCAT_eels_all_ 477
+FCAT_eels_all_ 351
+FCAT_eels_all_ 352
+FCAT_eels_all_ 353
+FCAT_eels_all_ 354
+FCAT_eels_all_ 355
+FCAT_eels_all_ 356
+FCAT_eels_all_ 357
+FCAT_eels_all_ 358
+FCAT_eels_all_ 359
+FCAT_eels_all_ 360
+FCAT_eels_all_ 361
+FCAT_eels_all_ 362
+FCAT_eels_all_ 363
+FCAT_eels_all_ 364
+FCAT_eels_all_ 365
+FCAT_eels_all_ 366
+FCAT_eels_all_ 367
+FCAT_eels_all_ 368
+FCAT_eels_all_ 369
+FCAT_eels_all_ 370
+FCAT_eels_all_ 371
+FCAT_eels_all_ 372
+FCAT_eels_all_ 373
+FCAT_eels_all_ 266
+FCAT_eels_all_ 267
+FCAT_eels_all_ 268
+FCAT_eels_all_ 374
+FCAT_eels_all_ 375
+FCAT_eels_all_ 376
+FCAT_eels_all_ 377
+FCAT_eels_all_ 378
+FCAT_eels_all_ 379
+FCAT_eels_all_ 380
+FCAT_eels_all_ 381
+FCAT_eels_all_ 382
+FCAT_eels_all_ 383
+FCAT_eels_all_ 270
+FCAT_eels_all_ 271
+FCAT_eels_all_ 272
+FCAT_eels_all_ 273
+FCAT_eels_all_ 274
+FCAT_eels_all_ 275
+FCAT_eels_all_ 276
+FCAT_eels_all_ 277
+FCAT_eels_all_ 278
+FCAT_eels_all_ 279
+FCAT_eels_all_ 280
+FCAT_eels_all_ 283
+FCAT_eels_all_ 285
+FCAT_eels_all_ 286
+FCAT_eels_all_ 107
+FCAT_eels_all_ 108
+FCAT_eels_all_ 109
+FCAT_eels_all_ 110
+FCAT_eels_all_ 111
+FCAT_eels_all_ 112
+FCAT_eels_all_ 113
+FCAT_eels_all_ 114
+FCAT_eels_all_ 119
+FCAT_eels_all_ 120
+FCAT_eels_all_ 121
+FCAT_eels_all_ 122
+FCAT_eels_all_ 123
+FCAT_eels_all_ 124
+FCAT_eels_all_ 197
+FCAT_eels_all_ 198
+FCAT_eels_all_ 200
+FCAT_eels_all_ 201
+FCAT_eels_all_ 202
+FCAT_eels_all_ 203
+FCAT_eels_all_ 212
+FCAT_eels_all_ 213
+FCAT_eels_all_ 214
+FCAT_eels_all_ 215
+FCAT_eels_all_ 219
+FCAT_eels_all_ 220
+FCAT_eels_all_ 221
+FCAT_eels_all_ 204
+FCAT_eels_all_ 205
+FCAT_eels_all_ 207
+FCAT_eels_all_ 208
+FCAT_eels_all_ 209
+FCAT_eels_all_ 210
+FCAT_eels_all_ 287
+FCAT_eels_all_ 291
+FCAT_eels_all_ 292
+FCAT_eels_all_ 384
+FCAT_eels_all_ 385
+FCAT_eels_all_ 386
+FCAT_eels_all_ 387
+FCAT_eels_all_ 388
+FCAT_eels_all_ 389
+FCAT_eels_all_ 390
+FCAT_eels_all_ 391
+FCAT_eels_all_ 392
+FCAT_eels_all_ 393
+FCAT_eels_all_ 394
+FCAT_eels_all_ 395
+FCAT_eels_all_ 396
+FCAT_eels_all_ 397
+FCAT_eels_all_ 398
+FCAT_eels_all_ 399
+FCAT_eels_all_ 400
+FCAT_eels_all_ 401
+FCAT_eels_all_ 402
+FCAT_eels_all_ 444
+FCAT_eels_all_ 445
+FCAT_eels_all_ 446
+FCAT_eels_all_ 447
+FCAT_eels_all_ 448
+FCAT_eels_all_ 449
+FCAT_eels_all_ 450
+FCAT_eels_all_ 451
+FCAT_eels_all_ 452
+FCAT_eels_all_ 453
+FCAT_eels_all_ 454
+FCAT_eels_all_ 455
+FCAT_eels_all_ 456
+FCAT_eels_all_ 457
+FCAT_eels_all_ 403
+FCAT_eels_all_ 405
+FCAT_eels_all_ 406
+FCAT_eels_all_ 410
+FCAT_eels_all_ 411
+FCAT_eels_all_ 412
+FCAT_eels_all_ 413
+FCAT_eels_all_ 414
+FCAT_eels_all_ 415
+FCAT_eels_all_ 416
+FCAT_eels_all_ 417
+FCAT_eels_all_ 418
+FCAT_eels_all_ 419
+FCAT_eels_all_ 420
+FCAT_eels_all_ 421
+FCAT_eels_all_ 422
+FCAT_eels_all_ 423
+FCAT_eels_all_ 425
+FCAT_eels_all_ 426
+FCAT_eels_all_ 427
+FCAT_eels_all_ 428
+FCAT_eels_all_ 429
+FCAT_eels_all_ 430
+FCAT_eels_all_ 434
+FCAT_eels_all_ 435
+FCAT_eels_all_ 436
+FCAT_eels_all_ 437
+FCAT_eels_all_ 438
+FCAT_eels_all_ 439
+FCAT_eels_all_ 440
+FCAT_eels_all_ 441
+FCAT_eels_all_ 442
+FCAT_eels_all_ 443
+FCAT_eels_all_ 431
+FCAT_eels_all_ 432
+FCAT_eels_all_ 433
+FCAT_eels_all_ 458
+FCAT_eels_all_ 459
+FCAT_eels_all_ 460
+FCAT_eels_all_ 461
+FCAT_eels_all_ 465
+FCAT_eels_all_ 466
+FCAT_eels_all_ 478
+FCAT_eels_all_ 482
+FCAT_eels_all_ 483
+FCAT_eels_all_ 293
+FCAT_eels_all_ 297
+FCAT_eels_all_ 298
+FCAT_eels_all_ 299
+FCAT_eels_all_ 300
+FCAT_eels_all_ 305
+FCAT_eels_all_ 306
+FCAT_eels_all_ 309
+FCAT_eels_all_ 310
+FCAT_eels_all_ 222
+FCAT_eels_all_ 223
+FCAT_eels_all_ 224
+FCAT_eels_all_ 225
+FCAT_eels_all_ 226
+FCAT_eels_all_ 227
+FCAT_eels_all_ 231
+FCAT_eels_all_ 232
+FCAT_eels_all_ 233
+FCAT_eels_all_ 234
+FCAT_eels_all_ 235
+FCAT_eels_all_ 236
+FCAT_eels_all_ 237
+FCAT_eels_all_ 238
+FCAT_eels_all_ 239
+FCAT_eels_all_ 240
+FCAT_eels_all_ 245
+FCAT_eels_all_ 256
+FCAT_eels_all_ 257
+FCAT_eels_all_ 258
+FCAT_eels_all_ 259
+FCAT_eels_all_ 260
+FCAT_eels_all_ 261
+FCAT_eels_all_ 262
+FCAT_eels_all_ 263
+FCAT_eels_all_ 264
+FCAT_eels_all_ 265
+FCAT_eels_all_ 311
+FCAT_eels_all_ 314
+FCAT_eels_all_ 316
+FCAT_eels_all_ 317
+FCAT_eels_all_ 318
+FCAT_eels_all_ 322
+FCAT_eels_all_ 323
+FCAT_eels_all_ 242
+FCAT_eels_all_ 243
+FCAT_eels_all_ 244
+FCAT_eels_all_ 246
+FCAT_eels_all_ 247
+FCAT_eels_all_ 248
+FCAT_eels_all_ 249
+FCAT_eels_all_ 250
+FCAT_eels_all_ 251
+FCAT_eels_all_ 252
+FCAT_eels_all_ 253
+FCAT_eels_all_ 254
+FCAT_eels_all_ 255
+FCAT_eels_all_ 484
+FCAT_eels_all_ 488
+FCAT_eels_all_ 489
+FCAT_eels_all_ 490
+FCAT_eels_all_ 491
+FCAT_eels_all_ 324
+FCAT_eels_all_ 328
+FCAT_eels_all_ 329
+FCAT_eels_all_ 330
+FCAT_eels_all_ 331
+FCAT_eels_all_ 332
+FCAT_eels_all_ 333
+FCAT_eels_all_ 334
+FCAT_eels_all_ 335
+FCAT_eels_all_ 336
+FCAT_eels_all_ 241
+FCAT_eels_all_ 337
+FCAT_eels_all_ 338
+FCAT_eels_all_ 340
+FCAT_eels_all_ 341
+FCAT_eels_all_ 342
+FCAT_eels_all_ 346
+FCAT_eels_all_ 347
+FCAT_eels_all_ 115
+FCAT_eels_all_ 116
+FCAT_eels_all_ 117
+FCAT_eels_all_ 492
+FCAT_eels_all_ 493
+FCAT_eels_all_ 494
+FCAT_eels_all_ 501
+FCAT_eels_all_ 502
+FCAT_eels_all_ 508
+FCAT_eels_all_ 509
+FCAT_eels_all_ 666
+FCAT_eels_all_ 667
+FCAT_eels_all_ 668
+FCAT_eels_all_ 669
+FCAT_eels_all_ 670
+FCAT_eels_all_ 671
+FCAT_eels_all_ 682
+FCAT_eels_all_ 683
+FCAT_eels_all_ 686
+FCAT_eels_all_ 672
+FCAT_eels_all_ 673
+FCAT_eels_all_ 674
+FCAT_eels_all_ 675
+FCAT_eels_all_ 676
+FCAT_eels_all_ 677
+FCAT_eels_all_ 678
+FCAT_eels_all_ 679
+FCAT_eels_all_ 680
+FCAT_eels_all_ 681
+FCAT_eels_all_ 684
+FCAT_eels_all_ 685
+FCAT_eels_all_ 307
+FCAT_eels_all_ 308
+FCAT_eels_all_ 687
+FCAT_eels_all_ 86
+FCAT_eels_all_ 87
+FCAT_eels_all_ 88
+FCAT_eels_all_ 89
+FCAT_eels_all_ 90
+FCAT_eels_all_ 91
+FCAT_eels_all_ 92
+FCAT_eels_all_count 1 1
+FCAT_eels_all_count 2 1
+FCAT_eels_all_count 3 1
+FCAT_eels_all_count 4 1
+FCAT_eels_all_count 5 1
+FCAT_eels_all_count 6 1
+FCAT_eels_all_count 7 1
+FCAT_eels_all_count 8 1
+FCAT_eels_all_count 9 1
+FCAT_eels_all_count 10 1
+FCAT_eels_all_count 11 1
+FCAT_eels_all_count 12 1
+FCAT_eels_all_count 13 1
+FCAT_eels_all_count 14 1
+FCAT_eels_all_count 15 1
+FCAT_eels_all_count 16 1
+FCAT_eels_all_count 17 0
+FCAT_eels_all_count 18 0
+FCAT_eels_all_count 19 1
+FCAT_eels_all_count 20 0
+FCAT_eels_all_count 21 0
+FCAT_eels_all_count 22 1
+FCAT_eels_all_count 23 1
+FCAT_eels_all_count 24 1
+FCAT_eels_all_count 25 1
+FCAT_eels_all_count 26 1
+FCAT_eels_all_count 27 0
+FCAT_eels_all_count 28 0
+FCAT_eels_all_count 29 0
+FCAT_eels_all_count 30 0
+FCAT_eels_all_count 31 1
+FCAT_eels_all_count 32 0
+FCAT_eels_all_count 33 0
+FCAT_eels_all_count 34 1
+FCAT_eels_all_count 35 1
+FCAT_eels_all_count 36 1
+FCAT_eels_all_count 37 1
+FCAT_eels_all_count 38 2
+FCAT_eels_all_count 39 2
+FCAT_eels_all_count 40 2
+FCAT_eels_all_count 41 2
+FCAT_eels_all_count 42 2
+FCAT_eels_all_count 43 2
+FCAT_eels_all_count 44 0
+FCAT_eels_all_count 45 0
+FCAT_eels_all_count 46 2
+FCAT_eels_all_count 47 2
+FCAT_eels_all_count 48 2
+FCAT_eels_all_count 49 1
+FCAT_eels_all_count 50 1
+FCAT_eels_all_count 51 1
+FCAT_eels_all_count 52 1
+FCAT_eels_all_count 53 1
+FCAT_eels_all_count 54 1
+FCAT_eels_all_count 55 1
+FCAT_eels_all_count 56 1
+FCAT_eels_all_count 57 1
+FCAT_eels_all_count 58 2
+FCAT_eels_all_count 59 2
+FCAT_eels_all_count 60 2
+FCAT_eels_all_count 61 0
+FCAT_eels_all_count 62 0
+FCAT_eels_all_count 63 0
+FCAT_eels_all_count 64 2
+FCAT_eels_all_count 65 2
+FCAT_eels_all_count 66 2
+FCAT_eels_all_count 67 0
+FCAT_eels_all_count 68 0
+FCAT_eels_all_count 69 0
+FCAT_eels_all_count 70 0
+FCAT_eels_all_count 71 0
+FCAT_eels_all_count 72 0
+FCAT_eels_all_count 73 2
+FCAT_eels_all_count 74 2
+FCAT_eels_all_count 75 2
+FCAT_eels_all_count 76 1
+FCAT_eels_all_count 77 1
+FCAT_eels_all_count 78 1
+FCAT_eels_all_count 79 1
+FCAT_eels_all_count 80 1
+FCAT_eels_all_count 81 1
+FCAT_eels_all_count 82 1
+FCAT_eels_all_count 83 1
+FCAT_eels_all_count 84 1
+FCAT_eels_all_count 85 1
+FCAT_eels_all_count 86 1
+FCAT_eels_all_count 87 1
+FCAT_eels_all_count 88 1
+FCAT_eels_all_count 89 326
+FCAT_eels_all_count 90 326
+FCAT_eels_all_count 91 1
+FCAT_eels_all_count 92 1
+FCAT_eels_all_count 93 0
+FCAT_eels_all_count 94 0
+FCAT_eels_all_count 95 0
+FCAT_eels_all_count 96 0
+FCAT_eels_all_count 97 0
+FCAT_eels_all_count 98 0
+FCAT_eels_all_count 99 0
+FCAT_eels_all_count 100 0
+FCAT_eels_all_count 101 0
+FCAT_eels_all_count 102 0
+FCAT_eels_all_count 103 0
+FCAT_eels_all_count 104 0
+FCAT_eels_all_count 105 0
+FCAT_eels_all_count 106 0
+FCAT_eels_all_count 107 40156
+FCAT_eels_all_count 108 40156
+FCAT_eels_all_count 109 40156
+FCAT_eels_all_count 110 40156
+FCAT_eels_all_count 111 40156
+FCAT_eels_all_count 112 40156
+FCAT_eels_all_count 113 63246
+FCAT_eels_all_count 114 63246
+FCAT_eels_all_count 115 17169
+FCAT_eels_all_count 116 17169
+FCAT_eels_all_count 117 17169
+FCAT_eels_all_count 118 0
+FCAT_eels_all_count 119 46077
+FCAT_eels_all_count 120 46077
+FCAT_eels_all_count 121 40156
+FCAT_eels_all_count 122 22987
+FCAT_eels_all_count 123 22987
+FCAT_eels_all_count 124 22987
+FCAT_eels_all_count 125 0
+FCAT_eels_all_count 126 0
+FCAT_eels_all_count 127 0
+FCAT_eels_all_count 128 0
+FCAT_eels_all_count 129 0
+FCAT_eels_all_count 130 0
+FCAT_eels_all_count 131 0
+FCAT_eels_all_count 132 0
+FCAT_eels_all_count 133 0
+FCAT_eels_all_count 134 0
+FCAT_eels_all_count 135 0
+FCAT_eels_all_count 136 0
+FCAT_eels_all_count 137 0
+FCAT_eels_all_count 138 0
+FCAT_eels_all_count 139 0
+FCAT_eels_all_count 140 0
+FCAT_eels_all_count 141 0
+FCAT_eels_all_count 142 0
+FCAT_eels_all_count 143 0
+FCAT_eels_all_count 144 0
+FCAT_eels_all_count 145 0
+FCAT_eels_all_count 146 0
+FCAT_eels_all_count 147 0
+FCAT_eels_all_count 148 0
+FCAT_eels_all_count 149 0
+FCAT_eels_all_count 150 0
+FCAT_eels_all_count 151 0
+FCAT_eels_all_count 152 0
+FCAT_eels_all_count 153 0
+FCAT_eels_all_count 154 0
+FCAT_eels_all_count 155 0
+FCAT_eels_all_count 156 0
+FCAT_eels_all_count 157 0
+FCAT_eels_all_count 158 0
+FCAT_eels_all_count 159 0
+FCAT_eels_all_count 160 0
+FCAT_eels_all_count 161 0
+FCAT_eels_all_count 162 0
+FCAT_eels_all_count 163 0
+FCAT_eels_all_count 164 0
+FCAT_eels_all_count 165 0
+FCAT_eels_all_count 166 0
+FCAT_eels_all_count 167 0
+FCAT_eels_all_count 168 0
+FCAT_eels_all_count 169 0
+FCAT_eels_all_count 170 0
+FCAT_eels_all_count 171 0
+FCAT_eels_all_count 172 0
+FCAT_eels_all_count 173 0
+FCAT_eels_all_count 174 0
+FCAT_eels_all_count 175 0
+FCAT_eels_all_count 176 0
+FCAT_eels_all_count 177 0
+FCAT_eels_all_count 178 0
+FCAT_eels_all_count 179 0
+FCAT_eels_all_count 180 0
+FCAT_eels_all_count 181 0
+FCAT_eels_all_count 182 0
+FCAT_eels_all_count 183 0
+FCAT_eels_all_count 184 0
+FCAT_eels_all_count 185 0
+FCAT_eels_all_count 186 0
+FCAT_eels_all_count 187 0
+FCAT_eels_all_count 188 0
+FCAT_eels_all_count 189 0
+FCAT_eels_all_count 190 0
+FCAT_eels_all_count 191 0
+FCAT_eels_all_count 192 0
+FCAT_eels_all_count 193 0
+FCAT_eels_all_count 194 0
+FCAT_eels_all_count 195 0
+FCAT_eels_all_count 196 0
+FCAT_eels_all_count 197 22987
+FCAT_eels_all_count 198 22987
+FCAT_eels_all_count 199 0
+FCAT_eels_all_count 200 22987
+FCAT_eels_all_count 201 40156
+FCAT_eels_all_count 202 63246
+FCAT_eels_all_count 203 63246
+FCAT_eels_all_count 204 40156
+FCAT_eels_all_count 205 40156
+FCAT_eels_all_count 206 0
+FCAT_eels_all_count 207 40156
+FCAT_eels_all_count 208 40156
+FCAT_eels_all_count 209 40156
+FCAT_eels_all_count 210 40156
+FCAT_eels_all_count 211 0
+FCAT_eels_all_count 212 23090
+FCAT_eels_all_count 213 23090
+FCAT_eels_all_count 214 23090
+FCAT_eels_all_count 215 23090
+FCAT_eels_all_count 216 0
+FCAT_eels_all_count 217 0
+FCAT_eels_all_count 218 0
+FCAT_eels_all_count 219 23090
+FCAT_eels_all_count 220 23090
+FCAT_eels_all_count 221 23090
+FCAT_eels_all_count 222 41010
+FCAT_eels_all_count 223 41010
+FCAT_eels_all_count 224 41010
+FCAT_eels_all_count 225 41010
+FCAT_eels_all_count 226 41010
+FCAT_eels_all_count 227 41010
+FCAT_eels_all_count 228 0
+FCAT_eels_all_count 229 0
+FCAT_eels_all_count 230 0
+FCAT_eels_all_count 231 41010
+FCAT_eels_all_count 232 41010
+FCAT_eels_all_count 233 41010
+FCAT_eels_all_count 234 41010
+FCAT_eels_all_count 235 41010
+FCAT_eels_all_count 236 41010
+FCAT_eels_all_count 237 41010
+FCAT_eels_all_count 238 41010
+FCAT_eels_all_count 239 41010
+FCAT_eels_all_count 240 41010
+FCAT_eels_all_count 241 20833
+FCAT_eels_all_count 242 19851
+FCAT_eels_all_count 243 19851
+FCAT_eels_all_count 244 19851
+FCAT_eels_all_count 245 41010
+FCAT_eels_all_count 246 40684
+FCAT_eels_all_count 247 40684
+FCAT_eels_all_count 248 40684
+FCAT_eels_all_count 249 40684
+FCAT_eels_all_count 250 40684
+FCAT_eels_all_count 251 40684
+FCAT_eels_all_count 252 40684
+FCAT_eels_all_count 253 40684
+FCAT_eels_all_count 254 40684
+FCAT_eels_all_count 255 40684
+FCAT_eels_all_count 256 326
+FCAT_eels_all_count 257 326
+FCAT_eels_all_count 258 326
+FCAT_eels_all_count 259 326
+FCAT_eels_all_count 260 326
+FCAT_eels_all_count 261 326
+FCAT_eels_all_count 262 41010
+FCAT_eels_all_count 263 41010
+FCAT_eels_all_count 264 41010
+FCAT_eels_all_count 265 41010
+FCAT_eels_all_count 266 14598
+FCAT_eels_all_count 267 326
+FCAT_eels_all_count 268 326
+FCAT_eels_all_count 269 0
+FCAT_eels_all_count 270 14272
+FCAT_eels_all_count 271 14272
+FCAT_eels_all_count 272 14272
+FCAT_eels_all_count 273 14272
+FCAT_eels_all_count 274 14272
+FCAT_eels_all_count 275 14272
+FCAT_eels_all_count 276 14272
+FCAT_eels_all_count 277 14272
+FCAT_eels_all_count 278 14272
+FCAT_eels_all_count 279 14272
+FCAT_eels_all_count 280 14272
+FCAT_eels_all_count 281 0
+FCAT_eels_all_count 282 0
+FCAT_eels_all_count 283 14272
+FCAT_eels_all_count 284 0
+FCAT_eels_all_count 285 14272
+FCAT_eels_all_count 286 14272
+FCAT_eels_all_count 287 14272
+FCAT_eels_all_count 288 0
+FCAT_eels_all_count 289 0
+FCAT_eels_all_count 290 0
+FCAT_eels_all_count 291 14272
+FCAT_eels_all_count 292 14272
+FCAT_eels_all_count 293 10758
+FCAT_eels_all_count 294 0
+FCAT_eels_all_count 295 0
+FCAT_eels_all_count 296 0
+FCAT_eels_all_count 297 10758
+FCAT_eels_all_count 298 10758
+FCAT_eels_all_count 299 10758
+FCAT_eels_all_count 300 10758
+FCAT_eels_all_count 301 0
+FCAT_eels_all_count 302 0
+FCAT_eels_all_count 303 0
+FCAT_eels_all_count 304 0
+FCAT_eels_all_count 305 10758
+FCAT_eels_all_count 306 10758
+FCAT_eels_all_count 307 74
+FCAT_eels_all_count 308 74
+FCAT_eels_all_count 309 10758
+FCAT_eels_all_count 310 10758
+FCAT_eels_all_count 311 10758
+FCAT_eels_all_count 312 0
+FCAT_eels_all_count 313 0
+FCAT_eels_all_count 314 10758
+FCAT_eels_all_count 315 0
+FCAT_eels_all_count 316 10758
+FCAT_eels_all_count 317 10758
+FCAT_eels_all_count 318 10758
+FCAT_eels_all_count 319 0
+FCAT_eels_all_count 320 0
+FCAT_eels_all_count 321 0
+FCAT_eels_all_count 322 10758
+FCAT_eels_all_count 323 10758
+FCAT_eels_all_count 324 15126
+FCAT_eels_all_count 325 0
+FCAT_eels_all_count 326 0
+FCAT_eels_all_count 327 0
+FCAT_eels_all_count 328 15126
+FCAT_eels_all_count 329 15126
+FCAT_eels_all_count 330 15126
+FCAT_eels_all_count 331 15126
+FCAT_eels_all_count 332 15126
+FCAT_eels_all_count 333 15126
+FCAT_eels_all_count 334 15126
+FCAT_eels_all_count 335 15126
+FCAT_eels_all_count 336 15126
+FCAT_eels_all_count 337 15126
+FCAT_eels_all_count 338 15126
+FCAT_eels_all_count 339 0
+FCAT_eels_all_count 340 15126
+FCAT_eels_all_count 341 15126
+FCAT_eels_all_count 342 15126
+FCAT_eels_all_count 343 0
+FCAT_eels_all_count 344 0
+FCAT_eels_all_count 345 0
+FCAT_eels_all_count 346 15126
+FCAT_eels_all_count 347 15126
+FCAT_eels_all_count 348 0
+FCAT_eels_all_count 349 0
+FCAT_eels_all_count 350 0
+FCAT_eels_all_count 351 978
+FCAT_eels_all_count 352 978
+FCAT_eels_all_count 353 978
+FCAT_eels_all_count 354 978
+FCAT_eels_all_count 355 978
+FCAT_eels_all_count 356 978
+FCAT_eels_all_count 357 978
+FCAT_eels_all_count 358 978
+FCAT_eels_all_count 359 978
+FCAT_eels_all_count 360 978
+FCAT_eels_all_count 361 978
+FCAT_eels_all_count 362 978
+FCAT_eels_all_count 363 978
+FCAT_eels_all_count 364 978
+FCAT_eels_all_count 365 978
+FCAT_eels_all_count 366 978
+FCAT_eels_all_count 367 978
+FCAT_eels_all_count 368 978
+FCAT_eels_all_count 369 978
+FCAT_eels_all_count 370 978
+FCAT_eels_all_count 371 978
+FCAT_eels_all_count 372 978
+FCAT_eels_all_count 373 978
+FCAT_eels_all_count 374 978
+FCAT_eels_all_count 375 978
+FCAT_eels_all_count 376 978
+FCAT_eels_all_count 377 978
+FCAT_eels_all_count 378 978
+FCAT_eels_all_count 379 978
+FCAT_eels_all_count 380 978
+FCAT_eels_all_count 381 978
+FCAT_eels_all_count 382 978
+FCAT_eels_all_count 383 7824
+FCAT_eels_all_count 384 7824
+FCAT_eels_all_count 385 978
+FCAT_eels_all_count 386 978
+FCAT_eels_all_count 387 3960
+FCAT_eels_all_count 388 3960
+FCAT_eels_all_count 389 3960
+FCAT_eels_all_count 390 27720
+FCAT_eels_all_count 391 27720
+FCAT_eels_all_count 392 27720
+FCAT_eels_all_count 393 3960
+FCAT_eels_all_count 394 3960
+FCAT_eels_all_count 395 3960
+FCAT_eels_all_count 396 3960
+FCAT_eels_all_count 397 3960
+FCAT_eels_all_count 398 3960
+FCAT_eels_all_count 399 3960
+FCAT_eels_all_count 400 3960
+FCAT_eels_all_count 401 3960
+FCAT_eels_all_count 402 3960
+FCAT_eels_all_count 403 2982
+FCAT_eels_all_count 404 0
+FCAT_eels_all_count 405 2982
+FCAT_eels_all_count 406 2982
+FCAT_eels_all_count 407 0
+FCAT_eels_all_count 408 0
+FCAT_eels_all_count 409 0
+FCAT_eels_all_count 410 2982
+FCAT_eels_all_count 411 2982
+FCAT_eels_all_count 412 513
+FCAT_eels_all_count 413 513
+FCAT_eels_all_count 414 513
+FCAT_eels_all_count 415 4104
+FCAT_eels_all_count 416 4104
+FCAT_eels_all_count 417 4104
+FCAT_eels_all_count 418 513
+FCAT_eels_all_count 419 513
+FCAT_eels_all_count 420 4104
+FCAT_eels_all_count 421 4104
+FCAT_eels_all_count 422 4104
+FCAT_eels_all_count 423 513
+FCAT_eels_all_count 424 0
+FCAT_eels_all_count 425 2469
+FCAT_eels_all_count 426 2469
+FCAT_eels_all_count 427 2469
+FCAT_eels_all_count 428 2469
+FCAT_eels_all_count 429 2469
+FCAT_eels_all_count 430 2469
+FCAT_eels_all_count 431 2469
+FCAT_eels_all_count 432 2469
+FCAT_eels_all_count 433 2469
+FCAT_eels_all_count 434 2469
+FCAT_eels_all_count 435 2469
+FCAT_eels_all_count 436 1491
+FCAT_eels_all_count 437 1491
+FCAT_eels_all_count 438 1491
+FCAT_eels_all_count 439 1491
+FCAT_eels_all_count 440 11928
+FCAT_eels_all_count 441 11928
+FCAT_eels_all_count 442 11928
+FCAT_eels_all_count 443 1491
+FCAT_eels_all_count 444 978
+FCAT_eels_all_count 445 978
+FCAT_eels_all_count 446 978
+FCAT_eels_all_count 447 978
+FCAT_eels_all_count 448 7824
+FCAT_eels_all_count 449 7824
+FCAT_eels_all_count 450 7824
+FCAT_eels_all_count 451 978
+FCAT_eels_all_count 452 978
+FCAT_eels_all_count 453 7824
+FCAT_eels_all_count 454 7824
+FCAT_eels_all_count 455 7824
+FCAT_eels_all_count 456 978
+FCAT_eels_all_count 457 978
+FCAT_eels_all_count 458 978
+FCAT_eels_all_count 459 978
+FCAT_eels_all_count 460 978
+FCAT_eels_all_count 461 978
+FCAT_eels_all_count 462 0
+FCAT_eels_all_count 463 0
+FCAT_eels_all_count 464 0
+FCAT_eels_all_count 465 978
+FCAT_eels_all_count 466 978
+FCAT_eels_all_count 467 326
+FCAT_eels_all_count 468 326
+FCAT_eels_all_count 469 0
+FCAT_eels_all_count 470 0
+FCAT_eels_all_count 471 326
+FCAT_eels_all_count 472 326
+FCAT_eels_all_count 473 326
+FCAT_eels_all_count 474 326
+FCAT_eels_all_count 475 326
+FCAT_eels_all_count 476 326
+FCAT_eels_all_count 477 326
+FCAT_eels_all_count 478 326
+FCAT_eels_all_count 479 0
+FCAT_eels_all_count 480 0
+FCAT_eels_all_count 481 0
+FCAT_eels_all_count 482 326
+FCAT_eels_all_count 483 326
+FCAT_eels_all_count 484 326
+FCAT_eels_all_count 485 0
+FCAT_eels_all_count 486 0
+FCAT_eels_all_count 487 0
+FCAT_eels_all_count 488 326
+FCAT_eels_all_count 489 326
+FCAT_eels_all_count 490 326
+FCAT_eels_all_count 491 326
+FCAT_eels_all_count 492 326
+FCAT_eels_all_count 493 326
+FCAT_eels_all_count 494 326
+FCAT_eels_all_count 495 0
+FCAT_eels_all_count 496 0
+FCAT_eels_all_count 497 0
+FCAT_eels_all_count 498 0
+FCAT_eels_all_count 499 0
+FCAT_eels_all_count 500 0
+FCAT_eels_all_count 501 326
+FCAT_eels_all_count 502 978
+FCAT_eels_all_count 503 0
+FCAT_eels_all_count 504 0
+FCAT_eels_all_count 505 0
+FCAT_eels_all_count 506 0
+FCAT_eels_all_count 507 0
+FCAT_eels_all_count 508 326
+FCAT_eels_all_count 509 326
+FCAT_eels_all_count 510 326
+FCAT_eels_all_count 511 326
+FCAT_eels_all_count 512 652
+FCAT_eels_all_count 513 652
+FCAT_eels_all_count 514 652
+FCAT_eels_all_count 515 652
+FCAT_eels_all_count 516 0
+FCAT_eels_all_count 517 0
+FCAT_eels_all_count 518 0
+FCAT_eels_all_count 519 0
+FCAT_eels_all_count 520 0
+FCAT_eels_all_count 521 0
+FCAT_eels_all_count 522 0
+FCAT_eels_all_count 523 0
+FCAT_eels_all_count 524 0
+FCAT_eels_all_count 525 652
+FCAT_eels_all_count 526 652
+FCAT_eels_all_count 527 652
+FCAT_eels_all_count 528 652
+FCAT_eels_all_count 529 652
+FCAT_eels_all_count 530 652
+FCAT_eels_all_count 531 652
+FCAT_eels_all_count 532 326
+FCAT_eels_all_count 533 326
+FCAT_eels_all_count 534 652
+FCAT_eels_all_count 535 0
+FCAT_eels_all_count 536 0
+FCAT_eels_all_count 537 652
+FCAT_eels_all_count 538 652
+FCAT_eels_all_count 539 652
+FCAT_eels_all_count 540 652
+FCAT_eels_all_count 541 326
+FCAT_eels_all_count 542 0
+FCAT_eels_all_count 543 0
+FCAT_eels_all_count 544 0
+FCAT_eels_all_count 545 0
+FCAT_eels_all_count 546 0
+FCAT_eels_all_count 547 326
+FCAT_eels_all_count 548 1
+FCAT_eels_all_count 549 1
+FCAT_eels_all_count 550 0
+FCAT_eels_all_count 551 0
+FCAT_eels_all_count 552 0
+FCAT_eels_all_count 553 0
+FCAT_eels_all_count 554 0
+FCAT_eels_all_count 555 0
+FCAT_eels_all_count 556 0
+FCAT_eels_all_count 557 0
+FCAT_eels_all_count 558 0
+FCAT_eels_all_count 559 0
+FCAT_eels_all_count 560 1
+FCAT_eels_all_count 561 1
+FCAT_eels_all_count 562 1
+FCAT_eels_all_count 563 53
+FCAT_eels_all_count 564 53
+FCAT_eels_all_count 565 1
+FCAT_eels_all_count 566 1
+FCAT_eels_all_count 567 1
+FCAT_eels_all_count 568 1
+FCAT_eels_all_count 569 1
+FCAT_eels_all_count 570 1
+FCAT_eels_all_count 571 0
+FCAT_eels_all_count 572 0
+FCAT_eels_all_count 573 0
+FCAT_eels_all_count 574 0
+FCAT_eels_all_count 575 0
+FCAT_eels_all_count 576 0
+FCAT_eels_all_count 577 0
+FCAT_eels_all_count 578 0
+FCAT_eels_all_count 579 0
+FCAT_eels_all_count 580 0
+FCAT_eels_all_count 581 1
+FCAT_eels_all_count 582 1
+FCAT_eels_all_count 583 1
+FCAT_eels_all_count 584 1
+FCAT_eels_all_count 585 1
+FCAT_eels_all_count 586 1
+FCAT_eels_all_count 587 1
+FCAT_eels_all_count 588 1
+FCAT_eels_all_count 589 1
+FCAT_eels_all_count 590 1
+FCAT_eels_all_count 591 1
+FCAT_eels_all_count 592 1
+FCAT_eels_all_count 593 1
+FCAT_eels_all_count 594 1
+FCAT_eels_all_count 595 1
+FCAT_eels_all_count 596 1
+FCAT_eels_all_count 597 1
+FCAT_eels_all_count 598 1
+FCAT_eels_all_count 599 0
+FCAT_eels_all_count 600 0
+FCAT_eels_all_count 601 0
+FCAT_eels_all_count 602 0
+FCAT_eels_all_count 603 1
+FCAT_eels_all_count 604 1
+FCAT_eels_all_count 605 0
+FCAT_eels_all_count 606 0
+FCAT_eels_all_count 607 0
+FCAT_eels_all_count 608 0
+FCAT_eels_all_count 609 0
+FCAT_eels_all_count 610 0
+FCAT_eels_all_count 611 0
+FCAT_eels_all_count 612 0
+FCAT_eels_all_count 613 0
+FCAT_eels_all_count 614 0
+FCAT_eels_all_count 615 0
+FCAT_eels_all_count 616 0
+FCAT_eels_all_count 617 0
+FCAT_eels_all_count 618 0
+FCAT_eels_all_count 619 0
+FCAT_eels_all_count 620 0
+FCAT_eels_all_count 621 0
+FCAT_eels_all_count 622 0
+FCAT_eels_all_count 623 0
+FCAT_eels_all_count 624 0
+FCAT_eels_all_count 625 0
+FCAT_eels_all_count 626 0
+FCAT_eels_all_count 627 0
+FCAT_eels_all_count 628 0
+FCAT_eels_all_count 629 0
+FCAT_eels_all_count 630 0
+FCAT_eels_all_count 631 0
+FCAT_eels_all_count 632 0
+FCAT_eels_all_count 633 0
+FCAT_eels_all_count 634 0
+FCAT_eels_all_count 635 0
+FCAT_eels_all_count 636 0
+FCAT_eels_all_count 637 0
+FCAT_eels_all_count 638 0
+FCAT_eels_all_count 639 0
+FCAT_eels_all_count 640 0
+FCAT_eels_all_count 641 0
+FCAT_eels_all_count 642 0
+FCAT_eels_all_count 643 0
+FCAT_eels_all_count 644 0
+FCAT_eels_all_count 645 0
+FCAT_eels_all_count 646 0
+FCAT_eels_all_count 647 0
+FCAT_eels_all_count 648 0
+FCAT_eels_all_count 649 0
+FCAT_eels_all_count 650 0
+FCAT_eels_all_count 651 0
+FCAT_eels_all_count 652 1
+FCAT_eels_all_count 653 1
+FCAT_eels_all_count 654 326
+FCAT_eels_all_count 655 326
+FCAT_eels_all_count 656 326
+FCAT_eels_all_count 657 326
+FCAT_eels_all_count 658 326
+FCAT_eels_all_count 659 326
+FCAT_eels_all_count 660 326
+FCAT_eels_all_count 661 326
+FCAT_eels_all_count 662 326
+FCAT_eels_all_count 663 0
+FCAT_eels_all_count 664 326
+FCAT_eels_all_count 665 326
+FCAT_eels_all_count 666 326
+FCAT_eels_all_count 667 326
+FCAT_eels_all_count 668 326
+FCAT_eels_all_count 669 326
+FCAT_eels_all_count 670 326
+FCAT_eels_all_count 671 326
+FCAT_eels_all_count 672 2
+FCAT_eels_all_count 673 2
+FCAT_eels_all_count 674 2
+FCAT_eels_all_count 675 2
+FCAT_eels_all_count 676 2
+FCAT_eels_all_count 677 2
+FCAT_eels_all_count 678 2
+FCAT_eels_all_count 679 2
+FCAT_eels_all_count 680 2
+FCAT_eels_all_count 681 2
+FCAT_eels_all_count 682 326
+FCAT_eels_all_count 683 326
+FCAT_eels_all_count 684 19
+FCAT_eels_all_count 685 19
+FCAT_eels_all_count 686 326
+FCAT_eels_all_count 687 1
+FCAT_eels_all_count 688 0
+FCAT_eels_all_count 689 0
+FCAT_eels_all_count 690 0
+FCAT_eels_all_count 691 0
+FCAT_eels_all_count 692 1
+FCAT_eels_all_count 693 0
+FCAT_eels_all_count 694 0
+FCAT_eels_all_count 695 0
+FCAT_eels_all_count 696 0
+FCAT_eels_all_count 697 0
+FCAT_eels_all_count 698 0
+FCAT_eels_all_count 699 0
+FCAT_eels_all_count 700 0
+FCAT_eels_all_count 701 0
+FCAT_eels_all_count 702 1
diff --git a/source/f90/fcat-analysis/eelsin b/source/f90/fcat-analysis/eelsin
new file mode 100644
index 0000000..1db7dba
--- /dev/null
+++ b/source/f90/fcat-analysis/eelsin
@@ -0,0 +1,16 @@
+ 4.0 E0 ABTI0002
+ 60.0 THETA ABTI0003
+ 1.8 PHIA ABTI0004
+ 1.8 PHIB ABTI0005
+ 50.0 WMIN ABTI0006
+ 700.0 WMAX ABTI0007
+ 2.0 DW ABTI0008
+WFW: MnO layer on metal
+ ABTI0010
+ 2 1 No-layers NPER No-periodic
+MnO 994.00D+00 LAYER 1 name thickness
+ 4.95 1 epsinf No-Osc.
+ 269.0 16.000 5.00000E-02 wto, Q, lambda
+Platinum 1000.00D+00 LAYER 2 ABTI0012
+ 8.90 1 ABTI0013
+160000.0 -1 12.0000E-02 ABTI0014
diff --git a/source/f90/fcat-analysis/eelsou b/source/f90/fcat-analysis/eelsou
new file mode 100644
index 0000000..058e261
--- /dev/null
+++ b/source/f90/fcat-analysis/eelsou
@@ -0,0 +1,328 @@
+e0 = 4.00 theta = 60.0 phia = 1.80 phib = 1.80
+WFW: MnO layer on metal
+ 0.5000000E+02 0.3941008E-04
+ 0.5200000E+02 0.3978564E-04
+ 0.5400000E+02 0.4013988E-04
+ 0.5600000E+02 0.4047467E-04
+ 0.5800000E+02 0.4079173E-04
+ 0.6000000E+02 0.4109263E-04
+ 0.6200000E+02 0.4137881E-04
+ 0.6400000E+02 0.4108544E-04
+ 0.6600000E+02 0.4191212E-04
+ 0.6800000E+02 0.4216160E-04
+ 0.7000000E+02 0.4240101E-04
+ 0.7200000E+02 0.4263132E-04
+ 0.7400000E+02 0.4285338E-04
+ 0.7600000E+02 0.4306802E-04
+ 0.7800000E+02 0.4327598E-04
+ 0.8000000E+02 0.4347794E-04
+ 0.8200000E+02 0.4367455E-04
+ 0.8400000E+02 0.4386642E-04
+ 0.8600000E+02 0.4405408E-04
+ 0.8800000E+02 0.4423806E-04
+ 0.9000000E+02 0.4441883E-04
+ 0.9200000E+02 0.4459685E-04
+ 0.9400000E+02 0.4477229E-04
+ 0.9600000E+02 0.4494627E-04
+ 0.9800000E+02 0.4511842E-04
+ 0.1000000E+03 0.4528934E-04
+ 0.1020000E+03 0.4545934E-04
+ 0.1040000E+03 0.4562872E-04
+ 0.1060000E+03 0.4579779E-04
+ 0.1080000E+03 0.4596679E-04
+ 0.1100000E+03 0.4613600E-04
+ 0.1120000E+03 0.4630565E-04
+ 0.1140000E+03 0.4647599E-04
+ 0.1160000E+03 0.4664719E-04
+ 0.1180000E+03 0.4681947E-04
+ 0.1200000E+03 0.4699305E-04
+ 0.1220000E+03 0.4716812E-04
+ 0.1240000E+03 0.4734484E-04
+ 0.1260000E+03 0.4752340E-04
+ 0.1280000E+03 0.4770396E-04
+ 0.1300000E+03 0.4788669E-04
+ 0.1320000E+03 0.4807173E-04
+ 0.1340000E+03 0.4825916E-04
+ 0.1360000E+03 0.4844938E-04
+ 0.1380000E+03 0.4864227E-04
+ 0.1400000E+03 0.4883806E-04
+ 0.1420000E+03 0.4903689E-04
+ 0.1440000E+03 0.4923889E-04
+ 0.1460000E+03 0.4944419E-04
+ 0.1480000E+03 0.4965293E-04
+ 0.1500000E+03 0.4986523E-04
+ 0.1520000E+03 0.5008121E-04
+ 0.1540000E+03 0.5030101E-04
+ 0.1560000E+03 0.5052510E-04
+ 0.1580000E+03 0.5075291E-04
+ 0.1600000E+03 0.5098491E-04
+ 0.1620000E+03 0.5122123E-04
+ 0.1640000E+03 0.5146199E-04
+ 0.1660000E+03 0.5170731E-04
+ 0.1680000E+03 0.5195733E-04
+ 0.1700000E+03 0.5221217E-04
+ 0.1720000E+03 0.5247162E-04
+ 0.1740000E+03 0.5273652E-04
+ 0.1760000E+03 0.5300665E-04
+ 0.1780000E+03 0.5328235E-04
+ 0.1800000E+03 0.5356326E-04
+ 0.1820000E+03 0.5384979E-04
+ 0.1840000E+03 0.5414208E-04
+ 0.1860000E+03 0.5444027E-04
+ 0.1880000E+03 0.5474451E-04
+ 0.1900000E+03 0.5505495E-04
+ 0.1920000E+03 0.5537174E-04
+ 0.1940000E+03 0.5569504E-04
+ 0.1960000E+03 0.5602500E-04
+ 0.1980000E+03 0.5636178E-04
+ 0.2000000E+03 0.5670564E-04
+ 0.2020000E+03 0.5705658E-04
+ 0.2040000E+03 0.5741486E-04
+ 0.2060000E+03 0.5778066E-04
+ 0.2080000E+03 0.5815417E-04
+ 0.2100000E+03 0.5853558E-04
+ 0.2120000E+03 0.5892508E-04
+ 0.2140000E+03 0.5932288E-04
+ 0.2160000E+03 0.5972919E-04
+ 0.2180000E+03 0.6014421E-04
+ 0.2200000E+03 0.6056817E-04
+ 0.2220000E+03 0.6100129E-04
+ 0.2240000E+03 0.6144381E-04
+ 0.2260000E+03 0.6189598E-04
+ 0.2280000E+03 0.6235803E-04
+ 0.2300000E+03 0.6283023E-04
+ 0.2320000E+03 0.6331285E-04
+ 0.2340000E+03 0.6380615E-04
+ 0.2360000E+03 0.6431043E-04
+ 0.2380000E+03 0.6482597E-04
+ 0.2400000E+03 0.6535308E-04
+ 0.2420000E+03 0.6589204E-04
+ 0.2440000E+03 0.6644328E-04
+ 0.2460000E+03 0.6700703E-04
+ 0.2480000E+03 0.6758367E-04
+ 0.2500000E+03 0.6817357E-04
+ 0.2520000E+03 0.6877710E-04
+ 0.2540000E+03 0.6939465E-04
+ 0.2560000E+03 0.7002661E-04
+ 0.2580000E+03 0.7067340E-04
+ 0.2600000E+03 0.7133544E-04
+ 0.2620000E+03 0.7201319E-04
+ 0.2640000E+03 0.7270710E-04
+ 0.2660000E+03 0.7341769E-04
+ 0.2680000E+03 0.7414551E-04
+ 0.2700000E+03 0.7489117E-04
+ 0.2720000E+03 0.7565519E-04
+ 0.2740000E+03 0.7643808E-04
+ 0.2760000E+03 0.7724036E-04
+ 0.2780000E+03 0.7806264E-04
+ 0.2800000E+03 0.7890556E-04
+ 0.2820000E+03 0.7976980E-04
+ 0.2840000E+03 0.8065605E-04
+ 0.2860000E+03 0.8156506E-04
+ 0.2880000E+03 0.8249757E-04
+ 0.2900000E+03 0.8345437E-04
+ 0.2920000E+03 0.8443630E-04
+ 0.2940000E+03 0.8544420E-04
+ 0.2960000E+03 0.8647898E-04
+ 0.2980000E+03 0.8754097E-04
+ 0.3000000E+03 0.8863237E-04
+ 0.3020000E+03 0.8975359E-04
+ 0.3040000E+03 0.9090571E-04
+ 0.3060000E+03 0.9208985E-04
+ 0.3080000E+03 0.9330717E-04
+ 0.3100000E+03 0.9455890E-04
+ 0.3120000E+03 0.9584633E-04
+ 0.3140000E+03 0.9717080E-04
+ 0.3160000E+03 0.9853388E-04
+ 0.3180000E+03 0.9993669E-04
+ 0.3200000E+03 0.1013810E-03
+ 0.3220000E+03 0.1028684E-03
+ 0.3240000E+03 0.1044008E-03
+ 0.3260000E+03 0.1059797E-03
+ 0.3280000E+03 0.1076073E-03
+ 0.3300000E+03 0.1092856E-03
+ 0.3320000E+03 0.1110164E-03
+ 0.3340000E+03 0.1128022E-03
+ 0.3360000E+03 0.1146452E-03
+ 0.3380000E+03 0.1165479E-03
+ 0.3400000E+03 0.1185130E-03
+ 0.3420000E+03 0.1205431E-03
+ 0.3440000E+03 0.1226413E-03
+ 0.3460000E+03 0.1248106E-03
+ 0.3480000E+03 0.1270542E-03
+ 0.3500000E+03 0.1293757E-03
+ 0.3520000E+03 0.1317786E-03
+ 0.3540000E+03 0.1342669E-03
+ 0.3560000E+03 0.1368447E-03
+ 0.3580000E+03 0.1395163E-03
+ 0.3600000E+03 0.1422865E-03
+ 0.3620000E+03 0.1451601E-03
+ 0.3640000E+03 0.1481424E-03
+ 0.3660000E+03 0.1512391E-03
+ 0.3680000E+03 0.1544560E-03
+ 0.3700000E+03 0.1577997E-03
+ 0.3720000E+03 0.1612769E-03
+ 0.3740000E+03 0.1648949E-03
+ 0.3760000E+03 0.1686615E-03
+ 0.3780000E+03 0.1725851E-03
+ 0.3800000E+03 0.1766746E-03
+ 0.3820000E+03 0.1809396E-03
+ 0.3840000E+03 0.1853905E-03
+ 0.3860000E+03 0.1900384E-03
+ 0.3880000E+03 0.1948952E-03
+ 0.3900000E+03 0.1999738E-03
+ 0.3920000E+03 0.2052881E-03
+ 0.3940000E+03 0.2108531E-03
+ 0.3960000E+03 0.2166852E-03
+ 0.3980000E+03 0.2228019E-03
+ 0.4000000E+03 0.2292224E-03
+ 0.4020000E+03 0.2359673E-03
+ 0.4040000E+03 0.2430592E-03
+ 0.4060000E+03 0.2505228E-03
+ 0.4080000E+03 0.2583848E-03
+ 0.4100000E+03 0.2666745E-03
+ 0.4120000E+03 0.2754241E-03
+ 0.4140000E+03 0.2846686E-03
+ 0.4160000E+03 0.2944466E-03
+ 0.4180000E+03 0.3048006E-03
+ 0.4200000E+03 0.3157775E-03
+ 0.4220000E+03 0.3274288E-03
+ 0.4240000E+03 0.3398119E-03
+ 0.4260000E+03 0.3529902E-03
+ 0.4280000E+03 0.3670341E-03
+ 0.4300000E+03 0.3820223E-03
+ 0.4320000E+03 0.3980424E-03
+ 0.4340000E+03 0.4151927E-03
+ 0.4360000E+03 0.4335834E-03
+ 0.4380000E+03 0.4533387E-03
+ 0.4400000E+03 0.4745985E-03
+ 0.4420000E+03 0.4975215E-03
+ 0.4440000E+03 0.5222878E-03
+ 0.4460000E+03 0.5491027E-03
+ 0.4480000E+03 0.5782011E-03
+ 0.4500000E+03 0.6098524E-03
+ 0.4520000E+03 0.6443672E-03
+ 0.4540000E+03 0.6821050E-03
+ 0.4560000E+03 0.7234834E-03
+ 0.4580000E+03 0.7689902E-03
+ 0.4600000E+03 0.8191977E-03
+ 0.4620000E+03 0.8747809E-03
+ 0.4640000E+03 0.9365404E-03
+ 0.4660000E+03 0.1005431E-02
+ 0.4680000E+03 0.1082601E-02
+ 0.4700000E+03 0.1169436E-02
+ 0.4720000E+03 0.1267624E-02
+ 0.4740000E+03 0.1379238E-02
+ 0.4760000E+03 0.1506843E-02
+ 0.4780000E+03 0.1653641E-02
+ 0.4800000E+03 0.1823674E-02
+ 0.4820000E+03 0.2022093E-02
+ 0.4840000E+03 0.2255541E-02
+ 0.4860000E+03 0.2532695E-02
+ 0.4880000E+03 0.2865045E-02
+ 0.4900000E+03 0.3268032E-02
+ 0.4920000E+03 0.3762748E-02
+ 0.4940000E+03 0.4378508E-02
+ 0.4960000E+03 0.5156827E-02
+ 0.4980000E+03 0.6157643E-02
+ 0.5000000E+03 0.7469191E-02
+ 0.5020000E+03 0.9223619E-02
+ 0.5040000E+03 0.1162098E-01
+ 0.5060000E+03 0.1496223E-01
+ 0.5080000E+03 0.1967779E-01
+ 0.5100000E+03 0.2627908E-01
+ 0.5120000E+03 0.3497838E-01
+ 0.5140000E+03 0.4448802E-01
+ 0.5160000E+03 0.5057913E-01
+ 0.5180000E+03 0.4873470E-01
+ 0.5200000E+03 0.4036501E-01
+ 0.5220000E+03 0.3068666E-01
+ 0.5240000E+03 0.2272070E-01
+ 0.5260000E+03 0.1692023E-01
+ 0.5280000E+03 0.1283520E-01
+ 0.5300000E+03 0.9950658E-02
+ 0.5320000E+03 0.7879717E-02
+ 0.5340000E+03 0.6360611E-02
+ 0.5360000E+03 0.5222741E-02
+ 0.5380000E+03 0.4353299E-02
+ 0.5400000E+03 0.3676186E-02
+ 0.5420000E+03 0.3140392E-02
+ 0.5440000E+03 0.2709948E-02
+ 0.5460000E+03 0.2359504E-02
+ 0.5480000E+03 0.2070778E-02
+ 0.5500000E+03 0.1830347E-02
+ 0.5520000E+03 0.1628190E-02
+ 0.5540000E+03 0.1456724E-02
+ 0.5560000E+03 0.1310130E-02
+ 0.5580000E+03 0.1183891E-02
+ 0.5600000E+03 0.1074460E-02
+ 0.5620000E+03 0.9790217E-03
+ 0.5640000E+03 0.8953225E-03
+ 0.5660000E+03 0.8215399E-03
+ 0.5680000E+03 0.7561889E-03
+ 0.5700000E+03 0.6980498E-03
+ 0.5720000E+03 0.6461144E-03
+ 0.5740000E+03 0.5995427E-03
+ 0.5760000E+03 0.5576316E-03
+ 0.5780000E+03 0.5197882E-03
+ 0.5800000E+03 0.4855105E-03
+ 0.5820000E+03 0.4543708E-03
+ 0.5840000E+03 0.4260033E-03
+ 0.5860000E+03 0.4000936E-03
+ 0.5880000E+03 0.3763701E-03
+ 0.5900000E+03 0.3545976E-03
+ 0.5920000E+03 0.3345713E-03
+ 0.5940000E+03 0.3161125E-03
+ 0.5960000E+03 0.2990646E-03
+ 0.5980000E+03 0.2832897E-03
+ 0.6000000E+03 0.2686665E-03
+ 0.6020000E+03 0.2550875E-03
+ 0.6040000E+03 0.2424575E-03
+ 0.6060000E+03 0.2306916E-03
+ 0.6080000E+03 0.2197144E-03
+ 0.6100000E+03 0.2094581E-03
+ 0.6120000E+03 0.1998624E-03
+ 0.6140000E+03 0.1908727E-03
+ 0.6160000E+03 0.1824402E-03
+ 0.6180000E+03 0.1745206E-03
+ 0.6200000E+03 0.1670742E-03
+ 0.6220000E+03 0.1600647E-03
+ 0.6240000E+03 0.1534595E-03
+ 0.6260000E+03 0.1472285E-03
+ 0.6280000E+03 0.1413449E-03
+ 0.6300000E+03 0.1357838E-03
+ 0.6320000E+03 0.1305226E-03
+ 0.6340000E+03 0.1255406E-03
+ 0.6360000E+03 0.1208189E-03
+ 0.6380000E+03 0.1163402E-03
+ 0.6400000E+03 0.1120885E-03
+ 0.6420000E+03 0.1080490E-03
+ 0.6440000E+03 0.1042083E-03
+ 0.6460000E+03 0.1005538E-03
+ 0.6480000E+03 0.9707402E-04
+ 0.6500000E+03 0.9375831E-04
+ 0.6520000E+03 0.9059679E-04
+ 0.6540000E+03 0.8758031E-04
+ 0.6560000E+03 0.8470038E-04
+ 0.6580000E+03 0.8194911E-04
+ 0.6600000E+03 0.7931918E-04
+ 0.6620000E+03 0.7680376E-04
+ 0.6640000E+03 0.7439649E-04
+ 0.6660000E+03 0.7209145E-04
+ 0.6680000E+03 0.6988311E-04
+ 0.6700000E+03 0.6776630E-04
+ 0.6720000E+03 0.6573619E-04
+ 0.6740000E+03 0.6378826E-04
+ 0.6760000E+03 0.6191827E-04
+ 0.6780000E+03 0.6012225E-04
+ 0.6800000E+03 0.5839648E-04
+ 0.6820000E+03 0.5673747E-04
+ 0.6840000E+03 0.5514193E-04
+ 0.6860000E+03 0.5360677E-04
+ 0.6880000E+03 0.5212910E-04
+ 0.6900000E+03 0.5070617E-04
+ 0.6920000E+03 0.4933540E-04
+ 0.6940000E+03 0.4801438E-04
+ 0.6960000E+03 0.4674080E-04
+ 0.6980000E+03 0.4551251E-04
+ 0.7000000E+03 0.4432745E-04
--
GitLab