diff --git a/TODO b/TODO index 97a6155d..1abacdcf 100644 --- a/TODO +++ b/TODO @@ -45,3 +45,4 @@ * Doc des executables * Il faut que le programme ait le meme nom que la subroutine +* EZFIO sans fork diff --git a/src/tools/fcidump.irp.f b/src/tools/fcidump.irp.f index 8d334fc5..ee035728 100644 --- a/src/tools/fcidump.irp.f +++ b/src/tools/fcidump.irp.f @@ -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' diff --git a/src/tools/molden.irp.f b/src/tools/molden.irp.f index 3903d342..0943a5a3 100644 --- a/src/tools/molden.irp.f +++ b/src/tools/molden.irp.f @@ -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 diff --git a/src/tools/save_natorb.irp.f b/src/tools/save_natorb.irp.f index 329809c1..7d508eca 100644 --- a/src/tools/save_natorb.irp.f +++ b/src/tools/save_natorb.irp.f @@ -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 diff --git a/src/tools/save_ortho_mos.irp.f b/src/tools/save_ortho_mos.irp.f index 86c08991..94cbd3c4 100644 --- a/src/tools/save_ortho_mos.irp.f +++ b/src/tools/save_ortho_mos.irp.f @@ -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