2024-07-25 10:27:17 +02:00

110 lines
4.7 KiB
Fortran
Executable File

************************************************************************
* A program to assist *
* Quantum mechanical subsystem modifcation *
* (qmmod) *
* *
* FEATURES *
* *
* - Active MO determination for projection-based embedding *
* (RHF, UHF, virtual subspace partitioning) *
* - Active MO determination for multi-level local correlation *
* - Bond order determination for ONIOM borders *
* - MO selection, truncation, and projector consruction for *
* Huzinaga equation-based QM/MM technique *
* *
* Author: Bence Hégely *
* Budapest University of Technology and Economics *
* Mail: bence.hegely@vbk.bme.hu *
************************************************************************
! To do list: - *
! last update: 2023.05.08 *
************************************************************************
program qmmod
use qmmod_handler
call mrccini
call qmmod_handler_init
if ( do_multilevel_localcorrelation ) then
write(iout,*)
write(iout,'(a)')
$' Selecting orbitals for multilevel local correlation
$calculation...'
write(iout,*)
call orbitals_for_multilevel_localcorr
else if( do_projection_based_embedding ) then
write(iout,*)
write(iout,'(a)')
$' Construction of frozen localized MOs for DFT embedding...'
write(iout,*)
call projection_based_embed
else if ( do_oniom_assist ) then
write(iout,*)
write(iout,'(a)')
$' Determination of bonding order for ONIOM calculation...'
write(iout,*)
call oniom_border_assist
else if( do_frozen_MO_extraction_for_QMMM ) then
write(iout,*)
write(iout,'(a)')
$' Construction of frozen localized MOs for QM/MM calculation...'
write(iout,*)
call selector_for_frozen_MO_QMMM
else if( do_projector_build_for_QMMM ) then
write(iout,*)
write(iout,'(a)')
$' Construction of projector for frozen MO QM/MM calculation...'
write(iout,*)
call projector_for_frozen_MO_QMMM
else
write(iout,'(a)')
$" The purpose of 'qmmod' is undetermined. Exiting."
call mrccend(1)
endif
call qmmod_handler_clear()
write(iout,*)
call timer
call mrccend(0)
end program qmmod
C
************************************************************************
subroutine oniom_border_assist
************************************************************************
* Assign maximum two atoms to MOs to assist the border determination
************************************************************************
use error_handler
use qmmod_handler
implicit none
type( c_ptr ) :: c_bp_aux
integer, allocatable , target :: bp_aux(:)
type( BP_algorithm ), pointer :: bp => null()
integer :: imo, iatom
integer :: memstat
memstat = smem % a_top()
!
call smem % push( bp_type_size )
bp_aux = smem % top_i()
c_bp_aux = c_loc( bp_aux )
call c_f_pointer( c_bp_aux , bp )
call bp % get_resources()
call bp % init_data()
bp % bpcompo = 0.95d0
bp % max_natmo = 2
bp % return_mocomp = .true.
call bp % execute()
open(scrfile1,file='BONDTABLE',status='replace',
$ form='FORMATTED',action='WRITE',iostat=istat)
if(istat.eq.0) write(scrfile1,'(a)',iostat=istat)
$' MO Natoms Completeness Atoms'
do imo = 1 , nal
if(istat.eq.0)
$ write(scrfile1,"(2i5,4x,f9.6,4x,1000i5)",iostat=istat)
$imo , bp%natmo(imo) , bp%mocomp(imo),
$( bp%atmo(iatom,imo) , iatom = 1 , bp%natmo(imo) )
enddo
close(scrfile1)
if(istat.ne.0) call io_error
$('Error during the bond table creation.',
$'oniom_border_assist @ qmmod.f')
call smem % erase_from( memstat )
end subroutine oniom_border_assist