1*
2* $Id$
3*
4      logical function raktask_ecppe(rtdb)
5*
6* compute pe matrix with given basis set
7*
8      implicit none
9#include "errquit.fh"
10*::includes
11#include "mafdecls.fh"
12#include "geom.fh"
13#include "bas.fh"
14#include "rtdb.fh"
15*::functions
16      logical int_normalize
17      external int_normalize
18*::passed
19      integer rtdb
20*::local
21      integer geom, basis, nbf, nshells, max1e, mscr, h_buff, k_buff
22      integer h_scr, k_scr, ish, jsh, ilo, ihi, jlo, jhi
23      integer nbfi, nbfj, ish_start, jsh_start
24      raktask_ecppe = .false.
25
26* create geometry handle
27      if (.not.geom_create(geom,'geometry'))
28     &      call errquit('task_ecppe: geom_create failed?',911,
29     &       GEOM_ERR)
30* load geometry from rtdb
31      if (.not.geom_rtdb_load(rtdb,geom,'geometry'))
32     &      call errquit
33     &      ('task_ecppe: geom_rtdb_load failed?',911, RTDB_ERR)
34* create basis set handle
35      if (.not.bas_create(basis,'ao basis'))
36     &      call errquit('task_ecppe: bas_create failed?',911,
37     &       BASIS_ERR)
38* load basis set
39      if (.not.bas_rtdb_load(rtdb,geom,basis,'ao basis'))
40     &      call errquit
41     &      ('task_ecppe: bas_rtdb_load failed?',911, RTDB_ERR)
42c
43* query basis set object for the number of functions and shells
44c
45      if (.not.bas_numbf(basis,nbf)) call errquit
46     &      ('task_ecppe: bas_numbf failed?',911, BASIS_ERR)
47      if (.not.bas_numcont(basis,nshells)) call errquit
48     &      ('task_ecppe: bas_numcont failed?',911, BASIS_ERR)
49*
50*normalize basis set
51      if (.not.int_normalize(rtdb,basis)) call errquit
52     &      ('task_ecppe: int_normalize failed?',911, INT_ERR)
53      if (.not.bas_print(basis)) stop ' err bas_print'
54      if (.not.gbs_map_print(basis)) stop ' err bas_print'
55*
56* initialize the integral API
57      call int_init(rtdb,1,basis)
58*
59* query integral API for memory requirements.
60      call int_mem_1e(max1e, mscr)
61*
62* allocate local memory buffers for integrals and scratch space for
63* the integral API
64      if (.not. ma_push_get(mt_dbl,max1e,'integral buffer',
65     &      h_buff,k_buff)) call errquit
66     &      ('task_ecppe: could not allocat integral buffer',911,
67     &       MA_ERR)
68      if (.not. ma_push_get(mt_dbl,mscr,'integral scratch',
69     &      h_scr,k_scr)) call errquit
70     &      ('task_ecppe: could not allocat integral buffer',911,
71     &       MA_ERR)
72      if (.not.rtdb_get(rtdb,'rak24:ish_start',mt_int,1,ish_start))
73     &    ish_start = 1
74      if (.not.rtdb_get(rtdb,'rak24:jsh_start',mt_int,1,jsh_start))
75     &    jsh_start = 1
76      do ish = ish_start,nshells
77        if (.not.bas_cn2bfr(basis,ish,ilo,ihi)) call errquit
78     &      ('task_ecppe: bas_cn2bfr failed',911, BASIS_ERR)
79        nbfi = ihi - ilo + 1
80        do jsh = jsh_start,nshells
81          if (.not.bas_cn2bfr(basis,jsh,jlo,jhi)) call errquit
82     &        ('task_ecppe: bas_cn2bfr failed',911, BASIS_ERR)
83          nbfj = jhi - jlo + 1
84*...compute it: pe(ilo:ihi,jlo:jhi)
85          call util_flush(6)
86          call dfill(mscr,0.0d00,dbl_mb(k_scr),1)
87          call dfill(max1e,0.0d00,dbl_mb(k_buff),1)
88          write(6,*)'<ish,jsh> = <',ish,',',jsh,'>...'
89          call util_flush(6)
90          call int_1epe(basis,jsh,basis,ish,
91     &        mscr,dbl_mb(k_scr),
92     &        max1e,dbl_mb(k_buff))
93          write(6,*)'<ish,jsh> = <',ish,',',jsh,'>...done'
94          call util_flush(6)
95        enddo
96      enddo
97
98*
99      raktask_ecppe = .true.
100*
101      end
102