1c $Id$
2C_______________________________________________________
3c OCT.,94 KW changed the order of D-orbitals to the consistent
4C one : xx xy xz yy yz zz
5C
6C Corresponding changes have been made in one-electron part
7C (intcal1.f in this directory).
8C
9C The NMR part has NOT been changed .
10C_______________________________________________________
11      subroutine datlog(inx,ncs,lp1,lp2,lp3,lp4,lp5)
12c    *             hnia,ndege,len,lensm,nfu,icoor,icool,
13c    *             ifrst,ilast,nia,nmxyz,npxyz)
14      implicit real*8 (a-h,o-z)
15#include "errquit.fh"
16c***********************************************
17c* memory for all logical matrices - in commons logicd, logic1-11
18c*
19c*  denote  : maxtyp1=max(itype1)
20c*            itype1=inx(12,ics)
21c*            if(itype1>4) itype1=itype1-1
22c*            if(itype1>5) itype1=itype1-1
23c*
24c*  denote  : mmax=4*ndege(maxtype1)-3
25c*
26c*  Array                  Dimension           Parameter
27c*----------------------------------------------------------
28c*  ndege, len          -  (maxtype1)            lp4
29c*
30c*  nfu                 -   (mmax+1)             lp1
31c*  lensm               -   ( mmax )             lp5
32c
33c*  icoor,icool,
34c*  ifrst,ilast         -   ( nfu(mmax+1) )      lp2
35c*
36c*  nia                 -   ( 3, nfu(mmax+1) )   3 * lp2
37c*  hnia                -   ( 3, nfu(mmax+1) )   3 * lp2
38c*  nmxyz               -   ( 3, nfu(mmax+1) )   3 * lp2
39c*  npxyz               -   ( 3, nfu(mmax  ) )   3 * lp3
40c
41c*
42c*  shells maxtyp1 mmax nfu(mmax) nfu(mmax+1) lp1,2, 3,  4,  5
43c* -------------------------------------------------------------
44c*    ss,ss    1     1      0       1       2,    1,    0,  1,  1
45c*    pp,pp    2     5     20      35       6,   35,   20,  2,  5
46c*    ll,ll    3     5     20      35       6,   35,   20,  3,  5
47c*    dd,dd    4     9    120     165      10,  165,  120,  4,  9
48c*    ff,ff    5    13    364     455      14,  455,  364,  5, 13
49c*    gg,gg    6    17    816     969      18,  969,  816,  6, 17
50c*    hh,hh    7    21   1540     1771     22, 1771, 1540,  7, 21
51c*    ii,ii    8    25   2600     2925     26, 2925, 2600,  8, 25
52c*
53c*
54c* --------------------------------------------------------------
55c dimensions for logical matrices in TWELINT :
56c
57c up to ff,ff :
58c     parameter (lpar1=14,lpar2= 455,lpar3= 364,lpar4=5,lpar5=13)
59c up to gg,gg :
60c     parameter (lpar1=18,lpar2= 969,lpar3= 816,lpar4=6,lpar5=17)
61c up to hh,hh :
62c     parameter (lpar1=22,lpar2=1771,lpar3=1540,lpar4=7,lpar5=21)
63c up to ii,ii :
64c     parameter (lpar1=26,lpar2=2925,lpar3=2600,lpar4=8,lpar5=25)
65c
66c---------------------------------------------------------------
67      dimension inx(12,*)
68cxx
69c     dimension  hnia(3,lp2)
70c     dimension  ndege(lp4)
71c     dimension  len(lp4)
72c     dimension  lensm(lp5)
73c     dimension  nfu(lp1)
74c     dimension  icoor(lp2)
75c     dimension  icool(lp2)
76c     dimension  ifrst(lp2)
77c     dimension  ilast(lp2)
78c     dimension  nia(3,lp2)
79c     dimension  nmxyz(3,lp2)
80c     dimension  npxyz(3,lp3)
81cxx
82Cedo      parameter (lpar1=30,lpar2=4495,lpar3=4060,lpar4=9,lpar5=29)
83#include "texas_lpar.fh"
84cxx
85c
86c     lensm(nsij)=total number of functions up to given nsij
87c************************************************************
88c
89      maxtyp1=0
90      do 10 ics=1,ncs
91      itype=inx(12,ics)
92      itype1=itype
93      if(itype.gt.4) itype1=itype-1
94      if(itype1.gt.5) itype1=itype1-1
95c
96      if(itype1.gt.maxtyp1) maxtyp1=itype1
97   10 continue
98c
99c for derivatives of two-el. integ. :
100       maxtyp1=maxtyp1+2
101c
102c
103c* check if dimensions of logical arrays are correct :
104c
105      if(maxtyp1.gt.lp4) then
106c
107ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
108        call txs_message
109     &      ('datlog :','logic arrays too small,lpar4=',lp4,0)
110        call txs_message
111     &      ('datlog :','take set of parameters with lpar4=',
112     *                maxtyp1,0)
113        call txs_message
114     &      ('datlog :',' make this change in PREPINT2 ',0,0)
115        call txs_message
116     &      ('datlog :',' execution stoped ', 0,0)
117        call errquit('texas:datlog',0, INT_ERR)
118*        stop10
119      endif
120c
121      ndege(1)=1
122      ndege(2)=2
123      ndege(3)=2
124      len(1)=1
125      len(2)=3
126      len(3)=4
127      do 20 ityp1=4,maxtyp1
128      ityp11=ityp1-1
129      ndege(ityp1)=ityp11
130      len(ityp1)=ityp1*ityp11/2
131   20 continue
132c
133      nqi=ndege(maxtyp1)
134      mmax=4*nqi-3
135      lensm(1)=1
136      lensm(2)=4
137      nfu(1)=0
138      nfu(2)=1
139      nfu(3)=4
140      do 30 i=3,mmax
141      lensm(i)=lensm(i-1) + i*(i+1)/2
142      nfu(i+1)=lensm(i)
143   30 continue
144c
145c nia :
146c
147      do 40 i=1,10
148      nia(1,i)=0
149      nia(2,i)=0
150      nia(3,i)=0
151   40 continue
152      nia(1,2)=1
153      nia(2,3)=1
154      nia(3,4)=1
155c d-
156      nia(1,5)=2
157      nia(2,6)=2
158      nia(3,7)=2
159      nia(1,8)=1
160      nia(2,8)=1
161      nia(1,9)=1
162      nia(3,9)=1
163      nia(2,10)=1
164      nia(3,10)=1
165c d-new
166      nia(1,5)=2
167      nia(2,5)=0
168      nia(3,5)=0
169c
170      nia(1,6)=1
171      nia(2,6)=1
172      nia(3,6)=0
173c
174      nia(1,7)=1
175      nia(2,7)=0
176      nia(3,7)=1
177c
178      nia(1,8)=0
179      nia(2,8)=2
180      nia(3,8)=0
181c
182      nia(1,9)=0
183      nia(2,9)=1
184      nia(3,9)=1
185c
186      nia(1,10)=0
187      nia(2,10)=0
188      nia(3,10)=2
189c f-
190      ijk=10
191      do 43 i=1,3
192      do 43 j=i,3
193      do 43 k=j,3
194      ijk=ijk+1
195      ix=0
196      iy=0
197      iz=0
198        if(i.eq.1) ix=ix+1
199        if(j.eq.1) ix=ix+1
200        if(k.eq.1) ix=ix+1
201c
202        if(i.eq.2) iy=iy+1
203        if(j.eq.2) iy=iy+1
204        if(k.eq.2) iy=iy+1
205c
206        if(i.eq.3) iz=iz+1
207        if(j.eq.3) iz=iz+1
208        if(k.eq.3) iz=iz+1
209c
210        nia(1,ijk)=ix
211        nia(2,ijk)=iy
212        nia(3,ijk)=iz
213c
214   43 continue
215c
216c g- and higher
217c
218      do 50 nq=5,mmax
219      nq1=nq-1
220      nful=nfu(nq)-nfu(nq1)
221cxxx  nfuc=nfu(nq+1)-nfu(nq)
222      iful=nfu(nq1)
223      ifuc=nfu(nq)
224         do 51 i=1,nful
225         iful=iful+1
226         ifuc=ifuc+1
227         nia(1,ifuc)=nia(1,iful)+1
228         nia(2,ifuc)=nia(2,iful)
229         nia(3,ifuc)=nia(3,iful)
230   51    continue
231c
232         do 52 i=1,nq
233         i1=i-1
234         ifuc=ifuc+1
235         nia(1,ifuc)=0
236         nia(2,ifuc)=nq1-i1
237         nia(3,ifuc)=i1
238   52    continue
239   50 continue
240c
241c* total number of functions
242c
243      nfun=nfu(mmax+1)
244      nfu1=nfu(mmax)
245c
246c* hnia matrix :
247c
248      do 55 i=1,nfun
249      hnia(1,i)=0.5d0*dble(nia(1,i))
250      hnia(2,i)=0.5d0*dble(nia(2,i))
251      hnia(3,i)=0.5d0*dble(nia(3,i))
252   55 continue
253c
254c* nmxyz and npxyz matrices :
255c
256      do 60 nf=1,nfun
257      ix=nia(1,nf)
258      iy=nia(2,nf)
259      iz=nia(3,nf)
260          do 65 nf1=1,nfun
261          ix1=nia(1,nf1)
262          iy1=nia(2,nf1)
263          iz1=nia(3,nf1)
264      if(ix1.eq.ix-1.and.iy1.eq.iy.and.iz1.eq.iz) nmxyz(1,nf)=nf1
265      if(ix1.eq.ix.and.iy1.eq.iy-1.and.iz1.eq.iz) nmxyz(2,nf)=nf1
266      if(ix1.eq.ix.and.iy1.eq.iy.and.iz1.eq.iz-1) nmxyz(3,nf)=nf1
267ccc
268      if(nf.le.nfu1) then
269      if(ix1.eq.ix+1.and.iy1.eq.iy.and.iz1.eq.iz) npxyz(1,nf)=nf1
270      if(ix1.eq.ix.and.iy1.eq.iy+1.and.iz1.eq.iz) npxyz(2,nf)=nf1
271      if(ix1.eq.ix.and.iy1.eq.iy.and.iz1.eq.iz+1) npxyz(3,nf)=nf1
272      endif
273   65     continue
274   60 continue
275c
276c* icoor, icool and ifrst, ilast marices :
277c
278ctest icool(1)=0
279ctest icoor(1)=0
280      icool(1)=1
281      icoor(1)=1
282      ifrst(1)=1
283      ilast(1)=1
284      do 70 nf=2,nfun
285      ix=nia(1,nf)
286      iy=nia(2,nf)
287      iz=nia(3,nf)
288         if(ix.ne.0) then
289           icool(nf)=1
290         else if(iy.ne.0) then
291           icool(nf)=2
292         else
293           icool(nf)=3
294         endif
295cc
296         if(iz.ne.0) then
297           icoor(nf)=3
298         else if(iy.ne.0) then
299           icoor(nf)=2
300         else
301           icoor(nf)=1
302         endif
303c
304      ilast(nf)=nmxyz(icool(nf),nf)
305      ifrst(nf)=nmxyz(icoor(nf),nf)
306c
307  70  continue
308c
309      return
310      end
311ccccccc
312