mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 04:00:49 +01:00
5786 lines
220 KiB
Fortran
Executable File
5786 lines
220 KiB
Fortran
Executable File
************************************************************************
|
|
* Routines for *
|
|
*Our Own N-layered Integrated Molecular Orbital and Molecular Mechanics*
|
|
* (ONIOM) *
|
|
* technique *
|
|
* *
|
|
* Currently, only the Integrated MO+MO (IMOMO) scheme is supported *
|
|
* (without any external programs) *
|
|
* *
|
|
* FEATURES *
|
|
* Mechanical embedding *
|
|
* -Pure *
|
|
* (MRCC,MOPAC,XTB) *
|
|
* -Continuum embedded *
|
|
* (MRCC+PCM(c,x) or MRCC+MOPAC+CPCM(c) or MRCC+xTB+GBSA/ALPB(c)) *
|
|
* -Point charge embedded *
|
|
* (MRCC+Amber or MRCC+xTB+Amber) *
|
|
* Electronic embedding *
|
|
* (Warning: the gradient is only implemented with fixed charges) *
|
|
* -Pure *
|
|
* (MRCC or MRCC+xTB) *
|
|
* -Continuum embedded *
|
|
* (MRCC+XTB+GBSA/ALPB) *
|
|
* -Point charge embedded *
|
|
* (MRCC+Amber or MRCC+xTB+Amber) *
|
|
* --- Layer handling --- *
|
|
* Layer-boundary identification (based on connection), *
|
|
* Link atom determination (based on bond order), *
|
|
* and link atom positioning (based on exp. bond distances) *
|
|
* in automatic, manual, or semi-automatic fashion. *
|
|
* *
|
|
* Refs: *
|
|
* https://doi.org/10.1021/cr5004419 (ChemRev - ONIOM review) *
|
|
* https://doi.org/10.1063/1.5142048 (JCP - MRCC review) *
|
|
* - *
|
|
* Author: Bence Hégely *
|
|
* Budapest University of Technology and Economics *
|
|
* Mail: bence.hegely@vbk.bme.hu *
|
|
************************************************************************
|
|
! To do list:
|
|
! - some differences (~20 uEh) between g09/Amber(sqm)/MOPAC energies... ? (AM1/Ethanol)
|
|
! - semi-automatic border handling: overwrite singe parameters
|
|
! - ECP handling in get_coords ?
|
|
! - implement the readers of the different input structure formats
|
|
! - assumed charges for layers based on LMOs
|
|
! Possible developements
|
|
! - electronic embedding: QM/QM gradient with generated mulliken/lowdin chages
|
|
! - electronic embedding: with Adam's new atomic charges (chelp?)
|
|
! - electronic embedding: PCM with inner point charges
|
|
! last update: 2022.10.30.
|
|
************************************************************************
|
|
subroutine oniomcore(oniom,gopt,freq,qmmm)
|
|
************************************************************************
|
|
* Core routine for ONIOM calculations
|
|
************************************************************************
|
|
use error_handler
|
|
#include "MRCCCOMMON"
|
|
integer :: channelopen
|
|
integer :: istat
|
|
integer :: nsp
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: ncent
|
|
integer :: natwdummy
|
|
integer :: oniomem
|
|
integer, dimension(:,:), allocatable :: layeratoms
|
|
integer, dimension(:), allocatable :: ind
|
|
integer, dimension(:,:,:),allocatable :: borderat
|
|
integer, dimension(:,:), allocatable :: bondord
|
|
integer, dimension(:), allocatable :: embedat
|
|
integer, dimension(:), allocatable :: corembedat
|
|
integer, dimension(:), allocatable :: atnum
|
|
integer, parameter :: okbyte=1024
|
|
integer, parameter :: tkbyte=2048
|
|
double precision, dimension(:), allocatable :: atchg
|
|
double precision, dimension(:), allocatable :: satchg
|
|
double precision, dimension(:,:), allocatable :: coord
|
|
double precision, dimension(:,:), allocatable :: scoord
|
|
double precision, dimension(:,:), allocatable :: force
|
|
double precision, dimension(:,:), allocatable :: efield
|
|
double precision, dimension(:,:,:),allocatable :: linkcoord
|
|
double precision, dimension(:,:), allocatable :: linkdist
|
|
double precision, dimension(:,:), allocatable :: eecharge
|
|
double precision, dimension(:,:), allocatable :: sbondtable
|
|
double precision, dimension(:,:), allocatable :: bondtable
|
|
character(len=4) :: geom
|
|
character(len=4) :: oniomtype
|
|
character(len=4) :: comprest
|
|
character(len=8) :: gopt
|
|
character(len=8) :: freq
|
|
character(len=8) :: oniom
|
|
character(len=8) :: qmmm
|
|
character(len=8) :: cscr8
|
|
character(len=16) :: mem
|
|
character(len=16) :: oldmem
|
|
character(len=16) :: coniomem
|
|
character(len=:), allocatable :: string
|
|
character(len=:), allocatable :: bordstring
|
|
character(len=:), allocatable :: linkstring
|
|
character(len=:), allocatable :: diststring
|
|
logical :: foundopen
|
|
logical :: lb
|
|
logical :: lembed
|
|
logical :: lcorembed
|
|
inquire(file='MINP',opened=foundopen,number=channelopen)
|
|
if(foundopen .and. channelopen .eq. minpfile) close(minpfile)
|
|
lembed=.false.
|
|
lcorembed=.false.
|
|
open(minpfile,file='MINP',status='OLD',iostat=istat)
|
|
if(istat.ne.0) call io_error
|
|
$("Cannot open MINP file","oniomcore (compmod.f)")
|
|
call getkeym('embed',5,cscr8,8)
|
|
call getkeym('geom',4,geom,4)
|
|
if(cscr8.ne.'off ') lembed=.true.
|
|
call getkeym('corembed',8,cscr8,8)
|
|
if(cscr8.ne.'off ') lcorembed=.true.
|
|
close(minpfile)
|
|
call get_natoms(minpfile,geom,natwdummy,natoms)
|
|
call get_nmmcharges(minpfile,iout,natwdummy,ncent,qmmm)
|
|
call get_layernumber_oniomtype(oniom,nlay,oniomtype)
|
|
write(iout,*)
|
|
write(iout,
|
|
$"(' An ONIOM calculation is requested with',i2,' layers.')") nlay
|
|
if (oniomtype.eq.'me') then
|
|
write(iout,"(' Mechanical embedding will be utilized.')")
|
|
elseif(oniomtype.eq.'ee') then
|
|
write(iout,"(' Electronic embedding will be utilized.')")
|
|
endif
|
|
nsp=(nlay-1)*2+1
|
|
! Cleanup existing input files
|
|
call getkey('comprest',8,comprest,4)
|
|
if(comprest.eq.'off ') then
|
|
call cleanup_oniom(nsp,scrfile1)
|
|
endif
|
|
! calculate necessary memory and redefine requested memory
|
|
write(iout,*)
|
|
write(iout,'(a)') ' Allocating memory for ONIOM calculation...'
|
|
oniomem=natoms*nlay*153+natoms+ncent*14+1+natwdummy
|
|
if(lembed) oniomem=oniomem+natoms
|
|
if(lcorembed) oniomem=oniomem+natoms
|
|
if(oniomtype.eq.'ee') oniomem=oniomem+natoms*nlay
|
|
call getkey('mem',3,oldmem,16)
|
|
call modify_mem(oldmem,mem,oniomem,coniomem,iout)
|
|
write(iout,"(' The ammount of requested memory:
|
|
$',a16)") trim(adjustl(oldmem))
|
|
write(iout,"(' Memory requirement of ONIOM specific arrays:
|
|
$',a16)") trim(adjustl(coniomem))
|
|
write(iout,"(' The remaining ammount of the requested memory:
|
|
$',a16)") trim(adjustl(mem))
|
|
write(iout,*)
|
|
istat=0
|
|
! allocate memory
|
|
allocate(layeratoms(natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("layeratoms",1)
|
|
allocate(ind(natoms+1),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("ind",1)
|
|
allocate(atchg(ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("atchg",1)
|
|
allocate(satchg(ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("satchg",1)
|
|
allocate(coord(3,ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("coord",1)
|
|
allocate(scoord(3,ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("scoord",1)
|
|
allocate(force(3,ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("force",1)
|
|
allocate(efield(3,ncent),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("efield",1)
|
|
allocate(linkcoord(3,natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("linkcoord",1)
|
|
allocate(borderat(2,natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("borderat",1)
|
|
allocate(bondord(natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("bondord",1)
|
|
allocate(linkdist(natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("linkdist",1)
|
|
allocate(bondtable(natoms,natoms),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("bondtable",1)
|
|
allocate(sbondtable(natoms,natoms),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("sbondtable",1)
|
|
allocate(atnum(natwdummy),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("atnum",1)
|
|
allocate(character(8*8*natoms) :: string,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("string",1)
|
|
allocate(character(8*4*natoms*nlay) :: bordstring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("borderstring",1)
|
|
allocate(character(8*3*natoms*nlay) :: linkstring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("linkstring",1)
|
|
allocate(character(8*3*natoms*nlay) :: diststring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("diststring",1)
|
|
if(oniomtype.eq.'ee') then
|
|
allocate(eecharge(natoms,nlay),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("eecharge",1)
|
|
endif
|
|
if(lembed) then
|
|
allocate(embedat(natoms),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("embedat",1)
|
|
endif
|
|
if(lcorembed) then
|
|
allocate(corembedat(natoms),stat=istat) !
|
|
if(istat.ne.0) call failed_memop("corembedat",1)
|
|
endif
|
|
call oniomdriver(gopt,freq,qmmm,nsp,nlay,natoms,
|
|
$layeratoms,ind,ncent,atchg,coord,
|
|
$satchg,scoord,mem,natwdummy,borderat,bondord,linkdist,
|
|
$linkcoord,string,bordstring,linkstring,diststring,force,efield,
|
|
$oniomtype,eecharge,bondtable,sbondtable,
|
|
$embedat,corembedat,okbyte,tkbyte,atnum)
|
|
deallocate(layeratoms,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("layeratoms",2)
|
|
deallocate(ind,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("ind",2)
|
|
deallocate(atchg,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("atchg",2)
|
|
deallocate(satchg,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("satchg",2)
|
|
deallocate(coord,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("coord",2)
|
|
deallocate(scoord,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("scoord",2)
|
|
deallocate(force,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("force",2)
|
|
deallocate(efield,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("efield",2)
|
|
deallocate(linkcoord,stat=istat)
|
|
if(istat.ne.0) call failed_memop("linkcoord",2)
|
|
deallocate(borderat,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("borderat",2)
|
|
deallocate(bondord,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("bondord",2)
|
|
deallocate(linkdist,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("linkdist",2)
|
|
deallocate(bondtable,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("bondtable",2)
|
|
deallocate(sbondtable,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("sbondtable",2)
|
|
deallocate(atnum,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("atnum",2)
|
|
deallocate(string,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("string",2)
|
|
deallocate(bordstring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("borderstring",2)
|
|
deallocate(linkstring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("linkstring",2)
|
|
deallocate(diststring,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("diststring",2)
|
|
if(oniomtype.eq.'ee') then
|
|
deallocate(eecharge,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("eecharge",2)
|
|
endif
|
|
if(lembed) then
|
|
deallocate(embedat,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("embedat",2)
|
|
endif
|
|
if(lcorembed) then
|
|
deallocate(corembedat,stat=istat) !
|
|
if(istat.ne.0) call failed_memop("corembedat",2)
|
|
endif
|
|
open(scrfile1,file='ONIOMROUTE',status='OLD',form='UNFORMATTED')
|
|
close(scrfile1,status='delete')
|
|
call changekey('mem',3,oldmem,16)
|
|
end subroutine oniomcore
|
|
C
|
|
************************************************************************
|
|
subroutine oniomdriver(gopt,freq,qmmm,nsp,nlay,natoms,
|
|
$layeratoms,ind,ncent,atchg,coord,satchg,
|
|
$scoord,mem,natwdummy,borderat,bondord,linkdist,linkcoord,istring,
|
|
$borderstring,linkstring,diststring,force,efield,
|
|
$oniomtype,eecharge,bondtable,sbondtable,embedat,corembedat,okbyte,
|
|
$tkbyte,atnum)
|
|
************************************************************************
|
|
* Driver routine for ONIOM calculations
|
|
************************************************************************
|
|
use error_handler
|
|
#include "MRCCCOMMON"
|
|
integer :: i,isp,ilay
|
|
integer :: natwdummy,natoms,nlay,nsp
|
|
integer :: startsp
|
|
integer :: istat
|
|
integer :: irest
|
|
integer :: ncent,level,icent
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: ind(natoms+1)
|
|
integer :: ichg(nlay)
|
|
integer :: imul(nlay)
|
|
integer :: nborders(nlay)
|
|
integer :: nkeys,nkeysnon
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
integer :: bondord(natoms,nlay)
|
|
integer :: laykey
|
|
integer :: nmrcckeys
|
|
integer :: npcmkeys
|
|
integer :: npcmdefkeys
|
|
integer :: ncharge(nlay)
|
|
integer :: qnatoms(nlay)
|
|
integer :: atnum(natwdummy)
|
|
integer :: nelec_perlay(nlay)
|
|
integer :: embedat(natoms)
|
|
integer :: corembedat(natoms)
|
|
integer :: nembedat
|
|
integer :: ncorembedat
|
|
integer :: kstringsize
|
|
integer :: pcmkstringsize
|
|
integer :: estringsize
|
|
integer :: cstringsize
|
|
integer :: okbyte,tkbyte
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: satsymbol(natwdummy)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: cisp,slinksym(natoms,nlay)
|
|
character(len=3) :: moldenval
|
|
character(len=4) :: verbosity,cdens,geom,uval,sdens
|
|
character(len=4) :: mpitasks,localcc
|
|
character(len=4) :: borderhand(nlay),oniomtype
|
|
character(len=4) :: soniomtype
|
|
character(len=4) :: oniomrest
|
|
character(len=7) :: scfiguess
|
|
character(len=8) :: gopt,qmmm,freq,subminp,oniom_pcm
|
|
character(len=8) :: oniom_eechg
|
|
character(len=8) :: etemp
|
|
character(len=8) :: embedalg,corembedalg,oniom_qcorr
|
|
character(len=16) :: mem,orbloco,orblocc,orbloce,orblocv
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: sqmprog,mmprog
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay),pcm,embedlow,corembedlow
|
|
character(len=64) :: cscr64
|
|
character(len=64) :: eorbselecto,eorbselectv,corbselecto
|
|
character(len=128) :: xtbstring
|
|
character(len=okbyte) :: embedatstring,corembedatstring
|
|
character(len=okbyte) :: pcmkeys,pcmkeystring,mrcckeys
|
|
character(len=tkbyte) :: keywstring,filterstring
|
|
character(len=natoms*8*8) :: istring
|
|
character(len=natoms*4*8) :: borderstring(nlay)
|
|
character(len=natoms*3*8) :: linkstring(nlay),diststring(nlay)
|
|
double precision :: coord(3,ncent)
|
|
double precision :: atchg(ncent)
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: force(3,ncent)
|
|
double precision :: efield(3,ncent)
|
|
double precision :: bondtable(natoms,natoms)
|
|
double precision :: sbondtable(natoms,natoms)
|
|
double precision :: scoord(3,ncent)
|
|
double precision :: satchg(ncent)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: eecharge(natoms,nlay)
|
|
double precision :: itol
|
|
double precision :: rescharge_amber
|
|
double precision :: rescharge(nlay)
|
|
double precision :: autokcal
|
|
double precision :: cput(nsp)
|
|
double precision :: walt(nsp)
|
|
double precision :: orbcpu,orbwal
|
|
double precision :: finalener
|
|
double precision :: rscr
|
|
logical :: found
|
|
logical :: usetemp
|
|
logical :: firstcall,lastcalc
|
|
logical :: lembed,lcorembed
|
|
logical :: printchg
|
|
logical :: restguess
|
|
logical :: do_mm
|
|
parameter(autokcal=627.5094740631)
|
|
! Initalize variables + call for keys + mrcc/pcm key handling
|
|
call oniomdriverinit(firstcall,usetemp,borderhand,linkdist,imet,
|
|
$ibas,borderstat,sdens,nlinks,borderstring,linkstring,diststring,
|
|
$coord,force,efield,atchg,eecharge,layeratoms,borderat,linksym,
|
|
$pcmkeystring,mrcckeys,nmrcckeys,pcmkeys,npcmkeys,nkeys,
|
|
$npcmdefkeys,nkeysnon,subminp,verbosity,cdens,geom,uval,orblocc,
|
|
$orbloco,orbloce,moldenval,mpitasks,pcm,oniom_pcm,oniom_eechg,
|
|
$ncent,natoms,natwdummy,slinksym,nlay,keywstring,filterstring,iout,
|
|
$oniomtype,sqmprog,nsp,iprog,xtbstring,mmprog,etemp,embedalg,
|
|
$corembedalg,embedat,corembedat,orblocv,localcc,okbyte,tkbyte,
|
|
$oniom_qcorr,printchg,rescharge,qnatoms,itol,oniomrest,restguess,
|
|
$atnum,nelec_perlay,cput,walt,minpfile,rescharge_amber,
|
|
$atsymbol,qmmm,embedatstring,corembedatstring,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,do_mm)
|
|
! Initalize "firstcall" in the case of gopt/freq
|
|
call get_firstcall(firstcall,moldenval,qmmm,gopt,freq,scrfile1,
|
|
$minpfile)
|
|
! Setup coordinates
|
|
call get_coords
|
|
$(qmmm,natoms,natwdummy,coord,atchg,atsymbol,uval,geom,ncent,iout)
|
|
if(firstcall) then
|
|
if(oniomrest.eq.'off ') call ishell('rm -f ONIOMSPEC')
|
|
! Setup ONIOM layer specifications
|
|
call setup_oniomspec(nlay,natwdummy,minpfile,layeratoms,
|
|
$natomslay,ind,imet,ibas,ichg,imul,iout,natwdummy,
|
|
$borderat,atsymbol,borderhand,linksym,linkdist,
|
|
$borderstat,istring,borderstring,linkstring,diststring,usetemp,
|
|
$subminp,nsp,iprog,sqmprog,mmprog,qmmm,embedalg,corembedalg,
|
|
$embedat,corembedat,nembedat,ncorembedat,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,orblocv,localcc,printchg,
|
|
$oniom_eechg,atnum,nelec_perlay,oniomtype,do_mm)
|
|
! get the specifications from the MINP file
|
|
call get_keylist(minpfile,keywstring,tkbyte,scrfile1,nkeys)
|
|
call get_nonmust_keylist(keywstring,tkbyte,nkeys,filterstring,
|
|
$tkbyte,nkeysnon)
|
|
call get_complete_keys(minpfile,keywstring,tkbyte,nkeys)
|
|
if(trim(adjustl(pcm)).ne.'off') then
|
|
call get_pcmkeylist(minpfile,pcmkeystring,okbyte,npcmdefkeys,
|
|
$pcmkeys,npcmkeys)
|
|
call get_complete_keys(minpfile,pcmkeystring,okbyte,npcmdefkeys)
|
|
if(iprog(1).eq.'MOPAC2016.exe') then
|
|
call mopac_solvent_duties
|
|
$(pcm,pcmkeystring,okbyte,npcmdefkeys)
|
|
endif
|
|
endif
|
|
! Rewrite the chosen embedded/corembedded atom IDs
|
|
! to match the order of the atoms of the last single-point calculation
|
|
if(embedalg.ne.'off') then
|
|
call rewrite_atomid
|
|
$(natomslay(nlay),layeratoms(1,nlay),nembedat,embedat,ind,iout)
|
|
call atlist_to_string
|
|
$(nembedat,embedat,okbyte,embedatstring)
|
|
endif
|
|
if(corembedalg.ne.'off') then
|
|
call rewrite_atomid
|
|
$(natomslay(nlay),layeratoms(1,nlay),ncorembedat,corembedat,ind,
|
|
$iout)
|
|
call atlist_to_string
|
|
$(ncorembedat,corembedat,okbyte,corembedatstring)
|
|
endif
|
|
else
|
|
! Setup oniom specifications for the first calculation
|
|
inquire(file='ONIOMSPEC',exist=found)
|
|
if(.not.found) then
|
|
write(iout,'(a)') ' The ONIOMSPEC file is not found.'
|
|
write(iout,'(a)') ' Exiting...'
|
|
call mrccend(1)
|
|
endif
|
|
call read_oniomspec(scrfile1,nlay,natwdummy,natoms,layeratoms,
|
|
$natomslay,imet,ibas,ichg,imul,borderat,borderhand,linksym,
|
|
$linkdist,borderstat,keywstring,tkbyte,nkeys,pcmkeystring,okbyte,
|
|
$npcmdefkeys,eecharge,nsp,iprog,oniomtype,embedalg,
|
|
$corembedalg,okbyte,embedatstring,okbyte,corembedatstring,
|
|
$embedlow,corembedlow,eorbselecto,eorbselectv,corbselecto,usetemp,
|
|
$do_mm)
|
|
endif
|
|
! ################### Main loop starts ######################
|
|
ilay=1
|
|
level=0
|
|
startsp=1
|
|
irest=0
|
|
if(oniomrest.ne.'off ') then
|
|
call do_oniom_restart
|
|
$(oniomrest,startsp,ilay,level,oniomtype,soniomtype,iout,
|
|
$cdens,sdens,nlay,nsp,npcmdefkeys,laykey,nkeys,oniom_eechg,
|
|
$oniom_pcm,subminp,iprog,pcm,okbyte,qmmm,restguess,irest)
|
|
if(irest.ne.0) then
|
|
call read_oniomspec(scrfile1,nlay,natwdummy,natoms,layeratoms,
|
|
$natomslay,imet,ibas,ichg,imul,borderat,borderhand,linksym,
|
|
$linkdist,borderstat,keywstring,tkbyte,nkeys,pcmkeystring,okbyte,
|
|
$npcmdefkeys,eecharge,nsp,iprog,oniomtype,embedalg,
|
|
$corembedalg,okbyte,embedatstring,okbyte,corembedatstring,
|
|
$embedlow,corembedlow,eorbselecto,eorbselectv,corbselecto,usetemp,
|
|
$do_mm)
|
|
call set_linkcoords(nlay,natwdummy,natoms,coord,borderat,iout,
|
|
$linkdist,nborders,borderstat,linkcoord,nlinks,linksym,slinksym,
|
|
$ncent)
|
|
endif
|
|
endif
|
|
MAIN_CALC_LOOP:
|
|
$do isp=startsp,nsp
|
|
lastcalc=.false.
|
|
lembed=.false.
|
|
lcorembed=.false.
|
|
if(isp.eq.nsp) then
|
|
lastcalc=.true.
|
|
if(embedalg.ne. 'off ') lembed=.true.
|
|
if(corembedalg.ne.'off ') lcorembed=.true.
|
|
endif
|
|
istat=0
|
|
open(scrfile1,file='ONIOMROUTE',form='UNFORMATTED',iostat=istat)
|
|
if(istat.eq.0) write(scrfile1,iostat=istat) isp,oniomtype
|
|
if(istat.ne.0) call io_error
|
|
$("Cannot open/write ONIOMROUTE","oniomdriver (compmod.f)")
|
|
close(scrfile1)
|
|
scoord=0.0d0
|
|
satchg=0.0d0
|
|
sdens=cdens
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
write(iout,*)
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
write(iout,"(' *** Starting calculation #',i2,'
|
|
$ ***')") isp
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
if(isp.eq.1) then
|
|
call ishell('cp MINP MINP.composite')
|
|
call ishell('cp KEYWD KEYWD.composite')
|
|
read(cdens,'(i2)') i
|
|
if(i.eq.0.and.oniomtype.eq.'ee'.and.oniom_eechg.ne.'user')
|
|
$ sdens='1 '
|
|
soniomtype=' '
|
|
else if(isp.eq.2) then
|
|
if(trim(adjustl(pcm)).ne.'off'.and.
|
|
$ trim(adjustl(oniom_pcm)).eq.'x') then
|
|
npcmdefkeys=npcmdefkeys+2
|
|
pcmkeystring=trim(adjustl(pcmkeystring))//
|
|
$' pcm_cavity_type=restart pcm_cavity_npzFile=cavity.npz'
|
|
soniomtype=oniomtype
|
|
else
|
|
pcm='off '
|
|
soniomtype=oniomtype
|
|
if(iprog(isp).eq.'MOPAC2016.exe') npcmdefkeys=0
|
|
endif
|
|
endif
|
|
if(subminp.eq.'top'.or.subminp.eq.'t+t') then
|
|
if(isp.ne.nsp) then
|
|
laykey=0
|
|
else
|
|
laykey=nkeys
|
|
endif
|
|
else if(subminp.eq.'temp') then
|
|
laykey=0
|
|
else if(subminp.eq.'minp'.or.subminp.eq.'m+t') then
|
|
laykey=nkeys
|
|
endif
|
|
! Fill coordinate scratch arrays
|
|
call fill_coords(natoms,natwdummy,nlay,ilay,natomslay,layeratoms,
|
|
$icent,coord,scoord,atsymbol,satsymbol,nlinks,linkcoord,slinksym,
|
|
$qmmm,ncent,atchg,satchg,soniomtype,eecharge(1,ilay),force,ncharge)
|
|
MAIN_CALC_LOOP_INPUT_SETUP:
|
|
$ if(iprog(isp).eq.'mrcc'.and.oniomrest.ne.'0 ') then
|
|
! Generate MINP file
|
|
call write_minp(minpfile,iout,qmmm,sdens,isp,
|
|
$natomslay(ilay)+nlinks(ilay),natomslay(ilay)+nlinks(ilay),
|
|
$icent,scoord,satsymbol,satchg,imet(level),ibas(level),ichg(ilay),
|
|
$imul(ilay),mem,geom,usetemp,verbosity,uval,laykey,keywstring,
|
|
$tkbyte,mpitasks,pcm,pcmkeystring,npcmdefkeys,soniomtype,force,
|
|
$ncharge(ilay),lembed,lcorembed,embedalg,corembedalg,okbyte,
|
|
$embedatstring,okbyte,corembedatstring,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,orbloce,orblocv,localcc,
|
|
$restguess)
|
|
write(iout,*)
|
|
write(cisp,'(i2)') isp
|
|
cisp=trim(adjustl(cisp))
|
|
call ishell('cp MINP.'//cisp//' MINP')
|
|
! Get calculation specific keys
|
|
if(firstcall) then
|
|
call runit('minp',cput(isp),walt(isp))
|
|
if(oniomtype.eq.'ee'.and.isp.eq.1)then
|
|
if (oniom_eechg.eq.'iao') then
|
|
call changekey('popul',5,'iao ',8)
|
|
else if(oniom_eechg.eq.'chelpg') then
|
|
call changekey('espcharge',9,'chelpg ',8)
|
|
else if(oniom_eechg.eq.'mk ') then
|
|
call changekey('espcharge',9,'mk ',8)
|
|
endif
|
|
endif
|
|
if(oniomtype.eq.'ee'.and.isp.gt.1) then
|
|
call changekey('qmmm',4,'amber ',8)
|
|
endif
|
|
else
|
|
call ishell('cp KEYWD.'//cisp//' KEYWD')
|
|
call changekey('scfiguess',9,'restart',7)
|
|
endif
|
|
call getkey('scfiguess',9,scfiguess,7)
|
|
if(scfiguess.eq.'restart') then
|
|
inquire(file='SCFDENSITIES.'//cisp,exist=found)
|
|
if(found) then
|
|
write(iout,*)
|
|
write(iout,*) ' SCFDENSITIES.'//cisp//' is found!'
|
|
call ishell('cp SCFDENSITIES.'//cisp//' SCFDENSITIES')
|
|
else
|
|
write(iout,*)
|
|
write(iout,'(a)') ' Warning!'//
|
|
$'Cannot restart calculation from SCFDENSITIES.'//cisp//
|
|
$'(the file was not found).'
|
|
write(iout,'(a)')
|
|
$' The default inital guess for the density will be used...'
|
|
call changekey('scfiguess',9,'sad',3)
|
|
endif
|
|
endif
|
|
call ishell('cp KEYWD KEYWD.'//cisp)
|
|
else if(iprog(isp).eq.'MOPAC2016.exe'.and.oniomrest.ne.'0 ')
|
|
$ then
|
|
! note: mopac and mrcc are not compatibe with molden in the same way
|
|
call write_mop(qmmm,sdens,isp,minpfile,
|
|
$natomslay(ilay)+nlinks(ilay),natomslay(ilay)+nlinks(ilay),
|
|
$icent,scoord,satsymbol,satchg,imet(level),ichg(ilay),
|
|
$imul(ilay),iout,usetemp,verbosity,uval,pcm,pcmkeystring,
|
|
$npcmdefkeys,soniomtype,force,ncharge(ilay),firstcall,moldenval)
|
|
if(isp.eq.1.and.moldenval.ne.'off') then
|
|
call sqm_moldentask(natomslay(ilay)+nlinks(ilay),scoord,
|
|
$scrfile1,satsymbol,ind,angtobohr)
|
|
endif
|
|
else if(iprog(isp).eq.'xtb'.and.oniomrest.ne.'0 ') then
|
|
call write_xtb_files(qmmm,sdens,isp,minpfile,
|
|
$natomslay(ilay)+nlinks(ilay),natomslay(ilay)+nlinks(ilay),icent,
|
|
$scoord,satsymbol,satchg,imet(level),ichg(ilay),imul(ilay),iout,
|
|
$usetemp,verbosity,uval,pcm,pcmkeystring,npcmdefkeys,
|
|
$soniomtype,force,ncharge(ilay),firstcall,moldenval,xtbstring,
|
|
$printchg,.false.,etemp)
|
|
write(cisp,'(i2)') isp
|
|
if(.not.firstcall.and.(imet(level).ne.'gfn-ff')) then
|
|
inquire(file='MINP.'//trim(adjustl(cisp))//'.xtbrestart',
|
|
$ exist=found)
|
|
if(found) then
|
|
write(iout,*)
|
|
write(iout,*) ' MINP.'//trim(adjustl(cisp))//
|
|
$'.xtbrestart is found!'
|
|
else
|
|
write(iout,*)
|
|
write(iout,'(a)') ' Warning! '//
|
|
$'Cannot restart calculation from MINP.'
|
|
$//trim(adjustl(cisp))//'.xtbrestart '//
|
|
$'(the file was not found).'
|
|
write(iout,'(a)')
|
|
$' The default inital guess for the density will be used...'
|
|
endif
|
|
endif
|
|
if(isp.eq.1.and.moldenval.ne.'off'.and.do_mm) then
|
|
call sqm_moldentask(natomslay(ilay)+nlinks(ilay),scoord,
|
|
$scrfile1,satsymbol,ind,angtobohr)
|
|
endif
|
|
endif MAIN_CALC_LOOP_INPUT_SETUP
|
|
MAIN_CALC_LOOP_EXECUTE:
|
|
$ if(iprog(isp).eq.'mrcc'.and.oniomrest.ne.'0 ') then
|
|
call spoint(.true.)
|
|
else if(iprog(isp).eq.'MOPAC2016.exe'.and.oniomrest.ne.'0 ')
|
|
$ then
|
|
write(cisp,'(i2)') isp
|
|
call execute_mopac(cisp,iprog(isp),iout,istat,cput(isp),
|
|
$walt(isp))
|
|
if(istat.ne.0) then
|
|
write(iout,'(a)') ' Fatal error during MOPAC execution.'
|
|
call mrccend(1)
|
|
endif
|
|
else if(iprog(isp).eq.'xtb'.and.oniomrest.ne.'0 ') then
|
|
call execute_xtb(cisp,iout,xtbstring,.true.,istat,cput(isp),
|
|
$walt(isp))
|
|
if(istat.ne.0) then
|
|
write(iout,'(a)') ' Fatal error during xTB execution.'
|
|
call mrccend(1)
|
|
endif
|
|
if(isp.eq.1.and.moldenval.ne.'off') then
|
|
call ishell('cp MINP.'//trim(adjustl(cisp))//'.xyz'//
|
|
$' COORD.xyz')
|
|
endif
|
|
endif MAIN_CALC_LOOP_EXECUTE
|
|
write(iout,*)
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
write(iout,
|
|
$"(' *** Calculation #',i2,' is finished ',
|
|
$' ***')") isp
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
if(isp.eq.1) then
|
|
! Setup borders based on the first calculation
|
|
if(firstcall) then
|
|
if(iprog(isp).eq.'mrcc') then
|
|
if(moldenval.ne.'off') then
|
|
call ishell('cp MOLDEN MOLDEN.composite')
|
|
endif
|
|
call changekey('orbloco',7,orbloce,16)
|
|
call changekey('orblocc',7,orbloce,16)
|
|
call ishell('cp MOCOEF MOCOEF.CAN.'//cisp)
|
|
call runit('orbloc',orbcpu,orbwal)
|
|
call ishell('cp MOCOEF MOCOEF.LOC.'//cisp)
|
|
open(scrfile1,file='QMMOD_ROUTE',position='REWIND',
|
|
$ status='REPLACE', action='WRITE')
|
|
write(scrfile1,'(a)') 'select_only_occ'
|
|
close(scrfile1)
|
|
call runit('qmmod',orbcpu,orbwal)
|
|
call ishell('cp MOCOEF.CAN.'//cisp//' MOCOEF')
|
|
call changekey('orbloco',7,orbloco,16)
|
|
call changekey('orblocc',7,orblocc,16)
|
|
else if(iprog(isp).eq.'MOPAC2016.exe'.or.
|
|
$ iprog(isp).eq.'xtb') then
|
|
if(moldenval.ne.'off') then
|
|
if(iprog(isp).eq.'MOPAC2016.exe')
|
|
$call ishell('cp MOLDEN MOLDEN.composite')
|
|
if(iprog(isp).eq.'xtb'.and. do_mm )
|
|
$call ishell('cp MOLDEN MOLDEN.composite')
|
|
if(iprog(isp).eq.'xtb'.and. .not. do_mm )
|
|
$call ishell('cp MINP.1.molden.input MOLDEN.composite')
|
|
endif
|
|
if( .not. do_mm ) then
|
|
call make_sqm_bondtable
|
|
$(scrfile1,minpfile,natoms,bondtable,sbondtable,iprog(isp),iout)
|
|
endif
|
|
endif
|
|
call search_layerborders(nlay,natoms,natwdummy,scrfile1,
|
|
$natomslay,layeratoms,nborders,borderat,bondord,iout,
|
|
$atsymbol,linksym,borderhand,borderstat,do_mm)
|
|
call set_linkdist(nlay,natoms,natwdummy,borderat,nborders,iout,
|
|
$linksym,linkdist,borderhand,atsymbol,borderstat,uval,angtobohr)
|
|
endif
|
|
call set_linkcoords(nlay,natwdummy,natoms,coord,borderat,iout,
|
|
$linkdist,nborders,borderstat,linkcoord,nlinks,linksym,slinksym,
|
|
$ncent)
|
|
if(firstcall) then
|
|
call set_multiplicity(nlay,natwdummy,natoms,atnum,nelec_perlay,
|
|
$ichg,natomslay,layeratoms,atsymbol,nborders,slinksym,imul)
|
|
if(oniomtype.eq.'ee') then
|
|
call read_eecharge(oniom_eechg,eecharge(1,1),natoms,
|
|
$iprog(isp),ichg(ilay),itol,ind,qmmm,rescharge_amber,iout)
|
|
call make_qcorr(natoms,nlay,eecharge(1,1),iout,natomslay,
|
|
$layeratoms,ichg,nborders,borderat,rescharge,qnatoms,oniom_qcorr,
|
|
$minpfile,ind,rescharge_amber,qmmm,oniom_eechg)
|
|
endif
|
|
call print_layerborders(nlay,natoms,natwdummy,
|
|
$natomslay,layeratoms,nborders,borderat,bondord,iout,
|
|
$atsymbol,linksym,borderhand,linkdist,borderstat,uval,linkcoord,
|
|
$nlinks,oniomtype,rescharge,qnatoms)
|
|
! Save the setup/borders for gopt/freq
|
|
call write_oniomspec(scrfile1,nlay,nborders,borderstat,
|
|
$borderat,linksym,linkdist,natoms,eecharge,natomslay,layeratoms,
|
|
$imet,ibas,ichg,imul,borderhand,nkeys,keywstring,npcmdefkeys,
|
|
$pcmkeystring,tkbyte,okbyte,nsp,iprog,oniomtype,embedalg,
|
|
$corembedalg,okbyte,embedatstring,okbyte,corembedatstring,
|
|
$embedlow,corembedlow,eorbselecto,eorbselectv,corbselecto,usetemp,
|
|
$do_mm)
|
|
endif
|
|
call ishell('cp COORD.xyz COORD.xyz.composite')
|
|
endif
|
|
! Gradient duties
|
|
read(cdens,'(i2)') i
|
|
if(((gopt.ne.'off '.or.freq.ne.'off ').or.
|
|
$ (i.gt.1)).and.iprog(isp).eq.'mrcc') then
|
|
if(qmmm.eq.'amber'.or.(oniomtype.eq.'ee'.and.isp.gt.1))
|
|
$ call ishell('cp mrcc_job.dat mrcc_job.dat.'//cisp)
|
|
call ishell('cp GRAD GRAD.'//cisp)
|
|
endif
|
|
! save mrcc-related auxiliary files
|
|
if(iprog(isp).eq.'mrcc') then
|
|
call ishell('mv iface iface.'//cisp)
|
|
call ishell('mv VARS VARS.'//cisp)
|
|
call ishell('mv SCFDENSITIES SCFDENSITIES.'//cisp)
|
|
endif
|
|
restguess=.false.
|
|
if(oniomrest.eq.'0 ') then
|
|
call write_xyz_for_calib
|
|
$(nsp,natoms,natwdummy,nlay,ilay,natomslay,layeratoms,ncent,coord,
|
|
$atsymbol,linkcoord,slinksym,nlinks,minpfile)
|
|
stop
|
|
endif
|
|
c if(isp.eq.1) stop
|
|
enddo MAIN_CALC_LOOP
|
|
! ################### Main loop ends ######################
|
|
! Recover the initial setup
|
|
call ishell('cp MINP.composite MINP')
|
|
call ishell('cp KEYWD.composite KEYWD')
|
|
call ishell('rm -f VARS')
|
|
if(moldenval.ne.'off') then
|
|
! if( .not. do_mm ) call ishell('cp MOLDEN.composite MOLDEN')
|
|
call ishell('cp MOLDEN.composite MOLDEN')
|
|
call ishell('cp COORD.xyz.composite COORD.xyz')
|
|
endif
|
|
! Calculate the composite energy
|
|
call collect_and_print_results
|
|
$(nsp,nlay,imet,ibas,iout,scrfile1,minpfile,finalener,iprog,
|
|
$autokcal,embedalg,corembedalg,embedlow,corembedlow,oniomtype,
|
|
$qmmm,cput,walt)
|
|
! Calculate the composite gradient
|
|
read(cdens,'(i2)') i
|
|
if(gopt.ne.'off'.or.freq.ne.'off'.or.i.gt.1) then
|
|
call oniomgrad(natoms,natwdummy,nlay,natomslay,layeratoms,
|
|
$icent,coord,scoord,atsymbol,satsymbol,nlinks,linkcoord,
|
|
$slinksym,ncent,atchg,satchg,nsp,iout,scrfile1,borderat,linkdist,
|
|
$angtobohr,uval,force,efield,echesu,finalener,qmmm,ncharge,
|
|
$oniomtype,eecharge,iprog,efield,autokcal)
|
|
open(scrfile1,file='VARS',form='UNFORMATTED')
|
|
write(scrfile1) 'centmass ',3*ifltln,0.d0,0.d0,0.d0
|
|
write(scrfile1) 'ten ',9*ifltln,
|
|
$1.d0,0.d0,0.d0,0.d0,1.d0,0.d0,0.d0,0.d0,1.d0
|
|
close(scrfile1)
|
|
endif
|
|
end subroutine oniomdriver
|
|
C
|
|
************************************************************************
|
|
subroutine setup_oniomspec(nlay,natoms,minpfile,layeratoms,
|
|
$natomslay,ind,imet,ibas,ichg,imul,iout,natwdummy,
|
|
$borderat,atsymbol,borderhand,linksym,linkdist,
|
|
$borderstat,cscrk,border,linkat,linksd,usetemp,subminp,
|
|
$nsp,iprog,sqmprog,mmprog,qmmm,embedalg,corembedalg,embedat,
|
|
$corembedat,nembedat,ncorembedat,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,orblocv,localcc,printchg,
|
|
$oniom_eechg,atnum,nelec,oniomtype,do_mm)
|
|
************************************************************************
|
|
* Read and set ONIOM layer specifications
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,iatom,ilay,isp
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: minpfile
|
|
integer :: iout
|
|
integer :: ind(natwdummy+1)
|
|
integer :: ichg(nlay)
|
|
integer :: imul(nlay)
|
|
integer :: nsp
|
|
integer :: layeratoms(natwdummy,nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: stringsize
|
|
integer :: embedat(natoms)
|
|
integer :: corembedat(natoms)
|
|
integer :: nembedat
|
|
integer :: ncorembedat
|
|
integer :: atnum(natwdummy)
|
|
integer :: nelec(nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: cscr4
|
|
character(len=4) :: cchg(nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=4) :: localcc
|
|
character(len=4) :: cmul(nlay)
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: oniom
|
|
character(len=8) :: cscr8
|
|
character(len=8) :: subminp
|
|
character(len=8) :: qmmm
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=8) :: oniom_eechg
|
|
character(len=16) :: cscr16
|
|
character(len=16) :: sqmprog
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: mmprog
|
|
character(len=16) :: orblocv
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: embedlow
|
|
character(len=32) :: corembedlow
|
|
character(len=64) :: eorbselecto
|
|
character(len=64) :: eorbselectv
|
|
character(len=64) :: corbselecto
|
|
character(len=natoms*4*8) :: border(nlay)
|
|
character(len=natoms*3*8) :: linkat(nlay)
|
|
character(len=natoms*3*8) :: linksd(nlay)
|
|
character(len=8*natoms*8) :: cscrk
|
|
double precision :: linkdist(natoms,nlay)
|
|
logical :: llg,usetemp,printchg
|
|
logical :: do_mm
|
|
stringsize=8*natoms*8
|
|
!
|
|
open(minpfile,file='MINP',status='OLD')
|
|
call getkeym('calc',4,imet(nlay),32)
|
|
call getkey('basis',5,ibas(nlay),20)
|
|
call getkey('mult',4,cscr4,4)
|
|
if(embedalg.ne.'off '.or.corembedalg.ne.'off ') then
|
|
call embedreadspec(embedalg,corembedalg,natoms,minpfile,ind,
|
|
$iout,nembedat,ncorembedat,embedat,corembedat,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,orblocv,localcc)
|
|
endif
|
|
if(cscr4.eq.' ') then
|
|
imul(nlay)=0
|
|
else
|
|
read(cscr4,'(i4)') imul(nlay)
|
|
endif
|
|
call getkey('charge',6,cchg(nlay),4)
|
|
if(cscr4.eq.'0 ') then
|
|
cchg(nlay)='none'
|
|
endif
|
|
call getkeym('oniom',5,oniom,8)
|
|
! initalize
|
|
natomslay=0
|
|
layeratoms=0
|
|
imet(1:nlay-1)=' '
|
|
ibas(1:nlay-1)=' '
|
|
imul(1:nlay-1)=0
|
|
cchg(1:nlay-1)=' '
|
|
cmul(1:nlay-1)=' '
|
|
border(1:nlay)=' '
|
|
linkat(1:nlay)=' '
|
|
linksd(1:nlay)=' '
|
|
do ilay=1,nlay
|
|
! Set full system conditions for the lowest layer
|
|
if(ilay.eq.1) then
|
|
natomslay(ilay)=natwdummy
|
|
do iatom=1,natoms
|
|
layeratoms(iatom,ilay)=iatom
|
|
enddo
|
|
else
|
|
! Read upper layer atoms
|
|
call oniomat(natwdummy,minpfile,ind,iout)
|
|
k=0
|
|
do iatom=1,natoms
|
|
if(ind(iatom).eq.1) then
|
|
k=k+1
|
|
layeratoms(k,ilay)=iatom
|
|
endif
|
|
enddo
|
|
natomslay(ilay)=k
|
|
call oniomreadspec(natoms,iout,ind,cscrk,stringsize,
|
|
$minpfile,imet,ibas,cchg,cmul,ilay,nlay,imul,borderhand,
|
|
$border,linkat,linksd)
|
|
endif
|
|
enddo
|
|
close(minpfile)
|
|
! Setup external sqm program
|
|
call set_external_sqmprog
|
|
$(nlay,imet,nsp,iprog,sqmprog,iout,subminp,qmmm)
|
|
if(iprog(1).eq.'xtb'.and.oniom_eechg.eq.'external') then
|
|
printchg=.true.
|
|
endif
|
|
if(oniomtype.eq.'ee') then
|
|
if(iprog(1).eq.'xtb') then
|
|
if(oniom_eechg.ne.'external'.and.oniom_eechg.ne.'amber'.and.
|
|
$ oniom_eechg.ne.'user') then
|
|
write(iout,"(a)")
|
|
$" The 'oniom_eechg' keyword is incompatible with "//
|
|
$"the exteral program xTB."
|
|
write(iout,"(a)")
|
|
$" Please use 'external', 'amber', or 'user' settings for "//
|
|
$"'oniom_eechg' with external programs."
|
|
write(iout,"(a)") " Exiting..."
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
endif
|
|
! Set external mm program
|
|
call set_external_mmprog
|
|
$(nlay,imet,nsp,iprog,mmprog,iout,subminp)
|
|
! Check overlap of layer atoms
|
|
call check_layeratoms(natwdummy,iout,nlay,layeratoms,natomslay)
|
|
if(embedalg.ne.'off'.or.corembedalg.ne.'off') then
|
|
call check_layerembedatoms
|
|
$(natwdummy,iout,nlay,layeratoms,natomslay,
|
|
$ embedalg,corembedalg,nembedat,embedat,ncorembedat,corembedat)
|
|
endif
|
|
! Check manually selected borders
|
|
llg=.false.
|
|
do ilay=2,nlay
|
|
if(borderhand(ilay).ne.'auto') llg=.true.
|
|
enddo
|
|
if(llg) write(iout,'(a)')
|
|
$' Checking the manually selected borders...'
|
|
do ilay=2,nlay
|
|
if(borderhand(ilay).ne.'auto') then
|
|
call manual_borderat(ilay,nlay,natoms,border(ilay),borderat,
|
|
$layeratoms,natomslay,iout,ind,borderstat,borderhand,cscrk,cscrk)
|
|
call manual_linkat(ilay,nlay,natoms,linkat(ilay),linksym,
|
|
$iout,ind,borderstat,borderhand,cscrk,cscrk)
|
|
call manual_linksd(ilay,nlay,natoms,linksd(ilay),linkdist,
|
|
$iout,ind,borderstat,borderhand,cscrk,cscrk)
|
|
endif
|
|
enddo
|
|
if(llg) write(iout,'(a)') ' All selections seem ok.'
|
|
! Set default basis and charge if they are not defined
|
|
cscr4='none'
|
|
write(iout,*) 'Checking the charge specification of the layers...'
|
|
do ilay=1,nlay
|
|
if(ibas(ilay).eq.'none'.or.ibas(ilay).eq.' ') then
|
|
do i=ilay+1,nlay
|
|
if(ibas(i).ne.'none'.and.ibas(i).ne.' ') then
|
|
ibas(ilay)=ibas(i)
|
|
if(iprog(ilay).ne.'mrcc') ibas(ilay)='sqm-minimal'
|
|
if(imet(ilay).eq.'gfn-ff') ibas(ilay)=' '
|
|
exit
|
|
endif
|
|
enddo
|
|
endif
|
|
if(cchg(ilay).eq.' ') then
|
|
write(iout,"(
|
|
$' Warning! The charge of layer',i2,' is undetermined.')") ilay
|
|
cscr4='zero'
|
|
ichg(ilay)=0
|
|
else
|
|
read(cchg(ilay),'(i4)') ichg(ilay)
|
|
endif
|
|
enddo
|
|
! Calculate the electron number
|
|
! (a prerequisite to set the default multiplicity, see later)
|
|
call get_nelec
|
|
$(atsymbol,atnum,natoms,natwdummy,nelec(1),ichg(1),natoms,
|
|
$layeratoms(1,1))
|
|
if(imul(1).eq.0) then
|
|
if(MOD(nelec(1),2).eq.0) then
|
|
imul(1)=1
|
|
else
|
|
imul(1)=2
|
|
endif
|
|
endif
|
|
! Check for template files
|
|
write(iout,*)
|
|
if (subminp.eq.'minp'.or.subminp.eq.'m+t') then
|
|
write(iout,'(a)') ' Keywords specified in MINP will be'//
|
|
$' used for all calculations.'
|
|
else if(subminp.eq.'top'.or.subminp.eq.'t+t') then
|
|
write(iout,'(a)') ' Keywords specified in MINP will only'//
|
|
$' be used for the top layer calculations.'
|
|
endif
|
|
if(subminp.eq.'temp'.or.
|
|
$ subminp.eq.'t+t' .or.
|
|
$ subminp.eq.'m+t') then
|
|
usetemp=.true.
|
|
write(iout,'(a)')
|
|
$' Template files will be used for all calculations.'
|
|
write(iout,'(a)') ' Checking for template files...'
|
|
do isp=1,nsp
|
|
write(cscr2,'(i2)') isp
|
|
cscr16='MINP.'//trim(adjustl(cscr2))//'.tpl'
|
|
inquire(file=cscr16,exist=llg)
|
|
if(llg) write(iout,
|
|
$"( ' Template file for calculation #',a2,' is found: ',a16)")
|
|
$cscr2,trim(adjustl(cscr16))
|
|
enddo
|
|
write(iout,*)
|
|
endif
|
|
! Check for molecular-mechanics
|
|
call check_for_mm(imet,nlay,do_mm)
|
|
! Print layer information
|
|
call print_layers(natwdummy,iout,imet,ibas,ichg,imul,cchg,nlay,
|
|
$layeratoms,natomslay,borderhand,minpfile,nsp,iprog,
|
|
$embedalg,corembedalg,nembedat,ncorembedat,embedat,corembedat,
|
|
$embedlow,corembedlow)
|
|
end subroutine setup_oniomspec
|
|
C
|
|
************************************************************************
|
|
subroutine oniomreadspec(natoms,iout,ind,cscrk,stringsize,
|
|
$minpfile,imet,ibas,cchg,cmul,ilay,nlay,imul,borderhand,
|
|
$border,linkat,linksd)
|
|
************************************************************************
|
|
* Read the requested layer specifications
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,k,ilay
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: stringsize
|
|
integer :: iout
|
|
integer :: minpfile
|
|
integer :: ind(natoms+1)
|
|
integer :: imul(nlay)
|
|
integer :: bordersize
|
|
integer :: linksdsize
|
|
character(len=4) :: cmul(nlay)
|
|
character(len=4) :: cchg(nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=natoms*4*8) :: border(nlay)
|
|
character(len=natoms*3*8) :: linkat(nlay)
|
|
character(len=natoms*3*8) :: linksd(nlay)
|
|
character(len=8*natoms*8) :: cscrk
|
|
bordersize=4*natoms*8
|
|
linksdsize=3*natoms*8
|
|
! Read upper layer method/basis/charge/mult
|
|
! format: METHOD / BASIS / CHARGE / MULTIPLICITY
|
|
! METHOD: defines keyword "calc"
|
|
! BASIS: defines keyword "basis"
|
|
! CHARGE: defines keyword "charge"
|
|
! MULTIPLICITY: defines keyword "mult"
|
|
read(minpfile,'(a)') cscrk
|
|
call lowercase(cscrk,cscrk,stringsize)
|
|
ind=0
|
|
cscrk=trim(adjustl(cscrk))
|
|
call stringseparator(cscrk,stringsize,'/',1,ind,natoms+1,k,iout)
|
|
c call stringseparator(cscrk,stringsize,'/',1,ind,3,k,iout)
|
|
if (k.eq.0) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,stringsize,imet(ilay-1),32)
|
|
else if(k.eq.1) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,ind(1)-1,imet(ilay-1),32)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,stringsize,ibas(ilay-1),20)
|
|
else if(k.eq.2) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,ind(1)-1,imet(ilay-1),32)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,ind(2)-1,ibas(ilay-1),20)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(2)+1,stringsize,cchg(ilay-1),4)
|
|
else if(k.eq.3) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,ind(1)-1,imet(ilay-1),32)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,ind(2)-1,ibas(ilay-1),20)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(2)+1,ind(3)-1,cchg(ilay-1),4)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(3)+1,stringsize,cmul(ilay-1),4)
|
|
endif
|
|
imet(ilay-1)=trim(adjustl(imet(ilay-1)))
|
|
ibas(ilay-1)=trim(adjustl(ibas(ilay-1)))
|
|
cchg(ilay-1)=trim(adjustl(cchg(ilay-1)))
|
|
cmul(ilay-1)=trim(adjustl(cmul(ilay-1)))
|
|
if(imet(ilay-1).eq.' ') then
|
|
write(iout,'(a)')
|
|
$' The level of theory is not defined for an ONIOM layer.'
|
|
call mrccend(1)
|
|
endif
|
|
if(cmul(ilay-1).ne.' ') then
|
|
read(cmul(ilay-1),'(i4)') imul(ilay-1)
|
|
endif
|
|
! Read about handling of the layer boundaries
|
|
! format: <Q>/<B1>:<X1>-<Y1>,<B2>:<X2>-<Y2>,...,<BN>:<XN>-<YN> / <B1>:<L1>,<B2>:<L2>,...,<BN>:<LN> / <B1>:<R1>,<B2>:<R2>,...,<BN>:<RN>
|
|
! Q=0 - automatic boundary handling
|
|
! Q=1 - semi-automatic boundary handling (use Q=0 but some options are overwritten manually)
|
|
! Q=2 - manual boundary handling
|
|
! B1,B2,...,BN - boundary number 1, 2,...,N
|
|
! X1,X2,...,XN - host atom of the upper layer of boundary 1, 2,..., N
|
|
! Y1,Y2,...,YN - host atom of the lower layer of boundary 1, 2,..., N
|
|
! L1,L2,...,LN - link atom of boundary 1, 2,...,N
|
|
! R1,R2,...,RN - link atom and upper layer host atom distance of boundary 1, 2,...,N
|
|
read(minpfile,'(a)') cscrk
|
|
call lowercase(cscrk,cscrk,stringsize)
|
|
ind=0
|
|
cscrk=trim(adjustl(cscrk))
|
|
c call stringseparator(cscrk,stringsize,'/',1,ind,natoms+1,k,iout)
|
|
call stringseparator(cscrk,stringsize,'/',1,ind,3,k,iout)
|
|
if(k.gt.0) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,ind(1)-1,borderhand(ilay),4)
|
|
else
|
|
call stringfiller
|
|
$(cscrk,stringsize,1,stringsize,borderhand(ilay),4)
|
|
endif
|
|
borderhand(ilay)=trim(adjustl(borderhand(ilay)))
|
|
if(borderhand(ilay).eq.'0') then
|
|
borderhand(ilay)='auto'
|
|
else if(borderhand(ilay).eq.'1') then
|
|
borderhand(ilay)='semi'
|
|
else if(borderhand(ilay).eq.'2') then
|
|
borderhand(ilay)='manu'
|
|
else
|
|
write(iout,'(a)')
|
|
$'Illegal specification of the handling of layer boundaries.'
|
|
call mrccend(1)
|
|
endif
|
|
if(borderhand(ilay).ne.'auto') then
|
|
if (k.eq.1) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,stringsize,border(ilay),bordersize)
|
|
else if(k.eq.2) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,ind(2)-1,border(ilay),bordersize)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(2)+1,stringsize,linkat(ilay),linksdsize)
|
|
else if(k.eq.3) then
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(1)+1,ind(2)-1,border(ilay),bordersize)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(2)+1,ind(3)-1,linkat(ilay),linksdsize)
|
|
call stringfiller
|
|
$(cscrk,stringsize,ind(3)+1,stringsize,linksd(ilay),linksdsize)
|
|
endif
|
|
endif
|
|
!write(6,'(2a)'),'cscrk = ',cscrk
|
|
border(ilay)=trim(adjustl(border(ilay)))
|
|
linkat(ilay)=trim(adjustl(linkat(ilay)))
|
|
linksd(ilay)=trim(adjustl(linksd(ilay)))
|
|
! print*,'ilay = ',ilay
|
|
! print*,'border(ilay) = ',trim(adjustl(border(ilay)))
|
|
! print*,'linkat(ilay) = ',trim(adjustl(linkat(ilay)))
|
|
! print*,'linksd(ilay) = ',trim(adjustl(linksd(ilay)))
|
|
end subroutine oniomreadspec
|
|
C
|
|
************************************************************************
|
|
subroutine oniomat(natoms,minpfile,ind,iout)
|
|
************************************************************************
|
|
* Read atoms of the oniom layers
|
|
************************************************************************
|
|
implicit none
|
|
integer :: n,m,i,ii,jj
|
|
integer :: natoms
|
|
integer :: minpfile
|
|
integer :: iout
|
|
integer :: ind(natoms+1)
|
|
character(len=1) :: line2(16),line3(max(512,6*natoms))
|
|
character(len=16) :: line1
|
|
equivalence(line1,line2)
|
|
n=0
|
|
line3=' '
|
|
do
|
|
n=n+1
|
|
read(minpfile,'(a)',advance='no',eor=1234,end=1234) line3(n)
|
|
enddo
|
|
1234 continue
|
|
n=1
|
|
ind=0
|
|
do while(line3(n).ne.' ')
|
|
m=n
|
|
do while(line3(n).ne.','.and.line3(n).ne.'-'
|
|
$.and.line3(n).ne.' ')
|
|
n=n+1
|
|
enddo
|
|
line1=' '
|
|
do i=m,n-1
|
|
line2(i-m+1)=line3(i)
|
|
enddo
|
|
read(line1,*) ii
|
|
jj=ii
|
|
if(line3(n).eq.'-') then
|
|
n=n+1
|
|
m=n
|
|
do while(line3(n).ne.','.and.line3(n).ne.' ')
|
|
n=n+1
|
|
enddo
|
|
line1=' '
|
|
do i=m,n-1
|
|
line2(i-m+1)=line3(i)
|
|
enddo
|
|
read(line1,*) jj
|
|
endif
|
|
if(jj.gt.natoms) then
|
|
write(iout,*) 'Invalid ONIOM-layer specification!'
|
|
call mrccend(1)
|
|
endif
|
|
ind(ii:jj)=1
|
|
n=n+1
|
|
enddo
|
|
C
|
|
end subroutine oniomat
|
|
C
|
|
************************************************************************
|
|
subroutine check_layeratoms(natoms,iout,nlay,layeratoms,natomslay)
|
|
************************************************************************
|
|
* Check if the upper layer atoms are subset of the lower layer
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,ilay,jlay,iatom,jatom
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: iout
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: natomslay(nlay)
|
|
logical :: ll
|
|
ilay=nlay
|
|
do i=1,nlay
|
|
do jlay=1,ilay-1
|
|
do iatom=1,natomslay(ilay)
|
|
ll=.false.
|
|
do jatom=1,natomslay(jlay)
|
|
if(layeratoms(iatom,ilay).eq.layeratoms(jatom,jlay)) ll=.true.
|
|
enddo
|
|
if(ll.eqv..false.) then
|
|
write(iout,'(a)') 'Illegal specification of layer atoms.'
|
|
write(iout,'(a)')
|
|
$'Inner layer atoms must be a subset of the outer layer atoms.'
|
|
call mrccend(1)
|
|
endif
|
|
enddo
|
|
enddo
|
|
ilay=ilay-1
|
|
enddo
|
|
end subroutine check_layeratoms
|
|
C
|
|
************************************************************************
|
|
subroutine check_layerembedatoms
|
|
$(natoms,iout,nlay,layeratoms,natomslay,
|
|
$ embedalg,corembedalg,nembedat,embedat,ncorembedat,corembedat)
|
|
************************************************************************
|
|
* Check if the atoms denoted as embedded or corembedded atoms
|
|
* are a subset of the top layer
|
|
************************************************************************
|
|
implicit none
|
|
integer :: ilay,jlay,i,iatom,jatom
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: iout
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: nembedat
|
|
integer :: ncorembedat
|
|
integer :: embedat(nembedat)
|
|
integer :: corembedat(ncorembedat)
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
logical ::ll
|
|
if(embedalg.ne.'off') then
|
|
do iatom=1,nembedat
|
|
ll=.false.
|
|
do jatom=1,natomslay(nlay)
|
|
if(layeratoms(jatom,nlay).eq.embedat(iatom)) ll=.true.
|
|
enddo
|
|
if(ll.eqv..false.) then
|
|
write(iout,'(a)')
|
|
$' Illegal specification of the layer atoms.'
|
|
write(iout,'(a)')
|
|
$' The embedded atoms must be a subset of the top layer atoms.'
|
|
call mrccend(1)
|
|
endif
|
|
enddo
|
|
endif
|
|
if(corembedalg.ne.'off') then
|
|
do iatom=1,ncorembedat
|
|
ll=.false.
|
|
do jatom=1,natomslay(nlay)
|
|
if(layeratoms(jatom,nlay).eq.corembedat(iatom)) ll=.true.
|
|
enddo
|
|
if(ll.eqv..false.) then
|
|
write(iout,'(a)')
|
|
$' Illegal specification of the layer atoms.'
|
|
write(iout,'(a)')
|
|
$' The correlation-embedded atoms must be a subset of the top '//
|
|
$'layer atoms.'
|
|
call mrccend(1)
|
|
endif
|
|
enddo
|
|
endif
|
|
if(corembedalg.ne.'off'.and.embedalg.ne.'off') then
|
|
do iatom=1,ncorembedat
|
|
ll=.false.
|
|
do jatom=1,nembedat
|
|
if(embedat(jatom).eq.corembedat(iatom)) ll=.true.
|
|
enddo
|
|
if(ll.eqv..false.) then
|
|
write(iout,'(a)')
|
|
$' Illegal specification of the embedded atoms.'
|
|
write(iout,'(a)')
|
|
$' The correlation-embedded atoms must be a subset of the '//
|
|
$'DFT-embedding atoms.'
|
|
call mrccend(1)
|
|
endif
|
|
enddo
|
|
endif
|
|
end subroutine check_layerembedatoms
|
|
C
|
|
************************************************************************
|
|
subroutine get_coords(qmmm,natoms,natwdummy,coord,atchg,atsymbol,
|
|
$uval,gval,ncent,iout)
|
|
************************************************************************
|
|
* Extract coordinates of the system, including surrounding environment of the point charges
|
|
************************************************************************
|
|
integer :: natwdummy,ncent,natoms
|
|
integer :: iout
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=4) :: gval,uval
|
|
character(len=8) :: qmmm
|
|
double precision :: coord(3,ncent)
|
|
double precision :: atchg(ncent)
|
|
C Read Cartesian coordinates in the case of QM/MM calculation ! from integ but never tested => deleted
|
|
if(qmmm.eq.'charmm ') then
|
|
write(iout,'(a)')
|
|
$' Only the xyz format is supported for ONIOM calculations!'
|
|
call mrccend(1)
|
|
C Construct Z-matrix ! from integ but never tested => deleted
|
|
else if(gval.eq.'zmat'.or.gval.eq.' ') then
|
|
write(iout,'(a)')
|
|
$' Only the xyz format is supported for ONIOM calculations!'
|
|
call mrccend(1)
|
|
else
|
|
C Read Cartesian coordinates
|
|
if(gval.eq.'xyz ') then !xyz format
|
|
call get_coords_xyz(natoms,atsymbol,coord)
|
|
else !Turbomole and mol format ! from integ but never tested => deleted
|
|
write(iout,'(a)')
|
|
$' Only the xyz format is supported for ONIOM calculations!'
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
C Read point charges in the case Amber interface
|
|
if(qmmm.eq.'amber ') call get_pointcharges
|
|
$(natoms,ncent,coord,atchg)
|
|
end subroutine get_coords
|
|
C
|
|
************************************************************************
|
|
subroutine get_coords_xyz(natoms,atsymbol,coord)
|
|
************************************************************************
|
|
use error_handler
|
|
#include "MRCCCOMMON"
|
|
integer :: istat
|
|
integer :: natoms
|
|
integer :: j,iatom
|
|
double precision :: coord(3,*)
|
|
character(len=2) :: atsymbol(*)
|
|
character(len=2048) :: line
|
|
line=''
|
|
istat=0
|
|
open(unit=minpfile,file='MINP',status='OLD',iostat=istat,
|
|
$action='READ')
|
|
do while (istat.eq.0 .and. line(1:4).ne."geom" )
|
|
read(minpfile,'(a)',iostat=istat) line
|
|
enddo
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(minpfile,'(a)',iostat=istat) line
|
|
iatom=1
|
|
do while ( istat.eq.0 .and. iatom .le. natoms )
|
|
read(minpfile,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*,iostat=istat)
|
|
$atsymbol(iatom),(coord(j,iatom),j=1,3)
|
|
iatom=iatom+1
|
|
enddo
|
|
if(istat.ne.0) call io_error
|
|
$("Cannot open/read MINP","get_coord_xyz (compmod.f)")
|
|
close(minpfile)
|
|
end subroutine get_coords_xyz
|
|
C
|
|
************************************************************************
|
|
subroutine get_pointcharges(natoms,ncent,coord,atchg)
|
|
************************************************************************
|
|
use error_handler
|
|
#include "MRCCCOMMON"
|
|
character(len=8) :: cscr8
|
|
integer :: iatom,i,j
|
|
integer :: natoms
|
|
integer :: ncent
|
|
integer :: istat
|
|
double precision :: coord(3,ncent)
|
|
double precision :: atchg(ncent)
|
|
istat=0
|
|
open(minpfile,file="MINP",position="REWIND",status='OLD',
|
|
$iostat=istat)
|
|
cscr8=' '
|
|
do while(istat.eq.0 .and. cscr8.ne.'pointcha')
|
|
read(minpfile,"(a8)",iostat=istat) cscr8
|
|
enddo
|
|
if(istat.eq.0) read(minpfile,*,iostat=istat) i
|
|
iatom=natoms+1
|
|
do while( istat.eq.0 .and. iatom.le.ncent )
|
|
read(minpfile,*) (coord(j,iatom),j=1,3),atchg(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
if(istat.ne.0) call io_error
|
|
$("Cannot open/read MINP file","get_pointcharges (compmod.f)")
|
|
close(minpfile)
|
|
end subroutine get_pointcharges
|
|
C
|
|
|
|
************************************************************************
|
|
subroutine print_layers(natoms,iout,imet,ibas,ichg,imul,cchg,nlay,
|
|
$layeratoms,natomslay,borderhand,scrfile1,nsp,iprog,embedalg,
|
|
$corembedalg,nembedat,ncorembedat,embedat,corembedat,embedlow,
|
|
$corembedlow)
|
|
************************************************************************
|
|
* Print layer information: layer number, atoms of the layer, method
|
|
* basis, charge, and multiplicity
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,k,isp,ilay
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: iout
|
|
integer :: ichg(nlay)
|
|
integer :: imul(nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: level
|
|
integer :: nsp
|
|
integer :: scrfile1
|
|
integer :: nembedat
|
|
integer :: ncorembedat
|
|
integer :: embedat(nembedat)
|
|
integer :: corembedat(ncorembedat)
|
|
character(len=4) :: cscr4
|
|
character(len=4) :: cchg(nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=8) :: oniom
|
|
character(len=8) :: cscr8
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: embedlow
|
|
character(len=32) :: corembedlow
|
|
character(len=40) :: cscr40
|
|
write(iout,'(a)') ' ==============================================
|
|
$========================='
|
|
write(iout,'(a)') ' *** Layer specifications
|
|
$ ***'
|
|
write(iout,'(a)') ' ==============================================
|
|
$========================='
|
|
write(iout,*)
|
|
ilay=1
|
|
level=0
|
|
! Correct the writings in the case of sqm/mm
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(iprog(isp).ne.'mrcc') then
|
|
ibas(level)='sqm-minimal'
|
|
if(imet(level).eq.'gfn-ff') ibas(level)=' '
|
|
endif
|
|
enddo
|
|
! Print layer information with the high-level methods
|
|
do ilay=1,nlay
|
|
write(iout,'(a,i2)') ' Layer: ',ilay
|
|
write(iout,'(a,i6)') ' Number of atoms: ',natomslay(ilay)
|
|
write(iout,'(a)') ' Atoms of the layer: '
|
|
write(iout,'(14i6)') (layeratoms(k,ilay),k=1,natomslay(ilay))
|
|
if(ilay.eq.nlay.and.
|
|
$ (embedalg.ne.'off'.or.corembedalg.ne.'off')) then
|
|
write(iout,'(a,a)') ' Top-level Method: ',
|
|
$trim(adjustl(imet(ilay)))
|
|
if(embedalg.ne.'off'.and.corembedalg.eq.'off') then
|
|
write(iout,'(a)') ' Atoms of the top-level method: '
|
|
write(iout,'(14i6)') (embedat(k),k=1,nembedat)
|
|
write(iout,'(a,a)') ' Low-level Method: ',
|
|
$trim(adjustl(embedlow))
|
|
else if(embedalg.eq.'off'.and.corembedalg.ne.'off') then
|
|
write(iout,'(a)') ' Atoms of the top-level method: '
|
|
write(iout,'(14i6)') (corembedat(k),k=1,ncorembedat)
|
|
write(iout,'(a,a)') ' Low-level Method: ',
|
|
$trim(adjustl(corembedlow))
|
|
else if(embedalg.ne.'off'.and.corembedalg.ne.'off') then
|
|
write(iout,'(a)') ' Atoms of the top-level method: '
|
|
write(iout,'(14i6)') (corembedat(k),k=1,ncorembedat)
|
|
write(iout,'(a,a)') ' Middle-level Method: ',
|
|
$trim(adjustl(corembedlow))
|
|
write(iout,'(a)') ' Atoms of the middle-level method: '
|
|
write(iout,'(14i6)') (embedat(k),k=1,nembedat)
|
|
write(iout,'(a,a)') ' Low-level Method: ',
|
|
$trim(adjustl(embedlow))
|
|
endif
|
|
else
|
|
write(iout,'(a,a)') ' Method: ',
|
|
$trim(adjustl(imet(ilay)))
|
|
endif
|
|
write(iout,'(a,a)') ' Basis set: ',
|
|
$trim(adjustl(ibas(ilay)))
|
|
write(iout,'(a,i6)') ' Charge: ',ichg(ilay)
|
|
if(imul(ilay).ne.0) then
|
|
write(iout,'(a,i2)') ' Multiplicity: ',imul(ilay)
|
|
else
|
|
write(iout,'(a)') ' Multiplicity: to be determined'
|
|
endif
|
|
if(borderhand(ilay).eq.'auto') then
|
|
write(iout,'(a)') ' Boundary handling: automatic'
|
|
else if(borderhand(ilay).eq.'semi') then
|
|
write(iout,'(a)') ' Boundary handling: semi-automatic'
|
|
else if(borderhand(ilay).eq.'manu') then
|
|
write(iout,'(a)') ' Boundary handling: manual'
|
|
endif
|
|
write(iout,*)
|
|
enddo
|
|
ilay=1
|
|
level=0
|
|
write(iout,'(a)')
|
|
$' Single point calculations will be executed'//
|
|
$' in the following order:'
|
|
write(iout,'(a)')
|
|
$' Calc. number Layer number Level'
|
|
do isp=1,nsp ! Main loop starts
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(iprog(isp).eq.'mrcc') then
|
|
cscr40=trim(adjustl(imet(level)))//'/'//
|
|
$trim(adjustl(ibas(level)))
|
|
! Embed and corembed
|
|
if(isp.eq.nsp) then
|
|
if(embedalg.ne.'off '.and.corembedalg.ne.'off ') then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(corembedlow))//
|
|
$ '-in-'//trim(adjustl(embedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
else if(embedalg.eq.'off '.and.corembedalg.ne.'off ')
|
|
$then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(corembedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
else if(embedalg.ne.'off '.and.corembedalg.eq.'off ')
|
|
$then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(embedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
endif
|
|
endif
|
|
write(iout,"(4x,i4,10x,i4,9x,a40)")
|
|
$isp, ilay,cscr40
|
|
else
|
|
if(imet(level).ne.'gfn-ff') then
|
|
cscr40=trim(adjustl(imet(level)))//'/'//
|
|
$trim(adjustl(ibas(level)))//' ('//
|
|
$trim(adjustl(iprog(isp)))//')'
|
|
else
|
|
cscr40=trim(adjustl(imet(level)))//
|
|
$' ('//trim(adjustl(iprog(isp)))//')'
|
|
endif
|
|
write(iout,"(4x,i4,10x,i4,9x,a40,2x,a3,a,2a)")
|
|
$isp, ilay,cscr40
|
|
endif
|
|
enddo
|
|
end subroutine print_layers
|
|
C
|
|
************************************************************************
|
|
subroutine write_minp(minpfile,iout,qmmm,dens,isp,natoms,
|
|
$natwdummy,ncent,coord,atsymbol,atchg,method,basis,charge,mult,mem,
|
|
$geom,usetemp,verbosity,uval,nkeys,keywstring,kstringsize,mpitasks,
|
|
$pcm,pcmkeystring,npcmdefkeys,oniomtype,ccoord,ncharge,
|
|
$embed,corembed,embedalg,corembedalg,estringsize,embedatstring,
|
|
$cstringsize,corembedatstring,embedlow,corembedlow,eorbselecto,
|
|
$eorbselectv,corbselecto,orbloce,orblocv,localcc,restguess)
|
|
************************************************************************
|
|
* write MINP file
|
|
************************************************************************
|
|
implicit none
|
|
integer :: isp,i,j,k,iatom
|
|
integer :: minpfile
|
|
integer :: iout
|
|
integer :: ncent
|
|
integer :: natoms
|
|
integer :: ncharge
|
|
integer :: charge
|
|
integer :: mult
|
|
integer :: natwdummy
|
|
integer :: ierr
|
|
integer :: nkeys
|
|
integer :: kstringsize
|
|
integer :: npcmdefkeys
|
|
integer :: estringsize
|
|
integer :: cstringsize
|
|
character(len=kstringsize) :: keywstring
|
|
character(len=estringsize) :: embedatstring
|
|
character(len=cstringsize) :: corembedatstring
|
|
character(len=1) :: line1(512)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: verbosity
|
|
character(len=4) :: dens
|
|
character(len=4) :: geom
|
|
character(len=4) :: uval
|
|
character(len=4) :: mpitasks
|
|
character(len=4) :: oniomtype
|
|
character(len=4) :: localcc
|
|
character(len=8) :: qmmm
|
|
character(len=8) :: cscr8
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=16) :: mem
|
|
character(len=16) :: cscr16
|
|
character(len=16) :: inpfile
|
|
character(len=16) :: orbloce
|
|
character(len=16) :: orblocv
|
|
character(len=20) :: basis
|
|
character(len=32) :: method
|
|
character(len=32) :: pcm
|
|
character(len=32) :: embedlow
|
|
character(len=32) :: corembedlow
|
|
character(len=64) :: eorbselecto
|
|
character(len=64) :: eorbselectv
|
|
character(len=64) :: corbselecto
|
|
character(len=512) :: line
|
|
character(len=512) :: pcmkeystring
|
|
double precision :: coord(3,ncent)
|
|
double precision :: atchg(ncharge)
|
|
double precision :: ccoord(3,ncharge)
|
|
logical :: usetemp
|
|
logical :: lfound
|
|
logical :: embed
|
|
logical :: corembed
|
|
logical :: restguess
|
|
equivalence(line,line1)
|
|
write(iout,'(a)') ' Writing MINP file ...'
|
|
write(cscr2,'(i2)') isp
|
|
! Search for template file
|
|
inpfile='MINP.'//trim(adjustl(cscr2))
|
|
cscr16='MINP.'//trim(adjustl(cscr2))//'.tpl'
|
|
if(usetemp) then
|
|
inquire(file=cscr16,exist=lfound)
|
|
if(lfound) then
|
|
write(iout,"( ' Template file is found. Using file:
|
|
$',a12)") cscr16
|
|
call system('echo "! User defined keywords from MINP" //
|
|
$"template file" >'//inpfile//'; cat '//cscr16//' >> '//inpfile)
|
|
open(minpfile, file=inpfile, iostat=ierr, position='append')
|
|
else
|
|
write(iout,"( ' Template file is not found.')")
|
|
open(minpfile, file=inpfile, iostat=ierr, status='replace')
|
|
endif
|
|
else
|
|
open(minpfile, file=inpfile, iostat=ierr, status='replace')
|
|
endif
|
|
if(ierr.ne.0) then
|
|
write(iout,*)
|
|
$" An error occured during the opening of a MINP file (write_minp)"
|
|
call mrccend(1)
|
|
endif
|
|
! Minimum specification: Method / Basis set / Charge / Mult
|
|
write(minpfile,'(a)')'! User defined keywords from MINP'
|
|
write(minpfile,'(a,a)')'calc=',trim(adjustl(method))
|
|
write(minpfile,'(a,a)')'basis=',trim(adjustl(basis))
|
|
write(minpfile,'(2a)')'verbosity=',trim(adjustl(verbosity))
|
|
write(cscr8,'(i5)') charge
|
|
write(minpfile,'(2a)')'charge=',trim(adjustl(cscr8))
|
|
if(mult.ne.0) then
|
|
write(cscr8,'(i5)') mult
|
|
write(minpfile,'(2a)')'mult=',trim(adjustl(cscr8))
|
|
endif
|
|
! Restart
|
|
if(restguess) write(minpfile,'(a)')'scfiguess=restart'
|
|
! Extra specification
|
|
if(nkeys.ne.0) then
|
|
do i=1,nkeys
|
|
if(i.eq.1) then
|
|
read(keywstring,*) line
|
|
else
|
|
read(keywstring,*) (line1(k),k=1,i-1),line
|
|
endif
|
|
write(minpfile,'(a)') trim(adjustl(line))
|
|
enddo
|
|
endif
|
|
write(minpfile,'(a)')'! Default keywords for ONIOM calculation'
|
|
write(minpfile,'(2a)')'mpitasks=',trim(adjustl(mpitasks))
|
|
write(minpfile,'(2a)')'unit=',trim(adjustl(uval))
|
|
write(minpfile,'(2a)')'mem=',trim(adjustl(mem))
|
|
! PCM specification
|
|
if(trim(adjustl(pcm)).ne.'off') then
|
|
write(minpfile,'(2a)')'pcm=',trim(adjustl(pcm))
|
|
if(npcmdefkeys.ne.0) then
|
|
do i=1,npcmdefkeys
|
|
if(i.eq.1) then
|
|
read(pcmkeystring,*) line
|
|
else
|
|
read(pcmkeystring,*) (line1(k),k=1,i-1),line
|
|
endif
|
|
write(minpfile,'(a)') trim(adjustl(line))
|
|
enddo
|
|
endif
|
|
endif
|
|
if(qmmm.eq.'amber') then
|
|
write(minpfile,'(a)')'qmmm=amber'
|
|
endif
|
|
write(minpfile,'(2a)')'dens=',trim(adjustl(dens))
|
|
write(minpfile,*)
|
|
! Handling 'embed' and 'corembed'
|
|
if(embed) then
|
|
write(minpfile,'(2a)')'orbloce=',trim(adjustl(orbloce))
|
|
if(orblocv.ne.'off '.and.localcc.eq.'off ') then
|
|
write(minpfile,'(2a)')'orblocv=',trim(adjustl(orblocv))
|
|
endif
|
|
write(minpfile,'(2a)')'embed=',trim(adjustl(embedalg))
|
|
write(minpfile,'(a)')trim(adjustl(embedatstring))
|
|
write(minpfile,'(a)')trim(adjustl(embedlow))
|
|
write(minpfile,'(a)')trim(adjustl(eorbselecto))
|
|
if(orblocv.ne.'off '.and.localcc.eq.'off ') then
|
|
write(minpfile,'(a)')trim(adjustl(eorbselectv))
|
|
endif
|
|
endif
|
|
write(minpfile,*)
|
|
if(corembed) then
|
|
write(minpfile,'(2a)')'corembed=',trim(adjustl(corembedalg))
|
|
write(minpfile,'(a)')trim(adjustl(corembedatstring))
|
|
write(minpfile,'(a)')trim(adjustl(corembedlow))
|
|
write(minpfile,'(a)')trim(adjustl(corbselecto))
|
|
endif
|
|
write(minpfile,*)
|
|
! Geometry
|
|
write(minpfile,'(a)') 'geom=xyz'
|
|
write(cscr16,'(i16)') natoms
|
|
write(minpfile,'(a)') trim(adjustl(cscr16))
|
|
write(minpfile,*)
|
|
do iatom=1,natoms
|
|
write(minpfile,'(a2,3f25.16)')
|
|
$atsymbol(iatom),coord(1:3,iatom)
|
|
enddo
|
|
write(minpfile,*)
|
|
! Point charge environment
|
|
if(qmmm.eq.'amber'.or.oniomtype.eq.'ee') then
|
|
write(minpfile,'(a)') 'pointcharges'
|
|
write(cscr16,'(i16)') ncharge
|
|
write(minpfile,'(a)') trim(adjustl(cscr16))
|
|
do iatom=1,ncharge
|
|
write(minpfile,'(4f25.16)') ccoord(1:3,iatom),atchg(iatom)
|
|
enddo
|
|
endif
|
|
close(minpfile)
|
|
end subroutine write_minp
|
|
C
|
|
************************************************************************
|
|
subroutine modify_mem(oldmem,mem,imemdiff,cmemdiff,iout)
|
|
************************************************************************
|
|
* Redefine the requested memory to incorporate the ONIOM memory requirement
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i
|
|
integer :: imemdiff
|
|
integer :: imem
|
|
integer :: iout
|
|
integer :: imem1
|
|
integer :: intadd
|
|
double precision :: roldmem
|
|
double precision :: rmem
|
|
character(len=1) :: line2(16)
|
|
character(len=2) :: ch2
|
|
character(len=16) :: line1
|
|
character(len=16) :: oldmem
|
|
character(len=16) :: mem
|
|
character(len=16) :: cscr16
|
|
character(len=16) :: cmemdiff
|
|
equivalence(line1,line2)
|
|
C
|
|
line1=oldmem
|
|
if(line1.ne.' ') then
|
|
i=1
|
|
do while(line2(i).ne.' '.and.i.lt.16)
|
|
i=i+1
|
|
enddo
|
|
call lowercase(line2(i-2),ch2,2)
|
|
if(ch2.ne.'mb'.and.ch2.ne.'gb') then
|
|
write(iout,*) 'Unknown memory unit!'
|
|
call exit(1)
|
|
endif
|
|
line2(i-2)=' '
|
|
line2(i-1)=' '
|
|
read(line1,*) roldmem
|
|
else
|
|
ch2='mb'
|
|
roldmem=256.d0
|
|
endif
|
|
if(ch2.eq.'gb') roldmem=1024.d0*roldmem
|
|
rmem=roldmem-imemdiff*8d0/1024d0/1024d0
|
|
imem=int(rmem)
|
|
write(cscr16, '(i14)') imem
|
|
line1=trim(adjustl(cscr16))
|
|
i=1
|
|
do while(line2(i).ne.' '.and.i.lt.16)
|
|
i=i+1
|
|
enddo
|
|
line2(i)='m'
|
|
line2(i+1)='b'
|
|
mem=line1
|
|
rmem=imemdiff*8d0/1024d0/1024d0
|
|
imem=int(rmem)
|
|
if(imem.eq.0) imem=1
|
|
write(cscr16, '(i14)') imem
|
|
line1=trim(adjustl(cscr16))
|
|
i=1
|
|
do while(line2(i).ne.' '.and.i.lt.16)
|
|
i=i+1
|
|
enddo
|
|
line2(i)='m'
|
|
line2(i+1)='b'
|
|
cmemdiff=line1
|
|
! print*,'oldmem =',trim(adjustl(oldmem)),
|
|
! $'mem = ',mem,' memdiff = ',cmemdiff
|
|
end subroutine modify_mem
|
|
C
|
|
************************************************************************
|
|
subroutine search_layerborders(nlay,natoms,natwdummy,scrfile1,
|
|
$natomslay,layeratoms,nborders,borderat,bondord,iout,
|
|
$atsymbol,linksym,borderhand,borderstat,do_mm)
|
|
************************************************************************
|
|
* Search for those bonds that connect the different layers
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,l,n,ilay,ibond,iatom,jatom
|
|
integer :: natperbond
|
|
integer :: minpfile
|
|
integer :: scrfile1
|
|
integer :: nlay
|
|
integer :: iout
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nborders(nlay)
|
|
integer :: nbonds
|
|
integer :: ind(natoms+1)
|
|
integer :: ispec
|
|
integer :: bondord(natoms,nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: cscr2i,cscr2j
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=2048) :: line
|
|
double precision :: rscr
|
|
logical :: ii,jj,kk
|
|
logical :: do_mm
|
|
nborders=0
|
|
ind=0
|
|
write(iout,*)
|
|
NO_BONDTABLE_BRANCH:
|
|
$if( .not. do_mm ) then
|
|
write(iout,'(a)') ' Searching for boundaries of the layers...'
|
|
open(scrfile1,file='BONDTABLE',position='append',status='OLD')
|
|
backspace(scrfile1)
|
|
read(scrfile1,'(a)') line
|
|
read(line,*) nbonds
|
|
rewind(scrfile1)
|
|
read(scrfile1,'(a)') line
|
|
do ibond=1,nbonds
|
|
iatom=0
|
|
jatom=0
|
|
read(scrfile1,'(a)') line
|
|
read(line,*) i,natperbond
|
|
if(natperbond.eq.2) then
|
|
backspace(scrfile1)
|
|
read(scrfile1,'(a)') line
|
|
read(line,*) i,natperbond,rscr,iatom,jatom
|
|
endif
|
|
do ilay=2,nlay
|
|
if(borderhand(ilay).ne.'manu') then
|
|
ii=.false.
|
|
jj=.false.
|
|
kk=.false.
|
|
do k=1,natomslay(ilay)
|
|
if(iatom.eq.layeratoms(k,ilay)) ii=.true.
|
|
if(jatom.eq.layeratoms(k,ilay)) jj=.true.
|
|
enddo
|
|
! increment bond order if the border is already found
|
|
if(ii.neqv.jj.and.rscr.gt.0.5d0) then !
|
|
do k=1,nborders(ilay)
|
|
if((borderat(1,k,ilay).eq.iatom.and.
|
|
$ borderat(2,k,ilay).eq.jatom).or.
|
|
$ (borderat(1,k,ilay).eq.jatom.and.
|
|
$ borderat(2,k,ilay).eq.iatom)) then
|
|
bondord(k,ilay)=bondord(k,ilay)+1
|
|
kk=.true.
|
|
exit
|
|
endif
|
|
enddo
|
|
! new border is found
|
|
if(kk.eqv..false.) then
|
|
nborders(ilay)=nborders(ilay)+1
|
|
if(ii) then
|
|
borderat(1,nborders(ilay),ilay)=iatom
|
|
borderat(2,nborders(ilay),ilay)=jatom
|
|
endif
|
|
if(jj) then
|
|
borderat(1,nborders(ilay),ilay)=jatom
|
|
borderat(2,nborders(ilay),ilay)=iatom
|
|
endif
|
|
if(borderstat(nborders(ilay),ilay).eq.' ') then
|
|
borderstat(nborders(ilay),ilay)='A'
|
|
endif
|
|
bondord(nborders(ilay),ilay)=1
|
|
endif
|
|
endif
|
|
endif
|
|
enddo
|
|
enddo
|
|
close(scrfile1)
|
|
endif NO_BONDTABLE_BRANCH
|
|
! Set the type of link atom in the case of automatic selections
|
|
do ilay=2,nlay
|
|
do k=1,nborders(ilay)
|
|
if(borderstat(k,ilay).eq.'A') then
|
|
if(bondord(k,ilay).ge.2) then
|
|
write(iout,'(a,i2,a,i2)') ' Warning! Multiple MOs are'//
|
|
$' localized to layer ',ilay,', boundary ',k,')'
|
|
endif
|
|
if(bondord(k,ilay).eq.1) linksym(k,ilay)='H '
|
|
if(bondord(k,ilay).eq.2) linksym(k,ilay)='O '
|
|
if(bondord(k,ilay).eq.3) linksym(k,ilay)='N '
|
|
if(bondord(k,ilay).ge.4) then
|
|
write(iout,'(a)') ' Quadruple bond is detected at the'//
|
|
$'boundary border.'
|
|
write(iout,'(a)') ' Something must have gone wrong.'
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
enddo
|
|
enddo
|
|
! Modify the number of borders by the used defined borders
|
|
do ilay=2,nlay
|
|
if(borderhand(ilay).eq.'manu') then
|
|
do j=1,natoms
|
|
if(borderstat(j,ilay).eq.'M') nborders(ilay)=nborders(ilay)+1
|
|
enddo
|
|
endif
|
|
if(borderhand(ilay).eq.'semi') then
|
|
do j=1,natoms
|
|
if(borderstat(j,ilay).eq.'M') nborders(ilay)=nborders(ilay)+1
|
|
if(borderstat(j,ilay).eq.'D') nborders(ilay)=nborders(ilay)-1
|
|
enddo
|
|
endif
|
|
enddo
|
|
c if(llg) then
|
|
c write(iout,"(' This can lead to unexpected errors.')")
|
|
c write(iout,"(' Please reconsider your layer specification.')")
|
|
c endif
|
|
write(iout,'(a)') ' Done.'
|
|
end subroutine search_layerborders
|
|
C
|
|
************************************************************************
|
|
subroutine print_layerborders(nlay,natoms,natwdummy,
|
|
$natomslay,layeratoms,nborders,borderat,
|
|
$bondord,iout,atsymbol,linksym,borderhand,linkdist,
|
|
$borderstat,uval,linkcoord,nlinks,oniomtype,rescharge,qnatoms)
|
|
************************************************************************
|
|
* Print border atoms, link atoms, and handling
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,l,n,ilay
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: iout
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nborders(nlay)
|
|
integer :: ispec
|
|
integer :: nlinks(nlay)
|
|
integer :: bondord(natoms,nlay)
|
|
integer :: qnatoms(nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=4) :: uval
|
|
character(len=4) :: oniomtype
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: rescharge(nlay)
|
|
logical :: ii,jj
|
|
write(iout,*)
|
|
write(iout,'(a)') ' ########################################'
|
|
write(iout,'(a)') ' *** Boundary information ***'
|
|
write(iout,'(a)') ' ########################################'
|
|
write(iout,*)
|
|
write(iout,'(a)') ' ---------------------------------------'
|
|
do ilay=2,nlay
|
|
write(iout,"( ' Layer: ',i2,' ')")
|
|
$ilay
|
|
if(borderhand(ilay).eq.'auto') then
|
|
write(iout,'(a)') ' Boundary handling: automatic'
|
|
else if(borderhand(ilay).eq.'semi') then
|
|
write(iout,'(a)') ' Boundary handling: semi-automatic'
|
|
else if(borderhand(ilay).eq.'manu') then
|
|
write(iout,'(a)') ' Boundary handling: manual'
|
|
endif
|
|
if(nborders(ilay).gt.0) then
|
|
write(iout,"(' Number of boundaries: ',i2)") nborders(ilay)
|
|
write(iout,*)
|
|
k=0
|
|
do j=1,natoms
|
|
if(borderstat(j,ilay).ne.' ') then
|
|
write(iout,"(' Boundary No.: ',i2)") j
|
|
if(borderhand(ilay).eq.'semi') then
|
|
if(borderstat(j,ilay).eq.'A') then
|
|
write(iout,"(' Selection scheme: automatic')")
|
|
else if(borderstat(j,ilay).eq.'D') then
|
|
write(iout,"(' Selection scheme: manual
|
|
$(deleted border)')")
|
|
else if(borderstat(j,ilay).eq.'M') then
|
|
write(iout,"(' Selection scheme: manual')")
|
|
endif
|
|
endif
|
|
call uppercase(atsymbol(borderat(1,j,ilay)),
|
|
$ atsymbol(borderat(1,j,ilay)),1)
|
|
call uppercase(atsymbol(borderat(2,j,ilay)),
|
|
$ atsymbol(borderat(2,j,ilay)),1)
|
|
if(borderstat(j,ilay).ne.'D') then
|
|
write(iout,"(' Layer atom: ',i8,' ',a2)")
|
|
$borderat(1,j,ilay),atsymbol(borderat(1,j,ilay))
|
|
write(iout,"(' Non-layer atom: ',i8,' ',a2)")
|
|
$borderat(2,j,ilay),atsymbol(borderat(2,j,ilay))
|
|
if(borderstat(j,ilay).eq.'A') then
|
|
c write(iout,"(' Mayer bond order: ',f10.5)")
|
|
c $bondord(j,ilay)
|
|
write(iout,"(' # of LMOs: ',i8)")
|
|
$bondord(j,ilay)
|
|
endif
|
|
write(iout,"(' Link atom: ',a2)")linksym(j,ilay)
|
|
if(uval.eq.' '.or.uval.eq.'angs') then
|
|
write(iout,"(' Link atom distance: ',f10.5,' Angstrom')")
|
|
$linkdist(j,ilay)
|
|
else
|
|
write(iout,"(' Link atom distance: ',f10.5,' Bohr')")
|
|
$linkdist(j,ilay)
|
|
endif
|
|
k=k+1
|
|
! Reorder manually selected borders
|
|
if(((borderstat(j,ilay).eq.'M').or.
|
|
$ (borderstat(j,ilay).eq.'A')).and.
|
|
$ (k.ne.j)) then
|
|
borderstat(k,ilay)=borderstat(j,ilay)
|
|
borderstat(j,ilay)=' '
|
|
borderat(1,k,ilay)=borderat(1,j,ilay)
|
|
borderat(2,k,ilay)=borderat(2,j,ilay)
|
|
borderat(1,j,ilay)=-1
|
|
borderat(2,j,ilay)=-1
|
|
linksym(k,ilay)=linksym(j,ilay)
|
|
linksym(j,ilay)=' '
|
|
linkdist(k,ilay)=linkdist(j,ilay)
|
|
linkdist(j,ilay)=0.0d0
|
|
endif
|
|
write(iout,"(' Link atom coordinates: '
|
|
$'x = ',f10.5,' y = ',f10.5,' z = ',f10.5)")
|
|
$linkcoord(1,k,ilay),linkcoord(2,k,ilay),linkcoord(3,k,ilay)
|
|
write(iout,*)
|
|
else
|
|
write(iout,"(' Layer atom: ',i8,' ',a2)")
|
|
$borderat(1,j,ilay),atsymbol(borderat(1,j,ilay))
|
|
write(iout,"(' Non-layer atom: ',i8,' ',a2)")
|
|
$borderat(2,j,ilay),atsymbol(borderat(2,j,ilay))
|
|
write(iout,*)
|
|
endif
|
|
endif
|
|
enddo
|
|
else
|
|
write(iout,'(a)') ' The layers are not connected covalently.'
|
|
write(iout,'(a)') ' Boundary handling is not required.'
|
|
endif
|
|
if(oniomtype.eq.'ee') then
|
|
write(iout,"(' Residual point charge : ',f10.5)")
|
|
$rescharge(ilay)
|
|
write(iout,"(' # of corrected charges: ',i8)")
|
|
$qnatoms(ilay)
|
|
endif
|
|
write(iout,'(a)') ' ---------------------------------------'
|
|
enddo
|
|
do ilay=2,nlay
|
|
if(nborders(ilay).gt.0) then
|
|
write(iout,*)
|
|
write(iout,'(a)') ' Link atom distances are set according to:'
|
|
write(iout,'(a)') ' https://cccbdb.nist.gov/expbondlengths1.asp'
|
|
write(iout,*)
|
|
exit
|
|
endif
|
|
enddo
|
|
write(iout,'(a)') ' #######################################'
|
|
end subroutine print_layerborders
|
|
C
|
|
************************************************************************
|
|
subroutine manual_borderat(ilay,nlay,natoms,border,borderat,
|
|
$layeratoms,natomslay,iout,separ,borderstat,borderhand,line3,line4)
|
|
************************************************************************
|
|
* Set used-defined border atoms
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,l,n,ilay,iatoms,jatoms,ispec
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: iout
|
|
integer :: startc
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: separ(0:natoms)
|
|
integer :: nsepar
|
|
integer :: stringsize
|
|
integer :: maxelement
|
|
character(len=1) :: c1
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=16) :: cscr16
|
|
character(len=1) :: line3(4*natoms*8)
|
|
character(len=natoms*4*8) :: line4
|
|
character(len=natoms*4*8) :: border
|
|
logical :: ii,jj,llg
|
|
stringsize=natoms*4*8
|
|
! locate the separators
|
|
separ=0
|
|
call stringseparator(border,stringsize,',',1,separ(1),natoms+1,
|
|
$nsepar,iout)
|
|
if(border.ne.' ') then
|
|
line4=border
|
|
separ(0)=1
|
|
separ(nsepar+1)=stringsize
|
|
do i=0,nsepar
|
|
if(i.eq.0) then
|
|
n=separ(i)
|
|
else
|
|
n=separ(i)+1
|
|
endif
|
|
ii=.true.
|
|
do k=1,3
|
|
startc=n
|
|
if(k.eq.1) c1=':'
|
|
if(k.eq.2) c1='-'
|
|
if(k.eq.3.and.i.eq.nsepar) then
|
|
c1=' '
|
|
else if(k.eq.3.and.i.ne.nsepar) then
|
|
c1=','
|
|
endif
|
|
do while(line3(n).ne.c1.and.n.ne.stringsize
|
|
$ .and.n.ne.separ(i+1))
|
|
n=n+1
|
|
enddo
|
|
cscr16=' '
|
|
call stringfiller(line4,stringsize,startc,n-1,
|
|
$cscr16,16)
|
|
call lowercase(cscr16,cscr16,16)
|
|
cscr16=trim(adjustl(cscr16))
|
|
if(k.eq.1) read(cscr16,*) ispec
|
|
if(k.eq.2) then
|
|
if(cscr16.ne.'x') then
|
|
read(cscr16,*) iatoms
|
|
else
|
|
write(iout,"(' Manually deleted boundary '
|
|
$'is detected. Boundary: 'i2,' Layer: ',i2)")ispec,ilay
|
|
if(borderhand(ilay).eq.'semi') borderstat(ispec,ilay)='D'
|
|
ii=.false.
|
|
borderat(1,ispec,ilay)=0
|
|
borderat(2,ispec,ilay)=0
|
|
endif
|
|
endif
|
|
if(k.eq.3.and.ii) read(cscr16,*) jatoms
|
|
n=n+1
|
|
enddo
|
|
if(ii) then
|
|
! place border atoms in place: 1: layer atom, 2: non-layer atom
|
|
ii=.false.
|
|
jj=.false.
|
|
do n=1,natomslay(ilay)
|
|
if(layeratoms(n,ilay).eq.iatoms) ii=.true.
|
|
if(layeratoms(n,ilay).eq.jatoms) jj=.true.
|
|
enddo
|
|
if(ii.neqv.jj) then
|
|
if(ii) then
|
|
borderat(1,ispec,ilay)=iatoms
|
|
borderat(2,ispec,ilay)=jatoms
|
|
endif
|
|
if(jj) then
|
|
borderat(1,ispec,ilay)=jatoms
|
|
borderat(2,ispec,ilay)=iatoms
|
|
endif
|
|
write(iout,"(' Manually selected boundary atoms '
|
|
$'are detected. Boundary: 'i2,' Layer: ',i2)")ispec,ilay
|
|
if(borderhand(ilay).ne.'auto') borderstat(ispec,ilay)='M'
|
|
else
|
|
write(iout,'(a)') ' Illegal specification of border atoms.'
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
enddo
|
|
endif
|
|
end subroutine manual_borderat
|
|
************************************************************************
|
|
subroutine manual_linkat(ilay,nlay,natoms,linkat,linksym,
|
|
$iout,separ,borderstat,borderhand,line3,line4)
|
|
************************************************************************
|
|
* Set used-defined link atom types
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,l,n,ilay
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: iout
|
|
integer :: startc
|
|
integer :: separ(0:natoms)
|
|
integer :: nsepar
|
|
integer :: ispec
|
|
integer :: stringsize
|
|
integer :: maxelement
|
|
character(len=1) :: line3(3*natoms*8)
|
|
character(len=1) :: c1
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: atsym(1:118)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=16) :: cscr16
|
|
character(len=natoms*3*8) :: line4
|
|
character(len=natoms*3*8) :: linkat
|
|
logical :: ii,jj,llg
|
|
data atsym /
|
|
$ 'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne',
|
|
$ 'Na','Mg','Al','Si','P ','S ','Cl','Ar','K ','Ca',
|
|
$ 'Sc','Ti','V ','Cr','Mn','Fe','Co','Ni','Cu','Zn',
|
|
$ 'Ga','Ge','As','Se','Br','Kr','Rb','Sr','Y ','Zr',
|
|
$ 'Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn',
|
|
$ 'Sb','Te','I ','Xe','Cs','Ba','La','Ce','Pr','Nd',
|
|
$ 'Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',
|
|
$ 'Lu','Hf','Ta','W ','Re','Os','Ir','Pt','Au','Hg',
|
|
$ 'Tl','Pb','Bi','Po','At','Rn','Fr','Ra','Ac','Th',
|
|
$ 'Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm',
|
|
$ 'Md','No','Lr','Rf','Db','Sg','Bh','Hs','Mt','Ds',
|
|
$ 'Rg','Cn','Nh','Fl','Mc','Lv','Ts','Og'/
|
|
stringsize=natoms*3*8
|
|
! locate the separators
|
|
separ=0
|
|
call stringseparator(linkat,stringsize,',',1,separ(1),natoms+1,
|
|
$nsepar,iout)
|
|
if(linkat.ne.' ') then
|
|
line4=linkat
|
|
separ(0)=1
|
|
separ(nsepar+1)=stringsize
|
|
do i=0,nsepar
|
|
if(i.eq.0) then
|
|
n=separ(i)
|
|
else
|
|
n=separ(i)+1
|
|
endif
|
|
do k=1,2
|
|
startc=n
|
|
if(k.eq.1) c1=':'
|
|
if(k.eq.2.and.i.eq.nsepar) then
|
|
c1=' '
|
|
else if(k.eq.2.and.i.ne.nsepar) then
|
|
c1=','
|
|
endif
|
|
do while(line3(n).ne.c1.and.n.ne.stringsize
|
|
$ .and.n.ne.separ(i+1))
|
|
n=n+1
|
|
enddo
|
|
cscr16=' '
|
|
call stringfiller(line4,stringsize,startc,n-1,
|
|
$cscr16,16)
|
|
call lowercase(cscr16,cscr16,16)
|
|
cscr16=trim(adjustl(cscr16))
|
|
if(k.eq.1) read(cscr16,*) ispec
|
|
if(k.eq.2) linksym(ispec,ilay)=trim(adjustl(cscr16))
|
|
n=n+1
|
|
enddo
|
|
call uppercase(linksym(ispec,ilay),linksym(ispec,ilay),1)
|
|
ii=.true.
|
|
do k=1,118
|
|
if(linksym(ispec,ilay).eq.atsym(k)) ii=.false.
|
|
enddo
|
|
if(ii) then
|
|
write(iout,'(a)') ' Illegal specification of link atom type.'
|
|
write(iout,"('Layer: ',i2,', Border: ',i4,'
|
|
$, Link atom type: ',a2)") ilay,ispec,linksym(ispec,ilay)
|
|
call mrccend(1)
|
|
else
|
|
write(iout,"(' Manually selected link atom '
|
|
$'is detected. Boundary: 'i2,' Layer: ',i2)")ispec,ilay
|
|
if(borderhand(ilay).ne.'auto') borderstat(ispec,ilay)='M'
|
|
endif
|
|
enddo
|
|
endif
|
|
end subroutine manual_linkat
|
|
C
|
|
************************************************************************
|
|
subroutine manual_linksd(ilay,nlay,natoms,linksd,linkdist,
|
|
$iout,separ,borderstat,borderhand,line3,line4)
|
|
************************************************************************
|
|
* Set used-defined link atom types
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,l,n,ilay
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: iout
|
|
integer :: startc
|
|
integer :: separ(0:natoms)
|
|
integer :: nsepar
|
|
integer :: ispec
|
|
integer :: stringsize
|
|
integer :: maxelement
|
|
character(len=1) :: c1
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: atsym(1:118)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=16) :: cscr16
|
|
double precision :: linkdist(natoms,nlay)
|
|
character(len=1) :: line3(3*natoms*8)
|
|
character(len=natoms*3*8) :: line4
|
|
character(len=natoms*3*8) :: linksd
|
|
logical ii,jj,llg
|
|
stringsize=natoms*3*8
|
|
! locate the separators
|
|
separ=0
|
|
call stringseparator(linksd,stringsize,',',1,separ(1),natoms+1,
|
|
$nsepar,iout)
|
|
if(linksd.ne.' ') then
|
|
line4=linksd
|
|
separ(0)=1
|
|
separ(nsepar+1)=stringsize
|
|
do i=0,nsepar
|
|
if(i.eq.0) then
|
|
n=separ(i)
|
|
else
|
|
n=separ(i)+1
|
|
endif
|
|
do k=1,2
|
|
startc=n
|
|
if(k.eq.1) c1=':'
|
|
if(k.eq.2.and.i.eq.nsepar) then
|
|
c1=' '
|
|
else if(k.eq.2.and.i.ne.nsepar) then
|
|
c1=','
|
|
endif
|
|
do while(line3(n).ne.c1.and.n.ne.stringsize
|
|
$ .and.n.ne.separ(i+1))
|
|
n=n+1
|
|
enddo
|
|
cscr16=' '
|
|
call stringfiller(line4,stringsize,startc,n-1,
|
|
$cscr16,16)
|
|
cscr16=trim(adjustl(cscr16))
|
|
if(k.eq.1) read(cscr16,*) ispec
|
|
if(k.eq.2) read(cscr16,*) linkdist(ispec,ilay)
|
|
n=n+1
|
|
enddo
|
|
! Check is based on iodine bond lenght (gas phase)
|
|
! https://en.wikipedia.org/wiki/Iodine
|
|
if(linkdist(ispec,ilay).le.0.0d0.or.
|
|
$ linkdist(ispec,ilay).gt.2.66d0) then
|
|
write(iout,'(a)') ' Illegal specification of link atom '//
|
|
$'distance.'
|
|
write(iout,"('Layer: ',i2,', Border: ',i4,'
|
|
$, Link atom distance: ',f7.4)") ilay,ispec,linkdist(ispec,ilay)
|
|
if(linkdist(ispec,ilay).le.0.0d0) write(iout,'(a)')
|
|
$' The link atom distance should be positive.'
|
|
if(linkdist(ispec,ilay).gt.2.66d0) write(iout,'(a)')
|
|
$' The link atom distance is too large for a covalent bond.'
|
|
call mrccend(1)
|
|
else
|
|
write(iout,"(' Manually set link atom distance '
|
|
$'is detected. Boundary: 'i2,' Layer: ',i2)")ispec,ilay
|
|
if(borderhand(ilay).ne.'auto') borderstat(ispec,ilay)='M'
|
|
endif
|
|
enddo
|
|
endif
|
|
end subroutine manual_linksd
|
|
C
|
|
************************************************************************
|
|
subroutine stringseparator(string,stringlen,ssepar,sseparlen,
|
|
$seploc,maxsepar,nspecloc,iout)
|
|
************************************************************************
|
|
* Determines the separator places in the input string
|
|
************************************************************************
|
|
implicit none
|
|
integer :: stringlen
|
|
integer :: nspecloc
|
|
integer :: sseparlen
|
|
integer :: n
|
|
integer :: maxsepar
|
|
integer :: iout
|
|
integer :: seploc(maxsepar)
|
|
character(len=1) :: string(stringlen)
|
|
character(len=sseparlen) :: ssepar
|
|
nspecloc=0
|
|
do n=1,stringlen
|
|
if(string(n).eq.ssepar) then
|
|
nspecloc=nspecloc+1
|
|
if(nspecloc.gt.maxsepar) then
|
|
write(iout,'(a)') '@stringseparator: Fatal error during ',
|
|
$'string separation!'
|
|
call mrccend(1)
|
|
endif
|
|
seploc(nspecloc)=n
|
|
endif
|
|
enddo
|
|
end subroutine stringseparator
|
|
C
|
|
************************************************************************
|
|
subroutine stringfiller(instring,instringlen,startc,endc,
|
|
$outstring,outstringlen)
|
|
************************************************************************
|
|
* Fills the outputstring with some part of the string
|
|
************************************************************************
|
|
implicit none
|
|
integer :: instringlen
|
|
integer :: startc,endc
|
|
integer :: n,k
|
|
integer :: outstringlen
|
|
character(len=1) :: instring(instringlen)
|
|
character(len=1) :: outstring(outstringlen)
|
|
k=0
|
|
do n=startc,endc
|
|
if((k.gt.outstringlen).or.(k.gt.instringlen)) exit
|
|
if(instring(n).ne.' ') then
|
|
k=k+1
|
|
outstring(k)=instring(n)
|
|
endif
|
|
enddo
|
|
end subroutine stringfiller
|
|
C
|
|
************************************************************************
|
|
subroutine set_linkdist(nlay,natoms,natwdummy,borderat,nborders,
|
|
$iout,linksym,linkdist,borderhand,atsymbol,borderstat,uval,
|
|
$angtobohr)
|
|
************************************************************************
|
|
* Set default link atom distances
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,iborder,ilay
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: iout
|
|
integer :: nborders(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=4) :: uval
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: angtobohr
|
|
logical :: llg
|
|
! set default link atom distances
|
|
write(iout,'(a)') ' Setting the distance between link atoms',
|
|
$' and layer atoms...'
|
|
llg=.true.
|
|
do ilay=2,nlay
|
|
if(borderhand(ilay).ne.'manu') then
|
|
do iborder=1,nborders(ilay)
|
|
if(borderstat(iborder,ilay).eq.'A') then
|
|
call uppercase(atsymbol(borderat(1,iborder,ilay)),
|
|
$ atsymbol(borderat(1,iborder,ilay)),1)
|
|
call uppercase(atsymbol(borderat(2,iborder,ilay)),
|
|
$ atsymbol(borderat(2,iborder,ilay)),1)
|
|
call set_bonddist(atsymbol(borderat(1,iborder,ilay)),
|
|
$linksym(iborder,ilay),linkdist(iborder,ilay),llg,uval,angtobohr)
|
|
endif
|
|
enddo
|
|
endif
|
|
enddo
|
|
if(.not.llg) then
|
|
write(iout,'(a)') ' Cannot set link atom distance automatically.'
|
|
call mrccend(1)
|
|
endif
|
|
write(iout,'(a)') ' Done.'
|
|
end subroutine set_linkdist
|
|
C
|
|
CCCC
|
|
subroutine set_bonddist(iatoms,jatoms,atomdist,llg,uval,angtobohr)
|
|
************************************************************************
|
|
* Determine bond distance
|
|
************************************************************************
|
|
implicit none
|
|
character(len=2) :: iatoms,jatoms
|
|
character(len=4) :: uval
|
|
double precision :: atomdist
|
|
double precision :: angtobohr
|
|
logical :: llg
|
|
! based on average bond distances: https://cccbdb.nist.gov/expbondlengths1.asp (angstrom)
|
|
! ##################### jatoms = 'H ' ######################
|
|
! 3:Li-H
|
|
if (iatoms.eq.'Li'.and.jatoms.eq.'H ') then
|
|
atomdist=1.595d0
|
|
! 4:Be-H
|
|
else if(iatoms.eq.'Be'.and.jatoms.eq.'H ') then
|
|
atomdist=1.335d0
|
|
! 5:B-H
|
|
else if(iatoms.eq.'B '.and.jatoms.eq.'H ') then
|
|
atomdist=1.221d0
|
|
! 6:C-H
|
|
else if(iatoms.eq.'C '.and.jatoms.eq.'H ') then
|
|
atomdist=1.093d0
|
|
! 7:N-H
|
|
else if(iatoms.eq.'N '.and.jatoms.eq.'H ') then
|
|
atomdist=1.009d0
|
|
! 8:O-H
|
|
else if(iatoms.eq.'O '.and.jatoms.eq.'H ') then
|
|
atomdist=0.966d0
|
|
! 9:F-H
|
|
else if(iatoms.eq.'F '.and.jatoms.eq.'H ') then
|
|
atomdist=0.966d0
|
|
! 11:Na-H
|
|
else if(iatoms.eq.'Na'.and.jatoms.eq.'H ') then
|
|
atomdist=1.887d0
|
|
! 12:Mg-H
|
|
else if(iatoms.eq.'Mg'.and.jatoms.eq.'H ') then
|
|
atomdist=1.691d0
|
|
! 13:Al-H
|
|
else if(iatoms.eq.'Al'.and.jatoms.eq.'H ') then
|
|
atomdist=1.613d0
|
|
! 14:Si-H
|
|
else if(iatoms.eq.'Si'.and.jatoms.eq.'H ') then
|
|
atomdist=1.483d0
|
|
! 15:P-H
|
|
else if(iatoms.eq.'P '.and.jatoms.eq.'H ') then
|
|
atomdist=1.423d0
|
|
! 16:S-H
|
|
else if(iatoms.eq.'S '.and.jatoms.eq.'H ') then
|
|
atomdist=1.346d0
|
|
! 17:Cl-H
|
|
else if(iatoms.eq.'Cl'.and.jatoms.eq.'H ') then
|
|
atomdist=1.295d0
|
|
! 19:K-H
|
|
else if(iatoms.eq.'K '.and.jatoms.eq.'H ') then
|
|
atomdist=2.243d0
|
|
! 20:Ca-H
|
|
else if(iatoms.eq.'Ca'.and.jatoms.eq.'H ') then
|
|
atomdist=2.003d0
|
|
! 21:Sc-H
|
|
else if(iatoms.eq.'Sc'.and.jatoms.eq.'H ') then
|
|
atomdist=1.775d0
|
|
! 22:Ti-H
|
|
else if(iatoms.eq.'Ti'.and.jatoms.eq.'H ') then
|
|
atomdist=1.785d0
|
|
! 24:Cr-H
|
|
else if(iatoms.eq.'Cr'.and.jatoms.eq.'H ') then
|
|
atomdist=1.655d0
|
|
! 29:Cu-H
|
|
else if(iatoms.eq.'Cu'.and.jatoms.eq.'H ') then
|
|
atomdist=1.463d0
|
|
! 30:Zn-H
|
|
else if(iatoms.eq.'Zn'.and.jatoms.eq.'H ') then
|
|
atomdist=1.565d0
|
|
! 31:Ga-H
|
|
else if(iatoms.eq.'Ga'.and.jatoms.eq.'H ') then
|
|
atomdist=1.663d0
|
|
! 32:Ge-H
|
|
else if(iatoms.eq.'Ge'.and.jatoms.eq.'H ') then
|
|
atomdist=1.568d0
|
|
! 33:As-H
|
|
else if(iatoms.eq.'As'.and.jatoms.eq.'H ') then
|
|
atomdist=1.523d0
|
|
! 34:Se-H
|
|
else if(iatoms.eq.'Zn'.and.jatoms.eq.'H ') then
|
|
atomdist=1.469d0
|
|
! 35:Br-H
|
|
else if(iatoms.eq.'Br'.and.jatoms.eq.'H ') then
|
|
atomdist=1.431d0
|
|
! 114:I-H
|
|
else if(iatoms.eq.'I '.and.jatoms.eq.'H ') then
|
|
atomdist=1.609d0
|
|
! ##################### jatoms = 'O ' ######################
|
|
! ( only double bonds )
|
|
! 4:Be-O
|
|
else if(iatoms.eq.'Be'.and.jatoms.eq.'O ') then
|
|
atomdist=1.331d0
|
|
! 5:B-O
|
|
else if(iatoms.eq.'B '.and.jatoms.eq.'O ') then
|
|
atomdist=1.223d0
|
|
! 6:C-O
|
|
else if(iatoms.eq.'C '.and.jatoms.eq.'O ') then
|
|
atomdist=1.197d0
|
|
! 7:N-O
|
|
else if(iatoms.eq.'N '.and.jatoms.eq.'O ') then
|
|
atomdist=1.184d0
|
|
! 12:Mg-O
|
|
else if(iatoms.eq.'Mg'.and.jatoms.eq.'O ') then
|
|
atomdist=1.758d0
|
|
! 15:P-O
|
|
else if(iatoms.eq.'P '.and.jatoms.eq.'O ') then
|
|
atomdist=1.468d0
|
|
! 16:S-O
|
|
else if(iatoms.eq.'S '.and.jatoms.eq.'O ') then
|
|
atomdist=1.435d0
|
|
! 20:Ca-O
|
|
else if(iatoms.eq.'Ca'.and.jatoms.eq.'O ') then
|
|
atomdist=1.899d0
|
|
! 21:Sc-O
|
|
else if(iatoms.eq.'Sc'.and.jatoms.eq.'O ') then
|
|
atomdist=1.668d0
|
|
! 22:Ti-O
|
|
else if(iatoms.eq.'Ti'.and.jatoms.eq.'O ') then
|
|
atomdist=1.620d0
|
|
! 23:V-O
|
|
else if(iatoms.eq.'V '.and.jatoms.eq.'O ') then
|
|
atomdist=1.589d0
|
|
! 29:Cu-O
|
|
else if(iatoms.eq.'Cu'.and.jatoms.eq.'O ') then
|
|
atomdist=1.724d0
|
|
! 31:Ga-O
|
|
else if(iatoms.eq.'Ga'.and.jatoms.eq.'O ') then
|
|
atomdist=1.743d0
|
|
! ##################### jatoms = ' N' ######################
|
|
! ( only triple bonds )
|
|
! 6:C-N
|
|
else if(iatoms.eq.'C '.and.jatoms.eq.'N ') then
|
|
atomdist=1.160d0
|
|
! 15:P-N
|
|
else if(iatoms.eq.'P '.and.jatoms.eq.'N ') then
|
|
atomdist=1.491d0
|
|
else
|
|
llg=.false.
|
|
endif
|
|
if(uval.eq.'bohr') atomdist=atomdist/angtobohr
|
|
end subroutine set_bonddist
|
|
C
|
|
************************************************************************
|
|
subroutine set_linkcoords(nlay,natwdummy,natoms,coord,borderat,
|
|
$iout,linkdist,nborders,borderstat,linkcoord,nlinks,linksym,
|
|
$slinksym,ncent)
|
|
************************************************************************
|
|
* Place link atoms to layer borders
|
|
************************************************************************
|
|
implicit none
|
|
integer :: ilay,xyz,iborder,layerat,nonlayerat
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: ncent
|
|
integer :: iout
|
|
integer :: nborders(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: slinksym(natoms,nlay)
|
|
double precision :: coord(3,ncent)
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: rij
|
|
do ilay=2,nlay
|
|
do iborder=1,natoms
|
|
if(borderstat(iborder,ilay).ne.' '.and.
|
|
$ borderstat(iborder,ilay).ne.'D') then
|
|
rij=0.0d0
|
|
nlinks(ilay)=nlinks(ilay)+1
|
|
slinksym(nlinks(ilay),ilay)=linksym(iborder,ilay)
|
|
layerat=borderat(1,iborder,ilay)
|
|
nonlayerat=borderat(2,iborder,ilay)
|
|
rij=sqrt((coord(1,nonlayerat)-coord(1,layerat))**2.0d0
|
|
$ +(coord(2,nonlayerat)-coord(2,layerat))**2.0d0
|
|
$ +(coord(3,nonlayerat)-coord(3,layerat))**2.0d0)
|
|
if(rij.ne.0.0d0) then
|
|
do xyz=1,3
|
|
linkcoord(xyz,nlinks(ilay),ilay)=
|
|
$(coord(xyz,nonlayerat)-coord(xyz,layerat))*linkdist(iborder,ilay)
|
|
$/rij+coord(xyz,layerat)
|
|
enddo
|
|
else
|
|
write(iout,'(a)') ' @set_linkcoords: Fatal error during the',
|
|
$' positioning of link atoms.'
|
|
write(iout,'(a)') ' The distance between the',
|
|
$' inner layer and the outer layer atoms is zero!'
|
|
call mrccend(1)
|
|
endif
|
|
endif
|
|
enddo
|
|
enddo
|
|
end subroutine set_linkcoords
|
|
C
|
|
************************************************************************
|
|
subroutine fill_coords(natoms,natwdummy,nlay,ilay,natomslay,
|
|
$layeratoms,icent,coord,scoord,atsymbol,satsymbol,nlinks,linkcoord,
|
|
$linksym,qmmm,ncent,atchg,satchg,oniomtype,eecharge,ccoord,
|
|
$ncharge)
|
|
************************************************************************
|
|
* Fill the geometry and charge related arrays to generate MINP
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,ilay,iatom
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: icent
|
|
integer :: ncent
|
|
integer :: natwdummy
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
integer :: ncharge(nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: satsymbol(natwdummy)
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: qmmm
|
|
double precision :: coord(3,ncent)
|
|
double precision :: scoord(3,ncent)
|
|
double precision :: ccoord(3,ncent)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: eecharge(natoms)
|
|
double precision :: atchg(ncent)
|
|
double precision :: satchg(ncent)
|
|
logical :: notlayerat
|
|
icent=0
|
|
ncharge(ilay)=0
|
|
! Set coordinates and atomic symbols for layer atoms
|
|
do iatom=1,natoms
|
|
do i=1,natomslay(ilay)
|
|
if(iatom.eq.layeratoms(i,ilay)) then
|
|
icent=icent+1
|
|
scoord(1:3,icent)=coord(1:3,iatom)
|
|
satsymbol(icent)=atsymbol(iatom)
|
|
endif
|
|
enddo
|
|
enddo
|
|
! Set coordinates and atomic symbols for link atoms
|
|
if(nlinks(ilay).gt.0) then
|
|
do iatom=1,nlinks(ilay)
|
|
icent=icent+1
|
|
scoord(1:3,icent)=linkcoord(1:3,iatom,ilay)
|
|
satsymbol(icent)=linksym(iatom,ilay)
|
|
enddo
|
|
endif
|
|
! Set point charge list for electronic embedding
|
|
if(oniomtype.eq.'ee') then
|
|
do iatom=1,natoms
|
|
notlayerat=.true.
|
|
do i=1,natomslay(ilay)
|
|
if(iatom.eq.layeratoms(i,ilay)) notlayerat=.false.
|
|
enddo
|
|
if(notlayerat) then
|
|
ncharge(ilay)=ncharge(ilay)+1
|
|
ccoord(1:3,ncharge(ilay))=coord(1:3,iatom)
|
|
satchg(ncharge(ilay))=eecharge(iatom)
|
|
endif
|
|
enddo
|
|
endif
|
|
! Set point charge list for QM/MM
|
|
if(qmmm.eq.'amber') then
|
|
do iatom=natoms+1,ncent
|
|
ncharge(ilay)=ncharge(ilay)+1
|
|
ccoord(1:3,ncharge(ilay))=coord(1:3,iatom)
|
|
satchg(ncharge(ilay))=atchg(iatom)
|
|
enddo
|
|
endif
|
|
end subroutine fill_coords
|
|
C
|
|
************************************************************************
|
|
subroutine collect_and_print_results(nsp,nlay,imet,ibas,iout,
|
|
$scrfile1,minpfile,finalener,iprog,autokcal,embedalg,corembedalg,
|
|
$embedlow,corembedlow,oniomtype,qmmm,cput,walt)
|
|
************************************************************************
|
|
* Collect and print ONIOM energy components
|
|
************************************************************************
|
|
implicit none
|
|
integer :: nsp,level,ilay,isp,i,j
|
|
integer :: scrfile1
|
|
integer :: iout
|
|
integer :: nlay
|
|
integer :: minpfile
|
|
integer :: ios
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: cscr8
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=8) :: qmmm
|
|
character(len=15) :: cscr15,c15
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: embedlow
|
|
character(len=32) :: corembedlow
|
|
character(len=40) :: cscr40
|
|
double precision :: oniomener(nsp)
|
|
double precision :: finalener
|
|
double precision :: selfener
|
|
double precision :: pcener
|
|
double precision :: sumwall
|
|
double precision :: autokcal
|
|
double precision :: cputime
|
|
double precision :: walltime
|
|
double precision :: sumcpu
|
|
double precision :: cput(nsp)
|
|
double precision :: walt(nsp)
|
|
double precision :: rscr
|
|
double precision :: rscrvec(2)
|
|
logical :: llg
|
|
finalener=0.0d0
|
|
sumcpu=0.0d0
|
|
sumwall=0.0d0
|
|
oniomener=0.0d0
|
|
finalener=0.0d0
|
|
selfener=0.0d0
|
|
write(iout,*)
|
|
write(iout,"(' ======================= FINAL ONIOM RESULTS '
|
|
$'==========================')")
|
|
write(iout,'(a)') ' Calc. Layer '//
|
|
$' Level Energy[AU]'
|
|
ilay=1
|
|
level=0
|
|
open(unit=minpfile,file='iface',status='replace')
|
|
write(minpfile,"(68a)")
|
|
$'#property method sym st mul value' //
|
|
$' CPU(sec) Wall(sec)'
|
|
EVAL_ENER_MAIN_LOOP:
|
|
$ do isp=1,nsp ! Main loop starts
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
write(cscr2,'(i2)') isp
|
|
cscr15='iface.'//trim(adjustl(cscr2))
|
|
if(iprog(isp).eq.'MOPAC2016.exe')
|
|
$cscr15='MINP.'//trim(adjustl(cscr2))//'.aux'
|
|
if(iprog(isp).eq.'xtb')
|
|
$cscr15='MINP.'//trim(adjustl(cscr2))//'.gradient'
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
write(iout,'(3a)')
|
|
$' Error! File '//trim(adjustl(cscr15))//' is missing for '//
|
|
$'energy evaluation.'
|
|
call mrccend(1)
|
|
endif
|
|
! Extract pc self energy for amber
|
|
if(qmmm.ne.'off') then
|
|
if(iprog(1).eq.'MOPAC2016.exe') selfener=0.0d0 ! no embedding for mopac
|
|
if(iprog(1).eq.'xtb') selfener=0.0d0 ! xtb does not give self energy (returns the correct subsystem energy)
|
|
if(iprog(1).eq.'mrcc') then
|
|
c15='VARS.1'
|
|
inquire(file=c15,exist=llg)
|
|
if(.not.llg) then
|
|
write(iout,'(3a)')
|
|
$' Error! File '//trim(adjustl(c15))//' is missing for '//
|
|
$'energy evaluation.'
|
|
call mrccend(1)
|
|
endif
|
|
call ishell('cp '//trim(adjustl(c15))//' VARS')
|
|
selfener=0.0d0
|
|
call getvar('selfenergy',selfener)
|
|
endif
|
|
endif
|
|
EVAL_ENER_PROG_SELECT:
|
|
$ if(iprog(isp).eq.'mrcc') then
|
|
open(unit=scrfile1,file=cscr15,status='old')
|
|
read(scrfile1,*)
|
|
i=0
|
|
do
|
|
read(scrfile1,*,end=7597)
|
|
i=i+1
|
|
enddo
|
|
7597 rewind(scrfile1)
|
|
do j=1,i
|
|
read(scrfile1,*)
|
|
enddo
|
|
read(scrfile1,7596) cscr8,cscr15,i,i,i,oniomener(isp),
|
|
$cputime,walltime
|
|
7596 format(a8,1x,a15,1x,3(i2,1x),1pe23.15,2(1pe15.8))
|
|
! Correct self energy in the case of electronic embedding
|
|
if((oniomtype.eq.'ee'.and.isp.gt.1).or.
|
|
$ (qmmm.ne.'off'.and.isp.gt.1)) then
|
|
c15='VARS.'//trim(adjustl(cscr2))
|
|
inquire(file=c15,exist=llg)
|
|
if(.not.llg) then
|
|
write(iout,'(3a)')
|
|
$' Error! File '//trim(adjustl(c15))//' is missing for '//
|
|
$'energy evaluation.'
|
|
call mrccend(1)
|
|
endif
|
|
call ishell('cp '//trim(adjustl(c15))//' VARS')
|
|
pcener=0.0d0
|
|
call getvar('selfenergy',pcener)
|
|
oniomener(isp)=oniomener(isp)-pcener
|
|
endif
|
|
write(minpfile,7596) cscr8,cscr15,i,i,i,oniomener(isp),
|
|
$cputime,walltime
|
|
sumcpu=sumcpu+cputime
|
|
sumwall=sumwall+walltime
|
|
close(scrfile1)
|
|
else if(iprog(isp).eq.'MOPAC2016.exe') then
|
|
sumcpu=sumcpu+cput(isp)
|
|
sumwall=sumwall+walt(isp)
|
|
call read_mopac_aux(cscr2,scrfile1,1,oniomener(isp),
|
|
$'horizo',' HEAT_OF_FORMATION:',19)
|
|
oniomener(isp)=oniomener(isp)/autokcal
|
|
write(minpfile,7596) 'ENERGY ','MOPAC-SCF ',1,1,1,
|
|
$oniomener(isp),sumcpu,sumwall
|
|
else if(iprog(isp).eq.'xtb') then
|
|
sumcpu=sumcpu+cput(isp)
|
|
sumwall=sumwall+walt(isp)
|
|
open(unit=scrfile1,file=cscr15,status='old')
|
|
rewind(scrfile1)
|
|
read(scrfile1,*)
|
|
read(scrfile1,*)
|
|
$cscr8,cscr8,i,cscr8,cscr8,cscr8,oniomener(isp)
|
|
close(scrfile1)
|
|
write(minpfile,7596) 'ENERGY ','XTB-SCF ',1,1,1,
|
|
$oniomener(isp),sumcpu,sumwall
|
|
endif EVAL_ENER_PROG_SELECT
|
|
if(MOD(isp,2).eq.0) then
|
|
finalener=finalener-oniomener(isp)
|
|
else
|
|
finalener=finalener+oniomener(isp)
|
|
endif
|
|
if(imet(level).ne.'gfn-ff') then
|
|
cscr40=trim(adjustl(imet(level)))//'/'//
|
|
$trim(adjustl(ibas(level)))
|
|
if(isp.eq.nsp) then
|
|
if(embedalg.ne.'off '.and.corembedalg.ne.'off ') then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(corembedlow))//
|
|
$ '-in-'//trim(adjustl(embedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
else if(embedalg.eq.'off '.and.corembedalg.ne.'off ')
|
|
$then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(corembedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
else if(embedalg.ne.'off '.and.corembedalg.eq.'off ')
|
|
$then
|
|
cscr40= trim(adjustl(imet(nlay)))//
|
|
$ '-in-'//trim(adjustl(embedlow))//'/'//
|
|
$ trim(adjustl(ibas(level)))
|
|
endif
|
|
endif
|
|
else
|
|
cscr40=trim(adjustl(imet(level)))
|
|
endif
|
|
write(iout,"(1x,i4,4x,i4,9x,a24,1x,f24.16)")
|
|
$isp, ilay,cscr40,
|
|
$oniomener(isp)
|
|
enddo EVAL_ENER_MAIN_LOOP
|
|
close(minpfile)
|
|
write(iout,*)
|
|
write(iout,"(' ***FINAL ONIOM ENERGY: ',F24.16,' [AU]')")
|
|
$finalener
|
|
write(iout,*)
|
|
write(iout,'(a)') ' ==============================================
|
|
$========================'
|
|
open(unit=scrfile1,file='iface',status='old',position='append')
|
|
write(scrfile1,7596) 'ENERGY ','ONIOMENER ',1,1,1,
|
|
$finalener,sumcpu,sumwall
|
|
close(scrfile1)
|
|
if(qmmm.eq.'amber') then
|
|
call write_dat_file_for_amber(finalener,selfener,1,
|
|
$i,i,rscrvec,rscrvec,rscr,rscr,rscr)
|
|
call ishell('cp mrcc_job.dat mrcc_job.dat.composite')
|
|
endif
|
|
end subroutine collect_and_print_results
|
|
C
|
|
************************************************************************
|
|
subroutine get_keylist(minpfile,istring,stringsize,scrfile1,nkeys)
|
|
************************************************************************
|
|
* Collect the user-specified keywords from the minp file
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j
|
|
integer :: stringsize
|
|
integer :: nkeys
|
|
integer :: scrfile1
|
|
integer :: minpfile
|
|
character(len=stringsize) :: istring
|
|
character(len=1) :: line1(512)
|
|
character(len=1) :: cscr64v(64)
|
|
character(len=64) :: cscr64
|
|
character(len=512) :: line
|
|
equivalence(line,line1)
|
|
equivalence(cscr64,cscr64v)
|
|
istring=' '
|
|
nkeys=0
|
|
! read keyword list from the MINP file
|
|
open(minpfile,file='MINP',status='OLD')
|
|
rewind(minpfile)
|
|
do
|
|
read(minpfile,'(512a1)',end=1000) line1
|
|
call lowercase(line,line,512)
|
|
line=adjustl(line)
|
|
if(line1(1).ne.' ') then
|
|
i=1
|
|
cscr64=' '
|
|
do while(line1(i).ne.'='.and.i.ne.64)
|
|
cscr64v(i)=line1(i)
|
|
i=i+1
|
|
enddo
|
|
! read keyword from KEYWD file
|
|
open(scrfile1,file='KEYWD')
|
|
rewind(scrfile1)
|
|
do
|
|
read(scrfile1,'(512a1)',end=1001) line1
|
|
call lowercase(line,line,512)
|
|
line=adjustl(line)
|
|
j=1
|
|
do while(line1(j).ne.'='.and.j.ne.512)
|
|
j=j+1
|
|
enddo
|
|
! add keyword if it is specified in both lists
|
|
if(trim(adjustl(cscr64)).eq.line(1:j-1)) then
|
|
nkeys=nkeys+1
|
|
istring=trim(adjustl(istring))//' '//trim(adjustl(cscr64))
|
|
endif
|
|
enddo
|
|
1001 continue
|
|
close(scrfile1)
|
|
endif
|
|
enddo
|
|
1000 continue
|
|
close(minpfile)
|
|
end subroutine get_keylist
|
|
C
|
|
************************************************************************
|
|
subroutine get_pcmkeylist(minpfile,pcmkeystring,stringsize,
|
|
$npcmdefkeys,pcmkeys,npcmkeys)
|
|
************************************************************************
|
|
* Collect the user-specified keywords from the minp file
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k
|
|
integer :: minpfile
|
|
integer :: stringsize
|
|
integer :: npcmdefkeys
|
|
integer :: npcmkeys
|
|
character(len=stringsize) :: pcmkeystring
|
|
character(len=stringsize) :: pcmkeys
|
|
character(len=1) :: line1(512)
|
|
character(len=1) :: cscr64v(64)
|
|
character(len=64) :: cscr64
|
|
character(len=64) :: cscr
|
|
character(len=512) :: line
|
|
logical :: llg
|
|
equivalence(line,line1)
|
|
equivalence(cscr64,cscr64v)
|
|
pcmkeystring=' '
|
|
npcmdefkeys=0
|
|
! read keyword list from the MINP file
|
|
open(minpfile,file='MINP',status='OLD',position='REWIND')
|
|
do
|
|
llg=.false.
|
|
read(minpfile,'(512a1)',end=1000) line1
|
|
call lowercase(line,line,512)
|
|
line=adjustl(line)
|
|
if(line1(1).ne.' ') then
|
|
i=1
|
|
cscr64=' '
|
|
do while(line1(i).ne.'='.and.i.ne.64)
|
|
cscr64v(i)=line1(i)
|
|
i=i+1
|
|
enddo
|
|
! read keyword from PCM key list
|
|
do j=1,npcmkeys
|
|
if(j.eq.1) then
|
|
read(pcmkeys,*) cscr
|
|
else
|
|
read(pcmkeys,*) (line1(k),k=1,j-1),cscr
|
|
endif
|
|
if(trim(adjustl(cscr64)).eq.trim(adjustl(cscr))) llg=.true.
|
|
enddo
|
|
if(llg) then
|
|
pcmkeystring=trim(adjustl(pcmkeystring))//' '
|
|
$ //trim(adjustl(cscr64))
|
|
npcmdefkeys=npcmdefkeys+1
|
|
endif
|
|
endif
|
|
enddo
|
|
1000 continue
|
|
close(minpfile)
|
|
end subroutine get_pcmkeylist
|
|
C
|
|
************************************************************************
|
|
subroutine get_nonmust_keylist(istring,stringsize,nkeys,
|
|
$fstring,fstringsize,nkeysnon)
|
|
************************************************************************
|
|
* Filter out those keywords which are controlled by the oniom run
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,k,j
|
|
integer :: stringsize
|
|
integer :: nkeys
|
|
integer :: fstringsize
|
|
integer :: noutkeys
|
|
integer :: nkeysnon
|
|
character(len=1) :: line1(512)
|
|
character(len=64) :: cscr
|
|
character(len=64) :: cscr2
|
|
character(len=512) :: line
|
|
character(len=stringsize) :: istring
|
|
character(len=stringsize) :: cscrstring
|
|
character(len=fstringsize) :: fstring
|
|
logical :: llg
|
|
equivalence(line,line1)
|
|
noutkeys=0
|
|
cscrstring=istring
|
|
istring=' '
|
|
do i=1,nkeys
|
|
llg=.true.
|
|
if(i.eq.1) then
|
|
read(cscrstring,*) cscr
|
|
else
|
|
read(cscrstring,*) (line1(k),k=1,i-1),cscr
|
|
endif
|
|
do j=1,nkeysnon
|
|
if(j.eq.1) then
|
|
read(fstring,*) cscr2
|
|
else
|
|
read(fstring,*) (line1(k),k=1,j-1),cscr2
|
|
endif
|
|
if(trim(adjustl(cscr)).eq.trim(adjustl(cscr2))) llg=.false.
|
|
enddo
|
|
if(llg) then
|
|
istring=trim(adjustl(istring))//' '//trim(adjustl(cscr))
|
|
else
|
|
nkeys=nkeys-1
|
|
endif
|
|
enddo
|
|
end subroutine get_nonmust_keylist
|
|
C
|
|
************************************************************************
|
|
subroutine get_complete_keys(minpfile,istring,istringsize,
|
|
$nkeys)
|
|
************************************************************************
|
|
* Add value to the remaining keywords
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,k
|
|
integer :: nkeys
|
|
integer :: minpfile
|
|
integer :: istringsize
|
|
character(len=1) :: line1(512)
|
|
character(len=64) :: cscr,cscr2
|
|
character(len=512) :: line,linex
|
|
character(len=istringsize) :: istring
|
|
character(len=istringsize) :: cscrstring
|
|
logical :: llg
|
|
equivalence(line,line1)
|
|
cscrstring=' '
|
|
open(minpfile,file='MINP',status='OLD')
|
|
do i=1,nkeys
|
|
linex=' '
|
|
if(i.eq.1) then
|
|
read(istring,*) line
|
|
else
|
|
read(istring,*) (line1(k),k=1,i-1),line
|
|
endif
|
|
line=trim(adjustl(line))
|
|
k=1
|
|
do while(line1(k+1).ne.' ')
|
|
k=k+1
|
|
enddo
|
|
call getkeym(line,k,linex,512)
|
|
line=trim(adjustl(line))//'='//trim(adjustl(linex))
|
|
cscrstring=trim(adjustl(cscrstring))//' '//trim(adjustl(line))
|
|
enddo
|
|
close(minpfile)
|
|
istring=cscrstring
|
|
end subroutine get_complete_keys
|
|
C
|
|
************************************************************************
|
|
subroutine write_oniomspec(scrfile1,nlay,nborders,borderstat,
|
|
$borderat,linksym,linkdist,natoms,eecharge,natomslay,layeratoms,
|
|
$imet,ibas,ichg,imul,borderhand,nkeys,keywstring,npcmdefkeys,
|
|
$pcmkeystring,kstringlen,pcmstringlen,nsp,iprog,oniomtype,embedalg,
|
|
$corembedalg,embedatstringsize,embedatstring,corembedatstringsize,
|
|
$corembedatstring,embedlow,corembedlow,eorbselecto,eorbselectv,
|
|
$corbselecto,usetemp,do_mm)
|
|
************************************************************************
|
|
* Save ONIOM specifications
|
|
************************************************************************
|
|
implicit none
|
|
integer :: ilay,j,k,isp
|
|
integer :: scrfile1
|
|
integer :: nlay
|
|
integer :: natoms
|
|
integer :: nkeys
|
|
integer :: nsp
|
|
integer :: kstringlen
|
|
integer :: pcmstringlen
|
|
integer :: npcmdefkeys
|
|
integer :: nborders(nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: ichg(nlay)
|
|
integer :: imul(nlay)
|
|
integer :: embedatstringsize
|
|
integer :: corembedatstringsize
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: eecharge(natoms,nlay)
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: embedlow,corembedlow
|
|
character(len=64) :: eorbselecto,eorbselectv,corbselecto
|
|
character(len=kstringlen) :: keywstring
|
|
character(len=pcmstringlen) :: pcmkeystring
|
|
character(len=embedatstringsize) :: embedatstring
|
|
character(len=corembedatstringsize) :: corembedatstring
|
|
logical :: usetemp
|
|
logical :: do_mm
|
|
! write layer/method settings
|
|
open(scrfile1,file='ONIOMSPEC',form='UNFORMATTED')
|
|
write(scrfile1) 'LAYERSPEC'
|
|
write(scrfile1) nlay
|
|
do ilay=1,nlay
|
|
write(scrfile1) natomslay(ilay)
|
|
write(scrfile1) (layeratoms(k,ilay),k=1,natomslay(ilay))
|
|
write(scrfile1) imet(ilay),ibas(ilay),ichg(ilay),imul(ilay),
|
|
$borderhand(ilay)
|
|
enddo
|
|
! write filtered keywords
|
|
write(scrfile1) 'KEYS'
|
|
write(scrfile1) nkeys,keywstring
|
|
write(scrfile1) npcmdefkeys,pcmkeystring
|
|
write(scrfile1) usetemp,do_mm
|
|
! write border settings
|
|
write(scrfile1) 'ONIOMBORDER'
|
|
do ilay=2,nlay
|
|
write(scrfile1) nborders(ilay)
|
|
do j=1,nborders(ilay)
|
|
write(scrfile1) j
|
|
write(scrfile1) borderstat(j,ilay),
|
|
$borderat(1,j,ilay),borderat(2,j,ilay),
|
|
$linksym(j,ilay),linkdist(j,ilay)
|
|
enddo
|
|
enddo
|
|
! write executable-related settings
|
|
write(scrfile1) 'EXE'
|
|
do isp=1,nsp
|
|
write(scrfile1) iprog(isp)
|
|
enddo
|
|
! write point charges in the case of electronic embedding
|
|
write(scrfile1) 'CHARGES'
|
|
write(scrfile1) natoms
|
|
if(oniomtype.eq.'ee') then
|
|
do ilay=1,nlay
|
|
write(scrfile1) (eecharge(j,ilay),j=1,natoms)
|
|
enddo
|
|
endif
|
|
write(scrfile1) 'EMBED'
|
|
write(scrfile1) embedalg
|
|
write(scrfile1) embedatstring
|
|
write(scrfile1) embedlow
|
|
write(scrfile1) eorbselecto
|
|
write(scrfile1) eorbselectv
|
|
write(scrfile1) 'COREMBED'
|
|
write(scrfile1) corembedalg
|
|
write(scrfile1) corembedatstring
|
|
write(scrfile1) corembedlow
|
|
write(scrfile1) corbselecto
|
|
close(scrfile1)
|
|
end subroutine write_oniomspec
|
|
C
|
|
************************************************************************
|
|
subroutine read_oniomspec(scrfile1,nlay,natwdummy,natoms,
|
|
$layeratoms,natomslay,imet,ibas,ichg,imul,borderat,borderhand,
|
|
$linksym,linkdist,borderstat,keywstring,kstringlen,nkeys,pcmstring,
|
|
$pcmstringlen,npcmdefkeys,eecharge,nsp,iprog,oniomtype,embedalg,
|
|
$corembedalg,embedatstringsize,embedatstring,corembedatstringsize,
|
|
$corembedatstring,embedlow,corembedlow,eorbselecto,eorbselectv,
|
|
$corbselecto,usetemp,do_mm)
|
|
************************************************************************
|
|
* Read variables which were previously set
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k,ilay,isp,iborder
|
|
integer :: scrfile1
|
|
integer :: nlay
|
|
integer :: natwdummy
|
|
integer :: natoms
|
|
integer :: kstringlen
|
|
integer :: nsp
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: ichg(nlay)
|
|
integer :: imul(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nborder
|
|
integer :: nkeys
|
|
integer :: npcmdefkeys
|
|
integer :: pcmstringlen
|
|
integer :: embedatstringsize
|
|
integer :: corembedatstringsize
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=4) :: borderhand(nlay)
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: embedlow,corembedlow
|
|
character(len=64) :: eorbselecto
|
|
character(len=64) :: eorbselectv
|
|
character(len=64) :: corbselecto
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: eecharge(natoms,nlay)
|
|
character(len=kstringlen) :: keywstring
|
|
character(len=pcmstringlen) :: pcmstring
|
|
character(len=embedatstringsize) :: embedatstring
|
|
character(len=corembedatstringsize) :: corembedatstring
|
|
logical :: usetemp
|
|
logical :: do_mm
|
|
open(scrfile1,file='ONIOMSPEC',form='UNFORMATTED')
|
|
read(scrfile1)
|
|
read(scrfile1)
|
|
do ilay=1,nlay
|
|
read(scrfile1) natomslay(ilay)
|
|
read(scrfile1) (layeratoms(k,ilay),k=1,natomslay(ilay))
|
|
read(scrfile1) imet(ilay),ibas(ilay),ichg(ilay),imul(ilay),
|
|
$borderhand(ilay)
|
|
enddo
|
|
read(scrfile1)
|
|
read(scrfile1) nkeys,keywstring
|
|
read(scrfile1) npcmdefkeys,pcmstring
|
|
read(scrfile1) usetemp,do_mm
|
|
read(scrfile1)
|
|
do ilay=2,nlay
|
|
read(scrfile1) nborder
|
|
do iborder=1,nborder
|
|
read(scrfile1) i
|
|
read(scrfile1) borderstat(i,ilay)
|
|
if(borderstat(i,ilay).ne.'D') then
|
|
backspace(scrfile1)
|
|
read(scrfile1)
|
|
$borderstat(i,ilay),
|
|
$borderat(1,i,ilay),borderat(2,i,ilay),
|
|
$linksym(i,ilay),linkdist(i,ilay)
|
|
endif
|
|
enddo
|
|
enddo
|
|
! write executable-related settings
|
|
read(scrfile1)
|
|
do isp=1,nsp
|
|
read(scrfile1) iprog(isp)
|
|
enddo
|
|
read(scrfile1)
|
|
read(scrfile1)
|
|
if(oniomtype.eq.'ee') then
|
|
do ilay=1,nlay
|
|
read(scrfile1) (eecharge(j,ilay),j=1,natoms)
|
|
enddo
|
|
endif
|
|
read(scrfile1)
|
|
read(scrfile1) embedalg
|
|
read(scrfile1) embedatstring
|
|
read(scrfile1) embedlow
|
|
read(scrfile1) eorbselecto
|
|
read(scrfile1) eorbselectv
|
|
read(scrfile1)
|
|
read(scrfile1) corembedalg
|
|
read(scrfile1) corembedatstring
|
|
read(scrfile1) corembedlow
|
|
read(scrfile1) corbselecto
|
|
close(scrfile1)
|
|
end subroutine read_oniomspec
|
|
C
|
|
************************************************************************
|
|
subroutine oniomgrad(natoms,natwdummy,nlay,natomslay,
|
|
$layeratoms,icent,coord,scoord,atsymbol,satsymbol,nlinks,
|
|
$linkcoord,slinksym,ncent,atchg,satchg,nsp,iout,scrfile1,
|
|
$borderat,linkdist,angtobohr,uval,force,efield,echesu,finalener,
|
|
$qmmm,ncharge,oniomtype,eecharge,iprog,rscrmat,autokcal)
|
|
************************************************************************
|
|
* Read and collect forces on the atoms
|
|
************************************************************************
|
|
implicit none
|
|
integer :: isp,ilay,i,iborder,iatoms,jatoms,xyz
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: nlay
|
|
integer :: icent
|
|
integer :: ncent
|
|
integer :: nsp
|
|
integer :: ios
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
integer :: iout
|
|
integer :: scrfile1
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: ncharge(nlay)
|
|
integer :: nval,nrow
|
|
double precision :: coord(3,ncent)
|
|
double precision :: scoord(3,ncent)
|
|
double precision :: rscrr
|
|
double precision :: autokcal
|
|
double precision :: force(3,ncent)
|
|
double precision :: efield(3,ncent)
|
|
double precision :: rscrmat(3*natoms)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: fact,angtobohr
|
|
double precision :: echesu
|
|
double precision :: finalener
|
|
double precision :: atchg(ncent)
|
|
double precision :: satchg(ncent)
|
|
double precision :: eecharge(natoms,nlay)
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: selfener,dipxyz(3)
|
|
double precision :: rscr(3)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=2) :: satsymbol(natwdummy)
|
|
character(len=2) :: slinksym(natoms,nlay)
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: uval
|
|
character(len=4) :: oniomtype
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: read_buffer
|
|
character(len=8) :: qmmm
|
|
logical :: llg
|
|
ilay=1
|
|
force=0.0d0
|
|
EVAL_GRAD_MAIN_LOOP:
|
|
$do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
fact=-1.0d0
|
|
else
|
|
fact=1.0d0
|
|
endif
|
|
write(cscr2,'(i2)') isp
|
|
cscr2=trim(adjustl(cscr2))
|
|
EVAL_GRAD_PROG_SELECT:
|
|
$ if(iprog(isp).eq.'mrcc') then
|
|
inquire(file='GRAD.'//cscr2,exist=llg)
|
|
if(llg) then
|
|
open(scrfile1,file='GRAD.'//cscr2,form='unformatted')
|
|
rewind(scrfile1)
|
|
! read non-link atoms
|
|
do iatoms=1,natomslay(ilay)
|
|
read(scrfile1) scoord(1:3,iatoms)
|
|
enddo
|
|
! read link atoms
|
|
if(nlinks(ilay).ne.0) then
|
|
do iborder=1,nlinks(ilay)
|
|
read(scrfile1) linkcoord(1:3,iborder,ilay)
|
|
! distribute forces
|
|
call distribute_link_forces(ncent,natwdummy,coord,
|
|
$linkcoord(1:3,iborder,ilay),borderat(1,iborder,ilay),
|
|
$borderat(2,iborder,ilay),linkdist(iborder,ilay),angtobohr,
|
|
$uval,fact,force)
|
|
enddo
|
|
endif
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Error in ONIOM gradient calculation.'
|
|
write(iout,'(a,a,a)')
|
|
$' GRAD.'//trim(adjustl(cscr2))//' is missing!'
|
|
call mrccend(1)
|
|
endif
|
|
else if(iprog(isp).eq.'MOPAC2016.exe') then
|
|
inquire(file='MINP.'//trim(adjustl(cscr2))//'.aux',exist=llg)
|
|
if(llg) then
|
|
nval=(natomslay(ilay)+nlinks(ilay))*3
|
|
call read_mopac_aux(cscr2,scrfile1,nval,rscrmat,'block ',
|
|
$' GRADIENTS:KCAL/',16)
|
|
! Convert kcal/[mol Angs] to Hartree/Bohr
|
|
rscrmat(1:nval)=rscrmat(1:nval)/autokcal*angtobohr
|
|
! Rearrange into scoord array
|
|
i=0
|
|
do iatoms=1,natomslay(ilay)
|
|
do xyz=1,3
|
|
i=i+1
|
|
scoord(xyz,iatoms)=rscrmat(i)
|
|
enddo
|
|
enddo
|
|
! Read gradients of link atoms and distribute the forces
|
|
if(nlinks(ilay).ne.0) then
|
|
do iborder=1,nlinks(ilay)
|
|
do xyz=1,3
|
|
i=i+1
|
|
linkcoord(xyz,iborder,ilay)=rscrmat(i)
|
|
enddo
|
|
! distribute forces
|
|
call distribute_link_forces(ncent,natwdummy,coord,
|
|
$linkcoord(1:3,iborder,ilay),borderat(1,iborder,ilay),
|
|
$borderat(2,iborder,ilay),linkdist(iborder,ilay),angtobohr,
|
|
$uval,fact,force)
|
|
enddo
|
|
endif
|
|
else
|
|
write(iout,'(a)') ' Error in ONIOM gradient calculation.'
|
|
write(iout,'(a,a,a)')
|
|
$' MINP.'//trim(adjustl(cscr2))//'.aux is missing!'
|
|
call mrccend(1)
|
|
endif
|
|
else if(iprog(isp).eq.'xtb') then
|
|
inquire(file='MINP.'//trim(adjustl(cscr2))//'.gradient',
|
|
$exist=llg)
|
|
if(llg) then
|
|
open(scrfile1,file='MINP.'//trim(adjustl(cscr2))//'.gradient',
|
|
$ form='formatted')
|
|
! append gradient file
|
|
rewind(scrfile1)
|
|
do i=1,natomslay(ilay)+nlinks(ilay)+2
|
|
read(scrfile1,*)
|
|
enddo
|
|
! read forces acting on layer atoms
|
|
do iatoms=1,natomslay(ilay)
|
|
read(scrfile1,*) scoord(1:3,iatoms)
|
|
enddo
|
|
! read forces acting on link atoms
|
|
if(nlinks(ilay).ne.0) then
|
|
do iborder=1,nlinks(ilay)
|
|
read(scrfile1,*) linkcoord(1:3,iborder,ilay)
|
|
! distribute forces
|
|
call distribute_link_forces(ncent,natwdummy,coord,
|
|
$linkcoord(1:3,iborder,ilay),borderat(1,iborder,ilay),
|
|
$borderat(2,iborder,ilay),linkdist(iborder,ilay),angtobohr,
|
|
$uval,fact,force)
|
|
enddo
|
|
endif
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Error in ONIOM gradient calculation.'
|
|
write(iout,'(a,a,a)')
|
|
$' MINP.'//trim(adjustl(cscr2))//'.gradient is missing!'
|
|
call mrccend(1)
|
|
endif
|
|
endif EVAL_GRAD_PROG_SELECT
|
|
! sum forces
|
|
do iatoms=1,natomslay(ilay)
|
|
force(1:3,layeratoms(iatoms,ilay))=fact*scoord(1:3,iatoms)
|
|
$ +force(1:3,layeratoms(iatoms,ilay))
|
|
enddo
|
|
enddo EVAL_GRAD_MAIN_LOOP
|
|
!### Handle external point charges and electric embedding. ###
|
|
! (1) if the charges are from an external program, gather the electric field
|
|
! (2) if the charges are used in the electronic embedding version of oniom, do step (1) and calculate the force layer-by-layer.
|
|
if(((qmmm.ne.'off').and.(natoms.ne.ncent)).or.
|
|
$ (oniomtype.eq.'ee')) then
|
|
ilay=1
|
|
EVAL_PCGRAD_MAIN_LOOP:
|
|
$ do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
fact=-1.0d0
|
|
else
|
|
fact=1.0d0
|
|
endif
|
|
write(cscr2,'(i2)') isp
|
|
cscr2=trim(adjustl(cscr2))
|
|
scoord=0.0d0
|
|
if(qmmm.ne.'off'.or.(oniomtype.eq.'ee'.and.isp.gt.1)) then
|
|
EVAL_PCGRAD_PROG_SELECT:
|
|
$ if(iprog(isp).eq.'mrcc') then
|
|
inquire(file='mrcc_job.dat.'//cscr2,exist=llg)
|
|
if(llg) then
|
|
open(scrfile1,file='mrcc_job.dat.'//cscr2,form='formatted')
|
|
rewind(scrfile1)
|
|
do
|
|
read(scrfile1,'(a)',iostat=ios) read_buffer
|
|
! End of file; data not found
|
|
if(ios.lt.0) exit
|
|
! Elec is electric field !
|
|
if(read_buffer(1:4).eq.'Elec') then
|
|
if (oniomtype.eq.'me') then
|
|
do iatoms=natoms+1,ncent
|
|
read(scrfile1,'(3e23.15)') scoord(1:3,iatoms)
|
|
enddo
|
|
else if(oniomtype.eq.'ee') then
|
|
do iatoms=1,ncent
|
|
llg=.true.
|
|
do jatoms=1,natomslay(ilay)
|
|
if(layeratoms(jatoms,ilay).eq.iatoms) llg=.false.
|
|
enddo
|
|
if((llg).or.(iatoms.gt.natoms)) then
|
|
read(scrfile1,'(3e23.15)') scoord(1:3,iatoms)
|
|
endif
|
|
enddo
|
|
endif
|
|
endif
|
|
if(read_buffer(1:4).eq.'Dire' ) then
|
|
read(scrfile1,'(3e23.15)') rscr(1), rscr(2), rscr(3)
|
|
endif
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Error in ONIOM gradient calculation.'
|
|
write(iout,'(a,a,a)')
|
|
$' mrcc_job.dat.'//trim(adjustl(cscr2))//' is missing!'
|
|
call mrccend(1)
|
|
endif
|
|
else if(iprog(isp).eq.'xtb') then
|
|
inquire(file='MINP.'//trim(adjustl(cscr2))//'.pcgrad',
|
|
$ exist=llg)
|
|
if(llg) then
|
|
open(scrfile1,
|
|
$ file='MINP.'//trim(adjustl(cscr2))//'.pcgrad',
|
|
$ form='formatted')
|
|
rewind(scrfile1)
|
|
do iatoms=1,ncent
|
|
llg=.true.
|
|
! Electric field/forces are read here.
|
|
! Skip reading in the case of a layer atom
|
|
do jatoms=1,natomslay(ilay)
|
|
if(layeratoms(jatoms,ilay).eq.iatoms) llg=.false.
|
|
enddo
|
|
! Also skip reading if its not a layeratom _and_ mechanical embedding is utilized
|
|
! note: with qm/mm, external charges can be present so we still need the field/forces
|
|
! (without this, we are heading to end of file error)
|
|
if(oniomtype.ne.'ee'.and.iatoms.le.natoms) llg=.false.
|
|
if((llg).or.(iatoms.gt.natoms)) then
|
|
read(scrfile1,*) scoord(1:3,iatoms)
|
|
endif
|
|
! The xtb program returns the force.
|
|
! Calculate the electric field to avoid further complications.
|
|
if(iatoms.le.natoms) then
|
|
if(llg.and.oniomtype.eq.'ee') then
|
|
if(eecharge(iatoms,ilay).ne.0.0d0) then
|
|
scoord(1:3,iatoms)=scoord(1:3,iatoms)
|
|
$ /(-1.0d0)/eecharge(iatoms,ilay)
|
|
endif
|
|
endif
|
|
else
|
|
if(llg.and.atchg(iatoms).ne.0.0d0) then
|
|
scoord(1:3,iatoms)=scoord(1:3,iatoms)
|
|
$ /(-1.0d0)/atchg(iatoms)
|
|
endif
|
|
endif
|
|
if(iatoms.eq.ncent) rewind(scrfile1)
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a,a,a)')
|
|
$' MINP.'//trim(adjustl(cscr2))//'.pcgrad is missing!'
|
|
call mrccend(1)
|
|
endif
|
|
endif EVAL_PCGRAD_PROG_SELECT
|
|
endif
|
|
selfener=0.0d0
|
|
if(isp.eq.1.and.iprog(isp).eq.'mrcc') then
|
|
call ishell('cp VARS.'//cscr2//' VARS')
|
|
call getvar('selfenergy',selfener)
|
|
else if(isp.eq.1.and.iprog(isp).eq.'xtb') then
|
|
! xtb correct the energy automatically
|
|
selfener=0.0d0
|
|
else if(isp.eq.1.and.iprog(isp).eq.'MOPAC2016') then
|
|
! the pc-embedding is not implemented
|
|
selfener=0.0d0
|
|
endif
|
|
! If MRCC is a subprogram, the electric field at the position of the point charges is needed as output
|
|
EVAL_PCGRAD_ME_OR_EE:
|
|
$ if (oniomtype.eq.'me') then
|
|
do iatoms=natoms+1,ncent
|
|
efield(1:3,iatoms)=fact*scoord(1:3,iatoms)
|
|
$ +efield(1:3,iatoms)
|
|
enddo
|
|
! In the case of electronic embedding, both the external point charges and the atomic charges of the layer atoms have to be handled
|
|
else if(oniomtype.eq.'ee') then
|
|
do iatoms=1,ncent
|
|
llg=.true.
|
|
do jatoms=1,natomslay(ilay)
|
|
if(layeratoms(jatoms,ilay).eq.iatoms) llg=.false.
|
|
enddo
|
|
! First, calculate the force on the layer atoms due electronic embedding
|
|
if(llg) then
|
|
force(1:3,iatoms)=
|
|
$ fact*scoord(1:3,iatoms)*(-1.0d0)*eecharge(iatoms,ilay)
|
|
$ +force(1:3,iatoms)
|
|
endif
|
|
! Second, add up the electric field for external program
|
|
if(iatoms.gt.natoms) then
|
|
efield(1:3,iatoms)=fact*scoord(1:3,iatoms)
|
|
$ +efield(1:3,iatoms)
|
|
endif
|
|
enddo
|
|
endif EVAL_PCGRAD_ME_OR_EE
|
|
! Componens of the dipole vector is also calculated according to the original amber/mrcc interface
|
|
dipxyz(1)=dipxyz(1)+rscr(1)*fact
|
|
dipxyz(2)=dipxyz(2)+rscr(2)*fact
|
|
dipxyz(3)=dipxyz(3)+rscr(3)*fact
|
|
enddo EVAL_PCGRAD_MAIN_LOOP
|
|
endif
|
|
! Write the gradient on screen and save it to a file
|
|
write(iout,*)
|
|
write(iout,*) 'Cartesian gradient [au]:'
|
|
open(scrfile1,file='GRAD',status='replace',form='unformatted')
|
|
do iatoms=1,natoms
|
|
write(scrfile1) force(1:3,iatoms)
|
|
write(iout,'(i5,1x,a3,3f17.10)') iatoms,atsymbol(iatoms),
|
|
$force(1:3,iatoms)
|
|
enddo
|
|
close(scrfile1)
|
|
call ishell('cp GRAD GRAD.composite')
|
|
! Write the gradient and the electric field for the interface
|
|
if(qmmm.eq.'amber') then
|
|
call write_dat_file_for_amber(finalener,selfener,2,
|
|
$natoms,ncent,force,efield,dipxyz(1),dipxyz(2),dipxyz(3))
|
|
call ishell('cp mrcc_job.dat mrcc_job.dat.composite')
|
|
endif
|
|
end subroutine oniomgrad
|
|
C
|
|
************************************************************************
|
|
subroutine distribute_link_forces(ncent,natwdummy,coord,
|
|
$linkcoord,iborderat,jborderat,linkdist,angtobohr,uval,
|
|
$fact,force)
|
|
************************************************************************
|
|
* Distribute forces acting on the link atoms
|
|
* ibordetat: layer atom, jborderat: non-layer atom
|
|
************************************************************************
|
|
implicit none
|
|
integer :: iborderat,jborderat,xyz
|
|
integer :: natwdummy
|
|
integer :: ncent
|
|
double precision :: linkcoord(3)
|
|
double precision :: linkdist
|
|
double precision :: angtobohr
|
|
double precision :: fact
|
|
double precision :: coord(3,ncent)
|
|
double precision :: dij(3)
|
|
double precision :: rij
|
|
double precision :: scafact
|
|
double precision :: dotprod
|
|
double precision :: force(3,ncent)
|
|
double precision :: q(3)
|
|
double precision :: conv
|
|
character(len=4) :: uval
|
|
dij=0.0d0
|
|
dotprod=0.0d00
|
|
if(uval.eq.'bohr') then
|
|
conv=angtobohr
|
|
else
|
|
conv=1.0d0
|
|
endif
|
|
dij(1)=(coord(1,jborderat)-coord(1,iborderat))/conv
|
|
dij(2)=(coord(2,jborderat)-coord(2,iborderat))/conv
|
|
dij(3)=(coord(3,jborderat)-coord(3,iborderat))/conv
|
|
rij=sqrt(dij(1)**2.0d0+dij(2)**2.0d0+dij(3)**2.0d0)
|
|
scafact=linkdist/rij
|
|
dij(1)=dij(1)/rij
|
|
dij(2)=dij(2)/rij
|
|
dij(3)=dij(3)/rij
|
|
q=0.0d0
|
|
dotprod=linkcoord(1)*dij(1)
|
|
$ +linkcoord(2)*dij(2)
|
|
$ +linkcoord(3)*dij(3)
|
|
do xyz=1,3
|
|
q(xyz)=scafact*(linkcoord(xyz)-dotprod*dij(xyz))
|
|
force(xyz,iborderat)=force(xyz,iborderat)
|
|
$+(linkcoord(xyz)-q(xyz))*fact
|
|
force(xyz,jborderat)=force(xyz,jborderat)
|
|
$+q(xyz)*fact
|
|
enddo
|
|
end subroutine distribute_link_forces
|
|
C
|
|
************************************************************************
|
|
subroutine cleanup_oniom(nsp,scrfile1)
|
|
************************************************************************
|
|
* Clean files of the previous subcalculations
|
|
************************************************************************
|
|
implicit none
|
|
integer :: isp,nsp
|
|
integer :: scrfile1
|
|
character(len=2) :: cscr2
|
|
character(len=16) :: cscr16
|
|
logical :: lfound
|
|
do isp=1,nsp
|
|
write(cscr2,'(i2)') isp
|
|
cscr16='MINP.'//trim(adjustl(cscr2))
|
|
inquire(file=cscr16,exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file=cscr16,status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
cscr16='KEYW.'//trim(adjustl(cscr2))
|
|
inquire(file=cscr16,exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file=cscr16,status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
cscr16='GRAD.'//trim(adjustl(cscr2))
|
|
inquire(file=cscr16,exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file=cscr16,form='UNFORMATTED',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
cscr16='VARS.'//trim(adjustl(cscr2))
|
|
inquire(file=cscr16,exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file=cscr16,form='UNFORMATTED',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
enddo
|
|
inquire(file='ONIOMROUTE',exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file='ONIOMROUTE',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
inquire(file='ATCHARGE',exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file='ATCHARGE',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
inquire(file='BONDTABLE',exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file='BONDTABLE',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
inquire(file='VARS',exist=lfound)
|
|
if(lfound) then
|
|
open(scrfile1,file='VARS',form='UNFORMATTED',status='OLD')
|
|
close(scrfile1,status='delete')
|
|
endif
|
|
end subroutine cleanup_oniom
|
|
C
|
|
************************************************************************
|
|
subroutine get_layernumber_oniomtype(oniom,nlay,oniomtype)
|
|
************************************************************************
|
|
* Analyze the 'oniom' keyword to get the number of layers and
|
|
* the type of ONIOM calculation
|
|
* (mechanical embedding=me / electronic embedding=ee)
|
|
************************************************************************
|
|
implicit none
|
|
character(len=1) :: vline(8),vline2(8)
|
|
character(len=4) :: oniomtype
|
|
character(len=8) :: oniom,line,line2
|
|
integer :: nlay,i
|
|
logical :: llg
|
|
equivalence(line,vline)
|
|
equivalence(line2,vline2)
|
|
call lowercase(oniom,oniom,8)
|
|
line=oniom
|
|
line2=' '
|
|
i=1
|
|
llg=.false.
|
|
do while(vline(i).ne.' '.and.i.lt.8)
|
|
if(vline(i).eq.'-') then
|
|
vline2(1:i-1)=vline(1:i-1)
|
|
read(line2,*) nlay
|
|
llg=.true.
|
|
line2=' '
|
|
vline2(i+1:8)=vline(i+1:8)
|
|
oniomtype=trim(adjustl(line2))
|
|
endif
|
|
i=i+1
|
|
enddo
|
|
if(.not.llg) then
|
|
read(oniom,*) nlay
|
|
oniomtype='me '
|
|
endif
|
|
end subroutine get_layernumber_oniomtype
|
|
C
|
|
************************************************************************
|
|
subroutine get_nmmcharges(minpfile,iout,natwdummy,ncent,qmmm)
|
|
************************************************************************
|
|
* Read the number of point charges
|
|
************************************************************************
|
|
use error_handler
|
|
implicit none
|
|
character(len=8) :: qmmm,cscr8
|
|
integer :: iout
|
|
integer :: nmmat
|
|
integer :: ncent
|
|
integer :: natwdummy
|
|
integer :: minpfile
|
|
integer :: istat
|
|
nmmat=0
|
|
istat=0
|
|
if(qmmm.eq.'amber') then
|
|
open(unit=minpfile,file='MINP',status='OLD',
|
|
$ position='REWIND',iostat=istat)
|
|
cscr8=' '
|
|
do while( istat.eq.0 .and. cscr8.ne.'pointcha' )
|
|
read(minpfile,"(a8)",iostat=istat) cscr8
|
|
enddo
|
|
if(istat.eq.0) read(minpfile,*,iostat=istat) nmmat
|
|
if(istat.ne.0) call io_error
|
|
$("Cannot open/read MINP file","get_nmmcharges (compmod.f)")
|
|
close(minpfile)
|
|
ncent=natwdummy+nmmat
|
|
else
|
|
ncent=natwdummy
|
|
endif
|
|
end subroutine get_nmmcharges
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge(oniom_eechg,eecharge,natoms,
|
|
$prog,ichg,itol,ind,qmmm,rescharge_amber,iout)
|
|
************************************************************************
|
|
* Read the atomic charges for electronic embedding
|
|
************************************************************************
|
|
implicit none
|
|
character(len=8) :: oniom_eechg
|
|
character(len=8) :: qmmm
|
|
character(len=16):: prog
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: ichg
|
|
integer :: iout
|
|
integer :: ind(natoms)
|
|
double precision :: eecharge(natoms)
|
|
double precision :: sumcharge
|
|
double precision :: itol
|
|
double precision :: rescharge_amber
|
|
double precision :: rescharge
|
|
double precision :: chargetol
|
|
chargetol=0.0d0
|
|
rescharge=0.0d0
|
|
if (oniom_eechg.eq.'mulli ') then
|
|
call read_eecharge_mulli(natoms,eecharge)
|
|
else if(oniom_eechg.eq.'lowdin ') then
|
|
call read_eecharge_lowdin(natoms,eecharge)
|
|
else if(oniom_eechg.eq.'iao ') then
|
|
call read_eecharge_iao(natoms,eecharge)
|
|
else if(oniom_eechg.eq.'chelpg '.or.
|
|
$ oniom_eechg.eq.'mk ') then
|
|
call read_eecharge_resp(natoms,eecharge)
|
|
else if(oniom_eechg.eq.'amber') then
|
|
call read_eecharge_amber(natoms,eecharge,qmmm,ind)
|
|
else if(oniom_eechg.eq.'external'.and.
|
|
$ prog.eq.'xtb') then
|
|
call read_eecharge_xtb(natoms,eecharge)
|
|
else if(oniom_eechg.eq.'external'.and.
|
|
$ prog.eq.'MOPAC2016.exe') then
|
|
write(iout,'(a)') ' The electronic embedding version of '//
|
|
$'ONIOM is not supported with the MOPAC program.'
|
|
call mrccend(1)
|
|
else if(oniom_eechg.eq.'user') then
|
|
call read_eecharge_user(natoms,eecharge)
|
|
endif
|
|
! Check atomic charges
|
|
sumcharge=0.0d0
|
|
do iatom=1,natoms
|
|
sumcharge=sumcharge+eecharge(iatom)
|
|
enddo
|
|
if(prog.eq.'mrcc') chargetol=itol
|
|
if(prog.eq.'MOPAC2016.exe') chargetol=10d0**(-6)
|
|
if(prog.eq.'xtb') chargetol=1d0**(-8)
|
|
if(oniom_eechg.eq.'user') chargetol=10d0**(-6)
|
|
if(oniom_eechg.eq.'amber') chargetol=10d0**(-6)
|
|
! Warn the user if the sum of point charges is inconsistent
|
|
! with the set integer (qm) charge
|
|
rescharge=abs(sumcharge-dble(ichg))
|
|
if(rescharge.gt.chargetol) then
|
|
write(iout,*)
|
|
write(iout,'(a)') ' Warning! The sum of the point charges '//
|
|
$'differs from the integer charge of the system.'
|
|
write(iout,"(' The difference is ',f15.10,' au')")
|
|
write(iout,'(a,f15.10,a)') ' The difference is ',rescharge,' au'
|
|
! In the case of QM/MM, the sum of charge of the QM atoms can differ
|
|
! from the integer charge of the QM subsystem
|
|
! (which is also why Amber has charge correction schemes).
|
|
! To reduce the modification of charges, we add this difference
|
|
! to our charge correction scheme to have correct
|
|
! (integer) subsystem charge representations.
|
|
if(qmmm.eq.'amber'.and.oniom_eechg.eq.'amber') then
|
|
write(iout,'(a)') ' This charge will be added to the residual'//
|
|
$' charge of the upper-layer subsystem residual charge.'
|
|
rescharge_amber=rescharge
|
|
endif
|
|
endif
|
|
end subroutine read_eecharge
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_amber(natoms,eecharge,qmmm,ind)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: atcounter,iatom,jatom
|
|
integer :: natoms
|
|
integer :: natoms_fs
|
|
integer :: nqmatoms
|
|
integer :: ind(natoms)
|
|
integer :: intpoint(31)
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
double precision :: sumcharge
|
|
character(len=8) :: qmmm
|
|
character(len=70) :: prmtopfile
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
double precision, dimension(:), allocatable :: mmchg
|
|
inquire(file='MINP.composite',exist=found)
|
|
if(.not.found) call io_error("Cannot found MINP.composite",
|
|
$"read_eecharge_amber (compmod.f)")
|
|
open(scrfile1,file='MINP.composite',position='REWIND',
|
|
$ iostat=istat)
|
|
do while(istat.eq.0 .and. line(1:11).ne.'oniom_eechg')
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
enddo
|
|
if(istat.eq.0) read(scrfile1,'(a)') prmtopfile
|
|
inquire(file=prmtopfile,exist=found)
|
|
if(.not.found) call io_error
|
|
$("The Amber topolofy file is not found",
|
|
$"read_eecharge_amber (compmod.f)")
|
|
if(qmmm.eq.'amber') then
|
|
ind=0
|
|
call readlinelist(natoms,scrfile1,ind,iout,'mmserial')
|
|
! Count the QM atoms
|
|
! (note: natoms = nqmatoms if we dont have link atoms)
|
|
nqmatoms=0
|
|
do iatom=1,natoms
|
|
if(ind(iatom).ne.0) nqmatoms=nqmatoms+1
|
|
enddo
|
|
else if(qmmm.eq.'off') then
|
|
nqmatoms=natoms
|
|
do iatom=1,natoms
|
|
ind(iatom)=iatom
|
|
enddo
|
|
endif
|
|
close(scrfile1)
|
|
! Read the number of atoms of the original full system
|
|
! we need the first element of the first block of the prmtopfile
|
|
! (written to natoms_fs)
|
|
open(scrfile1,file=prmtopfile,position='REWIND')
|
|
call amber_block_reader_int
|
|
$(scrfile1,31,'POINTERS',8,intpoint,iout)
|
|
natoms_fs=intpoint(1)
|
|
! The full system can be a couple of hundred thousand atoms
|
|
! so we should allocate an array temporally to avoid stack overflow
|
|
allocate(mmchg(natoms_fs),stat=istat)
|
|
if(istat.ne.0) call failed_memop("mmchg",1)
|
|
! read the original MM charges
|
|
call amber_block_reader_real
|
|
$(scrfile1,natoms_fs,'CHARGE',6,mmchg,iout)
|
|
! Rescale MM charges to get atomic units
|
|
! (instead of the internal amber units)
|
|
mmchg(1:natoms_fs)=mmchg(1:natoms_fs)/18.2223d0
|
|
! Recover the charges of the (QM) atoms:
|
|
sumcharge=0.0d0
|
|
if(qmmm.eq.'amber') then
|
|
! if we are doing QM/MM, place the charges to the eecharge array.
|
|
! The order of atoms in MRCC and in the prmtop file must match!
|
|
! (if sander calls dmrcc, this is guaranteed)
|
|
atcounter=0
|
|
do iatom=1,natoms_fs
|
|
jatom=1
|
|
do while( jatom.le.nqmatoms .and. iatom.eq.ind(jatom) )
|
|
jatom=jatom+1
|
|
enddo
|
|
if( iatom.eq.ind(jatom) ) then
|
|
atcounter=atcounter+1
|
|
eecharge(atcounter)=mmchg(iatom)
|
|
endif
|
|
enddo
|
|
else
|
|
! if we use a prmtop file as an auxiliary, we assume that
|
|
! natoms = natoms_fs and
|
|
! the order of the atoms in the MINP and prmtop is the same
|
|
eecharge(1:natoms)=mmchg(1:natoms)
|
|
endif
|
|
! The MM charges are not required anymore, we get rid of them
|
|
deallocate(mmchg,stat=istat)
|
|
if(istat.ne.0) call failed_memop("mmchg",2)
|
|
close(scrfile1)
|
|
end subroutine read_eecharge_amber
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_mulli(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: i,iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
character(len=2) :: cscr2
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='ATCHARGE',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='ATCHARGE',iostat=istat,position='REWIND')
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) i,cscr2,eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Cannot find atomic charges.'
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read ATCHARGE file",
|
|
$"read_eecharge_mulli (compmod.f)")
|
|
end subroutine read_eecharge_mulli
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_lowdin(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: i,iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
double precision :: rscr
|
|
character(len=2) :: cscr2
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='ATCHARGE',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='ATCHARGE',iostat=istat,position='REWIND')
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) i,cscr2,rscr,eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Cannot find atomic charges.'
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read ATCHARGE file",
|
|
$"read_eecharge_lowdin (compmod.f)")
|
|
end subroutine read_eecharge_lowdin
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_iao(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: i,iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
double precision :: rscr,rscrb
|
|
character(len=2) :: cscr2
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='ATCHARGE',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='ATCHARGE',iostat=istat,position='REWIND')
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) i,cscr2,rscr,rscrb,eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Cannot find atomic charges.'
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read ATCHARGE file","read_eecharge_iao (compmod.f)")
|
|
end subroutine read_eecharge_iao
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_resp(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='ATCHARGE',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='ATCHARGE',iostat=istat,position='REWIND')
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)') ' Cannot find atomic charges.'
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read ATCHARGE file",
|
|
$"read_eecharge_resp (compmod.f)")
|
|
end subroutine read_eecharge_resp
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_user(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='MINP.composite',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='MINP.composite',
|
|
$ iostat=istat,position='REWIND')
|
|
line=''
|
|
do while(istat.eq.0 .and. line(1:11).ne.'oniom_eechg')
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
enddo
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read MINP.composite",
|
|
$"read_eecharge_user (compmod.f)")
|
|
end subroutine read_eecharge_user
|
|
C
|
|
************************************************************************
|
|
subroutine read_eecharge_xtb(natoms,eecharge)
|
|
************************************************************************
|
|
use error_handler
|
|
#include"MRCCCOMMON"
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: istat
|
|
double precision :: eecharge(*)
|
|
character(len=2048) :: line
|
|
logical :: found
|
|
inquire(file='MINP.1.charges',exist=found)
|
|
if(found) then
|
|
open(scrfile1,file='MINP.1.charges',
|
|
$ iostat=istat,position='REWIND')
|
|
line=''
|
|
do while(istat.eq.0 .and. line(1:11).eq.'oniom_eechg')
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
enddo
|
|
iatom=1
|
|
do while(istat.eq.0 .and. iatom.le.natoms)
|
|
read(scrfile1,'(a)',iostat=istat) line
|
|
if(istat.eq.0) read(line,*) eecharge(iatom)
|
|
iatom=iatom+1
|
|
enddo
|
|
close(scrfile1)
|
|
else
|
|
write(iout,'(a)')
|
|
$' The xtb generated file (MINP.1.charges) is not found.'
|
|
endif
|
|
if(.not.found.or.istat.ne.0) call io_error
|
|
$("Cannot find/read MINP.1.charges",
|
|
$"read_eecharge_xtb (compmod.f)")
|
|
end subroutine read_eecharge_xtb
|
|
C
|
|
************************************************************************
|
|
subroutine oniomdriverinit(firstcall,usetemp,borderhand,linkdist,
|
|
$imet,ibas,borderstat,sdens,nlinks,borderstring,linkstring,
|
|
$diststring,coord,force,efield,atchg,eecharge,layeratoms,borderat,
|
|
$linksym,pcmkeystring,mrcckeys,nmrcckeys,pcmkeys,npcmkeys,
|
|
$nkeys,npcmdefkeys,nkeysnon,subminp,verbosity,dens,geom,uval,
|
|
$orblocc,orbloco,orbloce,moldenval,mpitasks,pcm,oniom_pcm,
|
|
$oniom_eechg,ncent,natoms,natwdummy,slinksym,nlay,keywstring,
|
|
$filterstring,iout,oniomtype,sqmprog,nsp,iprog,xtbstring,mmprog,
|
|
$etemp,embedalg,corembedalg,embedat,corembedat,orblocv,localcc,
|
|
$okbyte,tkbyte,oniom_qcorr,printchg,rescharge,qnatoms,itol,
|
|
$oniomrest,restguess,atnum,nelec,cput,walt,minpfile,
|
|
$rescharge_amber,atsymbol,qmmm,embedatstring,corembedatstring,
|
|
$embedlow,corembedlow,eorbselecto,eorbselectv,corbselecto,do_mm)
|
|
************************************************************************
|
|
* Initalize variables for oniomdriver
|
|
************************************************************************
|
|
implicit none
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: ncent
|
|
integer :: natwdummy
|
|
integer :: nkeys
|
|
integer :: nkeysnon
|
|
integer :: iout
|
|
integer :: nsp
|
|
integer :: isp
|
|
integer :: nborders(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
integer :: nmrcckeys
|
|
integer :: npcmkeys
|
|
integer :: npcmdefkeys
|
|
integer :: embedat(natoms)
|
|
integer :: corembedat(natoms)
|
|
integer :: qnatoms(nlay)
|
|
integer :: atnum(natwdummy)
|
|
integer :: nelec(nlay)
|
|
integer :: okbyte,tkbyte
|
|
integer :: minpfile
|
|
integer :: i
|
|
character(len=1) :: borderstat(natoms,nlay)
|
|
character(len=2) :: linksym(natoms,nlay)
|
|
character(len=2) :: slinksym(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
character(len=3) :: moldenval
|
|
character(len=4) :: verbosity,dens,geom,uval,sdens
|
|
character(len=4) :: mpitasks
|
|
character(len=4) :: localcc
|
|
character(len=4) :: borderhand(nlay),oniomtype,citol
|
|
character(len=4) :: oniomrest
|
|
character(len=7) :: scfiguess
|
|
character(len=8) :: gopt,qmmm,freq,subminp,oniom_pcm
|
|
character(len=8) :: oniom_eechg,etemp
|
|
character(len=8) :: embedalg,corembedalg,oniom_qcorr
|
|
character(len=16) :: orbloco,orblocc,orbloce,orblocv
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: sqmprog,mmprog
|
|
character(len=20) :: ibas(nlay)
|
|
character(len=32) :: imet(nlay),pcm
|
|
character(len=32) :: embedlow,corembedlow
|
|
character(len=64) :: eorbselecto,eorbselectv,corbselecto
|
|
character(len=128) :: xtbstring
|
|
character(len=okbyte) :: pcmkeys
|
|
character(len=okbyte) :: pcmkeystring
|
|
character(len=okbyte) :: mrcckeys
|
|
character(len=tkbyte) :: keywstring
|
|
character(len=tkbyte) :: filterstring
|
|
character(len=okbyte) :: embedatstring
|
|
character(len=okbyte) :: corembedatstring
|
|
character(len=natoms*8*8) :: istring
|
|
character(len=natoms*4*8) :: borderstring(nlay)
|
|
character(len=natoms*3*8) :: linkstring(nlay)
|
|
character(len=natoms*3*8) :: diststring(nlay)
|
|
double precision :: coord(3,ncent)
|
|
double precision :: atchg(ncent)
|
|
double precision :: linkdist(natoms,nlay)
|
|
double precision :: force(3,ncent)
|
|
double precision :: efield(3,ncent)
|
|
double precision :: eecharge(natoms,nlay)
|
|
double precision :: rescharge(nlay)
|
|
double precision :: itol
|
|
double precision :: rescharge_amber
|
|
double precision :: walt(nsp),cput(nsp)
|
|
logical :: usetemp
|
|
logical :: firstcall
|
|
logical :: printchg
|
|
logical :: restguess
|
|
logical :: do_mm
|
|
firstcall=.true.
|
|
usetemp=.false.
|
|
do_mm=.false.
|
|
borderhand(1:nlay)=''
|
|
linkdist=0.0d0
|
|
imet=''
|
|
ibas=''
|
|
borderstat=''
|
|
sdens=''
|
|
nlinks=0
|
|
borderstring=''
|
|
linkstring=''
|
|
diststring=''
|
|
atsymbol=''
|
|
coord=0.0d0
|
|
force=0.0d0
|
|
efield=0.0d0
|
|
atchg=0.0d0
|
|
if(oniomtype.eq.'ee') eecharge=0.0d0
|
|
rescharge=0.0d0
|
|
layeratoms=0
|
|
borderat=-1
|
|
linksym=''
|
|
slinksym=''
|
|
istring=''
|
|
pcmkeystring=''
|
|
keywstring=''
|
|
xtbstring=''
|
|
embedat=0
|
|
corembedat=0
|
|
qnatoms=0
|
|
oniomrest=''
|
|
printchg=.false.
|
|
restguess=.false.
|
|
atnum=0
|
|
nelec=0
|
|
cput=0.0d0
|
|
walt=0.0d0
|
|
rescharge_amber=0.0d0
|
|
mrcckeys='mem qmmm gopt freq calc
|
|
$ basis charge mult verbosity test
|
|
$ qmreg oniom geom subminp dens
|
|
$ mpitasks pcm oniom_pcm oniom_eechg embed
|
|
$ corembed orbloce orblocv oniom_qcorr comprest'
|
|
nmrcckeys=25
|
|
pcmkeys='pcm_cavity_type
|
|
$ pcm_cavity_area
|
|
$ pcm_cavity_scaling
|
|
$ pcm_cavity_radiiset
|
|
$ pcm_cavity_npzfile
|
|
$ pcm_cavity_minradius
|
|
$ pcm_medium_solvertype
|
|
$ pcm_medium_correction
|
|
$ pcm_medium_solvent
|
|
$ pcm_medium_proberadius
|
|
$ pcm_green_eps
|
|
$ pcm_green_type'
|
|
npcmkeys=12
|
|
filterstring=trim(adjustl(mrcckeys))//' '//trim(adjustl(pcmkeys))
|
|
nkeysnon=nmrcckeys+npcmkeys
|
|
nkeys=0
|
|
npcmdefkeys=0
|
|
do isp=1,nsp
|
|
iprog(isp)='mrcc'
|
|
enddo
|
|
embedatstring=''
|
|
corembedatstring=''
|
|
embedlow=''
|
|
corembedlow=''
|
|
eorbselecto=''
|
|
eorbselectv=''
|
|
corbselecto=''
|
|
call getkey('subminp',7,subminp,8)
|
|
call getkey('verbosity',9,verbosity,4)
|
|
call getkey('dens',4,dens,4)
|
|
call getkey('geom',4,geom,4)
|
|
call getkey('unit',4,uval,4)
|
|
call getkey('orblocc',7,orblocc,16)
|
|
call getkey('orbloco',7,orbloco,16)
|
|
call getkey('orbloce',7,orbloce,16)
|
|
call getkey('orblocv',7,orblocv,16)
|
|
call getkey('localcc',7,localcc,4)
|
|
call getkey('molden',6,moldenval,3)
|
|
call getkey('mpitasks',8,mpitasks,4)
|
|
call getkey('pcm',3,pcm,32)
|
|
call getkey('oniom_pcm',9,oniom_pcm,8)
|
|
call getkey('oniom_eechg',11,oniom_eechg,8)
|
|
call getkey('oniom_qcorr',11,oniom_qcorr,8)
|
|
call getkey('comprest',8,oniomrest,4)
|
|
call getkey('sqmprog',7,sqmprog,16)
|
|
call getkey('mmprog',6,mmprog,16)
|
|
call getkey('etemp',5,etemp,8)
|
|
call getkey('embed',5,embedalg,8)
|
|
call getkey('corembed',8,corembedalg,8)
|
|
call getkey('itol',4,citol,4)
|
|
read(citol,*) i
|
|
itol=10.d0**(-i)
|
|
if(oniom_eechg.eq.'off') oniomtype='me'
|
|
if(oniomtype.eq.'ee'.and.oniom_eechg.eq.'amber') then
|
|
endif
|
|
if(geom.eq.'zmat'.and.qmmm.ne.'off') then
|
|
write(iout,'(a)') ' QM/MM calculation is not supported with the
|
|
$zmat input format.'
|
|
call mrccend(1)
|
|
endif
|
|
end subroutine oniomdriverinit
|
|
C
|
|
************************************************************************
|
|
subroutine get_firstcall(firstcall,moldenval,qmmm,gopt,freq,
|
|
$scrfile1,minpfile)
|
|
************************************************************************
|
|
* Determine if ONION is already used or not
|
|
************************************************************************
|
|
implicit none
|
|
integer :: niter
|
|
integer :: istat
|
|
integer :: minpfile
|
|
integer :: scrfile1
|
|
character(len=3) :: moldenval
|
|
character(len=8) :: qmmm
|
|
character(len=8) :: gopt
|
|
character(len=8) :: freq
|
|
character(len=16) :: cscr16
|
|
logical :: lexist,firstcall
|
|
istat=0
|
|
inquire(file='ITER',exist=lexist)
|
|
if((gopt.ne.'off '.or.freq.ne.'off ').and.lexist) then
|
|
firstcall=.false.
|
|
open(scrfile1,file='ITER')
|
|
read(scrfile1,*) niter
|
|
close(scrfile1)
|
|
if(niter.gt.0) then
|
|
firstcall=.false.
|
|
if(moldenval.ne.'off') then
|
|
call ishell('cp MOLDEN MOLDEN.composite')
|
|
endif
|
|
endif
|
|
endif
|
|
inquire(file='ONIOMSPEC',exist=lexist)
|
|
if(qmmm.ne.'off'.and.lexist) then
|
|
open(minpfile,file='MINP',status='OLD',iostat=istat,
|
|
$position='REWIND')
|
|
do while( istat.eq.0 .and. cscr16.ne.'! Non-first MRCC')
|
|
read(minpfile,'(a)',iostat=istat) cscr16
|
|
enddo
|
|
! End of file; data not found
|
|
if( istat .eq. 0 ) firstcall=.false.
|
|
close(minpfile)
|
|
endif
|
|
end subroutine get_firstcall
|
|
C
|
|
************************************************************************
|
|
subroutine set_external_sqmprog
|
|
$(nlay,imet,nsp,iprog,sqmprog,iout,subminp,qmmm)
|
|
************************************************************************
|
|
* Determine if a semi-empirical method is requested
|
|
************************************************************************
|
|
implicit none
|
|
integer :: isp,ilay,level
|
|
integer :: istat
|
|
integer :: nlay
|
|
integer :: nsp
|
|
integer :: iout
|
|
integer :: sqmprogerr
|
|
character(len=8) :: subminp
|
|
character(len=8) :: qmmm
|
|
character(len=16) :: sqmprog
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: exe
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: string
|
|
logical :: checkprog
|
|
logical :: userset
|
|
nsp=(nlay-1)*2+1
|
|
ilay=1
|
|
level=0
|
|
sqmprogerr=0
|
|
checkprog=.false.
|
|
userset=.true.
|
|
! Set the default for sqmprog
|
|
if(sqmprog.eq.' ') then
|
|
userset=.false.
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(imet(level).eq.'am1'.or.
|
|
$ imet(level).eq.'mndo'.or.
|
|
$ imet(level).eq.'mndod'.or.
|
|
$ imet(level).eq.'cis'.or.
|
|
$ imet(level).eq.'cisd'.or.
|
|
$ imet(level).eq.'cisdt'.or.
|
|
$ imet(level).eq.'pm3'.or.
|
|
$ imet(level).eq.'pm6'.or.
|
|
$ imet(level).eq.'pm6-d3'.or.
|
|
$ imet(level).eq.'pm6-dh+'.or.
|
|
$ imet(level).eq.'pm6-dh2'.or.
|
|
$ imet(level).eq.'pm6-dh2x'.or.
|
|
$ imet(level).eq.'pm6-d3h4'.or.
|
|
$ imet(level).eq.'pm6-d3h4x'.or.
|
|
$ imet(level).eq.'pm7'.or.
|
|
$ imet(level).eq.'pm7-ts'.or.
|
|
$ imet(level).eq.'rm1'.or.
|
|
$ imet(level).eq.'sqm') then
|
|
sqmprog='mopac2016'
|
|
checkprog=.true.
|
|
exe='MOPAC2016.exe'
|
|
endif
|
|
if(imet(level).eq.'gfn0-xtb'.or.
|
|
$ imet(level).eq.'gfn1-xtb'.or.
|
|
$ imet(level).eq.'gfn2-xtb') then
|
|
sqmprog='xtb'
|
|
checkprog=.true.
|
|
exe='xtb'
|
|
endif
|
|
enddo
|
|
else if(sqmprog.eq.'mopac2016 ') then
|
|
checkprog=.true.
|
|
exe='MOPAC2016.exe'
|
|
else if(sqmprog.eq.'xtb ') then
|
|
checkprog=.true.
|
|
exe='xtb'
|
|
endif
|
|
! Set the executables for the calculations
|
|
ilay=1
|
|
level=0
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(imet(level).eq.'am1'.or.
|
|
$ imet(level).eq.'mndo'.or.
|
|
$ imet(level).eq.'mndod'.or.
|
|
$ imet(level).eq.'cis'.or.
|
|
$ imet(level).eq.'cisd'.or.
|
|
$ imet(level).eq.'cisdt'.or.
|
|
$ imet(level).eq.'pm3'.or.
|
|
$ imet(level).eq.'pm6'.or.
|
|
$ imet(level).eq.'pm6-d3'.or.
|
|
$ imet(level).eq.'pm6-dh+'.or.
|
|
$ imet(level).eq.'pm6-dh2'.or.
|
|
$ imet(level).eq.'pm6-dh2x'.or.
|
|
$ imet(level).eq.'pm6-d3h4'.or.
|
|
$ imet(level).eq.'pm6-d3h4x'.or.
|
|
$ imet(level).eq.'pm7'.or.
|
|
$ imet(level).eq.'pm7-ts'.or.
|
|
$ imet(level).eq.'rm1'.or.
|
|
$ imet(level).eq.'sqm') then
|
|
if(sqmprog.eq.'mopac2016') then
|
|
iprog(isp)=exe
|
|
if((imet(level).eq.'sqm').and.(subminp.ne.'temp'.and.
|
|
$subminp.ne.'m+t'.and.subminp.ne.'t+t')) then
|
|
write(iout,'(a)')
|
|
$" SQM method is requsted but it is not specified."
|
|
write(iout,'(a)')
|
|
$" Please use a template file for method specification."
|
|
call mrccend(1)
|
|
endif
|
|
if(qmmm.ne.'off') sqmprogerr=-1
|
|
else if(sqmprog.eq.'off') then
|
|
sqmprogerr=1
|
|
else if(sqmprog.eq.' ') then
|
|
sqmprogerr=2
|
|
else
|
|
sqmprogerr=3
|
|
endif
|
|
endif
|
|
if(imet(level).eq.'gfn0-xtb'.or.
|
|
$ imet(level).eq.'gfn1-xtb'.or.
|
|
$ imet(level).eq.'gfn2-xtb') then
|
|
if(sqmprog.eq.'xtb') then
|
|
iprog(isp)=exe
|
|
if(qmmm.ne.'off'.and.imet(level).eq.'gfn0') then
|
|
sqmprogerr=-1
|
|
endif
|
|
else if(sqmprog.eq.'off') then
|
|
sqmprogerr=1
|
|
else if(sqmprog.eq.' ') then
|
|
sqmprogerr=2
|
|
else
|
|
sqmprogerr=3
|
|
endif
|
|
endif
|
|
enddo
|
|
! Check if the selected program is available in the path
|
|
if(checkprog) call check_sqm_prog(sqmprog,exe,iout,userset)
|
|
! Error handling of the sqm program-specification
|
|
if(sqmprogerr.eq.-1) then
|
|
write(iout,'(a)')
|
|
$" QMMM is not supported with sqmprog="
|
|
$//trim(adjustl(sqmprog))//' and with the requested method.'
|
|
write(iout,'(a)') ' Please check the documentation of the'//
|
|
$' external program.'
|
|
call mrccend(1)
|
|
endif
|
|
if(sqmprogerr.eq.1) then
|
|
write(iout,'(a)')
|
|
$" SQM method is specified while sqmprog=off "
|
|
write(iout,'(a)')
|
|
$" Something must have gone wrong..."
|
|
call mrccend(1)
|
|
endif
|
|
if(sqmprogerr.eq.2) then
|
|
write(iout,'(a)')
|
|
$" An SQM method is specified while sqmprog keyword is not."
|
|
write(iout,"(' Exiting...')")
|
|
call mrccend(1)
|
|
endif
|
|
if(sqmprogerr.eq.3) then
|
|
write(iout,"(' SQM method is not supported with sqmprog=',a) ")
|
|
$trim(adjustl(sqmprog))
|
|
write(iout,"(' Exiting...')")
|
|
call mrccend(1)
|
|
endif
|
|
end subroutine set_external_sqmprog
|
|
C
|
|
************************************************************************
|
|
subroutine set_external_mmprog
|
|
$(nlay,imet,nsp,iprog,mmprog,iout,subminp)
|
|
************************************************************************
|
|
* Determine if a molecular mechanics method is requested
|
|
************************************************************************
|
|
implicit none
|
|
integer :: isp,level,istat,ilay
|
|
integer :: nlay
|
|
integer :: nsp
|
|
integer :: iout
|
|
integer :: mmprogerr
|
|
character(len=8) :: subminp
|
|
character(len=16) :: mmprog
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=16) :: exe
|
|
character(len=32) :: imet(nlay)
|
|
character(len=32) :: string
|
|
logical :: checkprog
|
|
nsp=(nlay-1)*2+1
|
|
ilay=1
|
|
level=0
|
|
mmprogerr=0
|
|
checkprog=.false.
|
|
! Set the default for mmprog
|
|
if(mmprog.eq.' ') then
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(imet(level).eq.'gfn-ff') then
|
|
mmprog='xtb'
|
|
checkprog=.true.
|
|
exe='xtb'
|
|
endif
|
|
enddo
|
|
else if(mmprog.eq.'xtb ') then
|
|
checkprog=.true.
|
|
exe='xtb'
|
|
endif
|
|
! Set the executables for the calculations
|
|
ilay=1
|
|
level=0
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(imet(level).eq.'gfn-ff') then
|
|
if(mmprog.eq.'xtb') then
|
|
iprog(isp)=exe
|
|
else if(mmprog.eq.'off') then
|
|
mmprogerr=1
|
|
else if(mmprog.eq.' ') then
|
|
mmprogerr=2
|
|
else
|
|
mmprogerr=3
|
|
endif
|
|
endif
|
|
enddo
|
|
! Check if the selected program is available in the path
|
|
if(checkprog) then
|
|
write(iout,
|
|
$"(' Checking for the executable of an external program...')")
|
|
string='which '//trim(adjustl(exe))
|
|
call ishell(trim(adjustl(string)) )
|
|
endif
|
|
! Error handling of the sqm program-specification
|
|
if(mmprogerr.eq.1) then
|
|
write(iout,'(a)')
|
|
$" MM method is specified while mmprog=off "
|
|
write(iout,'(a)')
|
|
$" Something must have gone wrong..."
|
|
call mrccend(1)
|
|
endif
|
|
if(mmprogerr.eq.2) then
|
|
write(iout,'(a)')
|
|
$" An MM method is specified while mmprog keyword is not."
|
|
write(iout,"(' Exiting...')")
|
|
call mrccend(1)
|
|
endif
|
|
if(mmprogerr.eq.3) then
|
|
write(iout,"(' MM method is not supported with mmprog=',a) ")
|
|
$trim(adjustl(mmprog))
|
|
write(iout,"(' Exiting...')")
|
|
call mrccend(1)
|
|
endif
|
|
end subroutine set_external_mmprog
|
|
C
|
|
************************************************************************
|
|
subroutine make_sqm_bondtable(scrfile1,minpfile,natoms,bondtable,
|
|
$sbondtable,extprog,iout)
|
|
************************************************************************
|
|
* Determine if a semi-empirical method is requested
|
|
************************************************************************
|
|
implicit none
|
|
integer :: i,j,k
|
|
integer :: natoms
|
|
integer :: scrfile1
|
|
integer :: minpfile
|
|
integer :: ios
|
|
integer :: nrow
|
|
integer :: nval
|
|
integer :: iout
|
|
double precision :: sbondtable(natoms*natoms)
|
|
double precision :: bondtable(natoms,natoms)
|
|
double precision :: rscr
|
|
character(len=16) :: read_buffer
|
|
character(len=16) :: extprog
|
|
if(extprog.eq.'MOPAC2016.exe') then
|
|
write(iout,'(a)')
|
|
$' Building bond table based on MOPAC BOND keyword...'
|
|
rscr=(natoms*natoms+natoms)/2d0
|
|
nval=nint(rscr)
|
|
rscr=nval/10d0
|
|
nrow=nint(rscr)
|
|
if(nval.gt.0.and.nrow.eq.0) nrow=1
|
|
sbondtable=0.0d0
|
|
call read_mopac_aux(' 1',scrfile1,nval,sbondtable,'block ',
|
|
$' BOND_ORDERS',12)
|
|
bondtable=0.0d0
|
|
k=0
|
|
do i=1,natoms
|
|
do j=1,i
|
|
k=k+1
|
|
bondtable(i,j)=sbondtable(k)
|
|
enddo
|
|
enddo
|
|
open(scrfile1,file='BONDTABLE',status='replace')
|
|
c write(scrfile1,'(a)')
|
|
write(scrfile1,'(a)') ' BONDNUM NATOMS BONDORDER IATOM JATOM'
|
|
k=0
|
|
if(natoms.eq.1) write(scrfile1,*) '0'
|
|
do i=1,natoms
|
|
do j=1,i-1
|
|
if(bondtable(i,j).gt.0.5d0) then
|
|
k=k+1
|
|
write(scrfile1,"(2i5,4x,f9.6,4x,1000i5)")
|
|
$k,2,bondtable(i,j),i,j
|
|
endif
|
|
enddo
|
|
enddo
|
|
close(scrfile1)
|
|
else if(extprog.eq.'xtb') then
|
|
write(iout,'(a)')
|
|
$' Building bond table based on Wiberg bond orders...'
|
|
open(minpfile,file='BONDTABLE',status='replace')
|
|
c write(minpfile,'(a)')
|
|
write(minpfile,'(a)') ' BONDNUM NATOMS BONDORDER IATOM JATOM'
|
|
open(scrfile1,file='MINP.1.wbo',form='formatted')
|
|
k=0
|
|
do
|
|
read(scrfile1,*,iostat=ios) i,j,bondtable(i,j)
|
|
if(bondtable(i,j).gt.0.5d0) then
|
|
k=k+1
|
|
write(minpfile,"(2i5,4x,f9.6,4x,1000i5)")
|
|
$k,2,bondtable(i,j),i,j
|
|
endif
|
|
if(ios.lt.0) exit
|
|
enddo
|
|
close(scrfile1)
|
|
close(minpfile)
|
|
endif
|
|
write(iout,'(a)') ' Done.'
|
|
end subroutine make_sqm_bondtable
|
|
C
|
|
************************************************************************
|
|
subroutine sqm_moldentask(natoms,coord,scrfile1,atsymbol,atnum,
|
|
$angtobohr)
|
|
************************************************************************
|
|
* Generate COORD and MOLDEN file for geometry optimization
|
|
* if a semi-empirical method is requested in the first calculation
|
|
************************************************************************
|
|
implicit none
|
|
integer :: natoms
|
|
integer :: scrfile1
|
|
integer :: iatoms
|
|
integer :: atnum(natoms)
|
|
character(len=2) :: atsymbol(natoms)
|
|
character(len=10) :: cscr
|
|
double precision :: coord(3,natoms)
|
|
double precision :: angtobohr
|
|
atnum(1:natoms)=0
|
|
open(scrfile1,file='COORD.xyz',status='replace')
|
|
write(cscr,"(i10)") natoms
|
|
write(scrfile1,"(a10)") adjustl(cscr)
|
|
write(scrfile1,*)
|
|
do iatoms=1,natoms
|
|
write(scrfile1,'(a3,3f25.20)')
|
|
$atsymbol(iatoms),coord(1:3,iatoms)
|
|
enddo
|
|
close(scrfile1)
|
|
open(scrfile1,file='MOLDEN',status='replace')
|
|
write(scrfile1,'(a)') '[Molden Format]'
|
|
write(scrfile1,'(a)') '[ATOMS] AU'
|
|
do iatoms=1,natoms
|
|
call getatnum(atsymbol(iatoms),atnum(iatoms))
|
|
write(scrfile1,"(a3,2i5,3f20.10)")
|
|
$atsymbol(iatoms),iatoms,atnum(iatoms),coord(1:3,iatoms)*angtobohr
|
|
enddo
|
|
close(scrfile1)
|
|
end subroutine sqm_moldentask
|
|
C
|
|
subroutine embedreadspec(embedalg,corembedalg,natoms,minpfile,ind,
|
|
$iout,nembedat,ncorembedat,embedat,corembedat,embedlow,corembedlow,
|
|
$eorbselecto,eorbselectv,corbselecto,orblocv,localcc)
|
|
c************************************************************************
|
|
c* Read the embed and corembed specifications for oniom calculations
|
|
c************************************************************************
|
|
implicit none
|
|
character(len=4) :: localcc
|
|
character(len=8) :: embedalg
|
|
character(len=8) :: corembedalg
|
|
character(len=8) :: cscr8
|
|
character(len=16) :: orblocv
|
|
character(len=32) :: embedlow
|
|
character(len=32) :: corembedlow
|
|
character(len=64) :: eorbselecto
|
|
character(len=64) :: eorbselectv
|
|
character(len=64) :: corbselecto
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: minpfile
|
|
integer :: iout
|
|
integer :: nembedat
|
|
integer :: ncorembedat
|
|
integer :: embedat(natoms)
|
|
integer :: corembedat(natoms)
|
|
integer :: ind(natoms)
|
|
if(embedalg.ne.'off ') then
|
|
call getkeym('embed',5,cscr8,8)
|
|
ind=0
|
|
call readlinelist(natoms,minpfile,ind,iout,'atoms ')
|
|
nembedat=0
|
|
do iatom=1,natoms
|
|
if(ind(iatom).ne.0) then
|
|
nembedat=nembedat+1
|
|
embedat(nembedat)=iatom
|
|
endif
|
|
enddo
|
|
read(minpfile,*) embedlow
|
|
call lowercase(embedlow,embedlow,32)
|
|
read(minpfile,*) eorbselecto
|
|
if(orblocv.ne.'off '.and.
|
|
$ localcc.eq.'off ') then
|
|
read(minpfile,*) eorbselectv
|
|
endif
|
|
endif
|
|
if(corembedalg.ne.'off ') then
|
|
call getkeym('corembed',8,cscr8,8)
|
|
ind=0
|
|
call readlinelist(natoms,minpfile,ind,iout,'atoms ')
|
|
ncorembedat=0
|
|
do iatom=1,natoms
|
|
if(ind(iatom).ne.0) then
|
|
ncorembedat=ncorembedat+1
|
|
corembedat(ncorembedat)=iatom
|
|
endif
|
|
enddo
|
|
read(minpfile,*) corembedlow
|
|
call lowercase(corembedlow,corembedlow,32)
|
|
read(minpfile,*) corbselecto
|
|
endif
|
|
c print*,'embed = ',embed
|
|
c print*,'nembedat = ',nembedat
|
|
c print*,'embedat = ',embedat(1:nembedat)
|
|
c print*,'embedlow = ',embedlow
|
|
c print*,'eorbselecto = ',eorbselecto
|
|
c print*
|
|
c print*,'corembed = ',corembed
|
|
c print*,'ncorembedat = ',ncorembedat
|
|
c print*,'corembedat = ',corembedat(1:ncorembedat)
|
|
c print*,'corembedlow = ',corembedlow
|
|
c print*,'corbselecto = ',corbselecto
|
|
ind=0
|
|
end subroutine embedreadspec
|
|
C
|
|
subroutine rewrite_atomid(nrefset,refset,nsubset,subset,work,iout)
|
|
c************************************************************************
|
|
c* rewrite the atom ids to match the atom orders in a subset
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: nrefset
|
|
integer :: nsubset
|
|
integer :: refatom
|
|
integer :: subatom
|
|
integer :: newind
|
|
integer :: iout
|
|
integer :: refset(nrefset)
|
|
integer :: subset(nsubset)
|
|
integer :: work(nrefset)
|
|
work=0
|
|
newind=0
|
|
do refatom=1,nrefset
|
|
do subatom=1,nsubset
|
|
if(refset(refatom).eq.subset(subatom)) then
|
|
newind=newind+1
|
|
work(newind)=refatom
|
|
endif
|
|
enddo
|
|
enddo
|
|
if(newind.ne.nsubset) then
|
|
write(iout,'(a)') ' Fatal error at the reordering of atomic IDs'
|
|
call mrccend(1)
|
|
else
|
|
subset(1:nsubset)=work(1:nsubset)
|
|
endif
|
|
end subroutine rewrite_atomid
|
|
C
|
|
subroutine atlist_to_string(nelem,arr,stringsize,string)
|
|
c************************************************************************
|
|
c* Convert integer atom list to a string, where the elements are separated by comma
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: ielem
|
|
integer :: nelem
|
|
integer :: stringsize
|
|
integer :: arr(nelem)
|
|
character(len=stringsize) :: string
|
|
character(len=16) :: cscr
|
|
string(1:stringsize)=' '
|
|
write(cscr,'(i16)') arr(1)
|
|
string=trim(adjustl(cscr))
|
|
if(nelem.gt.1) then
|
|
do ielem=2,nelem
|
|
write(cscr,'(i16)') arr(ielem)
|
|
string=trim(adjustl(string))//','//trim(adjustl(cscr))
|
|
enddo
|
|
endif
|
|
end subroutine atlist_to_string
|
|
C
|
|
subroutine mopac_solvent_duties
|
|
$(pcm,pcmkeystring,pcmkeystringsize,npcmdefkeys)
|
|
c************************************************************************
|
|
* Convert solvent name to its dielectric constant for mopac calculations
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: pcmkeystringsize
|
|
integer :: npcmdefkeys
|
|
character(len=pcmkeystringsize) :: pcmkeystring
|
|
character(len=32) :: pcm
|
|
if (trim(adjustl(pcm)).eq.'water'.or.
|
|
$ trim(adjustl(pcm)).eq.'h2o') then
|
|
pcmkeystring='eps=78.39 rsolv=1.385'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'propylene_carbonate'.or.
|
|
$ trim(adjustl(pcm)).eq.'c4h6o3') then
|
|
pcmkeystring='eps=64.96 rsolv=1.385'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'dimethylsulfoxide'.or.
|
|
$ trim(adjustl(pcm)).eq.'dmso') then
|
|
pcmkeystring='eps=46.7 rsolv=2.455'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'nitromethane'.or.
|
|
$ trim(adjustl(pcm)).eq.'ch3no2') then
|
|
pcmkeystring='eps=38.20 rsolv=2.155'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'acetonitrile'.or.
|
|
$ trim(adjustl(pcm)).eq.'ch3cn') then
|
|
pcmkeystring='eps=36.64 rsolv=2.155'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'methanol'.or.
|
|
$ trim(adjustl(pcm)).eq.'ch3oh') then
|
|
pcmkeystring='eps=32.63 rsolv=1.855'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'ethanol'.or.
|
|
$ trim(adjustl(pcm)).eq.'ch3ch2oh') then
|
|
pcmkeystring='eps=24.55 rsolv=2.180'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'acetone'.or.
|
|
$ trim(adjustl(pcm)).eq.'c2h6co') then
|
|
pcmkeystring='eps=20.7 rsolv=2.38'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'1,2-dichloroethane'.or.
|
|
$ trim(adjustl(pcm)).eq.'c2h4cl2') then
|
|
pcmkeystring='eps=10.36 rsolv=2.505'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'methylenechloride'.or.
|
|
$ trim(adjustl(pcm)).eq.'ch2cl2') then
|
|
pcmkeystring='eps=8.93 rsolv=2.27'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'tetrahydrofurane'.or.
|
|
$ trim(adjustl(pcm)).eq.'thf') then
|
|
pcmkeystring='eps=7.58 rsolv=2.9'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'aniline'.or.
|
|
$ trim(adjustl(pcm)).eq.'c6h5nh2') then
|
|
pcmkeystring='eps=6.89 rsolv=2.80'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'chlorobenzene'.or.
|
|
$ trim(adjustl(pcm)).eq.'c6h5cl') then
|
|
pcmkeystring='eps=5.621 rsolv=2.805'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'chloroform'.or.
|
|
$ trim(adjustl(pcm)).eq.'chcl3') then
|
|
pcmkeystring='eps=4.90 rsolv=2.48'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'toluene'.or.
|
|
$ trim(adjustl(pcm)).eq.'c6h5ch3') then
|
|
pcmkeystring='eps=2.379 rsolv=2.82'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'1,4-dioxane'.or.
|
|
$ trim(adjustl(pcm)).eq.'c4h8o2') then
|
|
pcmkeystring='eps=2.250 rsolv=2.630'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'benzene'.or.
|
|
$ trim(adjustl(pcm)).eq.'c6h6') then
|
|
pcmkeystring='eps=2.247 rsolv=2.630'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'carbon_tetrachloride'.or.
|
|
$ trim(adjustl(pcm)).eq.'ccl4') then
|
|
pcmkeystring='eps=2.228 rsolv=2.685'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'cyclohexane'.or.
|
|
$ trim(adjustl(pcm)).eq.'c6h12') then
|
|
pcmkeystring='eps=2.023 rsolv=2.815'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else if(trim(adjustl(pcm)).eq.'n-heptane'.or.
|
|
$ trim(adjustl(pcm)).eq.'c7h16') then
|
|
pcmkeystring='eps=1.92 rsolv=3.125'
|
|
npcmdefkeys=npcmdefkeys+2
|
|
else
|
|
pcmkeystring=trim(adjustl(pcm))
|
|
npcmdefkeys=npcmdefkeys+1
|
|
endif
|
|
end subroutine mopac_solvent_duties
|
|
C
|
|
subroutine make_qcorr
|
|
$(natoms,nlay,eecharge,iout,natomslay,layeratoms,ichg,nborders,
|
|
$borderat,rescharge,qnatoms,oniom_qcorr,minpfile,ind,
|
|
$rescharge_amber,qmmm,oniom_eechg)
|
|
c************************************************************************
|
|
* Correct the point charges in the case of electronic embedding by
|
|
* zeroing those point charges that are saptially close to the atoms of
|
|
* the given layers
|
|
* _and_
|
|
* redistribute charges to reflect the integer charge of the given layer
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: iatom,jatom,iborder,ilay
|
|
integer :: natoms
|
|
integer :: nlay
|
|
integer :: iout
|
|
integer :: minpfile
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: ichg(nlay)
|
|
integer :: nborders(nlay)
|
|
integer :: borderat(2,natoms,nlay)
|
|
integer :: qnatoms(nlay)
|
|
integer :: ind(natoms+1)
|
|
double precision :: eecharge(natoms,nlay)
|
|
double precision :: rescharge(nlay)
|
|
double precision :: sumcharge(nlay)
|
|
double precision :: rescharge_amber
|
|
character(len=8) :: oniom_qcorr
|
|
character(len=8) :: cscr8
|
|
character(len=8) :: qmmm
|
|
character(len=8) :: oniom_eechg
|
|
logical :: nonlayerat
|
|
! initalize
|
|
sumcharge=0.0d0
|
|
qnatoms=0
|
|
if(oniom_qcorr.eq.'off ') then
|
|
do ilay=2,nlay
|
|
eecharge(1:natoms,ilay)=eecharge(1:natoms,1)
|
|
enddo
|
|
endif
|
|
if(oniom_qcorr.eq.'special ') then
|
|
open(minpfile,file='MINP.composite')
|
|
call getkeym('oniom_qcorr',11,cscr8,8)
|
|
endif
|
|
! Calculate the sum of charges of the following atoms:
|
|
! + layer atoms (option 0)
|
|
! + and host atom of the lower-layer (option 1)
|
|
! + and user-defined atoms (option special)
|
|
do ilay=2,nlay
|
|
if(oniom_qcorr.eq.'special ')
|
|
$ call readlinelist(natoms,minpfile,ind,iout,'atoms ')
|
|
do iatom=1,natoms
|
|
nonlayerat=.true.
|
|
jatom=1
|
|
do while( ( jatom.le.natomslay(ilay) ).and.
|
|
$ ( iatom.ne.layeratoms(jatom,ilay) ) )
|
|
jatom=jatom+1
|
|
enddo
|
|
if( jatom.le.natomslay(ilay) ) nonlayerat=.false.
|
|
if(nonlayerat .and.
|
|
$ oniom_qcorr.eq.'1 '.or.
|
|
$ oniom_qcorr.eq.'special ') then
|
|
iborder=1
|
|
do while( (iborder .le. nborders(ilay) ).and.
|
|
$ (iatom .ne. borderat(2,iborder,ilay) ))
|
|
iborder=iborder+1
|
|
enddo
|
|
if( iborder .le. nborders(ilay)) nonlayerat=.false.
|
|
endif
|
|
if(nonlayerat .and.
|
|
$ oniom_qcorr.eq.'special ' .and.
|
|
$ ind(iatom).eq.1 ) nonlayerat=.false.
|
|
if(nonlayerat) then
|
|
! Calculate the number of those atoms which partial charge must be corrected
|
|
qnatoms(ilay)=qnatoms(ilay)+1
|
|
else
|
|
! Calculate the sum of charges on layer atoms
|
|
sumcharge(ilay)=
|
|
$ sumcharge(ilay)+eecharge(iatom,1)
|
|
endif
|
|
enddo
|
|
enddo
|
|
! Calculate residual charge
|
|
do ilay=2,nlay
|
|
rescharge(ilay)=sumcharge(ilay)-dble(ichg(ilay))
|
|
enddo
|
|
! Add the residual charge of QM atoms if electronic embedding
|
|
! is used with Amber-controlled QM/MM
|
|
! (note: only two layers are allowed in this case)
|
|
if(qmmm.eq.'amber'.and.oniom_eechg.eq.'amber') then
|
|
rescharge(2)=rescharge(2)+rescharge_amber
|
|
endif
|
|
! Return if charge correction is not requested
|
|
if(oniom_qcorr.eq.'off ') then
|
|
qnatoms(1:nlay)=0
|
|
return
|
|
endif
|
|
! Distribute residual charge
|
|
if(oniom_qcorr.eq.'special ') then
|
|
do ilay=1,nlay-1
|
|
backspace(minpfile)
|
|
enddo
|
|
endif
|
|
do ilay=2,nlay
|
|
if(oniom_qcorr.eq.'special ')
|
|
$ call readlinelist(natoms,minpfile,ind,iout,'atoms ')
|
|
do iatom=1,natoms
|
|
nonlayerat=.true.
|
|
jatom=1
|
|
do while( ( jatom .le. natomslay(ilay) ) .and.
|
|
$ ( iatom .ne.layeratoms(jatom,ilay) ) )
|
|
jatom=jatom+1
|
|
enddo
|
|
if( jatom .le. natomslay(ilay) ) nonlayerat=.false.
|
|
if(nonlayerat .and.
|
|
$ oniom_qcorr.eq.'1 '.or.
|
|
$ oniom_qcorr.eq.'special ') then
|
|
iborder=1
|
|
do while( ( iborder .le. nborders(ilay) ).and.
|
|
$ ( iatom .ne. borderat(2,iborder,ilay) ) )
|
|
iborder=iborder+1
|
|
enddo
|
|
if( iborder .le. nborders(ilay) ) nonlayerat=.false.
|
|
endif
|
|
if(nonlayerat.and.
|
|
$ oniom_qcorr.eq.'special '.and.
|
|
$ ind(iatom).eq.1) nonlayerat=.false.
|
|
if(nonlayerat) then
|
|
eecharge(iatom,ilay)=eecharge(iatom,1)+
|
|
$ rescharge(ilay)/qnatoms(ilay)
|
|
else
|
|
eecharge(iatom,ilay)=0.0d0
|
|
endif
|
|
enddo
|
|
enddo
|
|
if(oniom_qcorr.eq.'special ') then
|
|
close(minpfile)
|
|
endif
|
|
if(.false.) then
|
|
do ilay=1,nlay
|
|
write(iout,'(a,i4)') 'ilay = ',ilay
|
|
do iatom=1,natoms
|
|
write(iout,'(a,i4,a,f10.5)')
|
|
$'iatom = ',iatom,' eecharge(jatom,ilay) = ',
|
|
$eecharge(iatom,ilay)
|
|
enddo
|
|
enddo
|
|
endif
|
|
end subroutine make_qcorr
|
|
C
|
|
subroutine do_oniom_restart
|
|
$(oniomrest,startsp,ilay,level,oniomtype,soniomtype,iout,
|
|
$dens,sdens,nlay,nsp,npcmdefkeys,laykey,nkeys,oniom_eechg,
|
|
$oniom_pcm,subminp,iprog,pcm,okbyte,qmmm,restguess,irest)
|
|
c************************************************************************
|
|
* This routine initalize/checks variables in the case of oniom restart
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: ilay,isp,i
|
|
integer :: startsp
|
|
integer :: nlay
|
|
integer :: level
|
|
integer :: irest
|
|
integer :: nsp
|
|
integer :: iout
|
|
integer :: idens
|
|
integer :: npcmdefkeys
|
|
integer :: laykey
|
|
integer :: nkeys
|
|
integer :: okbyte
|
|
integer :: notfound
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: oniomrest
|
|
character(len=4) :: dens,sdens
|
|
character(len=4) :: oniomtype,soniomtype
|
|
character(len=8) :: oniom_eechg,oniom_pcm,subminp,qmmm
|
|
character(len=15) :: cscr15
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=32) :: pcm
|
|
character(len=128) :: nofilelist
|
|
character(len=okbyte) :: pcmkeystring
|
|
logical :: llg
|
|
logical :: restguess
|
|
nofilelist=' '
|
|
if(oniomrest.ne.'auto') then
|
|
read(oniomrest,'(i8)') irest
|
|
if(irest.ge.nsp) then
|
|
write(iout,'(a)') ' Invalid specification of comprest.'
|
|
write(iout,"(' The input integer (',i2,') cannot be ',
|
|
$'equal or grater than the number of subcalculations (',i2,').')")
|
|
$irest,nsp
|
|
call mrccend(1)
|
|
endif
|
|
else
|
|
irest=nsp
|
|
endif
|
|
notfound=0
|
|
call check_oniom_files
|
|
$(irest,nofilelist,notfound,iprog,nsp,dens,oniomrest,oniomtype,
|
|
$qmmm)
|
|
ilay=1
|
|
level=0
|
|
do isp=1,irest
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
if(isp.eq.1) then
|
|
call ishell('cp MINP MINP.composite')
|
|
call ishell('cp KEYWD KEYWD.composite')
|
|
read(dens,'(i2)') i
|
|
if(i.eq.0.and.oniomtype.eq.'ee'.and.oniom_eechg.ne.'user')
|
|
$ sdens='1 '
|
|
soniomtype=' '
|
|
else if(isp.eq.2) then
|
|
if(trim(adjustl(pcm)).ne.'off'.and.
|
|
$ trim(adjustl(oniom_pcm)).eq.'x') then
|
|
npcmdefkeys=npcmdefkeys+2
|
|
pcmkeystring=trim(adjustl(pcmkeystring))//
|
|
$' pcm_cavity_type=restart pcm_cavity_npzFile=cavity.npz'
|
|
soniomtype=oniomtype
|
|
else
|
|
pcm='off '
|
|
soniomtype=oniomtype
|
|
if(iprog(isp).eq.'MOPAC2016.exe') npcmdefkeys=0
|
|
endif
|
|
endif
|
|
if(subminp.eq.'top'.or.subminp.eq.'t+t') then
|
|
if(isp.ne.nsp) then
|
|
laykey=0
|
|
else
|
|
laykey=nkeys
|
|
endif
|
|
else if(subminp.eq.'temp') then
|
|
laykey=0
|
|
else if(subminp.eq.'minp'.or.subminp.eq.'m+t') then
|
|
laykey=nkeys
|
|
endif
|
|
enddo
|
|
if(notfound.gt.0.and.oniomrest.ne.'auto') then
|
|
if(irest.ne.0) then
|
|
write(iout,'(a,i2,a)') ' The restart of an ONIOM calculation'//
|
|
$' is requested asif calc. #',irest,' is finished.'
|
|
else
|
|
write(iout,'(a,i2,a)') ' The restart of an ONIOM calculation'//
|
|
$' is requested to setup the boundary.'
|
|
endif
|
|
write(iout,'(a)') ' The following files are not found for '//
|
|
$'ONIOM restart:'
|
|
write(iout,'(a)') trim(adjustl(nofilelist))
|
|
write(iout,'(a)') ' Exiting...'
|
|
call mrccend(1)
|
|
endif
|
|
if(irest.gt.0) then
|
|
startsp=irest+1
|
|
else
|
|
c if(oniomrest.eq.'auto'.and.irest.eq.0) startsp=1
|
|
startsp=1
|
|
endif
|
|
! Set SCF restart in the case of MRCC
|
|
if(oniomrest.eq.'auto') then
|
|
inquire(file='SCFDENSITIES',exist=llg)
|
|
if(llg.and.iprog(startsp).eq.'mrcc') then
|
|
restguess=.true.
|
|
write(cscr2,'(i2)') startsp
|
|
call ishell
|
|
$('cp SCFDENSITIES SCFDENSITIES.'//trim(adjustl(cscr2)))
|
|
endif
|
|
endif
|
|
if(irest.ne.0) then
|
|
write(iout,*)
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
if(irest.eq.1) then
|
|
write(iout,"(' *** RESTARTING ONIOM CALCULATION ASIF CALC. #'
|
|
$,' 1 IS FINISHED ***')")
|
|
else if(irest.gt.1) then
|
|
write(iout,"(' *** RESTARTING ONIOM CALCULATION ASIF CALC.'
|
|
$' # 1 -',i2,' ARE FINISHED ***')") irest
|
|
endif
|
|
write(iout,'(a)') ' =========================================='//
|
|
$'============================'
|
|
endif
|
|
end subroutine do_oniom_restart
|
|
C
|
|
subroutine check_oniom_files
|
|
$(irest,nofilelist,notfound,iprog,nsp,dens,oniomrest,oniomtype,
|
|
$qmmm)
|
|
c************************************************************************
|
|
* This routine checks the necessary file for oniom restart
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: isp,ilay,level,irest
|
|
integer :: notfound
|
|
integer :: nsp
|
|
integer :: idens
|
|
integer :: nrest
|
|
character(len=2) :: cscr2
|
|
character(len=4) :: dens,oniomrest,oniomtype
|
|
character(len=8) :: qmmm
|
|
character(len=16) :: iprog(nsp)
|
|
character(len=15) :: cscr15
|
|
character(len=128) :: nofilelist
|
|
logical :: llg
|
|
if(irest.eq.0) then
|
|
if(iprog(1).eq.'mrcc')
|
|
$cscr15='MOCOEF'
|
|
if(iprog(1).eq.'MOPAC2016.exe')
|
|
$cscr15='MINP.1.aux'
|
|
if(iprog(1).eq.'xtb')
|
|
$cscr15='MINP.1.wbo'
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//' '//trim(adjustl(cscr15))
|
|
cscr15=' '
|
|
endif
|
|
nrest=1
|
|
else
|
|
nrest=irest
|
|
endif
|
|
do isp=1,nrest
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
else
|
|
level=level+1
|
|
endif
|
|
! File checks for single point calculations
|
|
write(cscr2,'(i2)') isp
|
|
if(iprog(isp).eq.'mrcc')
|
|
$cscr15='iface.'//trim(adjustl(cscr2))
|
|
if(iprog(isp).eq.'MOPAC2016.exe')
|
|
$cscr15='MINP.'//trim(adjustl(cscr2))//'.aux'
|
|
if(iprog(isp).eq.'xtb')
|
|
$cscr15='MINP.'//trim(adjustl(cscr2))//'.gradient'
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//' '//trim(adjustl(cscr15))
|
|
cscr15=' '
|
|
endif
|
|
! File checks for single point, gradient calculations
|
|
read(dens,'(i2)') idens
|
|
if(idens.ge.2) then
|
|
if(iprog(isp).eq.'mrcc')
|
|
$cscr15='GRAD.'//trim(adjustl(cscr2))
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//
|
|
$' '//trim(adjustl(cscr15))
|
|
cscr15=' '
|
|
endif
|
|
! File checks for single point, gradient + electronic embedding/qmmm calculations
|
|
if((oniomtype.eq.'ee'.and.isp.gt.1).or.qmmm.ne.'off') then
|
|
if(iprog(isp).eq.'mrcc')
|
|
$cscr15='mrcc_job.dat.'//trim(adjustl(cscr2))
|
|
if(iprog(isp).eq.'xtb')
|
|
$cscr15='MINP.'//trim(adjustl(cscr2))//'.pcgrad'
|
|
llg=.true.
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//
|
|
$' '//trim(adjustl(cscr15))
|
|
cscr15=' '
|
|
endif
|
|
if(iprog(isp).eq.'mrcc')
|
|
$cscr15='VARS.'//trim(adjustl(cscr2))
|
|
llg=.true.
|
|
inquire(file=cscr15,exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//
|
|
$' '//trim(adjustl(cscr15))
|
|
cscr15=' '
|
|
endif
|
|
endif
|
|
endif
|
|
if(notfound.gt.0.and.oniomrest.eq.'auto') then
|
|
irest=isp-1
|
|
exit
|
|
endif
|
|
enddo
|
|
if(irest.ne.0) then
|
|
inquire(file='ONIOMSPEC',exist=llg)
|
|
if(.not.llg) then
|
|
notfound=notfound+1
|
|
nofilelist=trim(adjustl(nofilelist))//
|
|
$' ONIOMSPEC'
|
|
endif
|
|
endif
|
|
end subroutine check_oniom_files
|
|
C
|
|
subroutine write_xyz_for_calib
|
|
$(nsp,natoms,natwdummy,nlay,ilay,natomslay,layeratoms,ncent,coord,
|
|
$atsymbol,linkcoord,slinksym,nlinks,minpfile)
|
|
c************************************************************************
|
|
* Write xyz files for boundary calibration
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: i,isp,ilay,iatom
|
|
integer :: nsp
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: nlay
|
|
integer :: ncent
|
|
integer :: minpfile
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: nlinks(nlay)
|
|
double precision :: linkcoord(3,natoms,nlay)
|
|
double precision :: coord(3,ncent)
|
|
character(len=2) :: cscr2
|
|
character(len=2) :: slinksym(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
ilay=1
|
|
do isp=1,nsp
|
|
if(MOD(isp,2).eq.0) then
|
|
ilay=ilay+1
|
|
endif
|
|
write(cscr2,'(i2)') isp
|
|
open(minpfile,file='COORD.'//trim(adjustl(cscr2))//'.xyz')
|
|
write(minpfile,*) natomslay(ilay)+nlinks(ilay)
|
|
write(minpfile,*)
|
|
! Write real atoms
|
|
do iatom=1,natoms
|
|
do i=1,natomslay(ilay)
|
|
if(iatom.eq.layeratoms(i,ilay)) then
|
|
write(minpfile,'(a2,3f15.10)') atsymbol(iatom),
|
|
$ coord(1:3,iatom)
|
|
endif
|
|
enddo
|
|
enddo
|
|
! Write link atoms
|
|
if(nlinks(ilay).gt.0) then
|
|
do iatom=1,nlinks(ilay)
|
|
write(minpfile,'(a2,3f15.10)') slinksym(iatom,ilay),
|
|
$ linkcoord(1:3,iatom,ilay)
|
|
enddo
|
|
endif
|
|
close(minpfile)
|
|
enddo
|
|
end subroutine write_xyz_for_calib
|
|
C
|
|
subroutine get_nelec
|
|
$(atsymbol,atnum,natoms,natwdummy,nelec,ichg,nlistat,listat)
|
|
c************************************************************************
|
|
* Calculate the electron number of the full system
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: iatom
|
|
integer :: natoms
|
|
integer :: natwdummy
|
|
integer :: ichg
|
|
integer :: nelec
|
|
integer :: nlistat
|
|
integer :: listat(nlistat)
|
|
integer :: atnum(natwdummy)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
do iatom=1,nlistat
|
|
call getatnum(atsymbol(listat(iatom)),atnum(listat(iatom)))
|
|
c write(6,'(a,a,a,i2)')
|
|
c $' atsymbol = ',atsymbol(listat(iatom)),
|
|
c $' atnum = ',atnum(listat(iatom))
|
|
nelec=nelec+atnum(listat(iatom))
|
|
enddo
|
|
nelec=nelec+ichg
|
|
end subroutine get_nelec
|
|
C
|
|
subroutine set_multiplicity
|
|
$(nlay,natwdummy,natoms,atnum,nelec,ichg,natomslay,layeratoms,
|
|
$atsymbol,nborders,slinksym,imul)
|
|
c************************************************************************
|
|
* Set default multiplicity
|
|
c************************************************************************
|
|
implicit none
|
|
integer :: ilay,nlay,natwdummy,natoms,iborder
|
|
integer :: ichg(nlay)
|
|
integer :: natomslay(nlay)
|
|
integer :: layeratoms(natoms,nlay)
|
|
integer :: nborders(nlay)
|
|
integer :: atnum(natwdummy)
|
|
integer :: atnumlink
|
|
integer :: nelec(nlay)
|
|
integer :: imul(nlay)
|
|
character(len=2) :: slinksym(natoms,nlay)
|
|
character(len=2) :: atsymbol(natwdummy)
|
|
do ilay=2,nlay
|
|
call get_nelec(atsymbol,atnum,natoms,natwdummy,nelec(ilay),
|
|
$ichg(ilay),natomslay(ilay),layeratoms(1,ilay))
|
|
if(nborders(ilay).ne.0) then
|
|
do iborder=1,nborders(ilay)
|
|
atnumlink=0
|
|
call getatnum(slinksym(iborder,ilay),atnumlink)
|
|
c write(6,'(a,a,a,i2)')
|
|
c $' atsymbol*= ',slinksym(iborder,ilay),
|
|
c $' atnum*= ',atnumlink
|
|
nelec(ilay)=nelec(ilay)+atnumlink
|
|
enddo
|
|
endif
|
|
if(imul(ilay).eq.0) then
|
|
if(MOD(nelec(ilay),2).eq.0) then
|
|
imul(ilay)=1
|
|
else
|
|
imul(ilay)=2
|
|
endif
|
|
endif
|
|
enddo
|
|
c do ilay=1,nlay
|
|
c write(6,'(a,i2,a,i2)') 'ilay = ',ilay,' mult = ',imul(ilay)
|
|
c enddo
|
|
end subroutine set_multiplicity
|
|
C
|
|
************************************************************************
|
|
subroutine amber_block_reader_real
|
|
$(iunit,nquant,quantname,nmsize,rquant,iout)
|
|
************************************************************************
|
|
* Read real-type blocks from the Amber topology file
|
|
************************************************************************
|
|
implicit none
|
|
integer :: iline,n
|
|
integer :: iunit
|
|
integer :: nquant
|
|
integer :: nmsize
|
|
integer :: fullnmsize
|
|
integer :: ios
|
|
integer :: iout
|
|
integer :: linesize
|
|
integer :: iresidue
|
|
integer :: nfullline
|
|
double precision :: rquant(nquant)
|
|
character(len=1) :: linev(16),buffv(80)
|
|
character(len=16) :: linequant,line
|
|
character(len=nmsize) :: quantname
|
|
character(len=80) :: read_buffer,checkstring,fmtstring
|
|
logical :: found
|
|
equivalence(line,linev)
|
|
equivalence(read_buffer,buffv)
|
|
C
|
|
fullnmsize=len('%FLAG ')+nmsize
|
|
checkstring='%FLAG '//quantname
|
|
found=.false.
|
|
! Search for string
|
|
do
|
|
read(iunit,'(a80)',iostat=ios) read_buffer
|
|
if(read_buffer(1:fullnmsize).eq.checkstring) exit
|
|
if(ios.lt.0) exit
|
|
enddo
|
|
if(ios.lt.0) then
|
|
write(iout,'(a)')
|
|
$' Error during the read of the Amber prmtop file.'
|
|
write(iout,'(3a)') ' The ',checkstring,' string is not found.'
|
|
call mrccend(1)
|
|
endif
|
|
! Read the format
|
|
read(iunit,'(a80)',iostat=ios) read_buffer
|
|
read_buffer(1:7)=' '
|
|
fmtstring=trim(adjustl(read_buffer))
|
|
! Read horizontal the block size
|
|
n=9
|
|
linev(1:16)=' '
|
|
do while(buffv(n).ne.'E')
|
|
linev(n)=buffv(n)
|
|
n=n+1
|
|
enddo
|
|
read(line,*) linesize
|
|
! Calculate the vertical block size
|
|
iresidue=mod(nquant,linesize)
|
|
nfullline=(nquant-iresidue)/linesize
|
|
do iline=1,nfullline
|
|
read(iunit,fmtstring)
|
|
$(rquant(n),n=(iline-1)*linesize+1,iline*linesize)
|
|
enddo
|
|
if(iresidue.ne.0) then
|
|
read(iunit,fmtstring)
|
|
$(rquant(n),n=nfullline*linesize+1,nquant)
|
|
endif
|
|
end subroutine amber_block_reader_real
|
|
C
|
|
************************************************************************
|
|
subroutine amber_block_reader_int
|
|
$(iunit,nquant,quantname,nmsize,iquant,iout)
|
|
************************************************************************
|
|
* Read integer-tpye blocks from the Amber topology file
|
|
************************************************************************
|
|
implicit none
|
|
integer :: iline,n
|
|
integer :: iunit
|
|
integer :: nquant
|
|
integer :: nmsize
|
|
integer :: fullnmsize
|
|
integer :: ios
|
|
integer :: iout
|
|
integer :: linesize
|
|
integer :: iresidue
|
|
integer :: nfullline
|
|
integer :: iquant(nquant)
|
|
character(len=1) :: linev(16)
|
|
character(len=1) :: buffv(80)
|
|
character(len=16) :: linequant,line
|
|
character(len=nmsize) :: quantname
|
|
character(len=80) :: read_buffer
|
|
character(len=80) :: checkstring
|
|
character(len=80) :: fmtstring
|
|
logical :: found
|
|
equivalence(line,linev)
|
|
equivalence(read_buffer,buffv)
|
|
C
|
|
fullnmsize=len('%FLAG ')+nmsize
|
|
checkstring='%FLAG '//quantname
|
|
found=.false.
|
|
! Search for string
|
|
do
|
|
read(iunit,'(a80)',iostat=ios) read_buffer
|
|
if(read_buffer(1:fullnmsize).eq.checkstring) exit
|
|
if(ios.lt.0) exit
|
|
enddo
|
|
if(ios.lt.0) then
|
|
write(iout,'(a)')
|
|
$' Error during the read of the Amber prmtop file.'
|
|
write(iout,'(3a)') ' The ',checkstring,' string is not found.'
|
|
call mrccend(1)
|
|
endif
|
|
! Read the format
|
|
read(iunit,'(a80)',iostat=ios) read_buffer
|
|
read_buffer(1:7)=' '
|
|
fmtstring=trim(adjustl(read_buffer))
|
|
! Read horizontal the block size
|
|
n=9
|
|
linev(1:16)=' '
|
|
do while(buffv(n).ne.'I')
|
|
linev(n)=buffv(n)
|
|
n=n+1
|
|
enddo
|
|
read(line,*) linesize
|
|
! Calculate the vertical block size
|
|
iresidue=mod(nquant,linesize)
|
|
nfullline=(nquant-iresidue)/linesize
|
|
do iline=1,nfullline
|
|
read(iunit,fmtstring)
|
|
$(iquant(n),n=(iline-1)*linesize+1,iline*linesize)
|
|
enddo
|
|
if(iresidue.ne.0) then
|
|
read(iunit,fmtstring)
|
|
$(iquant(n),n=nfullline*linesize+1,nquant)
|
|
endif
|
|
end subroutine amber_block_reader_int
|
|
C
|
|
subroutine check_for_mm( imet , nlay , do_mm )
|
|
integer, intent(in) :: nlay
|
|
character(len=*), intent(in) :: imet(nlay)
|
|
logical, intent(out) :: do_mm
|
|
integer :: ilay
|
|
ilay = 1
|
|
do while( ilay .le. nlay .and. .not. do_mm )
|
|
if( imet( ilay ) .eq. 'gfn-ff') then
|
|
do_mm = .true.
|
|
endif
|
|
ilay = ilay + 1
|
|
enddo
|
|
end subroutine check_for_mm
|