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