From 975e762372d6e64fb7d62c329e4d21f9abfe8e59 Mon Sep 17 00:00:00 2001 From: Emiliano Deustua Date: Sat, 26 Oct 2024 21:04:26 -0500 Subject: [PATCH] refactor: Remove reorders in favor of reorder_stripe --- ccpy/lib/fortran/ccp3_adaptive_loops.f90 | 211 --------------- ccpy/lib/fortran/ccp3_loops.f90 | 224 +--------------- ccpy/lib/fortran/ccp3_opt_loops.f90 | 210 --------------- ccpy/lib/fortran/ccsdpt_loops.f90 | 211 --------------- ccpy/lib/fortran/cct3_loops.f90 | 213 --------------- ccpy/lib/fortran/crcc24_opt_loops.f90 | 213 +-------------- ccpy/lib/fortran/creacc_loops.f90 | 239 +---------------- ccpy/lib/fortran/cripcc_loops.f90 | 237 ----------------- ccpy/lib/fortran/eaccp3_loops.f90 | 271 ++------------------ ccpy/lib/fortran/eomccp3_adaptive_loops.f90 | 20 -- ccpy/lib/fortran/ipccp3_loops.f90 | 269 ++----------------- 11 files changed, 43 insertions(+), 2275 deletions(-) diff --git a/ccpy/lib/fortran/ccp3_adaptive_loops.f90 b/ccpy/lib/fortran/ccp3_adaptive_loops.f90 index afdeb658..9b58d9b0 100644 --- a/ccpy/lib/fortran/ccp3_adaptive_loops.f90 +++ b/ccpy/lib/fortran/ccp3_adaptive_loops.f90 @@ -1376,217 +1376,6 @@ subroutine ccp3d_ijk_with_selection_opt(deltaA,deltaB,deltaC,deltaD,& end do; end do; end do; end subroutine ccp3d_ijk_with_selection_opt - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - subroutine get_index_table(idx_table, rng1, rng2, rng3, n1, n2, n3) integer, intent(in) :: n1, n2, n3 diff --git a/ccpy/lib/fortran/ccp3_loops.f90 b/ccpy/lib/fortran/ccp3_loops.f90 index 86be5b85..7df048ed 100644 --- a/ccpy/lib/fortran/ccp3_loops.f90 +++ b/ccpy/lib/fortran/ccp3_loops.f90 @@ -1374,7 +1374,7 @@ subroutine ccp3a_full(deltaA,deltaB,deltaC,deltaD,& H2A_vvvv(1:nua,1:nua,1:nua,1:nua),& D3A_O(1:nua,1:noa,1:noa),& D3A_V(1:nua,1:noa,1:nua) - + integer :: i, j, k, a, b, c real(kind=8) :: D, LM @@ -1389,7 +1389,7 @@ subroutine ccp3a_full(deltaA,deltaB,deltaC,deltaD,& do a = 1, nua do b = a+1, nua do c = b+1, nua - + LM = M3A(a,b,c,i,j,k) * L3A(a,b,c,i,j,k) D = fA_oo(i,i) + fA_oo(j,j) + fA_oo(k,k)& @@ -1479,7 +1479,7 @@ subroutine ccp3b_full(deltaA,deltaB,deltaC,deltaD,& do a = 1, nua do b = a+1, nua do c = 1, nub - + LM = M3B(a,b,c,i,j,k) * L3B(a,b,c,i,j,k) D = fA_oo(i,i) + fA_oo(j,j) + fB_oo(k,k)& @@ -1554,7 +1554,7 @@ subroutine ccp3c_full(deltaA,deltaB,deltaC,deltaD,& D3C_V(1:nua,1:nob,1:nub),& D3D_O(1:nub,1:nob,1:nob),& D3D_V(1:nub,1:nob,1:nub) - + integer :: i, j, k, a, b, c real(kind=8) :: D, temp @@ -1569,7 +1569,7 @@ subroutine ccp3c_full(deltaA,deltaB,deltaC,deltaD,& do a = 1, nua do b = 1, nub do c = b+1, nub - + temp = M3C(a,b,c,i,j,k) * L3C(a,b,c,i,j,k) D = fA_oo(i,i) + fB_oo(j,j) + fB_oo(k,k)& @@ -1642,7 +1642,7 @@ subroutine ccp3d_full(deltaA,deltaB,deltaC,deltaD,& do a = 1, nub do b = a+1, nub do c = b+1, nub - + temp = M3D(a,b,c,i,j,k) * L3D(a,b,c,i,j,k) D = fB_oo(i,i) + fB_oo(j,j) + fB_oo(k,k)& @@ -1683,216 +1683,4 @@ subroutine ccp3d_full(deltaA,deltaB,deltaC,deltaD,& end subroutine ccp3d_full - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module ccp3_loops diff --git a/ccpy/lib/fortran/ccp3_opt_loops.f90 b/ccpy/lib/fortran/ccp3_opt_loops.f90 index 65afea74..dfa68fd1 100644 --- a/ccpy/lib/fortran/ccp3_opt_loops.f90 +++ b/ccpy/lib/fortran/ccp3_opt_loops.f90 @@ -1773,214 +1773,4 @@ subroutine argsort(r,d) end subroutine argsort - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module ccp3_opt_loops diff --git a/ccpy/lib/fortran/ccsdpt_loops.f90 b/ccpy/lib/fortran/ccsdpt_loops.f90 index e7e8de1f..bca61cfc 100644 --- a/ccpy/lib/fortran/ccsdpt_loops.f90 +++ b/ccpy/lib/fortran/ccsdpt_loops.f90 @@ -1926,215 +1926,4 @@ subroutine ccsdptD_p_full_moment(deltaA,moments,& end subroutine ccsdptD_p_full_moment - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module ccsdpt_loops diff --git a/ccpy/lib/fortran/cct3_loops.f90 b/ccpy/lib/fortran/cct3_loops.f90 index c94d54fe..6bcdc2bd 100644 --- a/ccpy/lib/fortran/cct3_loops.f90 +++ b/ccpy/lib/fortran/cct3_loops.f90 @@ -1584,217 +1584,4 @@ subroutine creomcc23D_opt(deltaA,deltaB,deltaC,deltaD,& end subroutine creomcc23D_opt - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module cct3_loops diff --git a/ccpy/lib/fortran/crcc24_opt_loops.f90 b/ccpy/lib/fortran/crcc24_opt_loops.f90 index 7b9b5b56..afe985b3 100644 --- a/ccpy/lib/fortran/crcc24_opt_loops.f90 +++ b/ccpy/lib/fortran/crcc24_opt_loops.f90 @@ -326,7 +326,7 @@ subroutine crcc24C_ijkl(deltaA,deltaB,deltaC,deltaD,& !real(kind=8), intent(in) :: test_array(1:nua,1:nua,1:nub,1:nub,1:noa,1:noa,1:nob,1:nob) - integer :: a, b, c, d + integer :: a, b, c, d real(kind=8) :: denom, temp, mm24, l4 deltaA = 0.0d0 @@ -2793,215 +2793,4 @@ subroutine crcc24E_opt(deltaA,deltaB,deltaC,deltaD,& end subroutine crcc24E_opt - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - - subroutine reorder1423(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i4,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1423 - end module crcc24_opt_loops diff --git a/ccpy/lib/fortran/creacc_loops.f90 b/ccpy/lib/fortran/creacc_loops.f90 index 9ab6cd33..a03a61d2 100644 --- a/ccpy/lib/fortran/creacc_loops.f90 +++ b/ccpy/lib/fortran/creacc_loops.f90 @@ -131,7 +131,7 @@ subroutine crcc23B(deltaA,deltaB,deltaC,deltaD,& +h2b_vovo(b,k,b,k) + h2b_vovo(a,k,a,k)& +h2b_ovov(j,c,j,c)& -h2a_vvvv(a,b,a,b)& - -h2b_vvvv(a,c,a,c) - h2b_vvvv(b,c,b,c) + -h2b_vvvv(a,c,a,c) - h2b_vvvv(b,c,b,c) deltaC = deltaC + temp/(omega+D) ! D correction D = D& @@ -224,241 +224,4 @@ subroutine crcc23C(deltaA,deltaB,deltaC,deltaD,& end subroutine crcc23C - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! subroutine reorder4(y, x, iorder) -! -! integer, intent(in) :: iorder(4) -! real(kind=8), intent(in) :: x(:,:,:,:) -! -! real(kind=8), intent(out) :: y(:,:,:,:) -! -! integer :: i, j, k, l -! integer :: vec(4) -! -! y = 0.0d0 -! do i = 1, size(x,1) -! do j = 1, size(x,2) -! do k = 1, size(x,3) -! do l = 1, size(x,4) -! vec = (/i,j,k,l/) -! y(vec(iorder(1)),vec(iorder(2)),vec(iorder(3)),vec(iorder(4))) = x(i,j,k,l) -! end do -! end do -! end do -! end do -! -! end subroutine reorder4 - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module creacc_loops diff --git a/ccpy/lib/fortran/cripcc_loops.f90 b/ccpy/lib/fortran/cripcc_loops.f90 index 161b28b8..5ab39ad9 100644 --- a/ccpy/lib/fortran/cripcc_loops.f90 +++ b/ccpy/lib/fortran/cripcc_loops.f90 @@ -234,241 +234,4 @@ subroutine crcc23C(deltaA,deltaB,deltaC,deltaD,& end subroutine crcc23C - - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! subroutine reorder4(y, x, iorder) -! -! integer, intent(in) :: iorder(4) -! real(kind=8), intent(in) :: x(:,:,:,:) -! -! real(kind=8), intent(out) :: y(:,:,:,:) -! -! integer :: i, j, k, l -! integer :: vec(4) -! -! y = 0.0d0 -! do i = 1, size(x,1) -! do j = 1, size(x,2) -! do k = 1, size(x,3) -! do l = 1, size(x,4) -! vec = (/i,j,k,l/) -! y(vec(iorder(1)),vec(iorder(2)),vec(iorder(3)),vec(iorder(4))) = x(i,j,k,l) -! end do -! end do -! end do -! end do -! -! end subroutine reorder4 - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module cripcc_loops diff --git a/ccpy/lib/fortran/eaccp3_loops.f90 b/ccpy/lib/fortran/eaccp3_loops.f90 index cc5dc839..0603abb5 100644 --- a/ccpy/lib/fortran/eaccp3_loops.f90 +++ b/ccpy/lib/fortran/eaccp3_loops.f90 @@ -155,7 +155,7 @@ subroutine eaccp3B_full(deltaA,deltaB,deltaC,deltaD,& integer :: j, k, a, b, c real(kind=8) :: D, temp !integer :: sym_a, sym_b, sym_c, sym_j, sym_k, sym - + deltaA = 0.0d0 deltaB = 0.0d0 deltaC = 0.0d0 @@ -210,7 +210,7 @@ subroutine eaccp3B_full(deltaA,deltaB,deltaC,deltaD,& +h2b_vovo(b,k,b,k) + h2b_vovo(a,k,a,k)& +h2b_ovov(j,c,j,c)& -h2a_vvvv(a,b,a,b)& - -h2b_vvvv(a,c,a,c) - h2b_vvvv(b,c,b,c) + -h2b_vvvv(a,c,a,c) - h2b_vvvv(b,c,b,c) deltaC = deltaC + temp/(omega+D) ! D correction D = D& @@ -352,12 +352,12 @@ subroutine get_index_table3(idx_table, rng1, rng2, rng3, n1, n2, n3) integer, intent(in) :: n1, n2, n3 integer, intent(in) :: rng1(2), rng2(2), rng3(2) - + integer, intent(inout) :: idx_table(n1,n2,n3) - + integer :: kout integer :: p, q, r - + idx_table = 0 if (rng1(1) > 0 .and. rng2(1) < 0 .and. rng3(1) < 0) then ! p < q < r kout = 1 @@ -408,16 +408,16 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) integer, intent(in) :: n1, n2, n3, nloc, n3p integer, intent(in) :: idims(3) integer, intent(in) :: idx_table(n1,n2,n3) - + integer, intent(inout) :: loc_arr(2,nloc) integer, intent(inout) :: excits(n3p,5) - + integer :: idet integer :: p, q, r integer :: p1, q1, r1, p2, q2, r2 integer :: pqr1, pqr2 integer, allocatable :: temp(:), idx(:) - + allocate(temp(n3p),idx(n3p)) do idet = 1, n3p p = excits(idet,idims(1)); q = excits(idet,idims(2)); r = excits(idet,idims(3)); @@ -426,7 +426,7 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) call argsort(temp, idx) excits = excits(idx,:) deallocate(temp,idx) - + loc_arr(1,:) = 1; loc_arr(2,:) = 0; !!! WARNING: THERE IS A MEMORY LEAK HERE! pqrs2 is used below but is not set if n3p <= 1 !if (n3p <= 1) print*, "eomccsdt_p_loops >> WARNING: potential memory leakage in sort4 function. pqrs2 set to -1" @@ -434,7 +434,7 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) if (excits(1,1)==1 .and. excits(1,2)==1 .and. excits(1,3)==1 .and. excits(1,4)==1 .and. excits(1,5)==1) return p2 = excits(n3p,idims(1)); q2 = excits(n3p,idims(2)); r2 = excits(n3p,idims(3)); pqr2 = idx_table(p2,q2,r2) - else + else pqr2 = -1 end if do idet = 1, n3p-1 @@ -456,20 +456,20 @@ subroutine argsort(r,d) integer, intent(in), dimension(:) :: r integer, intent(out), dimension(size(r)) :: d - + integer, dimension(size(r)) :: il - + integer :: stepsize integer :: i, j, n, left, k, ksize - + n = size(r) - + do i=1,n d(i)=i end do - + if (n==1) return - + stepsize = 1 do while (stepsize < n) do left = 1, n-stepsize,stepsize*2 @@ -477,7 +477,7 @@ subroutine argsort(r,d) j = left+stepsize ksize = min(stepsize*2,n-left+1) k=1 - + do while (i < left+stepsize .and. j < left+ksize) if (r(d(i)) < r(d(j))) then il(k) = d(i) @@ -489,7 +489,7 @@ subroutine argsort(r,d) k = k+1 endif enddo - + if (i < left+stepsize) then ! fill up remaining from left il(k:ksize) = d(i:left+stepsize-1) @@ -504,239 +504,4 @@ subroutine argsort(r,d) end subroutine argsort - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! subroutine reorder4(y, x, iorder) -! -! integer, intent(in) :: iorder(4) -! real(kind=8), intent(in) :: x(:,:,:,:) -! -! real(kind=8), intent(out) :: y(:,:,:,:) -! -! integer :: i, j, k, l -! integer :: vec(4) -! -! y = 0.0d0 -! do i = 1, size(x,1) -! do j = 1, size(x,2) -! do k = 1, size(x,3) -! do l = 1, size(x,4) -! vec = (/i,j,k,l/) -! y(vec(iorder(1)),vec(iorder(2)),vec(iorder(3)),vec(iorder(4))) = x(i,j,k,l) -! end do -! end do -! end do -! end do -! -! end subroutine reorder4 - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module eaccp3_loops diff --git a/ccpy/lib/fortran/eomccp3_adaptive_loops.f90 b/ccpy/lib/fortran/eomccp3_adaptive_loops.f90 index f8109b7f..f8b4adaf 100644 --- a/ccpy/lib/fortran/eomccp3_adaptive_loops.f90 +++ b/ccpy/lib/fortran/eomccp3_adaptive_loops.f90 @@ -878,24 +878,4 @@ subroutine creomcc23D_p_with_selection(deltaA,deltaB,deltaC,deltaD,& end subroutine creomcc23D_p_with_selection - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - end module eomccp3_adaptive_loops diff --git a/ccpy/lib/fortran/ipccp3_loops.f90 b/ccpy/lib/fortran/ipccp3_loops.f90 index 1246d240..c02fa572 100644 --- a/ccpy/lib/fortran/ipccp3_loops.f90 +++ b/ccpy/lib/fortran/ipccp3_loops.f90 @@ -138,7 +138,7 @@ subroutine ipccp3B_full(deltaA,deltaB,deltaC,deltaD,& ! Local variables integer :: i, j, k, b, c real(kind=8) :: D, temp - + deltaA = 0.0d0 deltaB = 0.0d0 deltaC = 0.0d0 @@ -307,12 +307,12 @@ subroutine get_index_table3(idx_table, rng1, rng2, rng3, n1, n2, n3) integer, intent(in) :: n1, n2, n3 integer, intent(in) :: rng1(2), rng2(2), rng3(2) - + integer, intent(inout) :: idx_table(n1,n2,n3) - + integer :: kout integer :: p, q, r - + idx_table = 0 if (rng1(1) > 0 .and. rng2(1) < 0 .and. rng3(1) < 0) then ! p < q < r kout = 1 @@ -363,16 +363,16 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) integer, intent(in) :: n1, n2, n3, nloc, n3p integer, intent(in) :: idims(3) integer, intent(in) :: idx_table(n1,n2,n3) - + integer, intent(inout) :: loc_arr(2,nloc) integer, intent(inout) :: excits(n3p,5) - + integer :: idet integer :: p, q, r integer :: p1, q1, r1, p2, q2, r2 integer :: pqr1, pqr2 integer, allocatable :: temp(:), idx(:) - + allocate(temp(n3p),idx(n3p)) do idet = 1, n3p p = excits(idet,idims(1)); q = excits(idet,idims(2)); r = excits(idet,idims(3)); @@ -381,7 +381,7 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) call argsort(temp, idx) excits = excits(idx,:) deallocate(temp,idx) - + loc_arr(1,:) = 1; loc_arr(2,:) = 0; !!! WARNING: THERE IS A MEMORY LEAK HERE! pqrs2 is used below but is not set if n3p <= 1 !if (n3p <= 1) print*, "eomccsdt_p_loops >> WARNING: potential memory leakage in sort4 function. pqrs2 set to -1" @@ -389,7 +389,7 @@ subroutine sort3(excits, loc_arr, idx_table, idims, n1, n2, n3, nloc, n3p) if (excits(1,1)==1 .and. excits(1,2)==1 .and. excits(1,3)==1 .and. excits(1,4)==1 .and. excits(1,5)==1) return p2 = excits(n3p,idims(1)); q2 = excits(n3p,idims(2)); r2 = excits(n3p,idims(3)); pqr2 = idx_table(p2,q2,r2) - else + else pqr2 = -1 end if do idet = 1, n3p-1 @@ -411,20 +411,20 @@ subroutine argsort(r,d) integer, intent(in), dimension(:) :: r integer, intent(out), dimension(size(r)) :: d - + integer, dimension(size(r)) :: il - + integer :: stepsize integer :: i, j, n, left, k, ksize - + n = size(r) - + do i=1,n d(i)=i end do - + if (n==1) return - + stepsize = 1 do while (stepsize < n) do left = 1, n-stepsize,stepsize*2 @@ -432,7 +432,7 @@ subroutine argsort(r,d) j = left+stepsize ksize = min(stepsize*2,n-left+1) k=1 - + do while (i < left+stepsize .and. j < left+ksize) if (r(d(i)) < r(d(j))) then il(k) = d(i) @@ -444,7 +444,7 @@ subroutine argsort(r,d) k = k+1 endif enddo - + if (i < left+stepsize) then ! fill up remaining from left il(k:ksize) = d(i:left+stepsize-1) @@ -459,239 +459,4 @@ subroutine argsort(r,d) end subroutine argsort - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REORDER ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! subroutine reorder4(y, x, iorder) -! -! integer, intent(in) :: iorder(4) -! real(kind=8), intent(in) :: x(:,:,:,:) -! -! real(kind=8), intent(out) :: y(:,:,:,:) -! -! integer :: i, j, k, l -! integer :: vec(4) -! -! y = 0.0d0 -! do i = 1, size(x,1) -! do j = 1, size(x,2) -! do k = 1, size(x,3) -! do l = 1, size(x,4) -! vec = (/i,j,k,l/) -! y(vec(iorder(1)),vec(iorder(2)),vec(iorder(3)),vec(iorder(4))) = x(i,j,k,l) -! end do -! end do -! end do -! end do -! -! end subroutine reorder4 - - subroutine reorder3412(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3412 - - subroutine reorder1342(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i3,i4,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1342 - - subroutine reorder3421(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i4,i2,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3421 - - subroutine reorder2134(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i3,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2134 - - subroutine reorder1243(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i1,i2,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder1243 - - subroutine reorder4213(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i2,i1,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4213 - - subroutine reorder4312(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i3,i1,i2) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4312 - - subroutine reorder2341(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i3,i4,i1) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2341 - - subroutine reorder2143(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i2,i1,i4,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder2143 - - subroutine reorder4123(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i4,i1,i2,i3) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder4123 - - subroutine reorder3214(x_in,x_out) - - real(kind=8), intent(in) :: x_in(:,:,:,:) - real(kind=8), intent(out) :: x_out(:,:,:,:) - - integer :: i1, i2, i3, i4 - - do i1 = 1,size(x_in,1) - do i2 = 1,size(x_in,2) - do i3 = 1,size(x_in,3) - do i4= 1,size(x_in,4) - x_out(i3,i2,i1,i4) = x_in(i1,i2,i3,i4) - end do - end do - end do - end do - - end subroutine reorder3214 - end module ipccp3_loops