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!
18C
19C  /* Deck ccsd_init0 */
20      SUBROUTINE CCSD_INIT0(WORD)
21C
22C-------------------------------------------------
23C
24C     08-November 2013 Made by Stephan P. A. Sauer
25C
26C     Initialize /CCSDINP/ ,/CCLR / and /CCSDSYM/
27C     for the CC and AOSOPPA modules
28C
29C-------------------------------------------------
30C
31#include "implicit.h"
32#include "ccsdinp.h"
33#include "cclr.h"
34#include "ccsdsym.h"
35C
36#include "ccorb.h"
37#include "ccsections.h"
38#include "maxorb.h"
39! maxorb.h needed by ccpack.h
40#include "ccpack.h"
41#include "ccroper.h"
42#include "ccrspprp.h"
43#include "gnrinf.h"
44#include "ccfield.h"
45#include "r12int.h"
46#include "mxcent.h"
47#include "eribuf.h"
48Cholesky
49#include "chodbg.h"
50CSPAS:8/11-13: The following common blocks are probably not needed
51C#include "inftap.h"
52C#include "ccfop.h"
53C#include "leinf.h"
54C#include "cbieri.h"
55C#include "cch2d.h"
56CCholesky
57C#include "cc_cho.h"
58C#include "ccdeco.h"
59C#include "chomp2.h"
60C#include "chocc2.h"
61CC
62C#include "center.h"
63CKeinSPASmehr
64C
65      CHARACTER WORD*7
66C
67C     Initialize /CCSDINP/ ,/CCLR / and /CCSDSYM/
68C
69      LGLO = .FALSE.
70      SKIP   = .FALSE.
71      CCRSTR = .FALSE.
72      CCSDT  = .FALSE.
73      CC2    = .FALSE.
74      MP2    = .FALSE.
75      DCPT2  = .FALSE.
76      CIS    = .FALSE.
77      CCS    = .FALSE.
78      CCD    = .FALSE.
79!SONIA/FRAN
80      rCCD   = .FALSE.
81      drCCD  = .FALSE.
82      rTCCD  = .FALSE.
83      SOSEX  = .FALSE.
84!
85      CCP2   = .FALSE.
86      CC1A   = .FALSE.
87      CC1B   = .FALSE.
88      CCPT   = .FALSE.
89      CCP3   = .FALSE.
90      CCRT   = .FALSE.
91      CCR3   = .FALSE.
92      CCR1A  = .FALSE.
93      CCR1B  = .FALSE.
94      RSPIM  = .FALSE.
95      TRIPIM = .FALSE.
96      LSEC   = .FALSE.
97      LCOR   = .FALSE.
98      NOCCIT = .FALSE.
99      FROIMP = .FALSE.
100      FROEXP = .FALSE.
101      CCFOP  = .FALSE.
102      CCSTST = .FALSE.
103      T2TCOR = .TRUE.
104      DEBUG  = .FALSE.
105      CCLR   = .FALSE.
106      CCQR   = .FALSE.
107      CCCR   = .FALSE.
108      CC4R   = .FALSE.
109      CC5R   = .FALSE.
110      CCTM   = .FALSE.
111      CCMCD  = .FALSE.
112      CCLRSD = .FALSE.
113      CCQR2R = .FALSE.
114      CCOPA  = .FALSE.
115      CCXOPA = .FALSE.
116      CCTPA  = .FALSE.
117      CCEXLR = .FALSE.
118      CCDERI = .FALSE.
119!     Lanczos
120      CCLRLCZ = .FALSE.
121C
122Cholesky
123C
124      CHOPT  = .FALSE.
125      CALL CC_CHOPTINIT
126      CHODBG = .FALSE.
127C
128Cholesky
129C
130      LVVVV  = .FALSE.
131
132      L0SKIP = .FALSE.
133
134      F1SKIP = .FALSE.
135      R1SKIP = .FALSE.
136      L1SKIP = .FALSE.
137
138      RCSKIP = .FALSE.
139      FCSKIP = .FALSE.
140      LCSKIP = .FALSE.
141
142      O2SKIP = .FALSE.
143      R2SKIP = .FALSE.
144      X2SKIP = .FALSE.
145      F2SKIP = .FALSE.
146      L2SKIP = .FALSE.
147
148      CO2SKIP= .FALSE.
149      CR2SKIP= .FALSE.
150      CX2SKIP= .FALSE.
151      CF2SKIP= .FALSE.
152      CL2SKIP= .FALSE.
153
154      RESKIP = .FALSE.
155      LESKIP = .FALSE.
156      E0SKIP = .FALSE.
157      IMSKIP = .FALSE.
158      LISKIP = .FALSE.
159      M1SKIP = .FALSE.
160      FRSKIP = .FALSE.
161      BESKIP = .FALSE.
162      N2SKIP = .FALSE.
163      BRSKIP = .FALSE.
164      ETADSC = .FALSE.
165
166      FREEZE = .FALSE.
167      ONLYMO = .FALSE.
168      CCSLV  = .FALSE.
169CSPAS:8/11-13: NCCSLV of ccslvinf.h is initialized here, but this common block
170C              was not included in CC_INPUT
171C     NCCSLV = 0
172CKeinSPASmehr
173
174      HERDIR = .FALSE.
175
176      NOSORT = .FALSE.
177
178      ANAAOD   = .FALSE.
179      MAXRED   = 200
180      MXLRV    = MAXRED - 1
181      MXDIIS   = 8
182      MAXITE   = 40
183      NOEONL   = .FALSE.
184      THRLEQ   = 1.0D-05
185      THRENR   = 1.0D-08
186      THRVEC   = 1.0D9
187      MTRIP    = .FALSE.
188      THRLDPHF = 1.0D-13
189CWMK  NFIELD = 0
190      NSIMLE = 0
191      NEWCAU = .FALSE.
192      LBUF   = 250000
193C
194      KEEPAOTWO = 0
195      KEEPAOIN  = .FALSE.
196      LPACKINT  = .FALSE.
197      THRPCKINT = 1.0D-15
198C
199C     Multi-Level CC3 OR CCSD(T)
200      MLCC3 = .FALSE.
201      MLCCSDPT = .FALSE.
202C
203C DRCCD/DRPA related stuff
204C
205C IT2UPD: decide on doubles amplitude updating scheme for RCCD and DRCCD
206C         (not used for other methods)
207C   =0 --- use conventional MP2-like update
208C   =1 --- use gradient update of Henderson and Scuseria,
209C          Mol. Phys. 108, 2511-2517 (2010)
210      IT2UPD=1
211C
212C IT2START: decide on doubles amplitude start guess for RCCD and DRCCD
213C         (not used for other methods)
214C   =-1 --- use zero amplitudes as initial guess (DEC-CC)
215C   =0  --- use conventional MP2 guess
216C   =1  --- use gradient start guess along the lines of Henderson and Scuseria,
217C           Mol. Phys. 108, 2511-2517 (2010)
218      IT2START=1
219C
220C HURWITZ_CHECK: check that solution is stabilizing for DRCCD
221      HURWITZ_CHECK=.FALSE.
222C end
223
224C
225C     initialize AO-SOPPA variables
226C
227      SIRSOP    = .FALSE.
228      AOSOPPA   = .FALSE.
229C
230      CONNECTION = 'SYMMETR'
231C
232      CALL CC_NODINP(WORD,.TRUE.)
233C
234C----------------------------------------------------------------
235C Initialize additional labels for CCSD(T)-gradient optimization
236C and FOP
237C----------------------------------------------------------------
238
239      ETACCPT = .FALSE.
240      DIRKAPB = .FALSE.
241C
242C-----------------------------
243C     Cholesky initializations
244C-----------------------------
245C
246      CALL CC_CHOMP2INIT
247      CALL CC_CHOCC2INIT
248C
249C---------------------------------------------------------------------
250C     CCSAVE is true for all case, but can be turned of in *ccexci
251C     Only used for linear response - mandatory for oscstr and
252C     polarizabilities
253C---------------------------------------------------------------------
254C
255      CCSAVE = .TRUE.
256C
257C     Initialize the length of the list of response operator labels
258C
259      NPRLBL_CC = 0
260C
261C     Default for evaluation of first derivative integrals
262C
263      DIRGRD = DIRCAL
264C
265C     Default values based on gnrinf common block
266C
267      DIRECT = DIRCAL
268      IPRINT = IPRUSR
269C
270      CALL IZERO(NRHFFR,8)
271      CALL IZERO(NVIRFR,8)
272      CALL IZERO(KFRRHF,8*MAXFRO)
273      CALL IZERO(KFRVIR,8*MAXFRO)
274CSPAS:8/11-13: NOMINP of ccexcinf.h is initialized here but the common block was
275C              not included in CC_INPUT
276C     CALL IZERO(NOMINP,3*8)
277CKeinSPASmehr
278C
279      ITEST = 0
280      DO I=1,8
281        NRHFFR(I) = LOCFRO(I)
282        ITEST = ITEST + NRHFFR(I)
283      END DO
284      FROIMP = ITEST .NE. 0
285C
286      CALL DZERO(EFIELD,MXFELT)
287C
288      ITEST  = 0
289C
290      MINSCR = .TRUE.
291      MINMEM = .FALSE.
292      CCPAIR = .FALSE.
293ccn      MKVAJKL = .FALSE.
294ckr      R12CAL = .TRUE.
295ckr      R12NOA = .FALSE.
296ckr      R12NOP = .FALSE.
297ckr      R12NOB = .FALSE.
298ckr      R12HYB = .TRUE.
299ckr      NORXR  = .FALSE.
300cwk      VCLTHR =  0D0
301cwk      SVDTHR =  1D-15
302ckr      R12XXL = .FALSE.
303
304      BRASCL = 1.0D0
305      KETSCL = 1.0D0
306C
307      RETURN
308      END
309