Skip to content

Commit

Permalink
src/module_index_utils: delete sign_[even,odd]_ret1 subroutine, use m…
Browse files Browse the repository at this point in the history 
…erge instead
  • Loading branch information
@kohei-noda-qcrg
kohei-noda-qcrg committed Feb 3, 2025
1 parent 36f8573 commit 689e3b9
Show file tree
Hide file tree
Showing 7 changed files with 84 additions and 147 deletions.
12 changes: 6 additions & 6 deletions src/casmat.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ SUBROUTINE casmat_complex(mat)
use, intrinsic :: iso_fortran_env, only: int64
use module_global_variables
use module_dict, only: exists, get_val
use module_index_utils, only: convert_global_to_active_idx, convert_active_to_global_idx, sign_even_ret1
use module_index_utils, only: convert_global_to_active_idx, convert_active_to_global_idx
#ifdef HAVE_MPI
use module_mpi
#endif
Expand Down Expand Up @@ -161,7 +161,7 @@ SUBROUTINE casmat_complex(mat)
mat(i, j) = mat(i, j) - cmplxint
End do

mat(i, j) = sign_even_ret1(phase1)*mat(i, j)
mat(i, j) = merge(1, -1, mod(phase1, 2)==0)*mat(i, j)
mat(j, i) = DCONJG(mat(i, j))

End if
Expand Down Expand Up @@ -204,7 +204,7 @@ SUBROUTINE casmat_complex(mat)
cmplxint = DCMPLX(i2r, i2i)
mat(i, j) = mat(i, j) - cmplxint

mat(i, j) = sign_even_ret1(phase1 + phase2)*mat(i, j)
mat(i, j) = merge(1, -1, mod(phase1 + phase2, 2)==0)*mat(i, j)
mat(j, i) = DCONJG(mat(i, j))
End if
End do
Expand All @@ -231,7 +231,7 @@ SUBROUTINE casmat_real(mat)
use, intrinsic :: iso_fortran_env, only: int64
use module_global_variables
use module_dict, only: exists, get_val
use module_index_utils, only: convert_global_to_active_idx, convert_active_to_global_idx, sign_even_ret1
use module_index_utils, only: convert_global_to_active_idx, convert_active_to_global_idx
#ifdef HAVE_MPI
use module_mpi
#endif
Expand Down Expand Up @@ -361,7 +361,7 @@ SUBROUTINE casmat_real(mat)
mat(i, j) = mat(i, j) - i2r
End do

mat(i, j) = sign_even_ret1(phase1)*mat(i, j)
mat(i, j) = merge(1, -1, mod(phase1, 2)==0)*mat(i, j)
mat(j, i) = mat(i, j)

End if
Expand Down Expand Up @@ -401,7 +401,7 @@ SUBROUTINE casmat_real(mat)
i2r = inttwr(ir, ib, is, ia)
mat(i, j) = mat(i, j) - i2r

mat(i, j) = sign_even_ret1(phase1 + phase2)*mat(i, j)
mat(i, j) = merge(1, -1, mod(phase1 + phase2, 2)==0)*mat(i, j)
mat(j, i) = mat(i, j)
End if
End do
Expand Down
13 changes: 6 additions & 7 deletions src/divide_2_elec_integral_into_subspaces.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ SUBROUTINE divide_2_elec_integral_into_subspaces(filename) ! 2 electorn integral

use module_global_variables
use module_file_manager
use module_index_utils, only: sign_even_ret1
use module_realonly, only: realonly

Implicit NONE
Expand Down Expand Up @@ -99,28 +98,28 @@ SUBROUTINE divide_2_elec_integral_into_subspaces(filename) ! 2 electorn integral

totalint = totalint + nz

itr = i + sign_even_ret1(i + 1) ! itr = i+1 if i+1 is even, otherwise itr = i-1
jtr = j + sign_even_ret1(j + 1)
itr = i + merge(1, -1, mod(i + 1, 2)==0) ! itr = i+1 if i+1 is even, otherwise itr = i-1
jtr = j + merge(1, -1, mod(j + 1, 2)==0)

nmom = global_sec_end ! ninact + nact + nsec

If (space_idx(i) == 4 .or. space_idx(j) == 4) cycle ! Read the next 2-integral
If (i > global_act_end .and. j > global_act_end) cycle ! Read the next 2-integral

SignIJ = sign_even_ret1(i + j) ! If i+j is even, SignIJ = 1, otherwise SignIJ = -1
SignIJ = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even, SignIJ = 1, otherwise SignIJ = -1

Do inz = 1, nz

