mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-21 11:03:29 +01:00
normal order V2 FROZEN CORE
This commit is contained in:
parent
1f56b5d0f4
commit
7076fcd202
@ -37,6 +37,9 @@
|
||||
n_points_integration_angular = my_n_pt_a_grid
|
||||
endif
|
||||
|
||||
print*, " n_points_radial_grid = ", n_points_radial_grid
|
||||
print*, " n_points_integration_angular = ", n_points_integration_angular
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
@ -20,8 +20,8 @@ BEGIN_PROVIDER [integer, n_points_final_grid]
|
||||
enddo
|
||||
enddo
|
||||
|
||||
print*,' n_points_final_grid = ', n_points_final_grid
|
||||
print*,' n max point = ', n_points_integration_angular*(n_points_radial_grid*nucl_num - 1)
|
||||
!print*,' n_points_final_grid = ', n_points_final_grid
|
||||
!print*,' n max point = ', n_points_integration_angular*(n_points_radial_grid*nucl_num - 1)
|
||||
call ezfio_set_becke_numerical_grid_n_points_final_grid(n_points_final_grid)
|
||||
|
||||
END_PROVIDER
|
||||
|
@ -108,7 +108,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_ao, (ao_num, ao_num, n_points_f
|
||||
|
||||
PROVIDE int2_grad1_u12_ao_num
|
||||
int2_grad1_u12_ao = int2_grad1_u12_ao_num
|
||||
FREE int2_grad1_u12_ao_num
|
||||
|
||||
else
|
||||
|
||||
@ -225,7 +224,6 @@ BEGIN_PROVIDER [double precision, int2_grad1_u12_square_ao, (ao_num, ao_num, n_p
|
||||
|
||||
PROVIDE int2_grad1_u12_square_ao_num
|
||||
int2_grad1_u12_square_ao = int2_grad1_u12_square_ao_num
|
||||
FREE int2_grad1_u12_square_ao_num
|
||||
|
||||
else
|
||||
|
||||
|
@ -15,6 +15,7 @@
|
||||
integer :: n_blocks, n_rest, n_pass
|
||||
integer :: i_blocks, i_rest, i_pass, ii
|
||||
double precision :: time0, time1
|
||||
double precision :: mem, n_double
|
||||
double precision, allocatable :: tmp(:,:,:)
|
||||
double precision, allocatable :: tmp_grad1_u12(:,:,:), tmp_grad1_u12_squared(:,:)
|
||||
|
||||
@ -43,29 +44,31 @@
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! n_points_final_grid = n_blocks * n_pass + n_rest
|
||||
n_blocks = 4
|
||||
call total_memory(mem)
|
||||
mem = max(1.d0, qp_max_mem - mem)
|
||||
n_double = mem * 1.d8
|
||||
n_blocks = min(n_double / (n_points_extra_final_grid * 4), 1.d0*n_points_final_grid)
|
||||
n_rest = int(mod(n_points_final_grid, n_blocks))
|
||||
n_pass = int((n_points_final_grid - n_rest) / n_blocks)
|
||||
|
||||
if(n_pass .le. 1) then
|
||||
print*, ' blocks are to large or grid is very small !'
|
||||
stop
|
||||
endif
|
||||
call write_int(6, n_pass, 'Number of passes')
|
||||
call write_int(6, n_blocks, 'Size of the blocks')
|
||||
call write_int(6, n_rest, 'Size of the last block')
|
||||
|
||||
|
||||
allocate(tmp_grad1_u12_squared(n_points_extra_final_grid,n_blocks))
|
||||
allocate(tmp_grad1_u12(n_points_extra_final_grid,n_blocks,3))
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i_pass, i_blocks, ipoint, ii, m, tmp_grad1_u12, &
|
||||
!$OMP tmp_grad1_u12_squared) &
|
||||
!$OMP SHARED (n_pass, n_blocks, n_points_extra_final_grid, ao_num, &
|
||||
!$OMP final_grid_points, tmp, int2_grad1_u12_ao_num, &
|
||||
!$OMP int2_grad1_u12_square_ao_num)
|
||||
!$OMP DO
|
||||
do i_pass = 1, n_pass
|
||||
ii = (i_pass-1)*n_blocks + 1
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i_blocks, ipoint) &
|
||||
!$OMP SHARED (n_blocks, n_points_extra_final_grid, ii, &
|
||||
!$OMP final_grid_points, tmp_grad1_u12, &
|
||||
!$OMP tmp_grad1_u12_squared)
|
||||
!$OMP DO
|
||||
do i_blocks = 1, n_blocks
|
||||
ipoint = ii - 1 + i_blocks ! r1
|
||||
call get_grad1_u12_withsq_r1_seq(final_grid_points(1,ipoint), n_points_extra_final_grid, tmp_grad1_u12(1,i_blocks,1) &
|
||||
@ -73,6 +76,8 @@
|
||||
, tmp_grad1_u12(1,i_blocks,3) &
|
||||
, tmp_grad1_u12_squared(1,i_blocks))
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do m = 1, 3
|
||||
call dgemm( "T", "N", ao_num*ao_num, n_blocks, n_points_extra_final_grid, 1.d0 &
|
||||
@ -83,19 +88,23 @@
|
||||
, tmp(1,1,1), n_points_extra_final_grid, tmp_grad1_u12_squared(1,1), n_points_extra_final_grid &
|
||||
, 0.d0, int2_grad1_u12_square_ao_num(1,1,ii), ao_num*ao_num)
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
deallocate(tmp_grad1_u12, tmp_grad1_u12_squared)
|
||||
|
||||
! TODO
|
||||
! OPENMP
|
||||
if(n_rest .ne. 0) then
|
||||
if(n_rest .gt. 0) then
|
||||
|
||||
allocate(tmp_grad1_u12_squared(n_points_extra_final_grid,n_rest))
|
||||
allocate(tmp_grad1_u12(n_points_extra_final_grid,n_rest,3))
|
||||
|
||||
ii = n_pass*n_blocks + 1
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP DEFAULT (NONE) &
|
||||
!$OMP PRIVATE (i_rest, ipoint) &
|
||||
!$OMP SHARED (n_rest, n_points_extra_final_grid, ii, &
|
||||
!$OMP final_grid_points, tmp_grad1_u12, &
|
||||
!$OMP tmp_grad1_u12_squared)
|
||||
!$OMP DO
|
||||
do i_rest = 1, n_rest
|
||||
ipoint = ii - 1 + i_rest ! r1
|
||||
call get_grad1_u12_withsq_r1_seq(final_grid_points(1,ipoint), n_points_extra_final_grid, tmp_grad1_u12(1,i_rest,1) &
|
||||
@ -103,6 +112,8 @@
|
||||
, tmp_grad1_u12(1,i_rest,3) &
|
||||
, tmp_grad1_u12_squared(1,i_rest))
|
||||
enddo
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
do m = 1, 3
|
||||
call dgemm( "T", "N", ao_num*ao_num, n_rest, n_points_extra_final_grid, 1.d0 &
|
||||
|
@ -55,12 +55,13 @@ BEGIN_PROVIDER [double precision, ao_tc_int_chemist, (ao_num, ao_num, ao_num, ao
|
||||
integer :: i, j, k, l
|
||||
double precision :: wall1, wall0
|
||||
|
||||
PROVIDE j1b_type
|
||||
|
||||
print *, ' providing ao_tc_int_chemist ...'
|
||||
call wall_time(wall0)
|
||||
|
||||
if(test_cycle_tc) then
|
||||
|
||||
PROVIDE j1b_type
|
||||
if(j1b_type .ne. 3) then
|
||||
print*, ' TC integrals with cycle can not be used for j1b_type =', j1b_type
|
||||
stop
|
||||
@ -86,6 +87,11 @@ BEGIN_PROVIDER [double precision, ao_tc_int_chemist, (ao_num, ao_num, ao_num, ao
|
||||
|
||||
FREE tc_grad_square_ao tc_grad_and_lapl_ao ao_two_e_coul
|
||||
|
||||
if(j1b_type .ge. 100) then
|
||||
FREE int2_grad1_u12_ao_num int2_grad1_u12_square_ao_num
|
||||
endif
|
||||
|
||||
|
||||
call wall_time(wall1)
|
||||
print *, ' wall time for ao_tc_int_chemist ', wall1 - wall0
|
||||
call print_memory_usage()
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -26,7 +26,7 @@ BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth_old, (mo_num, mo_num,
|
||||
|
||||
if(read_tc_norm_ord) then
|
||||
|
||||
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth_old', action="read")
|
||||
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth', action="read")
|
||||
read(11) normal_two_body_bi_orth_old
|
||||
close(11)
|
||||
|
||||
@ -103,7 +103,7 @@ BEGIN_PROVIDER [ double precision, normal_two_body_bi_orth_old, (mo_num, mo_num,
|
||||
endif
|
||||
|
||||
if(write_tc_norm_ord.and.mpi_master) then
|
||||
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth_old', action="write")
|
||||
open(unit=11, form="unformatted", file=trim(ezfio_filename)//'/work/normal_two_body_bi_orth', action="write")
|
||||
call ezfio_set_work_empty(.False.)
|
||||
write(11) normal_two_body_bi_orth_old
|
||||
close(11)
|
||||
|
@ -17,8 +17,11 @@ program tc_bi_ortho
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
read_wf = .True.
|
||||
touch read_wf
|
||||
call write_int(6, my_n_pt_r_grid, 'radial external grid over')
|
||||
call write_int(6, my_n_pt_a_grid, 'angular external grid over')
|
||||
|
||||
! read_wf = .True.
|
||||
! touch read_wf
|
||||
|
||||
! call test_h_u0
|
||||
! call test_slater_tc_opt
|
||||
@ -27,10 +30,12 @@ program tc_bi_ortho
|
||||
! call timing_single
|
||||
! call timing_double
|
||||
|
||||
call test_no()
|
||||
!call test_no_aba()
|
||||
!call test_no_aab()
|
||||
!call test_no_aaa()
|
||||
|
||||
call test_no()
|
||||
|
||||
end
|
||||
|
||||
subroutine test_h_u0
|
||||
@ -272,9 +277,9 @@ subroutine test_no()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
double precision :: accu, contrib, new, ref, thr, norm
|
||||
|
||||
print*, ' testing normal_two_body_bi_orth ...'
|
||||
print*, ' test_no ...'
|
||||
|
||||
thr = 1d-8
|
||||
|
||||
@ -282,6 +287,7 @@ subroutine test_no()
|
||||
PROVIDE normal_two_body_bi_orth
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -289,8 +295,8 @@ subroutine test_no()
|
||||
|
||||
new = normal_two_body_bi_orth (l,k,j,i)
|
||||
ref = normal_two_body_bi_orth_old(l,k,j,i)
|
||||
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem on normal_two_body_bi_orth'
|
||||
print*, l, k, j, i
|
||||
@ -298,14 +304,17 @@ subroutine test_no()
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on normal_two_body_bi_orth = ', accu / dble(mo_num)**4
|
||||
|
||||
print*, ' accu (%) = ', 100.d0*accu/norm
|
||||
|
||||
return
|
||||
end
|
||||
end subroutine test_no
|
||||
|
||||
! ---
|
||||
|
||||
@ -313,7 +322,7 @@ subroutine test_no_aba()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
double precision :: accu, contrib, new, ref, thr, norm
|
||||
|
||||
print*, ' testing no_aba_contraction ...'
|
||||
|
||||
@ -323,6 +332,7 @@ subroutine test_no_aba()
|
||||
PROVIDE no_aba_contraction
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -331,7 +341,6 @@ subroutine test_no_aba()
|
||||
new = no_aba_contraction (l,k,j,i)
|
||||
ref = no_aba_contraction_v0(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem on no_aba_contraction'
|
||||
print*, l, k, j, i
|
||||
@ -339,11 +348,14 @@ subroutine test_no_aba()
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on no_aba_contraction = ', accu / dble(mo_num)**4
|
||||
|
||||
print*, ' accu (%) = ', 100.d0*accu/norm
|
||||
|
||||
return
|
||||
end
|
||||
@ -355,7 +367,7 @@ subroutine test_no_aab()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
double precision :: accu, contrib, new, ref, thr, norm
|
||||
|
||||
print*, ' testing no_aab_contraction ...'
|
||||
|
||||
@ -365,6 +377,7 @@ subroutine test_no_aab()
|
||||
PROVIDE no_aab_contraction
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -373,7 +386,6 @@ subroutine test_no_aab()
|
||||
new = no_aab_contraction (l,k,j,i)
|
||||
ref = no_aab_contraction_v0(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem on no_aab_contraction'
|
||||
print*, l, k, j, i
|
||||
@ -381,11 +393,14 @@ subroutine test_no_aab()
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on no_aab_contraction = ', accu / dble(mo_num)**4
|
||||
|
||||
print*, ' accu (%) = ', 100.d0*accu/norm
|
||||
|
||||
return
|
||||
end
|
||||
@ -396,7 +411,7 @@ subroutine test_no_aaa()
|
||||
|
||||
implicit none
|
||||
integer :: i, j, k, l
|
||||
double precision :: accu, contrib, new, ref, thr
|
||||
double precision :: accu, contrib, new, ref, thr, norm
|
||||
|
||||
print*, ' testing no_aaa_contraction ...'
|
||||
|
||||
@ -406,6 +421,7 @@ subroutine test_no_aaa()
|
||||
PROVIDE no_aaa_contraction
|
||||
|
||||
accu = 0.d0
|
||||
norm = 0.d0
|
||||
do i = 1, mo_num
|
||||
do j = 1, mo_num
|
||||
do k = 1, mo_num
|
||||
@ -414,7 +430,6 @@ subroutine test_no_aaa()
|
||||
new = no_aaa_contraction (l,k,j,i)
|
||||
ref = no_aaa_contraction_v0(l,k,j,i)
|
||||
contrib = dabs(new - ref)
|
||||
accu += contrib
|
||||
if(contrib .gt. thr) then
|
||||
print*, ' problem on no_aaa_contraction'
|
||||
print*, l, k, j, i
|
||||
@ -422,13 +437,17 @@ subroutine test_no_aaa()
|
||||
stop
|
||||
endif
|
||||
|
||||
accu += contrib
|
||||
norm += dabs(ref)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
print*, ' accu on no_aaa_contraction = ', accu / dble(mo_num)**4
|
||||
|
||||
print*, ' accu (%) = ', 100.d0*accu/norm
|
||||
|
||||
return
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -110,13 +110,13 @@ default: False
|
||||
type: Threshold
|
||||
doc: Threshold on the convergence of the Hartree Fock energy.
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 1.e-10
|
||||
default: 1.e-8
|
||||
|
||||
[n_it_tcscf_max]
|
||||
type: Strictly_positive_int
|
||||
doc: Maximum number of SCF iterations
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 100
|
||||
default: 50
|
||||
|
||||
[selection_tc]
|
||||
type: integer
|
||||
@ -278,11 +278,11 @@ default: 30
|
||||
type: integer
|
||||
doc: size of angular grid over r2
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 50
|
||||
default: 194
|
||||
|
||||
[tc_grid2_r]
|
||||
type: integer
|
||||
doc: size of radial grid over r2
|
||||
interface: ezfio,provider,ocaml
|
||||
default: 30
|
||||
default: 50
|
||||
|
||||
|
@ -18,6 +18,10 @@ program tc_scf
|
||||
my_n_pt_a_grid = tc_grid1_a
|
||||
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||
|
||||
call write_int(6, my_n_pt_r_grid, 'radial external grid over')
|
||||
call write_int(6, my_n_pt_a_grid, 'angular external grid over')
|
||||
|
||||
|
||||
PROVIDE mu_erf
|
||||
print *, ' mu = ', mu_erf
|
||||
PROVIDE j1b_type
|
||||
@ -30,6 +34,9 @@ program tc_scf
|
||||
my_n_pt_r_extra_grid = tc_grid2_r
|
||||
my_n_pt_a_extra_grid = tc_grid2_a
|
||||
touch my_extra_grid_becke my_n_pt_r_extra_grid my_n_pt_a_extra_grid
|
||||
|
||||
call write_int(6, my_n_pt_r_extra_grid, 'radial internal grid over')
|
||||
call write_int(6, my_n_pt_a_extra_grid, 'angular internal grid over')
|
||||
endif
|
||||
|
||||
!call create_guess()
|
||||
|
Loading…
Reference in New Issue
Block a user