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_FCKRLX1(FOCK1,FOCK0,ISYFCK1,ISYFCK0, 21 & XLAMDP0,XLAMDH0,ISYMP0,ISYMH0, 22 & XLAMDP1,XLAMDH1,ISYMP1,ISYMH1, 23 & LRELAX,WORK,LWORK) 24*---------------------------------------------------------------------- 25* 26* Purpose: transform derivative AO fock matrix to MO basis and 27* add relaxation contributions coming from the 28* derivatives of the transformation matrices 29* 30* if LRELAX, add relaxation contributions 31* 32* FOCK1 : derivative fock matrix, replaced on output 33* FOCK0 : zeroth-order fock matrix, unchanged on output 34* 35* WARNING: Symmetry of result is NOT necessarily ISYFCK1!!! 36* 37* Christof Haettig, July 1998 38* 39* Generalized for pairs of XLAMDH and XLAMDP of different symmetry 40* Symmetry of FOCK1, FOCK0 in input must be specified outside 41* Sonia Coriani, September 1999 42* (symmetry tests to be added) 43*====================================================================== 44#if defined (IMPLICIT_NONE) 45 IMPLICIT NONE 46#else 47# include "implicit.h" 48#endif 49#include "priunit.h" 50#include "ccorb.h" 51#include "ccsdsym.h" 52 53 LOGICAL LOCDBG 54 PARAMETER (LOCDBG = .FALSE.) 55 56 LOGICAL LRELAX 57 INTEGER ISYMP0, ISYMP1, ISYMH0, ISYMH1, ISYPH0, ISYPH1 58 INTEGER ISYFCK1,ISYFCK0 59 INTEGER LWORK, ISYRES, KEND1, KSCR, LWRK1 60 61#if defined (SYS_CRAY) 62 REAL FOCK1(*), FOCK0(*), WORK(*) 63 REAL XLAMDP0(*), XLAMDH0(*), XLAMDP1(*), XLAMDH1(*) 64 REAL ONE, XNORM, DDOT, DNRM2 65#else 66 DOUBLE PRECISION FOCK1(*), FOCK0(*), WORK(*) 67 DOUBLE PRECISION XLAMDP0(*), XLAMDH0(*), XLAMDP1(*), XLAMDH1(*) 68 DOUBLE PRECISION ONE, XNORM, DDOT, DNRM2 69#endif 70 PARAMETER(ONE=1.0D0) 71 72 73*---------------------------------------------------------------------* 74* if debug flag set, print input matrices in AO: 75*---------------------------------------------------------------------* 76 IF (LOCDBG) THEN 77 WRITE (LUPRI,*) 'CC_FCKRLX1> FOCK1 in AO:' 78 CALL CC_PRFCKAO(FOCK1,ISYFCK1) 79 XNORM = DNRM2(N2BST(ISYFCK1),FOCK1,1) 80 WRITE (LUPRI,*) 'Norm of AO FOCK1 matrix:', XNORM 81 WRITE (LUPRI,*) 'CC_FCKRLX1> FOCK0 in AO:' 82 CALL CC_PRFCKAO(FOCK0,ISYFCK0) 83 XNORM = DNRM2(N2BST(ISYFCK0),FOCK0,1) 84 WRITE (LUPRI,*) 'Norm of AO FOCK0 matrix:', XNORM 85 CALL FLSHFO(LUPRI) 86 END IF 87 88*---------------------------------------------------------------------* 89* transform derivative AO Fock matrix to MO using XLAMDP0/XLAMDH0 90*---------------------------------------------------------------------* 91 ISYPH0 = MULD2H(ISYMP0,ISYMH0) 92 ISYPH1 = MULD2H(ISYMP1,ISYMH1) 93 ISYRES = MULD2H(ISYFCK1,ISYPH0) 94 95 IF (ISYRES.NE.ISYFCK1) THEN 96 WRITE (LUPRI,*) 97 * 'Warning:ISYRES.NE.ISYFCK1. Replace FOCK1 in output?' 98 END IF 99 100* FOCK1 must be allocated outside as MAX(N2BST(ISYFCK1),N2BST(ISYRES))!! 101 102 CALL CC_FCKMO(FOCK1,XLAMDP0,XLAMDH0, 103 * WORK,LWORK,ISYFCK1,ISYMP0,ISYMH0) 104 105*---------------------------------------------------------------------* 106* transform zero AO Fock matrix to MO using XLAMDP0/XLAMDH1 107* XLAMDP1/XLAMDH0 108*---------------------------------------------------------------------* 109 IF (LRELAX) THEN 110 KSCR = 1 !contains Fock_MO 111 KEND1 = KSCR + MAX(N2BST(ISYFCK0),N2BST(ISYRES)) 112 LWRK1 = LWORK - KEND1 113 114 IF ( LWRK1 .LT. 0 ) THEN 115 CALL QUIT('Insufficient work space in CC_FCKRLX.') 116 END IF 117 118* duplicate zeroth-order AO Fock matrix in WORK: 119 CALL DCOPY(N2BST(ISYFCK0),FOCK0,1,WORK(KSCR),1) 120 121* transform zeroth-order AO FOCK with XLAMDP1 and XLAMDH0, 122* and add to transformed derivative Fock matrix: 123 CALL CC_FCKMO(WORK(KSCR),XLAMDP1,XLAMDH0, 124 & WORK(KEND1),LWRK1,ISYFCK0,ISYMP1,ISYMH0) 125 126 CALL DAXPY(N2BST(ISYRES),ONE,WORK(KSCR),1,FOCK1,1) 127 128* duplicate zeroth-order AO Fock matrix in WORK: 129 CALL DCOPY(N2BST(ISYFCK0),FOCK0,1,WORK(KSCR),1) 130 131* transform zeroth-order AO FOCK with XLAMDP0 and XLAMDH1, 132* and add to transformed derivative Fock matrix: 133 CALL CC_FCKMO(WORK(KSCR),XLAMDP0,XLAMDH1, 134 & WORK(KEND1),LWRK1,ISYFCK0,ISYMP0,ISYMH1) 135 136 CALL DAXPY(N2BST(ISYRES),ONE,WORK(KSCR),1,FOCK1,1) 137 138 END IF 139 140*---------------------------------------------------------------------* 141* print debug output and return: 142*---------------------------------------------------------------------* 143 144 IF (LOCDBG) THEN 145 WRITE (LUPRI,*) 'CC_FCKRLX1> FOCK1 in MO:' 146c CALL CC_PRFCKMO(FOCK1,ISYRES) 147 XNORM = DDOT(N2BST(ISYRES),FOCK1,1,FOCK1,1) 148 WRITE (LUPRI,*) 'Norm of MO FOCK1 matrix:', XNORM 149 CALL FLSHFO(LUPRI) 150 END IF 151 152 RETURN 153 154 END 155 156*====================================================================== 157