add i64 subroutines to remove type-mismatch

src/module_mpi.F90

@@ -3,14 +3,15 @@ module module_mpi
     ! Currently, only reduce and allreduce are implemented.
     ! Author: Kohei Noda
 
+    use, intrinsic :: iso_fortran_env, only: int64
     use module_global_variables, only: rank, nprocs, ierr, max_i4
     implicit none
 #ifdef HAVE_MPI
     include 'mpif.h'
     private
     public reduce_wrapper, allreduce_wrapper
     interface reduce_wrapper
-        module procedure reduce_i, reduce_i_1, reduce_r_2, reduce_c_2
+        module procedure reduce_i, reduce_i64, reduce_i_1, reduce_r_2, reduce_c_2
     end interface reduce_wrapper
 
     interface allreduce_wrapper
@@ -71,6 +72,36 @@ subroutine reduce_i(mat, root_rank, optional_op)
 
     end subroutine reduce_i
 
+    subroutine reduce_i64(mat, root_rank, optional_op)
+        ! Reduce for an integer value
+        implicit none
+        integer(kind=int64), intent(inout) :: mat
+        integer, intent(in) :: root_rank
+        integer, optional, intent(in) :: optional_op
+        integer :: ii, ie
+        integer :: i, cnt
+        integer :: op
+        integer :: datatype
+
+        op = op_mpi_sum ! default operation
+        if (present(optional_op)) then
+            call check_operation(optional_op)
+            op = optional_op
+        end if
+        if (sizeof(mat) == 4) then
+            datatype = MPI_INTEGER4 ! 4 byte integer
+        else
+            datatype = MPI_INTEGER8 ! 8 byte integer
+        end if
+
+        if (rank == root_rank) then
+            call MPI_Reduce(MPI_IN_PLACE, mat, 1, datatype, op, root_rank, MPI_COMM_WORLD, ierr)
+        else
+            call MPI_Reduce(mat, mat, 1, datatype, op, root_rank, MPI_COMM_WORLD, ierr)
+        end if
+
+    end subroutine reduce_i64
+
     subroutine reduce_i_1(mat, root_rank, optional_op)
         ! Reduce for 1 dimensional integer array
         implicit none

src/module_sort_swap.F90

@@ -16,7 +16,7 @@ module module_sort_swap
         module procedure heapifyInt, heapifyReal
     end interface heapify
     interface swap
-        module procedure swapInt, swapReal, swapCmp16, swapArrayInt, swapArrayReal, swapArrayCmp16
+        module procedure swapInt, swapInt64, swapReal, swapCmp16, swapArrayInt, swapArrayReal, swapArrayCmp16
     end interface swap
 contains
     subroutine heapifyInt(array, first, last, is_descending_order)
@@ -116,16 +116,26 @@ subroutine heapSortReal(list, is_descending_order)
     subroutine swapInt(a, b)
         ! Swap values between a and b
         implicit none
-        integer temp
+        integer :: temp
         integer, INTENT(INOUT) :: a, b
         temp = a
         a = b
         b = temp
     end subroutine swapInt
+    subroutine swapInt64(a, b)
+        ! Swap values between a and b
+        use, intrinsic :: iso_fortran_env, only: int64
+        implicit none
+        integer(kind=int64) :: temp
+        integer(kind=int64), INTENT(INOUT) :: a, b
+        temp = a
+        a = b
+        b = temp
+    end subroutine swapInt64
     subroutine swapReal(a, b)
         ! Swap values between a and b
         implicit none
-        real(8) temp
+        real(8) :: temp
         real(8), INTENT(INOUT) :: a, b
         temp = a
         a = b
@@ -134,7 +144,7 @@ end subroutine swapReal
     subroutine swapCmp16(a, b)
         ! Swap values between a and b
         implicit none
-        complex*16 temp
+        complex*16 :: temp
         complex*16, INTENT(INOUT) :: a, b
         temp = a
         a = b
@@ -144,7 +154,7 @@ end subroutine swapCmp16
     subroutine swapArrayInt(array, a, b)
         ! Swap values between array(a) and array(b)
         implicit none
