mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 04:00:49 +01:00
1952 lines
74 KiB
Fortran
1952 lines
74 KiB
Fortran
************************************************************************
|
|
program dmrcc
|
|
************************************************************************
|
|
* Date last modified: 14/11/2014 *
|
|
* Author: Mihaly Kallay *
|
|
* Version: 1026 *
|
|
* Description: Driver for mrcc *
|
|
* Routines called: getmemr8,getmem,gconfig,intinp,initialt,mpdenom,*
|
|
* ccit,gcoupl *
|
|
* References: J. Chem. Phys. 115, 2945 (2001); 117, 980 (2002); *
|
|
* 119, 2991 (2003). *
|
|
************************************************************************
|
|
use error_handler
|
|
#include "MRCCCOMMON"
|
|
integer i,j,verbosity
|
|
real*8 etest,temp,cput,walt,tmp
|
|
character*4 ctol,cscr4
|
|
character*8 cscr8,gopt,freq,lccrest,orblocguess,oniom !HB
|
|
character*8 ng,rism !GA
|
|
character*15 cscr15
|
|
character*16 devnul,cscr16
|
|
character*24 basopt
|
|
character*30 test
|
|
logical llg,ltmp
|
|
logical, external :: mopac_was_used
|
|
common/output/ devnul
|
|
|
|
c {{{ for MPI
|
|
integer, parameter :: IMPI = 1, OMPI = 2
|
|
character*4 mpitasks_ch
|
|
integer mpi_rank, mpitasks
|
|
data mpi_rank /0/
|
|
#if defined(MPI)
|
|
integer mpi_err, nlen, icomm
|
|
integer system, error
|
|
integer, allocatable :: err_codes(:)
|
|
character*8 rank_ch
|
|
character*(MPI_MAX_PROCESSOR_NAME) pname
|
|
character*64 mpi_argv(2)
|
|
|
|
integer ev_status
|
|
character(len = 32) env_var
|
|
|
|
#ifdef INTELMPI
|
|
call get_environment_variable("I_MPI_MPIRUN",
|
|
$ value = env_var, status = ev_status)
|
|
if(ev_status .eq. 1) call exec_mpirun(IMPI)
|
|
#endif
|
|
#ifdef OPENMPI
|
|
call get_environment_variable("OMPI_COMM_WORLD_RANK",
|
|
$ value = env_var, status = ev_status)
|
|
if(ev_status .eq. 1) call exec_mpirun(OMPI)
|
|
#endif
|
|
|
|
call MPI_Init(mpi_err)
|
|
call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_err)
|
|
|
|
c master_thread = .true. ! 1 dmrcc
|
|
|
|
write(rank_ch, '(i8)') mpi_rank
|
|
if(mpi_rank .ne. 0) then
|
|
outfilename = 'mrcc.out.' // trim(adjustl(rank_ch))
|
|
|
|
iout = 960
|
|
call delete_file(outfilename, .true.)
|
|
open(iout, file = outfilename)
|
|
else
|
|
iout = 6
|
|
outfilename = ' '
|
|
output_folder = 'mpi_output'
|
|
error = system('mkdir -p ' // trim(output_folder) // char(0))
|
|
c if(error .ne. 0) then
|
|
c write(*, '(" Error: Couldn''t create output directory")')
|
|
c call dmrccend(1)
|
|
c end if
|
|
end if
|
|
|
|
if(mpi_rank .ne. 0) devnul = '>>' // trim(outfilename)
|
|
|
|
call MPI_Get_processor_name(pname, nlen, mpi_err)
|
|
|
|
call getcwd(wdir)
|
|
|
|
#else
|
|
inquire(file='MINP',exist=llg)
|
|
if(llg) then
|
|
open(minpfile, file = 'MINP')
|
|
call getkeym('mpitasks', 8, mpitasks_ch, 4)
|
|
close(minpfile)
|
|
else
|
|
mpitasks_ch=' '
|
|
endif
|
|
if(mpitasks_ch .ne. ' ') then
|
|
read(mpitasks_ch, '(i4)') mpitasks
|
|
else
|
|
mpitasks = 1
|
|
end if
|
|
#ifdef INTELMPI
|
|
if(mpitasks .ne. 1) call exec_mpirun(IMPI)
|
|
#endif
|
|
#ifdef OPENMPI
|
|
if(mpitasks .ne. 1) call exec_mpirun(OMPI)
|
|
#endif
|
|
|
|
iout = 6
|
|
devnul = ' '
|
|
outfilename = ' '
|
|
call getcwd(wdir)
|
|
#endif
|
|
call init_error_handler(iout)
|
|
|
|
c }}}
|
|
C Title
|
|
write(iout,1003)
|
|
write(iout,"(26x,a19)") 'MRCC program system'
|
|
write(iout,1003)
|
|
write(iout,*)
|
|
write(iout,*) ' Written by'
|
|
write(iout,*) ' Mihaly Kallay, Peter R. Nagy, David Mester, '
|
|
$// 'Laszlo Gyevi-Nagy,'
|
|
write(iout,*) ' Jozsef Csoka, P. Bernat Szabo,'
|
|
$// ' Zoltan Rolik, Gyula Samu,'
|
|
write(iout,*) ' Jozsef Csontos, Bence Hegely, Adam Ganyecz,'
|
|
$// ' Istvan Ladjanszki,'
|
|
write(iout,*) ' Lorant Szegedy, Bence Ladoczki,'
|
|
$// ' Klara Petrov, Mate Farkas,'
|
|
write(iout,*) ' Pal D. Mezei, and'
|
|
$// ' Reka A. Horvath'
|
|
write(iout,*)
|
|
write(iout,*)
|
|
$' Department of Physical Chemistry and Materials Science'
|
|
write(iout,*)
|
|
$' Budapest University of Technology and Economics'
|
|
write(iout,*)
|
|
$' Budapest P.O.Box 91, H-1521 Hungary'
|
|
write(iout,*)
|
|
write(iout,*) ' www.mrcc.hu'
|
|
write(iout,*)
|
|
write(iout,*) ' Release date: August 28, 2023'
|
|
1003 format(1x,70('*'))
|
|
#if defined(MPI)
|
|
write(iout, *)
|
|
write(iout, '(//," dmrcc running on ",a)') trim(pname)
|
|
#endif
|
|
C Create empty pids file (deleting it only is probably sufficient)
|
|
open(scrfile1,file='pids')
|
|
close(scrfile1,status='delete')
|
|
open(scrfile1,file='pids')
|
|
close(scrfile1)
|
|
C Remove unnecessary files
|
|
open(scrfile1,file='ROUTE')
|
|
close(scrfile1,status='delete')
|
|
open(scrfile1,file='RESTART')
|
|
close(scrfile1,status='delete')
|
|
open(scrfile1,file='ONIOMROUTE')
|
|
close(scrfile1,status='delete')
|
|
call signalinit ! initialise response to SIG's of the OS
|
|
C Check if input files exist
|
|
inquire(file='ITER',exist=llg)
|
|
if(llg) call ishell("rm -f ITER")
|
|
inquire(file='MOCOEF.CAN',exist=llg)
|
|
if(llg) call ishell("rm -f MOCOEF.CAN")
|
|
inquire(file='MINP',exist=llg)
|
|
devnul=' '
|
|
oniom='off '
|
|
if(llg) then
|
|
call runit('minp',cput,walt)
|
|
open(minpfile, file = 'MINP')
|
|
|
|
#if defined(MPI)
|
|
call getkey('mpitasks', 8, mpitasks_ch, 4)
|
|
read(mpitasks_ch, '(i4)') mpitasks
|
|
#endif
|
|
|
|
call getkey('lccrest',7,lccrest,8)
|
|
call getkey('orblocguess',11,orblocguess,8)
|
|
inquire(file='MOCOEF.LOC',exist=ltmp)
|
|
if(ltmp.and.
|
|
$ .not.(lccrest.eq.'domain '.or.lccrest.eq.'restart '.or.
|
|
$ orblocguess.eq.'read '.or.orblocguess.eq.'restart '))
|
|
$ call ishell("rm -f MOCOEF.LOC") ! MOCOEF.LOC is needed for lccrest and orblocguess
|
|
call getkey('basopt',6,basopt,24)
|
|
call getkey('gopt',4,gopt,8)
|
|
call getkey('freq',4,freq,8)
|
|
call getkey('num_grad',8,ng,8)
|
|
call getkey('oniom',5,oniom,8) !HB
|
|
call getkey('rism',4,rism,8) !GA
|
|
if(basopt.ne.'off ') then
|
|
C Optimization of basis sets
|
|
call getkey('verbosity',9,cscr4,4)
|
|
read(cscr4,"(i4)") verbosity
|
|
if(verbosity.le.2) devnul='>/dev/null '
|
|
write(iout,*)
|
|
call basoptdrv(gbasfile)
|
|
else if(gopt.ne.'off ') then
|
|
C Geometry optimization
|
|
call geomoptdrv(minpfile)
|
|
C RISM-calc
|
|
!GA
|
|
else if(trim(rism).ne.'off') then
|
|
call rismcalc(llg)
|
|
else
|
|
C Single-point calculation
|
|
!HB
|
|
if(trim(oniom).ne.'off') then
|
|
call composite(llg)
|
|
else
|
|
call spoint(llg)
|
|
endif
|
|
endif
|
|
C Harmonic vibrational frequency calculation
|
|
if(ng.ne.'off ') call num_grad(iout,minpfile,scrfile3)
|
|
if(freq.ne.'off ') call freqdrv
|
|
else
|
|
C Single-point calculation with the old machinery
|
|
!HB
|
|
if(trim(oniom).ne.'off') then
|
|
call composite(llg)
|
|
else
|
|
call spoint(llg)
|
|
endif
|
|
endif
|
|
C Check test energy
|
|
if(llg) then
|
|
call getkey('test',4,test,30)
|
|
if(test.ne.'off ') then
|
|
call test_job(test,minpfile,freq,gopt,iout)
|
|
endif
|
|
endif
|
|
C
|
|
call dmrccend(0)
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine test_job(test,minpfile,freq,gopt,iout)
|
|
************************************************************************
|
|
* Checking test energies and gradients
|
|
************************************************************************
|
|
implicit none
|
|
integer minpfile,natoms,i,iout,gradfile
|
|
character*4 ctol
|
|
character*8 gopt,freq
|
|
character*15 cscr15
|
|
character*16 cscr16
|
|
character*30 test
|
|
double precision temp,tmp,etest
|
|
double precision grad_ref(3),grad(3),gerr,gtol
|
|
logical mopac_was_used
|
|
logical foundopen
|
|
integer channelopen
|
|
parameter(gradfile=99)
|
|
parameter(gtol=1.0d-8)
|
|
|
|
gerr=0.0d0
|
|
if(trim(test).ne.'gradient') then
|
|
read(test,*) etest
|
|
else
|
|
inquire(file='MINP',opened=foundopen,number=channelopen)
|
|
if(.not.foundopen .or. channelopen .ne. minpfile) then
|
|
open(minpfile,file='MINP',status='OLD',action='READ',
|
|
$ position='REWIND')
|
|
endif
|
|
call getkeym('test',4,test,30)
|
|
read(minpfile,*) etest
|
|
read(minpfile,*) natoms
|
|
open(gradfile,file='GRAD',status='old',form='unformatted')
|
|
do i=1,natoms
|
|
read(minpfile,*) grad_ref(:)
|
|
read(gradfile) grad(:)
|
|
gerr=max(gerr,
|
|
& abs(grad(1)-grad_ref(1)),
|
|
& abs(grad(2)-grad_ref(2)),
|
|
& abs(grad(3)-grad_ref(3)))
|
|
enddo
|
|
close(gradfile)
|
|
endif
|
|
call getenergy(temp,cscr15)
|
|
if(trim(adjustl(cscr15)).eq.'SCF') then
|
|
call getkey('scftol',6,ctol,4)
|
|
else
|
|
call getkey('cctol' ,5,ctol,4)
|
|
endif
|
|
read(ctol,*) i
|
|
if(gopt.ne.'off '.or.freq.ne.'off ') i=i-1
|
|
if(gopt.ne.'off ') then
|
|
call getkey('optetol',7,cscr16,16)
|
|
read(cscr16,*) tmp
|
|
tmp=dabs(dlog10(tmp))
|
|
i=min(i,idnint(tmp))
|
|
endif
|
|
if((gopt.ne.'off '.or.freq.ne.'off ').and.
|
|
$ (trim(adjustl(cscr15)).eq.'ONIOMENER' ).and.
|
|
$ mopac_was_used() ) i = 5
|
|
write(iout,*)
|
|
if(dabs(etest-temp).le.10.d0**(-i).and.gerr.le.gtol) then
|
|
write(iout,*) 'Test job completed successfully.'
|
|
else
|
|
write(iout,*) 'Test job failed to complete successfully!'
|
|
write(iout,*)
|
|
write(iout,"(' Test energy: ',f22.12)") etest
|
|
write(iout,"(' Calculated energy: ',f22.12)") temp
|
|
write(iout,"(' Difference: ',f22.12)") etest-temp
|
|
if(trim(test).eq.'gradient')
|
|
$ write(iout,"(' Gradient max error: ',f22.12)") gerr
|
|
call dmrccend(1)
|
|
endif
|
|
end subroutine
|
|
|
|
************************************************************************
|
|
subroutine dssmrcc(nbmax,ccprog)
|
|
************************************************************************
|
|
* Driver for SSMRCC calculations
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer i,nref,iref,nbmax,noccup(nbmax),roccup(nbmax)
|
|
integer nsingo,ntripo,ndoubo,iclsho,ihfo
|
|
real*8 coef
|
|
logical conv,log
|
|
character*4 ccprog
|
|
C
|
|
call ishell('cp fort.56 bup.56')
|
|
ss1route=.false.
|
|
ss2route=.false.
|
|
ss3route=.false.
|
|
C Solve FCI in reference space
|
|
ss1route=.true.
|
|
open(ssfile,status='unknown',file='fort.31',form='formatted')
|
|
rewind(ssfile)
|
|
write(ssfile,*) ss1route,ss2route,ss3route,1,1.d0
|
|
close(ssfile)
|
|
call ddmrcc(ccprog,.false.,.false.)
|
|
ss1route=.false.
|
|
rewind(ssfile)
|
|
read(ssfile,*) nref
|
|
call ishell('cp fort.16 fort.17')
|
|
C Generate denominators for rho's
|
|
ss2route=.true.
|
|
c ...
|
|
ss2route=.false.
|
|
C Iterations
|
|
ss3route=.true.
|
|
conv=.true.
|
|
rewind(scfile)
|
|
do while(conv)
|
|
do iref=1,nref
|
|
read(scfile,*) coef,noccup
|
|
if(iref.eq.1) then
|
|
do i=1,nbmax
|
|
roccup(i)=noccup(i)
|
|
enddo
|
|
endif
|
|
nsingo=nsing
|
|
ntripo=ntrip
|
|
ndoubo=ndoub
|
|
iclsho=iclsh
|
|
ihfo=ihf
|
|
do i=1,nbmax
|
|
if(iabs(noccup(i)).eq.1) log=.true.
|
|
enddo
|
|
if(log.and.ndoub.eq.0) then
|
|
nsing=0
|
|
ntrip=0
|
|
ndoub=nsingo+ntripo
|
|
iclsh=0
|
|
ihf=0
|
|
endif
|
|
call updatei(.true.,noccup,nbasis/2,op,.false.)
|
|
rewind(ssfile)
|
|
write(ssfile,*) ss1route,ss2route,ss3route,iref,coef
|
|
write(ssfile,*) roccup
|
|
close(ssfile)
|
|
call ddmrcc(ccprog,.false.,.false.)
|
|
nsing=nsingo
|
|
ntrip=ntripo
|
|
ndoub=ndoubo
|
|
iclsh=iclsho
|
|
ihf=ihfo
|
|
enddo
|
|
conv=.false.
|
|
enddo
|
|
ss3route=.false.
|
|
call ishell('mv bup.56 fort.56')
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine dftd3(edisp,subsys) !HB
|
|
************************************************************************
|
|
* Interface to Grimme's dftd3 program to calculate dispersion correction
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
real*8 cput,walt
|
|
character*2 subsys !HB
|
|
character*6 cscr6
|
|
character*8 embed !HB
|
|
character*12 cscr12 !HB
|
|
character*16 ccalc
|
|
character*32 dft,cg
|
|
character*256 edisp
|
|
C Shall we calculate gradient?
|
|
if(dens.ge.2) then
|
|
cg=' -grad | tee dftd3junk '
|
|
else
|
|
cg=' | tee dftd3junk '
|
|
endif
|
|
C Call DFT-D3
|
|
if(trim(edisp).eq.'auto') then
|
|
call getkey('dft',3,dft,32)
|
|
call getkey('calc',4,ccalc,16)
|
|
if(trim(dft).eq.'b3lyp'.or.trim(dft).eq.'b3lyp3') then
|
|
call runit('dftd3 COORD.xyz -func b3-lyp -bj'//cg,cput,walt)
|
|
call edispprint('B3LYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'b3pw91') then
|
|
call runit('dftd3 COORD.xyz -func b3pw91 -bj'//cg,cput,walt)
|
|
call edispprint('B3PW91-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'bhlyp') then
|
|
call runit('dftd3 COORD.xyz -func bh-lyp -bj'//cg,cput,walt)
|
|
call edispprint('BHLYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'blyp') then
|
|
call runit('dftd3 COORD.xyz -func b-lyp -bj'//cg,cput,walt)
|
|
call edispprint('BLYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'bp86') then
|
|
call runit('dftd3 COORD.xyz -func b-p -bj'//cg,cput,walt)
|
|
call edispprint('BP86-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'pbe') then
|
|
call runit('dftd3 COORD.xyz -func pbe -bj'//cg,cput,walt)
|
|
call edispprint('PBE-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'pbe0') then
|
|
call runit('dftd3 COORD.xyz -func pbe0 -bj'//cg,cput,walt)
|
|
call edispprint('PBE0-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'hcth120') then
|
|
call runit('dftd3 COORD.xyz -func hcth120 -bj'//cg,cput,walt)
|
|
call edispprint('HCTH120-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'hyb_mgga_xc_mpw1b95') then
|
|
call runit('dftd3 COORD.xyz -func mpw1b95 -bj'//cg,cput,walt)
|
|
call edispprint('mPW1B95-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'tpss') then
|
|
call runit('dftd3 COORD.xyz -func tpss -bj'//cg,cput,walt)
|
|
call edispprint('TPSS-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'hyb_mgga_xc_tpssh') then
|
|
call runit('dftd3 COORD.xyz -func tpssh -bj'//cg,cput,walt)
|
|
call edispprint('TPSSh-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'b2plyp') then
|
|
call runit('dftd3 COORD.xyz -func b2-plyp -bj'//cg,cput,walt)
|
|
call edispprint('B2PLYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'cam-b3lyp') then
|
|
call runit('dftd3 COORD.xyz -func cam-b3lyp -bj'//cg,cput,walt)
|
|
call edispprint('CAM-B3LYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'wb97x') then ! wB97X-D3(BJ) Tab S25 JCTC 14, 5725 (2018) s6/a1/s8/a2
|
|
call ishell('echo "1.0 0.0 0.2641 5.4959 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('wB97X-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'m06-l') then
|
|
call runit('dftd3 COORD.xyz -func m06l -zero'//cg,cput,walt)
|
|
call edispprint('M06-L-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'m06-2x') then
|
|
call runit('dftd3 COORD.xyz -func m062x -zero'//cg,cput,walt)
|
|
call edispprint('M06-2X-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'lc-wpbe') then
|
|
call runit('dftd3 COORD.xyz -func lc-wpbe -bj'//cg,cput,walt)
|
|
call edispprint('LC-wPBE-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'b2gpplyp') then
|
|
call runit('dftd3 COORD.xyz -func b2gp-plyp -bj'//cg,cput,walt)
|
|
call edispprint('B2GPPLYP-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'pw91') then ! Tab S3 of GMTKN55 SM, PCCP 19, 32184 (2017)
|
|
call ishell('echo "1.0 0.6319 1.9598 4.5718 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('PW91-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'mn15') then ! Tab S3 of GMTKN55 SM, PCCP 19, 32184 (2017)
|
|
call ishell('echo "1.0 2.0971 0.7862 7.5923 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('MN15-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'scan') then ! Tab S3 of GMTKN55 SM, PCCP 19, 32184 (2017)
|
|
call ishell('echo "1.0 0.538 0.000 5.420 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('SCAN-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'dsdpbep86') then
|
|
call ishell('echo "0.418 0.0000 0.000 5.65 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('DSDPBEP86-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'dsdpbehb95') then
|
|
call ishell('echo "0.58 0.0000 0.000 6.2 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('DSDPBEhB95-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'drpa75') then
|
|
call ishell('echo "0.375 0.0000 0.000 4.505 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('dRPA75-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'scs-drpa75') then
|
|
call ishell('echo "0.375 0.0000 0.000 4.505 0.0000 4" >' //
|
|
$'$HOME/.dftd3par.`hostname`')
|
|
call runit('dftd3 COORD.xyz -bj'//cg,cput,walt)
|
|
call ishell('rm -f $HOME/.dftd3par.`hostname`')
|
|
call edispprint('SCS-dRPA75-D3 ',cput,walt,subsys)
|
|
else if(trim(dft).eq.'off'.and.
|
|
$ ccalc.eq.'scf ') then
|
|
call runit('dftd3 COORD.xyz -func hf -bj'//cg,cput,walt)
|
|
call edispprint('HF-D3 ',cput,walt,subsys)
|
|
else
|
|
write(iout,*)
|
|
write(iout,*) 'Empirical dispersion correction is not ' //
|
|
$'implemented for this method!'
|
|
call dmrccend(1)
|
|
endif
|
|
else
|
|
open(minpfile,file='MINP')
|
|
!!! !HB
|
|
if(subsys.eq.'no'.or.subsys.eq.'a1') then
|
|
call getkeym('edisp',5,edisp,256)
|
|
backspace(minpfile)
|
|
read(minpfile,"(a6,a256)") cscr6,edisp
|
|
else
|
|
call getkeym('edisp_embed',11,edisp,256)
|
|
backspace(minpfile)
|
|
read(minpfile,"(a12,a256)") cscr12,edisp
|
|
endif
|
|
!!!
|
|
close(minpfile)
|
|
edisp='dftd3 COORD.xyz ' // trim(edisp) // cg
|
|
call runit(trim(edisp),cput,walt)
|
|
call edispprint('Corrected ',cput,walt,subsys)
|
|
endif
|
|
C
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine edispprint(meth,cput,walt,subsys) !HB
|
|
************************************************************************
|
|
* Read and print dispersion correction
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer i,j
|
|
real*8 edisp,temp,cput,walt,tmp
|
|
character*2 subsys !HB
|
|
character*6 cscr6
|
|
character*8 cscr8
|
|
character*15 cscr15
|
|
character*16 meth,c16
|
|
character*33 cscr32
|
|
C
|
|
if(subsys.ne.'no') then !HB
|
|
write(iout,*)
|
|
if(subsys.eq.'ab') then
|
|
write(iout,'(a)') ' D3 correction of the full system using the'
|
|
$//' low-level method:'
|
|
elseif(subsys.eq.'a2') then
|
|
write(iout,'(a)') ' D3 correction of the embedded subsystem'
|
|
$//' using the low-level method:'
|
|
elseif(subsys.eq.'a1') then
|
|
write(iout,'(a)') ' D3 correction of the embedded subsystem'
|
|
$//' using the high-level method:'
|
|
endif
|
|
endif !HB
|
|
write(iout,*)
|
|
write(iout,"(1x,70('*'))")
|
|
open(scrfile1,file='dftd3junk',status='old')
|
|
cscr6=' '
|
|
do while(cscr6.ne.'Edisp ')
|
|
read(scrfile1,*,end=9876) cscr6
|
|
cscr6=adjustl(cscr6)
|
|
enddo
|
|
backspace(scrfile1)
|
|
read(scrfile1,"(a16,f11.4,f12.8)",end=9876) c16,tmp,edisp
|
|
close(scrfile1,status='delete')
|
|
write(iout,"(' Dispersion correction [au]: ',f22.12)") edisp
|
|
open(unit=ifcfile,file='iface',status='old')
|
|
i=0
|
|
do
|
|
read(ifcfile,*,end=7597)
|
|
i=i+1
|
|
enddo
|
|
7597 rewind(ifcfile)
|
|
do j=1,i-1
|
|
read(ifcfile,*)
|
|
enddo
|
|
read(ifcfile,7596) cscr8,cscr15,i,i,i,ecc,temp,temp
|
|
if(subsys.ne.'a2') then !HB
|
|
ecc=ecc+edisp
|
|
else
|
|
ecc=ecc-edisp
|
|
endif !HB
|
|
cscr32=adjustl(trim(meth) // ' energy [au]:')
|
|
if(subsys.ne.'no') then !HB
|
|
write(iout,*)
|
|
if(subsys.eq.'a1'.or.subsys.eq.'a2')
|
|
$ cscr32='Final energy [au]:'
|
|
endif !HB
|
|
write(iout,"(1x,a32,f22.12)") cscr32,ecc
|
|
cscr15=trim(cscr15) // '-D3'
|
|
write(ifcfile,7596) cscr8,cscr15,i,i,i,ecc,cput,walt
|
|
close(ifcfile)
|
|
7596 format(a8,1x,a15,1x,3(i2,1x),1pe23.15,2(1pe15.8))
|
|
C
|
|
return
|
|
9876 write(iout,*)
|
|
$'Fatal error at the calculation of dispersion correcction!'
|
|
call dmrccend(1)
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine spoint(llg)
|
|
************************************************************************
|
|
* Driver for single-point calculations
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
integer i,j,m,nnb,itol,imult,nstate,istate,nstate2,denscorr
|
|
real*8 intcpu,intwal,orbcpu,orbwal,cput,walt,ovirtcpud,ovirtwald
|
|
real*8 intcpud,intwald,scfcpu,scfwal
|
|
real*8 lmp2ened,temp,edftbcor,comega,omega,cmp2
|
|
real*8 finalener,selfener
|
|
logical llg,log1,log2,log3
|
|
character*3 qro
|
|
character*4 localcc,cmult,ccprog,ctol,cscr4,molden,scfdtol,scftol
|
|
character*4 ccsdrest,cgrad
|
|
character*6 dhexc
|
|
character*5 scftype
|
|
character*8 lccrest
|
|
character*7 scfiguess,mcscfiguess
|
|
character*8 cscr,scfalg,dfalg,qscf
|
|
character*8 iface,cscr8,qmmm,qmreg,dfintran,cialg,embed,grdens,rsh
|
|
character*8 corembed
|
|
character*8 dual,lccoporder,dual_df
|
|
character*13 agrid,agrid_pssp
|
|
character*15 cscr15
|
|
character*16 orblocc,orbloco,orblocv,calctype,dft,c16,orbloce!HB
|
|
character*16 excrad_fin
|
|
character*16 moselectalg
|
|
character*20 dfbasis_scf,dfbasis_cor,basis_sm,dfbasis_scf_sm
|
|
character*256 edisp,edisp_embed !HB
|
|
logical lseqc,lrpa,lrpanocc,localcc15p,lf12,dof12,locdrvdone
|
|
C Initialize variables
|
|
moselectalg=''
|
|
huzitype=0
|
|
tim=0.d0
|
|
intcpu=0.d0
|
|
intwal=0.d0
|
|
orbcpu=0.d0
|
|
orbwal=0.d0
|
|
ovirtcpud=0.d0
|
|
ovirtwald=0.d0
|
|
scfcpu=0.d0
|
|
scfwal=0.d0
|
|
localcc='off '
|
|
locno=0
|
|
rsh=' '
|
|
nfroz=0
|
|
nvfroz=0
|
|
cput=0.d0
|
|
walt=0.d0
|
|
call ishell('rm -f ROUTE')
|
|
if(llg) then
|
|
C Analyze the input file
|
|
call getkey('iface',5,iface,8)
|
|
call ishell('rm -f DOMAIN')
|
|
call getkey('localcc',7,localcc,4)
|
|
call getkey('lccrest',7,lccrest,8)
|
|
call getkey('lccoporder',10,lccoporder,8)
|
|
call getkey('ccprog',6,ccprog,4) ! integ might change ccprog later
|
|
call getkey('ccsdrest',8,ccsdrest,4)
|
|
call getkey('calc',4,calctype,16)
|
|
call getkey('dfbasis_scf',11,dfbasis_scf,20)
|
|
call getkey('dfbasis_cor',11,dfbasis_cor,20)
|
|
call getkey('qmmm',4,qmmm,8)
|
|
call getkey('dfintran',8,dfintran,8)
|
|
call getkey('nstate',6,cscr4,4)
|
|
call getkey('grdens',6,grdens,8)
|
|
call getkey('scfdtol',7,scfdtol,4)
|
|
call getkey('scftol',6,scftol,4)
|
|
call getkey('dual',4,dual,8)
|
|
call getkey('scftype',7,scftype,5)
|
|
call getkey('qscf',4,qscf,8)
|
|
call getkey('mult',4,cmult,4)
|
|
call getkey('scfalg',6,scfalg,8)
|
|
call getkey('dfalg',5,dfalg,8)
|
|
call getkey('dual_df',7,dual_df,8)
|
|
call getkey('agrid_pssp',10,agrid_pssp,13)
|
|
call getkey('qro',3,qro,3)
|
|
call getkey('corembed',8,corembed,8) !
|
|
read(cscr4,*) nstate
|
|
call getkey('nsing' ,5,cscr4,4)
|
|
read(cscr4,*) i
|
|
call getkey('ntrip' ,5,cscr4,4)
|
|
read(cscr4,*) j
|
|
if(nstate.ne.0.and.i.ne.0.and.j.ne.0) nstate2=i+j
|
|
if(nstate.eq.0.and.i.ne.0.and.j.ne.0) nstate2=i+j
|
|
if(nstate.ne.0.and.i.ne.0.and.j.eq.0) nstate2=i
|
|
if(nstate.ne.0.and.i.eq.0.and.j.ne.0) nstate2=j+1
|
|
if(nstate.eq.0.and.i.eq.0.and.j.ne.0) nstate2=j+1
|
|
if(nstate.eq.0.and.i.ne.0.and.j.eq.0) nstate2=i
|
|
if(nstate.ne.0.and.i.eq.0.and.j.eq.0) nstate2=nstate
|
|
nstate=nstate2
|
|
call getkey('denscorr',8,cscr4,4)
|
|
read(cscr4,*) denscorr
|
|
lf12=dof12(calctype)
|
|
if (lccrest.eq.'on ') goto 317
|
|
c if (lccrest.eq.'restart ') goto 318
|
|
if(iface.eq.'none ') then
|
|
call getkey('embed',5,embed,8)
|
|
call getkey('edisp_embed',11,edisp_embed,256) !HB
|
|
call getkey('molden',6,molden,4)
|
|
call getkey('scfiguess',9,scfiguess,7)
|
|
if(lccrest.eq.'off ' .and. ccsdrest.eq.'ccsd') goto 317
|
|
C SQM method as initial guess
|
|
if(scfiguess.eq.'gfn2 '.or.scfiguess.eq.'gfn1 ') then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'sml'
|
|
close(scrfile1)
|
|
call changekey('dfbasis_cor',11,'none ',20)
|
|
call changekey('dfbasis_scf',11,'none ',20)
|
|
call getkey('basis_sm',8,basis_sm,20)
|
|
if(scfiguess.eq.'gfn1 ')
|
|
$ call changekey('basis_sm',8,'GFN1-xTB',8)
|
|
if(scfiguess.eq.'gfn2 ')
|
|
$ call changekey('basis_sm',8,'GFN2-xTB',8)
|
|
call changekey('symm',4,'0 ',4)
|
|
call runit('integ',intcpu,intwal)
|
|
call changekey('dfbasis_scf',11,dfbasis_scf,20)
|
|
call changekey('dfbasis_cor',11,dfbasis_cor,20)
|
|
call changekey('scfalg',6,scfalg,8)
|
|
call changekey('dfalg',5,dfalg,8)
|
|
call changekey('calc',4,calctype,16)
|
|
call changekey('scfiguess',9,'gfnrest',7)
|
|
endif
|
|
if(scfiguess.eq.'off '.or.scfiguess.eq.'lowlqm ')
|
|
$ call getvar('eref ',eref)
|
|
C Run SCF calculation in small basis
|
|
if(dual_df.ne.'off ') then
|
|
call getkey('excrad_fin',10,excrad_fin,16)
|
|
call getkey('excrad',6,c16,16)
|
|
call changekey('excrad_fin',10,c16,16)
|
|
if(dual_df.eq.'grid ') then
|
|
call getkey('agrid_pssp_sm',13,c16,13)
|
|
call changekey('agrid_pssp',10,c16,13)
|
|
endif
|
|
if(dual_df.eq.'dab ') then
|
|
call getkey('dfbasis_scf_sm',14,dfbasis_scf_sm,20)
|
|
call changekey('dfbasis_scf',11,dfbasis_scf_sm,20)
|
|
endif
|
|
endif
|
|
if(scfiguess.eq.'min '.or.scfiguess.eq.'small '.or.
|
|
$dual.eq.'on '.or.dual_df.ne.'off ') then
|
|
if (scfiguess.ne.'off ') then
|
|
open(scrfile1,file='ROUTE')
|
|
if(scfiguess.eq.'min ') then
|
|
write(scrfile1,"(a3)") 'min'
|
|
call changekey('scfdtol',7,'6 ',4)
|
|
call changekey('scftol',6,'5 ',4)
|
|
else if(lf12) then
|
|
write(scrfile1,"(a4)") 'f121'
|
|
else
|
|
write(scrfile1,"(a3)") 'sml'
|
|
endif
|
|
close(scrfile1)
|
|
if(.not.lf12) then
|
|
if(dual_df.eq.'off ')
|
|
& call changekey('dfbasis_scf',11,'auto ',20)
|
|
call changekey('dfbasis_cor',11,'none ',20)
|
|
if(scfiguess.ne.'restart')
|
|
$ call changekey('scfiguess',9,'sad ',7)
|
|
call changekey('calc',4,'scf ',16)
|
|
write(iout,*)
|
|
if(dual_df.eq.'dm ') then
|
|
write(iout,*)'Calculating integrals for overlap-metric SCF...'
|
|
elseif(dual_df.eq.'grid ') then
|
|
write(iout,*)'Calculating integrals for small-grid COSX...'
|
|
else
|
|
write(iout,*)'Calculating integrals for small-basis SCF...'
|
|
endif
|
|
endif
|
|
call runit('integ',intcpu,intwal)
|
|
if(lf12) then
|
|
call ishell('cp DOMAIN DOMAIN_AO')
|
|
call ishell('cp SROOT SROOT_AO')
|
|
call ishell('cp OEINT OEINT_AO')
|
|
else
|
|
write(iout,*)
|
|
if(dual_df.eq.'dm ') then
|
|
write(iout,*) 'Running overlap-metric SCF...'
|
|
elseif(dual_df.eq.'grid ') then
|
|
write(iout,*) 'Running small-grid COSX...'
|
|
else
|
|
write(iout,*) 'Running small-basis SCF...'
|
|
endif
|
|
endif
|
|
call ishell('rm -f DOMAIN')
|
|
if(dual.ne.'off '.or.dual_df.ne.'off ') then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'sml'
|
|
close(scrfile1)
|
|
endif
|
|
if (qro.eq.'on ') call changekey('qro',3,'off',3)
|
|
call runit('scf',cput,walt)
|
|
if (qro.eq.'on ') then
|
|
call changekey('qro',3,'on ',3)
|
|
call changekey('scftype',7,'uhf ',5)
|
|
endif ! qro.eq.on
|
|
call changekey('dfbasis_scf',11,dfbasis_scf,20)
|
|
call changekey('dfbasis_cor',11,dfbasis_cor,20)
|
|
call changekey('calc',4,calctype,16)
|
|
call changekey('agrid_pssp',10,agrid_pssp,13)
|
|
if(lf12) then
|
|
call ishell('cp VARS VARS_AO')
|
|
call ishell('cp FOCK FOCK_AO')
|
|
endif
|
|
endif
|
|
call changekey('scfiguess',9,'restart',7)
|
|
if (scfiguess.eq.'off ') then
|
|
call getkey('scfiguess',9,scfiguess,7)
|
|
write(iout,*)
|
|
write(iout,*) 'Small-basis SCF results are taken from the'
|
|
write(iout,*) ' VARS and SCFDENSITIES files'
|
|
call scfiguessOFFtasks(scfcpu,scfwal,2)
|
|
write(iout,*)
|
|
write(iout,*) ' beginning the large basis calculation'
|
|
endif
|
|
if(scfiguess.eq.'min ') then
|
|
call changekey('scfdtol',7,scfdtol,4)
|
|
call changekey('scftol',6,scftol,4)
|
|
endif
|
|
if(lf12) then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a4)") 'f122'
|
|
close(scrfile1)
|
|
endif
|
|
else if(dual.eq.'e1 '.or.dual.eq.'e2 ') then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'sml'
|
|
close(scrfile1)
|
|
call changekey('dfbasis_cor',11,'none ',20)
|
|
call changekey('calc',4,'scf ',16)
|
|
endif
|
|
C Calculate integrals
|
|
call runit('integ',intcpu,intwal)
|
|
call getkey('ccprog',6,ccprog,4) ! integ might change ccprog
|
|
if(scfiguess.eq.'off ') then
|
|
call scfiguessOFFtasks(scfcpu,scfwal,1)
|
|
goto 8765
|
|
endif
|
|
C Projector construction for frozen MO QMMM
|
|
if(qmmm.eq.'amber ') then
|
|
open(minpfile,file='MINP')
|
|
call getkeym('qmreg',5,qmreg,8)
|
|
close(minpfile)
|
|
if(qmreg.eq.'0 ') then
|
|
call set_qmmod_route(scrfile1,'build_proj')
|
|
call runit('qmmod',orbcpu,orbwal)
|
|
endif
|
|
endif
|
|
C DFT calculation in the case of embedding
|
|
call calc_low_levels_of_embedding
|
|
$ (embed,ccprog,edisp_embed,scfiguess,moselectalg,dual)
|
|
C SCF calculations
|
|
if(trim(scftype).eq.'mcscf') then
|
|
call getkey('mcscfiguess',11,mcscfiguess,7)
|
|
if(trim(mcscfiguess).eq.'hf') then
|
|
call changekey('calc',4,'scf ',16)
|
|
if(trim(cmult).eq.'1') then
|
|
call changekey('scftype',7,'rhf ',5)
|
|
else
|
|
call changekey('scftype',7,'rohf ',5)
|
|
endif
|
|
call changekey('qscf',4,'off ',8)
|
|
call runit('scf',cput,walt)
|
|
call changekey('calc',4,calctype,16)
|
|
call changekey('scftype',7,'mcscf',5)
|
|
call changekey('scfiguess',9,'mo ',7)
|
|
call changekey('qscf',4,qscf,8)
|
|
else
|
|
call changekey('scfiguess',9,mcscfiguess,7)
|
|
endif
|
|
endif
|
|
if(dual.ne.'e2 ') then
|
|
if(dual_df.ne.'off ') then
|
|
call getkey('fitting',7,cscr,8)
|
|
call getkey('excrad',6,c16,16)
|
|
call getkey('occri',5,cscr8,8)
|
|
call changekey('excrad',6,excrad_fin,16)
|
|
call changekey('excrad_fin',10,excrad_fin,16)
|
|
call changekey('fitting',7,'coulomb ',8)
|
|
call changekey('occri',5,'off ',8)
|
|
endif
|
|
call runit('scf',cput,walt)
|
|
if(dual_df.ne.'off ') then
|
|
call changekey('fitting',7,cscr,8)
|
|
call changekey('excrad',6,c16,16)
|
|
call changekey('occri',5,cscr8,8)
|
|
endif
|
|
endif
|
|
scfcpu=cput
|
|
scfwal=walt
|
|
C Dual basis set embedding
|
|
if(dual.eq.'e1 '.or.dual.eq.'e2 ') then
|
|
if(dual.eq.'e1 ')
|
|
$ call ishell('mv MOCOEF MOCOEF_A')
|
|
call ishell('rm -f DOMAIN')
|
|
call changekey('dfbasis_cor',11,dfbasis_cor,20)
|
|
call changekey('calc',4,calctype,16)
|
|
call changekey('scfiguess',9,'restart',7)
|
|
call getvar('nfroz ',nfroz)
|
|
call getvar('ncore ',ncore)
|
|
call runit('integ',intcpu,intwal)
|
|
open(varsfile,file='VARS',form='unformatted',
|
|
$position='append')
|
|
write(varsfile) 'nfroz ',iintln,nfroz
|
|
write(varsfile) 'ncorenew ',iintln,ncore
|
|
write(varsfile) 'huzitype ',iintln,huzitype !HB
|
|
close(varsfile)
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a4)") 'em1b'
|
|
close(scrfile1)
|
|
if(dual.eq.'e2 ') then
|
|
open(scrfile1,file='FOCK',form='unformatted')
|
|
read(scrfile1)
|
|
read(scrfile1) ncore
|
|
close(scrfile1)
|
|
endif
|
|
call runit('scf',cput,walt)
|
|
if(dual.eq.'e2 ') then
|
|
open(scrfile1,file='FOCK',form='unformatted')
|
|
read(scrfile1)
|
|
write(scrfile1) ncore
|
|
close(scrfile1)
|
|
endif
|
|
c call getkey('orblocc',7,orblocc,16)
|
|
c call getkey('orbloco',7,orbloco,16)
|
|
c if(orblocc.eq.'off ')
|
|
c $call changekey('orblocc',7,'pm ',16)
|
|
c if(orbloco.eq.'off ')
|
|
c $call changekey('orbloco',7,'pm ',16)
|
|
c call runit('orbloc',orbcpu,orbwal)
|
|
c call changekey('orblocc',7,orblocc,16)
|
|
c call changekey('orbloco',7,orbloco,16)
|
|
c call runit('qmmod',orbcpu,orbwal)
|
|
call ishell('mv SCFDENSITIES_A SCFDENSITIES')
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a4)") 'em2b'
|
|
close(scrfile1)
|
|
call runit('scf',cput,walt)
|
|
open(scrfile1,file='ROUTE')
|
|
if(dual.eq.'e1 ') then
|
|
write(scrfile1,"(a4)") 'em3b'
|
|
call ishell('mv SCFDENSITIES_At SCFDENSITIES')
|
|
else
|
|
write(scrfile1,"(a3)") 'em3'
|
|
endif
|
|
close(scrfile1)
|
|
call runit('scf',cput,walt)
|
|
endif
|
|
C
|
|
if(trim(grdens).ne.'off'.and.
|
|
$trim(calctype).ne.'scf') call ishell('cp DENSITY DENSITY.SCF')
|
|
8765 continue
|
|
if(embed.eq.'fdm '.and.trim(calctype).ne.'scf') then
|
|
call ishell('rm -f DOMAIN')
|
|
call runit('integ',intcpud,intwald)
|
|
endif
|
|
call getvar('rsh ',rsh)
|
|
C Integral transformation for the CPHF equations in the case of DF
|
|
call getkey('dens',4,cscr4,4)
|
|
read(cscr4,*) dens
|
|
if(dens.ne.0.and.dfbasis_scf.ne.'none '.and.
|
|
$ calctype.ne.'scf '.and.
|
|
$ trim(ccprog).ne.'cis') then
|
|
call ishell('mv DFINV DFINV_SCF')
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'scf'
|
|
close(scrfile1)
|
|
call runit('drpa',ovirtcpud,ovirtwald)
|
|
call ishell('mv DFINT_AB DFINT_AB_SCF')
|
|
call ishell('mv DFINT_AI DFINT_AI_SCF')
|
|
call ishell('mv DFINT_IJ DFINT_IJ_SCF')
|
|
endif
|
|
C Orbital localization
|
|
call getkey('orblocc',7,orblocc,16)
|
|
call getkey('orbloco',7,orbloco,16)
|
|
call getkey('orblocv',7,orblocv,16)
|
|
if(orblocc.ne.'off '.or.
|
|
$ orbloco.ne.'off '.or.
|
|
$ (orblocv.ne.'off '.and.
|
|
$ orblocv.ne.'pao ')) then
|
|
|
|
if (qro.eq.'on ') then
|
|
if(molden.ne.'off ') call ishell('cp MOLDEN MOLDEN.QRO')
|
|
if(scfiguess.eq.'off ') then
|
|
! make sure that QROs are localized and not the unrestricted MOs
|
|
write(iout,*)
|
|
write(iout,'(" File MOCOEF.QRO is copied to MOCOEF")')
|
|
call ishell('cp MOCOEF.QRO MOCOEF')
|
|
else
|
|
! MOCOEF.CAN already contains the canonical UHF orbitals, don't overwrite them
|
|
write(iout,*)
|
|
write(iout,'(" File MOCOEF is copied to MOCOEF.QRO")')
|
|
call ishell('cp MOCOEF MOCOEF.QRO')
|
|
endif
|
|
else
|
|
if(molden.ne.'off ') call ishell('cp MOLDEN MOLDEN.CAN')
|
|
call ishell('cp MOCOEF MOCOEF.CAN')
|
|
endif !qro
|
|
call runit('orbloc',orbcpu,orbwal)
|
|
if(corembed.ne.'off') then
|
|
call set_qmmod_route(scrfile1,'select_only_occ')
|
|
call runit('qmmod',orbcpu,orbwal)
|
|
endif
|
|
if(embed.ne.'off' .and. orblocv.eq.'pao-subsys') then
|
|
call getvar('nvfroz ',nvfroz)
|
|
if(embed.ne.'off') call getvar('nfroz ',nfroz)
|
|
endif
|
|
call ishell('cp MOCOEF MOCOEF.LOC') !NP
|
|
C Construction of frozen localized MOs for QM/MM calculation
|
|
if(qmmm.eq.'amber ') then
|
|
open(minpfile,file='MINP')
|
|
call getkeym('qmreg',5,qmreg,8)
|
|
close(minpfile)
|
|
if(qmreg.ne.'0 '.and.
|
|
$ qmreg.ne.' ') then
|
|
call set_qmmod_route(scrfile1,'select_only_occ')
|
|
call runit('qmmod',orbcpu,orbwal)
|
|
endif
|
|
endif
|
|
endif
|
|
endif
|
|
c 318 continue ! restart here if lccrest=restart/domain NOT YET OK integ?
|
|
lrpanocc=(calctype.eq.'mp2 '.and.
|
|
$ trim(dfbasis_cor).ne.'none')
|
|
$ .or. ! call ldrpa.f, no CC calculation
|
|
$ calctype.eq.'os-mp3 '.or.
|
|
$ calctype.eq.'drpa '.or.
|
|
$ calctype.eq.'sosex '.or.
|
|
$ calctype.eq.'rpax2 '.or.
|
|
$ calctype.eq.'rpa '
|
|
lrpa=lrpanocc.or.localcc15p(localcc)
|
|
c {{{ save timings of integ, scf, orbloc for localcc.restart ! NP
|
|
if(lrpa.and.nstate.lt.2.and.lccrest.eq.'off ') then
|
|
open(varsfile,file='VARS',form='unformatted',position='append')
|
|
write(varsfile) 'savedtimes',ifltln*6,
|
|
$ intcpu,intwal,scfcpu,scfwal,orbcpu,orbwal
|
|
close(varsfile)
|
|
endif
|
|
c }}}
|
|
if(calctype.eq.'scf '.and.nstate.lt.2) goto 1006
|
|
C Write fort.56 for ovirt and mrcc
|
|
open(inp,status='old',file='fort.55')
|
|
rewind(inp)
|
|
if(iface.eq.'none ') then
|
|
c read(inp,*,end=1002) nbasis,nocc,ncore
|
|
call getvar('nbf ',nbf)
|
|
call getvar('nal ',nal)
|
|
call getvar('nbe ',nbe)
|
|
call getvar('ncore ',ncore)
|
|
call getvar('omega ',omega)
|
|
call getvar('comega ',comega)
|
|
call getvar('cmp2 ',cmp2)
|
|
nbasis=nbf(1)
|
|
nocc=nal+nbe
|
|
else
|
|
omega=0.d0
|
|
comega=0.d0
|
|
cmp2=0.d0
|
|
read(inp,*,end=1002) nbasis,nocc
|
|
ncore=0
|
|
call getkey('mult',4,cmult,4)
|
|
if(cmult.eq.' ') then
|
|
if(mod(nocc,2).eq.0) then
|
|
cmult='1 '
|
|
else
|
|
cmult='2 '
|
|
endif
|
|
call changekey('mult',4,cmult,4)
|
|
endif
|
|
read(cmult,*) imult
|
|
nbe=(nocc-imult+1)/2
|
|
nal=nbe+imult-1
|
|
rsh=' '
|
|
endif
|
|
if(ccprog.ne.'cis '.and.(.not.lrpa.or.
|
|
$ (localcc15p(localcc)
|
|
$ .and.ccprog.eq.'mrcc'.and..not.lrpanocc)))
|
|
$ call write56(nbasis,iface,calctype,.false.,nal,nbe)
|
|
close(inp)
|
|
if(trim(ccprog).eq.'cis'.and.localcc.eq.'off ') then
|
|
open(varsfile,file='VARS',form='unformatted',position='append')
|
|
write(varsfile) 'localex ',iintln,0
|
|
close(varsfile)
|
|
endif
|
|
C Calculate short/long-range integrals
|
|
if(rsh.eq.' '.and.trim(ccprog).eq.'cis'
|
|
$.and.omega.ne.0d0.and.cmp2.ne.0.d0) then ! ansatz of goerigk / range-separated exchange
|
|
C for excited-state DH calculations
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'rsh'
|
|
close(scrfile1)
|
|
endif
|
|
C
|
|
if(rsh.ne.' ') then
|
|
open(scrfile1,file='ROUTE')
|
|
if(trim(rsh).eq.'lr'.or.trim(rsh).eq.'both') then
|
|
write(scrfile1,"(a5)") 'rshtl'
|
|
else
|
|
write(scrfile1,"(a5)") 'rshts'
|
|
endif
|
|
close(scrfile1)
|
|
call ishell('cp VARS VARS.old')
|
|
call runit('integ',intcpud,intwald)
|
|
call ishell('cp VARS.old VARS')
|
|
open(scrfile1,file='ROUTE')
|
|
if(trim(rsh).eq.'lr'.or.trim(rsh).eq.'both') then
|
|
write(scrfile1,"(a5)") 'rshtl'
|
|
else
|
|
write(scrfile1,"(a5)") 'rshts'
|
|
endif
|
|
close(scrfile1)
|
|
call runit('drpa',ovirtcpud,ovirtwald)
|
|
C
|
|
if(trim(rsh).eq.'both') then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a5)") 'rshts'
|
|
close(scrfile1)
|
|
call ishell('cp VARS.old VARS')
|
|
call runit('integ',intcpud,intwald)
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a5)") 'rshts'
|
|
close(scrfile1)
|
|
call ishell('mv VARS.old VARS')
|
|
call runit('drpa',ovirtcpud,ovirtwald)
|
|
else
|
|
call ishell('rm -rf VARS.old')
|
|
endif
|
|
C
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'rsh'
|
|
close(scrfile1)
|
|
C DFINT_AI_RS - RS (ai|P) alpha
|
|
C DFINT_AIb_RS - RS (ai|P) beta
|
|
C DFINT_PQ_RS - RS (P|Q)
|
|
C DFINV - Cholesky deco of normal (P|Q)
|
|
endif
|
|
C
|
|
if((localcc.eq.'off '.or.lrpa).and.iface.eq.'none ') then
|
|
C Calculate DF integrals for correlation calculation
|
|
call getkey('dfbasis_cor',11,dfbasis_cor,20)
|
|
call getvar('lseqc ',lseqc)
|
|
call getkey('scfalg',6,scfalg,8)
|
|
call getkey('cialg',5,cialg,8)
|
|
call getkey('dhexc',5,dhexc,6)
|
|
if(lf12) then
|
|
call runit('mp2f12',intcpud,intwald)
|
|
if(trim(calctype).ne.'mp2-f12') then
|
|
if(trim(ccprog).eq.'mrcc') goto 317
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a4)") 'f123'
|
|
close(scrfile1)
|
|
call ishell('cp VARS_AO VARS')
|
|
call ishell('cp DOMAIN_AO DOMAIN')
|
|
call ishell('mv OEINT_AO OEINT')
|
|
call changekey('scfiguess',9,'sad ',7)
|
|
call runit('integ',intcpud,intwald)
|
|
call ishell('cp VARS_AO VARS')
|
|
call ishell('cp FOCK_AO FOCK')
|
|
c call ishell('mv VARS.old VARS')
|
|
else
|
|
goto 1006
|
|
endif
|
|
else if(((.not.lseqc.or.dens.ne.0.or.rsh.ne.' ').and.
|
|
$dfbasis_cor.ne.'none ').or.
|
|
$trim(scfalg).ne.'disk'.or.(lrpa.and.localcc.ne.'off ').or.
|
|
$(dfbasis_scf.ne.'none '.and.
|
|
$ dfbasis_cor.eq.'none ')) then
|
|
c if (localcc.eq.'off '.or.
|
|
c $ (localcc.eq.'2015'.or..not.localcc15p(localcc))) then ! skip integ if localcc>2015
|
|
call ishell('cp VARS VARS.old')
|
|
call runit('integ',intcpud,intwald)
|
|
intcpu=intcpu+intcpud
|
|
intwal=intwal+intwald
|
|
c call getvar('nbf ',nbf)
|
|
call ishell('mv VARS.old VARS')
|
|
c open(varsfile,file='VARS',form='unformatted',
|
|
c $position='append')
|
|
c write(varsfile) 'nbfnew ',iintln*nbset,nbf
|
|
c close(varsfile)
|
|
c endif ! localcc.eq.'off '.or.
|
|
if(rsh.ne.' ') then
|
|
open(scrfile1,file='ROUTE')
|
|
write(scrfile1,"(a3)") 'rsh'
|
|
close(scrfile1)
|
|
endif
|
|
endif
|
|
call ishell('rm -f DOMAIN')
|
|
C Solve CIS equations in the case of local excited-state calculation
|
|
if(localcc.ne.'off '.and.nstate.gt.1) then
|
|
call ishell('cp VARS VARS.old')
|
|
open(varsfile,file='VARS',form='unformatted',
|
|
$position='append')
|
|
C 0: canonical, 1: CIS for local, 2: CC for local
|
|
write(varsfile) 'localex ',iintln,1
|
|
close(varsfile)
|
|
C
|
|
call ishell('cp MOCOEF MOCOEF.LOC')
|
|
call getkey('redcost_tddft',13,c16,16)
|
|
if(trim(c16).eq.'off') call ishell('cp MOCOEF.CAN MOCOEF')
|
|
if(trim(cialg).eq.'disk')
|
|
$call runit('drpa',ovirtcpud,ovirtwald)
|
|
call runit('cis',cput,walt)
|
|
C
|
|
call ishell('mv VARS.old VARS')
|
|
open(varsfile,file='VARS',form='unformatted',
|
|
$position='append')
|
|
C 0: canonical, 1: CIS for local, 2: CC for local
|
|
write(varsfile) 'localex ',iintln,2
|
|
close(varsfile)
|
|
C
|
|
endif
|
|
if(lrpa) then
|
|
C DF-MP2, RPA, or local correlation (2015-19) calculation
|
|
if(localcc.ne.'off '.and.nstate.gt.1) then
|
|
do istate=2,nstate
|
|
open(scrfile1,file='istate')
|
|
write(scrfile1,*) istate,nstate
|
|
close(scrfile1)
|
|
call ishell('cp MOCOEF.LOC MOCOEF')
|
|
call runit('drpa',ovirtcpud,ovirtwald)
|
|
C DAVID WARNING!!!
|
|
call ishell('cp MOCOEF.CAN MOCOEF')
|
|
call runit('cis',cput,walt)
|
|
enddo
|
|
else
|
|
call runit('drpa',ovirtcpud,ovirtwald) ! ground state local correlation
|
|
endif
|
|
if(localcc.eq.' off'.or.localcc.eq.'2013'.or. !jump over locdrv
|
|
$ (calctype.ne.'ccsd '
|
|
$ .and.calctype.ne.'ccsd(t) '.and.ccprog.eq.'ccsd')
|
|
$ .or.(ccprog.eq.'mrcc'.and.lrpanocc).or.
|
|
$ (localcc.ne.'off '.and.nstate.gt.1).or. ! if not a CC/CI type calc
|
|
$ (locdrvdone(2).and.lccoporder.eq.'trffirst') ! OR locdrv() is already called in ldrpa
|
|
$ ) goto 1006
|
|
else if(dfbasis_cor.ne.'none '.and.
|
|
$(ccprog.eq.'mrcc'.or.ccprog.eq.'cis '.or.
|
|
$(ccprog.eq.'ccsd'.and.dfintran.eq.'drpa '))) then
|
|
C DF integrals for mrcc or cis
|
|
if(ccprog.ne.'cis '.or.cialg.eq.'disk '.or.
|
|
$ ((trim(cialg).eq.'direct'.or.trim(cialg).eq.'direct2'
|
|
$ .or.trim(cialg).eq.'direct3').and.((trim(calctype).ne.
|
|
$ 'cis'.and.trim(calctype).ne.'scf').or.
|
|
$ trim(dhexc).eq.'cis(d)'))) then
|
|
|
|
if(denscorr.eq.1) call ishell('cp VARS VARS.old')
|
|
call runit('drpa',cput,walt)
|
|
if(denscorr.gt.1) return
|
|
if(denscorr.eq.1) then
|
|
call ishell('mv VARS.old VARS')
|
|
cscr4='0 '
|
|
call changekey('denscorr',8,cscr4,4)
|
|
call runit('drpa',cput,walt)
|
|
endif
|
|
endif
|
|
else
|
|
C Integral transformation and orbital optimization
|
|
call runit('ovirt',ovirtcpud,ovirtwald)
|
|
endif !lrpa
|
|
endif ! if((localcc.eq.'off '.or.lrpa).and.iface.eq.'none '
|
|
if(localcc.ne.'off ') locno=3
|
|
endif ! llg ?
|
|
C
|
|
if(.not.localcc15p(localcc).and.trim(ccprog).ne.'cis') then
|
|
open(inpfile,status='unknown',file='fort.56')
|
|
read(inpfile,*,end=1002) op,nsing,ntrip,rest,calc,i,conver,i,i,
|
|
$iclsh,i,ihf,ndoub,nacto,nactv,itol,maxex,sacc,ptfreq,dboc,maxcor
|
|
c $,locno
|
|
op1=op
|
|
nroot=nsing+ntrip+ndoub
|
|
close(inpfile)
|
|
endif
|
|
if(localcc.ne.'off ') op1=op
|
|
if(calc.gt.10) then
|
|
ssmrcc=calc-10
|
|
calc=1
|
|
else
|
|
ssmrcc=0
|
|
endif
|
|
C
|
|
inquire(file='fort.55',exist=log1)
|
|
inquire(file='MDCINT', exist=log2)
|
|
inquire(file='MRCONEE',exist=log3)
|
|
if(.not.log1) goto 1002
|
|
c if(.not.log1.and.(.not.log2.or..not.log3)) goto 1002
|
|
c if(log2.and.log3) then
|
|
c open(mrconeefile,file='MRCONEE',form='UNFORMATTED')
|
|
c read(mrconeefile) nbasis,log,nuc
|
|
c call dirac2mrcc(nbasis)
|
|
c close(mrconeefile)
|
|
c endif
|
|
open(inp,status='unknown',file='fort.55')
|
|
rewind(inp)
|
|
read(inp,*,end=1002) m
|
|
if(m.ne.0) then
|
|
rewind(inp)
|
|
endif
|
|
read(inp,*,end=1002) nbasis,nocc
|
|
read(inp,*,end=1002) (m,i=1,nbasis)
|
|
read(inp,*,end=1002) m
|
|
close(inp)
|
|
if(m.eq.-3.and.(.not.log2.or..not.log3)) goto 1002
|
|
nnb=nbasis
|
|
nbasis=2*nbasis
|
|
nvirt=nbasis-nocc
|
|
C
|
|
C Local CC calculation
|
|
317 continue
|
|
if(localcc.ne.'off ') then
|
|
cmpi write(*,*) 'nocc,nbasis in dmrcc',nocc,nbasis
|
|
call locdrv(intcpu,intwal,orbcpu,orbwal,ovirtcpud,ovirtwald,
|
|
$scfcpu,scfwal,localcc,calctype)
|
|
else
|
|
C Integral transformation and orbital optimization
|
|
c if(locno.gt.0) call runit('ovirt',ovirtcpud,ovirtwald)
|
|
C CC calculation
|
|
if(ssmrcc.gt.0) then
|
|
call dssmrcc(nnb,ccprog)
|
|
else
|
|
call ddmrcc(ccprog,.false.,llg)
|
|
endif
|
|
endif
|
|
C
|
|
1006 continue
|
|
if(iface.eq.'none '.and.llg) then
|
|
C Calculate empirical dispersion
|
|
call getkey('edisp',5,edisp,256)
|
|
call getkey('embed',5,embed,8)
|
|
if(embed.eq.'off') then !HB
|
|
if(trim(edisp).ne.'off') call dftd3(edisp,"no")
|
|
else
|
|
if(trim(edisp_embed).ne.'off') then
|
|
call dftd3(edisp_embed,"ab")
|
|
if(dens.ge.2) call ishell('cp dftd3_gradient dftd3_grad_ab')
|
|
endif
|
|
call ishell('cp COORD.xyz COORD_save.xyz')
|
|
call ishell('cp COORD_SUBSYSA.xyz COORD.xyz')
|
|
if(trim(edisp_embed).ne.'off') then
|
|
call dftd3(edisp_embed,"a2")
|
|
if(dens.ge.2) call ishell('cp dftd3_gradient dftd3_grad_a2')
|
|
endif
|
|
if(trim(edisp).ne.'off'.and.moselectalg.ne.'ecore') then
|
|
call dftd3(edisp,"a1")
|
|
if(dens.ge.2) call ishell('cp dftd3_gradient dftd3_grad_a1')
|
|
elseif(trim(edisp).ne.'off'.and.moselectalg.eq.'ecore') then
|
|
call dftd3(edisp,"no")
|
|
endif
|
|
call ishell('cp COORD_save.xyz COORD.xyz')
|
|
endif !HB
|
|
C Gradient and property calculation
|
|
if(iabs(dens).ge.1.and.iabs(dens).le.2.and.scftype.ne.'mcscf')
|
|
$then
|
|
if(dfbasis_scf.ne.'none '.and.
|
|
$calctype.ne.'scf '
|
|
$.and.trim(ccprog).ne.'cis') call ishell('mv DFINV_SCF DFINV')
|
|
call runit('prop',cput,walt)
|
|
endif
|
|
C Write Qm energy for QM/MM calculations
|
|
if(qmmm.eq.'charmm ') then
|
|
C CHARMM
|
|
call getenergy(temp,cscr15)
|
|
open(scrfile1,file='q1.out')
|
|
rewind(scrfile1)
|
|
write(scrfile1,"(' 11 ',e23.15,' Convergence criterion met')")
|
|
$temp
|
|
close(scrfile1)
|
|
else if(qmmm.eq.'amber ') then
|
|
call getkey('dens',4,cscr4,4)
|
|
read(cscr4,*) i
|
|
if(i.lt.2) then
|
|
call getenergy(finalener,cscr15)
|
|
call getvar('selfenergy',selfener)
|
|
call write_dat_file_for_amber
|
|
$(finalener,selfener,i,temp,temp,temp,temp,temp,temp)
|
|
endif
|
|
endif
|
|
endif
|
|
c restore the canonical orbitals to the MOCOEF file !NP
|
|
inquire(file='MOCOEF.LOC',exist=log1)
|
|
inquire(file='MOCOEF.CAN',exist=log2)
|
|
if(log1.and.log2) call ishell('cp MOCOEF.CAN MOCOEF')
|
|
C
|
|
c Change scfiguess for numercal gradient
|
|
if(embed.eq.'huzinaga') call changekey('scfiguess',9,scfiguess,7)
|
|
return
|
|
1002 continue
|
|
write(iout,*) 'Input file does not exist!'
|
|
call flush(iout)
|
|
call dmrccend(1)
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine scfiguessOFFtasks(scfcpu,scfwal,task)
|
|
************************************************************************
|
|
* perfrom necessary tasks is the scf calculation is skipped due to scfiguess=off keyword
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
character*16 dft
|
|
real*8 scfcpu,scfwal
|
|
integer task
|
|
C
|
|
if (task.eq.1) then
|
|
open(varsfile,file='VARS',form='unformatted',
|
|
$ position='append')
|
|
write(varsfile) 'eref ',ifltln,eref
|
|
close(varsfile)
|
|
open(unit=ifcfile,file='iface',status='unknown')
|
|
write(ifcfile,"(68a)")
|
|
& '#property method sym st mul value' //
|
|
& ' CPU(sec) Wall(sec)'
|
|
write(ifcfile,7596) 'ENERGY ','SCF ',1,1,1,eref,
|
|
& 0.d0,0.d0
|
|
close(ifcfile)
|
|
7596 format(a8,1x,a15,1x,3(i2,1x),1pe23.15,2(1pe15.8))
|
|
endif
|
|
c
|
|
if (task.eq.1.or.task.eq.2) then
|
|
call getkey('dft',3,dft,16)
|
|
write(*,*)
|
|
if(dft.eq.'off ') then
|
|
WRITE(*,"(' ***FINAL HARTREE-FOCK ENERGY:',F24.16,' [AU]')") eref
|
|
else
|
|
WRITE(*,"(' ***FINAL KOHN-SHAM ENERGY: ',F24.16,' [AU]')") eref
|
|
endif
|
|
scfcpu=0.d0
|
|
scfwal=0.d0
|
|
endif
|
|
c
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine composite(llg)
|
|
************************************************************************
|
|
* Performs calculations with composite methods, e.g., ONIOM
|
|
************************************************************************
|
|
implicit none
|
|
character*8 gopt,freq,oniom,qmmm
|
|
logical llg
|
|
call getkey('gopt',4,gopt,8)
|
|
call getkey('freq',4,freq,8)
|
|
call getkey('oniom',5,oniom,8)
|
|
call getkey('qmmm',4,qmmm,8)
|
|
if(trim(oniom).ne.'off') then
|
|
call oniomcore(oniom,gopt,freq,qmmm)
|
|
endif
|
|
return
|
|
end
|
|
C
|
|
************************************************************************
|
|
subroutine rismcalc(llg)
|
|
************************************************************************
|
|
* Perform EC-RISM calculation with MRCC and AmberTools
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
C implicit none
|
|
character*5 cscr5
|
|
character*8 netcharge,imult,cval,cmult,cscr8
|
|
character*67 temp,word
|
|
character*15 cscr15
|
|
character*256 rism,rismcommand,antechambercommand
|
|
real*8 cput,walt,energy,rismenergy,temp2,excessenergy
|
|
real*8 ecrismenergy, diff, prev_ecrismenergy,gasenergy
|
|
real*8 templine(4),prev_qmenergy,prev_rismenergy
|
|
real*8 diff_qmenergy, diff_rismenergy,qmenergy
|
|
integer nlines,io,i,j,k,icycle,ierr
|
|
logical llg,frcmodfile,chguessfile
|
|
call spoint(llg)
|
|
call changekey('scfiguess',9,'restart',7)
|
|
C read in energy correction
|
|
call getenergy(excessenergy,cscr15)
|
|
C read in the second to last energy
|
|
open(unit=ifcfile,file='iface',status='old')
|
|
j=0
|
|
do
|
|
read(ifcfile,*,iostat=io)
|
|
if (io.ne.0) exit
|
|
j=j+1
|
|
enddo
|
|
rewind(ifcfile)
|
|
do k=1,j-2
|
|
read(ifcfile,*)
|
|
enddo
|
|
read(ifcfile,7596) cscr8,cscr15,j,j,j,energy
|
|
close(ifcfile)
|
|
C end of second to last energy read in
|
|
call getkeym('rism',4,rism,8)
|
|
gasenergy=energy
|
|
!open(unit=scrfile6,file="ec-rism_results")
|
|
open(scrfile6,file="ec-rism_results",iostat=ierr,status='replace')
|
|
write(scrfile6,*) 'EC-RISM output'
|
|
write(scrfile6,*)
|
|
write(scrfile6,"( 'Gas-phase energy: ',f22.12,' Hartree')") energy
|
|
write(scrfile6,*)
|
|
write(scrfile6,"('Iteration QM Energy 3D-RISM/PC+
|
|
$ EC-RISM Energy solv. free energy difference')")
|
|
write(scrfile6,'(A)') ' Hartree kJ/mol
|
|
$ Hartree kJ/mol kJ/mol'
|
|
close(scrfile6)
|
|
call getkey('charge',6,cval,4)
|
|
read(cval,*) netcharge
|
|
call getkey('mult',4,cmult,4)
|
|
read(cmult,*) imult
|
|
write(iout,*)
|
|
write(iout,*) 'Doing 3D-RISM calculation with AmberTools'
|
|
C Use guess charges to restart or calculate the last step
|
|
INQUIRE (FILE='ATCHARGE.GUESS', EXIST=chguessfile)
|
|
if(chguessfile) then
|
|
write(iout,*) 'Guess charges has been used!'
|
|
call ishell("cat ATCHARGE.GUESS")
|
|
call ishell("mv ATCHARGE.GUESS ATCHARGE")
|
|
endif
|
|
C antechamber
|
|
antechambercommand="antechamber -i COORD.pdb -fi pdb
|
|
$ -o COORD.mol2 -fo mol2 -c rc -cf ATCHARGE -at gaff2
|
|
$ -s 2 -nc "//trim(netcharge)//" -dr no -j 1 -m
|
|
$ "//trim(imult)//" > antechamber_output"
|
|
call ishell(antechambercommand)
|
|
write(iout,*) antechambercommand
|
|
C mod for stupid waters
|
|
call ishell("sed -i 's/DU/ho/g' COORD.mol2")
|
|
C parmchk2
|
|
call ishell("parmchk2 -i COORD.mol2 -f mol2
|
|
$ -o COORD.frcmod > parmchk2_output")
|
|
INQUIRE (FILE='FRCMOD', EXIST=frcmodfile)
|
|
if(frcmodfile) call ishell("cp FRCMOD COORD.frcmod")
|
|
C call ishell("touch COORD.frcmod")
|
|
C create and run leap
|
|
open(unit=scrfile1,file="runleap.in")
|
|
write(scrfile1,*) "source leaprc.gaff2"
|
|
write(scrfile1,*) "mol=loadmol2 COORD.mol2"
|
|
write(scrfile1,*) "check mol"
|
|
write(scrfile1,*) "loadamberparams COORD.frcmod"
|
|
write(scrfile1,*) "SaveAmberParm mol COORD.prmtop COORD.incrd"
|
|
write(scrfile1,*) "quit"
|
|
close(scrfile1)
|
|
call ishell("tleap -f runleap.in > leap_output")
|
|
C create 1D-RISM input and run
|
|
if (rism(1:2).eq.'on') then
|
|
C write(*,*) "Doing 1D-RISM for solvent"
|
|
open(unit=scrfile1,file="solvent.sh")
|
|
write(scrfile1,*) "#!/bin/csh -f"
|
|
write(scrfile1,*) ""
|
|
write(scrfile1,*) "cat > solvent.inp <<EOF"
|
|
write(scrfile1,*) "&PARAMETERS"
|
|
write(scrfile1,*) "THEORY='DRISM', CLOSURE='pse3',"
|
|
write(scrfile1,*) "NR=16384, DR=0.025,"
|
|
write(scrfile1,*) "OUTLIST='xCGT', rout=0,"
|
|
write(scrfile1,*) "KSAVE=-1, PROGRESS=1, maxstep=10000,"
|
|
write(scrfile1,*) "MDIIS_NVEC=20, MDIIS_DEL=0.3,"
|
|
write(scrfile1,*) "SMEAR=1, ADBCOR=0.5,TOLERANCE=1.e-12,"
|
|
write(scrfile1,*) "TEMPERATURE=298.15, DIEps=78.375,"
|
|
write(scrfile1,*) "NSP=1"
|
|
write(scrfile1,*) "/"
|
|
write(scrfile1,*) "&SPECIES"
|
|
write(scrfile1,*) "DENSITY=55.343d0,"
|
|
write(scrfile1,*) "MODEL='$AMBERHOME/dat/rism1d/mdl/cTIP3P.mdl'"
|
|
write(scrfile1,*) "/"
|
|
write(scrfile1,'(a)') "EOF"
|
|
close(scrfile1)
|
|
call ishell("bash solvent.sh")
|
|
call ishell("rism1d solvent > solvent.out")
|
|
C run 3D-rism
|
|
rismcommand="rism3d.snglpnt --pdb COORD.pdb
|
|
$ --prmtop COORD.prmtop --rst COORD.incrd
|
|
$ --volfmt xyzv
|
|
$ --chgdist chgdist
|
|
$ --pc+ --gf
|
|
$ --xvv solvent.xvv
|
|
$ --grdspc 0.3,0.3,0.3
|
|
$ --tolerance 1E-5
|
|
$ --closure pse3
|
|
$ --buffer 15
|
|
$ --maxstep 10000 > rism_output"
|
|
else
|
|
call getkeym('rism',4,rism,256)
|
|
backspace(minpfile)
|
|
read(minpfile,"(a5,a256)") cscr5,rism
|
|
rismcommand="rism3d.snglpnt --pdb COORD.pdb
|
|
$ --prmtop COORD.prmtop --rst COORD.incrd
|
|
$ --volfmt xyzv
|
|
$ --chgdist chgdist
|
|
$ --pc+ --gf "//trim(rism)//" > rism_output"
|
|
endif
|
|
write(iout,*) rismcommand
|
|
call ishell(rismcommand)
|
|
call ishell("cat rism_output")
|
|
C get result from output
|
|
open(scrfile1,file="rism_output")
|
|
do
|
|
read(scrfile1,*,iostat=io) temp
|
|
if (io/=0) EXIT
|
|
read(temp,*) word
|
|
if (word=="rism_excessChemicalPotentialPCPLUS") then
|
|
backspace(scrfile1)
|
|
read(scrfile1,'(A)') temp
|
|
read(temp,*) word,rismenergy
|
|
EXIT
|
|
endif
|
|
enddo
|
|
close(scrfile1)
|
|
i=0
|
|
ecrismenergy=kjmtoeh*(energy-excessenergy)+rismenergy*kcaltokj
|
|
qmenergy=kjmtoeh*(energy-excessenergy)
|
|
open(scrfile6,file="ec-rism_results",iostat=ierr,status='old',
|
|
$ position='append')
|
|
if(ierr.eq.0) then
|
|
write(scrfile6,"(I5,' ',f12.6,f10.3,f17.6,f17.3)") i,energy,
|
|
$rismenergy*kcaltokj,ecrismenergy/kjmtoeh,
|
|
$ecrismenergy-gasenergy*kjmtoeh
|
|
else
|
|
write(iout,"(a)") " Cannot found file 'ec-rism_results'."
|
|
write(iout,"(a)") " Exiting."
|
|
call dmrccend(1)
|
|
endif
|
|
close(scrfile6)
|
|
call changekey('qmmm',4,'amber ',8)
|
|
C CYCLE FROM HERE
|
|
C drop small charges
|
|
icycle=0
|
|
DO ! MAIN LOOP STARTS
|
|
icycle=icycle+1
|
|
open(scrfile1,file="chgdist.1.xyzv")
|
|
open(scrfile2,file="temp.xyzv")
|
|
do
|
|
read(scrfile1,*,iostat=io)
|
|
$templine(1),templine(2),templine(3),templine(4)
|
|
if (io.ne.0) exit
|
|
if (dabs(templine(4)).ge.1D-6) then
|
|
c write(65,'(f,f,f,f)') !HB
|
|
write(scrfile2,'(4f25.15)') !HB
|
|
$templine(1),templine(2),templine(3),templine(4)
|
|
endif
|
|
enddo
|
|
close(scrfile1)
|
|
close(scrfile2)
|
|
call ishell("mv temp.xyzv chgdist.1.xyzv")
|
|
C QM calculation
|
|
call spoint(llg)
|
|
C get excess energy
|
|
C read in energy correction
|
|
call getenergy(excessenergy,cscr15)
|
|
C read in the second to last energy
|
|
open(unit=ifcfile,file='iface',status='old')
|
|
j=0
|
|
do
|
|
read(ifcfile,*,iostat=io)
|
|
if (io.ne.0) exit
|
|
j=j+1
|
|
enddo
|
|
rewind(ifcfile)
|
|
do k=1,j-2 !here is the second to last change
|
|
read(ifcfile,*)
|
|
enddo
|
|
read(ifcfile,7596) cscr8,cscr15,j,j,j,energy
|
|
close(ifcfile)
|
|
C end of second to last energy read in
|
|
C another RISM cycle
|
|
write(iout,*)
|
|
write(iout,*) 'Doing 3D-RISM calculation with AmberTools'
|
|
C antechamber
|
|
antechambercommand='antechamber -i COORD.pdb -fi pdb ' //
|
|
$'-o COORD.mol2 -fo mol2 -c rc -cf ATCHARGE -at gaff2 ' //
|
|
$'-s 2 -nc '//trim(netcharge)//' -dr no -j 1 -m ' //
|
|
$trim(imult)//' > antechamber_output'
|
|
call ishell(antechambercommand)
|
|
write(iout,*) antechambercommand
|
|
C mod for stupid waters
|
|
call ishell("sed -i 's/DU/ho/g' COORD.mol2")
|
|
C parmchk2
|
|
call ishell("parmchk2 -i COORD.mol2 -f mol2 " //
|
|
$"-o COORD.frcmod > parmchk2_output")
|
|
if(frcmodfile) call ishell("cp FRCMOD COORD.frcmod")
|
|
C create and run leap (nem kell)
|
|
call ishell("tleap -f runleap.in > leap_output")
|
|
C run 3D-rism
|
|
if (rism(1:2).eq.'on') then
|
|
rismcommand='rism3d.snglpnt --pdb COORD.pdb' //
|
|
$' --prmtop COORD.prmtop --rst COORD.incrd' //
|
|
$' --volfmt xyzv' //
|
|
$' --chgdist chgdist' //
|
|
$' --pc+ --gf' //
|
|
$' --xvv solvent.xvv' //
|
|
$' --grdspc 0.3,0.3,0.3' //
|
|
$' --tolerance 1E-5' //
|
|
$' --closure pse3' //
|
|
$' --buffer 15' //
|
|
$' --maxstep 10000 > rism_output'
|
|
else
|
|
rismcommand='rism3d.snglpnt --pdb COORD.pdb' //
|
|
$' --prmtop COORD.prmtop --rst COORD.incrd' //
|
|
$' --volfmt xyzv' //
|
|
$' --chgdist chgdist' //
|
|
$' --pc+ --gf '//trim(rism)//' > rism_output'
|
|
endif
|
|
write(iout,*) rismcommand
|
|
call ishell(rismcommand)
|
|
call ishell("cat rism_output")
|
|
C get result from output
|
|
prev_rismenergy=rismenergy
|
|
open(scrfile1,file="rism_output")
|
|
do
|
|
read(scrfile1,*,iostat=io) temp
|
|
if (io/=0) EXIT
|
|
read(temp,*) word
|
|
if (word=="rism_excessChemicalPotentialPCPLUS") then
|
|
backspace(scrfile1)
|
|
read(scrfile1,'(A)') temp
|
|
read(temp,*) word,rismenergy
|
|
EXIT
|
|
endif
|
|
enddo
|
|
close(scrfile1)
|
|
C write ec-rism progress and continue or finish cycle
|
|
i=i+1
|
|
prev_ecrismenergy=ecrismenergy
|
|
prev_qmenergy=qmenergy
|
|
ecrismenergy=kjmtoeh*(energy-excessenergy)+rismenergy*kcaltokj
|
|
qmenergy=kjmtoeh*(energy-excessenergy)
|
|
diff=ecrismenergy-prev_ecrismenergy
|
|
diff_qmenergy=qmenergy-prev_qmenergy
|
|
diff_rismenergy=kcaltokj*(prev_rismenergy-rismenergy)
|
|
open(scrfile6,file="ec-rism_results",iostat=ierr,status='old',
|
|
$ position='append')
|
|
if(ierr.eq.0) then
|
|
write(scrfile6,"(I5,' ',f12.6,f10.3,f17.6,f17.3,f18.3)")
|
|
$i,energy-excessenergy,
|
|
$rismenergy*kcaltokj,ecrismenergy/kjmtoeh,
|
|
$ecrismenergy-gasenergy*kjmtoeh,diff
|
|
else
|
|
write(iout,"(a)") " Cannot found file 'ec-rism_results'."
|
|
write(iout,"(a)") " Exiting."
|
|
call dmrccend(1)
|
|
endif
|
|
close(scrfile6)
|
|
write(iout,*) '*******************************************'
|
|
call ishell("cat ec-rism_results")
|
|
C if (abs(diff).lt.1E-2) then
|
|
if ((abs(diff).lt.1E-2).and.(abs(diff_qmenergy).lt.1E-1).and.
|
|
$(abs(diff_rismenergy).lt.1E-1)) then
|
|
write(iout,*) 'EC-RISM calculation has converged'
|
|
exit
|
|
endif
|
|
if (i.gt.20) then
|
|
write(iout,*) 'EC-RISM reached the maximum iteration'
|
|
exit
|
|
endif
|
|
ENDDO ! MAIN LOOP ENDS
|
|
open(scrfile6,file="ec-rism_results",iostat=ierr,status='old',
|
|
$ position='append')
|
|
if(ierr.eq.0) then
|
|
write(scrfile6,*)
|
|
write(iout,*)
|
|
write(scrfile6,"( 'Solvation free energy: ',f22.3,' kJ/mol')")
|
|
$ecrismenergy-gasenergy*kjmtoeh
|
|
write(iout,"( 'Solvation free energy: ',f22.3,' kJ/mol')")
|
|
$ecrismenergy-gasenergy*kjmtoeh
|
|
write(scrfile6,"( 'Solvated energy: ',f22.8,' Hartree')")
|
|
$ecrismenergy/kjmtoeh
|
|
write(iout,"( 'Solvated energy: ',f22.8,' Hartree')")
|
|
$ecrismenergy/kjmtoeh
|
|
else
|
|
write(iout,"(a)") " Cannot found file 'ec-rism_results'."
|
|
write(iout,"(a)") " Exiting."
|
|
call dmrccend(1)
|
|
endif
|
|
close(scrfile6)
|
|
C write results to iface
|
|
open(unit=ifcfile,file='iface',status='unknown')
|
|
write(ifcfile,"(68a)")
|
|
&'#property method sym st mul value' //
|
|
&' CPU(sec) Wall(sec)'
|
|
write(ifcfile,7596) 'ENERGY ','GAS ',1,1,1,gasenergy,
|
|
& 0d0,0d0
|
|
write(ifcfile,7596) 'ENER KJ ','SOLV FREE ENER ',1,1,1,
|
|
$ecrismenergy-gasenergy*kjmtoeh, 0d0,0d0
|
|
write(ifcfile,7596) 'ENERGY ','SOLV ',1,1,1,
|
|
$ecrismenergy/kjmtoeh, 0d0,0d0
|
|
close(ifcfile)
|
|
7596 format(a8,1x,a15,1x,3(i2,1x),1pe23.15,2(1pe15.8))
|
|
open(unit=scrfile1,file='chgdist.1.xyzv')
|
|
close(unit=scrfile1,status='delete')
|
|
return
|
|
end
|
|
|
|
************************************************************************
|
|
subroutine calc_low_levels_of_embedding
|
|
$(embed,ccprog,edisp_embed,scfiguess,moselectalg,dual)
|
|
************************************************************************
|
|
#include "MRCCCOMMON"
|
|
! in
|
|
character(len=8), intent(in) :: embed
|
|
character(len=8), intent(in) :: dual
|
|
! inout
|
|
character(len=4), intent(inout) :: ccprog
|
|
character(len=7), intent(inout) :: scfiguess
|
|
character(len=16), intent(inout) :: moselectalg
|
|
character(len=256), intent(inout) :: edisp_embed
|
|
! local
|
|
character(len=4) :: cgrad
|
|
character(len=8) :: corembed
|
|
character(len=16) :: orblocc,orbloco,orblocv
|
|
character(len=16) :: orbloce
|
|
character(len=16) :: orbloce_special(3)
|
|
double precision :: cput,walt
|
|
double precision :: scfcpu,scfwal
|
|
double precision :: orbcpu,orbwal
|
|
interface
|
|
character(len=16) function get_moselectalg( minpfile )
|
|
integer, intent(in) :: minpfile
|
|
end function get_moselectalg
|
|
end interface
|
|
orblocc=''
|
|
orbloco=''
|
|
orblocv=''
|
|
orbloce=''
|
|
orbloce_special=''
|
|
if(embed.eq.'off') return
|
|
moselectalg = get_moselectalg( minpfile )
|
|
open(scrfile1,file='KEYWD',form='FORMATTED',position='APPEND',
|
|
$ status='OLD',action='WRITE')
|
|
write(scrfile1,*) trim('moselect=' // moselectalg)
|
|
close(scrfile1)
|
|
if(moselectalg.eq.'ecore') edisp_embed='off'
|
|
if(embed.eq.'project '.or.embed.eq.'huzinaga'.or.
|
|
$ embed.eq.'fdm '.or.embed.eq.'sch ') then
|
|
huzitype=1
|
|
if (scfiguess.ne.'lowlqm ') then
|
|
call set_route(scrfile1,'em1')
|
|
open(scrfile1,file='SCHINFO',form='unformatted') !HB
|
|
write(scrfile1)
|
|
write(scrfile1) 'norm'
|
|
close(scrfile1)
|
|
call runit('scf',cput,walt) ! run embedding SCF for the total QM system
|
|
else ! read the solution of embedding SCF for the total QM system
|
|
open(varsfile,file='VARS',form='unformatted',
|
|
$position='append')
|
|
write(varsfile) 'edftab ',ifltln,eref
|
|
close(varsfile)
|
|
write(iout,*)
|
|
write(iout,*)' Read the embedding SCF solution from file'
|
|
call scfiguessOFFtasks(scfcpu,scfwal,2)
|
|
endif
|
|
if(embed.ne.'fdm ') then
|
|
call getkey('dens',4,cgrad,4)
|
|
if(cgrad.eq.'2 ') call ishell('cp MOCOEF MOCOEF_CAN')
|
|
orbloce_special(1:3)='off '
|
|
call getkey('corembed',8,corembed,8) !
|
|
call changekey('corembed',8,'off ',8)
|
|
call getkey('orblocc',7,orblocc,16)
|
|
call getkey('orbloco',7,orbloco,16)
|
|
call getkey('orblocv',7,orblocv,16)
|
|
call getkey('orbloce',7,orbloce,16)
|
|
call changekey('orblocc',7,orbloce,16)
|
|
call changekey('orbloco',7,orbloce,16)
|
|
call changekey('orblocv',7,'off ',16)
|
|
if( orbloce .eq. 'special' ) then
|
|
call get_orbloce_special
|
|
$ (orbloce_special(1),orbloce_special(2),orbloce_special(3))
|
|
call changekey('orblocc',7,orbloce_special(1),16)
|
|
call changekey('orbloco',7,orbloce_special(2),16)
|
|
call changekey('orblocv',7,orbloce_special(3),16)
|
|
endif
|
|
if(moselectalg.ne.'ecore') then
|
|
call runit('orbloc',orbcpu,orbwal)
|
|
endif
|
|
if(cgrad.eq.'2 ') then
|
|
call ishell('cp MOCOEF MOCOEF.LOC')
|
|
call getvar('ncore ',ncore)
|
|
open(scrfile1,file='NCORE')
|
|
write(scrfile1,'(I10)') ncore
|
|
close(scrfile1)
|
|
endif
|
|
call set_qmmod_route(scrfile1,'select_only_occ')
|
|
if( orbloce_special(3).ne.'off' ) then
|
|
huzitype=2
|
|
if(ccprog.eq.'ccsd') then
|
|
call changekey('ccprog',6,'mrcc',4)
|
|
ccprog='mrcc'
|
|
endif
|
|
call set_qmmod_route(scrfile1,'select_occ+virt')
|
|
endif
|
|
call runit('qmmod',orbcpu,orbwal)
|
|
call changekey('corembed',8,corembed,8)
|
|
call changekey('orblocc',7,orblocc,16)
|
|
call changekey('orbloco',7,orbloco,16)
|
|
call changekey('orblocv',7,orblocv,16)
|
|
if( orbloce_special(3).ne.'off' ) then
|
|
call getvar('nvfroz ',nvfroz)
|
|
call getvar('nfroz ',nfroz)
|
|
endif
|
|
open(scrfile1,file='SCHINFO',form='UNFORMATTED')
|
|
write(scrfile1) nfroz
|
|
write(scrfile1) 'norm'
|
|
close(scrfile1)
|
|
if( corembed .ne. 'off' .and. embed .ne. 'off' ) then
|
|
call changekey('orblocc',7,'off ',16)
|
|
endif
|
|
if(dual.eq.'e1 '.or.dual.eq.'e2 ')
|
|
$call ishell('cp MOCOEF MOCOEF_AB')
|
|
if(cgrad.eq.'2 ') then
|
|
call ishell('cp MOCOEF MOCOEF_AB')
|
|
call ishell('cp FOCK FOCK2_AB')
|
|
endif
|
|
endif
|
|
if(dual.ne.'e2 ') then
|
|
if(embed.eq.'sch') then
|
|
call changekey('scfiguess',9,'mo ',7)
|
|
call set_route(scrfile1,'sch')
|
|
else
|
|
call set_route(scrfile1,'em2')
|
|
call getkey('scfiguess',9,scfiguess,7)
|
|
call changekey('scfiguess',9,'restart',7)
|
|
call runit('scf',cput,walt)
|
|
call set_route(scrfile1,'em3')
|
|
endif
|
|
endif
|
|
endif
|
|
end subroutine calc_low_levels_of_embedding
|
|
|
|
subroutine set_qmmod_route( channel , msg )
|
|
integer, intent(in) :: channel
|
|
character(len=*), intent(in) :: msg
|
|
open(channel,file='QMMOD_ROUTE',position='REWIND',
|
|
$ status='REPLACE', action='WRITE')
|
|
write(channel,'(a)') msg
|
|
close(channel)
|
|
end subroutine set_qmmod_route
|
|
subroutine set_route( channel , msg )
|
|
integer, intent(in) :: channel
|
|
character(len=*), intent(in) :: msg
|
|
open(channel,file='ROUTE',position='REWIND',
|
|
$ status='REPLACE', action='WRITE')
|
|
write(channel,'(a)') msg
|
|
close(channel)
|
|
end subroutine set_route
|