← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/NWints/texas/memoha.f

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/NWints/texas/memoha.f
1
 
* $Id: memoha.f 19696 2010-10-29 16:53:42Z d3y133 $
2
 
c====================================================================
3
 
c kw Feb. 18,1994
4
 
c there is the new subroutine memo5 (memory handling for pairs)
5
 
c
6
 
c====================================================================
7
 
c    Memory handling subroutines for 2-electron integrals program
8
 
c
9
 
c====================================================================
10
 
      subroutine memo1_int(namount,iaddress)
11
 
      common /cpu/ intsize,iacc,icache,memreal
12
 
c
13
 
      needed=namount
14
 
      if(intsize.ne.1) needed=namount/intsize+1 
15
 
      call getmem(needed,iaddress)
16
 
c
17
 
      end
18
 
c====================================================================
19
 
      subroutine memo2(nbloks)
20
 
      common /cpu/ intsize,iacc,icache,memreal
21
 
      common /memor2/ nqrtd, nibld,nkbld, nijbd,nijed, nklbd,nkled
22
 
c
23
 
      ndim=nbloks
24
 
      if(intsize.ne.1) ndim=ndim/intsize+1
25
 
c
26
 
      call getmem(ndim,nqrtd)     ! for nqrt array
27
 
      call getmem(ndim,nibld)     ! for nibl array
28
 
      call getmem(ndim,nkbld)     ! for nkbl array
29
 
      call getmem(ndim,nijbd)     ! for nijb array
30
 
      call getmem(ndim,nijed)     ! for nije array
31
 
      call getmem(ndim,nklbd)     ! for nklb array
32
 
      call getmem(ndim,nkled)     ! for nkle array
33
 
c
34
 
      return
35
 
      end
36
 
c====================================================================
37
 
      subroutine memo3(maxqrt)
38
 
      common /cpu/ intsize,iacc,icache,memreal
39
 
      common /memor3/ nblok1d
40
 
      common /memors/ nsym,ijshp,isymm
41
 
c
42
 
c--------------------------------------------------
43
 
      ndim=maxqrt*2
44
 
      if(intsize.ne.1) ndim=ndim/intsize+1
45
 
c
46
 
      call getmem(ndim,nblok1d)      ! for nblok1(2,*)
47
 
      call getmem(maxqrt,isymm)      ! for isymm(*)
48
 
c--------------------------------------------------
49
 
c     call memo1_int(maxqrt*2, nblok1d)  ! for nblok1(2*maxqrt) 
50
 
c     call memo1_int(maxqrt  , nsymm  )  ! for symm(maxqrt) 
51
 
c--------------------------------------------------
52
 
      end
53
 
c********
54
 
      subroutine memo4a(bl, nbls, l11,l12,mem2,igmcnt)
55
 
      double precision bl(*)
56
 
c nmr deriv
57
 
      character*11 scftype
58
 
      character*8 where
59
 
      common /runtype/ scftype,where
60
 
c--
61
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
62
 
      common/obarai/
63
 
     * lni,lnj,lnk,lnl,lnij,lnkl,lnijkl,MMAX,
64
 
     * NQI,NQJ,NQK,NQL,NSIJ,NSKL,
65
 
     * NQIJ,NQIJ1,NSIJ1,NQKL,NQKL1,NSKL1,ijbeg,klbeg
66
 
c
67
 
      common /logic1/ ndege(1)
68
 
      common /logic2/ len(1)
69
 
      common /logic3/ lensm(1)
70
 
      common /logic4/ nfu(1)
71
 
c
72
 
      COMMON/SHELL/LSHELLT,LSHELIJ,LSHELKL,LHELP,LCAS2(4),LCAS3(4)
73
 
      common /memor4/ iwt0,iwt1,iwt2,ibuf,ibuf2,
74
 
     * ibfij1,ibfij2,ibfkl1,ibfkl2,
75
 
     * ibf2l1,ibf2l2,ibf2l3,ibf2l4,ibfij3,ibfkl3,
76
 
     * ibf3l,issss,
77
 
     * ix2l1,ix2l2,ix2l3,ix2l4,ix3l1,ix3l2,ix3l3,ix3l4,
78
 
     * ixij,iyij,izij, iwij,ivij,iuij,isij
79
 
c
80
 
      common /memor4a/ ibf3l1,ibf3l2,ibf3l3,ibf3l4
81
 
c
82
 
c dimensions for assembling :
83
 
      common /dimasse/ lqij,lqkl,lqmx,lij3,lkl3,l3l,lsss
84
 
c dimensions for a.m.shifting :
85
 
c     common /dimamsh/ 
86
 
c
87
 
C************************************************************
88
 
cxxx  DATA LENSM/1,4,10,20,35,56,84,120,165,220,286,364,455,560,680/
89
 
C*******  UP TO: S P D F G H I J K L M N O P Q *******
90
 
C     LENSM(NSIJ)=TOTAL NUMBER OF FUNCTIONS UP TO GIVEN NSIJ
91
 
C************************************************************
92
 
c---------------------------------------------------------------------
93
 
c  dimensions for assembling :
94
 
c  buf2(nbls,lnij,lnkl), bfij1(nbls,lqij,lnkl), bfkl1(nbls,lnij,lqkl)
95
 
c                        bfij2(nbls,lqij,lnkl), bfkl2(nbls,lnij,lqkl)
96
 
c                        bfij3(nbls,lij3,lnkl), bfkl3(nbls,lnij,lkl3)
97
 
c
98
 
c                        bf2l1(nbls,lqij,lqkl), bf2l2(nbls,lqij,lqkl)
99
 
c                        bf2l3(nbls,lqij,lqkl), bf2l4(nbls,lqij,lqkl)
100
 
c
101
 
c                        bf3l1(nbls,l3l ,lqmx), bf3l2(nbls,l3l ,lqmx)
102
 
c                        bf3l3(nbls,lqmx,l3l ), bf3l4(nbls,lqmx,l3l )
103
 
c
104
 
c                         ssss(nbls,lsss,lsss)
105
 
c---------------------------------------------------------------------
106
 
c
107
 
       lqij=nfu(nqij +1)
108
 
       lqkl=nfu(nqkl +1)
109
 
       lij3=1
110
 
       lkl3=1
111
 
       l3l =1
112
 
       lsss=1
113
 
       if(where.eq.'shif' .or. where.eq.'forc') then
114
 
          lqij=nfu(nqij1+1)
115
 
          lqkl=nfu(nqkl1+1)
116
 
          if(lshellt.gt.1) then
117
 
            lij3=4
118
 
            lkl3=4
119
 
          endif
120
 
          if(lshellt.gt.2) l3l =4