-        integer temp
+        integer :: temp
         integer, INTENT(INOUT) :: array(:)
         integer, INTENT(IN) :: a, b
         temp = array(a)
@@ -154,7 +164,7 @@ end subroutine swapArrayInt
     subroutine swapArrayReal(array, a, b)
         ! Swap values between array(a) and array(b)
         implicit none
-        real(8) temp
+        real(8) :: temp
         real(8), INTENT(INOUT) :: array(:)
         integer, INTENT(IN) :: a, b
         temp = array(a)
@@ -164,7 +174,7 @@ end subroutine swapArrayReal
     subroutine swapArrayCmp16(array, a, b)
         ! Swap values between array(a) and array(b)
         implicit none
-        complex*16 temp
+        complex*16 :: temp
         complex*16, INTENT(INOUT) :: array(:)
         integer, INTENT(IN) :: a, b
         temp = array(a)

src/takekr.F90

@@ -6,7 +6,7 @@ module module_takekr
     public :: takekr
 
     interface takekr
-        module procedure takekr_complex, takekr_real
+        module procedure takekr_complex, takekr_int64_complex, takekr_real, takekr_int64_real
     end interface takekr
 contains
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
@@ -42,6 +42,40 @@ SUBROUTINE takekr_complex(i, j, k, l, cint2)
 
     End subroutine takekr_complex
 
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+
+    SUBROUTINE takekr_int64_complex(i, j, k, l, cint2)
+
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+
+        use, intrinsic :: iso_fortran_env, only: int64
+        use module_global_variables
+
+        Implicit NONE
+        integer(kind=int64), intent(inout)      :: i, j, k, l
+        complex*16, intent(inout)   :: cint2
+        integer                     :: signij, signkl
+
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+!
+! Consider Kramers pair integrals (i~j~|k~l~)*
+!
+
+        i = i + merge(1, -1, mod(i, 2)==1) ! i = i+1 if i is odd, otherwise i = i-1
+        j = j + merge(1, -1, mod(j, 2)==1)
+        k = k + merge(1, -1, mod(k, 2)==1)
+        l = l + merge(1, -1, mod(l, 2)==1)
+
+        signij = merge(1, -1, mod(i + j, 2)==0) ! signij = 1 if i+j is even, otherwise signij = -1
+        signkl = merge(1, -1, mod(k + l, 2)==0)
+
+        cint2 = signij*signkl*DCONJG(cint2)
+
+    End subroutine takekr_int64_complex
+
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
 
@@ -50,10 +84,11 @@ SUBROUTINE takekr_real(i, j, k, l, rint2)
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
 
+        use, intrinsic :: iso_fortran_env, only: int64
         use module_global_variables
 
         Implicit NONE
-        integer, intent(inout)      :: i, j, k, l
+        integer(kind=int64), intent(inout)      :: i, j, k, l
         real(8), intent(inout)      :: rint2
         integer                     :: signij, signkl
 
@@ -75,4 +110,37 @@ SUBROUTINE takekr_real(i, j, k, l, rint2)
 
     End subroutine takekr_real
 
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+
+    SUBROUTINE takekr_int64_real(i, j, k, l, rint2)
+
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+
+        use module_global_variables
+
+        Implicit NONE
+        integer, intent(inout)      :: i, j, k, l
+        real(8), intent(inout)      :: rint2
+        integer                     :: signij, signkl
+
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
+!
+! Consider Kramers pair integrals (i~j~|k~l~)*
+!
+
+        i = i + merge(1, -1, mod(i, 2)==1) ! i = i+1 if i is odd, otherwise i = i-1
+        j = j + merge(1, -1, mod(j, 2)==1)
+        k = k + merge(1, -1, mod(k, 2)==1)
+        l = l + merge(1, -1, mod(l, 2)==1)
+
+        signij = merge(1, -1, mod(i + j, 2)==0) ! signij = 1 if i+j is even, otherwise signij = -1
+        signkl = merge(1, -1, mod(k + l, 2)==0)
+
+        rint2 = signij*signkl*rint2
+
+    End subroutine takekr_int64_real
+
 end module module_takekr