LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-02 11:25:26 +02:00
Code Issues Releases Wiki Activity

Documentation

Browse Source
This commit is contained in:
Anthony Scemama 2018-12-18 17:13:54 +01:00
parent cea7813857
commit 536ac314b1
5 changed files with 136 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
TODO
View File

@ -45,3 +45,4 @@
* Doc des executables
* Il faut que le programme ait le meme nom que la subroutine
* EZFIO sans fork

3
src/tools/fcidump.irp.f
View File

@ -1,5 +1,8 @@
program fcidump
implicit none
BEGIN_DOC
! Produce a FCIDUMP file
END_DOC
character*(128) :: output
integer :: i_unit_output,getUnitAndOpen
output=trim(ezfio_filename)//'.FCIDUMP'

241
src/tools/molden.irp.f
View File

@ -1,139 +1,142 @@
program print_mos
implicit none
character*(128) :: output
integer :: i_unit_output,getUnitAndOpen
provide ezfio_filename
integer :: i
print*,trim(ezfio_filename)
output=trim(ezfio_filename)//'.mol'
print*,'output = ',trim(output)
i_unit_output = getUnitAndOpen(output,'w')
print*,'i_unit_output = ',i_unit_output
call write_intro_gamess(i_unit_output)
call write_geometry(i_unit_output)
call write_Ao_basis(i_unit_output)
call write_Mo_basis(i_unit_output)
write(i_unit_output,*)''
write(i_unit_output,*)''
write(i_unit_output,*)' ------------------------'
close(i_unit_output)
implicit none
BEGIN_DOC
! Produce a Molden file
END_DOC
character*(128) :: output
integer :: i_unit_output,getUnitAndOpen
provide ezfio_filename
integer :: i
print*,trim(ezfio_filename)
output=trim(ezfio_filename)//'.mol'
print*,'output = ',trim(output)
i_unit_output = getUnitAndOpen(output,'w')
print*,'i_unit_output = ',i_unit_output
call write_intro_gamess(i_unit_output)
call write_geometry(i_unit_output)
call write_Ao_basis(i_unit_output)
call write_Mo_basis(i_unit_output)
write(i_unit_output,*)''
write(i_unit_output,*)''
write(i_unit_output,*)' ------------------------'
close(i_unit_output)
end
subroutine write_intro_gamess(i_unit_output)
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l
write(i_unit_output,*)' * GAMESS VERSION = 22 FEB 2006 (R5) *'
write(i_unit_output,*)' * FROM IOWA STATE UNIVERSITY *'
write(i_unit_output,*)' * M.W.SCHMIDT, K.K.BALDRIDGE, J.A.BOATZ, S.T.ELBERT, *'
write(i_unit_output,*)' * M.S.GORDON, J.H.JENSEN, S.KOSEKI, N.MATSUNAGA, *'
write(i_unit_output,*)' * K.A.NGUYEN, S.J.SU, T.L.WINDUS, *'
write(i_unit_output,*)' * TOGETHER WITH M.DUPUIS, J.A.MONTGOMERY *'
write(i_unit_output,*)' * J.COMPUT.CHEM. 14, 1347-1363(1993) *'
write(i_unit_output,*)''
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l
write(i_unit_output,*)' * GAMESS VERSION = 22 FEB 2006 (R5) *'
write(i_unit_output,*)' * FROM IOWA STATE UNIVERSITY *'
write(i_unit_output,*)' * M.W.SCHMIDT, K.K.BALDRIDGE, J.A.BOATZ, S.T.ELBERT, *'
write(i_unit_output,*)' * M.S.GORDON, J.H.JENSEN, S.KOSEKI, N.MATSUNAGA, *'
write(i_unit_output,*)' * K.A.NGUYEN, S.J.SU, T.L.WINDUS, *'
write(i_unit_output,*)' * TOGETHER WITH M.DUPUIS, J.A.MONTGOMERY *'
write(i_unit_output,*)' * J.COMPUT.CHEM. 14, 1347-1363(1993) *'
write(i_unit_output,*)''
end
subroutine write_geometry(i_unit_output)
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write(i_unit_output,*)'ATOM ATOMIC COORDINATES (BOHR) '
write(i_unit_output,*)' CHARGE X Y Z'
do i = 1, nucl_num
! write(i_unit_output,'(A2 I3 X F3.1 X 3(F16.10))') trim(element_name(int(nucl_charge(i)))),i,(nucl_charge(i)), nucl_coord(i,1), nucl_coord(i,2), nucl_coord(i,3)
write(i_unit_output,'(A2,I1, 9X F5.1 X 3(F16.10 ,4X))') trim(element_name(int(nucl_charge(i)))),i,(nucl_charge(i)), nucl_coord(i,1), nucl_coord(i,2), nucl_coord(i,3)
enddo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write(i_unit_output,*)'ATOM ATOMIC COORDINATES (BOHR) '
write(i_unit_output,*)' CHARGE X Y Z'
do i = 1, nucl_num
! write(i_unit_output,'(A2 I3 X F3.1 X 3(F16.10))') trim(element_name(int(nucl_charge(i)))),i,(nucl_charge(i)), nucl_coord(i,1), nucl_coord(i,2), nucl_coord(i,3)
write(i_unit_output,'(A2,I1, 9X F5.1 X 3(F16.10 ,4X))') trim(element_name(int(nucl_charge(i)))),i,(nucl_charge(i)), nucl_coord(i,1), nucl_coord(i,2), nucl_coord(i,3)
enddo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end
subroutine write_Ao_basis(i_unit_output)
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
character*(128) :: character_shell
integer :: i_shell,i_prim,i_ao
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write(i_unit_output,*)''
write(i_unit_output,*)''
write(i_unit_output,*)' ATOMIC BASIS SET'
write(i_unit_output,*)' ----------------'
write(i_unit_output,*)'THE CONTRACTED PRIMITIVE FUNCTIONS HAVE BEEN UNNORMALIZED'
write(i_unit_output,*)'THE CONTRACTED BASIS FUNCTIONS ARE NOW NORMALIZED TO UNITY'
write(i_unit_output,*)''
write(i_unit_output,*)'SHELL TYPE PRIMITIVE EXPONENT CONTRACTION COEFFICIENT(S)'
write(i_unit_output,*)''
write(i_unit_output,*)''
i_shell = 0
i_prim = 0
do i = 1, Nucl_num
write(i_unit_output,'(A2,I1)') trim(element_name(int(nucl_charge(i)))),i
write(i_unit_output,*)' '
! write(i_unit_output,*)'Nucl_num_shell_Aos(i) = ',Nucl_num_shell_Aos(i)
do j = 1, Nucl_num_shell_Aos(i)
i_shell +=1
i_ao = Nucl_list_shell_Aos(i,j)
character_shell = trim(ao_l_char(i_ao))
! write(i_unit_output,*),j,i_shell,i_ao!trim(character_shell)
do k = 1, ao_prim_num(i_ao)
i_prim +=1
if(i_prim.lt.100)then
write(i_unit_output,'(4X,I3,3X,A1,6X,I2,6X,F16.7,2X,F16.12)')i_shell,character_shell,i_prim,ao_expo(i_ao,k),ao_coef(i_ao,k)
else
write(i_unit_output,'(4X,I3,3X,A1,5X,I3,6X,F16.7,2X,F16.12)')i_shell,character_shell,i_prim,ao_expo(i_ao,k),ao_coef(i_ao,k)
endif
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
character*(128) :: character_shell
integer :: i_shell,i_prim,i_ao
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write(i_unit_output,*)''
write(i_unit_output,*)''
write(i_unit_output,*)' ATOMIC BASIS SET'
write(i_unit_output,*)' ----------------'
write(i_unit_output,*)'THE CONTRACTED PRIMITIVE FUNCTIONS HAVE BEEN UNNORMALIZED'
write(i_unit_output,*)'THE CONTRACTED BASIS FUNCTIONS ARE NOW NORMALIZED TO UNITY'
write(i_unit_output,*)''
write(i_unit_output,*)'SHELL TYPE PRIMITIVE EXPONENT CONTRACTION COEFFICIENT(S)'
write(i_unit_output,*)''
write(i_unit_output,*)''
i_shell = 0
i_prim = 0
do i = 1, Nucl_num
write(i_unit_output,'(A2,I1)') trim(element_name(int(nucl_charge(i)))),i
write(i_unit_output,*)' '
! write(i_unit_output,*)'Nucl_num_shell_Aos(i) = ',Nucl_num_shell_Aos(i)
do j = 1, Nucl_num_shell_Aos(i)
i_shell +=1
i_ao = Nucl_list_shell_Aos(i,j)
character_shell = trim(ao_l_char(i_ao))
! write(i_unit_output,*),j,i_shell,i_ao!trim(character_shell)
do k = 1, ao_prim_num(i_ao)
i_prim +=1
if(i_prim.lt.100)then
write(i_unit_output,'(4X,I3,3X,A1,6X,I2,6X,F16.7,2X,F16.12)')i_shell,character_shell,i_prim,ao_expo(i_ao,k),ao_coef(i_ao,k)
else
write(i_unit_output,'(4X,I3,3X,A1,5X,I3,6X,F16.7,2X,F16.12)')i_shell,character_shell,i_prim,ao_expo(i_ao,k),ao_coef(i_ao,k)
endif
enddo
write(i_unit_output,*)''
enddo
write(i_unit_output,*)''
enddo
enddo
write(i_unit_output,*)''
write(i_unit_output,'(A47,2X,I3)')'TOTAL NUMBER OF BASIS SET SHELLS =', i_shell
write(i_unit_output,'(A47,2X,I3)')'NUMBER OF CARTESIAN GAUSSIAN BASIS FUNCTIONS =', ao_num
! this is for the new version of molden
write(i_unit_output,'(A12)')'PP =NONE'
write(i_unit_output,*)''
enddo
write(i_unit_output,*)''
write(i_unit_output,'(A47,2X,I3)')'TOTAL NUMBER OF BASIS SET SHELLS =', i_shell
write(i_unit_output,'(A47,2X,I3)')'NUMBER OF CARTESIAN GAUSSIAN BASIS FUNCTIONS =', ao_num
! this is for the new version of molden
write(i_unit_output,'(A12)')'PP =NONE'
write(i_unit_output,*)''
end
subroutine write_Mo_basis(i_unit_output)
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
integer :: i_5,i_mod
write(i_unit_output,*) ' ----------------------'
write(i_unit_output,*) ' MCSCF NATURAL ORBITALS'
write(i_unit_output,*) ' ----------------------'
write(i_unit_output,*) ' '
do j = 1, mo_tot_num
write(i_unit_output,'(18X,I3)')j
write(i_unit_output,*)''
write(i_unit_output,'(18X,F8.5)')-1.d0
write(i_unit_output,*)''
do i = 1, ao_num
! write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! F12.6 for larger coefficients...
write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F12.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! write(i_unit_output,'(I3, X A1, X I3, X A4 X F16.8)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i))
implicit none
integer, intent(in) :: i_unit_output
integer :: i,j,k,l, getUnitAndOpen
integer :: i_5,i_mod
write(i_unit_output,*) ' ----------------------'
write(i_unit_output,*) ' MCSCF NATURAL ORBITALS'
write(i_unit_output,*) ' ----------------------'
write(i_unit_output,*) ' '
do j = 1, mo_tot_num
write(i_unit_output,'(18X,I3)')j
write(i_unit_output,*)''
write(i_unit_output,'(18X,F8.5)')-1.d0
write(i_unit_output,*)''
do i = 1, ao_num
! write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F9.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! F12.6 for larger coefficients...
write(i_unit_output,'(2X,I3, 2X A1, I3, 2X A4 , F12.6)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i)),mo_coef(i,j)
! write(i_unit_output,'(I3, X A1, X I3, X A4 X F16.8)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),(ao_l_char_space(i))
enddo
write(i_unit_output,*)''
enddo
write(i_unit_output,*)''
enddo
end

4
src/tools/save_natorb.irp.f
View File

@ -1,4 +1,8 @@
program save_natorb
implicit none
BEGIN_DOC
! Save natural MOs into the EZFIO
END_DOC
read_wf = .True.
touch read_wf
call save_natural_mos

8
src/tools/save_ortho_mos.irp.f
View File

@ -1,4 +1,8 @@
program save_ortho_mos
call orthonormalize_mos
call save_mos
implicit none
BEGIN_DOC
! Save orthonormalized MOs in the EZFIO.
END_DOC
call orthonormalize_mos
call save_mos
end