1C Copyright (c) 2003-2010 University of Florida 2C 3C This program is free software; you can redistribute it and/or modify 4C it under the terms of the GNU General Public License as published by 5C the Free Software Foundation; either version 2 of the License, or 6C (at your option) any later version. 7 8C This program is distributed in the hope that it will be useful, 9C but WITHOUT ANY WARRANTY; without even the implied warranty of 10C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11C GNU General Public License for more details. 12 13C The GNU General Public License is included in this distribution 14C in the file COPYRIGHT. 15 SUBROUTINE ERD__DERV_INT2D_TO_E0C0 16 + 17 + ( SHELLA,SHELLP,SHELLC, 18 + NGQP,NEXQ,NGQEXQ, 19 + NXYZET,NXYZP,NXYZC, 20 + INT2DX,INT2DY,INT2DZ, 21 + DIFFY,DIFFZ, 22 + TEMP1,TEMP2, 23 + SCALE, 24 + 25 + BATCH ) 26 + 27C------------------------------------------------------------------------ 28C OPERATION : ERD__DERV_INT2D_TO_E0C0 29C MODULE : ELECTRON REPULSION INTEGRALS DIRECT 30C MODULE-ID : ERD 31C SUBROUTINES : none 32C DESCRIPTION : This routine assembles the set of batches of cartesian 33C derivative eris: 34C 35C [E0|C0] or [E0|0C] , E = A to P 36C 37C adding up the contributions from all the respective 38C derivative 2D integrals: 39C 40C PC0 or P0C 41C 42C Simplified version of the general E0CD routine to 43C reduce loop overheads for those cases where there is 44C at least one s-shell in the CD-part. For comments 45C and details see the general E0CD routine. 46C 47C 48C Input: 49C 50C SHELLx = shell types for individual csh 51C x=A,C and csh sum P=A+B 52C NGQP = # of gaussian quadrature points 53C (roots) 54C NEXQ = current # of exponent quadruplets 55C NGQEXQ = product of # of gaussian quadrature 56C points times exponent quadruplets 57C NXYZET = sum of # of cartesian monomials 58C for all shells in the range 59C E = A,...,P=A+B 60C NXYZy = # of cartesian monomials for 61C y = P,C shells 62C INT2Dx = all current 2D PC0/P0C derivative 63C integrals for each cartesian 64C component (x = X,Y,Z) 65C DIFFx = is true, if differentiation was 66C performed along the x=Y,Z direction 67C TEMP1(2) = scratch arrays holding intermediate 68C 2D PC0/P0C derivative integral 69C products 70C SCALE = the NGQEXQ scaling factors 71C 72C 73C Output: 74C 75C BATCH = batch of primitive cartesian [E0|C0] 76C or [E0|0C]derivative integrals 77C corresponding to all current 78C exponent quadruplets 79C 80C 81C AUTHOR : Norbert Flocke 82C------------------------------------------------------------------------ 83C 84C 85C ...include files and declare variables. 86C 87C 88 IMPLICIT NONE 89 90 LOGICAL DIFFY,DIFFZ 91 92 INTEGER I,J,M,N,R 93 INTEGER NGQP,NEXQ,NGQEXQ 94 INTEGER NXYZE,NXYZET,NXYZP,NXYZC 95 INTEGER SE 96 INTEGER SEEND 97 INTEGER SHELLA,SHELLP,SHELLC 98 INTEGER XC,YC,ZC 99 INTEGER XCP 100 INTEGER XE,YE,ZE 101 INTEGER XEMAX 102 INTEGER XEP,XYEP 103 INTEGER XYE 104 INTEGER YCMAX 105 INTEGER YEEND 106 107 DOUBLE PRECISION SUM 108 DOUBLE PRECISION ZERO 109 110 DOUBLE PRECISION SCALE (1:NGQEXQ) 111 DOUBLE PRECISION TEMP1 (1:NGQEXQ) 112 DOUBLE PRECISION TEMP2 (1:NGQEXQ) 113 114 DOUBLE PRECISION BATCH (1:NEXQ,1:NXYZET,1:NXYZC) 115 116 DOUBLE PRECISION INT2DX (1:NGQEXQ,0:SHELLP,0:SHELLC) 117 DOUBLE PRECISION INT2DY (1:NGQEXQ,0:SHELLP,0:SHELLC) 118 DOUBLE PRECISION INT2DZ (1:NGQEXQ,0:SHELLP,0:SHELLC) 119 120 PARAMETER (ZERO = 0.D0) 121C 122C 123C------------------------------------------------------------------------ 124C 125C 126C ...jump according to number of roots. 127C 128C 129 GOTO (1,2,3,4,5,6,7,8,9,10) MIN (NGQP,10) 130C 131C 132C ******************** 133C * # of roots = 1 * 134C ******************** 135C 136C 137 1 XCP = 0 138 DO 100 XC = SHELLC,0,-1 139 YCMAX = SHELLC - XC 140 141 XEP = NXYZET + 3 142 DO 102 XE = 0,SHELLP 143 XEP = XEP + XE - 2 144 XEMAX = XE * SHELLP 145 YEEND = SHELLP - XE 146 147 DO M = 1,NEXQ 148 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 149 END DO 150 151 J = XCP 152 DO 110 YC = YCMAX,0,-1 153 J = J + 1 154 ZC = YCMAX - YC 155 156 XYEP = XEP - XEMAX 157 DO 112 YE = 0,YEEND 158 XYE = XE + YE 159 XYEP = XYEP - 1 160 SEEND = MAX0 (SHELLA,XYE) 161 162 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 163 DO M = 1,NEXQ 164 TEMP2 (M) = TEMP1 (M) 165 END DO 166 ELSE 167 DO M = 1,NEXQ 168 TEMP2 (M) = TEMP1 (M) * INT2DY (M,YE,YC) 169 END DO 170 END IF 171 172 I = XYEP 173 NXYZE = NXYZP 174 DO 120 SE = SHELLP,SEEND,-1 175 ZE = SE - XYE 176 177 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 178 DO M = 1,NEXQ 179 BATCH (M,I,J) = TEMP2 (M) 180 END DO 181 ELSE 182 DO M = 1,NEXQ 183 BATCH (M,I,J) = TEMP2 (M) 184 + * INT2DZ (M,ZE,ZC) 185 END DO 186 END IF 187 188 I = I - NXYZE + XE 189 NXYZE = NXYZE - SE - 1 190 120 CONTINUE 191 112 CONTINUE 192 110 CONTINUE 193 102 CONTINUE 194 XCP = J 195 100 CONTINUE 196 197 RETURN 198C 199C 200C ******************** 201C * # of roots = 2 * 202C ******************** 203C 204C 205 2 XCP = 0 206 DO 200 XC = SHELLC,0,-1 207 YCMAX = SHELLC - XC 208 209 XEP = NXYZET + 3 210 DO 202 XE = 0,SHELLP 211 XEP = XEP + XE - 2 212 XEMAX = XE * SHELLP 213 YEEND = SHELLP - XE 214 215 DO M = 1,NGQEXQ 216 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 217 END DO 218 219 J = XCP 220 DO 210 YC = YCMAX,0,-1 221 J = J + 1 222 ZC = YCMAX - YC 223 224 XYEP = XEP - XEMAX 225 DO 212 YE = 0,YEEND 226 XYE = XE + YE 227 XYEP = XYEP - 1 228 SEEND = MAX0 (SHELLA,XYE) 229 230 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 231 DO N = 1,NGQEXQ 232 TEMP2 (N) = TEMP1 (N) 233 END DO 234 ELSE 235 DO N = 1,NGQEXQ 236 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 237 END DO 238 END IF 239 240 I = XYEP 241 NXYZE = NXYZP 242 DO 220 SE = SHELLP,SEEND,-1 243 ZE = SE - XYE 244 245 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 246 R = 1 247 DO M = 1,NEXQ 248 BATCH (M,I,J) = TEMP2 (R) 249 + + TEMP2 (R+1) 250 R = R + 2 251 END DO 252 ELSE 253 R = 1 254 DO M = 1,NEXQ 255 BATCH (M,I,J) = TEMP2 (R) 256 + * INT2DZ (R,ZE,ZC) 257 + + TEMP2 (R+1) 258 + * INT2DZ (R+1,ZE,ZC) 259 R = R + 2 260 END DO 261 END IF 262 263 I = I - NXYZE + XE 264 NXYZE = NXYZE - SE - 1 265 220 CONTINUE 266 212 CONTINUE 267 210 CONTINUE 268 202 CONTINUE 269 XCP = J 270 200 CONTINUE 271 272 RETURN 273C 274C 275C ******************** 276C * # of roots = 3 * 277C ******************** 278C 279C 280 3 XCP = 0 281 DO 300 XC = SHELLC,0,-1 282 YCMAX = SHELLC - XC 283 284 XEP = NXYZET + 3 285 DO 302 XE = 0,SHELLP 286 XEP = XEP + XE - 2 287 XEMAX = XE * SHELLP 288 YEEND = SHELLP - XE 289 290 DO M = 1,NGQEXQ 291 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 292 END DO 293 294 J = XCP 295 DO 310 YC = YCMAX,0,-1 296 J = J + 1 297 ZC = YCMAX - YC 298 299 XYEP = XEP - XEMAX 300 DO 312 YE = 0,YEEND 301 XYE = XE + YE 302 XYEP = XYEP - 1 303 SEEND = MAX0 (SHELLA,XYE) 304 305 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 306 DO N = 1,NGQEXQ 307 TEMP2 (N) = TEMP1 (N) 308 END DO 309 ELSE 310 DO N = 1,NGQEXQ 311 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 312 END DO 313 END IF 314 315 I = XYEP 316 NXYZE = NXYZP 317 DO 320 SE = SHELLP,SEEND,-1 318 ZE = SE - XYE 319 320 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 321 R = 1 322 DO M = 1,NEXQ 323 BATCH (M,I,J) = TEMP2 (R) 324 + + TEMP2 (R+1) 325 + + TEMP2 (R+2) 326 R = R + 3 327 END DO 328 ELSE 329 R = 1 330 DO M = 1,NEXQ 331 BATCH (M,I,J) = TEMP2 (R) 332 + * INT2DZ (R,ZE,ZC) 333 + + TEMP2 (R+1) 334 + * INT2DZ (R+1,ZE,ZC) 335 + + TEMP2 (R+2) 336 + * INT2DZ (R+2,ZE,ZC) 337 R = R + 3 338 END DO 339 END IF 340 341 I = I - NXYZE + XE 342 NXYZE = NXYZE - SE - 1 343 320 CONTINUE 344 312 CONTINUE 345 310 CONTINUE 346 302 CONTINUE 347 XCP = J 348 300 CONTINUE 349 350 RETURN 351C 352C 353C ******************** 354C * # of roots = 4 * 355C ******************** 356C 357C 358 4 XCP = 0 359 DO 400 XC = SHELLC,0,-1 360 YCMAX = SHELLC - XC 361 362 XEP = NXYZET + 3 363 DO 402 XE = 0,SHELLP 364 XEP = XEP + XE - 2 365 XEMAX = XE * SHELLP 366 YEEND = SHELLP - XE 367 368 DO M = 1,NGQEXQ 369 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 370 END DO 371 372 J = XCP 373 DO 410 YC = YCMAX,0,-1 374 J = J + 1 375 ZC = YCMAX - YC 376 377 XYEP = XEP - XEMAX 378 DO 412 YE = 0,YEEND 379 XYE = XE + YE 380 XYEP = XYEP - 1 381 SEEND = MAX0 (SHELLA,XYE) 382 383 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 384 DO N = 1,NGQEXQ 385 TEMP2 (N) = TEMP1 (N) 386 END DO 387 ELSE 388 DO N = 1,NGQEXQ 389 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 390 END DO 391 END IF 392 393 I = XYEP 394 NXYZE = NXYZP 395 DO 420 SE = SHELLP,SEEND,-1 396 ZE = SE - XYE 397 398 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 399 R = 1 400 DO M = 1,NEXQ 401 BATCH (M,I,J) = TEMP2 (R) 402 + + TEMP2 (R+1) 403 + + TEMP2 (R+2) 404 + + TEMP2 (R+3) 405 R = R + 4 406 END DO 407 ELSE 408 R = 1 409 DO M = 1,NEXQ 410 BATCH (M,I,J) = TEMP2 (R) 411 + * INT2DZ (R,ZE,ZC) 412 + + TEMP2 (R+1) 413 + * INT2DZ (R+1,ZE,ZC) 414 + + TEMP2 (R+2) 415 + * INT2DZ (R+2,ZE,ZC) 416 + + TEMP2 (R+3) 417 + * INT2DZ (R+3,ZE,ZC) 418 R = R + 4 419 END DO 420 END IF 421 422 I = I - NXYZE + XE 423 NXYZE = NXYZE - SE - 1 424 420 CONTINUE 425 412 CONTINUE 426 410 CONTINUE 427 402 CONTINUE 428 XCP = J 429 400 CONTINUE 430 431 RETURN 432C 433C 434C ******************** 435C * # of roots = 5 * 436C ******************** 437C 438C 439 5 XCP = 0 440 DO 500 XC = SHELLC,0,-1 441 YCMAX = SHELLC - XC 442 443 XEP = NXYZET + 3 444 DO 502 XE = 0,SHELLP 445 XEP = XEP + XE - 2 446 XEMAX = XE * SHELLP 447 YEEND = SHELLP - XE 448 449 DO M = 1,NGQEXQ 450 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 451 END DO 452 453 J = XCP 454 DO 510 YC = YCMAX,0,-1 455 J = J + 1 456 ZC = YCMAX - YC 457 458 XYEP = XEP - XEMAX 459 DO 512 YE = 0,YEEND 460 XYE = XE + YE 461 XYEP = XYEP - 1 462 SEEND = MAX0 (SHELLA,XYE) 463 464 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 465 DO N = 1,NGQEXQ 466 TEMP2 (N) = TEMP1 (N) 467 END DO 468 ELSE 469 DO N = 1,NGQEXQ 470 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 471 END DO 472 END IF 473 474 I = XYEP 475 NXYZE = NXYZP 476 DO 520 SE = SHELLP,SEEND,-1 477 ZE = SE - XYE 478 479 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 480 R = 1 481 DO M = 1,NEXQ 482 BATCH (M,I,J) = TEMP2 (R) 483 + + TEMP2 (R+1) 484 + + TEMP2 (R+2) 485 + + TEMP2 (R+3) 486 + + TEMP2 (R+4) 487 R = R + 5 488 END DO 489 ELSE 490 R = 1 491 DO M = 1,NEXQ 492 BATCH (M,I,J) = TEMP2 (R) 493 + * INT2DZ (R,ZE,ZC) 494 + + TEMP2 (R+1) 495 + * INT2DZ (R+1,ZE,ZC) 496 + + TEMP2 (R+2) 497 + * INT2DZ (R+2,ZE,ZC) 498 + + TEMP2 (R+3) 499 + * INT2DZ (R+3,ZE,ZC) 500 + + TEMP2 (R+4) 501 + * INT2DZ (R+4,ZE,ZC) 502 R = R + 5 503 END DO 504 END IF 505 506 I = I - NXYZE + XE 507 NXYZE = NXYZE - SE - 1 508 520 CONTINUE 509 512 CONTINUE 510 510 CONTINUE 511 502 CONTINUE 512 XCP = J 513 500 CONTINUE 514 515 RETURN 516C 517C 518C ******************** 519C * # of roots = 6 * 520C ******************** 521C 522C 523 6 XCP = 0 524 DO 600 XC = SHELLC,0,-1 525 YCMAX = SHELLC - XC 526 527 XEP = NXYZET + 3 528 DO 602 XE = 0,SHELLP 529 XEP = XEP + XE - 2 530 XEMAX = XE * SHELLP 531 YEEND = SHELLP - XE 532 533 DO M = 1,NGQEXQ 534 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 535 END DO 536 537 J = XCP 538 DO 610 YC = YCMAX,0,-1 539 J = J + 1 540 ZC = YCMAX - YC 541 542 XYEP = XEP - XEMAX 543 DO 612 YE = 0,YEEND 544 XYE = XE + YE 545 XYEP = XYEP - 1 546 SEEND = MAX0 (SHELLA,XYE) 547 548 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 549 DO N = 1,NGQEXQ 550 TEMP2 (N) = TEMP1 (N) 551 END DO 552 ELSE 553 DO N = 1,NGQEXQ 554 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 555 END DO 556 END IF 557 558 I = XYEP 559 NXYZE = NXYZP 560 DO 620 SE = SHELLP,SEEND,-1 561 ZE = SE - XYE 562 563 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 564 R = 1 565 DO M = 1,NEXQ 566 BATCH (M,I,J) = TEMP2 (R) 567 + + TEMP2 (R+1) 568 + + TEMP2 (R+2) 569 + + TEMP2 (R+3) 570 + + TEMP2 (R+4) 571 + + TEMP2 (R+5) 572 R = R + 6 573 END DO 574 ELSE 575 R = 1 576 DO M = 1,NEXQ 577 BATCH (M,I,J) = TEMP2 (R) 578 + * INT2DZ (R,ZE,ZC) 579 + + TEMP2 (R+1) 580 + * INT2DZ (R+1,ZE,ZC) 581 + + TEMP2 (R+2) 582 + * INT2DZ (R+2,ZE,ZC) 583 + + TEMP2 (R+3) 584 + * INT2DZ (R+3,ZE,ZC) 585 + + TEMP2 (R+4) 586 + * INT2DZ (R+4,ZE,ZC) 587 + + TEMP2 (R+5) 588 + * INT2DZ (R+5,ZE,ZC) 589 R = R + 6 590 END DO 591 END IF 592 593 I = I - NXYZE + XE 594 NXYZE = NXYZE - SE - 1 595 620 CONTINUE 596 612 CONTINUE 597 610 CONTINUE 598 602 CONTINUE 599 XCP = J 600 600 CONTINUE 601 602 RETURN 603C 604C 605C ******************** 606C * # of roots = 7 * 607C ******************** 608C 609C 610 7 XCP = 0 611 DO 700 XC = SHELLC,0,-1 612 YCMAX = SHELLC - XC 613 614 XEP = NXYZET + 3 615 DO 702 XE = 0,SHELLP 616 XEP = XEP + XE - 2 617 XEMAX = XE * SHELLP 618 YEEND = SHELLP - XE 619 620 DO M = 1,NGQEXQ 621 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 622 END DO 623 624 J = XCP 625 DO 710 YC = YCMAX,0,-1 626 J = J + 1 627 ZC = YCMAX - YC 628 629 XYEP = XEP - XEMAX 630 DO 712 YE = 0,YEEND 631 XYE = XE + YE 632 XYEP = XYEP - 1 633 SEEND = MAX0 (SHELLA,XYE) 634 635 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 636 DO N = 1,NGQEXQ 637 TEMP2 (N) = TEMP1 (N) 638 END DO 639 ELSE 640 DO N = 1,NGQEXQ 641 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 642 END DO 643 END IF 644 645 I = XYEP 646 NXYZE = NXYZP 647 DO 720 SE = SHELLP,SEEND,-1 648 ZE = SE - XYE 649 650 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 651 R = 1 652 DO M = 1,NEXQ 653 BATCH (M,I,J) = TEMP2 (R) 654 + + TEMP2 (R+1) 655 + + TEMP2 (R+2) 656 + + TEMP2 (R+3) 657 + + TEMP2 (R+4) 658 + + TEMP2 (R+5) 659 + + TEMP2 (R+6) 660 R = R + 7 661 END DO 662 ELSE 663 R = 1 664 DO M = 1,NEXQ 665 BATCH (M,I,J) = TEMP2 (R) 666 + * INT2DZ (R,ZE,ZC) 667 + + TEMP2 (R+1) 668 + * INT2DZ (R+1,ZE,ZC) 669 + + TEMP2 (R+2) 670 + * INT2DZ (R+2,ZE,ZC) 671 + + TEMP2 (R+3) 672 + * INT2DZ (R+3,ZE,ZC) 673 + + TEMP2 (R+4) 674 + * INT2DZ (R+4,ZE,ZC) 675 + + TEMP2 (R+5) 676 + * INT2DZ (R+5,ZE,ZC) 677 + + TEMP2 (R+6) 678 + * INT2DZ (R+6,ZE,ZC) 679 R = R + 7 680 END DO 681 END IF 682 683 I = I - NXYZE + XE 684 NXYZE = NXYZE - SE - 1 685 720 CONTINUE 686 712 CONTINUE 687 710 CONTINUE 688 702 CONTINUE 689 XCP = J 690 700 CONTINUE 691 692 RETURN 693C 694C 695C ******************** 696C * # of roots = 8 * 697C ******************** 698C 699C 700 8 XCP = 0 701 DO 800 XC = SHELLC,0,-1 702 YCMAX = SHELLC - XC 703 704 XEP = NXYZET + 3 705 DO 802 XE = 0,SHELLP 706 XEP = XEP + XE - 2 707 XEMAX = XE * SHELLP 708 YEEND = SHELLP - XE 709 710 DO M = 1,NGQEXQ 711 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 712 END DO 713 714 J = XCP 715 DO 810 YC = YCMAX,0,-1 716 J = J + 1 717 ZC = YCMAX - YC 718 719 XYEP = XEP - XEMAX 720 DO 812 YE = 0,YEEND 721 XYE = XE + YE 722 XYEP = XYEP - 1 723 SEEND = MAX0 (SHELLA,XYE) 724 725 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 726 DO N = 1,NGQEXQ 727 TEMP2 (N) = TEMP1 (N) 728 END DO 729 ELSE 730 DO N = 1,NGQEXQ 731 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 732 END DO 733 END IF 734 735 I = XYEP 736 NXYZE = NXYZP 737 DO 820 SE = SHELLP,SEEND,-1 738 ZE = SE - XYE 739 740 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 741 R = 1 742 DO M = 1,NEXQ 743 BATCH (M,I,J) = TEMP2 (R) 744 + + TEMP2 (R+1) 745 + + TEMP2 (R+2) 746 + + TEMP2 (R+3) 747 + + TEMP2 (R+4) 748 + + TEMP2 (R+5) 749 + + TEMP2 (R+6) 750 + + TEMP2 (R+7) 751 R = R + 8 752 END DO 753 ELSE 754 R = 1 755 DO M = 1,NEXQ 756 BATCH (M,I,J) = TEMP2 (R) 757 + * INT2DZ (R,ZE,ZC) 758 + + TEMP2 (R+1) 759 + * INT2DZ (R+1,ZE,ZC) 760 + + TEMP2 (R+2) 761 + * INT2DZ (R+2,ZE,ZC) 762 + + TEMP2 (R+3) 763 + * INT2DZ (R+3,ZE,ZC) 764 + + TEMP2 (R+4) 765 + * INT2DZ (R+4,ZE,ZC) 766 + + TEMP2 (R+5) 767 + * INT2DZ (R+5,ZE,ZC) 768 + + TEMP2 (R+6) 769 + * INT2DZ (R+6,ZE,ZC) 770 + + TEMP2 (R+7) 771 + * INT2DZ (R+7,ZE,ZC) 772 R = R + 8 773 END DO 774 END IF 775 776 I = I - NXYZE + XE 777 NXYZE = NXYZE - SE - 1 778 820 CONTINUE 779 812 CONTINUE 780 810 CONTINUE 781 802 CONTINUE 782 XCP = J 783 800 CONTINUE 784 785 RETURN 786C 787C 788C ******************** 789C * # of roots = 9 * 790C ******************** 791C 792C 793 9 XCP = 0 794 DO 900 XC = SHELLC,0,-1 795 YCMAX = SHELLC - XC 796 797 XEP = NXYZET + 3 798 DO 902 XE = 0,SHELLP 799 XEP = XEP + XE - 2 800 XEMAX = XE * SHELLP 801 YEEND = SHELLP - XE 802 803 DO M = 1,NGQEXQ 804 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 805 END DO 806 807 J = XCP 808 DO 910 YC = YCMAX,0,-1 809 J = J + 1 810 ZC = YCMAX - YC 811 812 XYEP = XEP - XEMAX 813 DO 912 YE = 0,YEEND 814 XYE = XE + YE 815 XYEP = XYEP - 1 816 SEEND = MAX0 (SHELLA,XYE) 817 818 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 819 DO N = 1,NGQEXQ 820 TEMP2 (N) = TEMP1 (N) 821 END DO 822 ELSE 823 DO N = 1,NGQEXQ 824 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 825 END DO 826 END IF 827 828 I = XYEP 829 NXYZE = NXYZP 830 DO 920 SE = SHELLP,SEEND,-1 831 ZE = SE - XYE 832 833 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 834 R = 1 835 DO M = 1,NEXQ 836 BATCH (M,I,J) = TEMP2 (R) 837 + + TEMP2 (R+1) 838 + + TEMP2 (R+2) 839 + + TEMP2 (R+3) 840 + + TEMP2 (R+4) 841 + + TEMP2 (R+5) 842 + + TEMP2 (R+6) 843 + + TEMP2 (R+7) 844 + + TEMP2 (R+8) 845 R = R + 9 846 END DO 847 ELSE 848 R = 1 849 DO M = 1,NEXQ 850 BATCH (M,I,J) = TEMP2 (R) 851 + * INT2DZ (R,ZE,ZC) 852 + + TEMP2 (R+1) 853 + * INT2DZ (R+1,ZE,ZC) 854 + + TEMP2 (R+2) 855 + * INT2DZ (R+2,ZE,ZC) 856 + + TEMP2 (R+3) 857 + * INT2DZ (R+3,ZE,ZC) 858 + + TEMP2 (R+4) 859 + * INT2DZ (R+4,ZE,ZC) 860 + + TEMP2 (R+5) 861 + * INT2DZ (R+5,ZE,ZC) 862 + + TEMP2 (R+6) 863 + * INT2DZ (R+6,ZE,ZC) 864 + + TEMP2 (R+7) 865 + * INT2DZ (R+7,ZE,ZC) 866 + + TEMP2 (R+8) 867 + * INT2DZ (R+8,ZE,ZC) 868 R = R + 9 869 END DO 870 END IF 871 872 I = I - NXYZE + XE 873 NXYZE = NXYZE - SE - 1 874 920 CONTINUE 875 912 CONTINUE 876 910 CONTINUE 877 902 CONTINUE 878 XCP = J 879 900 CONTINUE 880 881 RETURN 882C 883C 884C ******************** 885C * # of roots > 9 * 886C ******************** 887C 888C ...outer loops over x,x-pairs. No skipping of the 889C x,x-contribution of 0,0-type can be done here, 890C since the 2DX integrals carry the Rys weight! 891C 892C 893 10 XCP = 0 894 DO 1000 XC = SHELLC,0,-1 895 YCMAX = SHELLC - XC 896 897 XEP = NXYZET + 3 898 DO 1002 XE = 0,SHELLP 899 XEP = XEP + XE - 2 900 XEMAX = XE * SHELLP 901 YEEND = SHELLP - XE 902 903 DO M = 1,NGQEXQ 904 TEMP1 (M) = SCALE (M) * INT2DX (M,XE,XC) 905 END DO 906C 907C 908C ...middle loops over y,y-pairs. Skip multiplication 909C of y,y-contributions, if no y-coordinate derivative 910C was formed and we have a 0,0-pair, as then the 2DY 911C integrals are equal to 1. 912C 913C 914 J = XCP 915 DO 1010 YC = YCMAX,0,-1 916 J = J + 1 917 ZC = YCMAX - YC 918 919 XYEP = XEP - XEMAX 920 DO 1012 YE = 0,YEEND 921 XYE = XE + YE 922 XYEP = XYEP - 1 923 SEEND = MAX0 (SHELLA,XYE) 924 925 IF (.NOT.DIFFY .AND. YE+YC.EQ.0) THEN 926 DO N = 1,NGQEXQ 927 TEMP2 (N) = TEMP1 (N) 928 END DO 929 ELSE 930 DO N = 1,NGQEXQ 931 TEMP2 (N) = TEMP1 (N) * INT2DY (N,YE,YC) 932 END DO 933 END IF 934C 935C 936C ...inner loop over E shells. Skip multiplication of 937C z,z-contributions, if we have a 0,0-pair and 938C no derivations were performed on the z-coordinate, 939C as then the 2DZ integrals are equal to 1. 940C All info concerning all three x,x-, y,y- and 941C z,z-pairs have been collected for all exponent 942C quadruplets at once. Sum up the 2D X,Y,Z integral 943C products to the appropriate place of the batch. 944C 945C 946 I = XYEP 947 NXYZE = NXYZP 948 DO 1020 SE = SHELLP,SEEND,-1 949 ZE = SE - XYE 950 951 IF (.NOT.DIFFZ .AND. ZE+ZC.EQ.0) THEN 952 R = 0 953 DO M = 1,NEXQ 954 SUM = ZERO 955 DO N = 1,NGQP 956 SUM = SUM + TEMP2 (R+N) 957 END DO 958 R = R + NGQP 959 BATCH (M,I,J) = SUM 960 END DO 961 ELSE 962 R = 0 963 DO M = 1,NEXQ 964 SUM = ZERO 965 DO N = 1,NGQP 966 SUM = SUM + TEMP2 (R+N) 967 + * INT2DZ (R+N,ZE,ZC) 968 END DO 969 R = R + NGQP 970 BATCH (M,I,J) = SUM 971 END DO 972 END IF 973C 974C 975C ...next z,z-pair. 976C 977C 978 I = I - NXYZE + XE 979 NXYZE = NXYZE - SE - 1 980 1020 CONTINUE 981C 982C 983C ...next y,y-pair and next x,x-pair. 984C 985C 986 1012 CONTINUE 987 1010 CONTINUE 988 1002 CONTINUE 989 XCP = J 990 1000 CONTINUE 991C 992C 993C ...ready! 994C 995C 996 RETURN 997 END 998