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