121
 
          if(lshellt.gt.3) lsss=4
122
 
       endif
123
 
       lqmx=max( lqij,lqkl )
124
 
c
125
 
c---------------------------------------------------------------------
126
 
c l11,l12,mem2 are not used for mmax.le.2 (psss)
127
 
c
128
 
       l11=1
129
 
       l12=1
130
 
       mem2=1
131
 
c---------------------------------------------------------------------
132
 
c
133
 
c* initiate all addresses :
134
 
c for trobsa :
135
 
       iwt0=1
136
 
       iwt1=1
137
 
       iwt2=1
138
 
c for assemble :
139
 
       ibuf=1
140
 
       ibuf2=1
141
 
       ibfij1=1
142
 
       ibfij2=1
143
 
       ibfkl1=1
144
 
       ibfkl2=1
145
 
       ibf2l1=1
146
 
       ibf2l2=1
147
 
       ibf2l3=1
148
 
       ibf2l4=1
149
 
       ibfij3=1
150
 
       ibfkl3=1
151
 
       ibf3l=1
152
 
c
153
 
c      ibf3l1=ibf3l
154
 
c
155
 
       ibf3l1=1
156
 
       ibf3l2=1
157
 
       ibf3l3=1
158
 
       ibf3l4=1
159
 
c
160
 
       issss=1
161
 
c
162
 
      mem0=lnij*lnkl
163
 
c
164
 
C******************************************************
165
 
c       Memory for "assemble"
166
 
c
167
 
c ------------------------------------------
168
 
c
169
 
c gen.contr.
170
 
      ngcijkl=(ngci+1)*(ngcj+1)*(ngck+1)*(ngcl+1)
171
 
      nblsg=nbls*ngcijkl
172
 
c
173
 
ccccc if(where.ne.'shif' .and. where.ne.'forc') then
174
 
      if(where.eq.'buff') then
175
 
        call getmem_zero(bl,nblsg*lnijkl,ibuf)  ! for buf(nbls,lnijkl)    ZERO
176
 
        call getmem_zero(bl,nblsg*mem0,ibuf2)  ! for buf2(nbls,lnij,lnkl) ZERO
177
 
      endif
178
 
      if(where.eq.'shif') then
179
 
c     - for nmr derivatives -
180
 
        call getmem(7*nblsg*lnijkl,ibuf)  ! for buf(nbls,lnijkl)
181
 
        ixxx=nblsg*mem0 + 6*nblsg*nfu(nsij)*nfu(nskl)
182
 
        call getmem(ixxx      ,ibuf2)  ! for buf2(nbls,lnij,lnkl)
183
 
      endif
184
 
      if(where.eq.'forc') then
185
 
c     memory allocated for ibuf will be used twice : first for
186
 
c     assembling (instead of buf2) and then for final derivatives.
187
 
c     For ibuf allocate maximum of :
188
 
        iyyy=nblsg*max(9*lnijkl,4*mem0) 
189
 
c     and for ibuf2 :
190
 
        ixxx=               10*nblsg*nfu(nsij)*nfu(nskl)
191
 
c     instead of ixxx=4*nblsg*mem0 + 10*nblsg*nfu(nsij)*nfu(nskl)
192
 
c
193
 
c 4*nblsg*mem0 is probably ALWAYS greater than 9*nblsg*lnijkl
194
 
c
195
 
c 4 comes from : ordinary contraction 
196
 
c              + rescaled contrac. with 2*expA
197
 
c              + rescaled contrac. with 2*expB
198
 
c              + rescaled contrac. with 2*expC
199
 
c 10 comes from 9 different derivatives with respect to 
200
 
c Ax,y,z , Bx,y,z and Cx,y,z (center positions)
201
 
c     plus 1 location for ordinary integrals.
202
 
c
203
 
        call getmem(iyyy  ,ibuf )  ! for buf (nbls,lnijkl)
204
 
        call getmem(ixxx  ,ibuf2)  ! for buf2(nbls,lnij,lnkl)
205
 
      endif
206
 
c
207
 
      if(where.eq.'hess') then
208
 
        iyyy=nblsg*max(54*lnijkl,10*mem0) 
209
 
        ixxx=55*nblsg*nfu(nsij)*nfu(nskl)
210
 
c
211
 
c 10 comes from : ordinary contraction 
212
 
c               + rescaled contrac. with 2*expA
213
 
c               + rescaled contrac. with 2*expB
214
 
c               + rescaled contrac. with 2*expC
215
 
c               + rescaled contrac. with 2*expA*2expB
216
 
c               + rescaled contrac. with 2*expA*2expC
217
 
c               + rescaled contrac. with 2*expB*2expC
218
 
c               + rescaled contrac. with (2*expA)**2    
219
 
c               + rescaled contrac. with (2*expB)**2
220
 
c               + rescaled contrac. with (2*expC)**2
221
 
c 54 comes from :  9 first derivatives 
222
 
c                +45 second derivatives
223
 
c
224
 
c 55 comes from :  1 ordinary integrals
225
 
c                  9 first derivatives 
226
 
c                +45 second derivatives
227
 
c
228
 
        call getmem(iyyy  ,ibuf )  ! for buf (nbls,lnijkl)
229
 
        call getmem(ixxx  ,ibuf2)  ! for buf2(nbls,lnij,lnkl)
230
 
      endif
231
 
c
232
 
c
233
 
c  count calls of getmem :
234
 
c
235
 
change  igmcnt=2     !  to save ibuf
236
 
        igmcnt=1
237
 
c
238
 
      if(mmax.le.2) return
239
 
c
240
 
        IF(LSHELLT.GT.0) THEN
241
 
c for ordinary integrals:
242
 
c
243
 
           mbfkl12=lnij*nfu(nqkl+1)*nbls 
244
 
           mbfij12=nfu(nqij+1)*lnkl*nbls
245
 
c
246
 
          if(where.eq.'shif') then
247
 
           mbfkl12=lnij*nfu(nqkl1+1)*nbls + 6*nfu(nsij)*nfu(nqkl+1)*nbls
248
 
           mbfij12=nfu(nqij1+1)*lnkl*nbls + 6*nfu(nqij+1)*nfu(nskl)*nbls
249
 
          endif
250
 
          if(where.eq.'forc') then
251
 
           mbfkl12=4*lnij*nfu(nqkl1+1)*nbls
252
 
     *            +10*nfu(nsij)*nfu(nqkl+1)*nbls
253
 
           mbfij12=4*nfu(nqij1+1)*lnkl*nbls
254
 
     *            +10*nfu(nqij+1)*nfu(nskl)*nbls
255
 
          endif
256
 
c
257
 
          if(lshellt.gt.1) then
