diff --git a/src/bq/bq_data.F b/src/bq/bq_data.F index 5443f56c1c..d156fbb97c 100644 --- a/src/bq/bq_data.F +++ b/src/bq/bq_data.F @@ -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) diff --git a/src/bq/bq_input.F b/src/bq/bq_input.F index 3e60e7152a..9b4649ae56 100644 --- a/src/bq/bq_input.F +++ b/src/bq/bq_input.F @@ -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 diff --git a/src/bq/bq_main.F b/src/bq/bq_main.F index a807939774..474f247a8c 100644 --- a/src/bq/bq_main.F +++ b/src/bq/bq_main.F @@ -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 diff --git a/src/bq/bq_rtdb.F b/src/bq/bq_rtdb.F index 6b5b0a8c2c..e5d088042b 100644 --- a/src/bq/bq_rtdb.F +++ b/src/bq/bq_rtdb.F @@ -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)) diff --git a/src/nwdft/rt_tddft/headers/rt_tddft.fh b/src/nwdft/rt_tddft/headers/rt_tddft.fh index 54206247b5..d1368928c1 100644 --- a/src/nwdft/rt_tddft/headers/rt_tddft.fh +++ b/src/nwdft/rt_tddft/headers/rt_tddft.fh @@ -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 diff --git a/src/nwdft/rt_tddft/init/rt_tddft_init_geoms.F b/src/nwdft/rt_tddft/init/rt_tddft_init_geoms.F index 9e1c0da581..e371936c3b 100644 --- a/src/nwdft/rt_tddft/init/rt_tddft_init_geoms.F +++ b/src/nwdft/rt_tddft/init/rt_tddft_init_geoms.F @@ -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))