1! 2! Dalton, a molecular electronic structure program 3! Copyright (C) by the authors of Dalton. 4! 5! This program is free software; you can redistribute it and/or 6! modify it under the terms of the GNU Lesser General Public 7! License version 2.1 as published by the Free Software Foundation. 8! 9! This program is distributed in the hope that it will be useful, 10! but WITHOUT ANY WARRANTY; without even the implied warranty of 11! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 12! Lesser General Public License for more details. 13! 14! If a copy of the GNU LGPL v2.1 was not distributed with this 15! code, you can obtain one at https://www.gnu.org/licenses/old-licenses/lgpl-2.1.en.html. 16! 17! 18 SUBROUTINE RSPESG(CMO,UDV,PV,FOCK,FC,FV,FCAC,H2AC,XINDX,WRK,LWRK) 19C 20C Purpose: 21C CONTROL CALCULATION OF EXCITED STATE GRADIENT 22C 23#include "implicit.h" 24#include "dummy.h" 25 DIMENSION CMO(*),UDV(*),PV(*),FOCK(*),FC(*),FV(*),FCAC(*),H2AC(*) 26 DIMENSION XINDX(*),WRK(*) 27 28 LOGICAL PROPTY 29C 30C 31#include "codata.h" 32C 33#include "priunit.h" 34#include "infopt.h" 35#include "infrsp.h" 36#include "wrkrsp.h" 37#include "rspprp.h" 38#include "infpp.h" 39#include "inflr.h" 40#include "inforb.h" 41#include "infdim.h" 42#include "infpri.h" 43#include "inftap.h" 44#include "mxcent.h" 45#include "nuclei.h" 46#include "energy.h" 47#include "past.h" 48#include "gnrinf.h" 49#include "esg.h" 50#include "taymol.h" 51#include "abainf.h" 52#include "pcmlog.h" 53 54 CALL HEADER('Excited state gradient calculation',-1) 55 CALL GETTIM(ESGTIM_0,DUMTIM) 56 WRITE(LUPRI,'(A,I3)') 'ESG calculation for state number:', IESG 57 WRITE(LUPRI,'(A,I3,/)') 'Symmetry of ESG state :', ISYME 58 59C ================================================================ 60C *** Calculate and save all the generalised matrices needed *** 61C *** for the gradient calculation *** 62C ================================================================ 63C 64C The response vectors for the excited states are calculated 65C already. Here they are only read from file and the apropriate 66C matrices are constructed. 67C 68 CALL HEADER('Generalised density matrices for ES lagrangean',-1) 69 70 CALL ESGLAG_AOMAT(CMO,UDV,PV,FOCK,FC,FV,FCAC,H2AC,XINDX,WRK,LWRK) 71 72 CALL GETTIM(ESGTIM_1,DUMTIM) 73 74 ESGTIM_LAG = ESGTIM_1 - ESGTIM_0 75 76C ================= 77C Initialize Abacus 78C ================= 79C 80 81 IPRUSR = 0 82 IPRINT = IPRDEF 83 IPRESG = IPRINT 84 CALL ABAINP('**PROPE',WRK,LWRK) 85 CALL ONEINI 86 CALL SETDCR('ABACUS') 87 88 MAXDIF = 1 89 MOLGRD = .TRUE. 90 PROPTY = .TRUE. 91 ESG = .TRUE. 92 93 KCSTRA = 1 94 KSCTRA = KCSTRA + 9*NUCDEP*NUCDEP 95 KWRK2 = KSCTRA + 9*NUCDEP*NUCDEP 96 LWRK2 = LWRK - KWRK2 + 1 97 98 CALL HEADER('Calculation of excited state gradient',-1) 99 100 CALL NUCREP(WRK,WRK(MXCOOR*MXCOOR+1),WRK(2*MXCOOR*MXCOOR+1)) 101 102 CALL DZERO(GRDMOL,3*NUCDEP) 103 104 CALL GETTIM(ESGTIM_2,DUMTIM) 105 106 107C ========================================================= 108C get the one-electron terms ( + reorhonormalization term ) 109C ========================================================= 110C 111 112 CALL ONEDRV( 113 & WRK(KWRK2),LWRK2,IPRINT,PROPTY,MAXDIF,DIFINT,NODC, 114 & NODV,DIFDIP,.FALSE.,HFONLY,NCLONE,PCM) 115 116 CALL GETTIM(ESGTIM_3,DUMTIM) 117 118C ========================= 119C get the two-electron term 120C ========================= 121 122 CALL TWOEXP(WRK(KWRK2),LWRK2,PASTWO) 123 124 CALL GETTIM(ESGTIM_4,DUMTIM) 125 ESGTIM_ONE = ESGTIM_3 - ESGTIM_2 126 ESGTIM_TWO = ESGTIM_4 - ESGTIM_3 127 128 CALL ADDGRD(GRADNN) 129 CALL ADDGRD(GRADNA) 130 CALL ADDGRD(GRADKE) 131 CALL ADDGRD(GRADEE) 132 CALL ADDGRD(GRADFS) 133 134C ========= 135C printouts 136C ========= 137C 138 139 IF ( IPRRSP .GE. 4 ) THEN 140 CALL HEADER('Molecular gradient contributions (au)',-1) 141 WRITE (LUPRI,'(A,I3,/)') 'For excited state number : ', IESG 142 143 CALL HEADER('Molecular gradient (au) - KE',-1) 144 CALL PRIGRD(GRADKE,WRK(KCSTRA),WRK(KSCTRA)) 145 CALL HEADER('Molecular gradient (au) - NA',-1) 146 CALL PRIGRD(GRADNA,WRK(KCSTRA),WRK(KSCTRA)) 147 CALL HEADER('Molecular gradient (au) - NN',-1) 148 CALL PRIGRD(GRADNN,WRK(KCSTRA),WRK(KSCTRA)) 149 CALL HEADER('Molecular gradient (au) - FS',-1) 150 CALL PRIGRD(GRADFS,WRK(KCSTRA),WRK(KSCTRA)) 151 CALL HEADER('Molecular gradient (au) - EE',-1) 152 CALL PRIGRD(GRADEE,WRK(KCSTRA),WRK(KSCTRA)) 153 END IF 154 155 CALL HEADER('Excited state gradient (au) ',-1) 156 WRITE (LUPRI,'(A,I3,/)') 'For excited state number : ', IESG 157 CALL PRIGRD(GRDMOL,WRK(KCSTRA),WRK(KSCTRA)) 158 159 CALL FLSHFO(LUPRI) 160 161 CALL HEADER('Timings for excited state calculation ',-1) 162 WRITE (LUPRI,1000) 163 & ' LAGRANGEAN : ',ESGTIM_LAG, 164 & ' - XVECS : ',ESGTIM_XVECS, 165 & ' - KVECS : ',ESGTIM_KVECS, 166 & ' - MOMAT : ',ESGTIM_MOMAT, 167 & ' ONEINT : ',ESGTIM_ONE, 168 & ' TWOINT : ',ESGTIM_TWO 169 170 1000 FORMAT(6(/,2X,A,F8.2,' seconds ')) 171 172 RETURN 173 END 174 175C 176C END OF RSPESG 177C 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192