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