mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-09 12:44:07 +01:00
Merge branch 'master' of github.com:scemama/quantum_package
This commit is contained in:
commit
6a35e89755
32
data/pseudo/tm
Normal file
32
data/pseudo/tm
Normal file
@ -0,0 +1,32 @@
|
||||
Ag GEN 36 2
|
||||
4
|
||||
11.074 1 1.712
|
||||
-166.201 2 1.391
|
||||
255.676 2 1.194
|
||||
-91.757 2 1.033
|
||||
3
|
||||
11.074 1 0.897
|
||||
-22.6472 2 1.226
|
||||
16.8557 2 0.9789
|
||||
4
|
||||
9.524 1 12.668
|
||||
227.659 2 1.662
|
||||
-363.576 2 1.4
|
||||
150.286 2 1.205
|
||||
|
||||
Au GEN 68 2
|
||||
4
|
||||
10.881 1 2.286
|
||||
-97.386 2 1.088
|
||||
270.134 2 1.267
|
||||
-171.733 2 1.499
|
||||
3
|
||||
10.721 1 1.38
|
||||
-63.222 2 1.111
|
||||
60.634 2 0.987
|
||||
4
|
||||
9.383 1 11.
|
||||
225.822 2 1.66
|
||||
286.233 2 1.342
|
||||
-497.561 2 1.437
|
||||
|
||||
@ -780,6 +780,27 @@ Ar GEN 10 2
|
||||
-1386.79918148 2 4.23753203
|
||||
1350.57102634 2 6.12344921
|
||||
|
||||
|
||||
Ag GEN 36 2
|
||||
6
|
||||
11.00000000 1 7.02317516
|
||||
178.71479273 2 1.36779344
|
||||
-206.54166000 2 1.85990342
|
||||
92.80009949 2 2.70385827
|
||||
-91.80009949 2 1.21149868
|
||||
77.25492677 3 2.46247055
|
||||
6
|
||||
-19159.46923372 2 2.56205947
|
||||
19178.09022506 2 3.28075183
|
||||
-19956.12207989 2 3.86486918
|
||||
12405.48540805 2 2.42437953
|
||||
-8569.95659418 2 5.14643113
|
||||
16121.59197935 2 4.79642660
|
||||
6
|
||||
-1054.66284551 2 1.92427691
|
||||
1072.38275494 2 1.94184452
|
||||
-1.15533162 2 27.95704514
|
||||
88.48945385 2 1.25545336
|
||||
-0.36033231 2 10.04954095
|
||||
-85.97371403 2 1.49011553
|
||||
|
||||
|
||||
|
||||
145
ocaml/Element.ml
145
ocaml/Element.ml
@ -9,6 +9,7 @@ type t =
|
||||
|Li|Be |B |C |N |O |F |Ne
|
||||
|Na|Mg |Al|Si|P |S |Cl|Ar
|
||||
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|
||||
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|
||||
with sexp
|
||||
|
||||
let of_string x =
|
||||
@ -50,6 +51,24 @@ let of_string x =
|
||||
| "Se" | "Selenium" -> Se
|
||||
| "Br" | "Bromine" -> Br
|
||||
| "Kr" | "Krypton" -> Kr
|
||||
| "Rb" | "Rubidium" -> Rb
|
||||
| "Sr" | "Strontium" -> Sr
|
||||
| "Y" | "Yttrium" -> Y
|
||||
| "Zr" | "Zirconium" -> Zr
|
||||
| "Nb" | "Niobium" -> Nb
|
||||
| "Mo" | "Molybdenum" -> Mo
|
||||
| "Tc" | "Technetium" -> Tc
|
||||
| "Ru" | "Ruthenium" -> Ru
|
||||
| "Rh" | "Rhodium" -> Rh
|
||||
| "Pd" | "Palladium" -> Pd
|
||||
| "Ag" | "Silver" -> Ag
|
||||
| "Cd" | "Cadmium" -> Cd
|
||||
| "In" | "Indium" -> In
|
||||
| "Sn" | "Tin" -> Sn
|
||||
| "Sb" | "Antimony" -> Sb
|
||||
| "Te" | "Tellurium" -> Te
|
||||
| "I" | "Iodine" -> I
|
||||
| "Xe" | "Xenon" -> Xe
|
||||
| x -> raise (ElementError ("Element "^x^" unknown"))
|
||||
|
||||
|
||||
@ -91,6 +110,24 @@ let to_string = function
|
||||
| Se -> "Se"
|
||||
| Br -> "Br"
|
||||
| Kr -> "Kr"
|
||||
| Rb -> "Rb"
|
||||
| Sr -> "Sr"
|
||||
| Y -> "Y"
|
||||
| Zr -> "Zr"
|
||||
| Nb -> "Nb"
|
||||
| Mo -> "Mo"
|
||||
| Tc -> "Tc"
|
||||
| Ru -> "Ru"
|
||||
| Rh -> "Rh"
|
||||
| Pd -> "Pd"
|
||||
| Ag -> "Ag"
|
||||
| Cd -> "Cd"
|
||||
| In -> "In"
|
||||
| Sn -> "Sn"
|
||||
| Sb -> "Sb"
|
||||
| Te -> "Te"
|
||||
| I -> "I"
|
||||
| Xe -> "Xe"
|
||||
|
||||
|
||||
let to_long_string = function
|
||||
@ -131,6 +168,24 @@ let to_long_string = function
|
||||
| Se -> "Selenium"
|
||||
| Br -> "Bromine"
|
||||
| Kr -> "Krypton"
|
||||
| Rb -> "Rubidium"
|
||||
| Sr -> "Strontium"
|
||||
| Y -> "Yttrium"
|
||||
| Zr -> "Zirconium"
|
||||
| Nb -> "Niobium"
|
||||
| Mo -> "Molybdenum"
|
||||
| Tc -> "Technetium"
|
||||
| Ru -> "Ruthenium"
|
||||
| Rh -> "Rhodium"
|
||||
| Pd -> "Palladium"
|
||||
| Ag -> "Silver"
|
||||
| Cd -> "Cadmium"
|
||||
| In -> "Indium"
|
||||
| Sn -> "Tin"
|
||||
| Sb -> "Antimony"
|
||||
| Te -> "Tellurium"
|
||||
| I -> "Iodine"
|
||||
| Xe -> "Xenon"
|
||||
|
||||
|
||||
let to_charge c =
|
||||
@ -172,6 +227,24 @@ let to_charge c =
|
||||
| Se -> 34
|
||||
| Br -> 35
|
||||
| Kr -> 36
|
||||
| Rb -> 37
|
||||
| Sr -> 38
|
||||
| Y -> 39
|
||||
| Zr -> 40
|
||||
| Nb -> 41
|
||||
| Mo -> 42
|
||||
| Tc -> 43
|
||||
| Ru -> 44
|
||||
| Rh -> 45
|
||||
| Pd -> 46
|
||||
| Ag -> 47
|
||||
| Cd -> 48
|
||||
| In -> 49
|
||||
| Sn -> 50
|
||||
| Sb -> 51
|
||||
| Te -> 52
|
||||
| I -> 53
|
||||
| Xe -> 54
|
||||
in Charge.of_int result
|
||||
|
||||
|
||||
@ -213,6 +286,24 @@ let of_charge c = match (Charge.to_int c) with
|
||||
| 34 -> Se
|
||||
| 35 -> Br
|
||||
| 36 -> Kr
|
||||
| 37 -> Rb
|
||||
| 38 -> Sr
|
||||
| 39 -> Y
|
||||
| 40 -> Zr
|
||||
| 41 -> Nb
|
||||
| 42 -> Mo
|
||||
| 43 -> Tc
|
||||
| 44 -> Ru
|
||||
| 45 -> Rh
|
||||
| 46 -> Pd
|
||||
| 47 -> Ag
|
||||
| 48 -> Cd
|
||||
| 49 -> In
|
||||
| 50 -> Sn
|
||||
| 51 -> Sb
|
||||
| 52 -> Te
|
||||
| 53 -> I
|
||||
| 54 -> Xe
|
||||
| x -> raise (ElementError ("Element of charge "^(string_of_int x)^" unknown"))
|
||||
|
||||
|
||||
@ -255,6 +346,24 @@ let covalent_radius x =
|
||||
| Se -> 0.70
|
||||
| Br -> 1.24
|
||||
| Kr -> 1.91
|
||||
| Rb -> 2.20
|
||||
| Sr -> 1.95
|
||||
| Y -> 1.90
|
||||
| Zr -> 1.75
|
||||
| Nb -> 1.64
|
||||
| Mo -> 1.54
|
||||
| Tc -> 1.47
|
||||
| Ru -> 1.46
|
||||
| Rh -> 1.42
|
||||
| Pd -> 1.39
|
||||
| Ag -> 1.45
|
||||
| Cd -> 1.44
|
||||
| In -> 1.42
|
||||
| Sn -> 1.39
|
||||
| Sb -> 1.39
|
||||
| Te -> 1.38
|
||||
| I -> 1.39
|
||||
| Xe -> 1.40
|
||||
in
|
||||
Units.angstrom_to_bohr *. (result x)
|
||||
|> Positive_float.of_float
|
||||
@ -298,6 +407,24 @@ let vdw_radius x =
|
||||
| Se -> 1.70
|
||||
| Br -> 2.10
|
||||
| Kr -> 1.70
|
||||
| Rb -> 3.03
|
||||
| Sr -> 2.49
|
||||
| Y -> 0.
|
||||
| Zr -> 0.
|
||||
| Nb -> 0.
|
||||
| Mo -> 0.
|
||||
| Tc -> 0.
|
||||
| Ru -> 0.
|
||||
| Rh -> 0.
|
||||
| Pd -> 1.63
|
||||
| Ag -> 1.72
|
||||
| Cd -> 1.58
|
||||
| In -> 1.93
|
||||
| Sn -> 2.17
|
||||
| Sb -> 2.06
|
||||
| Te -> 2.06
|
||||
| I -> 1.98
|
||||
| Xe -> 2.16
|
||||
in
|
||||
Units.angstrom_to_bohr *. (result x)
|
||||
|> Positive_float.of_float
|
||||
@ -341,6 +468,24 @@ let mass x =
|
||||
| Se -> 78.96
|
||||
| Br -> 79.904
|
||||
| Kr -> 83.80
|
||||
| Rb -> 85.4678
|
||||
| Sr -> 87.62
|
||||
| Y -> 88.90584
|
||||
| Zr -> 91.224
|
||||
| Nb -> 92.90637
|
||||
| Mo -> 95.95
|
||||
| Tc -> 98.
|
||||
| Ru -> 101.07
|
||||
| Rh -> 102.90550
|
||||
| Pd -> 106.42
|
||||
| Ag -> 107.8682
|
||||
| Cd -> 112.414
|
||||
| In -> 114.818
|
||||
| Sn -> 118.710
|
||||
| Sb -> 121.760
|
||||
| Te -> 127.60
|
||||
| I -> 126.90447
|
||||
| Xe -> 131.293
|
||||
in
|
||||
result x
|
||||
|> Positive_float.of_float
|
||||
|
||||
@ -6,6 +6,7 @@ type t =
|
||||
|Li|Be |B |C |N |O |F |Ne
|
||||
|Na|Mg |Al|Si|P |S |Cl|Ar
|
||||
|K |Ca|Sc|Ti|V |Cr|Mn|Fe|Co|Ni|Cu|Zn|Ga|Ge|As|Se|Br|Kr
|
||||
|Rb|Sr|Y |Zr|Nb|Mo|Tc|Ru|Rh|Pd|Ag|Cd|In|Sn|Sb|Te|I |Xe
|
||||
with sexp
|
||||
|
||||
(** String conversion functions *)
|
||||
|
||||
@ -11,7 +11,7 @@ program var_pt2_ratio_run
|
||||
|
||||
double precision, allocatable :: psi_det_save(:,:,:), psi_coef_save(:,:)
|
||||
|
||||
double precision :: E_fci, E_var, ratio, E_ref
|
||||
double precision :: E_fci, E_var, ratio, E_ref, selection_criterion_save
|
||||
integer :: Nmin, Nmax
|
||||
|
||||
pt2 = 1.d0
|
||||
@ -30,6 +30,7 @@ program var_pt2_ratio_run
|
||||
|
||||
threshold_selectors = 1.d0
|
||||
threshold_generators = 0.999d0
|
||||
selection_criterion_save = selection_criterion
|
||||
call diagonalize_CI
|
||||
call H_apply_FCI_PT2(pt2, norm_pert, H_pert_diag, N_st)
|
||||
E_ref = CI_energy(1) + pt2(1)
|
||||
@ -46,6 +47,8 @@ program var_pt2_ratio_run
|
||||
Nmax = max(Nmax,Nmin+10)
|
||||
! Select new determinants
|
||||
call H_apply_FCI(pt2, norm_pert, H_pert_diag, N_st)
|
||||
selection_criterion = selection_criterion_save
|
||||
SOFT_TOUCH selection_criterion selection_criterion_min selection_criterion_factor
|
||||
else
|
||||
Nmax = N_det
|
||||
N_det = Nmin + (Nmax-Nmin)/2
|
||||
|
||||
@ -223,6 +223,7 @@ END_PROVIDER
|
||||
ao_bi_elec_integral_beta_tmp = 0.d0
|
||||
|
||||
!$OMP DO SCHEDULE(dynamic)
|
||||
!DIR$ NOVECTOR
|
||||
do i8=0_8,ao_integrals_map%map_size
|
||||
n_elements = n_elements_max
|
||||
call get_cache_map(ao_integrals_map,i8,keys,values,n_elements)
|
||||
|
||||
@ -96,7 +96,7 @@ subroutine damping_SCF
|
||||
|
||||
a = (E_new + E - 2.d0*E_half)*2.d0
|
||||
b = -E_new - 3.d0*E + 4.d0*E_half
|
||||
lambda = -lambda*b/a
|
||||
lambda = -lambda*b/(a+1.d-16)
|
||||
D_alpha = (1.d0-lambda) * D_alpha + lambda * D_new_alpha
|
||||
D_beta = (1.d0-lambda) * D_beta + lambda * D_new_beta
|
||||
delta_E = HF_energy - E
|
||||
|
||||
73
plugins/QmcChem/dressed_dmc.irp.f
Normal file
73
plugins/QmcChem/dressed_dmc.irp.f
Normal file
@ -0,0 +1,73 @@
|
||||
program dressed_dmc
|
||||
implicit none
|
||||
double precision :: E0, hij
|
||||
double precision, allocatable :: H_jj(:), energies(:), delta_jj(:), cj(:), hj(:)
|
||||
integer :: i
|
||||
double precision, external :: diag_h_mat_elem
|
||||
|
||||
if (.not.read_wf) then
|
||||
stop 'read_wf should be true'
|
||||
endif
|
||||
|
||||
PROVIDE mo_bielec_integrals_in_map
|
||||
allocate ( H_jj(N_det), delta_jj(N_det), hj(N_det), cj(N_det), energies(N_states) )
|
||||
|
||||
! Read <i|\Phi_0>
|
||||
! -=-=-=-==-=-=-=
|
||||
|
||||
character*(32) :: w, w2
|
||||
integer :: k
|
||||
do while (.True.)
|
||||
read(*,*) w
|
||||
if ( trim(w) == 'Ci_h_psidet' ) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
do i=1,N_det
|
||||
read(*,*) k, w, hj(i)
|
||||
enddo
|
||||
|
||||
do while (.True.)
|
||||
read(*,*) w
|
||||
if ( trim(w) == 'Ci_overlap_psidet' ) then
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
do i=1,N_det
|
||||
read(*,*) k, w, cj(i)
|
||||
enddo
|
||||
|
||||
read(*,*)
|
||||
read(*,*) w, w2, E0
|
||||
print *, 'E0=', E0
|
||||
print *, 'Ndet = ', N_det
|
||||
|
||||
! Compute delta_ii
|
||||
! -=-=-=-==-=-=-=-
|
||||
|
||||
do i=1,N_det
|
||||
call i_H_psi(psi_det(1,1,i),psi_det,cj,N_int,N_det,size(psi_coef,1),N_states,energies)
|
||||
if (dabs(cj(i)) < 1.d-6) then
|
||||
delta_jj(i) = 0.d0
|
||||
else
|
||||
delta_jj(i) = (hj(i) - energies(1))/cj(i)
|
||||
endif
|
||||
H_jj(i) = diag_h_mat_elem(psi_det(1,1,i),N_int) + delta_jj(i)
|
||||
print *, 'Delta_jj(',i,') = ', Delta_jj(i), H_jj(i)
|
||||
enddo
|
||||
|
||||
|
||||
call davidson_diag_hjj(psi_det,psi_coef,H_jj,energies,size(psi_coef,1),N_det,N_states,N_int,6)
|
||||
|
||||
call save_wavefunction
|
||||
call write_spindeterminants
|
||||
|
||||
E0 = 0.d0
|
||||
do i=1,N_det
|
||||
call i_H_psi(psi_det(1,1,i),psi_det,psi_coef(1,1),N_int,N_det,size(psi_coef,1),N_states,energies)
|
||||
E0 += psi_coef(i,1) * energies(1)
|
||||
enddo
|
||||
print *, 'Trial energy: ', E0 + nuclear_repulsion
|
||||
|
||||
deallocate (H_jj, delta_jj, energies, cj)
|
||||
end
|
||||
@ -174,7 +174,7 @@ subroutine $subroutine_slave(thread, iproc)
|
||||
fock_diag_tmp, i_generator, iproc $params_post)
|
||||
endif
|
||||
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id,1)
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_id)
|
||||
call push_pt2(zmq_socket_push,pt2,norm_pert,H_pert_diag,i_generator,N_st,task_id)
|
||||
|
||||
enddo
|
||||
|
||||
@ -69,7 +69,7 @@ END_PROVIDER
|
||||
|
||||
if (diag_algorithm == "Davidson") then
|
||||
|
||||
call davidson_diag(psi_det,CI_eigenvectors,CI_electronic_energy, &
|
||||
call davidson_diag(psi_det,CI_eigenvectors,CI_electronic_energy,&
|
||||
size(CI_eigenvectors,1),N_det,N_states_diag,N_int,output_determinants)
|
||||
do j=1,N_states_diag
|
||||
call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),CI_eigenvectors_s2(j))
|
||||
@ -125,8 +125,6 @@ END_PROVIDER
|
||||
CI_eigenvectors_s2(i_state+i_other_state) = s2
|
||||
enddo
|
||||
|
||||
deallocate(index_good_state_array,good_state_array)
|
||||
|
||||
else
|
||||
print*,''
|
||||
print*,'!!!!!!!! WARNING !!!!!!!!!'
|
||||
@ -145,6 +143,7 @@ END_PROVIDER
|
||||
CI_eigenvectors_s2(j) = s2_eigvalues(j)
|
||||
enddo
|
||||
endif
|
||||
deallocate(index_good_state_array,good_state_array)
|
||||
deallocate(s2_eigvalues)
|
||||
else
|
||||
! Select the "N_states_diag" states of lowest energy
|
||||
@ -205,12 +204,12 @@ END_PROVIDER
|
||||
do i = 1, N_det
|
||||
CI_eigenvectors(i,j) = psi_coef(i,index_good_state_array(iorder(j)))
|
||||
enddo
|
||||
! call u0_H_u_0(e_0,CI_eigenvectors(1,j),n_det,psi_det,N_int)
|
||||
! print*,'e = ',CI_electronic_energy(j)
|
||||
! print*,'<e> = ',e_0
|
||||
! call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),s2)
|
||||
! print*,'s^2 = ',CI_eigenvectors_s2(j)
|
||||
! print*,'<s^2>= ',s2
|
||||
! call u0_H_u_0(e_0,CI_eigenvectors(1,j),n_det,psi_det,N_int)
|
||||
! print*,'e = ',CI_electronic_energy(j)
|
||||
! print*,'<e> = ',e_0
|
||||
! call get_s2_u0(psi_det,CI_eigenvectors(1,j),N_det,size(CI_eigenvectors,1),s2)
|
||||
! print*,'s^2 = ',CI_eigenvectors_s2(j)
|
||||
! print*,'<s^2>= ',s2
|
||||
enddo
|
||||
deallocate(e_array,iorder)
|
||||
|
||||
@ -228,7 +227,6 @@ END_PROVIDER
|
||||
enddo
|
||||
deallocate(index_good_state_array,good_state_array)
|
||||
|
||||
|
||||
else
|
||||
|
||||
! Sorting the N_states_diag by energy, whatever the S^2 value is
|
||||
@ -250,8 +248,8 @@ END_PROVIDER
|
||||
deallocate(e_array,iorder)
|
||||
endif
|
||||
deallocate(s2_eigvalues)
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -207,6 +207,7 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro
|
||||
do j=1,n_element(1)
|
||||
nt = list(j,1)
|
||||
idx_microlist(cur_microlist(nt)) = i
|
||||
! TODO : Page faults
|
||||
do k=1,Nint
|
||||
microlist(k,1,cur_microlist(nt)) = minilist(k,1,i)
|
||||
microlist(k,2,cur_microlist(nt)) = minilist(k,2,i)
|
||||
|
||||
@ -1060,6 +1060,7 @@ subroutine i_H_psi_minilist(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,
|
||||
i_in_coef = idx_key(idx(ii))
|
||||
!DIR$ FORCEINLINE
|
||||
call i_H_j(keys(1,1,i_in_key),key,Nint,hij)
|
||||
! TODO : Cache misses
|
||||
i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij
|
||||
enddo
|
||||
|
||||
|
||||
@ -351,14 +351,12 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||
|
||||
real :: map_mb
|
||||
if (read_ao_integrals) then
|
||||
integer :: load_ao_integrals
|
||||
print*,'Reading the AO integrals'
|
||||
if (load_ao_integrals(trim(ezfio_filename)//'/work/ao_integrals.bin') == 0) then
|
||||
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
||||
print*, 'AO integrals provided'
|
||||
ao_bielec_integrals_in_map = .True.
|
||||
return
|
||||
endif
|
||||
endif
|
||||
|
||||
print*, 'Providing the AO integrals'
|
||||
call wall_time(wall_0)
|
||||
@ -371,7 +369,7 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||
call new_parallel_job(zmq_to_qp_run_socket,'ao_integrals')
|
||||
|
||||
do l=1,ao_num
|
||||
write(task,*) l
|
||||
write(task,*) "triangle ", l
|
||||
call add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||
enddo
|
||||
|
||||
@ -402,8 +400,10 @@ BEGIN_PROVIDER [ logical, ao_bielec_integrals_in_map ]
|
||||
print*, ' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
|
||||
|
||||
ao_bielec_integrals_in_map = .True.
|
||||
|
||||
if (write_ao_integrals) then
|
||||
call dump_ao_integrals(trim(ezfio_filename)//'/work/ao_integrals.bin')
|
||||
call ezfio_set_work_empty(.False.)
|
||||
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
||||
call ezfio_set_integrals_bielec_disk_access_ao_integrals("Read")
|
||||
endif
|
||||
|
||||
|
||||
@ -103,12 +103,8 @@ subroutine ao_bielec_integrals_in_map_slave(thread,iproc)
|
||||
do
|
||||
call get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task)
|
||||
if (task_id == 0) exit
|
||||
read(task,*) l
|
||||
do j=1,l-1
|
||||
read(task,*) j, l
|
||||
call compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, 0)
|
||||
enddo
|
||||
call compute_ao_integrals_jl(l,l,n_integrals,buffer_i,buffer_value)
|
||||
call task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id)
|
||||
call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
|
||||
enddo
|
||||
@ -227,9 +223,11 @@ subroutine ao_bielec_integrals_in_map_collector
|
||||
control = get_ao_map_size(ao_integrals_map)
|
||||
|
||||
if (control /= accu) then
|
||||
print *, irp_here, 'Control : ', control
|
||||
print *, ''
|
||||
print *, irp_here
|
||||
print *, 'Control : ', control
|
||||
print *, 'Accu : ', accu
|
||||
print *, 'Some integrals were lost during the parallel computation. (2)'
|
||||
print *, 'Some integrals were lost during the parallel computation.'
|
||||
print *, 'Try to reduce the number of threads.'
|
||||
stop
|
||||
endif
|
||||
|
||||
@ -13,7 +13,7 @@ BEGIN_PROVIDER [ type(map_type), ao_integrals_map ]
|
||||
call bielec_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
|
||||
sze = key_max
|
||||
call map_init(ao_integrals_map,sze)
|
||||
print*, 'AO map initialized'
|
||||
print*, 'AO map initialized : ', sze
|
||||
END_PROVIDER
|
||||
|
||||
subroutine bielec_integrals_index(i,j,k,l,i1)
|
||||
|
||||
@ -28,13 +28,11 @@ BEGIN_PROVIDER [ logical, mo_bielec_integrals_in_map ]
|
||||
|
||||
mo_bielec_integrals_in_map = .True.
|
||||
if (read_mo_integrals) then
|
||||
integer :: load_mo_integrals
|
||||
print*,'Reading the MO integrals'
|
||||
if (load_mo_integrals(trim(ezfio_filename)//'/work/mo_integrals.bin') == 0) then
|
||||
call map_load_from_disk(trim(ezfio_filename)//'/work/mo_ints',mo_integrals_map)
|
||||
print*, 'MO integrals provided'
|
||||
return
|
||||
endif
|
||||
endif
|
||||
|
||||
call add_integrals_to_map(full_ijkl_bitmask_4)
|
||||
END_PROVIDER
|
||||
@ -299,7 +297,8 @@ subroutine add_integrals_to_map(mask_ijkl)
|
||||
print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')'
|
||||
|
||||
if (write_mo_integrals) then
|
||||
call dump_mo_integrals(trim(ezfio_filename)//'/work/mo_integrals.bin')
|
||||
call ezfio_set_work_empty(.False.)
|
||||
call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints',mo_integrals_map)
|
||||
call ezfio_set_integrals_bielec_disk_access_mo_integrals("Read")
|
||||
endif
|
||||
|
||||
|
||||
@ -6,24 +6,23 @@ BEGIN_PROVIDER [double precision, mo_nucl_elec_integral, (mo_tot_num_align,mo_to
|
||||
! interaction nuclear electron on the MO basis
|
||||
END_DOC
|
||||
|
||||
mo_nucl_elec_integral = 0.d0
|
||||
!$OMP PARALLEL DO DEFAULT(none) &
|
||||
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
||||
!$OMP SHARED(mo_tot_num,ao_num,mo_coef, &
|
||||
!$OMP mo_nucl_elec_integral, ao_nucl_elec_integral)
|
||||
do i = 1, mo_tot_num
|
||||
do j = 1, mo_tot_num
|
||||
do i1 = 1,ao_num
|
||||
c_i1 = mo_coef(i1,i)
|
||||
do j1 = 1,ao_num
|
||||
c_j1 = c_i1*mo_coef(j1,j)
|
||||
mo_nucl_elec_integral(j,i) = mo_nucl_elec_integral(j,i) + &
|
||||
c_j1 * ao_nucl_elec_integral(j1,i1)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
double precision, allocatable :: X(:,:)
|
||||
allocate(X(ao_num_align,mo_tot_num))
|
||||
|
||||
call dgemm('N','N',ao_num,mo_tot_num,ao_num, &
|
||||
1.d0, &
|
||||
ao_nucl_elec_integral, size(ao_nucl_elec_integral,1), &
|
||||
mo_coef,size(mo_coef,1), &
|
||||
0.d0, X, size(X,1))
|
||||
|
||||
call dgemm('T','N',mo_tot_num,mo_tot_num,ao_num, &
|
||||
1.d0, &
|
||||
mo_coef,size(mo_coef,1), &
|
||||
X, size(X,1), &
|
||||
0.d0, mo_nucl_elec_integral, size(mo_nucl_elec_integral,1))
|
||||
|
||||
deallocate(X)
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -36,25 +35,25 @@ BEGIN_PROVIDER [double precision, mo_nucl_elec_integral_per_atom, (mo_tot_num_al
|
||||
! where Rk is the geometry of the kth atom
|
||||
END_DOC
|
||||
|
||||
mo_nucl_elec_integral_per_atom = 0.d0
|
||||
allocate(X(ao_num_align,mo_tot_num))
|
||||
double precision, allocatable :: X(:,:)
|
||||
|
||||
do k = 1, nucl_num
|
||||
!$OMP PARALLEL DO DEFAULT(none) &
|
||||
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
||||
!$OMP SHARED(mo_tot_num,ao_num,mo_coef, &
|
||||
!$OMP mo_nucl_elec_integral_per_atom, ao_nucl_elec_integral_per_atom,k)
|
||||
do i = 1, mo_tot_num
|
||||
do j = 1, mo_tot_num
|
||||
do i1 = 1,ao_num
|
||||
c_i1 = mo_coef(i1,i)
|
||||
do j1 = 1,ao_num
|
||||
c_j1 = c_i1*mo_coef(j1,j)
|
||||
mo_nucl_elec_integral_per_atom(j,i,k) = mo_nucl_elec_integral_per_atom(j,i,k) + &
|
||||
c_j1 * ao_nucl_elec_integral_per_atom(j1,i1,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
call dgemm('N','N',ao_num,mo_tot_num,ao_num, &
|
||||
1.d0, &
|
||||
ao_nucl_elec_integral_per_atom, size(ao_nucl_elec_integral_per_atom,1),&
|
||||
mo_coef,size(mo_coef,1), &
|
||||
0.d0, X, size(X,1))
|
||||
|
||||
call dgemm('T','N',mo_tot_num,mo_tot_num,ao_num, &
|
||||
1.d0, &
|
||||
mo_coef,size(mo_coef,1), &
|
||||
X, size(X,1), &
|
||||
0.d0, mo_nucl_elec_integral_per_atom(1,1,k), size(mo_nucl_elec_integral_per_atom,1))
|
||||
|
||||
enddo
|
||||
|
||||
deallocate(X)
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
72
src/Utils/fortran_mmap.c
Normal file
72
src/Utils/fortran_mmap.c
Normal file
@ -0,0 +1,72 @@
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#include <sys/mman.h>
|
||||
|
||||
|
||||
void* mmap_fortran(char* filename, size_t bytes, int* file_descr, int read_only)
|
||||
{
|
||||
int i;
|
||||
int fd;
|
||||
int result;
|
||||
void* map;
|
||||
|
||||
if (read_only == 1)
|
||||
{
|
||||
fd = open(filename, O_RDONLY, (mode_t)0600);
|
||||
if (fd == -1) {
|
||||
printf("%s:\n", filename);
|
||||
perror("Error opening mmap file for reading");
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
map = mmap(NULL, bytes, PROT_READ, MAP_SHARED, fd, 0);
|
||||
}
|
||||
else
|
||||
{
|
||||
fd = open(filename, O_RDWR | O_CREAT, (mode_t)0600);
|
||||
if (fd == -1) {
|
||||
printf("%s:\n", filename);
|
||||
perror("Error opening mmap file for writing");
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
result = lseek(fd, bytes, SEEK_SET);
|
||||
if (result == -1) {
|
||||
close(fd);
|
||||
printf("%s:\n", filename);
|
||||
perror("Error calling lseek() to stretch the file");
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
result = write(fd, "", 1);
|
||||
if (result != 1) {
|
||||
close(fd);
|
||||
printf("%s:\n", filename);
|
||||
perror("Error writing last byte of the file");
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
map = mmap(NULL, bytes, PROT_READ | PROT_WRITE, MAP_SHARED, fd, 0);
|
||||
}
|
||||
|
||||
if (map == MAP_FAILED) {
|
||||
close(fd);
|
||||
printf("%s:\n", filename);
|
||||
perror("Error mmapping the file");
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
*file_descr = fd;
|
||||
return map;
|
||||
}
|
||||
|
||||
void munmap_fortran(size_t bytes, int fd, void* map)
|
||||
{
|
||||
if (munmap(map, bytes) == -1) {
|
||||
perror("Error un-mmapping the file");
|
||||
}
|
||||
close(fd);
|
||||
}
|
||||
115
src/Utils/map_functions.irp.f
Normal file
115
src/Utils/map_functions.irp.f
Normal file
@ -0,0 +1,115 @@
|
||||
subroutine map_save_to_disk(filename,map)
|
||||
use map_module
|
||||
use mmap_module
|
||||
implicit none
|
||||
character*(*), intent(in) :: filename
|
||||
type(map_type), intent(inout) :: map
|
||||
type(c_ptr) :: c_pointer(3)
|
||||
integer :: fd(3)
|
||||
integer*8 :: i,k
|
||||
integer :: j
|
||||
|
||||
|
||||
if (map % consolidated) then
|
||||
stop 'map already consolidated'
|
||||
endif
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .False., c_pointer(1))
|
||||
call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size +2_8/))
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .False., c_pointer(2))
|
||||
call c_f_pointer(c_pointer(2),map % consolidated_key, (/ map % n_elements /))
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .False., c_pointer(3))
|
||||
call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /))
|
||||
|
||||
if (.not.associated(map%consolidated_key)) then
|
||||
stop 'cannot consolidate map : consolidated_key not associated'
|
||||
endif
|
||||
|
||||
if (.not.associated(map%consolidated_value)) then
|
||||
stop 'cannot consolidate map : consolidated_value not associated'
|
||||
endif
|
||||
|
||||
if (.not.associated(map%consolidated_idx)) then
|
||||
stop 'cannot consolidate map : consolidated_idx not associated'
|
||||
endif
|
||||
|
||||
call map_sort(map)
|
||||
k = 1_8
|
||||
do i=0_8, map % map_size
|
||||
map % consolidated_idx (i+1) = k
|
||||
do j=1, map % map(i) % n_elements
|
||||
map % consolidated_value(k) = map % map(i) % value(j)
|
||||
map % consolidated_key (k) = map % map(i) % key(j)
|
||||
k = k+1_8
|
||||
enddo
|
||||
deallocate(map % map(i) % value)
|
||||
deallocate(map % map(i) % key)
|
||||
map % map(i) % value => map % consolidated_value ( map % consolidated_idx (i+1) :)
|
||||
map % map(i) % key => map % consolidated_key ( map % consolidated_idx (i+1) :)
|
||||
enddo
|
||||
map % consolidated_idx (map % map_size + 2_8) = k
|
||||
map % consolidated = .True.
|
||||
|
||||
|
||||
! call munmap( (/ map % map_size + 2_8 /), 8, fd(1), c_pointer(1))
|
||||
! call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .True., c_pointer(1))
|
||||
! call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size +2_8/))
|
||||
!
|
||||
! call munmap( (/ map % n_elements /), cache_key_kind, fd(2), c_pointer(2))
|
||||
! call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .True., c_pointer(2))
|
||||
! call c_f_pointer(c_pointer(2),map % consolidated_key, (/ map % n_elements /))
|
||||
!
|
||||
! call munmap( (/ map % n_elements /), integral_kind, fd(3), c_pointer(3))
|
||||
! call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., c_pointer(3))
|
||||
! call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /))
|
||||
|
||||
end
|
||||
|
||||
subroutine map_load_from_disk(filename,map)
|
||||
use map_module
|
||||
use mmap_module
|
||||
implicit none
|
||||
character*(*), intent(in) :: filename
|
||||
type(map_type), intent(inout) :: map
|
||||
type(c_ptr) :: c_pointer(3)
|
||||
integer :: fd(3)
|
||||
integer*8 :: i,k
|
||||
integer :: n_elements
|
||||
|
||||
|
||||
|
||||
if (map % consolidated) then
|
||||
stop 'map already consolidated'
|
||||
endif
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .True., c_pointer(1))
|
||||
call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size + 2_8/))
|
||||
|
||||
map% n_elements = map % consolidated_idx (map % map_size+2_8)-1
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .True., c_pointer(2))
|
||||
call c_f_pointer(c_pointer(2),map % consolidated_key, (/ map % n_elements /))
|
||||
|
||||
call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., c_pointer(3))
|
||||
call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /))
|
||||
|
||||
k = 1_8
|
||||
do i=0_8, map % map_size
|
||||
deallocate(map % map(i) % value)
|
||||
deallocate(map % map(i) % key)
|
||||
map % map(i) % value => map % consolidated_value ( map % consolidated_idx (i+1) :)
|
||||
map % map(i) % key => map % consolidated_key ( map % consolidated_idx (i+1) :)
|
||||
map % map(i) % sorted = .True.
|
||||
n_elements = map % consolidated_idx (i+2) - k
|
||||
k = map % consolidated_idx (i+2)
|
||||
map % map(i) % map_size = n_elements
|
||||
map % map(i) % n_elements = n_elements
|
||||
enddo
|
||||
map % n_elements = k-1
|
||||
map % sorted = .True.
|
||||
map % consolidated = .True.
|
||||
|
||||
end
|
||||
|
||||
@ -30,8 +30,8 @@ module map_module
|
||||
integer*8, parameter :: map_mask = ibset(0_8,15)-1_8
|
||||
|
||||
type cache_map_type
|
||||
integer(cache_key_kind), pointer :: key(:)
|
||||
real(integral_kind), pointer :: value(:)
|
||||
integer(cache_key_kind), pointer :: key(:)
|
||||
logical :: sorted
|
||||
integer(cache_map_size_kind) :: map_size
|
||||
integer(cache_map_size_kind) :: n_elements
|
||||
@ -40,9 +40,13 @@ module map_module
|
||||
|
||||
type map_type
|
||||
type(cache_map_type), allocatable :: map(:)
|
||||
real(integral_kind), pointer :: consolidated_value(:)
|
||||
integer(cache_key_kind), pointer :: consolidated_key(:)
|
||||
integer*8, pointer :: consolidated_idx(:)
|
||||
logical :: sorted
|
||||
logical :: consolidated
|
||||
integer(map_size_kind) :: map_size
|
||||
integer(map_size_kind) :: n_elements
|
||||
logical :: sorted
|
||||
integer(omp_lock_kind) :: lock
|
||||
end type map_type
|
||||
|
||||
@ -92,6 +96,7 @@ subroutine map_init(map,keymax)
|
||||
|
||||
map%n_elements = 0_8
|
||||
map%map_size = ishft(keymax,map_shift)
|
||||
map%consolidated = .False.
|
||||
|
||||
allocate(map%map(0_8:map%map_size),stat=err)
|
||||
if (err /= 0) then
|
||||
@ -618,6 +623,7 @@ subroutine search_key_big_interval(key,X,sze,idx,ibegin_in,iend_in)
|
||||
idx = ibegin + istep
|
||||
do while (istep > 16)
|
||||
idx = ibegin + istep
|
||||
! TODO : Cache misses
|
||||
if (cache_key < X(idx)) then
|
||||
iend = idx
|
||||
istep = ishft(idx-ibegin,-1)
|
||||
@ -655,12 +661,10 @@ subroutine search_key_big_interval(key,X,sze,idx,ibegin_in,iend_in)
|
||||
idx = ibegin
|
||||
if (min(iend_in,sze) > ibegin+16) then
|
||||
iend = ibegin+16
|
||||
!DIR$ VECTOR ALIGNED
|
||||
do while (cache_key > X(idx))
|
||||
idx = idx+1
|
||||
end do
|
||||
else
|
||||
!DIR$ VECTOR ALIGNED
|
||||
do while (cache_key > X(idx))
|
||||
idx = idx+1
|
||||
if (idx /= iend) then
|
||||
@ -768,13 +772,11 @@ subroutine search_key_value_big_interval(key,value,X,Y,sze,idx,ibegin_in,iend_in
|
||||
value = Y(idx)
|
||||
if (min(iend_in,sze) > ibegin+16) then
|
||||
iend = ibegin+16
|
||||
!DIR$ VECTOR ALIGNED
|
||||
do while (cache_key > X(idx))
|
||||
idx = idx+1
|
||||
value = Y(idx)
|
||||
end do
|
||||
else
|
||||
!DIR$ VECTOR ALIGNED
|
||||
do while (cache_key > X(idx))
|
||||
idx = idx+1
|
||||
value = Y(idx)
|
||||
@ -853,3 +855,4 @@ subroutine get_cache_map(map,map_idx,keys,values,n_elements)
|
||||
enddo
|
||||
|
||||
end
|
||||
|
||||
|
||||
69
src/Utils/mmap.f90
Normal file
69
src/Utils/mmap.f90
Normal file
@ -0,0 +1,69 @@
|
||||
module mmap_module
|
||||
|
||||
use iso_c_binding
|
||||
|
||||
interface
|
||||
|
||||
! File descriptors
|
||||
! ----------------
|
||||
|
||||
type(c_ptr) function c_mmap_fortran(filename, length, fd, read_only) bind(c,name='mmap_fortran')
|
||||
use iso_c_binding
|
||||
character(c_char), intent(in) :: filename(*)
|
||||
integer(c_size_t), intent(in), value :: length
|
||||
integer(c_int), intent(out) :: fd
|
||||
integer(c_int), intent(in), value :: read_only
|
||||
end function
|
||||
|
||||
subroutine c_munmap(length, fd, map) bind(c,name='munmap_fortran')
|
||||
use iso_c_binding
|
||||
integer(c_size_t), intent(in), value :: length
|
||||
integer(c_int), intent(in), value :: fd
|
||||
type(c_ptr), intent(in), value :: map
|
||||
end subroutine
|
||||
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine mmap(filename, shape, bytes, fd, read_only, map)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
character*(*), intent(in) :: filename ! Name of the mapped file
|
||||
integer*8, intent(in) :: shape(:) ! Shape of the array to map
|
||||
integer, intent(in) :: bytes ! Number of bytes per element
|
||||
logical, intent(in) :: read_only ! If true, mmap is read-only
|
||||
integer, intent(out) :: fd ! File descriptor
|
||||
type(c_ptr), intent(out) :: map ! C Pointer
|
||||
|
||||
integer(c_long) :: length
|
||||
integer(c_int) :: fd_
|
||||
|
||||
length = PRODUCT( shape(:) ) * bytes
|
||||
if (read_only) then
|
||||
map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 1)
|
||||
else
|
||||
map = c_mmap_fortran( trim(filename)//char(0), length, fd_, 0)
|
||||
endif
|
||||
fd = fd_
|
||||
end subroutine
|
||||
|
||||
subroutine munmap(shape, bytes, fd, map)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
integer*8, intent(in) :: shape(:) ! Shape of the array to map
|
||||
integer, intent(in) :: bytes ! Number of bytes per element
|
||||
integer, intent(in) :: fd ! File descriptor
|
||||
type(c_ptr), intent(in) :: map ! C pointer
|
||||
|
||||
integer(c_long) :: length
|
||||
integer(c_int) :: fd_
|
||||
|
||||
length = PRODUCT( shape(:) ) * bytes
|
||||
fd_ = fd
|
||||
call c_munmap( length, fd_, map)
|
||||
end subroutine
|
||||
|
||||
end module mmap_module
|
||||
|
||||
|
||||
@ -605,7 +605,7 @@ subroutine add_task_to_taskserver(zmq_to_qp_run_socket,task)
|
||||
|
||||
end
|
||||
|
||||
subroutine task_done_to_taskserver(zmq_to_qp_run_socket,worker_id, task_id)
|
||||
subroutine task_done_to_taskserver(zmq_to_qp_run_socket, worker_id, task_id)
|
||||
use f77_zmq
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
|
||||
Loading…
Reference in New Issue
Block a user