k = indk(inz)
ktr = k + sign_even_ret1(k + 1) ! ktr = k+1 if k+1 is even, otherwise ktr = k-1
ktr = k + merge(1, -1, mod(k + 1, 2)==0) ! ktr = k+1 if k+1 is even, otherwise ktr = k-1
l = indl(inz)
ltr = l + sign_even_ret1(l + 1)
ltr = l + merge(1, -1, mod(l + 1, 2)==0)

If (space_idx(k) == 4 .or. space_idx(l) == 4) cycle ! Go to the next idz
If (k > global_act_end .and. l > global_act_end) cycle ! Go to the next idz
If (i == j .and. k > l) cycle ! Go to the next idz

SignKL = sign_even_ret1(k + l) ! If k+l is even, SignKL = 1, otherwise SignKL = -1
SignKL = merge(1, -1, mod(k + l, 2)==0) ! If k+l is even, SignKL = 1, otherwise SignKL = -1

max1 = max(space_idx(i), space_idx(j))
min1 = min(space_idx(i), space_idx(j))
Expand Down
98 changes: 48 additions & 50 deletions src/module_2integrals.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea
use, intrinsic :: iso_fortran_env, only: int64
use module_global_variables
use module_file_manager
use module_index_utils, only: sign_even_ret1, sign_odd_ret1
use module_sort_swap, only: swap
#ifdef HAVE_MPI
use module_mpi
Expand Down Expand Up @@ -106,8 +105,8 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea

totalint = totalint + nz

itr = i + sign_even_ret1(i + 1) ! If i+1 is even, itr = i+1, else itr = i-1
jtr = j + sign_even_ret1(j + 1)
itr = i + merge(1, -1, mod(i + 1, 2)==0) ! If i+1 is even, itr = i+1, else itr = i-1
jtr = j + merge(1, -1, mod(j + 1, 2)==0)

i0 = i
itr0 = itr
Expand All @@ -122,16 +121,16 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea
jtr = jtr0

k = indk(inz)
ktr = k + sign_even_ret1(k + 1) ! If k+1 is even, ktr = k+1, else ktr = k-1
ktr = k + merge(1, -1, mod(k + 1, 2)==0) ! If k+1 is even, ktr = k+1, else ktr = k-1
l = indl(inz)
ltr = l + sign_even_ret1(l + 1)
ltr = l + merge(1, -1, mod(l + 1, 2)==0)

If (i > nmoc .and. j > nmoc .and. k > nmoc .and. l > nmoc) cycle loop_inz ! (33|33) is ignored
If (i == j .and. k > l) cycle loop_inz

If (i <= nmoc .and. j <= nmoc .and. k <= nmoc .and. l <= nmoc) then
signij = sign_even_ret1(i + j) ! If i+j is even, signij = 1, else signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even, signij = 1, else signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)
nuniq = nuniq + 1
!=-> Original integral plus time-reversed partners
INTTWR(I, J, K, L) = rklr(inz)
Expand All @@ -158,13 +157,13 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea
space_idx(k) < 3 .and. space_idx(l) == space_idx(k)) then !(33|11) or (33|22) type
count = 0
do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

int2r_f1(i, j, k, l) = rklr(inz)
int2r_f1(jtr, itr, k, l) = SignIJ*rklr(inz)
Expand All @@ -186,13 +185,13 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea
space_idx(i) < 3 .and. space_idx(i) == space_idx(j)) then !(11|33) or (22|33) type
count = 0
do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

int2r_f1(k, l, i, j) = rklr(inz)
int2r_f1(k, l, jtr, itr) = SignIJ*rklr(inz)
Expand All @@ -216,13 +215,13 @@ SUBROUTINE readint2_casci_realonly(filename, nuniq) ! 2 electorn integrals crea
count = 0

do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

if (i > j .and. k > l) then ! (31|31) or (32|32) ==> (31|13) or (32|23)
int2r_f2(i, j, ltr, ktr) = signKL*rklr(inz)
Expand Down Expand Up @@ -283,7 +282,6 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat
use, intrinsic :: iso_fortran_env, only: int64
use module_global_variables
use module_file_manager
use module_index_utils, only: sign_even_ret1, sign_odd_ret1
use module_sort_swap, only: swap
#ifdef HAVE_MPI
use module_mpi
Expand Down Expand Up @@ -371,8 +369,8 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat

totalint = totalint + nz

itr = i + sign_even_ret1(i + 1)
jtr = j + sign_even_ret1(j + 1)
itr = i + merge(1, -1, mod(i + 1, 2)==0)
jtr = j + merge(1, -1, mod(j + 1, 2)==0)

i0 = i
itr0 = itr
Expand All @@ -387,16 +385,16 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat
jtr = jtr0

k = indk(inz)
ktr = k + sign_even_ret1(k + 1) ! If k+1 is even, ktr = k+1, else ktr = k-1
ktr = k + merge(1, -1, mod(k + 1, 2)==0) ! If k+1 is even, ktr = k+1, else ktr = k-1
l = indl(inz)
ltr = l + sign_even_ret1(l + 1)
ltr = l + merge(1, -1, mod(l + 1, 2)==0)

