LCPQ
/
quantum_package
mirror of https://github.com/LCPQ/quantum_package
10
0
Fork 0
Code Issues Releases Wiki Activity

Removed output variables

This commit is contained in:
Anthony Scemama 2018-01-05 14:12:27 +00:00
parent ddc2dd44e9
commit b88a0eac78
20 changed files with 174 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
plugins/CIS/super_ci.irp.f
View File

@ -12,12 +12,12 @@ subroutine super_CI
integer :: k
character :: save_char
call write_time(output_hartree_fock)
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
call write_time(6)
write(6,'(A4,X,A16, X, A16, X, A16 )') &
'====','================','================','================'
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
write(6,'(A4,X,A16, X, A16, X, A16 )') &
' N ', 'Energy ', 'Energy diff ', 'Save '
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
write(6,'(A4,X,A16, X, A16, X, A16 )') &
'====','================','================','================'
E = HF_energy + 1.d0
@ -39,7 +39,7 @@ subroutine super_CI
save_char = ' '
endif
E_min = min(E,E_min)
write(output_hartree_fock,'(I4,X,F16.10, X, F16.10, X, A8 )') &
write(6,'(I4,X,F16.10, X, F16.10, X, A8 )') &
k, E, delta_E, save_char
if ( (delta_E < 0.d0).and.(dabs(delta_E) < thresh_scf) ) then
exit
@ -55,8 +55,8 @@ subroutine super_CI
TOUCH mo_coef
enddo
write(output_hartree_fock,'(A4,X,A16, X, A16, X, A16 )') &
write(6,'(A4,X,A16, X, A16, X, A16 )') &
'====','================','================','================'
call write_time(output_hartree_fock)
call write_time(6)
end

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

@ -8,7 +8,7 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
END_DOC
integer :: i
double precision :: norm
call write_time(output_determinants)
call write_time(6)
norm = 0.d0
N_det_generators = N_det
do i=1,N_det
@ -19,7 +19,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) ]

18
plugins/Hartree_Fock/Roothaan_Hall_SCF.irp.f
View File