258
 
            call getmem_zero(bl,mbfij12,ibfij1)  ! for bfij1 ZERO
259
 
            call getmem_zero(bl,mbfij12,ibfij2)  ! for bfij2 ZERO
260
 
            call getmem_zero(bl,mbfkl12,ibfkl1)  ! for bfkl1 ZERO
261
 
            call getmem_zero(bl,mbfkl12,ibfkl2)  ! for bfkl2 ZERO
262
 
            igmcnt=igmcnt+4
263
 
          else
264
 
            call getmem_zero(bl,mbfij12,ibfij1)  ! for bfij1 ZERO
265
 
            ibfij2=ibfij1
266
 
            call getmem_zero(bl,mbfkl12,ibfkl1)  ! for bfkl1 ZERO
267
 
            ibfkl2=ibfkl1
268
 
            igmcnt=igmcnt+2
269
 
          endif
270
 
c     
271
 
        IF( LSHELLT.GT.1 ) THEN
272
 
c
273
 
            mbf2l=nfu(nqij+1)*nfu(nqkl+1)*nbls 
274
 
            mbfkl3=lnij*nbls
275
 
            mbfij3=lnkl*nbls
276
 
c
277
 
          if(where.eq.'shif') then
278
 
            mbf2l=nfu(nqij1+1)*nfu(nqkl1+1)*nbls 
279
 
     *         +6*nfu(nqij +1)*nfu(nqkl +1)*nbls
280
 
c
281
 
            mbfkl3=lnij*4*nbls + 6*nfu(nsij)*nbls
282
 
            mbfij3=4*lnkl*nbls + 6*nfu(nskl)*nbls
283
 
          endif
284
 
          if(where.eq.'forc') then
285
 
            mbf2l=4*nfu(nqij1+1)*nfu(nqkl1+1)*nbls 
286
 
     *           +10*nfu(nqij +1)*nfu(nqkl +1)*nbls
287
 
c
288
 
            mbfkl3=4*(lnij*4*nbls) + 10*nfu(nsij)*nbls
289
 
            mbfij3=4*(4*lnkl*nbls) + 10*nfu(nskl)*nbls
290
 
          endif
291
 
c
292
 
          if(lshellt.gt.2) then
293
 
            call getmem_zero(bl,mbf2l,ibf2l1)   ! for bf2l1 ZERO
294
 
            call getmem_zero(bl,mbf2l,ibf2l2)   ! for bf2l2 ZERO
295
 
            call getmem_zero(bl,mbf2l,ibf2l3)   ! for bf2l3 ZERO
296
 
            call getmem_zero(bl,mbf2l,ibf2l4)   ! for bf2l4 ZERO
297
 
            igmcnt=igmcnt+4
298
 
          else
299
 
            call getmem_zero(bl,mbf2l,ibf2l1)   ! for bf2l1 ZERO
300
 
            ibf2l2=ibf2l1
301
 
            call getmem_zero(bl,mbf2l,ibf2l3)   ! for bf2l3 ZERO
302
 
            ibf2l4=ibf2l3
303
 
            igmcnt=igmcnt+2
304
 
          endif
305
 
c
306
 
            call getmem_zero(bl,mbfij3,ibfij3)  ! for bfij3 ZERO
307
 
            call getmem_zero(bl,mbfkl3,ibfkl3)  ! for bfkl3 ZERO
308
 
            igmcnt=igmcnt+2
309
 
c
310
 
        IF( LSHELLT.GT.2 ) THEN
311
 
c
312
 
            mbf3l0=max( nfu(nqij +1),nfu(nqkl +1) )
313
 
            mbf3l=mbf3l0*nbls
314
 
          if(where.eq.'shif') then
315
 
            mbf3l1=max( nfu(nqij1+1),nfu(nqkl1+1) )
316
 
            mbf3l0=max( nfu(nqij +1),nfu(nqkl +1) )
317
 
            mbf3l=4*mbf3l1*nbls + 6*mbf3l0*nbls
318
 
          endif
319
 
          if(where.eq.'forc') then
320
 
            mbf3l1=max( nfu(nqij1+1),nfu(nqkl1+1) )
321
 
            mbf3l0=max( nfu(nqij +1),nfu(nqkl +1) )
322
 
            mbf3l=4*(4*mbf3l1*nbls) + 10*mbf3l0*nbls
323
 
          endif
324
 
c
325
 
          if(lshellt.gt.3) then
326
 
            call getmem(mbf3l,ibf3l1)  ! for bf3l1
327
 
            call getmem(mbf3l,ibf3l2)  ! for bf3l2
328
 
            call getmem(mbf3l,ibf3l3)  ! for bf3l3
329
 
            call getmem(mbf3l,ibf3l4)  ! for bf3l4
330
 
            igmcnt=igmcnt+4
331
 
           else
332
 
            call getmem(mbf3l,ibf3l1)  ! for bf3l1
333
 
            ibf3l2=ibf3l1
334
 
            call getmem(mbf3l,ibf3l3)  ! for bf3l3
335
 
            ibf3l4=ibf3l3
336
 
            igmcnt=igmcnt+2
337
 
           endif
338
 
c
339
 
        IF( LSHELLT.GT.3 ) then
340
 
c
341
 
            i4s =nbls
342
 
          if(where.eq.'shif') then
343
 
            i4s =16*nbls + 6*nbls
344
 
          endif
345
 
          if(where.eq.'forc') then
346
 
            i4s =4*16*nbls + 10*nbls
347
 
          endif
348
 
c
349
 
           call getmem_zero(bl,i4s  ,issss)  ! for ssss ZERO
350
 
c
351
 
            igmcnt=igmcnt+1
352
 
        ENDIF
353
 
        ENDIF
354
 
        ENDIF
355
 
        ENDIF
356
 
c
357
 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
358
 
c         Memory handling for Obara-Saika-Tracy method
359
 
c     
360
 
c     0) for target classes WT0 or XT0(nbls,lnij,lnkl)
361
 
c
362
 
c     1) for recursive formulas in Obara-Saika:
363
 
c
364
 
c         WT1 or XT1( mmax, nbls, lensm(mmax) )
365
 
c
366
 
c     2) for recursive formulas in Tracy :
367
 
c        WT2(nbls,mem2)  where mem2 is a sum of all matrices  
368
 
c        from xt1(lensm(mmax),1) to  xt1(lensm(nsij),lensm(nskl))
369
 
c  
370
 
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
371
 
cc
372
 
c  for target classes
373
 
c
374
 
cc
375
 
c  for Obara-Saika
376
 
c
377
 
      l11=mmax
378
 
      l12=lensm(mmax)     
379
 
      mem1=l11*l12
380
 
cc
381
 
