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 cclt_yps1 */ 20 SUBROUTINE CCLT_YPS1(CTR1,ISYCTR,YI,ISYMYI,XLAMDH1, 21 & ISYLM1,XLAMDH2,ISYLM2,YPS) 22C 23C Purpose: To calculate the Ypsilon-type intermediates: 24C 25C Yps(alpha a) = sum_k XLAMDH(alpha k) CTR1(a k) 26C + sum_f XLAMDH(alpha f) YI(f a) 27C 28C ISYCTR : symmetry of CTR1, YI (Zeta_1) 29C ISYLAM : symmetry of XLAMDH 30C 31C Christof Haettig, October 1998 32C 33C Generalized for FbTa transformation: 34C 35C YpsA(alpha a) = sum_k XLAMDH1(alpha k) CTR1(a k) 36C + sum_f XLAMDH2(alpha f) YI(f a) 37C All vectors and matrices can have general symmetry 38C but the two contributions to YpsA must in total have 39C the same symmetry. 40C If ISYYPS is given in input, ISYLM1 and ISYLM2 not needed 41C 42C Sonia Coriani, February 1999 43C 44#include "implicit.h" 45#include "ccorb.h" 46#include "ccsdsym.h" 47#include "cclr.h" 48C 49 PARAMETER(ZERO = 0.0D0, ONE = 1.0D0) 50 DIMENSION CTR1(*),XLAMDH1(*),XLAMDH2(*),YPS(*),YI(*) 51C 52C--------------------------------------------------- 53C Half-transformation to AO-basis of CTR1 and YI 54C--------------------------------------------------- 55C 56 ISYMAO1 = MULD2H(ISYCTR,ISYLM1) 57 ISYMAO2 = MULD2H(ISYMYI,ISYLM2) 58 IF (ISYMAO1.NE.ISYMAO2) CALL QUIT('Symmetry mismatch in CCLT_YPS') 59 ISYYPS = ISYMAO1 60C 61 CALL DZERO(YPS,NGLMDT(ISYYPS)) 62C 63 DO ISYMAL = 1,NSYM !alpha 64C 65 ISYMA = MULD2H(ISYMAL,ISYYPS) 66 ISYMK = MULD2H(ISYMA,ISYCTR) 67 ISYMF = MULD2H(ISYMA,ISYMYI) 68C 69 KOFF1 = IGLMRH(ISYMAL,ISYMK) + 1 !offset LambdaH1_al,k 70 KOFF2 = IT1AM(ISYMA,ISYMK) + 1 !offset Zeta1_ak 71 KOFF3 = IGLMVI(ISYMAL,ISYMA) + 1 !offset Yps_al,a 72C 73 NTOTBA = MAX(NBAS(ISYMAL),1) 74 NTOTVI = MAX(NVIR(ISYMA),1) 75C 76C backtransformation of Zeta1 --> Zeta_al,a 77C 78 CALL DGEMM('N','T',NBAS(ISYMAL),NVIR(ISYMA),NRHF(ISYMK), 79 * ONE,XLAMDH1(KOFF1),NTOTBA,CTR1(KOFF2),NTOTVI, 80 * ONE,YPS(KOFF3),NTOTBA) 81C 82 KOFF4 = IMATAB(ISYMF,ISYMA) + 1 !offset YI_fa 83 KOFF5 = IGLMVI(ISYMAL,ISYMF) + 1 !offset LambdaH2_al,f 84C 85 NTOTVI = MAX(NVIR(ISYMF),1) 86C 87C backtranformation of YI --> YI_al,a 88C 89 CALL DGEMM('N','N',NBAS(ISYMAL),NVIR(ISYMA),NVIR(ISYMF), 90 * ONE,XLAMDH2(KOFF5),NTOTBA,YI(KOFF4),NTOTVI, 91 * ONE,YPS(KOFF3),NTOTBA) 92C 93 END DO 94C 95 RETURN 96 END 97