1 subroutine hf1_tran_shift(Gab,Gabcp,ngen,la,lb,nca,ncb) 2* $Id$ 3 implicit none 4 integer la, lb 5 integer nca, ncb 6 integer ngen 7 double precision 8 & Gabcp(1:((lb+1)*(lb+2)/2),1:((la+1)*(la+2)/2),ngen) 9 double precision 10 & Gab(1:ncb*((lb+1)*(lb+2)/2),1:nca*((la+1)*(la+2)/2)) 11c 12 integer kgen, igen, la2, lb2, ninta, nintb 13 integer ica, icb, ia, ib 14c 15 la2 = (la+1)*(la+2)/2 16 lb2 = (lb+1)*(lb+2)/2 17* write(6,*)' nca = ',nca 18* write(6,*)' ncb = ',ncb 19* write(6,*)' la/la2 = ',la,la2 20* write(6,*)' lb/lb2 = ',lb,lb2 21 igen = 0 22 do ica = 1,nca 23 do icb = 1,ncb 24 kgen = igen + 1 25 do ia = 1,la2 26 ninta=(ica-1)*la2+ia 27 do ib = 1,lb2 28 nintb=(icb-1)*lb2+ib 29* write(6,*)'nintb,ninta,ib,ia,kgen,igen', 30* & nintb,ninta,ib,ia,kgen,igen,ica,icb 31 Gab(nintb,ninta) = Gabcp(ib,ia,kgen) 32 enddo 33 enddo 34 igen = igen + 1 35 enddo 36 enddo 37c 38* igen = 0 39* do ica = 1,nca 40* do icb = 1,ncb 41* igen = igen + 1 42* write(6,*)' ica ',ica,' icb ',icb,' igen ',igen 43* enddo 44* enddo 45* do igen = 1,ngen 46* write(6,*)' gabcp matrix for general contraction ',igen 47* call output(gabcp(1,1,igen),1,lb2,1,la2,lb2,la2,1) 48* enddo 49* igen = 0 50* kgen = 0 51* do ica = 1,nca 52* do icb = 1,ncb 53* igen = igen + 1 54* do ia = 1,la2 55* do ib = 1,lb2 56* if (abs(gabcp(ib,ia,igen)).gt.1.0d-08) then 57* kgen = kgen + 1 58* endif 59* enddo 60* enddo 61* enddo 62* enddo 63* write(6,*)' number of non-zero gabcp elements ',kgen 64* write(6,*)' gab transformed ' 65* call output(gab,1,(lb2*ncb),1,(la2*nca),(lb2*ncb),(la2*nca),1) 66* kgen = 0 67* do ia = 1,(nca*la2) 68* do ib = 1,(ncb*lb2) 69* if (abs(gab(ib,ia)).gt.1.0d-08) then 70* kgen = kgen + 1 71* endif 72* enddo 73* enddo 74* write(6,*)' number of non-zero gab elements ',kgen 75c 76 end 77 subroutine hf1_tran_gen(gctrana,gctranb,PAIRp,NPP, 78 & Acoefs,NPA,NCA,Bcoefs,NPB,NCB) 79 implicit none 80c 81c form the general contraction transformation matrix for 1e (2 index quantities) 82c 83#include "stdio.fh" 84c::passed 85 integer NPP ! [input] number of primitive pairs used on center P (=A,B) 86 integer NPA ! [input] number of primitives on center A 87 integer NPB ! [input] number of primitives on center B 88 integer NCA ! [input] number of contractions on center A 89 integer NCB ! [input] number of contractions on center B 90 integer PAIRp (2,NPP) ! [input] kept indices of contraction coeffs 91 double precision Acoefs(NPA,NCA) ! [input] conctraction coeffs on center A 92 double precision Bcoefs(NPB,NCB) ! [input] conctraction coeffs on center B 93 double precision gctrana(NPP,NCA) ! [output] general contraction coefs for A multiply 94 double precision gctranb(NCB,NPP) ! [output] general contraction coefs for B multiply 95c::local 96 integer ica,icb,ipp 97c 98 do 00100 ica = 1,NCA 99 do 00200 ipp = 1,NPP 100* write(6,*)' ica,ipp,pair = ',ica, ipp,PAIRP(1,ipp) 101 gctrana(ipp,ica) = Acoefs(PAIRP(1,ipp),ica) 10200200 continue 10300100 continue 104 do 00300 icb = 1,NCB 105 do 00400 ipp = 1,NPP 106* write(6,*)' icb,ipp,pair = ',icb, ipp,PAIRP(2,ipp) 107 gctranb(icb,ipp) = Bcoefs(PAIRP(2,ipp),icb) 10800400 continue 10900300 continue 110 end 111