c  for Tracy 
382
 
c
383
 
      mem2_1=0
384
 
c98   if(nsij.ge.nskl) then
385
 
        klstep=0
386
 
        do 10 ijstep=mmax,nsij,-1
387
 
        klstep=klstep+1
388
 
        ijdim=lensm(ijstep)
389
 
        kldim=lensm(klstep)
390
 
        ijkld=ijdim*kldim
391
 
        mem2_1=mem2_1+ijkld
392
 
   10   continue
393
 
c98   else
394
 
      mem2_2=0
395
 
        ijstep=0
396
 
        do 11 klstep=mmax,nskl,-1
397
 
        ijstep=ijstep+1
398
 
        ijdim=lensm(ijstep)
399
 
        kldim=lensm(klstep)
400
 
        ijkld=ijdim*kldim
401
 
        mem2_2=mem2_2+ijkld
402
 
   11   continue
403
 
c98   endif
404
 
c98
405
 
      mem2=max(mem2_1,mem2_2)
406
 
c
407
 
ccc   write(6,*)' memoha: mem2_1,mem2_2,mem2=',mem2_1,mem2_2,mem2
408
 
c
409
 
      call getmem_zero(bl,nbls*mem0,iwt0)   ! for wt0(nbls,lnij,lnkl) ZERO
410
 
      call getmem_zero(bl,nbls*mem1,iwt1)   ! for wt1(l11,nbls,l12) ZERO
411
 
      call getmem_zero(bl,nbls*mem2,iwt2)      ! for wt2(nbls,mem2) ZERO
412
 
c
413
 
      igmcnt=igmcnt+3
414
 
c
415
 
      return
416
 
      end
417
 
c
418
 
c********
419
 
      subroutine memo4b(bl,nbls,igmcnt)
420
 
      double precision bl(*)
421
 
c nmr deriv
422
 
      character*11 scftype
423
 
      character*8 where
424
 
      common /runtype/ scftype,where
425
 
c--
426
 
      common/obarai/
427
 
     * lni,lnj,lnk,lnl,lnij,lnkl,lnijkl,MMAX,
428
 
     * NQI,NQJ,NQK,NQL,NSIJ,NSKL,
429
 
     * NQIJ,NQIJ1,NSIJ1,NQKL,NQKL1,NSKL1,ijbeg,klbeg
430
 
C
431
 
      common /logic4/ nfu(1)
432
 
c
433
 
      COMMON/SHELL/LSHELLT,LSHELIJ,LSHELKL,LHELP,LCAS2(4),LCAS3(4)
434
 
      common /memor4/ iwt0,iwt1,iwt2,ibuf,ibuf2,
435
 
     * ibfij1,ibfij2,ibfkl1,ibfkl2,
436
 
     * ibf2l1,ibf2l2,ibf2l3,ibf2l4,ibfij3,ibfkl3,
437
 
     * ibf3l,issss,
438
 
     * ix2l1,ix2l2,ix2l3,ix2l4,ix3l1,ix3l2,ix3l3,ix3l4,
439
 
     * ixij,iyij,izij, iwij,ivij,iuij,isij
440
 
C
441
 
C************************************************************
442
 
c
443
 
c* initiate all addresses :
444
 
c
445
 
c for amshift :
446
 
       ix2l1=1
447
 
       ix2l2=1
448
 
       ix2l3=1
449
 
       ix2l4=1
450
 
       ix3l1=1
451
 
       ix3l2=1
452
 
       ix3l3=1
453
 
       ix3l4=1
454
 
       ixij=1
455
 
       iyij=1
456
 
       izij=1
457
 
       iwij=1
458
 
       ivij=1
459
 
       iuij=1
460
 
       isij=1
461
 
c
462
 
c------------------------------------------------
463
 
c       Memory for "shifts"
464
 
c
465
 
c* for wij and xij :
466
 
c
467
 
c---new----
468
 
            mwvus=max(lnij,lnkl)*max(nfu(nqj+1),nfu(nql+1))
469
 
            mxij=nfu(nqi+1)*nfu(nqij+1)*lnkl
470
 
c
471
 
            mwij=mwvus
472
 
            mwij=mwij*nbls
473
 
            mxij=mxij*nbls
474
 
        if(where.eq.'shif') then
475
 
            mwij=6*mwij
476
 
            mxij=6*mxij
477
 
        endif
478
 
        if(where.eq.'forc') then
479
 
            mwij=10*mwij
480
 
            mxij=10*mxij
481
 
        endif
482
 
        if(where.eq.'hess') then
483
 
            mwij=55*mwij
484
 
            mxij=55*mxij
485
 
        endif
486
 
c---new----
487
 
c
488
 
            call getmem(mwij,iwij)    ! for wij
489
 
            call getmem_zero(bl,mxij,ixij)    ! for xij ZERO
490
 
c
491
 
c  count calls of getmem :
492
 
c
493
 
            igmcnt=2
494
 
c
495
 
        IF(LSHELLT.GT.0) THEN
496
 
c
497
 
c* for vij10:
498
 
c
499
 
c--new--    mvus=lnij2
500
 
            mvus=mwvus
501
 
            myz=nfu(nqi+1)*nfu(nqj+1)*nfu(nqkl+1)
502
 
            mvus=mvus*nbls
503
 
            myz=myz*nbls
504
 
c
505
 
        if(where.eq.'shif') then
506
 
            mvus=6*mvus
507
 
            myz =6*myz 
508
 
        endif
509
 
        if(where.eq.'forc') then
510
 
            mvus=10*mvus
511
 
            myz =10*myz 
512
 
        endif
513
 
c
514
 
            call getmem(mvus,ivij)      ! for vij
515
 
            call getmem(myz ,iyij)      ! for yij
516
 
c 
517
 
           igmcnt=igmcnt+2
518
 
c     
519
 
        IF( LSHELLT.GT.1 ) THEN
520
 
            mbf2l=nfu(nqij+1)*nfu(nqkl+1) *nbls
521
 
            if(where.eq.'shif') then
522
 
               mbf2l=6*mbf2l
523
 
            endif
524
 
            if(where.eq.'forc') then
525
 
               mbf2l=10*mbf2l
526
 
            endif
527
 
c
528
 
c* for x2l1-4, uij and sij:
529
 
c
530
 
            call getmem(mvus,iuij)      ! for uij
531
 
            call getmem(mvus,isij)      ! for sij
532
 
            call getmem(myz ,izij)      ! for zij
533
 
            igmcnt=igmcnt+3
534
 
cc
535
 
          if(lshellt.gt.2) then
536
 
            call getmem(mbf2l,ix2l1)    ! for x2l1