If (i > nmoc .and. j > nmoc .and. k > nmoc .and. l > nmoc) cycle loop_inz ! (33|33) is ignored
If (i == j .and. k > l) cycle loop_inz

If (i <= nmoc .and. j <= nmoc .and. k <= nmoc .and. l <= nmoc) then
signij = sign_even_ret1(i + j) ! If i+j is even, signij = 1, else signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even, signij = 1, else signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)
nuniq = nuniq + 1
!=-> Original integral plus time-reversed partners
INTTWR(I, J, K, L) = rklr(inz)
Expand Down Expand Up @@ -439,13 +437,13 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat
space_idx(k) < 3 .and. space_idx(l) == space_idx(k)) then !(33|11) or (33|22) type
count = 0
do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

int2r_f1(i, j, k, l) = rklr(inz)
int2i_f1(i, j, k, l) = rkli(inz)
Expand Down Expand Up @@ -475,13 +473,13 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat
space_idx(i) < 3 .and. space_idx(i) == space_idx(j)) then !(11|33) or (22|33) type
count = 0
do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

int2r_f1(k, l, i, j) = rklr(inz)
int2i_f1(k, l, i, j) = rkli(inz)
Expand Down Expand Up @@ -512,13 +510,13 @@ SUBROUTINE readint2_casci_complex(filename, nuniq) ! 2 electorn integrals creat

count = 0
do
itr = i + sign_odd_ret1(i) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + sign_odd_ret1(j)
ktr = k + sign_odd_ret1(k)
ltr = l + sign_odd_ret1(l)
itr = i + merge(1, -1, mod(i, 2)==1) ! If i is even, then itr = i-1, otherwise itr = i+1
jtr = j + merge(1, -1, mod(j, 2)==1)
ktr = k + merge(1, -1, mod(k, 2)==1)
ltr = l + merge(1, -1, mod(l, 2)==1)

signij = sign_even_ret1(i + j) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = sign_even_ret1(k + l)
signij = merge(1, -1, mod(i + j, 2)==0) ! If i+j is even signij = 1, if i+j is odd signij = -1
signkl = merge(1, -1, mod(k + l, 2)==0)

if (i > j .and. k > l) then ! (31|31) or (32|32) ==> (31|13) or (32|23)

Expand Down
60 changes: 2 additions & 58 deletions src/module_index_utils.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,13 @@ module module_index_utils
private
public :: convert_active_to_global_idx, convert_secondary_to_global_idx, &
convert_global_to_active_idx, convert_global_to_secondary_idx, &
get_mo_range, set_global_index, sign_even_ret1, sign_odd_ret1
get_mo_range, set_global_index

contains

function convert_active_to_global_idx(active_idx) result(global_idx)
! ====================================================================================================
! Converts a active index to a global index
! ====================================================================================================
! Converts a active index to a global index ====================================================================================================
! The global index means the index of sequential ordering of all (inactive + active + secondary) orbitals
! The active index means the index of sequential ordering of active orbitals
use module_global_variables, only: ninact, nact, rank
Expand Down Expand Up @@ -134,59 +133,4 @@ subroutine set_global_index
global_sec_end = ninact + nact + nsec
end subroutine set_global_index

function sign_even_ret1(phase) result(sign)
! ====================================================================================================
! Returns the sign of a phase, given the phase number
! If the phase is even, then the sign is returned as +1
! If the phase is odd, then the sign is returned as -1
! ====================================================================================================
use module_global_variables, only: rank
integer, intent(in) :: phase
integer :: sign
! phase | sign(return value)
! ==========================
! even | +1
! odd | -1
sign = 0

if (mod(phase, 2) == 0) then
sign = 1
else
sign = -1
end if

if (sign == 0) then
if (rank == 0) print *, "Error: sign = 0"
call stop_with_errorcode(4)
end if

end function sign_even_ret1

function sign_odd_ret1(phase) result(sign)
! ====================================================================================================
! Returns the sign of a phase, given the phase number
! If the phase is even, then the sign is returned as -1
! If the phase is odd, then the sign is returned as +1
! ====================================================================================================
use module_global_variables, only: rank
integer, intent(in) :: phase
integer :: sign
! phase | sign(return value)
! ==========================
! even | -1
! odd | +1
sign = 0

if (mod(phase, 2) == 0) then
sign = -1
else
sign = 1
end if

if (sign == 0) then
if (rank == 0) print *, "Error: sign = 0"
call stop_with_errorcode(4)
end if
end function sign_odd_ret1

end module module_index_utils
Loading

0 comments on commit 689e3b9

Please sign in to comment.