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