comp-chem/NWChem
1
0
Fork 0
mirror of https://github.com/nwchemgit/nwchem.git synced 2026-07-27 13:45:27 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Remove bse_dipole.F

Browse source
This commit is contained in:
Daniel Mejia-Rodriguez 2025-10-17 00:18:25 -07:00 • committed by edoapra
parent fadf7fe808
commit ffc53b74ae
No known key found for this signature in database
GPG key ID: 9E6A0B70826967BA
4 changed files with 1 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/bsemol/GNUmakefile
View file

@ -2,7 +2,7 @@ OBJ = bsemol.o bse_input.o bse_init.o bse_analytic.o \
bse_davidson.o bse_lanczos.o bse_defaults.o \
bse_finalize.o bse_ri_init.o bse_wmn.o \
bse_analytic_cis.o bse_analytic_tda.o \
bse_dipole.o bse_oscstr.o bse_puteris.o bse_get_eia.o \
bse_oscstr.o bse_puteris.o bse_get_eia.o \
bse_davidson_diagonal.o \
bse_davidson_kvec.o bse_davidson_guess.o \
bse_davidson_kortho.o bse_davidson_restart.o \

76
src/bsemol/bse_dipole.F
View file

@ -1,76 +0,0 @@
subroutine bse_dipole(pars)
implicit none
#include "global.fh"
#include "mafdecls.fh"
#include "errquit.fh"
#include "bse.fh"
#include "cdft.fh"
type(bse_params_t) :: pars
character(*),parameter :: pname = 'bse_dipole: '
integer ixyz,isp,ilo,ihi,jlo,jhi,amo,imo
integer g_dip(3),handle(3),g_tmp1,g_tmp2
integer k,klocal,kproc,kglobal,tovern,modtn,ktmp,ld
integer ga_create_atom_blocked
external ga_create_atom_blocked
! Create dipole matrices
do ixyz=1,3
g_dip(ixyz) = ga_create_atom_blocked(geom,ao_bas_han,'Dipoles')
if(.not.nga_create(mt_dbl,1,pars%npoles(1),'dip a',0,
& pars%g_dipa(ixyz)))
& call errquit(pname//'could not create g_dipa',0,GA_ERR)
if (pars%ipol.gt.1) then
if(.not.nga_create(mt_dbl,1,pars%npoles(2),'dip b',0,
& pars%g_dipb(ixyz)))
& call errquit(pname//'could not create g_dipb',0,GA_ERR)
endif
enddo
! Compute dipole AO integrals for the 3 components
call int_dip_ga(ao_bas_han, ao_bas_han, g_dip(1), g_dip(2),
& g_dip(3))
! Transform dipole matrices
do isp=1,pars%ipol
if (.not.ga_create(mt_dbl,nbf_ao,pars%nocc(isp),'tmp1',
& 0,pars%nocc(isp),g_tmp1))
& call errquit(pname//'could not create g_tmp1',0,GA_ERR)
if (.not.ga_create(mt_dbl,pars%nvir(isp),pars%nocc(isp),'tmp2',
& pars%nvir(isp),0,g_tmp2))
& call errquit(pname//'could not create g_tmp2',0,GA_ERR)
if (isp.eq.1) then
handle(:) = pars%g_dipa(:)
else
handle(:) = pars%g_dipb(:)
endif
tovern = pars%npoles(isp)/pars%nprocs
modtn = mod(pars%npoles(isp),pars%nprocs)
call ga_distribution(g_tmp2,pars%me,ilo,ihi,jlo,jhi)
do ixyz=1,3
call ga_matmul_patch('n','n',1d0,0d0,
& g_dip(ixyz),1,nbf_ao,1,nbf_ao,
& pars%g_movecs(isp),1,nbf_ao,1,pars%nocc(isp),
& g_tmp1,1,nbf_ao,1,pars%nocc(isp))
call ga_matmul_patch('t','n',1d0,0d0,
& pars%g_movecs(isp),pars%nocc(isp)+1,
& pars%nmo,1,nbf_ao,
& g_tmp1,1,nbf_ao,1,pars%nocc(isp),
& g_tmp2,1,pars%nvir(isp),1,pars%nocc(isp))
call nga_copy_patch('n',g_tmp2,(/1,1/),
& (/pars%nvir(isp),pars%nocc(isp)/),handle(ixyz),1,
& pars%npoles(isp))
enddo
if ((.not.ga_destroy(g_tmp1)).and.(.not.ga_destroy(g_tmp2)))
& call errquit(pname//'could not destroy GAs',0,GA_ERR)
enddo
do ixyz=1,3
if (.not.ga_destroy(g_dip(ixyz)))
& call errquit(pname//'could not destroy GAs',0,GA_ERR)
enddo
end

11
src/bsemol/bse_finalize.F
View file

@ -19,17 +19,6 @@
$ call errquit(pname//'failed to destroy g_movecs',0,GA_ERR)
enddo
do i=1,3
if(.not.ga_destroy(pars%g_dipa(i)))
$ call errquit(pname//'failed to destroy g_dipa',0,GA_ERR)
enddo
if (ipol.gt.1) then
do i=1,3
if(.not.ga_destroy(pars%g_dipb(i)))
$ call errquit(pname//'failed to destroy g_dipa',0,GA_ERR)
enddo
endif
ok = ma_chop_stack(pars%l_mf_evals)
if (.not.ok)
& call errquit(pname//'could not chop stack',0,MA_ERR)

3
src/bsemol/bse_init.F
View file

@ -311,9 +311,6 @@ c
$ ('bse_init: failed to destroy g_work',0, GA_ERR)
enddo
! Get dipole in CIS basis
call bse_dipole(pars)
!Clean previous grid
call grid_cleanup(.false.)