mirror of
https://github.com/nwchemgit/nwchem.git
synced 2026-07-29 06:35:39 -04:00
temporarily removing symmetry orbital correction for integrals; moving center for dipoles from CoM to coordinate center
This commit is contained in:
lachlan.belcher
edoapra
parent
24e60be437
commit
b5d8d4ebd6
3 changed files with 75 additions and 63 deletions
|
|
@ -382,24 +382,27 @@ c ECP is summed here, but COLUMBUS should not care.
|
|||
& thresh, int_mb(k_ilab),int_mb(k_jlab), max1e,
|
||||
& dbl_mb(k_buf), mem1, dbl_mb(k_scr), numints)
|
||||
end if
|
||||
WRITE(*,*)"LB, numints=",numints
|
||||
c
|
||||
do i=1,numints
|
||||
|
||||
if(ibuf.eq.n1max) then
|
||||
if(ibuf.eq.n1max) then !dump full record to file
|
||||
numtot = numtot + ibuf
|
||||
C LB
|
||||
WRITE(*,*)"C LB, calling sym_1int 1"
|
||||
CALL sym_1int(ibuf,nsoints,
|
||||
& dbl_mb(k_sifval), clab,
|
||||
& dbl_mb(k_SOval), cSOlab)
|
||||
WRITE(*,'(a,1i4)')"C LB, nsoints =",nsoints
|
||||
WRITE(*,*)"C LB, cSOlab ="
|
||||
WRITE(*,'(2i4)') cSOlab(1:2,1:nsoints)
|
||||
! WRITE(*,*)"C LB, calling sym_1int 1"
|
||||
! CALL sym_1int(ibuf,nsoints,
|
||||
! & dbl_mb(k_sifval), clab,
|
||||
! & dbl_mb(k_SOval), cSOlab)
|
||||
! WRITE(*,'(a,1i4)')"C LB, nsoints =",nsoints
|
||||
! WRITE(*,*)"C LB, cSOlab ="
|
||||
! WRITE(*,'(2i4)') cSOlab(1:2,1:nsoints)
|
||||
C LB
|
||||
WRITE(*,*)"C LB, calling sifew1"
|
||||
call sifew1(aoints, info, 2, nsoints, last,
|
||||
! call sifew1(aoints, info, 2, nsoints, last,
|
||||
call sifew1(aoints, info, 2, ibuf, last,
|
||||
& itypea, itypeb, ibvtyp,
|
||||
& dbl_mb(k_SOval), cSOlab, fcore, ibitv,
|
||||
! & dbl_mb(k_SOval), cSOlab, fcore, ibitv,
|
||||
& dbl_mb(k_sifval), clab, fcore, ibitv,
|
||||
& dbl_mb(k_sifbuf), nrec, ierr)
|
||||
c ibuf on return has the number of unwritten
|
||||
c integrals. dbl_mb(k_sifval+0:(ibuf-1))
|
||||
|
|
@ -407,10 +410,12 @@ c contains the unwritten values, ditto for labels
|
|||
numtot = numtot - ibuf
|
||||
endif
|
||||
|
||||
ibuf=ibuf+1
|
||||
clab(1,ibuf)=int_mb(k_ilab+i-1)
|
||||
clab(2,ibuf)=int_mb(k_jlab+i-1)
|
||||
dbl_mb(k_sifval+ibuf-1)=dbl_mb(k_buf+i-1)
|
||||
IF ( ABS(dbl_mb(k_buf+i-1)) .gt. thresh) THEN
|
||||
ibuf=ibuf+1
|
||||
clab(1,ibuf)=int_mb(k_ilab+i-1)
|
||||
clab(2,ibuf)=int_mb(k_jlab+i-1)
|
||||
dbl_mb(k_sifval+ibuf-1)=dbl_mb(k_buf+i-1)
|
||||
ENDIF
|
||||
|
||||
enddo ! i
|
||||
|
||||
|
|
@ -420,14 +425,16 @@ c contains the unwritten values, ditto for labels
|
|||
end do !j_shell
|
||||
last=nmsame
|
||||
numtot=numtot+ibuf
|
||||
WRITE(*,*)"C LB, calling sym_1int 2"
|
||||
CALL sym_1int(ibuf,nsoints,
|
||||
& dbl_mb(k_sifval), clab,
|
||||
& dbl_mb(k_SOval), cSOlab)
|
||||
! WRITE(*,*)"C LB, calling sym_1int 2, ibuf=",ibuf
|
||||
! CALL sym_1int(ibuf,nsoints,
|
||||
! & dbl_mb(k_sifval), clab,
|
||||
! & dbl_mb(k_SOval), cSOlab)
|
||||
WRITE(*,*)"C LB, calling sifew1"
|
||||
call sifew1(aoints, info, 2, nsoints, last,
|
||||
! call sifew1(aoints, info, 2, nsoints, last,
|
||||
call sifew1(aoints, info, 2, ibuf, last,
|
||||
& itypea, itypeb, ibvtyp,
|
||||
& dbl_mb(k_SOval), cSOlab, fcore, ibitv,
|
||||
! & dbl_mb(k_SOval), cSOlab, fcore, ibitv,
|
||||
& dbl_mb(k_sifval), clab, fcore, ibitv,
|
||||
& dbl_mb(k_sifbuf), nrec, ierr)
|
||||
|
||||
write(6,'(a,i10,1x,a,a)') 'Wrote ',numtot, integ_type,
|
||||
|
|
|
|||
|
|
@ -204,12 +204,12 @@ c int_type = 1, linear momentum
|
|||
c int_type = 2, angular momentum
|
||||
c int_type = 3, dipole moments
|
||||
do int_type=1,3
|
||||
WRITE(*,*)"LB, starting int_type loop",int_type
|
||||
! WRITE(*,*)"LB, starting int_type loop",int_type
|
||||
|
||||
if(int_type.eq.1.or.int_type.eq.2) itypea=2 ! gonna do dipole
|
||||
if(int_type.eq.3) itypea=1
|
||||
|
||||
WRITE(*,*)" LB, starting int_type loop, itypea=",itypea
|
||||
! WRITE(*,*)" LB, starting int_type loop, itypea=",itypea
|
||||
|
||||
if (0 .eq. ga_nodeid()) then
|
||||
cgk debug
|
||||
|
|
@ -257,23 +257,26 @@ C LB
|
|||
C LB
|
||||
C LB Dipoles
|
||||
elseif(int_type.eq.3) then
|
||||
!write(*,*)'LB: calling int_mpolel'
|
||||
lval=1;! 1 for dipoles
|
||||
! get geom
|
||||
IF (.NOT. bas_geom(ibas,geom)) CALL errquit
|
||||
$ ('int_mom_sifs: bas_geom failed for ibas', ibas,
|
||||
& BASIS_ERR)
|
||||
IF (.NOT. geom_center_of_mass(geom, centerl)) CALL
|
||||
& errquit ('int_mom_sifs: geom_center_of_mass failed'
|
||||
& ,geom,GEOM_ERR)
|
||||
WRITE(*,*)"LB, calling int_mpolel"
|
||||
! get centerl
|
||||
! IF (.NOT. geom_center_of_mass(geom, centerl)) CALL
|
||||
! & errquit ('int_mom_sifs: geom_center_of_mass failed'
|
||||
! & ,geom,GEOM_ERR)
|
||||
centerl=0
|
||||
! WRITE(*,*)"LB, calling int_mpolel"
|
||||
WRITE(*,*)"LB, centerl=",centerl
|
||||
CALL int_mpolel (ibas, ishell, ibas, jshell,
|
||||
$ lval, centerl,
|
||||
$ mem1mom, dbl_mb(k_scr), max1mom, dbl_mb(k_buf),
|
||||
$ Num_MPint)
|
||||
WRITE(*,'(a,2i5)')"LB, ishell, jshell =", ishell, jshell
|
||||
WRITE(*,'(a,1i5)')"LB, Num_MPint =", Num_MPint
|
||||
WRITE(*,*)"poles="
|
||||
WRITE(*,*)dbl_mb(k_buf:k_buf+Num_MPint-1)
|
||||
! WRITE(*,'(a,2i5)')"LB, ishell, jshell =", ishell, jshell
|
||||
! WRITE(*,'(a,1i5)')"LB, Num_MPint =", Num_MPint
|
||||
! WRITE(*,*)"poles="
|
||||
! WRITE(*,*)dbl_mb(k_buf:k_buf+Num_MPint-1)
|
||||
C LB
|
||||
endif
|
||||
|
||||
|
|
@ -287,8 +290,8 @@ C LB
|
|||
noffsetx = 2
|
||||
ENDIF
|
||||
|
||||
WRITE(*,'(a,3i4)')"LB, noffsetz,noffsety,noffsetx=",noffsetz,
|
||||
& noffsety,noffsetx
|
||||
! WRITE(*,'(a,3i4)')"LB, noffsetz,noffsety,noffsetx=",noffsetz,
|
||||
! & noffsety,noffsetx
|
||||
do j=jlo,jhi
|
||||
do i=ilo,ihi
|
||||
cgk debug
|
||||
|
|
@ -298,14 +301,13 @@ cgk debug
|
|||
cgk end
|
||||
ijmap=(j-jlo)*(ihi-ilo+1)+(i-ilo)
|
||||
IF (int_type .eq. 3) THEN! dipoles
|
||||
!ijmap=ijmap*(ihi-ilo+1)
|
||||
ijmap=(i-ilo)*(jhi-jlo+1)+(j-jlo)
|
||||
ijmap=ijmap*3
|
||||
ENDIF
|
||||
if(i.ge.j) then
|
||||
symmap=nbft*(j-1)-((j-1)*j)/2+i
|
||||
WRITE(*,'(a,2i4)')"LB, ijmap, symmap=",ijmap,symmap
|
||||
* write(*,*)'gk: symmap=',symmap
|
||||
! WRITE(*,'(a,2i4)')"LB, ijmap, symmap=",ijmap,symmap
|
||||
! write(*,*)'gk: symmap=',symmap
|
||||
dbl_mb(k_momx+symmap-1)=
|
||||
& dbl_mb(k_buf+noffsetx+ijmap)
|
||||
dbl_mb(k_momy+symmap-1)=
|
||||
|
|
@ -315,15 +317,15 @@ cgk end
|
|||
int_mb(k_imom+symmap-1)=i
|
||||
int_mb(k_jmom+symmap-1)=j
|
||||
cgk debug
|
||||
write(*,'(a,3i3,f18.12)')
|
||||
& 'gk: i,j,ij,dbl_mb(mom_x):',
|
||||
& i,j,numints+ijmap,dbl_mb(k_momx+symmap-1)
|
||||
write(*,'(a,3i3,f18.12)')
|
||||
& 'gk: i,j,ij,dbl_mb(mom_y):',
|
||||
& i,j,numints+ijmap,dbl_mb(k_momy+symmap-1)
|
||||
write(*,'(a,3i3,f18.12)')
|
||||
& 'gk: i,j,ij,dbl_mb(mom_z):',
|
||||
& i,j,numints+ijmap,dbl_mb(k_momz+symmap-1)
|
||||
! write(*,'(a,3i3,f18.12)')
|
||||
! & 'gk: i,j,ij,dbl_mb(mom_x):',
|
||||
! & i,j,numints+ijmap,dbl_mb(k_momx+symmap-1)
|
||||
! write(*,'(a,3i3,f18.12)')
|
||||
! & 'gk: i,j,ij,dbl_mb(mom_y):',
|
||||
! & i,j,numints+ijmap,dbl_mb(k_momy+symmap-1)
|
||||
! write(*,'(a,3i3,f18.12)')
|
||||
! & 'gk: i,j,ij,dbl_mb(mom_z):',
|
||||
! & i,j,numints+ijmap,dbl_mb(k_momz+symmap-1)
|
||||
cgk end
|
||||
endif
|
||||
enddo ! ilo
|
||||
|
|
@ -394,8 +396,8 @@ cgk debug
|
|||
numtot = numtot + ibuf
|
||||
C LB
|
||||
!WRITE(*,*)"LB: in int_mom_sifs"
|
||||
WRITE(*,*)"LB: in int_mom_sifs, ibuf=",ibuf
|
||||
WRITE(*,*)"LB: itypea,itypeb=",itypea,itypeb
|
||||
! WRITE(*,*)"LB: in int_mom_sifs, ibuf=",ibuf
|
||||
! WRITE(*,*)"LB: itypea,itypeb=",itypea,itypeb
|
||||
!WRITE(*,*)"LB: calling sifew1 1 last=",last,"ibvtyp=",ibvtyp
|
||||
C LB
|
||||
call sifew1(aoints, info, 2, ibuf, msame,
|
||||
|
|
@ -407,6 +409,7 @@ C LB
|
|||
|
||||
momval=dbl_mb(kcart+symmap)
|
||||
|
||||
! WRITE(*,*)"LB, momval =",momval
|
||||
if(abs(momval).gt.thresh) then
|
||||
ibuf=ibuf+1
|
||||
clab(1,ibuf)=int_mb(k_imom+symmap)
|
||||
|
|
@ -416,7 +419,6 @@ C LB
|
|||
symmap=symmap+1
|
||||
enddo
|
||||
enddo
|
||||
!if (icart.eq.3.and.int_type.eq.2) then
|
||||
if (icart.eq.3.and.int_type.eq.3) then
|
||||
last=nomore
|
||||
else
|
||||
|
|
@ -429,18 +431,19 @@ cgk debug
|
|||
* write(*,*)'gk: numtot=', numtot
|
||||
cgk end
|
||||
C LB
|
||||
!WRITE(*,*)"LB: in int_mom_sifs"
|
||||
WRITE(*,*)"LB: in int_mom_sifs, ibuf=",ibuf
|
||||
WRITE(*,*)"LB: itypea,itypeb=",itypea,itypeb
|
||||
WRITE(*,*)"C LB, calling sym_1int 2"
|
||||
CALL sym_1int(ibuf,nsoints,
|
||||
& sifval, clab,
|
||||
& SOval, cSOlab)
|
||||
!WRITE(*,*)"LB: calling sifew1 2 last=",last,"ibvtyp=",ibvtyp
|
||||
! WRITE(*,*)"LB: in int_mom_sifs, ibuf=",ibuf
|
||||
! WRITE(*,*)"LB: itypea,itypeb=",itypea,itypeb
|
||||
! WRITE(*,*)"C LB, calling sym_1int 2"
|
||||
! CALL sym_1int(ibuf,nsoints,
|
||||
! & sifval, clab,
|
||||
! & SOval, cSOlab)
|
||||
! WRITE(*,*)"LB: calling sifew1 2 last=",last,"ibvtyp=",ibvtyp
|
||||
C LB
|
||||
call sifew1(aoints, info, 2, nsoints, last,
|
||||
! call sifew1(aoints, info, 2, nsoints, last,
|
||||
call sifew1(aoints, info, 2, ibuf, last,
|
||||
& itypea, itypeb, ibvtyp,
|
||||
& SOval, cSOlab, fcore, ibitv,
|
||||
! & SOval, cSOlab, fcore, ibitv,
|
||||
& sifval, clab, fcore, ibitv,
|
||||
& sifbuf, nrec, ierr)
|
||||
write(6,'(a,i10,1x,a,a)') 'Wrote ',numtot, integ_type,
|
||||
& ' integrals to aoints'
|
||||
|
|
|
|||
|
|
@ -318,18 +318,20 @@ cgk end
|
|||
numtot=numtot+ibuf
|
||||
cgk debug
|
||||
WRITE(*,*)"C LB, calling sym_1int 2"
|
||||
CALL sym_1int(ibuf,nsoints,
|
||||
& sifval, clab,
|
||||
& SymOrbval, cSOlab)
|
||||
! CALL sym_1int(ibuf,nsoints,
|
||||
! & sifval, clab,
|
||||
! & SymOrbval, cSOlab)
|
||||
* WRITE(*,*)"int_so_sifs calling sifew1 2"
|
||||
* write(*,*)'gk: nrec=', nrec
|
||||
* write(*,*)'gk: ibuf=', ibuf
|
||||
* write(*,*)'gk: numtot=', numtot
|
||||
* WRITE(*,*)"last=",last,"ibvtyp=",ibvtyp
|
||||
cgk end
|
||||
call sifew1(aoints, info, 2, nsoints, last,
|
||||
! call sifew1(aoints, info, 2, nsoints, last,
|
||||
call sifew1(aoints, info, 2, ibuf, last,
|
||||
& itypea, itypeb, ibvtyp,
|
||||
& SymOrbval, cSOlab, fcore, ibitv,
|
||||
! & SymOrbval, cSOlab, fcore, ibitv,
|
||||
& sifval, clab, fcore, ibitv,
|
||||
& sifbuf, nrec, ierr)
|
||||
write(6,'(a,i10,1x,a,a)') 'Wrote ',numtot, integ_type,
|
||||
& ' integrals to aoints'
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue