diff --git a/bin/qp_set_frozen_core b/bin/qp_set_frozen_core index 879c71de..bc6f6834 100755 --- a/bin/qp_set_frozen_core +++ b/bin/qp_set_frozen_core @@ -7,12 +7,13 @@ setting all MOs as Active, except the n/2 first ones which are set as Core. If pseudo-potentials are used, all the MOs are set as Active. Usage: - qp_set_frozen_core [-q|--query] [(-l|-s|--large|--small)] EZFIO_DIR + qp_set_frozen_core [-q|--query] [(-l|-s|-u|--large|--small|--unset)] EZFIO_DIR Options: -q --query Prints in the standard output the number of frozen MOs -l --large Use a small core -s --small Use a large core + -u --unset Unset frozen core Default numbers of frozen electrons: @@ -88,7 +89,9 @@ def main(arguments): elif charge <= 54: n_frozen += 9 elif charge <= 86: n_frozen += 18 elif charge <= 118: n_frozen += 27 + elif arguments["--unset"]: + n_frozen = 0 else: # default for charge in ezfio.nuclei_nucl_charge: if charge <= 4: pass diff --git a/src/ao_basis/spherical_to_cartesian.irp.f b/src/ao_basis/spherical_to_cartesian.irp.f index 33a3bc89..336161f8 100644 --- a/src/ao_basis/spherical_to_cartesian.irp.f +++ b/src/ao_basis/spherical_to_cartesian.irp.f @@ -1,7 +1,7 @@ ! Spherical to cartesian transformation matrix obtained with ! Horton (http://theochem.github.com/horton/, 2015) -! First index is the index of the carteisan AO, obtained by ao_power_index +! First index is the index of the cartesian AO, obtained by ao_power_index ! Second index is the index of the spherical AO BEGIN_PROVIDER [ double precision, cart_to_sphe_0, (1,1) ] diff --git a/src/cipsi/pt2_stoch_routines.irp.f b/src/cipsi/pt2_stoch_routines.irp.f index 14b1d060..c7cee1ac 100644 --- a/src/cipsi/pt2_stoch_routines.irp.f +++ b/src/cipsi/pt2_stoch_routines.irp.f @@ -291,7 +291,7 @@ subroutine ZMQ_pt2(E, pt2_data, pt2_data_err, relative_error, N_in) print '(A)', '========== ======================= ===================== ===================== ===========' - print '(A)', ' Samples Energy Variance Norm^2 Seconds' + print '(A)', ' Samples Energy Variance Norm^2 Seconds' print '(A)', '========== ======================= ===================== ===================== ===========' PROVIDE global_selection_buffer @@ -523,21 +523,21 @@ subroutine pt2_collector(zmq_socket_pull, E, relative_error, pt2_data, pt2_data_ ! 1/(N-1.5) : see Brugger, The American Statistician (23) 4 p. 32 (1969) if(c > 2) then eqt = dabs((pt2_data_S2(t) % pt2(pt2_stoch_istate) / c) - (pt2_data_S(t) % pt2(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % pt2(pt2_stoch_istate) = eqt eqt = dabs((pt2_data_S2(t) % variance(pt2_stoch_istate) / c) - (pt2_data_S(t) % variance(pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqt = sqrt(eqt / (dble(c) - 1.5d0)) + eqt = dsqrt(eqt / (dble(c) - 1.5d0)) pt2_data_err % variance(pt2_stoch_istate) = eqt eqta(:) = dabs((pt2_data_S2(t) % overlap(:,pt2_stoch_istate) / c) - (pt2_data_S(t) % overlap(:,pt2_stoch_istate)/c)**2) ! dabs for numerical stability - eqta(:) = sqrt(eqta(:) / (dble(c) - 1.5d0)) + eqta(:) = dsqrt(eqta(:) / (dble(c) - 1.5d0)) pt2_data_err % overlap(:,pt2_stoch_istate) = eqta(:) if ((time - time1 > 1.d0) .or. (n==N_det_generators)) then time1 = time - print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.4)', c, & + print '(I10, X, F12.6, X, G10.3, X, F10.6, X, G10.3, X, F10.6, X, G10.3, X, F10.1)', c, & pt2_data % pt2(pt2_stoch_istate) +E, & pt2_data_err % pt2(pt2_stoch_istate), & pt2_data % variance(pt2_stoch_istate), & @@ -842,9 +842,8 @@ END_PROVIDER do t=1, pt2_N_teeth tooth_width = tilde_cW(pt2_n_0(t+1)) - tilde_cW(pt2_n_0(t)) if (tooth_width == 0.d0) then - tooth_width = sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1))) + tooth_width = max(1.d-15,sum(tilde_w(pt2_n_0(t):pt2_n_0(t+1)))) endif - ASSERT(tooth_width > 0.d0) do i=pt2_n_0(t)+1, pt2_n_0(t+1) pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width end do diff --git a/src/cipsi/run_pt2_slave.irp.f b/src/cipsi/run_pt2_slave.irp.f index f1001f89..30fc7ce0 100644 --- a/src/cipsi/run_pt2_slave.irp.f +++ b/src/cipsi/run_pt2_slave.irp.f @@ -116,10 +116,10 @@ subroutine run_pt2_slave_small(thread,iproc,energy) do k=1,n_tasks call pt2_alloc(pt2_data(k),N_states) b%cur = 0 - double precision :: time2 - call wall_time(time2) +! double precision :: time2 +! call wall_time(time2) call select_connected(i_generator(k),energy,pt2_data(k),b,subset(k),pt2_F(i_generator(k))) - call wall_time(time1) +! call wall_time(time1) ! print *, i_generator(1), time1-time2, n_tasks, pt2_F(i_generator(1)) enddo call wall_time(time1) @@ -190,8 +190,12 @@ subroutine run_pt2_slave_large(thread,iproc,energy) integer :: bsize ! Size of selection buffers logical :: sending + double precision :: time_shift + PROVIDE global_selection_buffer global_selection_buffer_lock + call random_number(time_shift) + time_shift = time_shift*15.d0 zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() @@ -209,6 +213,9 @@ subroutine run_pt2_slave_large(thread,iproc,energy) sending = .False. done = .False. + double precision :: time0, time1 + call wall_time(time0) + time0 = time0+time_shift do while (.not.done) integer, external :: get_tasks_from_taskserver @@ -244,19 +251,24 @@ subroutine run_pt2_slave_large(thread,iproc,energy) done = .true. endif call sort_selection_buffer(b) - call omp_set_lock(global_selection_buffer_lock) - global_selection_buffer%mini = b%mini - call merge_selection_buffers(b,global_selection_buffer) - b%cur=0 - call omp_unset_lock(global_selection_buffer_lock) + + call wall_time(time1) +! if (time1-time0 > 15.d0) then + call omp_set_lock(global_selection_buffer_lock) + global_selection_buffer%mini = b%mini + call merge_selection_buffers(b,global_selection_buffer) + b%cur=0 + call omp_unset_lock(global_selection_buffer_lock) + call wall_time(time0) +! endif + + call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) if ( iproc == 1 .or. i_generator < 100 .or. done) then call omp_set_lock(global_selection_buffer_lock) - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), global_selection_buffer, (/task_id/), 1,sending) global_selection_buffer%cur = 0 call omp_unset_lock(global_selection_buffer_lock) else - call push_pt2_results_async_recv(zmq_socket_push,b%mini,sending) call push_pt2_results_async_send(zmq_socket_push, (/i_generator/), (/pt2_data/), b, (/task_id/), 1,sending) endif diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index e62d5c8a..91147c04 100644 --- a/src/cipsi/selection.irp.f +++ b/src/cipsi/selection.irp.f @@ -474,17 +474,11 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d ! endif do i=1,fullinteresting(0) - do k=1,N_int - fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i)) - fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i)) - enddo + fullminilist(:,:,i) = psi_det_sorted(:,:,fullinteresting(i)) enddo do i=1,interesting(0) - do k=1,N_int - minilist(k,1,i) = psi_det_sorted(k,1,interesting(i)) - minilist(k,2,i) = psi_det_sorted(k,2,interesting(i)) - enddo + minilist(:,:,i) = psi_det_sorted(:,:,interesting(i)) enddo do s2=s1,2 @@ -1558,7 +1552,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) use bitmasks implicit none BEGIN_DOC - ! Gives the inidices(+1) of the bits set to 1 in the bit string + ! Gives the indices(+1) of the bits set to 1 in the bit string END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: string(Nint) diff --git a/src/cipsi/selection_buffer.irp.f b/src/cipsi/selection_buffer.irp.f index 79899139..1f743e0e 100644 --- a/src/cipsi/selection_buffer.irp.f +++ b/src/cipsi/selection_buffer.irp.f @@ -92,38 +92,51 @@ subroutine merge_selection_buffers(b1, b2) allocate(val(sze), detmp(N_int, 2, sze)) i1=1 i2=1 - do i=1,nmwen - if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then - exit - else if (i1 > b1%cur) then - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 - else if (i2 > b2%cur) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 - else - if (b1%val(i1) <= b2%val(i2)) then - val(i) = b1%val(i1) - detmp(1:N_int,1,i) = b1%det(1:N_int,1,i1) - detmp(1:N_int,2,i) = b1%det(1:N_int,2,i1) - i1=i1+1 + + select case (N_int) +BEGIN_TEMPLATE + case $case + do i=1,nmwen + if ( (i1 > b1%cur).and.(i2 > b2%cur) ) then + exit + else if (i1 > b1%cur) then + val(i) = b2%val(i2) + detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2) + detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2) + i2=i2+1 + else if (i2 > b2%cur) then + val(i) = b1%val(i1) + detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1) + detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1) + i1=i1+1 else - val(i) = b2%val(i2) - detmp(1:N_int,1,i) = b2%det(1:N_int,1,i2) - detmp(1:N_int,2,i) = b2%det(1:N_int,2,i2) - i2=i2+1 + if (b1%val(i1) <= b2%val(i2)) then + val(i) = b1%val(i1) + detmp(1:$N_int,1,i) = b1%det(1:$N_int,1,i1) + detmp(1:$N_int,2,i) = b1%det(1:$N_int,2,i1) + i1=i1+1 + else + val(i) = b2%val(i2) + detmp(1:$N_int,1,i) = b2%det(1:$N_int,1,i2) + detmp(1:$N_int,2,i) = b2%det(1:$N_int,2,i2) + i2=i2+1 + endif endif - endif - enddo + enddo + do i=nmwen+1,b2%N + val(i) = 0.d0 +! detmp(1:$N_int,1,i) = 0_bit_kind +! detmp(1:$N_int,2,i) = 0_bit_kind + enddo +SUBST [ case, N_int ] +(1); 1;; +(2); 2;; +(3); 3;; +(4); 4;; +default; N_int;; +END_TEMPLATE + end select deallocate(b2%det, b2%val) - do i=nmwen+1,b2%N - val(i) = 0.d0 - detmp(1:N_int,1:2,i) = 0_bit_kind - enddo b2%det => detmp b2%val => val b2%mini = min(b2%mini,b2%val(b2%N)) diff --git a/src/csf/configurations.irp.f b/src/csf/configurations.irp.f index 8e2a513c..ce5d48ab 100644 --- a/src/csf/configurations.irp.f +++ b/src/csf/configurations.irp.f @@ -779,6 +779,7 @@ subroutine binary_search_cfg(cfgInp,addcfg) end subroutine BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det, (2,N_configuration) ] +&BEGIN_PROVIDER [ integer, psi_configuration_n_det, (N_configuration) ] &BEGIN_PROVIDER [ integer, psi_configuration_to_psi_det_data, (N_det) ] implicit none @@ -867,6 +868,29 @@ end subroutine enddo deallocate(dets, old_order) + integer :: ndet_conf + do i = 1, N_configuration + ndet_conf = psi_configuration_to_psi_det(2,i) - psi_configuration_to_psi_det(1,i) + 1 + psi_configuration_n_det(i) = ndet_conf + enddo END_PROVIDER + +BEGIN_PROVIDER [ integer, n_elec_alpha_for_psi_configuration, (N_configuration)] + implicit none + integer :: i,j,k,l + integer(bit_kind) :: det_tmp(N_int,2),det_alpha(N_int) + n_elec_alpha_for_psi_configuration = 0 + do i = 1, N_configuration + j = psi_configuration_to_psi_det(2,i) + det_tmp(:,:) = psi_det(:,:,j) + k = 0 + do l = 1, N_int + det_alpha(N_int) = iand(det_tmp(l,1),psi_configuration(l,1,i)) + k += popcnt(det_alpha(l)) + enddo + n_elec_alpha_for_psi_configuration(i) = k + enddo + +END_PROVIDER diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f index 2f3d7f80..243e9995 100644 --- a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f +++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f @@ -1,5 +1,5 @@ -subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) +subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc) use mmap_module implicit none BEGIN_DOC @@ -412,36 +412,6 @@ subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d FREE nthreads_davidson end -subroutine hcalc_template(v,u,N_st,sze) - use bitmasks - implicit none - BEGIN_DOC - ! Template of routine for the application of H - ! - ! Here, it is done with the Hamiltonian matrix - ! - ! on the set of determinants of psi_det - ! - ! Computes $v = H | u \rangle$ - ! - END_DOC - integer, intent(in) :: N_st,sze - double precision, intent(in) :: u(sze,N_st) - double precision, intent(inout) :: v(sze,N_st) - integer :: i,j,istate - v = 0.d0 - do istate = 1, N_st - do i = 1, sze - do j = 1, sze - v(i,istate) += H_matrix_all_dets(j,i) * u(j,istate) - enddo - enddo - do i = 1, sze - v(i,istate) += u(i,istate) * nuclear_repulsion - enddo - enddo -end - subroutine dressing_diag_uv(v,u,dress_diag,N_st,sze) implicit none BEGIN_DOC diff --git a/src/davidson/u0_hs2_u0.irp.f b/src/davidson/u0_hs2_u0.irp.f index 8f7bf06b..38fb56bd 100644 --- a/src/davidson/u0_hs2_u0.irp.f +++ b/src/davidson/u0_hs2_u0.irp.f @@ -203,7 +203,7 @@ subroutine H_S2_u_0_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend, integer, allocatable :: doubles(:) integer, allocatable :: singles_a(:) integer, allocatable :: singles_b(:) - integer, allocatable :: idx(:), idx0(:) + integer, allocatable :: idx(:), buffer_lrow(:), idx0(:) integer :: maxab, n_singles_a, n_singles_b, kcol_prev integer*8 :: k8 logical :: compute_singles @@ -253,7 +253,7 @@ compute_singles=.True. !$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, & !$OMP lcol, lrow, l_a, l_b, utl, kk, u_is_sparse, & !$OMP buffer, doubles, n_doubles, umax, & - !$OMP tmp_det2, hij, sij, idx, l, kcol_prev, & + !$OMP tmp_det2, hij, sij, idx, buffer_lrow, l, kcol_prev, & !$OMP singles_a, n_singles_a, singles_b, ratio, & !$OMP n_singles_b, k8, last_found,left,right,right_max) @@ -264,7 +264,7 @@ compute_singles=.True. singles_a(maxab), & singles_b(maxab), & doubles(maxab), & - idx(maxab), utl(N_st,block_size)) + idx(maxab), buffer_lrow(maxab), utl(N_st,block_size)) kcol_prev=-1 @@ -332,18 +332,20 @@ compute_singles=.True. l_a = psi_bilinear_matrix_columns_loc(lcol) ASSERT (l_a <= N_det) - !DIR$ UNROLL(8) - !DIR$ LOOP COUNT avg(50000) do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) lrow = psi_bilinear_matrix_rows(l_a) ASSERT (lrow <= N_det_alpha_unique) - buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! hot spot + buffer_lrow(j) = lrow ASSERT (l_a <= N_det) idx(j) = l_a l_a = l_a+1 enddo + + do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol) + buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, buffer_lrow(j)) ! hot spot + enddo j = j-1 call get_all_spin_singles_$N_int( & @@ -789,7 +791,7 @@ compute_singles=.True. end do !$OMP END DO - deallocate(buffer, singles_a, singles_b, doubles, idx, utl) + deallocate(buffer, singles_a, singles_b, doubles, idx, buffer_lrow, utl) !$OMP END PARALLEL end diff --git a/src/determinants/dipole_moments.irp.f b/src/determinants/dipole_moments.irp.f index 8a5f1a2d..06fca0cd 100644 --- a/src/determinants/dipole_moments.irp.f +++ b/src/determinants/dipole_moments.irp.f @@ -9,7 +9,7 @@ double precision :: weight, r(3) double precision :: cpu0,cpu1,nuclei_part_z,nuclei_part_y,nuclei_part_x - call cpu_time(cpu0) +! call cpu_time(cpu0) z_dipole_moment = 0.d0 y_dipole_moment = 0.d0 x_dipole_moment = 0.d0 @@ -26,10 +26,10 @@ enddo enddo - print*,'electron part for z_dipole = ',z_dipole_moment - print*,'electron part for y_dipole = ',y_dipole_moment - print*,'electron part for x_dipole = ',x_dipole_moment - +! print*,'electron part for z_dipole = ',z_dipole_moment +! print*,'electron part for y_dipole = ',y_dipole_moment +! print*,'electron part for x_dipole = ',x_dipole_moment +! nuclei_part_z = 0.d0 nuclei_part_y = 0.d0 nuclei_part_x = 0.d0 @@ -38,28 +38,39 @@ nuclei_part_y += nucl_charge(i) * nucl_coord(i,2) nuclei_part_x += nucl_charge(i) * nucl_coord(i,1) enddo - print*,'nuclei part for z_dipole = ',nuclei_part_z - print*,'nuclei part for y_dipole = ',nuclei_part_y - print*,'nuclei part for x_dipole = ',nuclei_part_x - +! print*,'nuclei part for z_dipole = ',nuclei_part_z +! print*,'nuclei part for y_dipole = ',nuclei_part_y +! print*,'nuclei part for x_dipole = ',nuclei_part_x +! do istate = 1, N_states z_dipole_moment(istate) += nuclei_part_z y_dipole_moment(istate) += nuclei_part_y x_dipole_moment(istate) += nuclei_part_x enddo - call cpu_time(cpu1) - print*,'Time to provide the dipole moment :',cpu1-cpu0 +! call cpu_time(cpu1) +! print*,'Time to provide the dipole moment :',cpu1-cpu0 END_PROVIDER - subroutine print_z_dipole_moment_only + subroutine print_dipole_moments implicit none + integer :: i print*, '' print*, '' print*, '****************************************' - print*, 'z_dipole_moment = ',z_dipole_moment + write(*,'(A10)',advance='no') ' State : ' + do i = 1,N_states + write(*,'(i16)',advance='no') i + end do + write(*,*) '' + write(*,'(A17,100(1pE16.8))') 'x_dipole_moment = ',x_dipole_moment + write(*,'(A17,100(1pE16.8))') 'y_dipole_moment = ',y_dipole_moment + write(*,'(A17,100(1pE16.8))') 'z_dipole_moment = ',z_dipole_moment + !print*, 'x_dipole_moment = ',x_dipole_moment + !print*, 'y_dipole_moment = ',y_dipole_moment + !print*, 'z_dipole_moment = ',z_dipole_moment print*, '****************************************' end diff --git a/src/determinants/s2.irp.f b/src/determinants/s2.irp.f index d73b2dbf..2c1a8757 100644 --- a/src/determinants/s2.irp.f +++ b/src/determinants/s2.irp.f @@ -103,13 +103,17 @@ BEGIN_PROVIDER [ double precision, expected_s2] END_PROVIDER -BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] + BEGIN_PROVIDER [ double precision, s2_values, (N_states) ] +&BEGIN_PROVIDER [ double precision, s_values, (N_states) ] implicit none BEGIN_DOC ! array of the averaged values of the S^2 operator on the various states END_DOC integer :: i call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size) + do i = 1, N_states + s_values(i) = 0.5d0 *(-1.d0 + dsqrt(1.d0 + 4 * s2_values(i))) + enddo END_PROVIDER diff --git a/src/dft_utils_in_r/ao_in_r.irp.f b/src/dft_utils_in_r/ao_in_r.irp.f index 6fa6a4c7..38478d21 100644 --- a/src/dft_utils_in_r/ao_in_r.irp.f +++ b/src/dft_utils_in_r/ao_in_r.irp.f @@ -91,7 +91,19 @@ enddo END_PROVIDER - BEGIN_PROVIDER[double precision, aos_lapl_in_r_array, (ao_num,n_points_final_grid,3)] + BEGIN_PROVIDER [double precision, aos_lapl_in_r_array_transp, (ao_num, n_points_final_grid,3)] + implicit none + integer :: i,j,m + do i = 1, n_points_final_grid + do j = 1, ao_num + do m = 1, 3 + aos_lapl_in_r_array_transp(j,i,m) = aos_lapl_in_r_array(m,j,i) + enddo + enddo + enddo + END_PROVIDER + + BEGIN_PROVIDER [double precision, aos_lapl_in_r_array, (3,ao_num,n_points_final_grid)] implicit none BEGIN_DOC ! aos_lapl_in_r_array(i,j,k) = value of the kth component of the laplacian of jth ao on the ith grid point @@ -100,20 +112,20 @@ END_DOC integer :: i,j,m double precision :: aos_array(ao_num), r(3) - double precision :: aos_grad_array(ao_num,3) - double precision :: aos_lapl_array(ao_num,3) + double precision :: aos_grad_array(3,ao_num) + double precision :: aos_lapl_array(3,ao_num) !$OMP PARALLEL DO & !$OMP DEFAULT (NONE) & !$OMP PRIVATE (i,r,aos_array,aos_grad_array,aos_lapl_array,j,m) & !$OMP SHARED(aos_lapl_in_r_array,n_points_final_grid,ao_num,final_grid_points) - do m = 1, 3 - do i = 1, n_points_final_grid - r(1) = final_grid_points(1,i) - r(2) = final_grid_points(2,i) - r(3) = final_grid_points(3,i) - call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array) - do j = 1, ao_num - aos_lapl_in_r_array(j,i,m) = aos_lapl_array(j,m) + do i = 1, n_points_final_grid + r(1) = final_grid_points(1,i) + r(2) = final_grid_points(2,i) + r(3) = final_grid_points(3,i) + call give_all_aos_and_grad_and_lapl_at_r(r,aos_array,aos_grad_array,aos_lapl_array) + do j = 1, ao_num + do m = 1, 3 + aos_lapl_in_r_array(m,j,i) = aos_lapl_array(m,j) enddo enddo enddo diff --git a/src/dft_utils_in_r/mo_in_r.irp.f b/src/dft_utils_in_r/mo_in_r.irp.f index 0a8b4d52..192cb25a 100644 --- a/src/dft_utils_in_r/mo_in_r.irp.f +++ b/src/dft_utils_in_r/mo_in_r.irp.f @@ -138,7 +138,7 @@ integer :: m mos_lapl_in_r_array = 0.d0 do m=1,3 - call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num) + call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_coef_transp,mo_num,aos_lapl_in_r_array_transp(1,1,m),ao_num,0.d0,mos_lapl_in_r_array(1,1,m),mo_num) enddo END_PROVIDER diff --git a/src/dressing/alpha_factory.irp.f b/src/dressing/alpha_factory.irp.f index 5eeeb1a6..c7adffe3 100644 --- a/src/dressing/alpha_factory.irp.f +++ b/src/dressing/alpha_factory.irp.f @@ -1179,7 +1179,7 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) use bitmasks implicit none BEGIN_DOC - ! Gives the inidices(+1) of the bits set to 1 in the bit string + ! Gives the indices(+1) of the bits set to 1 in the bit string END_DOC integer, intent(in) :: Nint integer(bit_kind), intent(in) :: string(Nint) diff --git a/src/ezfio_files/output.irp.f b/src/ezfio_files/output.irp.f index 48512f92..7b2663a0 100644 --- a/src/ezfio_files/output.irp.f +++ b/src/ezfio_files/output.irp.f @@ -25,7 +25,7 @@ subroutine write_time(iunit) ct = ct - output_cpu_time_0 call wall_time(wt) wt = wt - output_wall_time_0 - write(6,'(A,F14.6,A,F14.6,A)') & + write(6,'(A,F14.2,A,F14.2,A)') & '.. >>>>> [ WALL TIME: ', wt, ' s ] [ CPU TIME: ', ct, ' s ] <<<<< ..' write(6,*) end diff --git a/src/mo_guess/h_core_guess_routine.irp.f b/src/mo_guess/h_core_guess_routine.irp.f index cbf23a9a..fcbdde49 100644 --- a/src/mo_guess/h_core_guess_routine.irp.f +++ b/src/mo_guess/h_core_guess_routine.irp.f @@ -7,7 +7,7 @@ subroutine hcore_guess label = 'Guess' call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, & size(mo_one_e_integrals,1), & - size(mo_one_e_integrals,2),label,1,.false.) + size(mo_one_e_integrals,2),label,1,.true.) call nullify_small_elements(ao_num, mo_num, mo_coef, size(mo_coef,1), 1.d-12 ) call save_mos TOUCH mo_coef mo_label diff --git a/src/tools/print_dipole.irp.f b/src/tools/print_dipole.irp.f index 8351308e..8db9aa09 100644 --- a/src/tools/print_dipole.irp.f +++ b/src/tools/print_dipole.irp.f @@ -1,5 +1,7 @@ program print_dipole implicit none - call print_z_dipole_moment_only + read_wf = .True. + TOUCH read_wf + call print_dipole_moments end diff --git a/src/tools/print_wf.irp.f b/src/tools/print_wf.irp.f index 7e51caaf..64eb1a1f 100644 --- a/src/tools/print_wf.irp.f +++ b/src/tools/print_wf.irp.f @@ -32,8 +32,9 @@ subroutine routine double precision :: norm_mono_a,norm_mono_b double precision :: norm_mono_a_2,norm_mono_b_2 double precision :: norm_mono_a_pert_2,norm_mono_b_pert_2 - double precision :: norm_mono_a_pert,norm_mono_b_pert + double precision :: norm_mono_a_pert,norm_mono_b_pert,norm_double_1 double precision :: delta_e,coef_2_2 + norm_mono_a = 0.d0 norm_mono_b = 0.d0 norm_mono_a_2 = 0.d0 @@ -42,6 +43,7 @@ subroutine routine norm_mono_b_pert = 0.d0 norm_mono_a_pert_2 = 0.d0 norm_mono_b_pert_2 = 0.d0 + norm_double_1 = 0.d0 do i = 1, min(N_det_print_wf,N_det) print*,'' print*,'i = ',i @@ -93,6 +95,7 @@ subroutine routine print*,'h1,p1 = ',h1,p1 print*,'s2',s2 print*,'h2,p2 = ',h2,p2 + norm_double_1 += dabs(psi_coef_sorted(i,1)/psi_coef_sorted(1,1)) endif print*,' = ',hij @@ -109,6 +112,7 @@ subroutine routine print*,'' print*,'L1 norm of mono alpha = ',norm_mono_a print*,'L1 norm of mono beta = ',norm_mono_b + print*,'L1 norm of double exc = ',norm_double_1 print*, '---' print*,'L2 norm of mono alpha = ',norm_mono_a_2 print*,'L2 norm of mono beta = ',norm_mono_b_2 diff --git a/src/two_body_rdm/two_e_dm_mo.irp.f b/src/two_body_rdm/two_e_dm_mo.irp.f index 4dadd2e6..a4dea15f 100644 --- a/src/two_body_rdm/two_e_dm_mo.irp.f +++ b/src/two_body_rdm/two_e_dm_mo.irp.f @@ -1,9 +1,8 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)] implicit none BEGIN_DOC - ! two_e_dm_bb_mo(i,j,k,l,istate) = STATE SPECIFIC physicist notation for 2RDM of beta/beta electrons - ! - ! + ! \sum_{\sigma \sigma'} + ! ! ! where the indices (i,j,k,l) belong to all MOs. ! @@ -12,7 +11,7 @@ BEGIN_PROVIDER [double precision, two_e_dm_mo, (mo_num,mo_num,mo_num,mo_num)] ! !!!!! WARNING !!!!! IF "no_core_density" then all elements involving at least one CORE MO are set to zero ! The state-averaged two-electron energy : ! - ! \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < ii jj | kk ll > + ! \sum_{i,j,k,l = 1, mo_num} two_e_dm_mo(i,j,k,l) * < kk ll | ii jj > END_DOC two_e_dm_mo = 0.d0 integer :: i,j,k,l,iorb,jorb,korb,lorb,istate diff --git a/src/utils/memory.irp.f b/src/utils/memory.irp.f index 3ea242b0..d5a066a1 100644 --- a/src/utils/memory.irp.f +++ b/src/utils/memory.irp.f @@ -114,7 +114,7 @@ subroutine print_memory_usage() call resident_memory(rss) call total_memory(mem) - write(*,'(A,F14.6,A,F14.6,A)') & + write(*,'(A,F14.3,A,F14.3,A)') & '.. >>>>> [ RES MEM : ', rss , & ' GB ] [ VIRT MEM : ', mem, ' GB ] <<<<< ..' end