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