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

declaring ddot in util.fh causes problems with cublas module

Browse source 
Signed-off-by: Jeff Hammond <jehammond@nvidia.com>
This commit is contained in:
Jeff Hammond 2021-05-03 17:42:44 -07:00
parent 003c09537e
commit 3f787eb25d
41 changed files with 149 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/ddscf/fast/potential.F
View file

@ -20,6 +20,8 @@ c
integer l_buf, l_scr
integer k_buf, k_scr
double precision pot, r(3)
double precision ddot
external ddot
c
r(1) = x
r(2) = y

3
src/ddscf/riscf_trans.F
View file

@ -41,6 +41,9 @@ C$Id$
integer nxtask
external nxtask
double precision ddot
external ddot
nproc = ga_nnodes()
if ( odisk ) then

13
src/driver/opt_drv.F
View file

@ -1424,6 +1424,8 @@ c
integer istrss
double precision strss1,strss2,dum1,dum2,dum3,dum4
logical redo_hessian
double precision ddot
external ddot
! This is a statement function
ind(i,j) = k_hess + i + (j-1)*nvar - 1
@ -1651,6 +1653,8 @@ c
logical ophigh
logical geom_lattice_get
external geom_lattice_get
double precision ddot
external ddot
c
ophigh = util_print('high', print_high)
c
@ -2001,6 +2005,8 @@ c
double precision e0, e1, e2p, dsgrad
double precision hess, a0, a1, a2
double precision driver_energy_step
double precision ddot
external ddot
c
dsgrad = ddot(nvar, ds, 1, g, 1)
if (dsgrad*alpha .ge. 0d0) then
@ -2154,6 +2160,8 @@ c
integer i, j
double precision walka(5), walke(5),dum
logical success
double precision ddot
external ddot
c
dsgrad = ddot(nvar, ds, 1, g, 1)
if (dsgrad*alpha .ge. 0d0) then
@ -2763,6 +2771,8 @@ c
logical omm
logical task_qmmm
logical opt_geom_cart_coords_get
double precision ddot
external ddot
ind(i,j) = k_pmat + i-1 + (j-1)*ncart
c
c FRACTIONAL?
@ -3118,6 +3128,9 @@ c
c
logical geom_print_zmatrix, omatchneg
save saddir, evalp
double precision ddot
external ddot
c
omatchneg = .true.
ovtol = 0.7d0

6
src/geom/geom.F
View file

@ -555,6 +555,8 @@ c
logical geom_check_handle, geom_rtdb_in, geom_get_user_scale
external geom_check_handle, geom_rtdb_in, geom_get_user_scale
logical getsym
double precision ddot
external ddot
c
geom_rtdb_load = geom_check_handle(geom, 'geom_rtdb_load')
if (.not. geom_rtdb_load) return
@ -948,6 +950,8 @@ c
logical geom_tag_to_element
external geom_tag_to_element
logical is_atom
double precision ddot
external ddot
is_atom(i) = (.not. inp_compare(.false., 'bq', tags(i,geom)(1:2)))
c
e = 0.0d0
@ -2697,6 +2701,8 @@ c external functions
$ geom_print_zmatrix, geom_any_finuc
double precision deter3
external deter3
double precision ddot
external ddot
c
if (.not. geom_check_handle(geom, 'geom_print')) then
geom_print = .false.

6
src/geom/geom_hnd.F
View file

