mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 04:00:49 +01:00
637 lines
27 KiB
Fortran
637 lines
27 KiB
Fortran
************************************************************************
|
|
* Subroutines related to the 'embed' and 'corembed' keywords
|
|
* 2023-05-12 Bence Hégely
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine orbitals_for_multilevel_localcorr
|
|
************************************************************************
|
|
* 0: Prepare for the Boughton-Pulay algorithm
|
|
* 1: Select occupied MOs based on various attributes
|
|
* 2: send MO flags to bpatomlists(local.f) using COREMBED_SCR
|
|
************************************************************************
|
|
use error_handler
|
|
use qmmod_handler
|
|
implicit none
|
|
integer, allocatable, target :: bp_aux(:)
|
|
type( BP_algorithm ), pointer :: bp => null()
|
|
integer, allocatable, target :: selected_MO_list_aux(:)
|
|
integer, pointer :: selected_MO_list(:) =>null()
|
|
integer, allocatable :: corembedatoms_list(:)
|
|
! local
|
|
character(len=buffer_size) :: control_line
|
|
integer :: oMOs_inactive
|
|
integer :: memstat
|
|
memstat = smem % a_top()
|
|
!
|
|
call corembed_init
|
|
call bp % execute()
|
|
call embedorb
|
|
$( 'o' , bp , corembedatoms_list , control_line , selected_MO_list)
|
|
oMOs_inactive =sum( selected_MO_list( 1 : nal ) )
|
|
call save_selected_MOs_for_corembed
|
|
call smem % erase_from( memstat )
|
|
!
|
|
contains
|
|
!
|
|
subroutine corembed_init
|
|
call init_pointers
|
|
call read_corembed_atoms_and_control_line
|
|
$ ( corembedatoms_list , control_line )
|
|
end subroutine corembed_init
|
|
!
|
|
subroutine init_pointers
|
|
type( c_ptr ) :: c_bp_aux
|
|
call smem % push( nbas )
|
|
selected_MO_list_aux = smem % top_i()
|
|
selected_MO_list => selected_MO_list_aux
|
|
selected_MO_list(1:nbas) = 1
|
|
call smem % push( natoms )
|
|
corembedatoms_list = smem % top_i()
|
|
corembedatoms_list = 0
|
|
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()
|
|
end subroutine init_pointers
|
|
!
|
|
subroutine save_selected_MOs_for_corembed
|
|
integer :: i
|
|
open(scrfile1,file='COREMBED_SCR',form='UNFORMATTED',
|
|
$ action='WRITE',status='REPLACE',iostat=istat)
|
|
if(istat.ne.0) call io_error
|
|
$('Cannot open COREMBED_SCR file in qmmod % qmbp ','bopu.f')
|
|
write(scrfile1) oMOs_inactive
|
|
write(scrfile1) (selected_MO_list(i),i=1,nal)
|
|
close(scrfile1,iostat=istat)
|
|
if(istat.ne.0) call io_error
|
|
$('Cannot close COREMBED_SCR file in qmmod','qmmod.f')
|
|
end subroutine save_selected_MOs_for_corembed
|
|
!
|
|
end subroutine orbitals_for_multilevel_localcorr
|
|
C
|
|
************************************************************************
|
|
subroutine projection_based_embed
|
|
************************************************************************
|
|
* 0: Prepare for the Boughton-Pulay algorithm
|
|
* 1: Select MOs based on various attributes
|
|
* 2: Reorder MOs after the selection.
|
|
* MO order: occupied_frozen, occupied_active, virtual_frozen, virtual_active
|
|
* 3: Calculate subsystem matrices:
|
|
* -use the active subsystem to update the occupied density
|
|
* -use the environment subsystem to construct the projector
|
|
* 4: Update the number of core orbitals for correlation calculations
|
|
************************************************************************
|
|
use error_handler
|
|
use qmmod_handler
|
|
implicit none
|
|
integer, allocatable, target :: bp_aux(:)
|
|
type( BP_algorithm ), pointer :: bp => null()
|
|
integer, allocatable, target :: bp_beta_aux(:)
|
|
type( BP_algorithm ), pointer :: bp_beta => null()
|
|
integer, allocatable :: selected_MO_list(:)
|
|
integer, allocatable :: selected_MO_list_beta(:)
|
|
integer, allocatable :: embedatoms_list(:)
|
|
! local
|
|
character(len=1) :: job
|
|
character(len=buffer_size) :: control_line_o
|
|
character(len=buffer_size) :: control_line_v
|
|
integer :: oMOs_inactive, oMOs_inactive_beta
|
|
integer :: vMOs_inactive, vMOs_inactive_beta
|
|
integer :: embedat_ncore
|
|
logical :: lcorembed
|
|
integer :: memstat
|
|
|
|
interface
|
|
subroutine reorder_MOs_in_place
|
|
& (nfrozen,selected_MO_list,scr_nbf,c,fst_ind,lst_ind,nbf)
|
|
implicit none
|
|
integer, intent(in) :: nfrozen
|
|
integer, intent(in) :: nbf
|
|
integer, intent(in) :: fst_ind
|
|
integer, intent(in) :: lst_ind
|
|
double precision, intent(in), target :: scr_nbf(nbf)
|
|
integer, intent(inout) :: selected_MO_list(nbf)
|
|
double precision, intent(inout) :: c(nbf,nbf)
|
|
end subroutine
|
|
integer pure function get_selected_atoms_ncore
|
|
$ ( selected_atoms_list , ncorb , natoms ) result(res)
|
|
integer, intent(in) :: selected_atoms_list(:)
|
|
integer, intent(in) :: ncorb(:)
|
|
integer, intent(in) :: natoms
|
|
end function get_selected_atoms_ncore
|
|
end interface
|
|
!
|
|
memstat = smem % a_top()
|
|
!
|
|
call projection_based_embed_init
|
|
call bp % execute()
|
|
job = 'o'
|
|
call embedorb( job , bp , embedatoms_list ,
|
|
$ control_line_o , selected_MO_list)
|
|
oMOs_inactive = sum( selected_MO_list(1:nal) )
|
|
call reorder_MOs_in_place
|
|
$(oMOs_inactive,selected_MO_list,bp%work,bp%c,1,nal,nbas)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
use_beta = .true.
|
|
call bp_beta % execute()
|
|
call embedorb( job , bp_beta , embedatoms_list ,
|
|
$ control_line_o , selected_MO_list_beta)
|
|
oMOs_inactive_beta = sum( selected_MO_list_beta(1:nbe) )
|
|
if( oMOs_inactive .ne. oMOs_inactive_beta ) then
|
|
call no_implementation_error
|
|
$(" Cannot handle different number"//
|
|
$" of occupied frozen alpha and beta MOs. Sorry.")
|
|
endif
|
|
call reorder_MOs_in_place
|
|
$(oMOs_inactive_beta,selected_MO_list_beta,bp_beta%work,
|
|
$bp_beta%c,1,nbe,nbas)
|
|
endif
|
|
call save_new_cmat
|
|
if(keywd % embed.eq.'huzinaga'.or.
|
|
$ keywd % embed.eq.'sch ') then
|
|
call calc_and_save_embedded_density
|
|
call calc_and_save_huzinaga_projector
|
|
call modify_fock_file
|
|
if( route.eq.'select_occ+virt' ) call select_virtual_orbitals
|
|
else if(keywd % embed.eq.'project') then
|
|
call calc_and_save_embedded_density
|
|
call calc_and_save_manbymiller_projector
|
|
endif
|
|
call add_parameters_to_varsfile
|
|
call smem % erase_from( memstat )
|
|
|
|
contains
|
|
|
|
subroutine projection_based_embed_init
|
|
call init_pointers
|
|
embedat_ncore = 0
|
|
call read_embedded_atoms_and_control_line
|
|
$( embedatoms_list , control_line_o , control_line_v)
|
|
embedat_ncore = get_selected_atoms_ncore
|
|
$ (embedatoms_list,ncorb,natoms)
|
|
end subroutine projection_based_embed_init
|
|
!
|
|
subroutine init_pointers
|
|
type( c_ptr ) :: c_bp_aux, c_bp_beta_aux
|
|
call smem % push( nbas )
|
|
selected_MO_list = smem % top_i()
|
|
selected_MO_list = 1
|
|
call smem % push( natoms )
|
|
embedatoms_list = smem % top_i()
|
|
embedatoms_list(1:natoms) = 0
|
|
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()
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
call smem % push( nbas )
|
|
selected_MO_list_beta = smem % top_i()
|
|
selected_MO_list_beta = 1
|
|
call smem % push( bp_type_size )
|
|
bp_beta_aux = smem % top_i()
|
|
c_bp_beta_aux = c_loc( bp_beta_aux )
|
|
call c_f_pointer( c_bp_beta_aux , bp_beta )
|
|
call bp_beta % get_resources( bp )
|
|
call bp_beta % init_data( bp )
|
|
endif
|
|
end subroutine init_pointers
|
|
!
|
|
!
|
|
subroutine save_new_cmat
|
|
open(mocoeffile,file='MOCOEF',form='UNFORMATTED',
|
|
$ position='REWIND',status='OLD')
|
|
call wrtmo
|
|
$(bp%work,bp%work,bp%c,mocoeffile,0.d0,nbas,nbas)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
call wrtmo
|
|
$(bp_beta%work,bp_beta%work,bp_beta%c,mocoeffile,0.d0,nbas,nbas)
|
|
endif
|
|
close(mocoeffile)
|
|
end subroutine
|
|
!
|
|
subroutine calc_and_save_embedded_density
|
|
double precision, allocatable :: p_embedded(:)
|
|
double precision :: occup_factor
|
|
occup_factor = merge( 2.0d0 , 1.0d0 ,keywd%scftype.eq.'rhf')
|
|
call smem % push( nbas**2 )
|
|
p_embedded = smem % top_r()
|
|
p_embedded = 0.0d0
|
|
call dsyrk('u','n', nbas, nal - oMOs_inactive ,occup_factor,
|
|
$bp % c( 1, oMOs_inactive + 1 ) ,nbas,0.d0,p_embedded,nbas)
|
|
call filllo( p_embedded , nbas )
|
|
open(unit=scrfile1,file='SCFDENSITIES',action='WRITE',
|
|
$ form='UNFORMATTED',position='REWIND',status='OLD')
|
|
call woeint
|
|
$(bp%work,bp%work,p_embedded,scrfile1,0.d0,nbas)
|
|
close(scrfile1)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
p_embedded = 0.0d0
|
|
call dsyrk('u','n', nbas, nbe - oMOs_inactive_beta ,
|
|
$occup_factor, bp_beta % c( 1, oMOs_inactive_beta + 1 ) ,nbas,0.d0,
|
|
$ p_embedded,nbas)
|
|
call filllo( p_embedded , nbas )
|
|
open(unit=scrfile1,file='SCFDENSITIES',action='WRITE',
|
|
$ form='UNFORMATTED',position='APPEND',status='OLD')
|
|
call woeint
|
|
$(bp_beta%work,bp_beta%work,p_embedded,scrfile1,0.d0,nbas)
|
|
close(scrfile1)
|
|
endif
|
|
call smem % pop()
|
|
end subroutine
|
|
!
|
|
subroutine calc_and_save_huzinaga_projector
|
|
double precision, allocatable, target :: p_env(:)
|
|
double precision, allocatable, target :: rs(:)
|
|
integer :: i
|
|
call smem % push( nbas**2 )
|
|
p_env = smem % top_r()
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n',
|
|
$nbas,oMOs_inactive,1.d0,bp%c,nbas,0.d0,p_env,nbas)
|
|
call filllo(p_env,nbas)
|
|
call smem % push( nbas**2 )
|
|
rs = smem % top_r()
|
|
rs = 0.0d0
|
|
call dsymm
|
|
$('l','u',nbas,nbas,1.d0,p_env,nbas,bp%s,nbas,0.d0,rs,nbas)
|
|
open(scrfile1,file='HUZPROJ',position='REWIND',
|
|
$ form='UNFORMATTED',status='REPLACE',action='WRITE')
|
|
call wtdmx(bp%work,bp%work,rs,scrfile1,0.d0,nbas,nbas)
|
|
close(scrfile1)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n',
|
|
$nbas,oMOs_inactive_beta,1.d0,bp_beta%c,nbas,0.d0,p_env,nbas)
|
|
call filllo(p_env,nbas)
|
|
rs = 0.0d0
|
|
call dsymm
|
|
$('l','u',nbas,nbas,1.d0,p_env,nbas,bp_beta%s,nbas,0.d0,rs,nbas)
|
|
open(scrfile1,file='HUZPROJ',position='APPEND',
|
|
$ form='UNFORMATTED',status='OLD',action='WRITE')
|
|
call wtdmx
|
|
$(bp_beta%work,bp_beta%work,rs,scrfile1,0.d0,nbas,nbas)
|
|
close(scrfile1)
|
|
endif
|
|
call smem % pop()
|
|
call smem % pop()
|
|
end subroutine calc_and_save_huzinaga_projector
|
|
!
|
|
subroutine calc_and_save_manbymiller_projector
|
|
double precision, allocatable :: fock(:)
|
|
double precision, allocatable :: fock_beta(:)
|
|
double precision, allocatable :: p_env(:)
|
|
double precision, allocatable :: rs(:)
|
|
double precision :: occup_factor
|
|
double precision, parameter :: lshift = 100000.0d0
|
|
occup_factor = merge( 2.0d0 , 1.0d0 ,keywd%scftype.eq.'rhf')
|
|
! sa : D^B = C_i * C_i^T , i \in (environment subsystem)
|
|
call smem % push( nbas**2 )
|
|
p_env = smem % top_r()
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n', nbas , oMOs_inactive , occup_factor,
|
|
$bp%c , nbas , 0.d0 , p_env,nbas)
|
|
! v : RS = D^B * S
|
|
call smem % push( nbas**2 )
|
|
rs = smem % top_r()
|
|
rs = 0.0d0
|
|
call dsymm
|
|
$('l','u',nbas,nbas,1.d0,p_env,nbas,bp%s,nbas,0.d0,rs,nbas)
|
|
call smem % push( nbas**2 )
|
|
fock = smem % top_r()
|
|
fock = 0.0d0
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
call smem % push( nbas**2 )
|
|
fock_beta = smem % top_r()
|
|
fock_beta = 0.0d0
|
|
endif
|
|
open(scrfile1,file='FOCK',form='UNFORMATTED',
|
|
$ position='REWIND',status='OLD')
|
|
! sa: F (Fock)
|
|
call roeint(bp%work,bp%work,fock,scrfile1,nbas)
|
|
if( keywd % scftype .eq. 'uhf') then
|
|
call roeint
|
|
$(bp_beta%work,bp_beta%work,fock_beta,scrfile1,nbas)
|
|
endif
|
|
close(scrfile1)
|
|
! F^AB_low + \mu SRS (later added as constant term in scf.f, route em2
|
|
call dsymm
|
|
$('l','l',nbas,nbas,lshift,bp%s,nbas,rs,nbas,1.d0,fock,nbas)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n', nbas , oMOs_inactive_beta ,
|
|
$occup_factor, bp_beta%c , nbas , 0.d0 , p_env, nbas)
|
|
rs = 0.0d0
|
|
call dsymm('l','u',nbas,nbas,1.d0,
|
|
$ p_env,nbas,bp_beta%s,nbas,0.d0,rs,nbas)
|
|
call dsymm('l','l',nbas,nbas,lshift,bp_beta%s,nbas,
|
|
$ rs,nbas,1.d0,fock_beta,nbas)
|
|
endif
|
|
open(scrfile1,file='FOCK',form='UNFORMATTED',
|
|
$ position='REWIND',status='OLD')
|
|
rewind(scrfile1)
|
|
call woeint(bp%work,bp%work,fock,scrfile1,0.d0,nbas)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
call woeint
|
|
$(bp_beta%work,bp_beta%work,fock_beta,scrfile1,0.d0,nbas)
|
|
endif
|
|
write(scrfile1) embedat_ncore
|
|
close(scrfile1)
|
|
call smem % pop()
|
|
call smem % pop()
|
|
call smem % pop()
|
|
end subroutine calc_and_save_manbymiller_projector
|
|
!
|
|
subroutine modify_fock_file
|
|
open(scrfile1,file='FOCK',form='UNFORMATTED',
|
|
$ position='REWIND',status='OLD')
|
|
read(scrfile1)
|
|
if( keywd % scftype .eq. 'uhf' ) read(scrfile1)
|
|
write(scrfile1) embedat_ncore
|
|
close(scrfile1)
|
|
end subroutine modify_fock_file
|
|
!
|
|
subroutine select_virtual_orbitals
|
|
double precision, allocatable :: p_env(:)
|
|
double precision, allocatable :: rs(:)
|
|
use_beta = .false.
|
|
job = 'v'
|
|
call embedorb
|
|
$( job , bp , embedatoms_list , control_line_v , selected_MO_list)
|
|
vMOs_inactive = sum( selected_MO_list(nal+1:nbas) )
|
|
call reorder_MOs_in_place(vMOs_inactive,selected_MO_list,
|
|
$bp%work,bp%c,nal+1,nbas,nbas)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
use_beta = .true.
|
|
call embedorb( job , bp_beta , embedatoms_list ,
|
|
$ control_line_v , selected_MO_list_beta)
|
|
vMOs_inactive_beta =
|
|
$ sum( selected_MO_list_beta( nbe + 1 : nbas ) )
|
|
call reorder_MOs_in_place(vMOs_inactive_beta,
|
|
$selected_MO_list_beta,bp_beta%work,bp_beta%c,nbe+1,nbas,nbas)
|
|
endif
|
|
call save_new_cmat
|
|
! construct the projector
|
|
call smem % push( nbas**2 )
|
|
p_env = smem % top_r()
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n',nbas,vMOs_inactive,1.d0,
|
|
$bp%c(1,nal+1),nbas,0.d0,p_env,nbas)
|
|
call filllo(p_env,nbas)
|
|
call smem % push( nbas**2 )
|
|
rs = smem % top_r()
|
|
rs = 0.0d0
|
|
call dsymm
|
|
$('l','u',nbas,nbas,1.d0,p_env,nbas,bp%s,nbas,0.d0,rs,nbas)
|
|
open(scrfile1,file='HUZPROJ',form='UNFORMATTED',
|
|
$ position='APPEND')
|
|
call wtdmx(bp%work,bp%work,rs,scrfile1,0.d0,nbas,nbas)
|
|
close(scrfile1)
|
|
if( keywd % scftype .eq. 'uhf' ) then
|
|
p_env = 0.0d0
|
|
call dsyrk('u','n',nbas,vMOs_inactive_beta,1.d0,
|
|
$bp_beta%c(1,nbe+1),nbas,0.d0,p_env,nbas)
|
|
call filllo(p_env,nbas)
|
|
rs = 0.0d0
|
|
call dsymm
|
|
$('l','u',nbas,nbas,1.d0,p_env,nbas,bp_beta%s,nbas,0.d0,rs,nbas)
|
|
open(scrfile1,file='HUZPROJ',form='UNFORMATTED',
|
|
$ position='APPEND')
|
|
call wtdmx(bp_beta%work,bp_beta%work,rs,scrfile1,
|
|
$ 0.d0,nbas,nbas)
|
|
close(scrfile1)
|
|
endif
|
|
call smem % pop()
|
|
call smem % pop()
|
|
end subroutine select_virtual_orbitals
|
|
!
|
|
subroutine add_parameters_to_varsfile
|
|
integer :: huzitype
|
|
open(varsfile, file='VARS', form='UNFORMATTED',
|
|
$ position='APPEND', status='OLD')
|
|
write(varsfile) 'nfroz ',iintln,oMOs_inactive
|
|
if(job.eq.'v')
|
|
$ write(varsfile) 'nvfroz ',iintln,vMOs_inactive
|
|
if(job.eq.'v' .and. keywd % scftype .eq. 'uhf')
|
|
$ write(varsfile) 'nvfrozb ',iintln,vMOs_inactive_beta
|
|
huzitype = 1
|
|
if(job.eq.'v') huzitype = 2
|
|
write(varsfile) 'huzitype ',iintln,huzitype
|
|
close(varsfile)
|
|
end subroutine add_parameters_to_varsfile
|
|
!
|
|
end subroutine projection_based_embed
|
|
************************************************************************
|
|
subroutine reorder_MOs_in_place
|
|
$(nfrozen , selected_MO_list, scr_nbf, c , fst_ind , lst_ind , nbf)
|
|
************************************************************************
|
|
* Reorder the MO coefficient matrix: frozen MOs come first
|
|
************************************************************************
|
|
implicit none
|
|
! intent(in)
|
|
integer, intent(in) :: nfrozen
|
|
integer, intent(in) :: nbf
|
|
integer, intent(in) :: fst_ind
|
|
integer, intent(in) :: lst_ind
|
|
double precision, intent(in), target :: scr_nbf(nbf)
|
|
! intent(inout)
|
|
integer, intent(inout) :: selected_MO_list(nbf)
|
|
double precision, intent(inout) :: c(nbf,nbf)
|
|
! local
|
|
double precision, pointer :: work(:) =>null()
|
|
integer :: imo,jmo
|
|
integer :: frozen
|
|
integer :: active
|
|
work => scr_nbf
|
|
frozen = 0
|
|
active = 0
|
|
imo = fst_ind
|
|
do while( imo .le. lst_ind .and. frozen .ne. nfrozen )
|
|
if( selected_MO_list( imo ) .eq. 0 ) then
|
|
jmo = nfrozen + active + fst_ind
|
|
do while( jmo.le.lst_ind .and. selected_MO_list( jmo ).eq.0)
|
|
jmo = jmo + 1
|
|
enddo
|
|
if( jmo .le. lst_ind ) then
|
|
call dcopy(nbf,c(1,imo),1,work,1)
|
|
call dcopy(nbf,c(1,jmo),1,c(1,imo),1)
|
|
call dcopy(nbf,work,1,c(1,jmo),1)
|
|
selected_MO_list( jmo ) = 0
|
|
selected_MO_list( imo ) = 1
|
|
active = active + 1
|
|
endif
|
|
else
|
|
frozen = frozen + 1
|
|
endif
|
|
imo = imo + 1
|
|
enddo
|
|
end subroutine reorder_MOs_in_place
|
|
|
|
************************************************************************
|
|
subroutine embedorb
|
|
$( job_in , bp_in , embedatoms_list , control_line ,
|
|
$ out_selected_MO_list )
|
|
************************************************************************
|
|
* Select orbitals in embedded subsystem
|
|
************************************************************************
|
|
use qmmod_moselect
|
|
implicit none
|
|
! intent(in)
|
|
type( BP_algorithm ), intent(in) :: bp_in
|
|
integer, intent(in) :: embedatoms_list(natoms)
|
|
character(len=1), intent(in) :: job_in
|
|
character(len=buffer_size), intent(in) :: control_line
|
|
integer, intent(inout) :: out_selected_MO_list( nbas )
|
|
!
|
|
call MO_selection_init
|
|
$ ( job_in , bp_in , embedatoms_list , control_line)
|
|
call algorithm % do_setup
|
|
call algorithm % do_calc
|
|
call algorithm % do_select
|
|
call algorithm % do_print
|
|
block
|
|
integer :: imo
|
|
do imo = fst_ind , lst_ind
|
|
if( selected_MO_list( imo ) .eq. 0 )
|
|
$ out_selected_MO_list( imo ) = 0
|
|
enddo
|
|
end block
|
|
|
|
call MO_selection_clear()
|
|
|
|
end subroutine embedorb
|
|
C
|
|
subroutine read_corembed_atoms_and_control_line
|
|
$( corembedatoms_ls , control_line )
|
|
use qmmod_handler
|
|
integer, intent(inout) :: corembedatoms_ls
|
|
$ (natoms)
|
|
character(len=buffer_size), intent(inout) :: control_line
|
|
character(len=8) :: c8
|
|
character(len=buffer_size) :: read_buffer
|
|
integer :: i
|
|
!
|
|
read_buffer = ' '
|
|
control_line = ' '
|
|
open(minpfile,file='MINP',form='FORMATTED',iostat=istat,
|
|
$ position='REWIND',status='OLD',action='READ')
|
|
if(istat.ne.0) call io_error
|
|
$('Cannot open MINP file in
|
|
$read_corembed_atoms_and_control_line','qmmod.f')
|
|
call getkeym('corembed',8,c8,8)
|
|
call readlinelist
|
|
$(natoms , minpfile , corembedatoms_ls , iout , 'atoms ')
|
|
! Read the active MO specifier line
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat)
|
|
$ read_buffer
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat)
|
|
$ control_line
|
|
i = index( control_line , '!' )
|
|
if(i.ne.0) control_line(i:) = ' '
|
|
control_line = adjustl( trim( control_line ) )
|
|
call lowercase
|
|
$( control_line , controle_line, len_trim(control_line) )
|
|
if(istat.ne.0 .or. len_trim(control_line).eq.0)
|
|
$ call io_error
|
|
$('Cannot read the MO specifier under the corembed keyword.
|
|
$( read_corembed_atoms_and_control_line)','qmmod.f')
|
|
close(minpfile, iostat=istat)
|
|
if(istat.ne.0) call io_error('Cannot close MINP file in
|
|
$read_corembed_atoms_and_control_line','qmmod.f')
|
|
end subroutine read_corembed_atoms_and_control_line
|
|
!
|
|
subroutine read_embedded_atoms_and_control_line
|
|
$( embedatoms_list , control_line_o , control_line_v )
|
|
use qmmod_handler
|
|
integer , intent(inout) :: embedatoms_list
|
|
$ (natoms)
|
|
character(len=buffer_size), intent(inout) :: control_line_o
|
|
character(len=buffer_size), intent(inout) :: control_line_v
|
|
character(len=8) :: c8
|
|
character(len=32) :: dft
|
|
character(len=buffer_size) :: read_buffer
|
|
integer :: i,j
|
|
control_line_o = ' '
|
|
control_line_v = ' '
|
|
read_buffer = ' '
|
|
open(minpfile,file='MINP',form='FORMATTED',iostat=istat,
|
|
$ position='REWIND',status='OLD',action='READ')
|
|
if(istat.ne.0) call io_error
|
|
$('Cannot open MINP file in
|
|
$embedorb % MO_selection_init % read_embedded_atoms','bopu.f')
|
|
call getkeym('qmreg',5,keywd%qmreg,8)
|
|
call getkeym('embed',5,c8,8)
|
|
call readlinelist
|
|
$(natoms , minpfile , embedatoms_list , iout , 'atoms ')
|
|
! Handle user-defined DFT parameters
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat) read_buffer
|
|
dft = trim( adjustl( read_buffer ) )
|
|
if(trim(dft).eq.'user'.or.trim(dft).eq.'userd') then
|
|
read(minpfile,'(a)',iostat=istat) read_buffer
|
|
read(read_buffer,*) j
|
|
do i=1,j
|
|
read(minpfile,'(a)',iostat=istat) read_buffer
|
|
enddo
|
|
if(trim(dft).eq.'userd') then
|
|
read(minpfile,'(a)',iostat=istat) read_buffer
|
|
read(read_buffer,*) j
|
|
do i=1,j
|
|
read(minpfile,'(a)',iostat=istat) read_buffer
|
|
enddo
|
|
endif
|
|
if(istat.ne.0) then
|
|
write(iout,'(a)') ' Error during the read of the'//
|
|
$' user-defined DFT functional parameters'
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
! Read the active MO specifier line
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat)
|
|
$ control_line_o
|
|
i = index( control_line_o , '!' )
|
|
if(i.ne.0) control_line_o(i:) = ' '
|
|
control_line_o = adjustl( trim( control_line_o ) )
|
|
if(istat.eq.0) call lowercase
|
|
$( control_line_o , controle_line_o, len_trim(control_line_o) )
|
|
if( istat.ne.0.or.len_trim(control_line_o).eq.0 ) then
|
|
call io_error
|
|
$('Cannot read the occupied MO selection specifier line under
|
|
$the embed keyword. ( read_embedded_atoms_and_control_line)',
|
|
$'qmmod.f')
|
|
endif
|
|
if(route.eq.'select_occ+virt') then
|
|
read(minpfile,'(a)',iostat=istat) control_line_v
|
|
i = index( control_line_v , '!' )
|
|
if(i.ne.0) control_line_v(i:) = ' '
|
|
call lowercase
|
|
$( control_line_v , controle_line_v, len_trim(control_line_v) )
|
|
control_line_v = adjustl( trim( control_line_v ) )
|
|
if( istat.ne.0.or.len_trim(control_line_v).eq.0 ) then
|
|
call io_error
|
|
$('Cannot read the virtual MO selection specifier line under
|
|
$the embed keyword. ( read_embedded_atoms_and_control_line)',
|
|
$'qmmod.f')
|
|
endif
|
|
endif
|
|
close(minpfile, iostat=istat)
|
|
if(istat.ne.0) call io_error('Cannot close MINP file in
|
|
$read_embedded_atoms_and_control_line','qmmod.f')
|
|
end subroutine read_embedded_atoms_and_control_line
|
|
C
|
|
integer pure function get_selected_atoms_ncore
|
|
$ ( selected_atoms_list , ncorb , natoms ) result(res)
|
|
integer, intent(in) :: selected_atoms_list(:)
|
|
integer, intent(in) :: ncorb(:)
|
|
integer, intent(in) :: natoms
|
|
integer :: iatom
|
|
res = 0
|
|
do iatom = 1 , natoms
|
|
if( selected_atoms_list( iatom ) .eq. 1 )
|
|
$ res = res + ncorb( iatom )
|
|
enddo
|
|
end function get_selected_atoms_ncore
|