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