1* 2* $Id$ 3* 4 subroutine lcao_generate_kematrix(kematrix,phi1,phi2) 5 implicit none 6 integer kematrix 7 complex*16 phi1(*) 8 complex*16 phi2(*) 9 10#include "bafdecls.fh" 11#include "global.fh" 12 13* **** local variables **** 14 integer i,j,nbasis,npack1 15 integer ispin,ne(2) 16 real*8 sum 17 18* ***** external functions **** 19 integer aorbs_nbasis 20 external aorbs_nbasis 21 22 23 ispin = 1 24 ne(1) = 1 25 ne(2) = 0 26 call Pack_npack(1,npack1) 27 nbasis = aorbs_nbasis() 28 do j=1,nbasis 29 30* **** get phi2 **** 31 call aorbs_aorb(j,phi1) 32 call ke(ispin,ne,phi1,phi2) 33 34 do i=1,j 35 36* **** get phi1 **** 37 call aorbs_aorb(i,phi1) 38 call Pack_cc_dot(1,phi1,phi2,sum) 39 40 sum = -sum 41 call ga_fill_patch(kematrix,i,i,j,j,sum) 42 call ga_fill_patch(kematrix,j,j,i,i,sum) 43 end do 44 end do 45 46 return 47 end 48 49 50