1c $Id$
2*
3C> \ingroup nwint
4C> @{
5C>
6C> \brief Calculate the number of integrals for a given
7C> shell quartet
8C>
9C> This is an internal routine which should never be called by an
10C> NWChem application module directly.
11C>
12C> This routine computes the number of integrals for a given
13C> shell/contraction grouping; if an input shell is zero then
14C> the routine ignores this shell.  This routine works
15C> for both cartesian and spherical basis sets.
16C>
17c:tex-% this is an internal API routine
18c:tex-\subsection{int\_nint}
19c:tex-This routine computes the number of integrals for a given
20c:tex-shell/contraction grouping; if an input shell is zero then
21c:tex-the routine ignores this shell.  This routine will work
22c:tex-for both cartesian and spherical basis sets.
23c:tex-This routine should never be called by an NWChem
24c:tex-application module.
25c:tex-
26c:tex-{\it Syntax:}
27c:tex-\begin{verbatim}
28      integer function int_nint(ibasin,icnt,jbasin,jcnt,
29     &       kbasin,kcnt,lbasin,lcnt)
30c:tex-\end{verbatim}
31      implicit none
32c
33c
34#include "bas.fh"
35#include "errquit.fh"
36c::passed
37c:tex-\begin{verbatim}
38      integer ibasin   !< [Input] basis set handle for icnt
39      integer icnt     !< [Input] contraction index (e.g., ish)
40      integer jbasin   !< [Input] basis set handle for jcnt
41      integer jcnt     !< [Input] contraction index (e.g., jsh)
42      integer kbasin   !< [Input] basis set handle for kcnt
43      integer kcnt     !< [Input] contraction index (e.g., ksh)
44      integer lbasin   !< [Input] basis set handle for lcnt
45      integer lcnt     !< [Input] contraction index (e.g., lsh)
46c:tex-\end{verbatim}
47c::local
48      integer hi,lo,nbf
49c
50      if (
51     &    icnt.eq.jcnt.and.
52     &    jcnt.eq.kcnt.and.
53     &    kcnt.eq.lcnt.and.
54     &    icnt.eq.0
55     &   ) then
56        int_nint = 0
57        return
58      endif
59c
60      int_nint = 1
61c
62c..icnt/ish
63      if (icnt.gt.0) then
64        if (.not.bas_cn2bfr(ibasin,icnt,lo,hi))
65     &         call errquit('int_nint: bas_cn2bfr failure',911,
66     &           INT_ERR)
67        nbf = hi - lo + 1
68        int_nint = int_nint*nbf
69      endif
70c
71c..jcnt/jsh
72      if (jcnt.gt.0) then
73        if (.not.bas_cn2bfr(jbasin,jcnt,lo,hi))
74     &         call errquit('int_nint: bas_cn2bfr failure',911,
75     &         INT_ERR)
76        nbf = hi - lo + 1
77        int_nint = int_nint*nbf
78      endif
79c
80c..kcnt/ksh
81      if (kcnt.gt.0) then
82        if (.not.bas_cn2bfr(kbasin,kcnt,lo,hi))
83     &         call errquit('int_nint: bas_cn2bfr failure',911, INT_ERR)
84        nbf = hi - lo + 1
85        int_nint = int_nint*nbf
86      endif
87c
88c..lcnt/lsh
89      if (lcnt.gt.0) then
90        if (.not.bas_cn2bfr(lbasin,lcnt,lo,hi))
91     &         call errquit('int_nint: bas_cn2bfr failure',911, INT_ERR)
92        nbf = hi - lo + 1
93        int_nint = int_nint*nbf
94      endif
95      end
96C>
97C> \brief Calculate the number of integrals for a given
98C> quartet of unique shells
99C>
100C> This is an internal routine which should never be called by an
101C> NWChem application module directly.
102C>
103C> This routine computes the number of integrals for a given
104C> shell/contraction grouping; if an input shell is zero then
105C> the routine ignores this shell. The input shell must be a
106C> unique shell in the sense of the basis set API. This routine
107C> works for both cartesian and spherical basis sets.
108C>
109c:tex-% this is an internal API routine
110c:tex-\subsection{int\_unint}
111c:tex-This routine computes the number of integrals for a given
112c:tex-shell/contraction grouping; if an input shell is zero then
113c:tex-the routine ignores this shell.  The input shell must be a
114c:tex-unique shell in the sense of the basis set API.  This
115c:tex-routine will work for both cartesian and spherical basis sets.
116c:tex-This routine should never be called by an NWChem
117c:tex-application module.
118c:tex-
119c:tex-{\it Syntax:}
120c:tex-\begin{verbatim}
121      integer function int_unint(ibasin,icnt,jbasin,jcnt,
122     &       kbasin,kcnt,lbasin,lcnt)
123c:tex-\end{verbatim}
124      implicit none
125c
126c::functions
127      integer nbf_from_ucont
128      external nbf_from_ucont
129c::passed
130c:tex-\begin{verbatim}
131      integer ibasin   !< [Input] basis set handle for icnt
132      integer icnt     !< [Input] unique contraction index (e.g., ish)
133      integer jbasin   !< [Input] basis set handle for jcnt
134      integer jcnt     !< [Input] unique contraction index (e.g., jsh)
135      integer kbasin   !< [Input] basis set handle for kcnt
136      integer kcnt     !< [Input] unique contraction index (e.g., ksh)
137      integer lbasin   !< [Input] basis set handle for lcnt
138      integer lcnt     !< [Input] unique contraction index (e.g., lsh)
139c:tex-\end{verbatim}
140c::local
141      integer nbf
142c
143      if (
144     &    icnt.eq.jcnt.and.
145     &    jcnt.eq.kcnt.and.
146     &    kcnt.eq.lcnt.and.
147     &    icnt.eq.0
148     &   ) then
149        int_unint = 0
150        return
151      endif
152c
153      int_unint = 1
154c
155c..icnt/ish
156      if (icnt.gt.0) then
157        nbf = nbf_from_ucont(icnt,ibasin)
158        int_unint = int_unint*nbf
159      endif
160c
161c..jcnt/jsh
162      if (jcnt.gt.0) then
163        nbf = nbf_from_ucont(jcnt,jbasin)
164        int_unint = int_unint*nbf
165      endif
166c
167c..kcnt/ksh
168      if (kcnt.gt.0) then
169        nbf = nbf_from_ucont(kcnt,kbasin)
170        int_unint = int_unint*nbf
171      endif
172c
173c..lcnt/lsh
174      if (lcnt.gt.0) then
175        nbf = nbf_from_ucont(lcnt,lbasin)
176        int_unint = int_unint*nbf
177      endif
178      end
179C>
180C> \brief Calculate the number of cartesian integrals for a given
181C> shell quartet
182C>
183C> This is an internal routine which should never be called by an
184C> NWChem application module directly.
185C>
186C> This routine computes the number of integrals for a given
187C> shell/contraction grouping; if an input shell is zero then
188C> the routine ignores this shell.  This routine will work
189C> for both cartesian and spherical basis sets. However, in either
190C> case it will calculate the number of integrals as if the basis sets
191C> were cartesian. The reason for this is that in the case of
192C> spherical harmonic basis sets the integral codes calculate the
193C> cartesian integrals first and transform them to spherical harmonics.
194C> Because of this all buffers have to be large enough to hold the
195C> larger sets of cartesian integrals that are calculated as
196C> intermediates.
197C>
198c:tex-% this is an internal API routine
199c:tex-\subsection{int\_nint\_cart}
200c:tex-This routine computes the number of integrals for a given
201c:tex-shell/contraction grouping; if an input shell is zero then
202c:tex-the routine ignores this shell.  This
203c:tex-routine will work for both cartesian and spherical basis
204c:tex-sets, but {\it returns the cartesian size} (this is how the
205c:tex-integrals are computed!).
206c:tex-This routine should never be called by an NWChem
207c:tex-application module.
208c:tex-
209c:tex-{\it Syntax:}
210c:tex-\begin{verbatim}
211      integer function int_nint_cart(ibasin,icnt,jbasin,jcnt,
212     &       kbasin,kcnt,lbasin,lcnt)
213c:tex-\end{verbatim}
214      implicit none
215#include "errquit.fh"
216#include "bas.fh"
217#include "nwc_const.fh"
218#include "int_nbf.fh"
219c
220c::passed
221c:tex-\begin{verbatim}
222      integer ibasin   !< [Input] basis set handle for icnt
223      integer icnt     !< [Input] contraction index (e.g., ish)
224      integer jbasin   !< [Input] basis set handle for jcnt
225      integer jcnt     !< [Input] contraction index (e.g., jsh)
226      integer kbasin   !< [Input] basis set handle for kcnt
227      integer kcnt     !< [Input] contraction index (e.g., ksh)
228      integer lbasin   !< [Input] basis set handle for lcnt
229      integer lcnt     !< [Input] contraction index (e.g., lsh)
230c:tex-\end{verbatim}
231c:local
232      integer type, nprim, ngen, spcart
233      integer nbf
234
235      if (
236     &    icnt.eq.jcnt.and.
237     &    jcnt.eq.kcnt.and.
238     &    kcnt.eq.lcnt.and.
239     &    icnt.eq.0
240     &   ) then
241        int_nint_cart = 0
242        return
243      endif
244
245      int_nint_cart = 1
246
247
248c..icnt/ish
249      if (icnt.gt.0) then
250        if (.not.bas_continfo(ibasin,icnt,type,nprim,ngen,spcart))
251     &         call errquit('int_nint_cart: bas_continfo failure',911,
252     &              INT_ERR)
253        nbf = int_nbf_x(type)*ngen
254        int_nint_cart = int_nint_cart*nbf
255      endif
256c
257c..jcnt/jsh
258      if (jcnt.gt.0) then
259        if (.not.bas_continfo(jbasin,jcnt,type,nprim,ngen,spcart))
260     &         call errquit('int_nint_cart: bas_continfo failure',911,
261     &               INT_ERR)
262        nbf = int_nbf_x(type)*ngen
263        int_nint_cart = int_nint_cart*nbf
264      endif
265c
266c..kcnt/ksh
267      if (kcnt.gt.0) then
268        if (.not.bas_continfo(kbasin,kcnt,type,nprim,ngen,spcart))
269     &         call errquit('int_nint_cart: bas_continfo failure',911,
270     &              INT_ERR)
271        nbf = int_nbf_x(type)*ngen
272        int_nint_cart = int_nint_cart*nbf
273      endif
274c
275c..lcnt/lsh
276      if (lcnt.gt.0) then
277        if (.not.bas_continfo(lbasin,lcnt,type,nprim,ngen,spcart))
278     &         call errquit('int_nint_cart: bas_continfo failure',911,
279     &                 INT_ERR)
280        nbf = int_nbf_x(type)*ngen
281        int_nint_cart = int_nint_cart*nbf
282      endif
283      end
284C>
285C> \brief Calculate the number of cartesian integrals for a given
286C> quartet of unique shells
287C>
288C> This is an internal routine which should never be called by an
289C> NWChem application module directly.
290C>
291C> This routine computes the number of integrals for a given
292C> shell/contraction grouping; if an input shell is zero then
293C> the routine ignores this shell. The shells have to be unique
294C> shells in the sense of the basis set API. This routine will work
295C> for both cartesian and spherical basis sets. However, in either
296C> case it will calculate the number of integrals as if the basis sets
297C> were cartesian. The reason for this is that in the case of
298C> spherical harmonic basis sets the integral codes calculate the
299C> cartesian integrals first and transform them to spherical harmonics.
300C> Because of this all buffers have to be large enough to hold the
301C> larger sets of cartesian integrals that are calculated as
302C> intermediates.
303C>
304c:tex-% this is an internal API routine
305c:tex-\subsection{int\_unint\_cart}
306c:tex-This routine computes the number of integrals for a given
307c:tex-shell/contraction grouping; if an input shell is zero then
308c:tex-the routine ignores this shell.  The input shell must be a
309c:tex-unique shell in the sense of the basis set API.  This
310c:tex-routine will work for both cartesian and spherical basis
311c:tex-sets, but {\it returns the cartesian size} (this is how the
312c:tex-integrals are computed!).
313c:tex-This routine should never be called by an NWChem
314c:tex-application module.
315c:tex-
316c:tex-{\it Syntax:}
317c:tex-\begin{verbatim}
318      integer function int_unint_cart(ibasin,icnt,jbasin,jcnt,
319     &       kbasin,kcnt,lbasin,lcnt)
320c:tex-\end{verbatim}
321      implicit none
322#include "errquit.fh"
323#include "nwc_const.fh"
324#include "int_nbf.fh"
325c
326c::passed
327c:tex-\begin{verbatim}
328      integer ibasin   !< [Input] basis set handle for icnt
329      integer icnt     !< [Input] unique contraction index (e.g., ish)
330      integer jbasin   !< [Input] basis set handle for jcnt
331      integer jcnt     !< [Input] unique contraction index (e.g., jsh)
332      integer kbasin   !< [Input] basis set handle for kcnt
333      integer kcnt     !< [Input] unique contraction index (e.g., ksh)
334      integer lbasin   !< [Input] basis set handle for lcnt
335      integer lcnt     !< [Input] unique contraction index (e.g., lsh)
336c:tex-\end{verbatim}
337c::local
338      integer type, nprim, ngen, spcart
339      integer nbf
340c::functions
341      logical  bas_ucontinfo
342      external bas_ucontinfo
343
344      if (
345     &    icnt.eq.jcnt.and.
346     &    jcnt.eq.kcnt.and.
347     &    kcnt.eq.lcnt.and.
348     &    icnt.eq.0
349     &   ) then
350        int_unint_cart = 0
351        return
352      endif
353
354      int_unint_cart = 1
355
356
357c..icnt/ish
358      if (icnt.gt.0) then
359        if (.not.bas_ucontinfo(ibasin,icnt,type,nprim,ngen,spcart))
360     &         call errquit('int_unint_cart: bas_ucontinfo failure',911,
361     &           INT_ERR)
362        nbf = int_nbf_x(type)*ngen
363        int_unint_cart = int_unint_cart*nbf
364      endif
365c
366c..jcnt/jsh
367      if (jcnt.gt.0) then
368        if (.not.bas_ucontinfo(jbasin,jcnt,type,nprim,ngen,spcart))
369     &         call errquit('int_unint_cart: bas_ucontinfo failure',911,
370     &            INT_ERR)
371        nbf = int_nbf_x(type)*ngen
372        int_unint_cart = int_unint_cart*nbf
373      endif
374c
375c..kcnt/ksh
376      if (kcnt.gt.0) then
377        if (.not.bas_ucontinfo(kbasin,kcnt,type,nprim,ngen,spcart))
378     &         call errquit('int_unint_cart: bas_ucontinfo failure',911,
379     &            INT_ERR)
380        nbf = int_nbf_x(type)*ngen
381        int_unint_cart = int_unint_cart*nbf
382      endif
383c
384c..lcnt/lsh
385      if (lcnt.gt.0) then
386        if (.not.bas_ucontinfo(lbasin,lcnt,type,nprim,ngen,spcart))
387     &         call errquit('int_unint_cart: bas_ucontinfo failure',911,
388     &          INT_ERR)
389        nbf = int_nbf_x(type)*ngen
390        int_unint_cart = int_unint_cart*nbf
391      endif
392      end
393* not used :      integer function int_nint_raw(ibasin,icnt,jbasin,jcnt,
394* not used :     &       kbasin,kcnt,lbasin,lcnt)
395* not used :      implicit none
396* not used :#include "bas.fh"
397* not used :#include "nwc_const.fh"
398* not used :#include "int_nbf.fh"
399* not used :c
400* not used :c::passed
401* not used :      integer ibasin   ! [input] basis set handle for icnt
402* not used :      integer icnt     ! [input] contraction index (e.g., ish)
403* not used :      integer jbasin   ! [input] basis set handle for jcnt
404* not used :      integer jcnt     ! [input] contraction index (e.g., jsh)
405* not used :      integer kbasin   ! [input] basis set handle for kcnt
406* not used :      integer kcnt     ! [input] contraction index (e.g., ksh)
407* not used :      integer lbasin   ! [input] basis set handle for lcnt
408* not used :      integer lcnt     ! [input] contraction index (e.g., lsh)
409* not used :c:local
410* not used :      integer type, nprim, ngen, spcart
411* not used :      integer nbf
412* not used :
413* not used :      if (
414* not used :     &    icnt.eq.jcnt.and.
415* not used :     &    jcnt.eq.kcnt.and.
416* not used :     &    kcnt.eq.lcnt.and.
417* not used :     &    icnt.eq.0
418* not used :     &   ) then
419* not used :        int_nint_raw = 0
420* not used :        return
421* not used :      endif
422* not used :
423* not used :      int_nint_raw = 1
424* not used :
425* not used :
426* not used :c..icnt/ish
427* not used :      if (icnt.gt.0) then
428* not used :        if (.not.bas_continfo(ibasin,icnt,type,nprim,ngen,spcart))
429* not used :     &         call errquit('int_nint_raw: bas_continfo failure',911)
430* not used :        nbf = int_nbf_x(type)
431* not used :        int_nint_raw = int_nint_raw*nbf
432* not used :      endif
433* not used :c
434* not used :c..jcnt/jsh
435* not used :      if (jcnt.gt.0) then
436* not used :        if (.not.bas_continfo(jbasin,jcnt,type,nprim,ngen,spcart))
437* not used :     &         call errquit('int_nint_raw: bas_continfo failure',911)
438* not used :        nbf = int_nbf_x(type)
439* not used :        int_nint_raw = int_nint_raw*nbf
440* not used :      endif
441* not used :c
442* not used :c..kcnt/ksh
443* not used :      if (kcnt.gt.0) then
444* not used :        if (.not.bas_continfo(kbasin,kcnt,type,nprim,ngen,spcart))
445* not used :     &         call errquit('int_nint_raw: bas_continfo failure',911)
446* not used :        nbf = int_nbf_x(type)
447* not used :        int_nint_raw = int_nint_raw*nbf
448* not used :      endif
449* not used :c
450* not used :c..lcnt/lsh
451* not used :      if (lcnt.gt.0) then
452* not used :        if (.not.bas_continfo(lbasin,lcnt,type,nprim,ngen,spcart))
453* not used :     &         call errquit('int_nint_raw: bas_continfo failure',911)
454* not used :        nbf = int_nbf_x(type)
455* not used :        int_nint_raw = int_nint_raw*nbf
456* not used :      endif
457* not used :      end
458* not used :      integer function int_unint_raw(ibasin,icnt,jbasin,jcnt,
459* not used :     &       kbasin,kcnt,lbasin,lcnt)
460* not used :      implicit none
461* not used :#include "nwc_const.fh"
462* not used :#include "int_nbf.fh"
463* not used :c
464* not used :c::passed
465* not used :      integer ibasin   ! [input] basis set handle for icnt
466* not used :      integer icnt     ! [input] contraction index (e.g., ish)
467* not used :      integer jbasin   ! [input] basis set handle for jcnt
468* not used :      integer jcnt     ! [input] contraction index (e.g., jsh)
469* not used :      integer kbasin   ! [input] basis set handle for kcnt
470* not used :      integer kcnt     ! [input] contraction index (e.g., ksh)
471* not used :      integer lbasin   ! [input] basis set handle for lcnt
472* not used :      integer lcnt     ! [input] contraction index (e.g., lsh)
473* not used :c::local
474* not used :      integer type, nprim, ngen, spcart
475* not used :      integer nbf
476* not used :c::functions
477* not used :      logical  bas_ucontinfo
478* not used :      external bas_ucontinfo
479* not used :
480* not used :      if (
481* not used :     &    icnt.eq.jcnt.and.
482* not used :     &    jcnt.eq.kcnt.and.
483* not used :     &    kcnt.eq.lcnt.and.
484* not used :     &    icnt.eq.0
485* not used :     &   ) then
486* not used :        int_unint_raw = 0
487* not used :        return
488* not used :      endif
489* not used :
490* not used :      int_unint_raw = 1
491* not used :
492* not used :
493* not used :c..icnt/ish
494* not used :      if (icnt.gt.0) then
495* not used :        if (.not.bas_ucontinfo(ibasin,icnt,type,nprim,ngen,spcart))
496* not used :     &         call errquit('int_unint_raw: bas_ucontinfo failure',911)
497* not used :        nbf = int_nbf_x(type)
498* not used :        int_unint_raw = int_unint_raw*nbf
499* not used :      endif
500* not used :c
501* not used :c..jcnt/jsh
502* not used :      if (jcnt.gt.0) then
503* not used :        if (.not.bas_ucontinfo(jbasin,jcnt,type,nprim,ngen,spcart))
504* not used :     &         call errquit('int_unint_raw: bas_ucontinfo failure',911)
505* not used :        nbf = int_nbf_x(type)
506* not used :        int_unint_raw = int_unint_raw*nbf
507* not used :      endif
508* not used :c
509* not used :c..kcnt/ksh
510* not used :      if (kcnt.gt.0) then
511* not used :        if (.not.bas_ucontinfo(kbasin,kcnt,type,nprim,ngen,spcart))
512* not used :     &         call errquit('int_unint_raw: bas_ucontinfo failure',911)
513* not used :        nbf = int_nbf_x(type)
514* not used :        int_unint_raw = int_unint_raw*nbf
515* not used :      endif
516* not used :c
517* not used :c..lcnt/lsh
518* not used :      if (lcnt.gt.0) then
519* not used :        if (.not.bas_ucontinfo(lbasin,lcnt,type,nprim,ngen,spcart))
520* not used :     &         call errquit('int_unint_raw: bas_ucontinfo failure',911)
521* not used :        nbf = int_nbf_x(type)
522* not used :        int_unint_raw = int_unint_raw*nbf
523* not used :      endif
524* not used :      end
525C> @}
526