@ -4522,6 +4522,8 @@ C
integer IA(1)
integer ij,j,ik,max,i,k
double precision small,zero,dum,qij,hij
double precision ddot
external ddot
DATA SMALL /1.0D-11/
DATA ZERO /0.0D+00/
IJ = 0
@ -5387,7 +5389,9 @@ c Return the angle in degrees that c makes with the plane
c containing a and b. The sign is determined in a left-handed
c sense ... so that if a=x, b=y then for c=+z angle=+90.
c
double precision ddot, d(3), abc, theta
double precision d(3), abc, theta
double precision ddot
external ddot
c
call cross_product(a,b,d)
abc = ddot(3,c,1,d,1)/sqrt(

2
src/hessian/analytic/dft/xc_d2expl.F
View file

@ -186,6 +186,8 @@ c
double precision duefac
double precision dabsmax
external dabsmax
double precision ddot
external ddot
c
c d2Exc / d2fxc dp(i) dp(j) / dfxc d2p(i)
c ----- = sum sum | ----------- ----- ----- + sum | ----- ------

8
src/mcscf/detci/detci_dens.F
View file

@ -33,13 +33,15 @@ c
integer g_dtmp
integer ii, jj, iex, ph
double precision xx
double precision ddot
external ddot
c
c
c
myid = ga_nodeid()
*ga:1:0
if (.not.(ga_create(MT_DBL, norb, norb, 'd', norb, 0, g_dtmp )))
$ call errquit('detci_twopdm: cannot create global',0, GA_ERR)
$ call errquit('detci_onepdm: cannot create global',0, GA_ERR)
call ga_zero(g_dtmp)
call ga_distribution( g_civec, myid, rlo, rhi, cilo, cihi )
if (((cilo.ne.0).and.(cihi.ne.-1)).and.
@ -162,6 +164,8 @@ c
integer l_t, k_t, l_s, k_s, lds
** integer g_dentmp
integer myid, nn, rlo, rhi, cilo, cihi, dilo, dihi
double precision ddot
external ddot
c
c
myid = ga_nodeid()
@ -425,6 +429,8 @@ c
double precision tx
integer nxtask
external nxtask
double precision ddot
external ddot
c
c
c Initialize parallel stuff

4
src/mp2_grad/mp2_back_transform.F
View file

@ -808,6 +808,8 @@ c
$ ylo_cur, yhi_cur, udim_cur, vdim_cur, xdim_cur, ydim_cur
logical status, odebug, odoit, sym_shell_quartet, oenergy
external sym_shell_quartet
double precision ddot
external ddot
c
odebug = util_print('mp2_backt', print_debug)
oenergy = util_print('backtenergy', print_debug)
@ -1122,6 +1124,8 @@ c
integer t_ilo, t_ihi, t_jlo, t_jhi
integer nsegs,iseg_in
double precision tr,tr_tr
double precision ddot
external ddot
c
call ga_distribution(g_a_trans, ga_nodeid(),
T t_ilo, t_ihi, t_jlo, t_jhi)

2
src/mp2_grad/mp2_make_tuhf.F
View file

@ -51,6 +51,8 @@ c
logical otdebug
c
integer l_ia_uv, k_ia_uv, l_tmp, k_tmp, l_ia_jb, k_ia_jb
double precision ddot
external ddot
c
#include "bitops.fh"
c

2
src/mp2_grad/mp2_read_tiajb.F
View file

@ -12,6 +12,8 @@
integer tunit
double precision tunitptr
double precision t(*)
double precision ddot
external ddot
c
c Read t(j,b,i,a) all j, b for given i, a taking into
c account symmetry blocking

4
src/nwdft/coulomb/dft_fitcd.F
View file

@ -59,6 +59,8 @@ c
integer LU,ierr,ilo,ihi,jlo,jhi,nnii
integer adrc,ldc,iptr,intdum
character*255 errmsg
double precision ddot
external ddot
c
c Fit electronic charge density. The fitting coefficients are obtained by
@ -383,6 +385,8 @@ c write(*,*)' CD_coef = ',(CD_coef(i,ifit),i=1,nbf_cd)
double precision cd_coef(nbf_cd), cgtf(nbf_cd)
character*1 shell_labels(nshells), ang_mom_label(11)
logical oprint_mull_fit
double precision ddot
external ddot
c
#include "bas.fh"
#include "mafdecls.fh"

2
src/nwdft/coulomb/dft_fitvc.F
View file

@ -57,6 +57,8 @@ c
integer k_at,l_at,atom_c_in,atom_d_in
logical v_nonzero
external nxtask
double precision ddot
external ddot
c
if(dermat) call errquit(
C 'fitvc: dermat not coded yet',0,0)

2
src/nwdft/dftgrad/dftg_cdfit.F
View file

@ -120,6 +120,8 @@ c
c
double precision dabsmax
external nxtask,schwarz_shell,dabsmax
double precision ddot
external ddot
nproc = ga_nnodes()
me = ga_nodeid()
c

3
src/nwdft/dftgrad/dftg_gridv0b.F
View file

@ -158,6 +158,9 @@ c Daniel (2-7-13): Logical variable storing if we're calculating the
c dVxc*P contribution.
logical do_tddftvxc
logical ldew2 ! Prevent weighting of derivative matrices
double precision ddot
external ddot
c
c Evaluate the AO basis set at each of the quad. points.
c allocate arrays for exponents and contraction coefficients

3
src/nwdft/grid/grid_quadv0b.F
View file

@ -101,6 +101,9 @@ c
double precision StericEnergy_qm, StericEnergy_fde
double precision StericEnergy_tot
double precision ddot
external ddot
pname = 'grid_quadv0b: '
mbf_fde = 0
! npol = 0

2
src/nwdft/so_dft/dft_scf_utils_so.F
View file

@ -85,6 +85,8 @@ c
integer info
c
integer i,j,i1
double precision ddot
external ddot
c
c Prepare arrays for diagonalization
c

2
src/nwdft/so_dft/sym_mo_adapt_so.F
View file

@ -62,6 +62,8 @@ c
integer l_u,k_u
logical sym_char_table_so
external sym_char_table_so
double precision ddot
external ddot
c
logical odebug ! True if debugging
logical owarn ! True if to print warning messages

2
src/nwdft/xc/xc_eval_fnl.F
View file

@ -98,6 +98,8 @@ c
double precision eps,dumd
integer nx,nc,dumi
parameter (eps=1.e-8)
double precision ddot
external ddot
c
c Initialize the XC potential and energy sampling matrices.
c

2
src/nwdft/xc/xc_tabcd.F
View file

@ -209,6 +209,8 @@ c
data nbhandl2 /0./
save nbhandl1
save nbhandl2
double precision ddot
external ddot
c
c 0: l3d=.f. & n3d=1
ccc rhs: l3d=.true. & n3d=3

2
src/nwpw/band/minimizer/c_bybminimize.F
View file

@ -86,6 +86,8 @@ c
external cpsi_1_noupdate_energy,cpsi_eigenvalue,ion_disp_energy
logical ion_disp_on
external ion_disp_on
double precision ddot
external ddot
Ein = E(1)

2
src/nwpw/band/minimizer/c_bybminimize2.F
View file

@ -106,6 +106,8 @@ c
external control_ks_algorithm
integer control_ks_maxit_orb,control_ks_maxit_orbs
external control_ks_maxit_orb,control_ks_maxit_orbs
double precision ddot
external ddot
Ein = E(1)
call Parallel_taskid(taskid)

2
src/nwpw/nwpwlib/ion/ion.F
View file

@ -4797,6 +4797,8 @@ c
double precision test_norm
integer i, j, k, l, m, n, mu, nu, indx, iatom, iaxis, itemp
integer nhess, nhesst,IMAX
double precision ddot
external ddot
C****
nhess = nat3*nat3
nhesst = nat3*(nat3+1)/2 ! dimension of lower triangular hessian

14
src/optim/mepgs/mepgs_drv.F
View file

@ -430,6 +430,8 @@ c
logical gsopt_geom_cart_coords_get
logical gsopt_geom_cart_coords_set
logical ophigh
double precision ddot
external ddot
c
ophigh = util_print('high', print_high)
CCCCCCCCCCCCCCCCCCCCCC
@ -511,6 +513,8 @@ c
double precision avec(nvar), bvec(nvar)
c
double precision ctheta, factor(2)
double precision ddot
external ddot
c
mepgs_cosang = 0.0
c
@ -555,6 +559,8 @@ c
double precision dsds, dshds, dsdg
integer l_hess, k_hess, i, j
integer ind
double precision ddot
external ddot
ind(i,j) = k_hess + i + (j-1)*nvar - 1
c
if (.not. ma_push_get(mt_dbl, nvar**2, 'hess',
@ -2188,6 +2194,8 @@ c
double precision dsds, dshds, dsdg
integer l_hess, k_hess, i, j
integer ind
double precision ddot
external ddot
ind(i,j) = k_hess + i + (j-1)*nvar - 1
c
if (alpha .eq. 0d0) call errquit
@ -2462,6 +2470,8 @@ c
integer ind
logical task_qmmm
logical gsopt_geom_cart_coords_get
double precision ddot
external ddot
ind(i,j) = k_pmat + i-1 + (j-1)*ncart
c
c FRACTIONAL?
@ -2656,6 +2666,8 @@ c
double precision desphere(max_nvar)
double precision zeta(max_nvar)
double precision norm
double precision ddot
external ddot
c
c Compute stuff used for printing and convergence tests
c
@ -3058,6 +3070,8 @@ c
double precision trustds ! restriction of step in opt. variable
logical ophigh
logical gsopt_geom_cart_coords_get
double precision ddot
external ddot
c
c get the hessian and gradient with appropriate projectors
c applied following peng, ayala, schlegel and frisch so that

2
src/optim/neb/neb_drv.F
View file

@ -52,6 +52,8 @@ c
external energy_bead_list
character*7 bead_index_name
external bead_index_name
double precision ddot
external ddot
oprint = ga_nodeid() .eq. 0

3
src/optim/string/string.F
View file

@ -467,6 +467,9 @@ C> @}
character*7 bead_index_name
external bead_index_name
double precision ddot
external ddot
! Setup the problem
! "Secret" options with defaults that generally do not need changed
if (.not. rtdb_get(rtdb, 'string:linopt', mt_log,1,linopt))

8
src/optim/tropt/tropt_drv.F
View file

@ -1392,6 +1392,8 @@ c
double precision dsds, dshds, dsdg
integer l_hess, k_hess, i, j
integer ind
double precision ddot
external ddot
ind(i,j) = k_hess + i + (j-1)*nvar - 1
c
if (alpha .eq. 0d0) call errquit
@ -1781,6 +1783,8 @@ c
integer ind
logical task_qmmm
logical tropt_geom_cart_coords_get
double precision ddot
external ddot
ind(i,j) = k_pmat + i-1 + (j-1)*ncart
c
c FRACTIONAL?
@ -2515,6 +2519,8 @@ c
double precision trustds ! restriction of step in opt. variable
logical geom_print_zmatrix
logical ophigh
double precision ddot
external ddot
c
c get the hessian and gradient with appropriate projectors
c applied following peng, ayala, schlegel and frisch so that
@ -2929,6 +2935,8 @@ cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
integer l_hess, k_hess
double precision epredict
double precision gamma(nvar)
double precision ddot
external ddot
!
! *** calculate predicted energy change ***
!

3
src/symmetry/sym_bs_ir_id.F
View file

@ -47,6 +47,9 @@ c
integer ncent_unique
integer centlist(100), jc
c
double precision ddot
external ddot
c
c Get basis and geom info
c

3
src/symmetry/sym_bs_irrep.F
View file

@ -40,6 +40,9 @@ c
c
double precision sym_trace_bas_op
external sym_trace_bas_op
c
double precision ddot
external ddot
c
c Get basis and geom info
c

2
src/symmetry/sym_mo_adapt.F
View file

@ -57,6 +57,8 @@ c
double precision v(maxireps), vnorm
integer idamax
external idamax
double precision ddot
external ddot
c
logical odebug ! True if debugging
logical owarn ! True if to print warning messages

6
src/tce/ddotfile.F
View file

@ -29,6 +29,8 @@ cc integer nxtask
EXTERNAL NXTASK
cc external nxtask
logical noloadbalance
double precision ddot
external ddot
c
c new
c
@ -143,6 +145,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical noloadbalance
double precision ddot
external ddot
c
c new
c
@ -267,6 +271,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical noloadbalance
double precision ddot
external ddot
c
c new
c

2
src/tce/tce_diagnose_t1.F
View file

@ -21,6 +21,8 @@
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c =====================
c Zero scratch residual

2
src/tce/tce_mbpt2.F
View file

@ -35,6 +35,8 @@ cc external nxtask
double precision cpu
double precision wall
logical nodezero
double precision ddot
external ddot
c
nodezero=(ga_nodeid().eq.0)
cpu=-util_cpusec()

4
src/tce/tce_residual_t1.F
View file

@ -27,6 +27,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c new
c
@ -130,6 +132,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c new
c

6
src/tce/tce_residual_t2.F
View file

@ -30,6 +30,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c new
c
@ -139,6 +141,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c new
c
@ -252,6 +256,8 @@ cc external nxtask
INTEGER NXTASK
EXTERNAL NXTASK
logical nodezero
double precision ddot
external ddot
c
c =====================
c Zero scratch residual

4
src/tce/tce_residual_t3.F
View file

@ -30,6 +30,8 @@ c
integer nxtask
external nxtask
logical nodezero
double precision ddot
external ddot
c
c new
c
@ -173,6 +175,8 @@ c
integer nxtask
external nxtask
logical nodezero
double precision ddot
external ddot
c
c new
c

2
src/tce/tce_residual_t3a.F
View file

@ -31,6 +31,8 @@ c
external nxtask
logical nodezero
logical acolo
double precision ddot
external ddot
c
c new
c

4
src/tce/tce_residual_t4.F
View file

@ -32,6 +32,8 @@ c
integer nxtask
external nxtask
logical nodezero
double precision ddot
external ddot
c
c new
c
@ -208,6 +210,8 @@ c
integer nxtask
external nxtask
logical nodezero
double precision ddot
external ddot
c
c new
c

2
src/util/util.fh
View file

@ -2,7 +2,6 @@
c
C$Id$
logical util_print
double precision ddot
double precision util_cpusec
double precision util_wallsec
double precision util_random
@ -12,7 +11,6 @@ C$Id$
logical util_nwchemrc_get
logical util_module_avail
external util_print
external ddot
external util_cpusec
external util_wallsec
external util_random

4
src/vib/vib_eckart.F
View file

@ -22,6 +22,8 @@ c
DOUBLE PRECISION UNIVEC(3), TEST(6,6), VNORM, temp, dotval, rnorm
double precision test_norm
integer i, j, k, l, m, n, mu, nu, indx, iatom, iaxis, itemp
double precision ddot
external ddot
C****
C**** construct translation unit vectors; these are stored in the
C**** first three columns of array VC, the rotation vectors will
@ -200,6 +202,8 @@ c
DOUBLE PRECISION UNIVEC(3), TEST(3,3), VNORM, temp, dotval, rnorm
double precision test_norm
integer i, j, k, l, m, n, mu, nu, indx, iatom, iaxis, itemp
double precision ddot
external ddot
C****
C**** construct translation unit vectors; these are stored in the
C**** first three columns of array VC, the rotation vectors will

4
src/vib/vib_nmass.F
View file

@ -39,6 +39,8 @@ C
c
double precision vnorm
integer col
double precision ddot
external ddot
do col = 1,nvec
vnorm = ddot(nvec,vectors(1,col),1,vectors(1,col),1)
vnorm = sqrt(1.0d00/vnorm)
@ -60,6 +62,8 @@ c
c
double precision vnorm
integer col
double precision ddot
external ddot
do col = 1,nvec
vnorm = ddot(nvec,coord,1,vectors(1,col),1)
if (vnorm.lt.0.0d0) then

2
src/vib/vib_tors.F
View file

@ -32,6 +32,8 @@ c
double precision dotpj, dotpk, sinpj, sinpk
double precision smi, smj, sml, sense, f1, f2, dot
integer m, nocol1, nocol2, nocol3, nocol4
double precision ddot
external ddot
C
C
C