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
19      SUBROUTINE CCRHS_IPM1(XINT,XINTP,XINTM,SCRAB,INDV1,INDV2,
20     *                     ISYMAB,ISYMG,NUMG,IG1,IG2,IOPT)
21C
22C     Written by Henrik Koch 17-aug-1994.
23C
24C     Purpose: Making plus and minus combination of integrals.
25C              (a>=g|bd) -> K+ and K- where
26C                           K+- = (ag|bd) +- (bg|ad) a<=b,g<=d
27C
28C     Modified by Sonia Coriani 26-oct-1999 to
29C              handle XINT with squared (ag|bd) (ag part):
30C              If IOPT = 0, XINT in input is packed  (a>=g|bd)
31C              If IOPT = 1, XINT in input is squared (ag|bd)
32C
33C
34#include "implicit.h"
35#include "maxorb.h"
36      PARAMETER(ONE = 1.0D0, TWO = 2.0D0)
37      DIMENSION XINT(*),XINTP(*),XINTM(*),SCRAB(*)
38      DIMENSION INDV1(*), INDV2(*)
39#include "ccorb.h"
40#include "ccsdsym.h"
41#include "symsq.h"
42C
43      INDEX(I,J) = MAX(I,J)*(MAX(I,J)-3)/2 + I + J
44C
45      ISYDIS = MULD2H(ISYMAB,ISYMG)
46C
47C
48      DO 100 G = IG1,IG2
49C
50         IG = G - IG1 + 1
51C
52         DO 110 ISYMB = 1,NSYM
53C
54            ISYMA  = MULD2H(ISYMB,ISYMAB)
55            ISYMAG = MULD2H(ISYMA,ISYMG)
56C
57            NTOTA  = MAX(NBAS(ISYMA),1)
58cs
59            IF (IOPT.EQ.0) THEN
60               NTOTAG = MAX(NNBST(ISYMAG),1)
61            ELSE IF (IOPT.EQ.1) THEN
62               NTOTAG = MAX(N2BST(ISYMAG),1)
63            ELSE
64               CALL QUIT('Unknown option in CCRHS_IPM1')
65            END IF
66C
67            DO 120 A = 1,NBAS(ISYMA)
68C
69               IF (IOPT.EQ.0) THEN
70                  IF (ISYMA .EQ. ISYMG) THEN
71                     KOFF1 = IDSAOG(ISYMB,ISYDIS) + IAODPK(ISYMA,ISYMG)
72     *                     + INDEX(G,A)
73                  ELSE IF (ISYMA .LT. ISYMG) THEN
74                     KOFF1 = IDSAOG(ISYMB,ISYDIS) + IAODPK(ISYMA,ISYMG)
75     *                     + NBAS(ISYMA)*(G - 1) + A
76                  ELSE
77                     KOFF1 = IDSAOG(ISYMB,ISYDIS) + IAODPK(ISYMA,ISYMG)
78     *                     + NBAS(ISYMG)*(A - 1) + G
79                  ENDIF
80               ELSE IF (IOPT.EQ.1) THEN
81                  KOFF1 = IDSAOGSQ(ISYMB,ISYDIS) + IAODIS(ISYMA,ISYMG)
82     &                  + NBAS(ISYMA)*(G - 1) + A
83               END IF
84C
85               KOFF2 = IAODIS(ISYMA,ISYMB) + A
86C
87               CALL DCOPY(NBAS(ISYMB),XINT(KOFF1),NTOTAG,
88     *                    SCRAB(KOFF2),NTOTA)
89C
90  120       CONTINUE
91C
92  110    CONTINUE
93C
94         KOFF = NNBST(ISYMAB)*(IG - 1)
95C
96#if !defined (SYS_CRAY)
97         DO 130 I = 1,NNBST(ISYMAB)
98C
99            XINTP(KOFF + I) = SCRAB(INDV1(I))
100            XINTM(KOFF + I) = SCRAB(INDV2(I))
101C
102  130    CONTINUE
103#else
104         CALL GATHER(NNBST(ISYMAB),XINTP(KOFF + 1),SCRAB,INDV1)
105         CALL GATHER(NNBST(ISYMAB),XINTM(KOFF + 1),SCRAB,INDV2)
106#endif
107C
108  100 CONTINUE
109C
110C
111      NTOT = NNBST(ISYMAB)*NUMG
112C
113      CALL DAXPY(NTOT,ONE,XINTM,1,XINTP,1)
114      CALL DSCAL(NTOT,-TWO,XINTM,1)
115      CALL DAXPY(NTOT,ONE,XINTP,1,XINTM,1)
116C
117      RETURN
118      END
119