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