LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-03 01:56:05 +01:00
Code Issues Releases Wiki Activity

Fixed travis

Browse Source
This commit is contained in:
Anthony Scemama 2018-01-05 18:15:34 +01:00
parent 79f6285472
commit a68f3bb909
11 changed files with 57 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
plugins/Generators_CAS/generators.irp.f
View File

@ -7,7 +7,7 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
END_DOC
integer :: i,k,l
logical :: good
call write_time(output_determinants)
call write_time(6)
N_det_generators = 0
do i=1,N_det
do l=1,n_cas_bitmask
@ -28,7 +28,7 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
endif
enddo
N_det_generators = max(N_det_generators,1)
call write_int(output_determinants,N_det_generators,'Number of generators')
call write_int(6,N_det_generators,'Number of generators')
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,psi_det_size) ]

2
plugins/Generators_restart/generators.irp.f
View File

@ -14,7 +14,7 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
else
print*,'PB in generators restart !!!'
endif
call write_int(output_determinants,N_det_generators,'Number of generators')
call write_int(6,N_det_generators,'Number of generators')
END_PROVIDER

8
plugins/MRCC_Utils/mrcc_utils.irp.f
View File

@ -211,7 +211,7 @@ END_PROVIDER
call davidson_diag_mrcc_HS2(psi_det,eigenvectors, &
size(eigenvectors,1), &
eigenvalues,N_det,N_states,N_states_diag,N_int, &
output_determinants,mrcc_state)
6,mrcc_state)
CI_eigenvectors_dressed(1:N_det,mrcc_state) = eigenvectors(1:N_det,mrcc_state)
CI_electronic_energy_dressed(mrcc_state) = eigenvalues(mrcc_state)
enddo
@ -316,12 +316,12 @@ BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ]
integer :: j
character*(8) :: st
call write_time(output_determinants)
call write_time(6)
do j=1,min(N_det,N_states)
write(st,'(I4)') j
CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion
call write_double(output_determinants,CI_energy_dressed(j),'Energy of state '//trim(st))
call write_double(output_determinants,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st))
call write_double(6,CI_energy_dressed(j),'Energy of state '//trim(st))
call write_double(6,CI_eigenvectors_s2_dressed(j),'S^2 of state '//trim(st))
enddo
END_PROVIDER

4
plugins/Selectors_no_sorted/selectors.irp.f
View File

@ -8,11 +8,11 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
END_DOC
integer :: i
double precision :: norm
call write_time(output_determinants)
call write_time(6)
norm = 0.d0
N_det_selectors = N_det
N_det_selectors = max(N_det_selectors,1)
call write_int(output_determinants,N_det_selectors,'Number of selectors')
call write_int(6,N_det_selectors,'Number of selectors')
END_PROVIDER

11
plugins/Symmetry/Symmetry.main.irp.f
View File

@ -3,9 +3,17 @@ program Symmetry
BEGIN_DOC
! TODO
END_DOC
integer :: i, j
integer :: i, j, k
character*8 :: sym
do k=1,n_irrep
print *, sym_operation(k)
do i=1,mo_tot_num
print '(1000(F8.4,X))', mo_symm(i,:,k), sum(mo_symm(i,:,k))
enddo
print *, ''
enddo
print *, 'Molecule is linear: ', molecule_is_linear
print *, 'Has center of inversion: ', molecule_has_center_of_inversion
print *, 'Has S2n improper rotation: ', molecule_has_improper_rotation
@ -17,5 +25,4 @@ program Symmetry
do i=1,n_irrep
print *, i, real(character_table(i,:))
enddo
PROVIDE mo_sym
end

18
plugins/Symmetry/aos.irp.f
View File

@ -22,15 +22,19 @@ subroutine generate_sym_coord(n_sym_points,result)
BEGIN_DOC
! xyz coordinates of points to check the symmetry, drawn uniformly in the molecular box.
END_DOC
integer :: i, xyz
integer :: i, iop
do i=1,n_sym_points
call random_number(result(1,i))
call random_number(result(2,i))
call random_number(result(3,i))
double precision, external :: halton_ranf
do i=1,n_sym_points,n_irrep
result(1,i) = sym_box(1,1) + halton_ranf(1) * (sym_box(1,2)-sym_box(1,1))
result(2,i) = sym_box(1,1) + halton_ranf(2) * (sym_box(2,2)-sym_box(2,1))
result(3,i) = sym_box(1,1) + halton_ranf(3) * (sym_box(3,2)-sym_box(3,1))
do iop=2,n_irrep
if (iop-1+i > n_sym_points) exit
call dgemm('N','N',3,1,3,1.d0,sym_transformation_matrices(1,1,iop), &
size(sym_transformation_matrices,1),&
result(1,i),size(result,1),0.d0,result(1,i+iop-1),size(result,1))
enddo
do xyz=1,3
result(xyz,1:n_sym_points) = sym_box(xyz,1) + result(xyz,:) * (sym_box(xyz,2)-sym_box(xyz,1))
enddo
end

108
plugins/Symmetry/find_sym.irp.f
View File

@ -47,6 +47,7 @@ BEGIN_PROVIDER [ integer, sym_rotation_axis, (3) ]
logical :: found
double precision, external :: u_dot_u
integer :: iorder, iaxis
do iaxis=1,3
do iorder=12,2,-1
sym_rotation_axis(iaxis) = iorder
@ -300,14 +301,6 @@ BEGIN_PROVIDER [ character*16, point_group ]
END_PROVIDER
BEGIN_PROVIDER [ character*8, mo_symmetry ]
implicit none
BEGIN_DOC
! Symmetry of the MOs
END_DOC
integer :: i,j
END_PROVIDER
BEGIN_PROVIDER [ integer, n_irrep ]
implicit none
@ -369,105 +362,6 @@ BEGIN_PROVIDER [ integer, mo_sym, (mo_tot_num) ]
double precision :: sym_operations_on_mos(mo_tot_num)
logical :: possible_irrep(n_irrep,mo_tot_num)
n_sym_points = 10
allocate(val(n_sym_points,mo_tot_num,2), sym_points(3,n_sym_points), ref_points(3,n_sym_points))
call generate_sym_coord(n_sym_points,ref_points)
call compute_sym_mo_values(ref_points,n_sym_points,val(1,1,2))
possible_irrep = .True.
do iop=1,n_irrep
if (sym_operation(iop) == 'E') then
cycle
endif
if (sym_operation(iop) == 'i') then
do ipoint=1,n_sym_points
call sym_apply_inversion(ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 'sh') then
do ipoint=1,n_sym_points
call sym_apply_reflexion(molecule_principal_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 's') then
do ipoint=1,n_sym_points
call sym_apply_reflexion(molecule_principal_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 'sv') then
do ipoint=1,n_sym_points
call sym_apply_reflexion(molecule_ternary_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 'sd') then
angle = dble(maxval(sym_rotation_axis))
do ipoint=1,n_sym_points
call sym_apply_diagonal_reflexion(angle,molecule_principal_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 'C2''') then
angle = 2.d0
do ipoint=1,n_sym_points
call sym_apply_rotation(angle,molecule_secondary_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop) == 'C2"') then
angle = 2.d0
do ipoint=1,n_sym_points
call sym_apply_rotation(angle,molecule_ternary_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else
do l=2,len(sym_operation(iop))
if (sym_operation(iop)(l:l) == '^') exit
enddo
read(sym_operation(iop)(2:l-1), *) iangle
if (l == len(sym_operation(iop))+1) then
l=1
else
read(sym_operation(iop)(l+1:), *, err=10, end=10) l
10 continue
endif
angle = dble(iangle)/(dble(l))
if (sym_operation(iop)(1:1) == 'C') then
do ipoint=1,n_sym_points
call sym_apply_rotation(angle,molecule_principal_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
else if (sym_operation(iop)(1:1) == 'S') then
do ipoint=1,n_sym_points
call sym_apply_improper_rotation(angle,molecule_principal_axis,ref_points(1,ipoint),sym_points(1,ipoint))
enddo
endif
endif
call compute_sym_mo_values(sym_points,n_sym_points,val(1,1,1))
print *, sym_operation(iop)
double precision :: icount
do imo=1,mo_tot_num
sym_operations_on_mos(imo) = 0.d0
icount = 0
do ipoint=1,n_sym_points
double precision :: x
if (dabs(val(ipoint,imo,1)) < 1.d-5) cycle
icount += 1.d0
x = val(ipoint,imo,1)/val(ipoint,imo,2)
if (dabs(x) > 1.d0) then
x = 1.d0/x
endif
sym_operations_on_mos(imo) += x
enddo
sym_operations_on_mos(imo) *= 1.d0/icount
if (dabs(sym_operations_on_mos(imo) - 1.d0) < 1.d-2) then
sym_operations_on_mos(imo) = 1.d0
else if (dabs(sym_operations_on_mos(imo) + 1.d0) < 1.d-2) then
sym_operations_on_mos(imo) = -1.d0
else if (dabs(sym_operations_on_mos(imo)) < 1.d-2) then
sym_operations_on_mos(imo) = 0.d0
endif
print *, imo, sym_operations_on_mos(imo)
do i=1,n_irrep
if (dabs(character_table(i,iop) - sym_operations_on_mos(imo)) > 1.d-2) then
possible_irrep(i,imo) = .False.
endif
enddo
enddo
enddo
do imo=1,mo_tot_num
print *, 'MO ', imo
do i=1,n_irrep

22
plugins/Symmetry/nuclei.irp.f
View File

@ -69,26 +69,26 @@ BEGIN_PROVIDER [ double precision, nucl_coord_sym, (nucl_num,3) ]
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
double precision, parameter :: a0= 0.529177249d0
call write_time(output_Nuclei)
write(output_Nuclei,'(A)') ''
write(output_Nuclei,'(A)') 'Nuclear Coordinates in standard orientation (Angstroms)'
write(output_Nuclei,'(A)') '======================================================='
write(output_Nuclei,'(A)') ''
write(output_Nuclei,ft) &
call write_time(6)
write(6,'(A)') ''
write(6,'(A)') 'Nuclear Coordinates in standard orientation (Angstroms)'
write(6,'(A)') '======================================================='
write(6,'(A)') ''
write(6,ft) &
'================','============','============','============','============'
write(output_Nuclei,*) &
write(6,*) &
' Atom Charge X Y Z '
write(output_Nuclei,ft) &
write(6,ft) &
'================','============','============','============','============'
do i=1,nucl_num
write(output_Nuclei,f) nucl_label(i), nucl_charge(i), &
write(6,f) nucl_label(i), nucl_charge(i), &
nucl_coord_sym(i,1)*a0, &
nucl_coord_sym(i,2)*a0, &
nucl_coord_sym(i,3)*a0
enddo
write(output_Nuclei,ft) &
write(6,ft) &
'================','============','============','============','============'
write(output_Nuclei,'(A)') ''
write(6,'(A)') ''
endif

2
plugins/Symmetry/sym_operation.irp.f
View File

@ -23,7 +23,7 @@ subroutine sym_apply_diagonal_reflexion(angle,iaxis,point_in,point_out)
double precision :: point_tmp1(3), point_tmp2(3)
integer :: iaxis2
iaxis2 = mod(iaxis,3)+1
iaxis2 = mod(iaxis2,3)+1
! iaxis2 = mod(iaxis2,3)+1
call sym_apply_rotation(-angle,iaxis,point_in,point_tmp1)
call sym_apply_reflexion(iaxis2,point_tmp1,point_tmp2)
call sym_apply_rotation(angle,iaxis,point_tmp2,point_out)

13
plugins/mrcepa0/dressing.irp.f
View File

@ -963,6 +963,19 @@ END_PROVIDER
enddo
end do
end do
! else if(mrmode == 10) then
! do i = 1, N_det_ref
! do i_state = 1, N_states
! delta_ii(i_state,i)= delta_ii_mrsc2(i_state,i)
! delta_ii_s2(i_state,i)= delta_ii_s2_mrsc2(i_state,i)
! enddo
! do j = 1, N_det_non_ref
! do i_state = 1, N_states
! delta_ij(i_state,j,i) = delta_ij_mrsc2(i_state,j,i)
! delta_ij_s2(i_state,j,i) = delta_ij_s2_mrsc2(i_state,j,i)
! enddo
! end do
! end do
else if(mrmode == 5) then
do i = 1, N_det_ref
do i_state = 1, N_states

2
src/Nuclei/nuclei.irp.f
View File

@ -8,7 +8,7 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
if (mpi_master) then
double precision, allocatable :: buffer(:,:)
nucl_coord_input = 0.d0
nucl_coord = 0.d0
allocate (buffer(nucl_num,3))
buffer = 0.d0
logical :: has