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*======================================================================* 19 subroutine cc_fckdela(ibasd,isydel,fock,isyfck,xcou,xexc,ifckvao) 20*----------------------------------------------------------------------* 21* Purpose: update Fock matrix with one AO and one virtual index 22* using precomputed partially transformed integrals 23* C. Haettig, spring 2006 24*----------------------------------------------------------------------* 25 implicit none 26#include "ccsdsym.h" 27#include "ccorb.h" 28 29 real*8 one, two 30 parameter ( one=1.0d0, two=2.0d0 ) 31 32* input: 33 integer ibasd, isydel, isyfck, ifckvao(8,8) 34 real*8 fock(*), xcou(*), xexc(*) 35 36* local: 37 integer isyma, kofff, isymi, koffx, isymai 38 39 isyma = muld2h(isyfck,isydel) 40 kofff = ifckvao(isyma,isydel) + nvir(isyma)*(ibasd-1) + 1 41 42 do isymi = 1, nsym 43 isymai = muld2h(isyma,isymi) 44 do i = 1, nrhf(isymi) 45 46 ! address of X^del(1,i,i) 47 koffx = it2bcd(isymai,isymi) + nt1am(isymai)*(i-1) + 48 & it1am(isyma,isymi) + nvir(isyma)*(i-1) + 1 49 50 call daxpy(nvir(isyma), two,xcou(koffx),1,fock(kofff),1) 51 call daxpy(nvir(isyma),-one,xexc(koffx),1,fock(kofff),1) 52 53 end do 54 end do 55 56 return 57 end 58*======================================================================* 59