diff --git a/src/nwc_columbus/aoints/int_1e_sifs.F b/src/nwc_columbus/aoints/int_1e_sifs.F index ef3db35ede..daf2d94fde 100644 --- a/src/nwc_columbus/aoints/int_1e_sifs.F +++ b/src/nwc_columbus/aoints/int_1e_sifs.F @@ -382,24 +382,27 @@ 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)) @@ -407,10 +410,12 @@ subroutine int_1e_sifs(ibas, aoints, energy, nenrgy, nbft, 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 @@ 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, diff --git a/src/nwc_columbus/aoints/int_mom_sifs.F b/src/nwc_columbus/aoints/int_mom_sifs.F index 3bc9536d52..3cc13ba605 100644 --- a/src/nwc_columbus/aoints/int_mom_sifs.F +++ b/src/nwc_columbus/aoints/int_mom_sifs.F @@ -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 @@ -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 @@ -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 @@ -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)= @@ -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 @@ -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, @@ -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) @@ -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 @@ -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' diff --git a/src/nwc_columbus/aoints/int_so_sifs.F b/src/nwc_columbus/aoints/int_so_sifs.F index 750129ef51..bb40291911 100644 --- a/src/nwc_columbus/aoints/int_so_sifs.F +++ b/src/nwc_columbus/aoints/int_so_sifs.F @@ -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'