537
 
            call getmem(mbf2l,ix2l2)    ! for x2l2
538
 
            call getmem(mbf2l,ix2l3)    ! for x2l3
539
 
            call getmem(mbf2l,ix2l4)    ! for x2l4
540
 
            igmcnt=igmcnt+4
541
 
          else
542
 
            call getmem(mbf2l,ix2l1)    ! for x2l1
543
 
            ix2l2=ix2l1                 ! for x2l2
544
 
            ix2l3=ix2l1                 ! for x2l3
545
 
            ix2l4=ix2l1                 ! for x2l4
546
 
            igmcnt=igmcnt+1
547
 
          endif
548
 
c
549
 
        IF( LSHELLT.GT.2 ) THEN
550
 
c
551
 
         mnbls=nbls
552
 
         if(where.eq.'shif') mnbls=6*nbls
553
 
         if(where.eq.'forc') mnbls=10*nbls
554
 
c
555
 
         if(lshellt.gt.3) then
556
 
            call getmem(mnbls*nfu(nqkl+1), ix3l1) ! for x3l1
557
 
            call getmem(mnbls*nfu(nqkl+1), ix3l2) ! for x3l2
558
 
            call getmem(mnbls*nfu(nqij+1), ix3l3) ! for x3l3
559
 
            call getmem(mnbls*nfu(nqij+1), ix3l4) ! for x3l4
560
 
            igmcnt=igmcnt+4
561
 
          else
562
 
            call getmem(mnbls*nfu(nqkl+1), ix3l1) ! for x3l1
563
 
            ix3l2=ix3l1
564
 
            call getmem(mnbls*nfu(nqij+1), ix3l3) ! for x3l3
565
 
            ix3l4=ix3l3
566
 
            igmcnt=igmcnt+2
567
 
          endif
568
 
c
569
 
        ENDIF
570
 
        ENDIF
571
 
        ENDIF
572
 
c
573
 
      return
574
 
      end
575
 
c
576
 
c================================================================
577
 
      subroutine memo5a_2(npij,mmax1)
578
 
c------------------------------------------
579
 
c Memory handling for left-hand pairs:
580
 
c
581
 
c 1: for individual shells (2 quantities)
582
 
c   cis,cjs - contr coef. dimensions are (lci), (lcj)
583
 
c
584
 
c 2: for : xab(ijpar,3) and xp, xpn, xpp all (ijpar,3,lcij)
585
 
c
586
 
c 3: for : apb, rapb, factij, (lcij)
587
 
c          ceofij and sij all (ijpar,lcij)
588
 
c
589
 
c 4. for : txab(ijpar,3,lcij)
590
 
c
591
 
c Total number of calls of Getmem is 11 or 12 (if gen.con.)
592
 
c OR 13 or 14 if where='forc'
593
 
c------------------------------------------
594
 
c for gradient derivatives:
595
 
      character*11 scftype
596
 
      character*8 where
597
 
      common /runtype/ scftype,where
598
 
c
599
 
      common /cpu/ intsize,iacc,icache,memreal
600
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
601
 
      common /memor5x/ ieab,iecd
602
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
603
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
604
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
605
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
606
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
607
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
608
 
c------------------------------------------
609
 
      ijpar=npij
610
 
c------------------------------------------
611
 
c reserve memory for left-hand pairs IJ :
612
 
c
613
 
       ndi=   ijpar*lci
614
 
       ndj=   ijpar*lcj
615
 
c
616
 
      call getmem(lci,icis)       ! for cis(lci)                 1
617
 
      call getmem(lcj,icjs)       ! for cjs(lcj)                 2
618
 
      call getmem(ijpar*3,ixab)   ! for xab(ijpar,3)             3
619
 
c
620
 
       ndij=ndi*lcj
621
 
       ndij3=ndij*3
622
 
c
623
 
ckw Do not change this order
624
 
      call getmem(ndij3,ixp)     ! for xp(ijpar,3,lcij)          4
625
 
      call getmem(ndij3,ixpn)    ! for xpn(ijpar,3,lcij)         5
626
 
      call getmem(ndij3,ixpp)    ! for xpp(ijpar,3,lcij)         6
627
 
ckw up to here.
628
 
c
629
 
      call getmem(lcij,ifij)     ! for factij(lcij)              7 
630
 
      call getmem(ndij,icij)     ! for coefij(ijpar,lcij)        8
631
 
      call getmem(ndij,ieab)     ! for eab(ijpar,lcij)           9
632
 
      call getmem(ndij3,itxab)   ! for txab(ijpar,3,lcij)       10
633
 
c
634
 
      ndijm=lcij*mmax1
635
 
      call getmem(ndijm,iabnia)  ! for abnia(mmax-1,lcij)       11
636
 
c
637
 
c------------------------------------------
638
 
c for general contraction on IJ-pairs
639
 
c
640
 
      ngci1=ngci+1
641
 
      ngcj1=ngcj+1
642
 
      ngck1=ngck+1
643
 
      ngcl1=ngcl+1
644
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
645
 
c
646
 
c-----
647
 
c
648
 
      igcij=1
649
 
      if(ngcd.gt.1) then
650
 
        ndijg=lcij*ngci1*ngcj1
651
 
        call getmem(ndijg,igcij)              !               12
652
 
      endif
653
 
c
654
 
      iaa=1
655
 
      ibb=1
656
 
      if(where.eq.'forc' .or. where.eq.'hess') then
657
 
         call getmem(ndi,iaa)     ! for  aa(ijpar,lci)        13  
658
 
         call getmem(ndj,ibb)     ! for  bb(ijpar,lcj)        14   
659
 
      endif
660
 
c------------------------------------------
661
 
      end
662
 
c================================================================
663
 
      subroutine memo5b_2(npkl,mmax1)
664
 
      common /cpu/ intsize,iacc,icache,memreal
665
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
666
 
c------------------------------------------
667
 
c Memory handling for right-hand pairs:
668
 
c------------------------------------------
669
 
c for gradient derivatives:
670
 
      character*11 scftype
671
 
      character*8 where
672
 
      common /runtype/ scftype,where
673
 
c
674
 
      common /memor5x/ ieab,iecd
675
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
676
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
677
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
678
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
679
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
680
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
681
 
c------------------------------------------
682
 
      klpar=npkl
683
 
c------------------------------------------
684
 
c reserve memory for right-hand pairs KL :
685
 
c
686
 
       ndk=   klpar*lck
687
 
cccc   ndl=   klpar*lcl
688
 
c
689
 
      call getmem(lck,icks)       ! for cks(lck)                1
690
 
      call getmem(lcl,icls)       ! for cls(lcl)                2
691
 
      call getmem(klpar*3,ixcd)  ! for xcd(klpar,3)             3
