From 4b4dd1f21cd970e6387b5ea79f297c2125824e55 Mon Sep 17 00:00:00 2001 From: Francois Coppens Date: Thu, 28 Oct 2021 15:29:12 +0200 Subject: [PATCH] Added LDS passing but no longer working. Passed one-time test in Ocrtave but SEGFAULTS when run continuesly. --- make.config.ifort | 6 +- src/det.irp.f | 390 ++++++++++++---------------------------------- 2 files changed, 103 insertions(+), 293 deletions(-) diff --git a/make.config.ifort b/make.config.ifort index 7321337..db77c5f 100644 --- a/make.config.ifort +++ b/make.config.ifort @@ -3,15 +3,15 @@ ## ALIGNMENT #CPU_TYPE="-xCORE-AVX2" # [ Host | CORE-AVX2 | CORE-AVX-I | AVX | SSE4.2 ] -CPU_TYPE="-xHost" +CPU_TYPE="-xCORE-AVX2" # Array alignment (Bytes) ALIGN="32" ## FORTRAN compiler -FC="ifort" +FC="/opt/intel/oneapi/compiler/2021.3.0/linux/bin/intel64/ifort" FCFLAGS="-O2 -g -ip -ftz -finline ${CPU_TYPE} -qopenmp-simd" #-traceback -LIB="-mkl=sequential" +LIB="-mkl=sequential -lqmckl" ## IRPF90 IRPF90="${QMCCHEM_PATH}/bin/irpf90" diff --git a/src/det.irp.f b/src/det.irp.f index 4fb247d..ecd5fb8 100644 --- a/src/det.irp.f +++ b/src/det.irp.f @@ -175,16 +175,14 @@ END_PROVIDER integer :: to_do(elec_alpha_num), n_to_do_old, n_to_do double precision :: tmp_inv(elec_alpha_num_8) real :: tmp_det(elec_alpha_num_8) - integer, save :: ifirst - logical :: file_exists + integer, save :: ifirst, couter=0 integer (qmckl_exit_code) :: rc integer (qmckl_context) :: context - integer(kind=8) :: ddim, nupdates + integer(kind=8) :: nupdates real(c_double) :: breakdown real(c_double), allocatable :: updates(:,:) - !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: tmp_inv, tmp_det if (ifirst == 0) then @@ -200,10 +198,10 @@ END_PROVIDER n_to_do = 0 do k=1,elec_alpha_num ! run over all alpha electrons - imo = mo_list_alpha_curr(k) - if ( imo /= mo_list_alpha_prev(k) ) then ! mo for electron k has changed - n_to_do += 1 ! one more electron to update - to_do(n_to_do) = k ! remember which electron to update + imo = mo_list_alpha_curr(k) ! pick MO-number from list of alpha-MOs + if ( imo /= mo_list_alpha_prev(k) ) then ! check if MO-number of kth alpha electron has changed + n_to_do += 1 ! update MO of kth alpha electron + to_do(n_to_do) = k ! remember which electrons to update endif enddo @@ -273,151 +271,70 @@ END_PROVIDER ddet = 0.d0 if (n_to_do < shiftl(elec_alpha_num,1)) then + ddet = det_alpha_value_curr ! set ddet to the current value + slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet - ddet = det_alpha_value_curr ! set ddet to the current value - slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet - - ! open(unit = 2000, file = "SlaterB_old.dat") - ! open(unit = 3000, file = "SlaterB_old_inv.dat") - ! do i=1, elec_alpha_num - ! do j=1, elec_alpha_num - ! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later - ! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) - ! end do - ! write(2000,*) - ! write(3000,*) - ! end do - ! flush(2000) - ! flush(3000) - ! close(2000) - ! close(3000) - - allocate(updates(elec_alpha_num, n_to_do)) - do j = 1, n_to_do ! do for all updates - k = to_do(j) ! find back the electron we need to update - imo = mo_list_alpha_curr(k) ! find column/row/MO for electron k - ! write(*,*) "n_to_do : ", n_to_do - ! write(*,*) "j, k = to_do(j), imo = mo_list_alpha_curr(k) : ", j, k, imo - do i = 1, elec_alpha_num ! run over all electrons - updates(i, j) = mo_value(i, imo) - slater_matrix_alpha(i, k) - slater_matrix_alpha(i, k) = mo_value(i, imo) - end do + open(unit = 2000, file = "SlaterB_old.dat") + open(unit = 3000, file = "SlaterB_old_inv.dat") + do i=1, elec_alpha_num + do j=1, elec_alpha_num + write(2000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later + write(3000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) end do + write(2000,*) + write(3000,*) + end do + flush(2000) + flush(3000) + close(2000) + close(3000) - context = qmckl_context_create() - breakdown = 1e-3 - rc = qmckl_sherman_morrison_smw32s(context, & - int(elec_alpha_num, kind=8), & - int(n_to_do, kind=8), & - updates, & - int(to_do, kind=8), & - breakdown, & - slater_matrix_alpha_inv_det(1:elec_alpha_num, 1:elec_alpha_num), & - ddet) - rc = qmckl_context_destroy(context) + allocate(updates(elec_alpha_num, n_to_do)) + do j = 1, n_to_do ! do for all updates + k = to_do(j) ! find back the electron we need to update + imo = mo_list_alpha_curr(k) ! find column/row/MO for electron k + ! write(*,*) "n_to_do : ", n_to_do + ! write(*,*) "j, k = to_do(j), imo = mo_list_alpha_curr(k) : ", j, k, imo + do i = 1, elec_alpha_num ! run over all electrons + updates(i, j) = mo_value(i, imo) - slater_matrix_alpha(i, k) + slater_matrix_alpha(i, k) = mo_value(i, imo) + end do + end do + + context = qmckl_context_create() + breakdown = 1e-3 + rc = qmckl_sherman_morrison(context, & + int(elec_alpha_num_8, kind=8), & + int(elec_alpha_num, kind=8), & + int(n_to_do, kind=8), & + updates, & + int(to_do, kind=8), & + breakdown, & + slater_matrix_alpha_inv_det(1:elec_alpha_num, 1:elec_alpha_num), & + ddet) + rc = qmckl_context_destroy(context) + deallocate(updates) - ! open(unit = 4000, file = "SlaterB.dat") - ! open(unit = 5000, file = "SlaterB_inv.dat") - ! do i=1, elec_alpha_num - ! do j=1, elec_alpha_num - ! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later - ! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) - ! end do - ! write(4000,*) - ! write(5000,*) - ! end do - ! flush(4000) - ! flush(5000) - ! close(4000) - ! close(5000) - - slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet - det_alpha_value_curr = ddet - deallocate(updates) - - - ! do while ( n_to_do > 0 ) - ! ddet = det_alpha_value_curr ! remember value of det_alpha_value_curr - ! n_to_do_old = n_to_do ! remember n_to_do value - ! n_to_do = 0 - ! do l=1,n_to_do_old - ! k = to_do(l) ! select electron to change - ! imo = mo_list_alpha_curr(k) ! select mo to change - - ! slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det / ddet - - ! open(unit = 2000, file = "SlaterA_old.dat") - ! open(unit = 3000, file = "SlaterA_old_inv.dat") - ! do i=1, elec_alpha_num - ! do j=1, elec_alpha_num - ! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later - ! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) - ! end do - ! write(2000,*) - ! write(3000,*) - ! end do - ! flush(2000) - ! flush(3000) - ! close(2000) - ! close(3000) - - ! do i = 1,elec_alpha_num - ! updates(i,1) = mo_value(i, imo) - slater_matrix_alpha(i, imo) - ! slater_matrix_alpha(i,imo) = mo_value(i, imo) - ! end do - - ! context = qmckl_context_create() - ! ddim = elec_alpha_num - ! nupdates = 1 - ! updates_index(1) = imo - ! breakdown = 1e-3 - ! rc = qmckl_sherman_morrison_splitting(context, & - ! ddim, & - ! nupdates, & - ! updates, & - ! updates_index, & - ! breakdown, & - ! slater_matrix_alpha_inv_det(1:elec_alpha_num, 1:elec_alpha_num), & - ! ddet) - ! rc = qmckl_context_destroy(context) - - ! open(unit = 4000, file = "SlaterA.dat") - ! open(unit = 5000, file = "SlaterA_inv.dat") - ! do i=1, elec_alpha_num - ! do j=1, elec_alpha_num - ! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later - ! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) - ! end do - ! write(4000,*) - ! write(5000,*) - ! end do - ! flush(4000) - ! flush(5000) - ! close(4000) - ! close(5000) - - ! slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet - - ! if (ddet /= 0.d0) then - ! det_alpha_value_curr = ddet - ! else - ! n_to_do += 1 - ! to_do(n_to_do) = k - ! ddet = det_alpha_value_curr - ! endif - ! enddo - ! if (n_to_do == n_to_do_old) then - ! ddet = 0.d0 - ! exit - ! endif - ! enddo - + open(unit = 4000, file = "SlaterB.dat") + open(unit = 5000, file = "SlaterB_inv.dat") + do i=1, elec_alpha_num + do j=1, elec_alpha_num + write(4000,"(E23.15, 1X)", advance="no") slater_matrix_alpha(j,i) ! avoid transpose later + write(5000,"(E23.15, 1X)", advance="no") slater_matrix_alpha_inv_det(i,j) + end do + write(4000,*) + write(5000,*) + end do + flush(4000) + flush(5000) + close(4000) + close(5000) + ! stop + slater_matrix_alpha_inv_det = slater_matrix_alpha_inv_det * ddet + det_alpha_value_curr = ddet endif - else - ddet = 0.d0 - endif ! Avoid NaN @@ -474,7 +391,7 @@ END_PROVIDER integer (qmckl_exit_code) :: rc integer (qmckl_context) :: context - integer(c_int64_t) :: ddim, nupdates + integer(c_int64_t) :: nupdates real(c_double) :: breakdown real(c_double), allocatable :: updates(:,:) @@ -569,26 +486,25 @@ END_PROVIDER ddet = 0.d0 if (n_to_do < shiftl(elec_beta_num,1)) then !! Why compare to double the number of electrons? - ! write(*,*) "Value of elec_beta_num, shiftl(elec_beta_num,1)", elec_beta_num, shiftl(elec_beta_num,1) - + ! write(*,*) "Value of elec_beta_num, shiftl(elec_beta_num,1)", elec_beta_num, shiftl(elec_beta_num,1) ddet = det_beta_value_curr ! set ddet to the current value slater_matrix_beta_inv_det = slater_matrix_beta_inv_det / ddet - ! open(unit = 2000, file = "SlaterB_old.dat") - ! open(unit = 3000, file = "SlaterB_old_inv.dat") - ! do i=1, elec_beta_num - ! do j=1, elec_beta_num - ! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later - ! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) - ! end do - ! write(2000,*) - ! write(3000,*) - ! end do - ! flush(2000) - ! flush(3000) - ! close(2000) - ! close(3000) + open(unit = 2000, file = "SlaterB_old.dat") + open(unit = 3000, file = "SlaterB_old_inv.dat") + do i=1, elec_beta_num + do j=1, elec_beta_num + write(2000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later + write(3000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) + end do + write(2000,*) + write(3000,*) + end do + flush(2000) + flush(3000) + close(2000) + close(3000) allocate(updates(elec_beta_num, n_to_do)) do j = 1, n_to_do ! do for all updates @@ -604,144 +520,38 @@ END_PROVIDER context = qmckl_context_create() breakdown = 1e-3 - rc = qmckl_sherman_morrison_smw32s(context, & + rc = qmckl_sherman_morrison(context, & + int(elec_beta_num_8, kind=8), & int(elec_beta_num, kind=8), & int(n_to_do, kind=8), & updates, & int(to_do, kind=8), & breakdown, & - slater_matrix_beta_inv_det(1:elec_beta_num, 1:elec_beta_num), & + slater_matrix_beta_inv_det, & ddet) rc = qmckl_context_destroy(context) + deallocate(updates) - ! open(unit = 4000, file = "SlaterB.dat") - ! open(unit = 5000, file = "SlaterB_inv.dat") - ! do i=1, elec_beta_num - ! do j=1, elec_beta_num - ! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later - ! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) - ! end do - ! write(4000,*) - ! write(5000,*) - ! end do - ! flush(4000) - ! flush(5000) - ! close(4000) - ! close(5000) - - slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet - det_beta_value_curr = ddet - deallocate(updates) - - - - ! !! THIS WHOLE WHILE LOOP NEEDS TO BE REPLACED WITH 1 CALL TO QMCKL_SHERMAN_MORRISON_SMWB32S() - ! do while ( n_to_do > 0 ) - ! ! keep doing this until there are no more updates. - ! ! This can take multiple runs over the updates stored in to_do() - ! ddet = det_beta_value_curr ! set ddet to the current value - ! n_to_do_old = n_to_do ! remember how many updates there are - ! n_to_do = 0 ! create a new list of update that need to be applied - - ! do l=1,n_to_do_old ! first run over all updates - ! k = to_do(l) ! find back the electron we need to update - ! imo = mo_list_beta_curr(k) ! find column/row/MO for electron k - - ! slater_matrix_beta_inv_det = slater_matrix_beta_inv_det / ddet - - ! open(unit = 2000, file = "SlaterB_old.dat") - ! open(unit = 3000, file = "SlaterB_old_inv.dat") - ! do i=1, elec_beta_num - ! do j=1, elec_beta_num - ! write(2000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later - ! write(3000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) - ! end do - ! write(2000,*) - ! write(3000,*) - ! end do - ! flush(2000) - ! flush(3000) - ! close(2000) - ! close(3000) - - ! do i = 1,elec_beta_num - ! updates(i,1) = mo_value(elec_alpha_num + i, imo) - slater_matrix_beta(i, k) - ! slater_matrix_beta(i, k) = mo_value(elec_alpha_num + i, imo) - ! end do - - ! context = qmckl_context_create() - ! ddim = elec_beta_num - ! nupdates = 1 - ! updates_index(1) = k - ! breakdown = 1e-3 - ! rc = qmckl_sherman_morrison_splitting(context, & - ! ddim, & - ! nupdates, & - ! updates, & - ! updates_index, & - ! breakdown, & - ! slater_matrix_beta_inv_det(1:elec_beta_num, 1:elec_beta_num), & - ! ddet) - ! rc = qmckl_context_destroy(context) - - ! open(unit = 4000, file = "SlaterB.dat") - ! open(unit = 5000, file = "SlaterB_inv.dat") - ! do i=1, elec_beta_num - ! do j=1, elec_beta_num - ! write(4000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later - ! write(5000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) - ! end do - ! write(4000,*) - ! write(5000,*) - ! end do - ! flush(4000) - ! flush(5000) - ! close(4000) - ! close(5000) - - ! slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet - ! stop - - ! if (ddet /= 0.d0) then - ! det_beta_value_curr = ddet - ! else - ! n_to_do += 1 - ! to_do(n_to_do) = k - ! ddet = det_beta_value_curr - ! endif - ! enddo - ! if (n_to_do == n_to_do_old) then - ! ddet = 0.d0 - ! exit - ! endif - ! enddo !! all updates have been done - - - - - - - - - - - - - - - - - - - - - + open(unit = 4000, file = "SlaterB.dat") + open(unit = 5000, file = "SlaterB_inv.dat") + do i=1, elec_beta_num + do j=1, elec_beta_num + write(4000,"(E23.15, 1X)", advance="no") slater_matrix_beta(j,i) ! avoid transpose later + write(5000,"(E23.15, 1X)", advance="no") slater_matrix_beta_inv_det(i,j) + end do + write(4000,*) + write(5000,*) + end do + flush(4000) + flush(5000) + close(4000) + close(5000) + ! stop + slater_matrix_beta_inv_det = slater_matrix_beta_inv_det * ddet + det_beta_value_curr = ddet endif - else - ddet = 0.d0 - endif ! Avoid NaN