Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
H
handyG
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Analytics
Analytics
Repository
Value Stream
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Commits
Open sidebar
McMule
handyG
Commits
c637adea
Commit
c637adea
authored
May 21, 2019
by
Luca
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
trilog for real args smaller one
parent
d921d35f
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
115 additions
and
18 deletions
+115
-18
maths_functions.f90
maths_functions.f90
+115
-18
No files found.
maths_functions.f90
View file @
c637adea
...
...
@@ -4,12 +4,6 @@ MODULE maths_functions
use
utils
implicit
none
! integer, parameter :: prec = selected_real_kind(15,32)
! integer, parameter :: GPLInfinity = 30 ! the default outermost expansion order for MPLs
! real(kind=prec), parameter :: epsilon = 1e-15 ! used for the small imaginary part
! real(kind=prec), parameter :: zero = 1e-15 ! values smaller than this count as zero
! real(kind=prec), parameter :: pi = 3.14159265358979323846_prec
CONTAINS
FUNCTION
naive_polylog
(
m
,
x
,
n_passed
)
result
(
res
)
...
...
@@ -23,7 +17,7 @@ CONTAINS
j
=
(/(
i
,
i
=
1
,
n
,
1
)/)
res
=
sum
(
x
**
j
/
j
**
m
)
END
FUNCTION
naive_polylog
FUNCTION
Li2
(
x
)
!! Dilogarithm for arguments x < = 1.0
...
...
@@ -113,15 +107,14 @@ CONTAINS
LI2_OLD
=-
(
S
*
(
B0
-
H
*
B2
)
+
A
)
! Artificial conversion
Li2
=
Real
(
LI2_OLD
,
prec
)
END
FUNCTION
Li2
FUNCTION
dilog_in_unit_circle
(
x
)
result
(
res
)
! evaluates for any argument x in unit circle
complex
(
kind
=
prec
)
::
x
,
res
res
=
naive_polylog
(
2
,
x
)
END
FUNCTION
dilog_in_unit_circle
FUNCTION
dilog
(
x
)
result
(
res
)
! evaluates dilog for any argument
complex
(
kind
=
prec
)
::
res
...
...
@@ -133,6 +126,110 @@ CONTAINS
end
if
END
FUNCTION
dilog
FUNCTION
Li3
(
x
)
! Trilogarithm for arguments x < = 1.0
! This was hacked from LI2 to also follow C332
! In theory this could also produce Re[Li [x]] for x>1
real
(
kind
=
prec
)::
X
,
S
,
A
real
(
kind
=
prec
)::
CA
(
0
:
18
),
HA
,
ALFAA
,
BA0
,
BA1
,
BA2
,
YA
real
(
kind
=
prec
)::
CB
(
0
:
18
),
HB
,
ALFAB
,
BB0
,
BB1
,
BB2
,
YB
DATA
CA
(
0
)
/
0.4617293928601208
/
DATA
CA
(
1
)
/
0.4501739958855029
/
DATA
CA
(
2
)
/
-0.010912841952292843
/
DATA
CA
(
3
)
/
0.0005932454712725702
/
DATA
CA
(
4
)
/
-0.00004479593219266303
/
DATA
CA
(
5
)
/
4.051545785869334e-6
/
DATA
CA
(
6
)
/
-4.1095398602619446e-7
/
DATA
CA
(
7
)
/
4.513178777974119e-8
/
DATA
CA
(
8
)
/
-5.254661564861129e-9
/
DATA
CA
(
9
)
/
6.398255691618666e-10
/
DATA
CA
(
10
)
/
-8.071938105510391e-11
/
DATA
CA
(
11
)
/
1.0480864927082917e-11
/
DATA
CA
(
12
)
/
-1.3936328400075057e-12
/
DATA
CA
(
13
)
/
1.8919788723690422e-13
/
DATA
CA
(
14
)
/
-2.6097139622039465e-14
/
DATA
CA
(
15
)
/
3.774985548158685e-15
/
DATA
CA
(
16
)
/
-5.671361978114946e-16
/
DATA
CA
(
17
)
/
1.1023848202712794e-16
/
DATA
CA
(
18
)
/
-5.0940525990875006e-17
/
DATA
CB
(
0
)
/
-0.016016180449195803
/
DATA
CB
(
1
)
/
-0.5036424400753012
/
DATA
CB
(
2
)
/
-0.016150992430500253
/
DATA
CB
(
3
)
/
-0.0012440242104245127
/
DATA
CB
(
4
)
/
-0.00013757218124463538
/
DATA
CB
(
5
)
/
-0.000018563818526041144
/
DATA
CB
(
6
)
/
-2.841735345177361e-6
/
DATA
CB
(
7
)
/
-4.7459967908588557e-7
/
DATA
CB
(
8
)
/
-8.448038544563037e-8
/
DATA
CB
(
9
)
/
-1.5787671270014e-8
/
DATA
CB
(
10
)
/
-3.0657620579122164e-9
/
DATA
CB
(
11
)
/
-6.140791949281482e-10
/
DATA
CB
(
12
)
/
-1.2618831590198e-10
/
DATA
CB
(
13
)
/
-2.64931268635803e-11
/
DATA
CB
(
14
)
/
-5.664711482422879e-12
/
DATA
CB
(
15
)
/
-1.2303909436235178e-12
/
DATA
CB
(
16
)
/
-2.7089360852246495e-13
/
DATA
CB
(
17
)
/
-6.024075373994343e-14
/
DATA
CB
(
18
)
/
-1.2894320641440237e-14
/
real
(
kind
=
prec
)::
Li3
real
(
kind
=
prec
),
parameter
::
zeta2
=
1.6449340668482264365
real
(
kind
=
prec
),
parameter
::
zeta3
=
1.2020569031595942854
integer
::
i
if
(
x
>
1.00000000001_prec
)
then
print
*
,
'need to crash Li3, since not convergent'
elseif
(
x
>
1.0_prec
)
then
x
=
1._prec
endif
IF
(
X
>
0.999999_prec
)
THEN
LI3
=
zeta3
RETURN
ELSE
IF
(
X
.EQ.
-1._prec
)
THEN
LI3
=
-0.75_prec
*
zeta3
RETURN
END
IF
IF
(
X
.LE.
-1._prec
)
THEN
YA
=
1._prec
/
x
;
YB
=
0._prec
S
=
-1._prec
A
=-
LOG
(
-
X
)
*
(
zeta2
+
LOG
(
-
x
)
**
2
/
6._prec
)
ELSE
IF
(
X
.LE.
0._prec
)
THEN
YA
=
x
;
YB
=
0._prec
S
=
-1._prec
A
=
0._prec
ELSE
IF
(
X
.LE.
0.5_prec
)
THEN
YA
=
0._prec
;
YB
=
x
S
=
-1._prec
A
=
0._prec
ELSE
IF
(
X
.LE.
1._prec
)
THEN
YA
=
(
x
-1._prec
)/
x
;
YB
=
1._prec
-
x
S
=
1._prec
A
=
zeta3
+
zeta2
*
Log
(
x
)
-
(
Log
(
1._prec
-
X
)
*
Log
(
X
)
**
2
)/
2._prec
+
Log
(
X
)
**
3
/
6._prec
ELSE
IF
(
X
.LE.
2._prec
)
THEN
YA
=
1._prec
-
X
;
YB
=
(
X
-1._prec
)/
X
S
=
1._prec
A
=
zeta3
+
zeta2
*
Log
(
x
)
-
(
Log
(
X
-
1._prec
)
*
Log
(
X
)
**
2
)/
2._prec
+
Log
(
X
)
**
3
/
6._prec
ELSE
YA
=
0._prec
;
YB
=
1._prec
/
X
S
=
-1._prec
A
=
2
*
zeta2
*
Log
(
x
)
-
Log
(
x
)
**
3
/
6._prec
END
IF
HA
=
-2._prec
*
YA
-1._prec
;
HB
=
2._prec
*
YB
ALFAA
=
HA
+
HA
;
ALFAB
=
HB
+
HB
BA0
=
0.
;
BA1
=
0.
;
BA2
=
0.
BB0
=
0.
;
BB1
=
0.
;
BB2
=
0.
DO
I
=
18
,
0
,
-1
BA0
=
CA
(
I
)
+
ALFAA
*
BA1
-
BA2
;
BA2
=
BA1
;
BA1
=
BA0
BB0
=
CB
(
I
)
+
ALFAB
*
BB1
-
BB2
;
BB2
=
BB1
;
BB1
=
BB0
ENDDO
Li3
=
A
+
S
*
(
(
BA0
-
HA
*
BA2
)
+
(
BB0
-
HB
*
BB2
)
)
END
FUNCTION
Li3
FUNCTION
polylog
(
m
,
x
)
result
(
res
)
! computes the polylog for now naively (except for dilog half-naively)
integer
::
m
...
...
@@ -144,14 +241,14 @@ CONTAINS
res
=
naive_polylog
(
m
,
x
)
end
if
END
FUNCTION
polylog
END
MODULE
maths_functions
!
PROGRAM test
!
use maths_functions
!
implicit none
!
complex(kind=prec) :: res
! res = dilog(dcmplx(0.4d0)
)
!
print*, res
!
END PROGRAM test
PROGRAM
test
use
maths_functions
implicit
none
complex
(
kind
=
prec
)
::
res
res
=
Li3
(
0.4d0
)
print
*
,
res
END
PROGRAM
test
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment