remove trailing zeros, call G with flat args

gpl_module.f90

 
 MODULE gpl_module
   use mpl_module
-
+  use utils
   implicit none
 
 CONTAINS 
 
+
   RECURSIVE FUNCTION factorial(n) result(res)
     integer, intent(in) :: n
     integer :: res
@@ -43,25 +44,60 @@ CONTAINS
     ! used to compute the value of GPL when all zi are zero
     integer :: l
     complex(kind=prec) :: y, GPL_zero_zi
-
+    print*, 'computed value using zero'
     GPL_zero_zi = 1.0d0/factorial(l) * log(y) ** l
 
   END FUNCTION GPL_zero_zi
 
-  FUNCTION GPL(m,z,y,k)
+  FUNCTION  G_with_flat_args(z_flat,y) result(res)
+    complex(kind=prec) :: z_flat(:), y, res
+    complex(kind=prec), allocatable :: z(:)
+    integer :: m_prime(size(z_flat)), condensed_size
+    integer, allocatable :: m(:)
+    m_prime = get_condensed_m(z_flat)
+    if(find_first_zero(m_prime) == -1) then
+      condensed_size = size(m_prime)
+    else
+      condensed_size = find_first_zero(m_prime)-1 
+    end if
+    allocate(m(condensed_size))
+    allocate(z(condensed_size))
+    m = m_prime(1:condensed_size)
+    z = get_condensed_z(m,z_flat)
+    res = GPL(m,z,y,size(m))
+    deallocate(m)
+    deallocate(z)
+  END  FUNCTION G_with_flat_args
+
+  RECURSIVE FUNCTION GPL(m,z,y,k) result(res)
     ! computes the generalized polylogarithm G_{m1,..mk} (z1,...zk; y)
     ! assumes zero arguments expressed through the m's
     
     integer :: m(:), k, i
-    complex(kind=prec) :: z(:), x(k), y, GPL
-    
+    complex(kind=prec) :: z(:), x(k), y, res, c(sum(m)+1,sum(m)+1), z_flat(sum(m)), a(sum(m)-1)
+
+    ! print*, 'z = ', abs(get_flattened_z(m,z))
     ! are all z_i = 0 ? 
-    if(k == 1 .and. z(1) == 0) then
-      ! for that we assume that only one argument was passed, the rest through m1
-      GPL = GPL_zero_zi(m(1),y)
+    if(k == 1 .and. abs(z(1)) < zero) then
+      ! assumes that the zeros at the beginning are passed through m1
+      res = GPL_zero_zi(m(1),y)
       return
     end if
 
+    !  need to remove trailing  zeros?
+    if(abs(z(k)) < zero ) then
+      print*, 'need to remove trailing zeros'
+      ! flatten z
+      z_flat = get_flattened_z(m,z)
+      a = z_flat(1: (size(z_flat)-1))
+      c = shuffle_with_zero(a)
+      res = G_with_flat_args(a,y)*log(y)
+      do  i = 2,k
+        res = res - G_with_flat_args(c(i,:),y)
+      end do
+      return
+    end  if
+
     ! need make convergent?
     if(.not. GPL_has_convergent_series(m,z,y,k)) then
       print*, 'need to make convergent'
@@ -70,12 +106,15 @@ CONTAINS
       else
         print*, '  ', 'does not have convergent series representation'
       end if
+      res = 0
+      return
     end if
 
     do i = 1,k
       x(i) = merge(y/z(1), z(i-1)/z(i),i == 1)
     end do
-    GPL = (-1)**k * MPL(m,x)
+    print*, 'computed using MPL'
+    res = (-1)**k * MPL(m,x)
 
   END FUNCTION GPL
 

makefile

@@ -7,7 +7,7 @@ FFLAGS=-fdefault-real-8 -cpp
 
 LD=gfortran
 
-OBJ=mpl_module.o gpl_module.o
+OBJ= utils.o mpl_module.o gpl_module.o
 
 
 # Rules for main fortran files

mpl_module.f90

  
 MODULE mpl_module
+  use  utils
   implicit none
 
-  integer, parameter :: prec = selected_real_kind(15,32)  
   integer :: GPLInfinity = 30   ! the default n if it is not passed
 
 CONTAINS 

test.f90

@@ -3,6 +3,7 @@
 ! These tests assume that GPLInfinity = 30
 
 PROGRAM TEST
+  use utils
   use mpl_module
   use gpl_module
   implicit none
@@ -11,7 +12,7 @@ PROGRAM TEST
   real, parameter :: tol = 1.0e-14
   logical :: tests_successful = .true.
   
