mirror of
https://github.com/nwchemgit/nwchem.git
synced 2026-07-28 06:05:44 -04:00
RJH: A CVS ID for every file and automated generation of a version output
This commit is contained in:
Robert Harrison
parent
1eb1dd5dc7
commit
e39fa2f238
304 changed files with 558 additions and 238 deletions
|
|
@ -1,10 +1,13 @@
|
|||
|
||||
# $Id: GNUmakefile,v 1.19 1994-11-30 18:57:58 vg422 Exp $
|
||||
# $Id: GNUmakefile,v 1.20 1995-02-02 23:08:17 d3g681 Exp $
|
||||
|
||||
include config/makefile.h
|
||||
|
||||
SUBDIRS = $(NWSUBDIRS)
|
||||
|
||||
LIB_DEFINES = -DCOMPILATION_DATE="'`date`'" \
|
||||
-DCOMPILATION_DIR="'$(NWCHEM_TOP)'"
|
||||
|
||||
#
|
||||
# This should be the first target so that a simple make builds
|
||||
# the entire world
|
||||
|
|
@ -23,12 +26,14 @@ $(BINDIR)/nwchem nwchem: directories libraries
|
|||
|
||||
link nwchem_link: nwchem.o stubs.o
|
||||
$(LINK.f) -o $(BINDIR)/nwchem nwchem.o stubs.o $(LIBS)
|
||||
/bin/rm -f nwchem.o
|
||||
$(INSTALL)
|
||||
#
|
||||
# This for linking test version
|
||||
#
|
||||
nwchem_test:
|
||||
nwchem_test: nwchem.o stubs.o
|
||||
$(LINK.f) -o $@ nwchem.o stubs.o $(LIBS)
|
||||
/bin/rm -f nwchem.o
|
||||
$(INSTALL)
|
||||
|
||||
# This dependency so that includes which are made by libraries rule
|
||||
|
|
@ -66,7 +71,7 @@ sngl_to_dbl dbl_to_sngl:
|
|||
directories:
|
||||
test -d $(LIBDIR) || $(MKDIR) $(LIBDIR)
|
||||
test -d $(BINDIR) || $(MKDIR) $(BINDIR)
|
||||
|
||||
|
||||
# This target will change config/nwchem_config.h include file which
|
||||
# controls what we're going to build.
|
||||
nwchem_config:
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
c
|
||||
c routine to calculate the 3 center overlap integrals
|
||||
c
|
||||
C$Id: int_1e3ov.F,v 1.5 1995-02-02 23:08:35 d3g681 Exp $
|
||||
implicit none
|
||||
#include "basP.fh"
|
||||
#include "basdeclsP.fh"
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
c
|
||||
c routine to calculate labels for 3 center overlap integrals
|
||||
c
|
||||
C$Id: int_l1e3ov.F,v 1.4 1995-02-02 23:08:36 d3g681 Exp $
|
||||
implicit none
|
||||
#include "basP.fh"
|
||||
#include "geobasmapP.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
program showxyz
|
||||
C$Id: showxyz.F,v 1.3 1995-02-02 23:08:42 d3g681 Exp $
|
||||
implicit none
|
||||
integer Lvalm,Lval
|
||||
integer nxyz(3)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
subroutine atomd(oprin,iwr,znps,ic,isymax,hatom,
|
||||
+ pcap,qcap,fc,fo,s,u,t,h,dc,dos,dt,dold,ss,
|
||||
+ c, copn, smin, qmin, transf, cc , nbb, element, tag)
|
||||
C$Id: atomd.F,v 1.6 1995-02-02 23:08:47 d3g681 Exp $
|
||||
implicit none
|
||||
#include "inp.fh"
|
||||
c
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ c
|
|||
c common used by guess routines for storing info and passing arguments
|
||||
c
|
||||
integer nb ! Maximum no. of primitives on any atom
|
||||
C$Id: cguess.fh,v 1.4 1995-02-02 23:08:48 d3g681 Exp $
|
||||
integer no ! Maximum no. of orbitals on any atom ??
|
||||
integer maxatsym ! Maximum no. of syms (s/p/d/f)
|
||||
parameter (nb=200, no=50, maxatsym=4)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine cmergd(c1,c2,nc,nb,no)
|
||||
C$Id: cmergd.F,v 1.2 1995-02-02 23:08:49 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c merge open and closed shell coefficient matrices.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine creded(g_dens, dt, iiloc, nbb)
|
||||
C$Id: creded.F,v 1.5 1995-02-02 23:08:51 d3g681 Exp $
|
||||
implicit none
|
||||
#include "global.fh"
|
||||
#include "cguess.fh"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
subroutine datoms(geom, basis, hatom, g_dens, oprin,
|
||||
+ pcap, qcap, fc, fo, s, u, t, h, dc, dos, dt, dold, ss,
|
||||
+ cvec, copn, smin, qmin, transf, cc, nbb, oprint_ener)
|
||||
C$Id: datoms.F,v 1.11 1995-02-02 23:08:52 d3g681 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "global.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine guess_dens(geom, basis, g_dens)
|
||||
C$Id: denat.F,v 1.7 1995-02-02 23:08:54 d3g681 Exp $
|
||||
implicit none
|
||||
#include "geom.fh"
|
||||
#include "bas.fh"
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
|
||||
|
||||
subroutine denmad(d,c,ns,nb,occ,nrow)
|
||||
C$Id: denmad.F,v 1.2 1995-02-02 23:08:55 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c make actual density matrices.
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@ c.......................................................................
|
|||
c
|
||||
c driver routine for density matrix processing
|
||||
c.......................................................................
|
||||
C$Id: densid.F,v 1.2 1995-02-02 23:08:56 d3g681 Exp $
|
||||
implicit none
|
||||
c
|
||||
real *8 dt(*), dold(*), dos(*), c(*)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine guess_mem(memscr)
|
||||
C$Id: guess_mem.F,v 1.3 1995-02-02 23:08:58 d3g681 Exp $
|
||||
implicit none
|
||||
#include "cguess.fh"
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
subroutine hamild(pcap, qcap, fc, fo, s, u, t, h, dos, dt,
|
||||
+ c, smin, qmin, nbb)
|
||||
C$Id: hamild.F,v 1.2 1995-02-02 23:08:59 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine jacod(f,v,nb,nb1,nb2,nmin,nmax,big,jbig,maxao)
|
||||
C$Id: jacod.F,v 1.2 1995-02-02 23:09:00 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c f is the matrix to be diagonalized. f is stored triangular
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine oeigd(fc, s, u, t, h)
|
||||
C$Id: oeigd.F,v 1.2 1995-02-02 23:09:03 d3g681 Exp $
|
||||
implicit none
|
||||
real *8 fc(*), s(*), u(*), t(*), h(*)
|
||||
c.......................................................................
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine orderd(amat,nrow,ncol,imemb,nblock,ind,vec,iflag)
|
||||
C$Id: orderd.F,v 1.2 1995-02-02 23:09:04 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c this routine sorts a set of column vectors in amat(*,*) according
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
function osatod(iat,ic,iiloc,iisch,nbb)
|
||||
C$Id: osatod.F,v 1.2 1995-02-02 23:09:05 d3g681 Exp $
|
||||
implicit none
|
||||
#include "geom.fh"
|
||||
#include "bas.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine outpud(copn,cc,ntest,iwr)
|
||||
C$Id: outpud.F,v 1.2 1995-02-02 23:09:06 d3g681 Exp $
|
||||
implicit none
|
||||
c
|
||||
real *8 copn(*), cc(*)
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
|
||||
subroutine pdfded(k,kdim,g_dens,dhelp,factor,dmult,lm,nbci,iiloc)
|
||||
C$Id: pdfded.F,v 1.2 1995-02-02 23:09:08 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@
|
|||
c
|
||||
* write(6,*)
|
||||
* write(6,*) ' zn=', zn, 'nbct=', nbct, ' nsym=', nsym, ' nsht=', nsht
|
||||
C$Id: printbasis.F,v 1.3 1995-02-02 23:09:09 d3g681 Exp $
|
||||
lobas = 1
|
||||
do isym = 1, nsym
|
||||
write(6,*) ' isym ', isym
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine shalfd(s,v,n)
|
||||
C$Id: shalfd.F,v 1.2 1995-02-02 23:09:10 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine square(r,a,mrowr,n)
|
||||
C$Id: square.F,v 1.2 1995-02-02 23:09:11 d3g681 Exp $
|
||||
implicit none
|
||||
integer mrowr, n
|
||||
real *8 r(*),a(*)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine starcd(c,ss,nbci,ncshi,noshi)
|
||||
C$Id: starcd.F,v 1.2 1995-02-02 23:09:13 d3g681 Exp $
|
||||
implicit none
|
||||
integer nbci, ncshi, noshi
|
||||
real *8 ss(*), c(nbci,nbci)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine teigd(pcap,qcap,u,t,dt,dos)
|
||||
C$Id: teigd.F,v 1.2 1995-02-02 23:09:14 d3g681 Exp $
|
||||
implicit none
|
||||
logical klnemn
|
||||
real *8 pcap(*),qcap(*),u(*),t(*),dos(*),dt(*)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
subroutine tracd(c, cc, nsqt, nsym, nbas, ncsh, nosh, nbc,
|
||||
+ nstrt, cont)
|
||||
C$Id: tracd.F,v 1.2 1995-02-02 23:09:16 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine trafsd(nsym,nbas,ndim,a,nbc,cont,nstrt,ffc)
|
||||
C$Id: trafsd.F,v 1.2 1995-02-02 23:09:17 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c transform matrix a
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine tramad(a,b,c,mdima,mdim,scr)
|
||||
C$Id: tramad.F,v 1.2 1995-02-02 23:09:18 d3g681 Exp $
|
||||
implicit none
|
||||
c.......................................................................
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine writel(p,newbas,oprint)
|
||||
C$Id: writel.F,v 1.2 1995-02-02 23:09:19 d3g681 Exp $
|
||||
implicit none
|
||||
c
|
||||
logical oprint
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
#$Id: GNUmakefile,v 1.11 1995-02-02 23:09:31 d3g681 Exp $
|
||||
include ../config/makefile.h
|
||||
|
||||
LIBRARY = libutil.a
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine bas_dummmmmm()
|
||||
C$Id: newbasis.F,v 1.2 1995-02-02 23:09:33 d3g681 Exp $
|
||||
implicit none
|
||||
integer i
|
||||
i = 0.0
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
#$Id: GNUmakefile,v 1.11 1995-02-02 23:09:36 d3g681 Exp $
|
||||
|
||||
include ../config/makefile.h
|
||||
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c takes the sum of the absolute values.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: dasum.f,v 1.2 1995-02-02 23:09:38 d3g681 Exp $
|
||||
double precision dx(1),dtemp
|
||||
integer i,incx,m,mp1,n,nincx
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c constant times a vector plus a vector.
|
|||
c uses unrolled loops for increments equal to one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: daxpy.f,v 1.2 1995-02-02 23:09:39 d3g681 Exp $
|
||||
double precision dx(1),dy(1),da
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c copies a vector, x, to a vector, y.
|
|||
c uses unrolled loops for increments equal to one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: dcopy.f,v 1.2 1995-02-02 23:09:40 d3g681 Exp $
|
||||
double precision dx(1),dy(1)
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c forms the dot product of two vectors.
|
|||
c uses unrolled loops for increments equal to one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: ddot.f,v 1.2 1995-02-02 23:09:41 d3g681 Exp $
|
||||
double precision dx(1),dy(1),dtemp
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
|
||||
$ BETA, Y, INCY )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dgemv.f,v 1.2 1995-02-02 23:09:43 d3g681 Exp $
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
INTEGER INCX, INCY, LDA, M, N
|
||||
CHARACTER*1 TRANS
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE DGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dger.f,v 1.2 1995-02-02 23:09:45 d3g681 Exp $
|
||||
DOUBLE PRECISION ALPHA
|
||||
INTEGER INCX, INCY, LDA, M, N
|
||||
* .. Array Arguments ..
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
double precision function dnrm2 ( n, dx, incx)
|
||||
C$Id: dnrm2.f,v 1.2 1995-02-02 23:09:46 d3g681 Exp $
|
||||
integer i, incx, ix, j, n, next
|
||||
double precision dx(1), cutlo, cuthi, hitest, sum, xmax,zero,one
|
||||
data zero, one /0.0d0, 1.0d0/
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ c
|
|||
c applies a plane rotation.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: drot.f,v 1.2 1995-02-02 23:09:47 d3g681 Exp $
|
||||
double precision dx(1),dy(1),dtemp,c,s
|
||||
integer i,incx,incy,ix,iy,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ c uses unrolled loops for increment equal to one.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: dscal.f,v 1.2 1995-02-02 23:09:48 d3g681 Exp $
|
||||
double precision da,dx(1)
|
||||
integer i,incx,m,mp1,n,nincx
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE DSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dspmv.f,v 1.2 1995-02-02 23:09:49 d3g681 Exp $
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
INTEGER INCX, INCY, N
|
||||
CHARACTER*1 UPLO
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE DSPR ( UPLO, N, ALPHA, X, INCX, AP )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dspr.f,v 1.2 1995-02-02 23:09:50 d3g681 Exp $
|
||||
DOUBLE PRECISION ALPHA
|
||||
INTEGER INCX, N
|
||||
CHARACTER*1 UPLO
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c interchanges two vectors.
|
|||
c uses unrolled loops for increments equal one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: dswap.f,v 1.2 1995-02-02 23:09:51 d3g681 Exp $
|
||||
double precision dx(1),dy(1),dtemp
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE DSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,
|
||||
$ BETA, C, LDC )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dsyrk.f,v 1.4 1995-02-02 23:09:52 d3g681 Exp $
|
||||
CHARACTER*1 UPLO, TRANS
|
||||
INTEGER N, K, LDA, LDC
|
||||
DOUBLE PRECISION ALPHA, BETA
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE DTRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
|
||||
$ B, LDB )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dtrmm.f,v 1.2 1995-02-02 23:09:54 d3g681 Exp $
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
INTEGER M, N, LDA, LDB
|
||||
DOUBLE PRECISION ALPHA
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE DTRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dtrmv.f,v 1.2 1995-02-02 23:09:55 d3g681 Exp $
|
||||
INTEGER INCX, LDA, N
|
||||
CHARACTER*1 DIAG, TRANS, UPLO
|
||||
* .. Array Arguments ..
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
SUBROUTINE DTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
|
||||
$ B, LDB )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: dtrsm.f,v 1.2 1995-02-02 23:09:56 d3g681 Exp $
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
INTEGER M, N, LDA, LDB
|
||||
DOUBLE PRECISION ALPHA
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c finds the index of element having max. absolute value.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: idamax.f,v 1.2 1995-02-02 23:09:57 d3g681 Exp $
|
||||
double precision dx(1),dmax
|
||||
integer i,incx,ix,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
* February 29, 1992
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: lsame.f,v 1.2 1995-02-02 23:09:58 d3g681 Exp $
|
||||
CHARACTER CA, CB
|
||||
* ..
|
||||
*
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c finds the index of element having max. absolute value.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: isamax.f,v 1.2 1995-02-02 23:10:09 d3g681 Exp $
|
||||
real sx(1),smax
|
||||
integer i,incx,ix,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@
|
|||
* February 29, 1992
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: lsame.f,v 1.2 1995-02-02 23:10:10 d3g681 Exp $
|
||||
CHARACTER CA, CB
|
||||
* ..
|
||||
*
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ c uses unrolled loops for increment equal to one.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: sasum.f,v 1.2 1995-02-02 23:10:11 d3g681 Exp $
|
||||
real sx(1),stemp
|
||||
integer i,incx,m,mp1,n,nincx
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c constant times a vector plus a vector.
|
|||
c uses unrolled loop for increments equal to one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: saxpy.f,v 1.2 1995-02-02 23:10:12 d3g681 Exp $
|
||||
real sx(1),sy(1),sa
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c copies a vector, x, to a vector, y.
|
|||
c uses unrolled loops for increments equal to 1.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: scopy.f,v 1.2 1995-02-02 23:10:13 d3g681 Exp $
|
||||
real sx(1),sy(1)
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c forms the dot product of two vectors.
|
|||
c uses unrolled loops for increments equal to one.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: sdot.f,v 1.2 1995-02-02 23:10:14 d3g681 Exp $
|
||||
real sx(1),sy(1),stemp
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE SGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
|
||||
$ BETA, C, LDC )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: sgemm.f,v 1.2 1995-02-02 23:10:15 d3g681 Exp $
|
||||
CHARACTER*1 TRANSA, TRANSB
|
||||
INTEGER M, N, K, LDA, LDB, LDC
|
||||
REAL ALPHA, BETA
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE SGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
|
||||
$ BETA, Y, INCY )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: sgemv.f,v 1.2 1995-02-02 23:10:16 d3g681 Exp $
|
||||
REAL ALPHA, BETA
|
||||
INTEGER INCX, INCY, LDA, M, N
|
||||
CHARACTER*1 TRANS
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE SGER ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: sger.f,v 1.2 1995-02-02 23:10:17 d3g681 Exp $
|
||||
REAL ALPHA
|
||||
INTEGER INCX, INCY, LDA, M, N
|
||||
* .. Array Arguments ..
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
real function snrm2 ( n, sx, incx)
|
||||
C$Id: snrm2.f,v 1.2 1995-02-02 23:10:18 d3g681 Exp $
|
||||
integer i, incx, ix, j, n, next
|
||||
real sx(1), cutlo, cuthi, hitest, sum, xmax, zero, one
|
||||
data zero, one /0.0e0, 1.0e0/
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@ c
|
|||
c applies a plane rotation.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: srot.f,v 1.2 1995-02-02 23:10:19 d3g681 Exp $
|
||||
real sx(1),sy(1),stemp,c,s
|
||||
integer i,incx,incy,ix,iy,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ c uses unrolled loops for increment equal to 1.
|
|||
c jack dongarra, linpack, 3/11/78.
|
||||
c modified 3/93 to return if incx .le. 0.
|
||||
c
|
||||
C$Id: sscal.f,v 1.2 1995-02-02 23:10:20 d3g681 Exp $
|
||||
real sa,sx(1)
|
||||
integer i,incx,m,mp1,n,nincx
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE SSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: sspmv.f,v 1.2 1995-02-02 23:10:21 d3g681 Exp $
|
||||
REAL ALPHA, BETA
|
||||
INTEGER INCX, INCY, N
|
||||
CHARACTER*1 UPLO
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE SSPR ( UPLO, N, ALPHA, X, INCX, AP )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: sspr.f,v 1.2 1995-02-02 23:10:22 d3g681 Exp $
|
||||
REAL ALPHA
|
||||
INTEGER INCX, N
|
||||
CHARACTER*1 UPLO
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c interchanges two vectors.
|
|||
c uses unrolled loops for increments equal to 1.
|
||||
c jack dongarra, linpack, 3/11/78.
|
||||
c
|
||||
C$Id: sswap.f,v 1.2 1995-02-02 23:10:23 d3g681 Exp $
|
||||
real sx(1),sy(1),stemp
|
||||
integer i,incx,incy,ix,iy,m,mp1,n
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE SSYRK ( UPLO, TRANS, N, K, ALPHA, A, LDA,
|
||||
$ BETA, C, LDC )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: ssyrk.f,v 1.3 1995-02-02 23:10:24 d3g681 Exp $
|
||||
CHARACTER*1 UPLO, TRANS
|
||||
INTEGER N, K, LDA, LDC
|
||||
REAL ALPHA, BETA
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
SUBROUTINE STRMM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
|
||||
$ B, LDB )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: strmm.f,v 1.2 1995-02-02 23:10:25 d3g681 Exp $
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
INTEGER M, N, LDA, LDB
|
||||
REAL ALPHA
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
SUBROUTINE STRMV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: strmv.f,v 1.2 1995-02-02 23:10:29 d3g681 Exp $
|
||||
INTEGER INCX, LDA, N
|
||||
CHARACTER*1 DIAG, TRANS, UPLO
|
||||
* .. Array Arguments ..
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
SUBROUTINE STRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
|
||||
$ B, LDB )
|
||||
* .. Scalar Arguments ..
|
||||
C$Id: strsm.f,v 1.2 1995-02-02 23:10:32 d3g681 Exp $
|
||||
CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
|
||||
INTEGER M, N, LDA, LDB
|
||||
REAL ALPHA
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c each. Simply run this program and check the size resulting file
|
|||
c 'da_rec_size.test' (in bytes) using 'ls' and divide by 1024 units.
|
||||
C
|
||||
Program da_rec_size
|
||||
C$Id: da_rec_size.f,v 1.2 1995-02-02 23:10:44 d3g681 Exp $
|
||||
Integer RecLen
|
||||
Parameter (RecLen = 512)
|
||||
Integer A(1)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
|
||||
# makefile.h,v 1.92 1995/01/12 18:44:07 pg511 Exp
|
||||
# $Id: makefile.h,v 1.95 1995-02-02 23:10:45 d3g681 Exp $
|
||||
|
||||
# Common definitions for all makefiles ... these can be overridden
|
||||
# either in each makefile by putting additional definitions below the
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
# $Id: GNUmakefile,v 1.20 1995-01-30 15:49:09 d3g681 Exp $
|
||||
# $Id: GNUmakefile,v 1.21 1995-02-02 23:11:46 d3g681 Exp $
|
||||
|
||||
|
||||
OBJ = comp4_bins.o rhf_dens_to_mo.o \
|
||||
|
|
@ -29,9 +29,7 @@
|
|||
|
||||
USES_BLAS = ga_conform.F ga_mxv.F k2cf.F matrix_exp.F rhf_dens_to_mo.F \
|
||||
rhf_do_canon.F \
|
||||
rhf_energy.F rhf_fock_2e.F rhf_hessv.F rhf_nr_solve.F \
|
||||
ri_invert_v.F \
|
||||
ri_v_fit_cd.F ri_v_fit_j.F
|
||||
rhf_energy.F rhf_fock_2e.F rhf_hessv.F rhf_nr_solve.F
|
||||
|
||||
HEADERS = schwarz.fh
|
||||
|
||||
|
|
|
|||
|
|
@ -6,6 +6,7 @@ c
|
|||
c orestrict_3 -> Only evaluate 3 center integrals
|
||||
c
|
||||
logical orestrict_2, orestrict_3
|
||||
C$Id: cfock.fh,v 1.4 1995-02-02 23:11:27 d3g681 Exp $
|
||||
integer lchunksize, task_chunks
|
||||
common/cfock/orestrict_2, orestrict_3, lchunksize, task_chunks
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine comp4_bins(m, n, nb_per_i)
|
||||
C$Id: comp4_bins.F,v 1.4 1995-02-02 23:11:28 d3g681 Exp $
|
||||
implicit none
|
||||
c
|
||||
integer m(*) ! Array holding info compressed to 4 bits
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine comp4_insert(m, i, s, nb_per_i)
|
||||
C$Id: comp4_insert.F,v 1.4 1995-02-02 23:11:30 d3g681 Exp $
|
||||
implicit none
|
||||
c
|
||||
integer m(*) ! Array holding info compressed to 4 bits
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@ c This common is used to pass info to the routines that do the
|
|||
c hessian-vector products and preconditioning of the iterative soln
|
||||
c
|
||||
integer geom_rhf, basis_rhf
|
||||
C$Id: crhf.fh,v 1.2 1995-02-02 23:11:31 d3g681 Exp $
|
||||
integer g_fock ! MO fock matrix ... nbf*nbf
|
||||
integer g_mocf_rhf ! MO coefficients
|
||||
integer nbf, nocc, nvir
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@ c
|
|||
integer ps_fock_2e, ps_int_1e, ps_solve, ps_search,
|
||||
$ ps_matexp, ps_total, ps_int_2e, ps_diag, ps_fock_add,
|
||||
$ ps_vecio, ps_orthog
|
||||
C$Id: cscfps.fh,v 1.4 1995-02-02 23:11:32 d3g681 Exp $
|
||||
logical oscfps ! True if gathering stats
|
||||
common /cscfps/ oscfps,
|
||||
$ ps_fock_2e, ps_int_1e, ps_solve, ps_search,
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
double precision sch_max ! Maximum value of any entry
|
||||
C$Id: cschwarz.fh,v 1.2 1995-02-02 23:11:33 d3g681 Exp $
|
||||
integer nb_per_i ! No. of bytes per integer
|
||||
integer l_csh, k_csh ! MA handle & index to shell array
|
||||
integer l_cat, k_cat ! MA handle & index to atom array
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
logical oskel
|
||||
C$Id: cskeleton.fh,v 1.2 1995-02-02 23:11:34 d3g681 Exp $
|
||||
common /cskeleton/ oskel
|
||||
c
|
||||
c oskel ... if true SCF uses petite list symmetry
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine int_1e_ga(ibas, jbas, g, integ_type, oskel)
|
||||
C$Id: int_1e_ga.F,v 1.11 1995-02-02 23:11:43 d3g681 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "global.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine matrix_exp(basis, g_k)
|
||||
C$Id: matrix_exp.F,v 1.6 1995-02-02 23:11:47 d3g681 Exp $
|
||||
implicit none
|
||||
#include "global.fh"
|
||||
#include "mafdecls.fh"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
subroutine rhf_fock_2e(geom, basis, g_dens, g_fock, tol2e,
|
||||
& ocoul, oexch, oskel)
|
||||
C$Id: rhf_fock_2e.F,v 1.11 1995-02-02 23:11:57 d3g681 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "global.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
logical function scf(rtdb)
|
||||
C$Id: scf.F,v 1.22 1995-02-02 23:12:07 d3g681 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "global.fh"
|
||||
|
|
@ -145,6 +146,12 @@ c
|
|||
endif
|
||||
call util_flush(6)
|
||||
endif
|
||||
c
|
||||
c Overwrite the input movecs option with where the final movecs
|
||||
c will end up so that a restart automatically picks them up
|
||||
c
|
||||
if (.not. rtdb_cput(rtdb, 'scf:input vectors', 1, movecs_out))
|
||||
$ call errquit('scf:rtdb_cput failed scf:input vectors',0)
|
||||
c
|
||||
c When do other than RHF need to check that WFN type is valid
|
||||
c in case have inherited the wavefunction description from
|
||||
|
|
@ -169,12 +176,6 @@ c
|
|||
if (.not. rtdb_put(rtdb, name, MT_LOG, 1, converged)) call errquit
|
||||
$ ('scf: failed to store converged in rtdb', 0)
|
||||
c
|
||||
c Overwrite the input movecs option with where the final movecs
|
||||
c ended up so that a restart automatically picks them up
|
||||
c
|
||||
if (.not. rtdb_cput(rtdb, 'scf:input vectors', 1, movecs_out))
|
||||
$ call errquit('scf:rtdb_cput failed scf:input vectors',0)
|
||||
c
|
||||
c SCF is done destroy basis and geometry handles
|
||||
c
|
||||
if (.not.(bas_destroy(basis) .and. geom_destroy(geom)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
block data dscfps
|
||||
#include "cscfps.fh"
|
||||
C$Id: scf_pstat.F,v 1.12 1995-02-02 23:12:08 d3g681 Exp $
|
||||
data oscfps /.false./ ! So that other codes don't break
|
||||
c
|
||||
end
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@ c iscreen(4) counts rejects in inner ijkl shell loop
|
|||
c iscreen(5) counts accepts in inner ijkl shell loop
|
||||
c
|
||||
integer iscreen, nscreen
|
||||
C$Id: schwarz.fh,v 1.2 1995-02-02 23:12:09 d3g681 Exp $
|
||||
parameter (nscreen=5)
|
||||
common/cscreen/iscreen(nscreen)
|
||||
double precision schwarz_max, schwarz_atom, schwarz_shell
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
double precision function schwarz_atom(iat, jat)
|
||||
C$Id: schwarz_atom.F,v 1.4 1995-02-02 23:12:10 d3g681 Exp $
|
||||
implicit none
|
||||
#include "cschwarz.fh"
|
||||
#include "mafdecls.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine schwarz_init(geom, basis)
|
||||
C$Id: schwarz_init.F,v 1.13 1995-02-02 23:12:11 d3g681 Exp $
|
||||
implicit none
|
||||
#include "mafdecls.fh"
|
||||
#include "bas.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
double precision function schwarz_max()
|
||||
C$Id: schwarz_max.F,v 1.2 1995-02-02 23:12:12 d3g681 Exp $
|
||||
implicit none
|
||||
#include "cschwarz.fh"
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine schwarz_tidy()
|
||||
C$Id: schwarz_tidy.F,v 1.3 1995-02-02 23:12:15 d3g681 Exp $
|
||||
implicit none
|
||||
#include "cschwarz.fh"
|
||||
#include "mafdecls.fh"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
logical function movecs_read_header(filename, title, basis_name,
|
||||
$ nbf, nsets, nmo, ldnmo)
|
||||
C$Id: vectors.F,v 1.11 1995-02-02 23:12:17 d3g681 Exp $
|
||||
implicit none
|
||||
#include "global.fh"
|
||||
#include "tcgmsg.fh"
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
#$Id: GNUmakefile,v 1.6 1995-02-02 23:12:35 d3g681 Exp $
|
||||
OBJ = rjhtest.o raktest.o debtest.o
|
||||
LIBRARY = libtest.a
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
Subroutine DEBTest(RTDB)
|
||||
C$Id: debtest.F,v 1.3 1995-02-02 23:12:34 d3g681 Exp $
|
||||
Implicit NONE
|
||||
Integer RTDB
|
||||
Logical Status
|
||||
|
|
|
|||
|
|
@ -1,210 +1,211 @@
|
|||
subroutine rjhtest(rtdb)
|
||||
implicit none
|
||||
integer rtdb
|
||||
call print_integs(rtdb, 'geometry','mo basis')
|
||||
* call scf(rtdb)
|
||||
end
|
||||
subroutine print_integs(rtdb, geom_name, basis_name)
|
||||
implicit none
|
||||
#include "rtdb.fh"
|
||||
#include "geom.fh"
|
||||
#include "bas.fh"
|
||||
#include "inp.fh"
|
||||
#include "global.fh"
|
||||
integer rtdb
|
||||
character*(*) geom_name, basis_name
|
||||
integer geom
|
||||
integer bases(2)
|
||||
integer basis
|
||||
integer ri_basis, g_j, g_vinv, g_dens_dumm, g_j_real
|
||||
integer ncenter
|
||||
integer icent, jcent, kcent, lcent
|
||||
integer ish, jsh, ksh, lsh
|
||||
integer ishlo, ishhi, jshlo, jshhi, kshlo, kshhi, lshlo, lshhi
|
||||
integer i, j, k, l, ijkl
|
||||
integer ilo, ihi, jlo, jhi, klo, khi, llo, lhi
|
||||
double precision eri(256), xi(3), xj(3), xk(3), xl(3)
|
||||
double precision qi, qj, qk, ql, sum
|
||||
character*16 tagi, tagj, tagk, tagl
|
||||
logical int_normalize
|
||||
integer ga_create_atom_blocked
|
||||
external int_normalize
|
||||
external ga_create_atom_blocked
|
||||
Double precision result
|
||||
c
|
||||
* call ieeetrap
|
||||
c
|
||||
if (.not. geom_create(geom, geom_name))
|
||||
$ call errquit('print_integs: geom_create failed?', 0)
|
||||
if (.not. geom_rtdb_load(rtdb, geom, geom_name))
|
||||
$ call errquit('print_integs: geom_load failed', 0)
|
||||
If ( GA_NodeID() .eq. 0) then
|
||||
if (.not. geom_print(geom))
|
||||
$ call errquit('print_integs: geom_print failed', 0)
|
||||
EndIf
|
||||
if (.not. bas_create(basis, basis_name))
|
||||
$ call errquit('print_integs: basis create failed', 0)
|
||||
if (.not. bas_rtdb_load(rtdb, geom, basis, basis_name))
|
||||
$ call errquit('print_integs: basis load failed', 0)
|
||||
If ( GA_NodeID() .eq. 0) then
|
||||
write(6,*) ' basis before normalization '
|
||||
if (.not. bas_print(basis))
|
||||
$ call errquit('print_integs: basis print failed', 0)
|
||||
EndIf
|
||||
if (.not. int_normalize(basis))
|
||||
$ call errquit('print_integs: normalize failed', 0)
|
||||
If ( GA_NodeID() .eq. 0) then
|
||||
write(6,*) ' basis after normalization '
|
||||
if (.not. bas_print(basis))
|
||||
$ call errquit('print_integs: basis print failed', 0)
|
||||
if (.not. gbs_map_print(basis))
|
||||
$ call errquit('print_integs: gbs_map_print failed', 0)
|
||||
EndIf
|
||||
c
|
||||
c... open ri basis set
|
||||
if (.not.bas_create(ri_basis, 'ri-scf basis'))
|
||||
& call errquit('rjhtest: bas_create failed',911)
|
||||
if (.not.bas_rtdb_load(rtdb,geom,ri_basis,'ri-scf basis'))
|
||||
& call errquit('rjhtest: bas_rtdb_load failed',911)
|
||||
If ( GA_NodeID() .eq. 0) then
|
||||
if (.not. bas_print(ri_basis))
|
||||
$ call errquit('print_integs: ri_basis print failed', 0)
|
||||
EndIf
|
||||
if (.not. int_normalize(ri_basis))
|
||||
$ call errquit('print_integs: normalize failed', 0)
|
||||
If ( GA_NodeID() .eq. 0) then
|
||||
write(6,*) ' ri_basis after normalization '
|
||||
if (.not. bas_print(ri_basis))
|
||||
$ call errquit('print_integs: ri_basis print failed', 0)
|
||||
if (.not. gbs_map_print(ri_basis))
|
||||
$ call errquit('print_integs: gbs_map_print failed', 0)
|
||||
EndIf
|
||||
bases(1) = basis
|
||||
bases(2) = ri_basis
|
||||
call int_init(rtdb,2,bases)
|
||||
g_dens_dumm = ga_create_atom_blocked(geom,basis,' fake density')
|
||||
g_j = ga_create_atom_blocked(geom,basis,'ri coulomb matrix ')
|
||||
g_j_real =
|
||||
& ga_create_atom_blocked(geom,basis,'real coulomb matrix ')
|
||||
call ga_zero(g_j)
|
||||
call schwarz_init(geom, basis)
|
||||
call guess_dens(geom,basis,g_dens_dumm)
|
||||
c$$$ write(6,*)' density matrix'
|
||||
c$$$ call ga_print(g_dens_dumm)
|
||||
call ri_invert_v(rtdb,ri_basis,geom,g_vinv)
|
||||
c$$$ write(6,*)' inverse v '
|
||||
c$$$ call ga_print(g_vinv)
|
||||
c
|
||||
call ri_drive(rtdb,basis,ri_basis,geom,1.0d00,
|
||||
& g_dens_dumm,g_vinv,g_j)
|
||||
c$$$ write(6,*)' from ri coulomb matrix'
|
||||
c$$$ call ga_print(g_j)
|
||||
c
|
||||
c get real coulomb energy
|
||||
c
|
||||
call ga_zero(g_j_real)
|
||||
call rhf_fock_2e(geom,basis,g_dens_dumm,g_j_real,
|
||||
& 1.0d-09,.true.,.false., .false.)
|
||||
c$$$ write(6,*)' real coulomb matrix'
|
||||
c$$$ call ga_print(g_j_real)
|
||||
Call GA_Sync
|
||||
call ga_dadd(1.0d00,g_j,-1.0d00,g_j_real, g_j_real)
|
||||
Result = ga_ddot(g_j_real,g_j_real)
|
||||
If ( GA_NodeID() .eq. 0 )
|
||||
$ write(6,*)'ddot of diff', result
|
||||
c$$$ write(6,*)' difference!!!! '
|
||||
c$$$ call ga_print(g_j_real)
|
||||
Call GA_Sync
|
||||
return
|
||||
write(6,2) geom_name(1:inp_strlen(geom_name)),
|
||||
$ basis_name(1:inp_strlen(basis_name))
|
||||
2 format(/' Integrals for geometry "',a,'" with basis "',a,'"'/)
|
||||
c
|
||||
c Partially redundant four-fold loop thru centers
|
||||
c
|
||||
if (.not. geom_ncent(geom, ncenter))
|
||||
$ call errquit('print_integs: geom_ncent failed', 0)
|
||||
sum = 0.0d0
|
||||
do icent = 1, ncenter
|
||||
do jcent = 1, icent
|
||||
do kcent = 1, icent
|
||||
do lcent = 1, kcent
|
||||
c
|
||||
c Figure out coords and contractions of each center
|
||||
c
|
||||
if (.not. geom_cent_get(geom, icent, tagi, xi, qi))
|
||||
$ call errquit('print_integs: cent_get ?', icent)
|
||||
if (.not. geom_cent_get(geom, jcent, tagj, xj, qj))
|
||||
$ call errquit('print_integs: cent_get ?', jcent)
|
||||
if (.not. geom_cent_get(geom, kcent, tagk, xk, qk))
|
||||
$ call errquit('print_integs: cent_get ?', kcent)
|
||||
if (.not. geom_cent_get(geom, lcent, tagl, xl, ql))
|
||||
$ call errquit('print_integs: cent_get ?', lcent)
|
||||
c
|
||||
if (.not. bas_ce2cnr(basis, icent, ishlo, ishhi))
|
||||
$ call errquit('print_integs: ce2cnr ?', icent)
|
||||
if (.not. bas_ce2cnr(basis, jcent, jshlo, jshhi))
|
||||
$ call errquit('print_integs: ce2cnr ?', jcent)
|
||||
if (.not. bas_ce2cnr(basis, kcent, kshlo, kshhi))
|
||||
$ call errquit('print_integs: ce2cnr ?', kcent)
|
||||
if (.not. bas_ce2cnr(basis, lcent, lshlo, lshhi))
|
||||
$ call errquit('print_integs: ce2cnr ?', lcent)
|
||||
c
|
||||
c Partially redundant four-fold loop thru contractions
|
||||
c
|
||||
do ish = ishlo, ishhi
|
||||
do jsh = jshlo, jshhi
|
||||
do ksh = kshlo, kshhi
|
||||
do lsh = lshlo, lshhi
|
||||
c
|
||||
c Now compute the SP integrals over these shells
|
||||
c
|
||||
call genr70(
|
||||
$ basis, ish, xi, jsh, xj,
|
||||
$ basis, ksh, xk, lsh, xl,
|
||||
$ eri)
|
||||
c
|
||||
c Print the integrals out
|
||||
c
|
||||
if (.not. bas_cn2bfr(basis, ish, ilo,ihi))
|
||||
$ call errquit('print_integ: cn2bf?',0)
|
||||
if (.not. bas_cn2bfr(basis, jsh, jlo,jhi))
|
||||
$ call errquit('print_integ: cn2bf?',0)
|
||||
if (.not. bas_cn2bfr(basis, ksh, klo,khi))
|
||||
$ call errquit('print_integ: cn2bf?',0)
|
||||
if (.not. bas_cn2bfr(basis, lsh, llo,lhi))
|
||||
$ call errquit('print_integ: cn2bf?',0)
|
||||
c
|
||||
ijkl = 0
|
||||
do i = ilo, ihi
|
||||
do j = jlo, jhi
|
||||
do k = klo, khi
|
||||
do l = llo, lhi
|
||||
ijkl = ijkl + 1
|
||||
if (abs(eri(ijkl)) .gt. 1e-6)
|
||||
$ write(6,1) i,j,k,l,
|
||||
$ eri(ijkl)
|
||||
sum = sum + abs(eri(ijkl))
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
c
|
||||
1 format(4i6,f20.9)
|
||||
|
||||
write(6,*) ' SUM of integrals ', sum
|
||||
|
||||
if (.not. geom_destroy(geom))
|
||||
$ call errquit('print_integs: geom_destroy failed', 0)
|
||||
if (.not.bas_destroy(basis))
|
||||
$ call errquit('print_integs: basis destroy failed', 0)
|
||||
c
|
||||
C$Id: rjhtest.F,v 1.12 1995-02-02 23:12:36 d3g681 Exp $
|
||||
c$$$ implicit none
|
||||
c$$$ integer rtdb
|
||||
c$$$ call print_integs(rtdb, 'geometry','mo basis')
|
||||
c$$$* call scf(rtdb)
|
||||
c$$$ end
|
||||
c$$$ subroutine print_integs(rtdb, geom_name, basis_name)
|
||||
c$$$ implicit none
|
||||
c$$$#include "rtdb.fh"
|
||||
c$$$#include "geom.fh"
|
||||
c$$$#include "bas.fh"
|
||||
c$$$#include "inp.fh"
|
||||
c$$$#include "global.fh"
|
||||
c$$$ integer rtdb
|
||||
c$$$ character*(*) geom_name, basis_name
|
||||
c$$$ integer geom
|
||||
c$$$ integer bases(2)
|
||||
c$$$ integer basis
|
||||
c$$$ integer ri_basis, g_j, g_vinv, g_dens_dumm, g_j_real
|
||||
c$$$ integer ncenter
|
||||
c$$$ integer icent, jcent, kcent, lcent
|
||||
c$$$ integer ish, jsh, ksh, lsh
|
||||
c$$$ integer ishlo, ishhi, jshlo, jshhi, kshlo, kshhi, lshlo, lshhi
|
||||
c$$$ integer i, j, k, l, ijkl
|
||||
c$$$ integer ilo, ihi, jlo, jhi, klo, khi, llo, lhi
|
||||
c$$$ double precision eri(256), xi(3), xj(3), xk(3), xl(3)
|
||||
c$$$ double precision qi, qj, qk, ql, sum
|
||||
c$$$ character*16 tagi, tagj, tagk, tagl
|
||||
c$$$ logical int_normalize
|
||||
c$$$ integer ga_create_atom_blocked
|
||||
c$$$ external int_normalize
|
||||
c$$$ external ga_create_atom_blocked
|
||||
c$$$ Double precision result
|
||||
c$$$c
|
||||
c$$$* call ieeetrap
|
||||
c$$$c
|
||||
c$$$ if (.not. geom_create(geom, geom_name))
|
||||
c$$$ $ call errquit('print_integs: geom_create failed?', 0)
|
||||
c$$$ if (.not. geom_rtdb_load(rtdb, geom, geom_name))
|
||||
c$$$ $ call errquit('print_integs: geom_load failed', 0)
|
||||
c$$$ If ( GA_NodeID() .eq. 0) then
|
||||
c$$$ if (.not. geom_print(geom))
|
||||
c$$$ $ call errquit('print_integs: geom_print failed', 0)
|
||||
c$$$ EndIf
|
||||
c$$$ if (.not. bas_create(basis, basis_name))
|
||||
c$$$ $ call errquit('print_integs: basis create failed', 0)
|
||||
c$$$ if (.not. bas_rtdb_load(rtdb, geom, basis, basis_name))
|
||||
c$$$ $ call errquit('print_integs: basis load failed', 0)
|
||||
c$$$ If ( GA_NodeID() .eq. 0) then
|
||||
c$$$ write(6,*) ' basis before normalization '
|
||||
c$$$ if (.not. bas_print(basis))
|
||||
c$$$ $ call errquit('print_integs: basis print failed', 0)
|
||||
c$$$ EndIf
|
||||
c$$$ if (.not. int_normalize(basis))
|
||||
c$$$ $ call errquit('print_integs: normalize failed', 0)
|
||||
c$$$ If ( GA_NodeID() .eq. 0) then
|
||||
c$$$ write(6,*) ' basis after normalization '
|
||||
c$$$ if (.not. bas_print(basis))
|
||||
c$$$ $ call errquit('print_integs: basis print failed', 0)
|
||||
c$$$ if (.not. gbs_map_print(basis))
|
||||
c$$$ $ call errquit('print_integs: gbs_map_print failed', 0)
|
||||
c$$$ EndIf
|
||||
c$$$c
|
||||
c$$$c... open ri basis set
|
||||
c$$$ if (.not.bas_create(ri_basis, 'ri-scf basis'))
|
||||
c$$$ & call errquit('rjhtest: bas_create failed',911)
|
||||
c$$$ if (.not.bas_rtdb_load(rtdb,geom,ri_basis,'ri-scf basis'))
|
||||
c$$$ & call errquit('rjhtest: bas_rtdb_load failed',911)
|
||||
c$$$ If ( GA_NodeID() .eq. 0) then
|
||||
c$$$ if (.not. bas_print(ri_basis))
|
||||
c$$$ $ call errquit('print_integs: ri_basis print failed', 0)
|
||||
c$$$ EndIf
|
||||
c$$$ if (.not. int_normalize(ri_basis))
|
||||
c$$$ $ call errquit('print_integs: normalize failed', 0)
|
||||
c$$$ If ( GA_NodeID() .eq. 0) then
|
||||
c$$$ write(6,*) ' ri_basis after normalization '
|
||||
c$$$ if (.not. bas_print(ri_basis))
|
||||
c$$$ $ call errquit('print_integs: ri_basis print failed', 0)
|
||||
c$$$ if (.not. gbs_map_print(ri_basis))
|
||||
c$$$ $ call errquit('print_integs: gbs_map_print failed', 0)
|
||||
c$$$ EndIf
|
||||
c$$$ bases(1) = basis
|
||||
c$$$ bases(2) = ri_basis
|
||||
c$$$ call int_init(rtdb,2,bases)
|
||||
c$$$ g_dens_dumm = ga_create_atom_blocked(geom,basis,' fake density')
|
||||
c$$$ g_j = ga_create_atom_blocked(geom,basis,'ri coulomb matrix ')
|
||||
c$$$ g_j_real =
|
||||
c$$$ & ga_create_atom_blocked(geom,basis,'real coulomb matrix ')
|
||||
c$$$ call ga_zero(g_j)
|
||||
c$$$ call schwarz_init(geom, basis)
|
||||
c$$$ call guess_dens(geom,basis,g_dens_dumm)
|
||||
c$$$c$$$ write(6,*)' density matrix'
|
||||
c$$$c$$$ call ga_print(g_dens_dumm)
|
||||
c$$$ call ri_invert_v(rtdb,ri_basis,geom,g_vinv)
|
||||
c$$$c$$$ write(6,*)' inverse v '
|
||||
c$$$c$$$ call ga_print(g_vinv)
|
||||
c$$$c
|
||||
c$$$ call ri_drive(rtdb,basis,ri_basis,geom,1.0d00,
|
||||
c$$$ & g_dens_dumm,g_vinv,g_j)
|
||||
c$$$c$$$ write(6,*)' from ri coulomb matrix'
|
||||
c$$$c$$$ call ga_print(g_j)
|
||||
c$$$c
|
||||
c$$$c get real coulomb energy
|
||||
c$$$c
|
||||
c$$$ call ga_zero(g_j_real)
|
||||
c$$$ call rhf_fock_2e(geom,basis,g_dens_dumm,g_j_real,
|
||||
c$$$ & 1.0d-09,.true.,.false., .false.)
|
||||
c$$$c$$$ write(6,*)' real coulomb matrix'
|
||||
c$$$c$$$ call ga_print(g_j_real)
|
||||
c$$$ Call GA_Sync
|
||||
c$$$ call ga_dadd(1.0d00,g_j,-1.0d00,g_j_real, g_j_real)
|
||||
c$$$ Result = ga_ddot(g_j_real,g_j_real)
|
||||
c$$$ If ( GA_NodeID() .eq. 0 )
|
||||
c$$$ $ write(6,*)'ddot of diff', result
|
||||
c$$$c$$$ write(6,*)' difference!!!! '
|
||||
c$$$c$$$ call ga_print(g_j_real)
|
||||
c$$$ Call GA_Sync
|
||||
c$$$ return
|
||||
c$$$ write(6,2) geom_name(1:inp_strlen(geom_name)),
|
||||
c$$$ $ basis_name(1:inp_strlen(basis_name))
|
||||
c$$$ 2 format(/' Integrals for geometry "',a,'" with basis "',a,'"'/)
|
||||
c$$$c
|
||||
c$$$c Partially redundant four-fold loop thru centers
|
||||
c$$$c
|
||||
c$$$ if (.not. geom_ncent(geom, ncenter))
|
||||
c$$$ $ call errquit('print_integs: geom_ncent failed', 0)
|
||||
c$$$ sum = 0.0d0
|
||||
c$$$ do icent = 1, ncenter
|
||||
c$$$ do jcent = 1, icent
|
||||
c$$$ do kcent = 1, icent
|
||||
c$$$ do lcent = 1, kcent
|
||||
c$$$c
|
||||
c$$$c Figure out coords and contractions of each center
|
||||
c$$$c
|
||||
c$$$ if (.not. geom_cent_get(geom, icent, tagi, xi, qi))
|
||||
c$$$ $ call errquit('print_integs: cent_get ?', icent)
|
||||
c$$$ if (.not. geom_cent_get(geom, jcent, tagj, xj, qj))
|
||||
c$$$ $ call errquit('print_integs: cent_get ?', jcent)
|
||||
c$$$ if (.not. geom_cent_get(geom, kcent, tagk, xk, qk))
|
||||
c$$$ $ call errquit('print_integs: cent_get ?', kcent)
|
||||
c$$$ if (.not. geom_cent_get(geom, lcent, tagl, xl, ql))
|
||||
c$$$ $ call errquit('print_integs: cent_get ?', lcent)
|
||||
c$$$c
|
||||
c$$$ if (.not. bas_ce2cnr(basis, icent, ishlo, ishhi))
|
||||
c$$$ $ call errquit('print_integs: ce2cnr ?', icent)
|
||||
c$$$ if (.not. bas_ce2cnr(basis, jcent, jshlo, jshhi))
|
||||
c$$$ $ call errquit('print_integs: ce2cnr ?', jcent)
|
||||
c$$$ if (.not. bas_ce2cnr(basis, kcent, kshlo, kshhi))
|
||||
c$$$ $ call errquit('print_integs: ce2cnr ?', kcent)
|
||||
c$$$ if (.not. bas_ce2cnr(basis, lcent, lshlo, lshhi))
|
||||
c$$$ $ call errquit('print_integs: ce2cnr ?', lcent)
|
||||
c$$$c
|
||||
c$$$c Partially redundant four-fold loop thru contractions
|
||||
c$$$c
|
||||
c$$$ do ish = ishlo, ishhi
|
||||
c$$$ do jsh = jshlo, jshhi
|
||||
c$$$ do ksh = kshlo, kshhi
|
||||
c$$$ do lsh = lshlo, lshhi
|
||||
c$$$c
|
||||
c$$$c Now compute the SP integrals over these shells
|
||||
c$$$c
|
||||
c$$$ call genr70(
|
||||
c$$$ $ basis, ish, xi, jsh, xj,
|
||||
c$$$ $ basis, ksh, xk, lsh, xl,
|
||||
c$$$ $ eri)
|
||||
c$$$c
|
||||
c$$$c Print the integrals out
|
||||
c$$$c
|
||||
c$$$ if (.not. bas_cn2bfr(basis, ish, ilo,ihi))
|
||||
c$$$ $ call errquit('print_integ: cn2bf?',0)
|
||||
c$$$ if (.not. bas_cn2bfr(basis, jsh, jlo,jhi))
|
||||
c$$$ $ call errquit('print_integ: cn2bf?',0)
|
||||
c$$$ if (.not. bas_cn2bfr(basis, ksh, klo,khi))
|
||||
c$$$ $ call errquit('print_integ: cn2bf?',0)
|
||||
c$$$ if (.not. bas_cn2bfr(basis, lsh, llo,lhi))
|
||||
c$$$ $ call errquit('print_integ: cn2bf?',0)
|
||||
c$$$c
|
||||
c$$$ ijkl = 0
|
||||
c$$$ do i = ilo, ihi
|
||||
c$$$ do j = jlo, jhi
|
||||
c$$$ do k = klo, khi
|
||||
c$$$ do l = llo, lhi
|
||||
c$$$ ijkl = ijkl + 1
|
||||
c$$$ if (abs(eri(ijkl)) .gt. 1e-6)
|
||||
c$$$ $ write(6,1) i,j,k,l,
|
||||
c$$$ $ eri(ijkl)
|
||||
c$$$ sum = sum + abs(eri(ijkl))
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$ enddo
|
||||
c$$$c
|
||||
c$$$ 1 format(4i6,f20.9)
|
||||
c$$$
|
||||
c$$$ write(6,*) ' SUM of integrals ', sum
|
||||
c$$$
|
||||
c$$$ if (.not. geom_destroy(geom))
|
||||
c$$$ $ call errquit('print_integs: geom_destroy failed', 0)
|
||||
c$$$ if (.not.bas_destroy(basis))
|
||||
c$$$ $ call errquit('print_integs: basis destroy failed', 0)
|
||||
c$$$c
|
||||
end
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
#$Id: GNUmakefile,v 1.7 1995-02-02 23:12:46 d3g681 Exp $
|
||||
|
||||
LIBRARY = libutil.a
|
||||
#LIBRARY = libgeom.a
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
block data geom_data
|
||||
C$Id: geom.F,v 1.31 1995-02-02 23:12:40 d3g681 Exp $
|
||||
implicit none
|
||||
#include "geomP.fh"
|
||||
c
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
logical geom_check_handle
|
||||
C$Id: geom.fh,v 1.11 1995-02-02 23:12:41 d3g681 Exp $
|
||||
logical geom_check_cent
|
||||
logical geom_rtdb_load
|
||||
logical geom_rtdb_store
|
||||
|
|
|
|||
|
|
@ -95,6 +95,7 @@ c elements(1:nelements) = names of elements
|
|||
c
|
||||
integer max_geom, max_cent, max_geom_rtdb, nelements,
|
||||
$ max_sym_ops
|
||||
C$Id: geomP.fh,v 1.7 1995-02-02 23:12:42 d3g681 Exp $
|
||||
parameter (max_sym_ops = 192)
|
||||
parameter (max_geom=2, max_geom_rtdb = 100)
|
||||
parameter (max_cent=500)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ c
|
|||
c The lattice constants are input and stored in Angstroms and Degrees
|
||||
c***********************************************************************
|
||||
subroutine geom_3d(geom)
|
||||
C$Id: geom_3d.F,v 1.3 1995-02-02 23:12:44 d3g681 Exp $
|
||||
implicit none
|
||||
#include "inp.fh"
|
||||
#include "geom.fh"
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
subroutine geom_input(rtdb)
|
||||
C$Id: geom_input.F,v 1.16 1995-02-02 23:12:45 d3g681 Exp $
|
||||
implicit none
|
||||
#include "inp.fh"
|
||||
#include "geom.fh"
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
$ g_dens, g_wdens, basis, geom, nproc, nat,
|
||||
$ max_at_bf, rtdb )
|
||||
|
||||
C$Id: grad1.F,v 1.6 1995-02-02 23:14:50 d3g681 Exp $
|
||||
implicit real*8 (a-h,o-z)
|
||||
|
||||
#include "mafdecls.h"
|
||||
|
|
|
|||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue