1#ifdef USE_SIMINT
2      subroutine nwcsim_init(rtdb,nbas,bases,num_der)
3      use nwcsim_shell
4      implicit none
5#include "bas.fh"
6#include "geom.fh"
7#include "basP.fh"
8#include "basdeclsP.fh"
9#include "geomP.fh"
10#include "geobasmapP.fh"
11#include "apiP.fh"
12#include "errquit.fh"
13#include "mafdecls.fh"
14#include "global.fh"
15#include "rtdb.fh"
16#include "stdio.fh"
17#include "nwcsim.fh"
18c      use iso_c_binding
19      integer rtdb,nbas,bases(3)
20      integer :: num_der
21c      type(c_simint_multi_shellpair), target :: msh
22      double precision :: alpha(3), coef(3)
23      integer :: ibasis,basis,bas
24      logical cart_2_sphe
25      integer :: geom, natoms
26      integer :: max_der, max_ang
27      integer :: mxmx
28      integer :: iat,icset,ic1,ic2, nprim
29      integer :: l, ncontr, isphere
30      character*16 tag
31      integer l_coef,k_coef,l_exp,k_exp
32      double precision coord(3)
33      double precision q
34      integer nwcsim_maxam
35      external nwcsim_maxam
36      character*14 pname
37      pname="nwcsim_f90init"
38c     fetch stuff from rtdb
39      if (.not.rtdb_get(rtdb,'int:smnt_screen_tol',MT_DBL,1,
40     s     smnt_screen_tol))  smnt_screen_tol=1d-22
41#define SIMINT_SCREEN_NONE         0
42#define SIMINT_SCREEN_SCHWARZ      1
43#define SIMINT_SCREEN_FASTSCHWARZ  2
44      if (.not.rtdb_get(rtdb,'int:smnt_screen_method',MT_INT,1,
45     s     smnt_screen_method))  smnt_screen_method=
46     S     SIMINT_SCREEN_FASTSCHWARZ
47c reset screen_tol when screening is off
48      if(smnt_screen_method.eq.SIMINT_SCREEN_NONE)smnt_screen_tol=0d0
49
50c     stick to nbas>=2 for now
51         if(nbas.gt.2) call errquit(
52     C        ' simint interface not ready for no basis gt 2',0,0)
53c     init
54      max_der=0
55#ifdef SIMINT_GRADIENT
56      max_der=1
57#endif
58      if(num_der.gt.max_der) call errquit(
59     C        ' simint interface not ready for derivative ',
60     D num_der,0)
61      if(.not.nwcsim_initialized) then
62      call simint_init()
63c     needed for 1-e integrals
64      call igamma_init()
65
66      nwcsim_initialized=.true.
67c
68c     create shells simint structure
69c
70      nwcsim_nbas=nbas
71      do ibasis=1,nbas
72         basis = bases(ibasis)
73         bas = basis + BASIS_HANDLE_OFFSET
74         nwcsim_bas(ibasis)=bas
75c     offset=-565
76         cart_2_sphe=bas_spherical(bas)
77         if (.not.bas_nprim_cn_max(basis, mxmx))
78     C        call errquit(' bas_nprim_cn_max failed ',0,BASIS_ERR)
79         if (.not. MA_Push_Get(MT_Dbl,mxmx,'simexp',l_exp,k_exp))
80     C        call errquit(' simint wrk ',mxmx,MA_ERR)
81         if (.not. MA_Push_Get(MT_Dbl,mxmx,'simcoef',l_coef,k_coef))
82     C        call errquit(' simint wrk ',mxmx, MA_ERR)
83         geom  = ibs_geom(bas)
84c
85         natoms   =  ncenter(geom)
86         nwcsim_noshell(bas)=0
87         max_ang=0
88         do iat=1,natoms
89            if (.not.bas_ce2cnr(basis,iat,ic1,ic2))
90     &           call errquit(pname//'Exiting ',11, BASIS_ERR)
91            do icset = ic1,ic2
92               if (.not.bas_continfo(basis, icset,
93     &              l, nprim, ncontr, isphere))
94     &              call errquit(pname//'Exiting ',3, BASIS_ERR)
95               if(l.gt.nwcsim_maxam()) call errquit(
96     p              pname//' simint library maxam too small ',
97     p              nwcsim_maxam(),BASIS_ERR)
98               max_ang=max(l,max_ang)
99               if (.not.bas_get_exponent(basis, icset, dbl_mb(k_exp)))
100     &              call errquit(pname//'Exiting ',7, BASIS_ERR)
101               if(.not. bas_get_coeff(basis,icset,dbl_mb(k_coef)))
102     &              call errquit(pname//'Exiting ',8, BASIS_ERR)
103               if (.not. geom_cent_get(geom, iat, tag,
104     &              coord, q))call errquit
105               nwcsim_noshell(bas)=nwcsim_noshell(bas)+1
106               call simint_initialize_shell(
107     S              smnt_sh(nwcsim_noshell(bas),bas))
108
109               call simint_create_shell(nprim, l ,
110     C              coord(1), coord(2), coord(3),
111     &              dbl_mb(k_exp), dbl_mb(k_coef),
112     L              smnt_sh(nwcsim_noshell(bas),bas))
113c     dummy shell for 3c-
114               dbl_mb(k_exp)=0d0
115               dbl_mb(k_coef)=1d0
116               call simint_create_shell(1, 0 ,
117     C              coord(1), coord(2), coord(3),
118     &              dbl_mb(k_exp), dbl_mb(k_coef),
119     L              zero_sh(nwcsim_noshell(bas),bas))
120            enddo
121         enddo
122         if(.not.ma_chop_stack(l_exp)) call errquit(
123     E        ' pop stack failed ',l_exp,0)
124c
125c     memory allocation
126c
127         isz_2e4c = max(isz_2e4c,
128     S        simint_eri_worksize(num_der, max_ang))
129         mem_2e4c = max(mem_2e4c,
130     S        simint_eri_workmem(num_der, max_ang))
131      enddo ! basis loop
132      endif
133c
134c     normalization not needed since nwchem and simint use the same
135cedo      call simint_normalize_shells(nwcsim_noshell,smnt_sh)
136c     SIMINT_PRIM_SCREEN_STAT needs 4 more doubles
137c      isz_2e4c        = isz_2e4c + 4
138c
139      call util_align(isz_2e4c,SIMINT_SIMD_LEN)
140      call util_align(mem_2e4c,SIMINT_SIMD_LEN)
141c
142      iszb_2e4c=isz_2e4c
143
144      if(num_der.eq.1) then
145         memb_2e4c = mem_2e4c + mem_2e4c/5
146      else
147         memb_2e4c = mem_2e4c + mem_2e4c/10 ! +10% to be safe
148      endif
149      call util_align(memb_2e4c,SIMINT_SIMD_LEN)
150      mem_2e3c = mem_2e4c
151      mem_2e2c = mem_2e4c
152      if(ga_nodeid().eq.0) then
153         write(luout,*)
154         write(luout,*) ' Using Simint Integral package'
155         write(luout,*) ' num_der',num_der
156         write(luout,*) ' simint: mem_2e4c    ',mem_2e4c
157         write(luout,*) ' simint: memb_2e4c   ',memb_2e4c
158         write(luout,*) ' simint: isz_2e4c   ',isz_2e4c
159         write(luout,*) ' simint: iszb_2e4c  ',iszb_2e4c
160         write(luout,*) ' screen_method ',smnt_screen_method
161         write(luout,*) ' screen_tol ',smnt_screen_tol
162         write(luout,*)
163         call util_flush(luout)
164      endif
165
166      return
167      end
168      subroutine nwcsim_terminate()
169      use nwcsim_shell
170      implicit none
171#include "errquit.fh"
172      integer nbas     ! [in]
173      integer bases(3) ! [in]
174c
175      integer icsh,ibasis,bas
176      character*14 pname
177      pname="nwcsim_termina"
178c
179      if(nwcsim_initialized) then
180      do ibasis=1,nwcsim_nbas
181         bas=nwcsim_bas(ibasis)
182            do icsh=1,nwcsim_noshell(bas)
183               call simint_free_shell(smnt_sh(icsh,bas))
184               call simint_free_shell(zero_sh(icsh,bas))
185            enddo
186      enddo
187      endif
188      call simint_finalize()
189      nwcsim_initialized=.false.
190      return
191      end
192      integer function nwcsim_maxam()
193      implicit none
194c
195      nwcsim_maxam=SIMINT_MAXAM
196      return
197      end
198      logical function nwcsim_initdone()
199      use nwcsim_shell
200      implicit none
201c
202      nwcsim_initdone=nwcsim_initialized
203      return
204      end
205#else
206c
207c     stubs when simint is not used
208c
209      subroutine nwcsim_init(rtdb,nbas,bases)
210      implicit none
211#include "errquit.fh"
212      integer rtdb,nbas,bases
213      return
214      end
215      subroutine nwcsim_terminate(nbas,bases)
216      implicit none
217#include "errquit.fh"
218      integer nbas,bases
219      return
220      end
221      logical function  nwcsim_initdone()
222      implicit none
223c
224      nwcsim_initdone=.false.
225      return
226      end
227      integer function nwcsim_maxam()
228      implicit none
229c
230      nwcsim_maxam=-1
231      return
232      end
233#endif
234      logical function int_forcenwints(rtdb,rtdb_errmsg)
235      implicit none
236#include "rtdb.fh"
237#include "mafdecls.fh"
238#include "errquit.fh"
239#include "stdio.fh"
240#include "global.fh"
241      integer rtdb
242      character*(*) rtdb_errmsg
243c
244      logical out1
245c
246      int_forcenwints=.false.
247c     Force texas integrals to false for CAM calculations
248      if (.not.rtdb_put(rtdb,'int:cando_txs',mt_log,1,.false.))
249     &     then
250         rtdb_errmsg='cannot set int:cando_txs'
251         return
252      endif
253c     unset cando_nw if defined to avoid Simint
254      if (rtdb_get(rtdb,'int:cando_nw',mt_log,1,out1)) then
255         if (.not.rtdb_delete(rtdb,'int:cando_nw')) then
256            rtdb_errmsg='cannot del int:cando_nw'
257            return
258         endif
259         if(ga_nodeid().eq.0) write(luout,*) ' cando_nw unset'
260      endif
261      int_forcenwints=.true.
262      call ga_sync()
263      return
264      end
265      logical function int_disablesim(rtdb,rtdb_errmsg)
266      implicit none
267#include "rtdb.fh"
268#include "mafdecls.fh"
269#include "errquit.fh"
270#include "stdio.fh"
271#include "global.fh"
272      integer rtdb
273      character*(*) rtdb_errmsg
274c
275      logical cando_txs,cando_nw
276c
277      int_disablesim=.false.
278c
279c     check if simint is enabled:
280c     cando_nw=f & cando_txs=f
281c     not needed if Simint is not enabled
282c
283#ifdef USE_SIMINT
284      if (.not.rtdb_get(rtdb,'int:cando_txs',mt_log,1,cando_txs))
285     &  cando_txs=.true.
286      if (.not.rtdb_get(rtdb,'int:cando_nw',mt_log,1,cando_txs))
287     &  cando_nw=.true.
288c     unset cando_nw if defined to avoid Simint
289      if((.not.cando_txs).and.(.not.cando_nw)) then
290         if (.not.rtdb_delete(rtdb,'int:cando_nw')) then
291            rtdb_errmsg='cannot del int:cando_nw'
292            return
293         endif
294         if(ga_nodeid().eq.0) write(luout,*) ' cando_nw unset'
295         if (.not.rtdb_delete(rtdb,'int:cando_txs')) then
296            rtdb_errmsg='cannot del int:cando_txs'
297            return
298         endif
299         if(ga_nodeid().eq.0) write(luout,*) ' cando_txs unset'
300      endif
301#endif
302      int_disablesim=.true.
303      call ga_sync()
304      return
305      end
306
307