Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Nwc sym #1046

Merged
merged 1 commit into from
Nov 20, 2024
+75 −63
Merged

Nwc sym #1046

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
47 changes: 27 additions & 20 deletions src/nwc_columbus/aoints/int_1e_sifs.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -382,35 +382,40 @@ subroutine int_1e_sifs(ibas, aoints, energy, nenrgy, nbft,
& 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))
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

Expand All @@ -420,14 +425,16 @@ subroutine int_1e_sifs(ibas, aoints, energy, nenrgy, nbft,
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,
Expand Down
79 changes: 41 additions & 38 deletions src/nwc_columbus/aoints/int_mom_sifs.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -204,12 +204,12 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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
Expand Down Expand Up @@ -257,23 +257,26 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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

Expand All @@ -287,8 +290,8 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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
Expand All @@ -298,14 +301,13 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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)=
Expand All @@ -315,15 +317,15 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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
Expand Down Expand Up @@ -394,8 +396,8 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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,
Expand All @@ -407,6 +409,7 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,

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)
Expand All @@ -416,7 +419,6 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
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
Expand All @@ -429,18 +431,19 @@ subroutine int_mom_sifs(ibas, oskel, aoints, nbft,
* 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'
Expand Down
12 changes: 7 additions & 5 deletions src/nwc_columbus/aoints/int_so_sifs.F
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -318,18 +318,20 @@ subroutine int_so_sifs(ibas, oskel, aoints, nbft, max1e, mem1,
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'
Expand Down