program molden 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,*)'' 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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 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,*)'' 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_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 end