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*=====================================================================* 20C /* Deck cc_bfbsort1 */ 21 SUBROUTINE CC_BFBSORT1(DSRHF,BSRHF,ISYRHF,LSQRAB) 22*---------------------------------------------------------------------* 23* 24* Purpose: presort DSRHF integral array for the BF intermediate 25* calculation in the B matrix transformation 26* 27* DSRHF : (alp bet|k delta) integrals for a fixed delta 28* BSRHF : integrals sorted as I(alp k;bet)^del 29* ISYRHF : symmetry of the integral arrays DSRHF,BSRHF 30* 31* Written by Christof Haettig July/October 1998 32* Updated by Sonia Coriani November 1999 to handle full (a b| 33*---------------------------------------------------------------------* 34 35 use dyn_iadrpk 36 37#if defined (IMPLICIT_NONE) 38 IMPLICIT NONE 39#else 40# include "implicit.h" 41#endif 42#include "ccorb.h" 43#include "maxorb.h" 44#include "ccsdsym.h" 45#include "symsq.h" 46 47 LOGICAL LSQRAB 48 INTEGER ISYRHF, ISYM, ISYMAK, ISYBET, ISYMK, ISYMAB, ISYALP 49 INTEGER ICOUNT, NBSRHF(8), IBSRHF(8,8) 50 INTEGER NABK, NAKB, NAK, KOFF1, IJSQ 51 52#if defined (SYS_CRAY) 53 REAL DSRHF(*), BSRHF(*) 54#else 55 DOUBLE PRECISION DSRHF(*), BSRHF(*) 56#endif 57C 58C -------------------------------------- 59C precalculate symmetry array for BSRHF: 60C -------------------------------------- 61C 62 DO ISYM = 1, NSYM 63 ICOUNT = 0 64 DO ISYMAK = 1, NSYM 65 ISYBET = MULD2H(ISYMAK,ISYM) 66 IBSRHF(ISYMAK,ISYBET) = ICOUNT 67 ICOUNT = ICOUNT + NT1AO(ISYMAK)*NBAS(ISYBET) 68 END DO 69 NBSRHF(ISYM) = ICOUNT 70 END DO 71C 72C ------------------- 73C sort the integrals: 74C ------------------- 75C 76 DO ISYMAK = 1, NSYM 77 DO ISYMK = 1, NSYM 78C 79 ISYBET = MULD2H(ISYMAK,ISYRHF) 80 ISYALP = MULD2H(ISYMK,ISYMAK) 81 ISYMAB = MULD2H(ISYALP,ISYBET) 82C 83C -------------------------------------------------------- 84C get (alp k;bet) blocks out of (alp bet|k del) integrals: 85C -------------------------------------------------------- 86C 87 DO K = 1, NRHF(ISYMK) 88C 89 IF (LSQRAB) THEN 90 KOFF1 = IDSRHFSQ(ISYMAB,ISYMK) + N2BST(ISYMAB)*(K-1) 91 ELSE 92 KOFF1 = IDSRHF(ISYMAB,ISYMK) + NNBST(ISYMAB)*(K-1) 93 END IF 94C 95 DO A = 1, NBAS(ISYALP) 96 DO B = 1, NBAS(ISYBET) 97C 98 IJSQ = IAODIS(ISYALP,ISYBET) + NBAS(ISYALP)*(B-1) + A 99 IF (LSQRAB) THEN 100 NABK = KOFF1 + IJSQ !not quite sure 101 ELSE 102 NABK = KOFF1 + IADRPK( I2BST(ISYMAB) + IJSQ ) 103 END IF 104 NAK = IT1AO(ISYALP,ISYMK) + NBAS(ISYALP)*(K-1) + A 105 NAKB = IBSRHF(ISYMAK,ISYBET) +NT1AO(ISYMAK)*(B-1) + NAK 106C 107 BSRHF(NAKB) = DSRHF(NABK) 108C 109 END DO 110 END DO 111C 112 END DO 113C 114 END DO 115 END DO 116C 117 RETURN 118 END 119*=====================================================================* 120