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