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 ccs_dhfao */
20      SUBROUTINE CC_DHFAO(AODEN,ISYDAO,CMOP,ISYMP,CMOH,ISYMH,WORK,LWORK)
21C
22C     Purpose: To set up HF one electron AO-density matrix
23C              allow for two different CMO vectors to handle
24C              different density matrices needed for derivatives
25C
26C                D_alp,bet = \sum_i  CMOP_alp,i CMOH_bet,i
27C
28C     Christof Haettig, spring 99, based on Asgers CCS_D1AO
29C
30#include "implicit.h"
31      PARAMETER(ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0)
32      DIMENSION AODEN(*), WORK(LWORK), CMOP(*), CMOH(*)
33#include "priunit.h"
34#include "ccorb.h"
35#include "ccsdsym.h"
36#include "cclr.h"
37C
38C---------------------------
39C     Work space allocation.
40C---------------------------
41C
42      KONEAI = 1
43      KONEAB = KONEAI + NT1AMX
44      KONEIJ = KONEAB + NMATAB(1)
45      KONEIA = KONEIJ + NMATIJ(1)
46      KEND1  = KONEIA + NT1AMX
47      LWRK1  = LWORK  - KEND1
48C
49      IF (LWRK1 .LT. 0) THEN
50         WRITE(LUPRI,*) 'Available:', LWORK, 'Needed:', KEND1
51         CALL QUIT('Insufficient memory for work allocation '//
52     &        'in CCS_D1AO')
53      ENDIF
54C
55C--------------------------------------------------------------
56C     Initialize arrays
57C--------------------------------------------------------------
58C
59      CALL DZERO(WORK(KONEAI),NT1AMX)
60      CALL DZERO(WORK(KONEAB),NMATAB(1))
61      CALL DZERO(WORK(KONEIJ),NMATIJ(1))
62      CALL DZERO(WORK(KONEIA),NT1AMX)
63C
64C-----------------------
65C     Set up MO-density.
66C-----------------------
67C
68      DO 100 ISYM = 1,NSYM
69         DO 110 I = 1,NRHF(ISYM)
70C
71            NII = IMATIJ(ISYM,ISYM) + NRHF(ISYM)*(I - 1) + I
72C
73            WORK(KONEIJ + NII - 1) = TWO
74C
75  110    CONTINUE
76  100 CONTINUE
77C
78C-----------------------------------
79C     Transform density to AO basis.
80C-----------------------------------
81C
82      ISYDEN = MULD2H(ISYMP,ISYMH)
83C
84      CALL DZERO(AODEN,N2BST(ISYDEN))
85C
86C     IF (ISYMH.NE.1 .OR. ISYMP.NE.1) THEN
87C        WRITE (LUPRI,*) 'CC_DHFAO only implemented for '//
88C    &        'total symmetric CMO.'
89C        WRITE (LUPRI,*) 'ISYMH, ISYMP:',ISYMH,ISYMP
90C        CALL QUIT('CC_DHFAO only implemented for total symmetric CMO.')
91C     END IF
92C
93      ISYDMO = 1
94      CALL CC_DENAO(AODEN,ISYDAO,WORK(KONEAI),WORK(KONEAB),
95     *              WORK(KONEIJ),WORK(KONEIA),ISYDMO,CMOP,ISYMP,
96     *              CMOH,ISYMH,WORK(KEND1),LWRK1)
97C
98      RETURN
99      END
100