-  call do_MPL_tests() 
+  ! call do_MPL_tests() 
   call do_GPL_tests()
   
   if(tests_successful) then
@@ -20,7 +21,7 @@ PROGRAM TEST
     print*, 'Some tests failed. '
     stop 1
   end if
-  
+
 CONTAINS
   
   subroutine check(res, ref)
@@ -83,9 +84,12 @@ CONTAINS
     
     ref = dcmplx(0.0020332632172573974)
     call test_one_GPL((/ 4 /),cmplx((/ 0 /)),cmplx(1.6),1,ref,'2.3')
+    
+    ! ref = dcmplx(0.0020332632172573974)
+    ! call test_one_GPL((/ 1,1 /),cmplx((/ 1.7,0.0 /)),cmplx(1.1),2,ref,'2.4')
 
-    ref = dcmplx(0.0020332632172573974)
-    call test_one_GPL((/ 1 /),(/(0.7,epsilon)/),(1.1,1.4),1,ref,'2.4')
+    ! ref = dcmplx(0.0020332632172573974)
+    ! call test_one_GPL((/ 1 /),(/(0.7,epsilon)/),(1.1,1.4),1,ref,'2.4')
   end subroutine do_GPL_tests
 
 END PROGRAM TEST

utils.f90

@@ -11,10 +11,11 @@
 
 MODULE utils
   implicit none
-
-  logical :: print_enabled = .true.
-  logical :: warnings_enabled = .true.
   integer, parameter :: prec = selected_real_kind(15,32)  
+  real, parameter :: zero = 1.0e-50
+
+  ! logical :: print_enabled = .true.
+  ! logical :: warnings_enabled = .true.
 
 CONTAINS
 
@@ -37,7 +38,7 @@ CONTAINS
     m(pos:) = 0
   END FUNCTION get_condensed_m
 
-  FUNCTION get_condenced_z(m, z_in) result(z_out)
+  FUNCTION get_condensed_z(m, z_in) result(z_out)
     ! returns condensed z vector
     integer :: m(:), i, pos
     complex(kind=prec) :: z_in(:), z_out(size(m)) 
@@ -46,7 +47,7 @@ CONTAINS
       pos = pos + m(i)
       z_out(i) = z_in(pos)
     end do
-  END FUNCTION get_condenced_z
+  END FUNCTION get_condensed_z
 
   FUNCTION  get_flattened_z(m,z_in) result(z_out)
     ! returns flattened version of z based on m and z
@@ -119,9 +120,9 @@ END MODULE utils
 !   implicit none
 
 !   complex(kind=prec), dimension(3) :: a = cmplx((/1,2,3/))
-!   complex(kind=prec) :: z_flat(7)
+!   complex(kind=prec) :: z_flat(2)
 !   complex(kind=prec), allocatable :: z(:)
-!   integer :: m_prime(7), condensed_size
+!   integer :: m_prime(2), condensed_size
 !   integer, allocatable :: m(:)
 !   complex(kind=prec) :: b(size(a)+1,size(a)+1)
 
@@ -130,19 +131,21 @@ END MODULE utils
 !   ! b = shuffle_with_zero(a)
 !   ! call print_as_matrix(b)
 
-!   ! ! test condensing
-!   ! z_flat = cmplx((/0,0,0,2,1,0,1/))
-!   ! m_prime = get_condensed_m(z_flat)
-!   ! condensed_size = find_first_zero(m_prime)-1 
-!   ! allocate(m(condensed_size))
-!   ! allocate(z(condensed_size))
-!   ! m = m_prime(1:condensed_size)
-!   ! z = get_condenced_z(m,z_flat)
-!   ! z_flat = get_flattened_z(m,z)
-!   ! print*, z_flat
-!   ! print*, m
-!   ! deallocate(m)
-!   ! deallocate(z)
+!   ! test condensing
+!   z_flat = cmplx((/4,0/))
+!   m_prime = get_condensed_m(z_flat)
+!   if(find_first_zero(m_prime) == -1) then
+!     condensed_size = size(m_prime)
+!   else
+!     condensed_size = find_first_zero(m_prime)-1 
+!   end if
+!   allocate(m(condensed_size))
+!   allocate(z(condensed_size))
+!   m = m_prime(1:condensed_size)
+!   z = get_condensed_z(m,z_flat)
+!   z_flat = get_flattened_z(m,z)
+!   deallocate(m)
+!   deallocate(z)
 
 ! END  PROGRAM test