692
 
c
693
 
       ndkl=ndk*lcl
694
 
       ndkl3=ndkl*3
695
 
c
696
 
ckw Do not change this order
697
 
      call getmem(ndkl3,ixq)     ! for xq(klpar,3,lckl)         4
698
 
      call getmem(ndkl3,ixqn)    ! for xqn(klpar,3,lckl)        5
699
 
      call getmem(ndkl3,ixqq)    ! for xqq(klpar,3,lckl)        6
700
 
ckw up to here.
701
 
c
702
 
      call getmem(ndkl,ifkl)     ! for factkl(klapr,lckl)       7
703
 
      call getmem(ndkl,ickl)     ! for coefkl(klapr,lckl)       8
704
 
      call getmem(ndkl,iecd)     ! for ecd(klapr,lckl)          9
705
 
      call getmem(ndkl3,itxcd)   ! for txcd(klpar,3,lckl)      10
706
 
c
707
 
      ndklm=lckl*mmax1
708
 
      call getmem(ndklm,icdnia)  ! for cdnia(mmax-1,lckl)      11
709
 
c------------------------------------------
710
 
c for general contraction on KL-pairs
711
 
c
712
 
      ngci1=ngci+1
713
 
      ngcj1=ngcj+1
714
 
      ngck1=ngck+1
715
 
      ngcl1=ngcl+1
716
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
717
 
c-----
718
 
      igckl=1
719
 
      if(ngcd.gt.1) then
720
 
        ndklg=lckl*ngck1*ngcl1
721
 
        call getmem(ndklg,igckl)      !               12
722
 
      endif
723
 
c------------------------------------------
724
 
      icc=1
725
 
      if(where.eq.'forc' .or. where.eq.'hess') then
726
 
         call getmem(ndk,icc)   ! for  cc(klpar,lck) 13
727
 
      endif
728
 
c------------------------------------------
729
 
      end
730
 
c================================================================
731
 
      subroutine memo5c_2(nbls,mmax1,npij,npkl,nfumax)
732
 
      common /cpu/ intsize,iacc,icache,memreal
733
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
734
 
c------------------------------------------
735
 
c Memory handling 
736
 
c
737
 
c 3: and quartets precalculations (12 quantities)
738
 
c (for whole block of contracted quartets and 
739
 
c        one primitive quartet )
740
 
c
741
 
c Total number of calls of Getmem is 21 or 23 (if gen.cont)
742
 
c------------------------------------------
743
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
744
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
745
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
746
 
      common /memor5b/ irppq,
747
 
     * irho,irr1,irys,irhoapb,irhocpd,iconst,ixwp,ixwq,ip1234,
748
 
     * idx1,idx2,indx
749
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
750
 
      common /memor5d/ iabnix,icdnix,ixpnx,ixqnx,ihabcdx
751
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
752
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
753
 
      common /memor5f/ indxp
754
 
c------------------------------------------
755
 
c reserve memory for quartets ijkl
756
 
c------------------------------------------
757
 
      nblsi=nbls
758
 
      if(intsize.ne.1) nblsi=nbls/intsize+1
759
 
c------------------------------------------
760
 
      call getmem(nblsi,indxp)   !                    1
761
 
      call getmem(nblsi,idx1)    ! for indxij         2
762
 
      call getmem(nblsi,idx2)    ! for indxkj         3
763
 
      call getmem(nblsi,indx)    ! for index          4
764
 
c
765
 
      call getmem(1   ,irppq)    ! for rppq(1   )     5
766
 
      call getmem(nbls,irr1)     ! for rr1(nbls)      6  
767
 
c
768
 
      call getmem(1   ,irhoapb)  ! for rhoapb(1   )   7
769
 
      call getmem(1   ,irhocpd)  ! for rhocpd(1   )   8
770
 
c
771
 
      nbls3=nbls*3
772
 
      call getmem(nbls3,ixpnx)   !                    9
773
 
      call getmem(nbls3,ixwp)    ! for xwp(nbls,3)   10
774
 
      call getmem(nbls3,ixqnx)   !                   11
775
 
      call getmem(nbls3,ixwq)    ! for xwq(nbls,3)   12
776
 
      call getmem(nbls3,ip1234)  ! for p1234(nbls,3) 13
777
 
      call getmem(1   ,iabcd)    ! for abcd(1   )    14
778
 
      call getmem(nbls,iconst)   ! for const(nbls)   15
779
 
      call getmem(nbls,irys)     ! for rys(nbls)     16
780
 
c
781
 
      nfha=3*nfumax*max(lcij,lckl)
782
 
      call getmem(nfha,ihabcd)    !                  17
783
 
c------------------------------------------
784
 
c for general contraction
785
 
c
786
 
      ngci1=ngci+1
787
 
      ngcj1=ngcj+1
788
 
      ngck1=ngck+1
789
 
      ngcl1=ngcl+1
790
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
791
 
c
792
 
c------------------------------------------
793
 
c for both gen.contr. and segmented basis sets
794
 
c because of the common Destiny
795
 
c
796
 
      call getmem(ngcd,icfg)        !               18
797
 
      call getmem(ngcd,jcfg)        !               19
798
 
      call getmem(ngcd,kcfg)        !               20
799
 
      call getmem(ngcd,lcfg)        !               21
800
 
c
801
 
c------------------------------------------
802
 
c for general contraction
803
 
c
804
 
      indgc=1
805
 
      igcoef=1
806
 
c
807
 
      if(ngcd.gt.1) then
808
 
        call getmem(nbls,indgc)       !             22
809
 
        call getmem(nbls*ngcd,igcoef) !             23
810
 
      endif
811
 
c
812
 
c------------------------------------------
813
 
      end
814
 
c====================================================================
815
 
      subroutine memo6(npij,npkl)
816
 
      common /memor6/ ixyab,ixycd
817
 
c**************
818
 
c
819
 
c Memory handling for NMR derivatives
820
 
c reserve memory for pair quantities :
821
 
c
822
 
c  ( Xa*Yb - Ya*Xb ) = xyab(ijpar,3)  - contributes to Z deriv.
823
 
c  (-Xa*Zb + Za*Xb ) = xyab(ijpar,2)  - contributes to Y deriv.
824
 
c  ( Ya*Zb + Za*Yb ) = xyab(ijpar,1)  - contributes to X deriv.
825
 
c
826
 
c  ( Xc*Yd - Yc*Xd ) = xycd(klpar,3)  - contributes to Z deriv.
827
 
c  (-Xc*Zd + Zc*Xd ) = xycd(klpar,2)  - contributes to Y deriv.
828
 
