From 827e6933d4f64ab4d48f315bf1caebb8bb4ed19d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 2 Oct 2017 09:49:22 +0200 Subject: [PATCH] Commit --- plugins/FourIdx/four_index_sym.irp.f | 76 +++++++++++++------- plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f | 4 +- 2 files changed, 52 insertions(+), 28 deletions(-) diff --git a/plugins/FourIdx/four_index_sym.irp.f b/plugins/FourIdx/four_index_sym.irp.f index ffab74e5..e12d47ea 100644 --- a/plugins/FourIdx/four_index_sym.irp.f +++ b/plugins/FourIdx/four_index_sym.irp.f @@ -27,6 +27,7 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & integer :: i, j, k, l, ik, ll integer :: a, b, c, d double precision, external :: get_ao_bielec_integral + integer*8 :: ii integer(key_kind) :: idx real(integral_kind) :: tmp integer(key_kind), allocatable :: key(:) @@ -64,20 +65,12 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & (/ 12_8 * map_a % n_elements /), 8, fd, .False., c_pointer) call c_f_pointer(c_pointer, a_array, (/ 12_8 * map_a % n_elements /)) - allocate(l_pointer(l_start:l_end+1)) - -! !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i) SCHEDULE(static,137) -! do i=1,size(a_array) -! a_array(i) = 0.d0 -! enddo -! !$OMP END PARALLEL DO - - allocate( value((i_max*k_max)) ) - a = 1 - !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,ik,idx) + allocate(l_pointer(l_start:l_end+1), value((i_max*k_max)) ) + ii = 1_8 + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l,ik,idx,ii) do l=l_start,l_end !$OMP SINGLE - l_pointer(l) = a + l_pointer(l) = ii !$OMP END SINGLE do j=j_start,j_end !$OMP DO SCHEDULE(static,1) @@ -97,12 +90,12 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & ik = ik+1 tmp=value(ik) if (tmp /= 0.d0) then - a_array(a) = ik - a = a+1 - a_array(a) = j - a = a+1 - a_array(a) = transfer(dble(tmp), 1_8) - a = a+1 + a_array(ii) = ik + ii = ii+1_8 + a_array(ii) = j + ii = ii+1_8 + a_array(ii) = transfer(dble(tmp), 1_8) + ii = ii+1_8 endif enddo enddo @@ -110,16 +103,31 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & enddo enddo !$OMP END PARALLEL - l_pointer(l_end+1) = a + l_pointer(l_end+1) = ii deallocate(value) +!INPUT DATA +!open(unit=10,file='INPUT',form='UNFORMATTED') +!write(10) i_start, j_start, i_end, j_end +!write(10) a_start, b_start, a_end, b_end +!write(10) LDB, mo_tot_num +!write(10) matrix_B(1:LDB,1:mo_tot_num) +!idx=size(a_array) +!write(10) idx +!write(10) a_array +!write(10) l_pointer +!close(10) +!open(unit=10,file='OUTPUT',form='FORMATTED') +! END INPUT DATA + + !$OMP PARALLEL DEFAULT(NONE) SHARED(a_array,c_pointer,fd, & !$OMP a_start,a_end,b_start,b_end,c_start,c_end,d_start,d_end,& !$OMP i_start,i_end,j_start,j_end,k_start,k_end,l_start,l_end,& !$OMP i_min,i_max,j_min,j_max,k_min,k_max,l_min,l_max, & - !$OMP map_a,map_c,matrix_B,l_pointer) & + !$OMP map_c,matrix_B,l_pointer) & !$OMP PRIVATE(key,value,T,U,V,i,j,k,l,idx,ik,ll, & - !$OMP a,b,c,d,tmp,T2d,V2d) + !$OMP a,b,c,d,tmp,T2d,V2d,ii) allocate( key(i_max*j_max*k_max), value(i_max*j_max*k_max) ) allocate( U(a_start:a_end, c_start:c_end, b_start:b_end) ) @@ -139,18 +147,18 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & cycle endif - a=l_pointer(l) + ii=l_pointer(l) do j=j_start,j_end ik=0 do k=k_start,k_end do i=i_start,k ik = ik+1 - if ( (ik /= a_array(a)).or.(j /= a_array(a+1)) & - .or.(a >= l_pointer(l+1)) ) then + if ( (ik /= a_array(ii)).or.(j /= a_array(ii+1_8)) & + .or.(ii >= l_pointer(l+1)) ) then T2d(ik,j) = 0.d0 else - T2d(ik,j) = transfer(a_array(a+2), 1.d0) - a=a+3 + T2d(ik,j) = transfer(a_array(ii+2_8), 1.d0) + ii=ii+3_8 endif enddo enddo @@ -236,6 +244,22 @@ subroutine four_index_transform_sym(map_a,map_c,matrix_B,LDB, & call map_append(map_c, key, value, idx) !$OMP END CRITICAL +!!$OMP CRITICAL +!WRITE OUTPUT +!print *, d +!do b=b_start,d +! do c=c_start,c_end +! do a=a_start,min(b,c) +! if (dabs(U(a,c,b)) < 1.d-15) then +! cycle +! endif +! write(10,*) d,c,b,a,U(a,c,b) +! enddo +! enddo +!enddo +!END WRITE OUTPUT +!!$OMP END CRITICAL + enddo !$OMP END DO diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index afeb08fd..f0a54214 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -350,12 +350,12 @@ subroutine get_first_tooth(computed, first_teeth) end subroutine -BEGIN_PROVIDER [ integer, size_tbc ] +BEGIN_PROVIDER [ integer*8, size_tbc ] implicit none BEGIN_DOC ! Size of the tbc array END_DOC - size_tbc = (comb_teeth+1)*N_det_generators + fragment_count*fragment_first + size_tbc = int((comb_teeth+1),8)*int(N_det_generators,8) + fragment_count*fragment_first END_PROVIDER subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc)