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*=====================================================================* 20 SUBROUTINE CC_MMOMMO(TRANSA,TRANSB,ALPHA,AMAT,ISYMA,BMAT,ISYMB, 21 & BETA,CMAT,ISYMC) 22*---------------------------------------------------------------------* 23* 24* Purpose: DGEMM like multiplication of two symmetry blocked 25* MO matrices 26* 27* CMAT := alpha AMAT x BMAT + beta CMAT 28* 29* TRANSA: 'N'/'T' transpose / do not transpose A 30* TRANSB: 'N'/'T' transpose / do not transpose B 31* 32* Christof Haettig, March 1999 33* 34*=====================================================================* 35#if defined (IMPLICIT_NONE) 36 IMPLICIT NONE 37#else 38# include "implicit.h" 39#endif 40#include "priunit.h" 41#include "ccorb.h" 42#include "ccsdsym.h" 43 44 LOGICAL LOCDBG 45 PARAMETER (LOCDBG = .FALSE.) 46 47 INTEGER ISYMC, ISYMA, ISYMB 48 CHARACTER*(*) TRANSA, TRANSB 49 50#if defined (SYS_CRAY) 51 REAL AMAT(*), BMAT(*), CMAT(*), ALPHA, BETA 52#else 53 DOUBLE PRECISION AMAT(*), BMAT(*), CMAT(*), ALPHA, BETA 54#endif 55 56 INTEGER ISYA1, ISYA2, ISYB1, ISYB2, ISYC1, ISYC2, LENK 57 INTEGER LDA, LDB, LDC, KOFF1, KOFF2, KOFF3 58 59*---------------------------------------------------------------------* 60* check if the symmetries match: 61*---------------------------------------------------------------------* 62 IF ( ISYMC .NE. MULD2H(ISYMA,ISYMB) ) THEN 63 WRITE (LUPRI,*) 'Symmetry mismatch in CC_MAOMAO.' 64 CALL QUIT('Symmetry mismatch in CC_MAOMAO.') 65 END IF 66 67*---------------------------------------------------------------------* 68* do the matrix multiplication using DGEMM 69*---------------------------------------------------------------------* 70 DO ISYA1 = 1, NSYM 71 72 ISYA2 = MULD2H(ISYA1,ISYMA) 73 74 IF (TRANSA(1:1).EQ.'N' .OR. TRANSA(1:1).EQ.'n') THEN 75 ISYC1 = ISYA1 76 LENK = NBAS(ISYA2) 77 ELSE IF (TRANSA(1:1).EQ.'T' .OR. TRANSA(1:1).EQ.'t') THEN 78 ISYC1 = ISYA2 79 LENK = NBAS(ISYA1) 80 END IF 81 82 ISYC2 = MULD2H(ISYC1,ISYMC) 83 84 IF (TRANSB(1:1).EQ.'N' .OR. TRANSB(1:1).EQ.'n') THEN 85 ISYB2 = ISYC2 86 ISYB1 = MULD2H(ISYB2,ISYMB) 87 ELSE IF (TRANSB(1:1).EQ.'T' .OR. TRANSB(1:1).EQ.'t') THEN 88 ISYB1 = ISYC1 89 ISYB2 = MULD2H(ISYB1,ISYMB) 90 END IF 91 92 LDA = MAX(NORBS(ISYA1),1) 93 LDB = MAX(NORBS(ISYB1),1) 94 LDC = MAX(NORBS(ISYC1),1) 95 96 KOFF1 = IAODIS(ISYA1,ISYA2) + 1 97 KOFF2 = IAODIS(ISYB1,ISYB2) + 1 98 KOFF3 = IAODIS(ISYC1,ISYC2) + 1 99 100 CALL DGEMM(TRANSA,TRANSB,NORBS(ISYC1),NORBS(ISYC2),LENK, 101 & ALPHA,AMAT(KOFF1),LDA,BMAT(KOFF2),LDB, 102 & BETA, CMAT(KOFF3),LDC) 103 104 END DO 105 106 RETURN 107 END 108*=====================================================================* 109