c  ( Yc*Zd + Zc*Yd ) = xycd(klpar,1)  - contributes to X deriv.
829
 
c
830
 
c**************
831
 
c
832
 
      npij3=3*npij
833
 
      npkl3=3*npkl
834
 
c
835
 
      call getmem(npij3,ixyab)
836
 
      call getmem(npkl3,ixycd)
837
 
c
838
 
      end
839
 
c================================================================
840
 
c used when iroute=1 (old) :
841
 
c
842
 
      subroutine memo5a_1(npij,mmax1)
843
 
      common /cpu/ intsize,iacc,icache,memreal
844
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
845
 
c------------------------------------------
846
 
c Memory handling for left-hand pairs:
847
 
c
848
 
c 1: for individual shells (4 quantities)
849
 
c ( aa, bb  - exponents ) and  ( cis,cjs - contr coef.)
850
 
c  dimensions are (ijpar,lcij)
851
 
c
852
 
c 2: for : xab(ijpar,3) and xp, xpn, xpp all (ijpar,3,lcij)
853
 
c
854
 
c 3: for : apb, rapb, factij, ceofij and sij all (ijpar,lcij)
855
 
c
856
 
c 4. for : txab(ijpar,3,lcij)
857
 
c
858
 
c Total number of calls of Getmem is 13 or 15 (if gen.con.)
859
 
c------------------------------------------
860
 
      common /memor5x/ ieab,iecd
861
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
862
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
863
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
864
 
c
865
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
866
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
867
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
868
 
c
869
 
c------------------------------------------
870
 
      ijpar=npij
871
 
c------------------------------------------
872
 
c reserve memory for left-hand pairs IJ :
873
 
c
874
 
       ndi=   ijpar*lci
875
 
       ndj=   ijpar*lcj
876
 
c
877
 
      call getmem(ndi,iaa)        ! for  aa(ijpar,lci)           1
878
 
      call getmem(ndj,ibb)        ! for  bb(ijpar,lcj)           2
879
 
      call getmem(ndi,icis)       ! for cis(ijpar,lci)           3
880
 
      call getmem(ndj,icjs)       ! for cjs(ijpar,lcj)           4
881
 
      call getmem(ijpar*3,ixab)   ! for xab(ijpar,3)              5
882
 
c
883
 
       ndij=ndi*lcj
884
 
       ndij3=ndij*3
885
 
c
886
 
ckw Do not change this order
887
 
      call getmem(ndij3,ixp)     ! for xp(ijpar,3,lcij)          6
888
 
      call getmem(ndij3,ixpn)    ! for xpn(ijpar,3,lcij)         7
889
 
      call getmem(ndij3,ixpp)    ! for xpp(ijpar,3,lcij)         8
890
 
ckw up to here.
891
 
c
892
 
c     call getmem(ndij,iapb)     ! for apb(ijpar,lcij)             
893
 
c     call getmem(ndij,i1apb)    ! for rapb(ijpar,lcij)         
894
 
      call getmem(ndij,ifij)     ! for factij(ijpar,lcij)        9 
895
 
      call getmem(ndij,icij)     ! for coefij(ijpar,lcij)       10
896
 
      call getmem(ndij,ieab)     ! for eab(ijpar,lcij)          
897
 
c
898
 
      call getmem(ndij3,itxab)   ! for txab(ijpar,3,lcij)       11
899
 
c
900
 
      ndijm=ndij*mmax1
901
 
      call getmem(ndijm,iabnia)  ! for abnia(ijpar,mmax-1,lcij) 12
902
 
c
903
 
c------------------------------------------
904
 
c for general contraction on IJ-pairs
905
 
c
906
 
      ngci1=ngci+1
907
 
      ngcj1=ngcj+1
908
 
      ngck1=ngck+1
909
 
      ngcl1=ngcl+1
910
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
911
 
c
912
 
c-----
913
 
c
914
 
      igci=1
915
 
      igcj=1
916
 
c
917
 
      if(ngcd.gt.1) then
918
 
        ndig=ndi*ngci1
919
 
        ndjg=ndj*ngcj1
920
 
        call getmem(ndig,igci)        !               13
921
 
        call getmem(ndjg,igcj)        !               14
922
 
      endif
923
 
c
924
 
c------------------------------------------
925
 
      end
926
 
c================================================================
927
 
      subroutine memo5b_1(npkl,mmax1)
928
 
      common /cpu/ intsize,iacc,icache,memreal
929
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
930
 
c------------------------------------------
931
 
c Memory handling for right-hand pairs:
932
 
c
933
 
c 1: for individual shells (4 quantities)
934
 
c ( cc, dd  - exponents ) and  ( cks,cls - contr coef.)
935
 
c  dimensions are (klpar,lcij)
936
 
c
937
 
c 2: for : xcd(ijpar,3) and xq, xqn, xqq all (klpar,3,lckl)
938
 
c
939
 
c 3: for : cpd, rcpd, factkl, coefkl and skl all (klpar,lckl)
940
 
c
941
 
c 4. for : txcd(klpar,3,lckl)
942
 
c
943
 
c Total number of calls of Getmem is 13 or 15 (if gen.con.)
944
 
c------------------------------------------
945
 
      common /memor5x/ ieab,iecd
946
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
947
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
948
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
949
 
c
950
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
951
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
952
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
953
 
c
954
 
c------------------------------------------
955
 
      klpar=npkl
956
 
c------------------------------------------
957
 
c reserve memory for right-hand pairs KL :
958
 
c
959
 
       ndk=   klpar*lck
960
 
       ndl=   klpar*lcl
961
 
c
962
 
      call getmem(ndk,icc)        ! for  cc(klpar,lck)           1
963
 
      call getmem(ndl,idd)        ! for  dd(klpar,lcl)           2
964
 
      call getmem(ndk,icks)       ! for cks(klpar,lck)           3
965
 
      call getmem(ndl,icls)       ! for cls(klpar,lcl)           4
966
 
      call getmem(klpar*3,ixcd)  ! for xcd(klpar,3)              5
967
 
c
968
 
       ndkl=ndk*lcl
969
 
       ndkl3=ndkl*3
970
 
c
971
 
ckw Do not change this order
972
 
      call getmem(ndkl3,ixq)     ! for xq(klpar,3,lckl)          6
973
 
      call getmem(ndkl3,ixqn)    ! for xqn(klpar,3,lckl)         7
974
 
      call getmem(ndkl3,ixqq)    ! for xqq(klpar,3,lckl)         8
975
 
ckw up to here.
976
 
c
977
 
c     call getmem(ndkl,icpd)     ! for cpd(klapr,lckl)     
978
 
c     call getmem(ndkl,i1cpd)    ! for rcpd(klapr,lckl)   
979
 
      call getmem(ndkl,ifkl)     ! for factkl(klapr,lckl)        9