@ -20,13 +20,13 @@ END_DOC
error_matrix_DIIS(ao_num,ao_num,max_dim_DIIS) &
)
call write_time(output_hartree_fock)
call write_time(6)
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
write(6,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
'====','================','================','================'
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
write(6,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
' N ', 'Energy ', 'Energy diff ', 'DIIS error '
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
write(6,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
'====','================','================','================'
! Initialize energies and density matrices
@ -115,7 +115,7 @@ END_DOC
! Print results at the end of each iteration
write(output_hartree_fock,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') &
write(6,'(I4, 1X, F16.10, 1X, F16.10, 1X, F16.10, 1X, I3)') &
iteration_SCF, energy_SCF, Delta_energy_SCF, max_error_DIIS, dim_DIIS
if (Delta_energy_SCF < 0.d0) then
@ -128,18 +128,18 @@ END_DOC
! End of Main SCF loop
!
write(output_hartree_fock,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
write(6,'(A4, 1X, A16, 1X, A16, 1X, A16)') &
'====','================','================','================'
write(output_hartree_fock,*)
write(6,*)
if(.not.no_oa_or_av_opt)then
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1,.true.)
endif
call write_double(output_hartree_fock, Energy_SCF, 'Hartree-Fock energy')
call write_double(6, Energy_SCF, 'Hartree-Fock energy')
call ezfio_set_hartree_fock_energy(Energy_SCF)
call write_time(output_hartree_fock)
call write_time(6)
end

18
plugins/Hartree_Fock/damping_SCF.irp.f
View File

@ -28,13 +28,13 @@ subroutine damping_SCF
enddo
call write_time(output_hartree_fock)
call write_time(6)
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
write(6,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
'====','================','================','================', '===='
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
write(6,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
' N ', 'Energy ', 'Energy diff ', 'Density diff ', 'Save'
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
write(6,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') &
'====','================','================','================', '===='
E = HF_energy + 1.d0
@ -58,7 +58,7 @@ subroutine damping_SCF
save_char = ' '
endif
write(output_hartree_fock,'(I4,1X,F16.10, 1X, F16.10, 1X, F16.10, 3X, A )') &
write(6,'(I4,1X,F16.10, 1X, F16.10, 1X, F16.10, 3X, A )') &
k, E, delta_E, delta_D, save_char
D_alpha = HF_density_matrix_ao_alpha
@ -115,17 +115,17 @@ subroutine damping_SCF
TOUCH mo_coef
enddo
write(output_hartree_fock,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
write(output_hartree_fock,*)
write(6,'(A4,1X,A16, 1X, A16, 1X, A16, 1X, A4 )') '====','================','================','================', '===='
write(6,*)
if(.not.no_oa_or_av_opt)then
call mo_as_eigvectors_of_mo_matrix(Fock_matrix_mo,size(Fock_matrix_mo,1),size(Fock_matrix_mo,2),mo_label,1,.true.)
endif
call write_double(output_hartree_fock, E_min, 'Hartree-Fock energy')
call write_double(6, E_min, 'Hartree-Fock energy')
call ezfio_set_hartree_fock_energy(E_min)
call write_time(output_hartree_fock)
call write_time(6)
deallocate(D_alpha,D_beta,F_new,D_new_alpha,D_new_beta,delta_alpha,delta_beta)
end

6
plugins/MRPT_Utils/mrpt_utils.irp.f
View File

@ -354,12 +354,12 @@ BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states) ]
integer :: j
character*(8) :: st
call write_time(output_determinants)
call write_time(6)
do j=1,N_states
CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion
write(st,'(I4)') j
call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st))
call write_double(output_determinants,CI_dressed_pt2_new_eigenvectors_s2(j),'S^2 of state '//trim(st))
call write_double(6,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st))
call write_double(6,CI_dressed_pt2_new_eigenvectors_s2(j),'S^2 of state '//trim(st))
enddo
END_PROVIDER

2
plugins/Perturbation/selection.irp.f
View File

@ -125,7 +125,7 @@ subroutine remove_small_contributions
if (N_removed > 0) then
N_det = N_det - N_removed
SOFT_TOUCH N_det psi_det psi_coef
call write_int(output_determinants,N_removed, 'Removed determinants')
call write_int(6,N_removed, 'Removed determinants')
endif
end

1
plugins/Selectors_Utils/zmq.irp.f
View File

@ -45,6 +45,7 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
integer :: rc
character*(256) :: msg
PROVIDE zmq_state
zmq_get_$X = 0
if (mpi_master) then

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

@ -8,7 +8,7 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
END_DOC
integer :: i
double precision :: norm, norm_max
call write_time(output_determinants)
call write_time(6)
N_det_selectors = N_det
if (threshold_generators < 1.d0) then
norm = 0.d0
@ -21,7 +21,7 @@ BEGIN_PROVIDER [ integer, N_det_selectors]
enddo
N_det_selectors = max(N_det_selectors,N_det_generators)
endif
call write_int(output_determinants,N_det_selectors,'Number of selectors')
call write_int(6,N_det_selectors,'Number of selectors')
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_selectors, (N_int,2,psi_selectors_size) ]

3
scripts/ezfio_interface/ei_handler.py
View File

@ -329,7 +329,8 @@ def create_ezfio_provider(dict_ezfio_cfg):
ez_p.set_doc(dict_info['doc'])
ez_p.set_ezfio_dir(dict_info['ezfio_dir'])
ez_p.set_ezfio_name(dict_info['ezfio_name'])
ez_p.set_output("output_%s" % dict_info['module'].lower)
ez_p.set_output("6")
# ez_p.set_output("output_%s" % dict_info['module'].lower)
# (nuclei.nucl_num,pseudo.klocmax) => (nucl_num,klocmax)
ez_p.set_size(re.sub(r'\w+\.', "", dict_info['size']))

10
scripts/generate_h_apply.py
View File

@ -142,7 +142,7 @@ class H_apply(object):
endif
SOFT_TOUCH psi_det psi_coef N_det
"""
s["printout_now"] = """write(output_determinants,*) &
s["printout_now"] = """write(6,*) &
100.*float(i_generator)/float(N_det_generators), '% in ', wall_1-wall_0, 's'"""
self.data = s
@ -370,9 +370,9 @@ class H_apply(object):
delta_pt2(k) = 0.d0
pt2_old(k) = 0.d0
enddo
write(output_determinants,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
write(6,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
'N_generators', 'Norm', 'Delta PT2', 'PT2', 'Est. PT2', 'secs'
write(output_determinants,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
write(6,'(A12, 1X, A8, 3(2X, A9), 2X, A8, 2X, A8, 2X, A8)') &
'============', '========', '=========', '=========', '=========', &
'========='
"""
@ -385,7 +385,7 @@ class H_apply(object):
"""
self.data["printout_now"] = """
do k=1,N_st
write(output_determinants,'(I10, 4(2X, F9.6), 2X, F8.1)') &
write(6,'(I10, 4(2X, F9.6), 2X, F8.1)') &
i_generator, norm_psi(k), delta_pt2(k), pt2(k), &
pt2(k)/(norm_psi(k)*norm_psi(k)), &
wall_1-wall_0
@ -416,7 +416,7 @@ class H_apply(object):
SOFT_TOUCH psi_det psi_coef N_det
selection_criterion_min = min(selection_criterion_min, maxval(select_max))*0.1d0
selection_criterion = selection_criterion_min
call write_double(output_determinants,selection_criterion,'Selection criterion')
call write_double(6,selection_criterion,'Selection criterion')
"""
self.data["keys_work"] = """
e_2_pert_buffer = 0.d0

2
src/Bitmask/bitmasks.irp.f
View File

@ -100,7 +100,7 @@ BEGIN_PROVIDER [ integer, N_generators_bitmask ]
! Number of bitmasks for generators
END_DOC
logical :: exists
PROVIDE ezfio_filename
PROVIDE ezfio_filename N_int
if (mpi_master) then
call ezfio_has_bitmasks_N_mask_gen(exists)

10
src/Davidson/diagonalize_CI.irp.f
View File

@ -7,14 +7,14 @@ BEGIN_PROVIDER [ double precision, CI_energy, (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_diag)
CI_energy(j) = CI_electronic_energy(j) + nuclear_repulsion
enddo
do j=1,min(N_det,N_states)
write(st,'(I4)') j
call write_double(output_determinants,CI_energy(j),'Energy of state '//trim(st))
call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
call write_double(6,CI_energy(j),'Energy of state '//trim(st))
call write_double(6,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
enddo
END_PROVIDER
@ -58,14 +58,14 @@ END_PROVIDER
! call davidson_diag(psi_det,CI_eigenvectors,CI_electronic_energy, &
! size(CI_eigenvectors,1), &
! N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,output_determinants)
! N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,6)
!
! call u_0_S2_u_0(CI_eigenvectors_s2,CI_eigenvectors,N_det,psi_det,N_int,&
! min(N_det,N_states_diag),size(CI_eigenvectors,1))
call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_eigenvectors_s2, &
size(CI_eigenvectors,1),CI_electronic_energy, &
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,output_determinants)
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,6)
else if (diag_algorithm == "Lapack") then

2
src/Determinants/H_apply.irp.f
View File

@ -265,7 +265,7 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
endif
enddo
N_det = k
call write_bool(output_determinants,found_duplicates,'Found duplicate determinants')
call write_bool(6,found_duplicates,'Found duplicate determinants')
SOFT_TOUCH N_det psi_det psi_coef
endif
deallocate (duplicate,bit_tmp)

10
src/Determinants/determinants.irp.f
View File

@ -43,7 +43,7 @@ BEGIN_PROVIDER [ integer, N_det ]
else
N_det = 1
endif
call write_int(output_determinants,N_det,'Number of determinants')
call write_int(6,N_det,'Number of determinants')
endif
IRP_IF MPI
include 'mpif.h'
@ -77,7 +77,7 @@ BEGIN_PROVIDER [ integer, psi_det_size ]
BEGIN_DOC
! Size of the psi_det/psi_coef arrays
END_DOC
PROVIDE ezfio_filename output_determinants
PROVIDE ezfio_filename
logical :: exists
if (mpi_master) then
call ezfio_has_determinants_n_det(exists)
@ -87,7 +87,7 @@ BEGIN_PROVIDER [ integer, psi_det_size ]
psi_det_size = 1
endif
psi_det_size = max(psi_det_size,100000)
call write_int(output_determinants,psi_det_size,'Dimension of the psi arrays')
call write_int(6,psi_det_size,'Dimension of the psi arrays')
endif
IRP_IF MPI
include 'mpif.h'
@ -562,7 +562,7 @@ subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
call ezfio_set_determinants_psi_coef(psi_coef_save)
deallocate (psi_coef_save)
call write_int(output_determinants,ndet,'Saved determinants')
call write_int(6,ndet,'Saved determinants')
endif
end
@ -634,7 +634,7 @@ subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,inde
enddo
call ezfio_set_determinants_psi_coef(psi_coef_save)
call write_int(output_determinants,ndet,'Saved determinants')
call write_int(6,ndet,'Saved determinants')
deallocate (psi_coef_save)
end

2
src/Determinants/psi_cas.irp.f
View File

@ -41,7 +41,7 @@ use bitmasks
enddo
endif
enddo
call write_int(output_determinants,N_det_cas, 'Number of determinants in the CAS')
call write_int(6,N_det_cas, 'Number of determinants in the CAS')
END_PROVIDER

3
src/Determinants/zmq.irp.f
View File

@ -87,6 +87,7 @@ integer function zmq_get_$X(zmq_to_qp_run_socket, worker_id)
integer :: rc
character*(256) :: msg
PROVIDE zmq_state
zmq_get_$X = 0
if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, '$X'
@ -272,6 +273,7 @@ integer function zmq_get_psi_det(zmq_to_qp_run_socket, worker_id)
integer*8 :: rc8
character*(256) :: msg
PROVIDE zmq_state
zmq_get_psi_det = 0
if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_det'
@ -319,6 +321,7 @@ integer function zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id)
integer*8 :: rc8
character*(256) :: msg
PROVIDE zmq_state psi_det_size
zmq_get_psi_coef = 0
if (mpi_master) then
write(msg,'(A,1X,I8,1X,A200)') 'get_data '//trim(zmq_state), worker_id, 'psi_coef'

30
src/Ezfio_files/output.irp.f
View File

@ -8,36 +8,6 @@
call wall_time(output_wall_time_0)
END_PROVIDER
BEGIN_SHELL [ /bin/bash ]
for NAME in $(\ls -d ${QP_ROOT}/src/*/)
do
NAME=$(basename ${NAME})
cat << EOF
BEGIN_PROVIDER [ integer, output_$NAME ]
implicit none
BEGIN_DOC
! Output file for $NAME
END_DOC
PROVIDE output_wall_time_0 output_cpu_time_0 ezfio_filename
! integer :: getUnitAndOpen
! call ezfio_set_output_empty(.False.)
IRP_IF COARRAY
if (this_image() == 1) then
output_$NAME = 6 !getUnitAndOpen(trim(ezfio_filename)//'/output/'//'$NAME.rst','a')
else
output_$NAME = getUnitAndOpen('/dev/null','w')
endif
IRP_ELSE
output_$NAME = 6 !getUnitAndOpen(trim(ezfio_filename)//'/output/'//'$NAME.rst','a')
IRP_ENDIF
write(output_$NAME,'(A)') &
'--------------------------------------------------------------------------------'
END_PROVIDER
EOF
done
END_SHELL
subroutine write_time(iunit)
implicit none

72
src/MO_Basis/utils.irp.f
View File

@ -55,7 +55,7 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign,output)
double precision, allocatable :: mo_coef_new(:,:), R(:,:),eigvalues(:), A(:,:)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R
call write_time(output_mo_basis)
call write_time(6)
if (m /= mo_tot_num) then
print *, irp_here, ': Error : m/= mo_tot_num'
stop 1
@ -78,12 +78,12 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign,output)
call lapack_diag(eigvalues,R,A,n,m)
if (output) then
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') 'Eigenvalues'
write (output_mo_basis,'(A)') '-----------'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') '======== ================'
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
write (6,'(A)') ''
write (6,'(A)') 'Eigenvalues'
write (6,'(A)') '-----------'
write (6,'(A)') ''
write (6,'(A)') '======== ================'
endif
if (sign == -1) then
do i=1,m
@ -92,15 +92,15 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign,output)
endif
if (output) then
do i=1,m
write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i)
write (6,'(I8,1X,F16.10)') i,eigvalues(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''
write (6,'(A)') '======== ================'
write (6,'(A)') ''
endif
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
deallocate(A,mo_coef_new,R,eigvalues)
call write_time(output_mo_basis)
call write_time(6)
mo_label = label
end
@ -115,7 +115,7 @@ subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label)
double precision, allocatable :: mo_coef_new(:,:), U(:,:),D(:), A(:,:), Vt(:,:), work(:)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
call write_time(output_mo_basis)
call write_time(6)
if (m /= mo_tot_num) then
print *, irp_here, ': Error : m/= mo_tot_num'
stop 1
@ -132,22 +132,22 @@ subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label)
call svd(A,lda,U,lda,D,Vt,lda,m,n)
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') 'Eigenvalues'
write (output_mo_basis,'(A)') '-----------'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') '======== ================'
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
write (6,'(A)') ''
write (6,'(A)') 'Eigenvalues'
write (6,'(A)') '-----------'
write (6,'(A)') ''
write (6,'(A)') '======== ================'
do i=1,m
write (output_mo_basis,'(I8,1X,F16.10)') i,D(i)
write (6,'(I8,1X,F16.10)') i,D(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''
write (6,'(A)') '======== ================'
write (6,'(A)') ''
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef,size(mo_coef,1))
deallocate(A,mo_coef_new,U,Vt,D)
call write_time(output_mo_basis)
call write_time(6)
mo_label = label
end
@ -162,7 +162,7 @@ subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n,
integer,allocatable :: iorder(:)
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R
call write_time(output_mo_basis)
call write_time(6)
if (m /= mo_tot_num) then
print *, irp_here, ': Error : m/= mo_tot_num'
stop 1
@ -213,21 +213,21 @@ subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n,
print*,''
enddo
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') 'Eigenvalues'
write (output_mo_basis,'(A)') '-----------'
write (output_mo_basis,'(A)') ''
write (output_mo_basis,'(A)') '======== ================'
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
write (6,'(A)') ''
write (6,'(A)') 'Eigenvalues'
write (6,'(A)') '-----------'
write (6,'(A)') ''
write (6,'(A)') '======== ================'
do i = 1, m
write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i)
write (6,'(I8,1X,F16.10)') i,eigvalues(i)
enddo
write (output_mo_basis,'(A)') '======== ================'
write (output_mo_basis,'(A)') ''
write (6,'(A)') '======== ================'
write (6,'(A)') ''
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
deallocate(mo_coef_new,R,eigvalues)
call write_time(output_mo_basis)
call write_time(6)
mo_label = label
SOFT_TOUCH mo_coef mo_label
@ -261,12 +261,12 @@ subroutine mo_sort_by_observable(observable,label)
enddo
enddo
write (output_mo_basis,'(A)') 'MOs are now **'//trim(label)//'**'
write (output_mo_basis,'(A)') ''
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
write (6,'(A)') ''
deallocate(mo_coef_new,value)
! call write_time(output_mo_basis)
! call write_time(6)
mo_label = label
SOFT_TOUCH mo_coef mo_label

86
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 = 0.d0
nucl_coord_input = 0.d0
allocate (buffer(nucl_num,3))
buffer = 0.d0
logical :: has
@ -31,26 +31,94 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
double precision, parameter :: a0= 0.529177249d0
<<<<<<< HEAD
call write_time(output_Nuclei)
write(output_Nuclei,'(A)') ''
write(output_Nuclei,'(A)') 'Nuclear Coordinates (Angstroms)'
write(output_Nuclei,'(A)') '==============================='
write(output_Nuclei,'(A)') ''
write(output_Nuclei,ft) &
=======
call write_time(6)
write(6,'(A)') ''
write(6,'(A)') 'Input Nuclear Coordinates (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_input(i,1)*a0, &
nucl_coord_input(i,2)*a0, &
nucl_coord_input(i,3)*a0
enddo
write(6,ft) &
'================','============','============','============','============'
write(6,'(A)') ''
endif
IRP_IF MPI
include 'mpif.h'
integer :: ierr
call MPI_BCAST( nucl_coord_input, 3*nucl_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
if (ierr /= MPI_SUCCESS) then
stop 'Unable to read nucl_coord_input with MPI'
endif
IRP_ENDIF
END_PROVIDER
BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num,3) ]
implicit none
BEGIN_DOC
! Nuclear coordinates in standard orientation
END_DOC
if (mpi_master) then
integer :: i
do i=1,nucl_num
nucl_coord(i,1) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,1) + &
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,1) + &
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,1)
nucl_coord(i,2) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,2) + &
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,2) + &
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,2)
nucl_coord(i,3) = (nucl_coord_input(i,1) - center_of_mass(1))*inertia_tensor_eigenvectors(1,3) + &
(nucl_coord_input(i,2) - center_of_mass(2))*inertia_tensor_eigenvectors(2,3) + &
(nucl_coord_input(i,3) - center_of_mass(3))*inertia_tensor_eigenvectors(3,3)
enddo
character*(64), parameter :: f = '(A16, 4(1X,F12.6))'
character*(64), parameter :: ft= '(A16, 4(1X,A12 ))'
double precision, parameter :: a0= 0.529177249d0
call write_time(6)
write(6,'(A)') ''
write(6,'(A)') 'Nuclear Coordinates (Angstroms)'
write(6,'(A)') '==============================='
write(6,'(A)') ''
write(6,ft) &
>>>>>>> 9bc0215d... Removed output variables
'================','============','============','============','============'
write(6,*) &
' Atom Charge X Y Z '
write(6,ft) &
'================','============','============','============','============'
do i=1,nucl_num
write(6,f) nucl_label(i), nucl_charge(i), &
nucl_coord(i,1)*a0, &
nucl_coord(i,2)*a0, &
nucl_coord(i,3)*a0
enddo
write(output_Nuclei,ft) &
write(6,ft) &
'================','============','============','============','============'
write(output_Nuclei,'(A)') ''
write(6,'(A)') ''
endif
@ -189,9 +257,15 @@ BEGIN_PROVIDER [ double precision, nuclear_repulsion ]
enddo
nuclear_repulsion *= 0.5d0
end if
<<<<<<< HEAD
call write_time(output_Nuclei)
call write_double(output_Nuclei,nuclear_repulsion, &
=======
call write_time(6)
call write_double(6,nuclear_repulsion, &
>>>>>>> 9bc0215d... Removed output variables
'Nuclear repulsion energy')
if (disk_access_nuclear_repulsion.EQ.'Write') then

1
src/ZMQ/put_get.irp.f
View File

@ -51,6 +51,7 @@ integer function zmq_get_dvector(zmq_to_qp_run_socket, worker_id, name, x, size_
integer*8 :: rc8
character*(256) :: msg
PROVIDE zmq_state
! Success
zmq_get_dvector = 0