1c $Id$
2*
3C> \ingroup nwint
4C> @{
5C>
6C> \brief Initialize the integral 2nd derivatives drivers
7C>
8C> This is the main initialization routine for integral second
9C> derivatives.
10C> Default memory requirements, accuracy thresholds, and other
11C> initializations for all base integral codes are set here.
12C> This routine will read (from the rtdb) any integral
13C> settings changed by the user.
14C>
15c:tex-%API Initialization and Termination Routines
16c:tex-\subsection{intdd\_init}
17c:tex-This is the main initialization routine for integral second
18c:tex-derivatives.
19c:tex-Default memory requirements, accuracy thresholds, and other
20c:tex-initializations for all base integral codes are set here.
21c:tex-This routine will read (from the rtdb) any integral
22c:tex-settings changed by the user.
23c:tex-
24c:tex-{\it Syntax:}
25c:tex-\begin{verbatim}
26      subroutine intdd_init(rtdb,nbas,bases)
27c:tex-\end{verbatim}
28c
29c Initializes integral second derivative code
30c
31      implicit none
32#include "stdio.fh"
33#include "errquit.fh"
34#include "global.fh"
35#include "mafdecls.fh"
36#include "bas.fh"
37#include "apiP.fh"
38#include "rtdb.fh"
39#include "candoP.fh"
40#include "nwc_const.fh"
41#include "int_nbf.fh"
42#include "util.fh"
43c::functions
44      logical  spcart_init
45      external spcart_init
46      logical  int_ecp_init
47      external int_ecp_init
48      logical  texas_check_basis_ok
49      external texas_check_basis_ok
50c::passed
51c:tex-\begin{verbatim}
52      integer rtdb        !< [Input] run time data base handle
53      integer nbas        !< [Input] number of basis sets to be used
54      integer bases(nbas) !< [Input] basis set handles
55c:tex-\end{verbatim}
56c::local
57      integer ibas, ang2use, angm
58      logical status, oprint
59      integer intd_memtmp
60      integer nqmax_texas  ! maximum number of quartets in texas blocking interface
61      parameter (nqmax_texas = 10000)
62      integer txs_mem_min
63      integer type
64      integer nbf2use, nbf2use_test, maxgdd
65      logical cando_txs_deriv
66c
67c
68c     print info/warnings unless print set to none. errors always print.
69c
70      oprint = util_print('information',print_low)
71c
72      call int_mem_zero()
73c
74      DCexp     = 0.0D00
75      DCcoeff   = 1.0D00
76      val_int_acc = 0.0d00
77c
78      if(init_intdd.eq.1 .and. oprint) then
79        write(luout,*)' warning nested intdd_inits'
80        write(luout,*)' intdd_init already called '
81        call util_flush(6)
82      endif
83c
84c initialize type-> nbf maps
85c
86      int_nbf_x(-1) = 4
87      int_nbf_s(-1) = 4
88      do type = 0,int_nbf_max_ang
89        int_nbf_x(type) = (type+1)*(type+2)/2
90        int_nbf_s(type) = 2*type+1
91      enddo
92c
93cTEMPORARY WORKAROUND check for derivative flag intdd:cando_txs
94c
95      cando_txs_deriv = .true.
96      if (rtdb_get(rtdb,'intdd:cando_txs',MT_LOG,1,status))
97     $     cando_txs_deriv = status
98      if (.not.cando_txs_deriv) then
99         call int_app_set_no_texas(rtdb)
100      endif
101c
102c initialize cando information from rtdb
103c
104      user_cando_sp   = .false.
105      user_cando_nw   = .false.
106      user_cando_txs  = .false.
107      user_cando_hnd  = .false.
108      def_cando_sp    = .false.
109      def_cando_nw    = .false.
110      def_cando_txs   = .false.
111      def_cando_hnd   = .false.
112c
113      if (rtdb_get(rtdb,'int:cando_sp',MT_LOG,1,status)) then
114        user_cando_sp = .true.
115        def_cando_sp  = status
116        if (ga_nodeid().eq.0 .and. oprint) then
117          write(luout,*)
118     &        ' intdd_init: cando_sp set to always be ',def_cando_sp
119          call util_flush(6)
120        endif
121      endif
122c
123      if (rtdb_get(rtdb,'int:cando_nw',MT_LOG,1,status)) then
124        user_cando_nw = .true.
125        def_cando_nw  = status
126        if (ga_nodeid().eq.0 .and. oprint) then
127          write(luout,*)
128     &        ' intdd_init: cando_nw set to always be ',def_cando_nw
129          call util_flush(6)
130        endif
131      endif
132c
133      if (rtdb_get(rtdb,'int:cando_txs',MT_LOG,1,status)) then
134        user_cando_txs = .true.
135        def_cando_txs  = status
136        if (ga_nodeid().eq.0 .and. oprint) then
137          write(luout,*)
138     &        ' intdd_init: cando_txs set to always be ',def_cando_txs
139          call util_flush(6)
140        endif
141      endif
142c
143      if (rtdb_get(rtdb,'int:cando_hnd',MT_LOG,1,status)) then
144        user_cando_hnd = .true.
145        def_cando_hnd  = status
146        if (ga_nodeid().eq.0 .and. oprint) then
147          write(luout,*)
148     &        ' intdd_init: cando_hnd set to always be ',def_cando_hnd
149          call util_flush(6)
150        endif
151      endif
152*
153      if (.not.user_cando_txs) then
154        if (.not.texas_check_basis_ok(nbas,bases)) then
155          user_cando_txs = .true.
156          def_cando_txs = .false.
157          if (ga_nodeid().eq.0 .and. oprint) then
158            write(luout,*)
159     &          ' intdd_init: internal texas instability ',
160     &          'possible cando',
161     &          '_txs set to always be ',def_cando_txs
162            call util_flush(6)
163          endif
164        endif
165      endif
166* sanity checking: e.g., you only want to turn off a particular integral
167* code never always turn it on.
168*
169      if (def_cando_sp.or.def_cando_nw.or.def_cando_txs.or.
170     &    def_cando_hnd) then
171        if (ga_nodeid().eq.0) then
172          write(luout,*)' you are trying to turn an integral code on? '
173          write(luout,*)' sp  ', def_cando_sp
174          write(luout,*)' nw  ', def_cando_nw
175          write(luout,*)' txs ', def_cando_txs
176          write(luout,*)' hnd ', def_cando_hnd
177          call util_flush(6)
178        endif
179        call errquit
180     &      ('intdd_init: logic error with user cando settings',911,
181     &        INT_ERR)
182      endif
183      status = .true.
184      do 00100 ibas=1,nbas
185        status = status .and. bas_check_handle(bases(ibas),'intdd_init')
18600100 continue
187      if (.not.status) then
188        write(luout,*)' at least one basis handle not valid'
189        do 00200 ibas = 1,nbas
190          write(luout,'(a,i5)')
191     &           ' basis set handle ',bases(ibas)
19200200   continue
193        call errquit('intdd_init: basis handles hosed ',nbas, INT_ERR)
194      endif
195*      write(luout,*)' intdd_init: basis set handles valid '
196c
197c check for both sp and gc shells
198c
199      call int_bothsp_gc_check(bases,nbas,'intdd_init')
200c
201c initialize defnxyz routines
202c
203      ang2use = -1
204      do 00300 ibas = 1,nbas
205        if(.not.bas_high_angular(bases(ibas),angm))
206     &         call errquit('intdd_init: angm error',angm, INT_ERR)
207        ang2use = max(ang2use,angm)
20800300 continue
209*
210* test for higher than g functions  0123456
211      if (ang2use.ge.7) call errquit
212     &    ('only basis sets with s through g functions are allowed',
213     &    911, INT_ERR)
214*
215c.. for second derivatives add 2
216      call defNxyz(ang2use+2)
217c
218c initialize spcart stuff
219c
220      if (.not.(spcart_init((ang2use+1),.true.,.false.))) then
221        call errquit('intdd_init: spcart_init failed',911, INT_ERR)
222      endif
223c.. read in approximate memory from rtdb
224c.
225c.. parameter is default value used in hf2d
226c.. input memory in words should be scaled by 1/12 for same range
227      intd_memthresh = intd_memp
228      if (rtdb_get(rtdb,'intdd:approxmem',MT_INT,1,intd_memtmp)) then
229        if(ga_nodeid().eq.0)then
230          write(luout,'(/a,i10,a/)')
231     &        ' approximate memory for derivative integrals set to:',
232     &        intd_memtmp
233        endif
234        intd_memthresh = intd_memtmp/12
235      endif
236c
237c... generate memory requirements and store in structures in apiP.fh
238c
239      call exactd_mem(rtdb,bases,nbas)
240      call sp_der_init(nbas,bases)
241      call int_acc_std()
242      if (.not.(user_cando_txs.and.(.not.def_cando_txs))) then
243         call texas_init(rtdb,nbas,bases,nqmax_texas,txs_mem_min,
244     &        'der2_int')
245      endif
246      call hnd_initdd(bases,nbas)
247c
248c    confirm basis set maximum buffer size for second derivatives
249c
250      nbf2use = 0
251      do ibas = 1,nbas
252        if (.not.bas_nbf_cn_max(bases(ibas),nbf2use_test))
253     &      call errquit('intdd_init: bas_nbf_cn_max failed',911,
254     &             INT_ERR)
255        nbf2use = max(nbf2use,nbf2use_test)
256      enddo
257      maxgdd  = 78*nbf2use*nbf2use*nbf2use*nbf2use  ! maxg for 2e2nd derivs
258      nbf2use = maxgdd + maxgdd/10  ! add 10%
259      isz_2e4c = max(isz_2e4c,nbf2use)
260      mem_2e4c = max(mem_2e4c,isz_2e4c)
261      isz_2e3c = maxgdd/nbf2use
262      isz_2e2c = maxgdd/nbf2use/nbf2use
263c
264c See if any basis has an attached ECP
265c
266      any_ecp = .false.
267      ecp_bsh = 0
268      do ibas = 1,nbas
269        if (bas_get_ecp_handle(bases(ibas),ecp_bsh)) then
270          any_ecp = .true.
271          goto 00001
272        endif
273      enddo
27400001 continue
275      if (any_ecp) then
276        if (.not.ecp_check_handle(ecp_bsh,'intdd_init')) call errquit
277     &        ('intdd_init: ecp handle is invalid fatal error',911,
278     &         INT_ERR)
279      endif
280*
281c See if any basis has an attached SO potential
282      any_so = .false.
283      so_bsh = 0
284      do ibas = 1,nbas
285        if (bas_get_so_handle(bases(ibas),so_bsh)) then
286          any_so = .true.
287          goto 00002
288        endif
289      enddo
29000002 continue
291      if (any_so) then
292        if (.not.so_check_handle(so_bsh,'intdd_init')) call errquit
293     &        ('intdd_init: so handle is invalid fatal error',911,
294     &         INT_ERR)
295      endif
296      if (any_so.or.any_ecp) then
297        if (.not.int_ecp_init(ecp_bsh,so_bsh,2)) call errquit
298     &        ('intdd_init: int_ecp_init failed ',911, INT_ERR)
299      endif
300      init_int   = 1
301      init_intd  = 1
302      init_intdd = 1
303      end
304
305C> @}
306