program deb_ao_2e_int implicit none !call check_ao_two_e_integral_cgtos() !call check_crint1() !call check_crint2() !call check_crint3() call check_crint4() end ! --- subroutine check_ao_two_e_integral_cgtos() implicit none integer :: i, j, k, l double precision :: acc, nrm, dif double precision :: tmp1, tmp2 double precision :: pw, pw0 double precision :: t1, t2, tt double precision, external :: ao_two_e_integral double precision, external :: ao_two_e_integral_cgtos acc = 0.d0 nrm = 0.d0 pw0 = dble(ao_num**3) pw = 0.d0 tt = 0.d0 do i = 1, ao_num call wall_time(t1) do j = 1, ao_num do k = 1, ao_num do l = 1, ao_num call deb_ao_2eint_cgtos(i, j, k, l) !tmp1 = ao_two_e_integral (i, j, k, l) !tmp2 = ao_two_e_integral_cgtos(i, j, k, l) !print*, i, j, k, l !dif = abs(tmp1 - tmp2) !!if(dif .gt. 1d-10) then ! print*, ' error on:', i, j, k, l ! print*, tmp1, tmp2, dif ! !stop !!endif !acc += dif !nrm += abs(tmp1) enddo enddo enddo call wall_time(t2) tt += t2 - t1 print*, " % done = ", 100.d0 * dble(i) / ao_num print*, ' ellepsed time (sec) =', tt enddo !print *, ' acc (%) = ', dif * 100.d0 / nrm end ! --- subroutine check_crint1() implicit none integer :: i, n, i_rho double precision :: dif_thr double precision :: dif_re, dif_im, acc_re, nrm_re, acc_im, nrm_im complex*16 :: rho_test(1:10) = (/ (1d-12, 0.d0), & (+1d-9, +1d-6), & (-1d-6, -1d-5), & (+1d-3, -1d-2), & (-1d-1, +1d-1), & (+1d-0, +1d-1), & (-1d+1, +1d+1), & (+1d+2, +1d+1), & (-1d+3, +1d+2), & (+1d+4, +1d+4) /) complex*16 :: rho complex*16 :: int_an, int_nm double precision, external :: rint complex*16, external :: crint_1, crint_2 n = 10 dif_thr = 1d-7 do i_rho = 8, 10 !do i_rho = 7, 7 !rho = (-10.d0, 0.1d0) !rho = (+10.d0, 0.1d0) rho = rho_test(i_rho) print*, "rho = ", real(rho), aimag(rho) acc_re = 0.d0 nrm_re = 0.d0 acc_im = 0.d0 nrm_im = 0.d0 do i = 0, n !int_an = crint_1(i, rho) int_an = crint_2(i, rho) call crint_quad_1(i, rho, 100000000, int_nm) dif_re = dabs(real(int_an) - real(int_nm)) dif_im = dabs(aimag(int_an) - aimag(int_nm)) if((dif_re .gt. dif_thr) .or. (dif_im .gt. dif_thr)) then print*, ' error on i =', i print*, real(int_an), real(int_nm), dif_re print*, aimag(int_an), aimag(int_nm), dif_im !print*, rint(i, real(rho)) print*, crint_1(i, rho) !print*, crint_2(i, rho) stop endif acc_re += dif_re nrm_re += dabs(real(int_nm)) acc_im += dif_im nrm_im += dabs(aimag(int_nm)) enddo print*, "accuracy on real part (%):", 100.d0 * acc_re / (nrm_re+1d-15) print*, "accuracy on imag part (%):", 100.d0 * acc_im / (nrm_im+1d-15) enddo end ! --- subroutine check_crint2() implicit none integer :: i, n, i_rho double precision :: dif_thr double precision :: dif_re, dif_im, acc_re, nrm_re, acc_im, nrm_im complex*16 :: rho_test(1:10) = (/ (1d-12, 0.d0), & (+1d-9, +1d-6), & (-1d-6, -1d-5), & (+1d-3, -1d-2), & (-1d-1, +1d-1), & (+1d-0, +1d-1), & (-1d+1, +1d+1), & (+1d+2, +1d+1), & (-1d+3, +1d+2), & (+1d+4, +1d+4) /) complex*16 :: rho complex*16 :: int_an, int_nm complex*16, external :: crint_1, crint_2 n = 30 dif_thr = 1d-12 do i_rho = 1, 10 rho = rho_test(i_rho) print*, "rho = ", real(rho), aimag(rho) acc_re = 0.d0 nrm_re = 0.d0 acc_im = 0.d0 nrm_im = 0.d0 do i = 0, n int_an = crint_1(i, rho) int_nm = crint_2(i, rho) dif_re = dabs(real(int_an) - real(int_nm)) !if(dif_re .gt. dif_thr) then ! print*, ' error in real part:', i ! print*, real(int_an), real(int_nm), dif_re ! stop !endif acc_re += dif_re nrm_re += dabs(real(int_nm)) dif_im = dabs(aimag(int_an) - aimag(int_nm)) !if(dif_im .gt. dif_thr) then ! print*, ' error in imag part:', i ! print*, aimag(int_an), aimag(int_nm), dif_im ! stop !endif acc_im += dif_im nrm_im += dabs(aimag(int_nm)) enddo print*, "accuracy on real part (%):", 100.d0 * acc_re / (nrm_re+1d-15) print*, "accuracy on imag part (%):", 100.d0 * acc_im / (nrm_im+1d-15) enddo end ! --- subroutine check_crint3() implicit none integer :: i_test, n_test integer :: nx, ny, n, n_quad integer :: i, seed_size, clock_time double precision :: xr(1:4), x double precision :: yr(1:4), y double precision :: dif_re, dif_im, acc_re, nrm_re, acc_im, nrm_im double precision :: delta_ref double precision :: t1, t2, t_int1, t_int2 complex*16 :: rho complex*16 :: int1_old, int1_ref, int2_old, int2_ref integer, allocatable :: seed(:) complex*16, external :: crint_2 call random_seed(size=seed_size) allocate(seed(seed_size)) call system_clock(count=clock_time) seed = clock_time + 37 * (/ (i, i=0, seed_size-1) /) !seed = 123456789 call random_seed(put=seed) t_int1 = 0.d0 t_int2 = 0.d0 n_test = 1 acc_re = 0.d0 nrm_re = 0.d0 acc_im = 0.d0 nrm_im = 0.d0 do i_test = 1, n_test ! Re(rho) call random_number(xr) x = xr(1) if(xr(2) .gt. 0.5d0) x = -x nx = int(15.d0 * xr(3)) if(xr(4) .gt. 0.5d0) nx = -nx x = x * 10.d0**nx ! Im(rho) call random_number(yr) y = yr(1) if(yr(2) .gt. 0.5d0) y = -y ny = int(5.d0 * yr(3)) if(yr(4) .gt. 0.5d0) ny = -ny y = y * 10.d0**ny rho = x + (0.d0, 1.d0) * y call random_number(x) x = 31.d0 * x n = int(x) !if(n.eq.0) cycle n = 0 !rho = (-6.83897018210218d0, -7.24479852507338d0) rho = (-9.83206247355480d0, 0.445269582329036d0) print*, " n = ", n print*, " rho = ", real(rho), aimag(rho) call wall_time(t1) int1_old = crint_2(n, rho) !n_quad = 10000000 !call crint_quad_1(n, rho, n_quad, int1_old) !!delta_ref = 1.d0 !!do while(delta_ref .gt. 1d-12) !! n_quad = n_quad * 10 !! !print*, " delta = ", delta_ref !! !print*, " increasing n_quad to:", n_quad !! call crint_quad_1(n, rho, n_quad, int1_ref) !! delta_ref = abs(int1_ref - int1_old) !! int1_old = int1_ref !! if(n_quad .ge. 1000000000) then !! print*, ' convergence was not reached for crint_quad_1' !! print*, " delta = ", delta_ref !! exit !! endif !!enddo call wall_time(t2) t_int1 = t_int1 + t2 - t1 !print*, " n_quad for crint_quad_1:", n_quad call wall_time(t1) n_quad = 10000000 call crint_quad_12(n, rho, n_quad, int2_old) !delta_ref = 1.d0 !do while(delta_ref .gt. 1d-12) ! n_quad = n_quad * 10 ! !print*, " delta = ", delta_ref ! !print*, " increasing n_quad to:", n_quad ! call crint_quad_12(n, rho, n_quad, int2_ref) ! delta_ref = abs(int2_ref - int2_old) ! int2_old = int2_ref ! if(n_quad .ge. 1000000000) then ! print*, ' convergence was not reached for crint_quad_2' ! print*, " delta = ", delta_ref ! exit ! endif !enddo call wall_time(t2) t_int2 = t_int2 + t2 - t1 !print*, " n_quad for crint_quad_2:", n_quad dif_re = dabs(real(int1_old) - real(int2_old)) dif_im = dabs(aimag(int1_old) - aimag(int2_old)) if((dif_re .gt. 1d-10) .or. (dif_im .gt. 1d-10)) then print*, ' important error found: ' print*, " n = ", n print*, " rho = ", real(rho), aimag(rho) print*, real(int1_old), real(int2_old), dif_re print*, aimag(int1_old), aimag(int2_old), dif_im !stop endif if((real(int1_old) /= real(int1_old)) .or. (aimag(int1_old) /= aimag(int1_old)) .or. & (real(int2_old) /= real(int2_old)) .or. (aimag(int2_old) /= aimag(int2_old)) ) then cycle else acc_re += dif_re acc_im += dif_im nrm_re += dabs(real(int1_old)) nrm_im += dabs(aimag(int1_old)) endif enddo print*, "accuracy on real part (%):", 100.d0 * acc_re / (nrm_re + 1d-15) print*, "accuracy on imag part (%):", 100.d0 * acc_im / (nrm_im + 1d-15) print*, "crint_quad_1 wall time (sec) = ", t_int1 print*, "crint_quad_2 wall time (sec) = ", t_int2 deallocate(seed) end ! --- subroutine check_crint4() implicit none integer :: i_test, n_test integer :: i, seed_size, clock_time double precision :: xr(1), x, shift double precision :: yr(1), y double precision :: dif_re, dif_im, acc_re, nrm_re, acc_im, nrm_im double precision :: delta_ref double precision :: t1, t2, t_int1, t_int2 complex*16 :: rho complex*16 :: int1, int2, int3 integer, allocatable :: seed(:) call random_seed(size=seed_size) allocate(seed(seed_size)) call system_clock(count=clock_time) seed = clock_time + 37 * (/ (i, i=0, seed_size-1) /) !seed = 123456789 call random_seed(put=seed) t_int1 = 0.d0 t_int2 = 0.d0 n_test = 100 shift = 15.d0 acc_re = 0.d0 nrm_re = 0.d0 acc_im = 0.d0 nrm_im = 0.d0 do i_test = 1, n_test call random_number(xr) call random_number(yr) x = 1.d0 * (2.d0 * shift * xr(1) - shift) y = 1.d0 * (2.d0 * shift * yr(1) - shift) rho = x + (0.d0, 1.d0) * y call wall_time(t1) call zboysfun00_1(rho, int1) call wall_time(t2) t_int1 = t_int1 + t2 - t1 call wall_time(t1) call zboysfun00_2(rho, int2) call wall_time(t2) t_int2 = t_int2 + t2 - t1 dif_re = dabs(real(int1) - real(int2)) dif_im = dabs(aimag(int1) - aimag(int2)) if((dif_re .gt. 1d-10) .or. (dif_im .gt. 1d-10)) then print*, ' important error found: ' print*, " rho = ", x, y print*, real(int1), real(int2), dif_re print*, aimag(int1), aimag(int2), dif_im call crint_quad_12(0, rho, 10000000, int3) if(zabs(int1 - int3) .lt. zabs(int2 - int3)) then print*, ' implementation 2 seems to be wrong' else print*, ' implementation 1 seems to be wrong' print*, ' quad 10000000:', real(int3), aimag(int3) call crint_quad_12(0, rho, 100000000, int3) print*, ' quad 100000000:', real(int3), aimag(int3) endif !print*, ' quad:', real(int3), aimag(int3) !stop endif if((real(int1) /= real(int1)) .or. (aimag(int1) /= aimag(int1)) .or. & (real(int2) /= real(int2)) .or. (aimag(int2) /= aimag(int2)) ) then cycle else acc_re += dif_re acc_im += dif_im nrm_re += dabs(real(int1)) nrm_im += dabs(aimag(int1)) endif enddo print*, "accuracy on real part (%):", 100.d0 * acc_re / (nrm_re + 1d-15) print*, "accuracy on imag part (%):", 100.d0 * acc_im / (nrm_im + 1d-15) print*, "zerf_1 wall time (sec) = ", t_int1 print*, "zerf_2 wall time (sec) = ", t_int2 deallocate(seed) end ! ---