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

Merge pull request #1076 from edoapra/bqbq

Browse source 
fixes for open issues
This commit is contained in:
Edoardo Aprà 2025-02-05 08:30:43 -08:00 • committed by GitHub
commit eedd26fefd
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
6 changed files with 39 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

32
src/bq/bq_data.F
View file

@ -85,6 +85,7 @@ c local variables
#include "bq_data.fh"
#include "errquit.fh"
#include "rtdb.fh"
#include "stdio.fh"
integer handle
logical bq_activate
c local variables
@ -96,12 +97,12 @@ c local variables
bq_activate = .true.
if(.not.bq_check_handle(handle)) then
bq_activate = .false.
write(*,*) "bq handle is out of bounds"
write(luout,*) "bq handle is out of bounds"
return
end if
if(bq_ncent(handle).eq.0) then
bq_activate = .false.
write(*,*) "bq ncent is zero"
write(luout,*) "bq ncent is zero"
return
end if
@ -619,6 +620,7 @@ c local variables
#include "rtdb.fh"
#include "util.fh"
#include "global.fh"
#include "stdio.fh"
integer handle
c local variables
@ -645,7 +647,7 @@ c local variables
end if
if(bq_ncent(handle).eq.0) then
write(*,*) "No charges are found"
write(luout,*) "No charges are found"
return
end if
@ -666,8 +668,8 @@ c local variables
> "Bq Structure Information (Angstroms)",
> 36, .true.)
write(*,*) "Name: ", bq_name(handle)
write(*,*) "Number of centers: ",bq_ncent(handle)
write(luout,*) "Name: ", bq_name(handle)
write(luout,*) "Number of centers: ",bq_ncent(handle)
c == tally up bq charges ==
bq_charge_total = 0.d0
@ -678,9 +680,9 @@ c > i,(dbl_mb(i_c+3*(i-1)+k-1),k=1,3),
> dbl_mb(i_q+i-1)
bq_charge_total = bq_charge_total + dbl_mb(i_q+i-1)
end do
write(*,*) "Total Bq charge: ",bq_charge_total
write(*,*)
write(*,*)
write(luout,*) "Total Bq charge: ",bq_charge_total
write(luout,*)
write(luout,*)
c
end if
9000 format(i5,2x,"Bq",4x,3f15.8,3x,"charge",3x,f15.8)
@ -912,6 +914,7 @@ c local variables
#include "rtdb.fh"
#include "util.fh"
#include "global.fh"
#include "stdio.fh"
integer handle
integer un
@ -938,7 +941,7 @@ c local variables
end if
if(bq_ncent(handle).eq.0) then
write(*,*) "No charges are found"
write(luout,*) "No charges are found"
return
end if
@ -962,8 +965,8 @@ c local variables
> dbl_mb(i_q+i-1)
end do
write(*,*)
write(*,*)
write(luout,*)
write(luout,*)
9000 format(i5,2x,"Bq",4x,4f15.8)
@ -978,6 +981,7 @@ c local variables
#include "rtdb.fh"
#include "util.fh"
#include "global.fh"
#include "stdio.fh"
integer handle
integer un
@ -1004,7 +1008,7 @@ c local variables
end if
if(bq_ncent(handle).eq.0) then
write(*,*) "No charges are found"
write(luout,*) "No charges are found"
return
end if
@ -1028,8 +1032,8 @@ c local variables
> dbl_mb(i_q+i-1)
end do
write(*,*)
write(*,*)
write(luout,*)
write(luout,*)
9000 format(i5,2x,"Bq",4x,4f15.8)

14
src/bq/bq_input.F
View file

@ -135,7 +135,7 @@ c ------------------
status = status .and. inp_f(y)
status = status .and. inp_f(z)
status = status .and. inp_f(q)
if (hprint) write(*,*) q,x,y,z
if (hprint) write(luout,*) q,x,y,z
if (.not. status)
& call errquit('bq_input: inp_read failed',0,0)
dbl_mb(i_qbq+ncenter) = q
@ -282,13 +282,13 @@ c scale and convert as needed
end if
c do i=1,n
c write(*,*) c(1,i),c(2,i),c(3,i),q(i)
c write(luout,*) c(1,i),c(2,i),c(3,i),q(i)
c end do
c write(*,*) "oscale ",oscale
c write(*,*) "scale ",charge_scale
c write(*,*) "afile ",afile
c write(*,*) "afile_coords ",afile_coords
c write(*,*) "afile_charges ",afile_charges
c write(luout,*) "oscale ",oscale
c write(luout,*) "scale ",charge_scale
c write(luout,*) "afile ",afile
c write(luout,*) "afile_coords ",afile_coords
c write(luout,*) "afile_charges ",afile_charges
return

7
src/bq/bq_main.F
View file

@ -18,6 +18,7 @@ C>
#include "bq.fh"
#include "errquit.fh"
#include "global.fh"
#include "stdio.fh"
integer rtdb !< [Input] The RTDB handle
logical bq_init
@ -29,12 +30,12 @@ c
pname = "bq_init"
c
c write(*,*) "in "//pname
c write(luout,*) "in "//pname
c
bq_init = .true.
if(.not. rtdb_cget(rtdb,"bq" , 1,namespace)) then
bq_init = .false.
write(*,*) "no namespace"
write(luout,*) "no namespace"
return
end if
@ -67,7 +68,7 @@ C>
character*30 pname
pname ="bq_end"
c write(*,*) "in "//pname
c write(luout,*) "in "//pname
bq_end = bq_destroy_all()
end

3
src/bq/bq_rtdb.F
View file

@ -168,6 +168,7 @@ C>
#include "mafdecls.fh"
#include "errquit.fh"
#include "rtdb.fh"
#include "stdio.fh"
integer irtdb !< [Input] The RTDB handle
integer handle !< [Input] The Bq instance handle
logical bq_rtdb_load
@ -205,7 +206,7 @@ c local variables
& call errquit('bq_ncenter failed',0,0)
if(ncent.ne.0) then
bq_rtdb_load = .false.
write(*,*) pname//"empty bq set first"
write(luout,*) pname//"empty bq set first"
return
end if
if(.not.bq_namespace(handle,namespace))

9
src/nwdft/rt_tddft/headers/rt_tddft.fh
View file

@ -47,14 +47,13 @@ C
C
C Hardcoded limits to the number of geometries, fields, and
C excitation rules. I think 100 is a sane choice (that is the
C default max number of geoms in nwchem). I chose hardcoded max
C excitation rules. I chose hardcoded max
C numbers since each of these are derived data types, and therefore
C there is no MA routine for allocating them.
C
integer, parameter :: rt_max_geoms = 100
integer, parameter :: rt_max_fields = 100
integer, parameter :: rt_max_excites = 100
integer, parameter :: rt_max_geoms = 200
integer, parameter :: rt_max_fields = 200
integer, parameter :: rt_max_excites = 200

4
src/nwdft/rt_tddft/init/rt_tddft_init_geoms.F
View file

@ -98,6 +98,10 @@ c$$$ $ call errquit (pname//"invalid ngeom_rtdb > nw_max_geoms",0,0)
if (ngeom_rtdb .gt. max_geom_rtdb)
$ call errquit(pname//"invalid ngeom_rtdb > max_geom_rtdb",0,0)
if (ngeom_rtdb .gt. rt_max_geoms)
$ call errquit(pname//"invalid ngeom_rtdb > rt_max_geoms",
G ngeom_rtdb, 0)
if (.not. rtdb_cget (params%rtdb,'geometry:names',
$ ngeom_rtdb,names_rtdb))