980
 
      call getmem(ndkl,ickl)     ! for coefkl(klapr,lckl)       10
981
 
      call getmem(ndkl,iecd)     ! for ecd(klapr,lckl)  
982
 
c
983
 
      call getmem(ndkl3,itxcd)   ! for txcd(klpar,3,lckl)       11
984
 
c
985
 
      ndklm=ndkl*mmax1
986
 
      call getmem(ndklm,icdnia)  ! for cdnia(klpar,mmax-1,lckl) 12
987
 
c
988
 
c------------------------------------------
989
 
c for general contraction on KL-pairs
990
 
c
991
 
      ngci1=ngci+1
992
 
      ngcj1=ngcj+1
993
 
      ngck1=ngck+1
994
 
      ngcl1=ngcl+1
995
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
996
 
c
997
 
c-----
998
 
c
999
 
      igck=1
1000
 
      igcl=1
1001
 
c
1002
 
      if(ngcd.gt.1) then
1003
 
        ndkg=ndk*ngck1
1004
 
        ndlg=ndl*ngcl1
1005
 
        call getmem(ndkg,igck)        !               13
1006
 
        call getmem(ndlg,igcl)        !               14
1007
 
      endif
1008
 
c------------------------------------------
1009
 
      end
1010
 
c================================================================
1011
 
      subroutine memo5c_1(bl,nbls,mmax1,npij,npkl,nfha,nfumax)
1012
 
      double precision bl(*)
1013
 
      common /cpu/ intsize,iacc,icache,memreal
1014
 
      common /contr/ ngci,ngcj,ngck,ngcl,lci,lcj,lck,lcl,lcij,lckl
1015
 
c------------------------------------------
1016
 
c Memory handling 
1017
 
c
1018
 
c 3: and quartets precalculations (12 quantities)
1019
 
c (for whole block of contracted quartets and 
1020
 
c        one primitive quartet )
1021
 
c
1022
 
c Total number of calls of Getmem is 24 or 26 (if gen.cont)
1023
 
c------------------------------------------
1024
 
      common /memor5a/ iaa,ibb,icc,idd,icis,icjs,icks,icls,
1025
 
     * ixab,ixp,ixpn,ixpp,iabnia,iapb,i1apb,ifij,icij,isab,
1026
 
     * ixcd,ixq,ixqn,ixqq,icdnia,icpd,i1cpd,ifkl,ickl,iscd
1027
 
c
1028
 
      common /memor5b/ irppq,
1029
 
     * irho,irr1,irys,irhoapb,irhocpd,iconst,ixwp,ixwq,ip1234,
1030
 
     * idx1,idx2,indx
1031
 
c
1032
 
      common /memor5c/ itxab,itxcd,iabcd,ihabcd
1033
 
      common /memor5d/ iabnix,icdnix,ixpnx,ixqnx,ihabcdx
1034
 
      common /memor5e/ igci,igcj,igck,igcl,indgc,igcoef,
1035
 
     *                 icfg,jcfg,kcfg,lcfg, igcij,igckl
1036
 
c
1037
 
      common /memor5f/ indxp
1038
 
c------------------------------------------
1039
 
c reserve memory for quartets ijkl
1040
 
c------------------------------------------
1041
 
      nblsi=nbls
1042
 
      if(intsize.ne.1) nblsi=nbls/intsize+1
1043
 
c------------------------------------------
1044
 
      call getmem(nblsi,indxp)   !                    3
1045
 
c------------------------------------------
1046
 
c
1047
 
      call getmem(nblsi,idx1)    ! for indxij         4
1048
 
      call getmem(nblsi,idx2)    ! for indxkj         5
1049
 
      call getmem(nblsi,indx)    ! for index          6
1050
 
c
1051
 
      call getmem(nbls,irppq)    ! for rppq(nbls)     7    
1052
 
cNOT  call getmem(nbls,irho)     ! for rho(nbls)      8   
1053
 
      call getmem(nbls,irr1)     ! for rr1(nbls)      9  
1054
 
c       
1055
 
c
1056
 
      call getmem(nbls,irhoapb)  ! for rhoapb(nbls)   10
1057
 
      call getmem(nbls,irhocpd)  ! for rhocpd(nbls)   11
1058
 
c
1059
 
      nbmx=nbls*mmax1
1060
 
      call getmem(nbmx,iabnix)   !                    12
1061
 
      call getmem(nbmx,icdnix)   !                    13
1062
 
c
1063
 
      nbls3=nbls*3
1064
 
      call getmem(nbls3,ixpnx)   !                    14
1065
 
      call getmem(nbls3,ixwp)    ! for xwp(nbls,3)    15
1066
 
      call getmem(nbls3,ixqnx)   !                    16
1067
 
      call getmem(nbls3,ixwq)    ! for xwq(nbls,3)    17
1068
 
      call getmem(nbls3,ip1234)  ! for p1234(nbls,3)  18
1069
 
      call getmem(nbls,iabcd)    ! for abcd(nbls)     19
1070
 
      call getmem(nbls,iconst)   ! for const(nbls)    20
1071
 
      call getmem(nbls,irys)     ! for rys(nbls)      21
1072
 
c
1073
 
      call getmem(nfha*3,ihabcd) !                    22
1074
 
      call getmem_zero(bl,nbls3*nfumax,ihabcdx)  !            23 ZERO
1075
 
c
1076
 
c------------------------------------------
1077
 
c for general contraction
1078
 
c
1079
 
      ngci1=ngci+1
1080
 
      ngcj1=ngcj+1
1081
 
      ngck1=ngck+1
1082
 
      ngcl1=ngcl+1
1083
 
      ngcd=ngci1*ngcj1*ngck1*ngcl1
1084
 
c
1085
 
c------------------------------------------
1086
 
c for both gen.contr. and segmented basis sets
1087
 
c because of the common Destiny
1088
 
c
1089
 
      call getmem(ngcd,icfg)          !               24
1090
 
      call getmem(ngcd,jcfg)          !               25
1091
 
      call getmem(ngcd,kcfg)          !               26
1092
 
      call getmem(ngcd,lcfg)          !               27
1093
 
c
1094
 
c------------------------------------------
1095
 
c for general contraction
1096
 
c
1097
 
      indgc=1
1098
 
      igcoef=1
1099
 
c
1100
 
      if(ngcd.gt.1) then
1101
 
        call getmem(nbls,indgc)       !               32
1102
 
        call getmem(nbls*ngcd,igcoef) !               33
1103
 
      endif
1104
 
c
1105
 
c------------------------------------------
1106
 
      end
1107
 
c====================================================================