C CHELP-NET ATOMIC CHARGES FROM AB INITIO WAVE FUNCTIONS CHE00010 C Modified for Grid Operations by Curt Breneman, Yale University CHE00020 C Department of Chemistry, 3/88 (Currently of Rensselaer CHE00030 C Polytechnic Institute, Troy, NY 12180.) CHE00040 C CHE00050 C CHELPG CHE00060 C CHE00070 C (NET ATOMIC) CHARGES FIT TO ELECTROSTATIC POTENTIALS CHE00080 C CHE00090 C Original CHELP code by: CHE00100 C M.M. FRANCL CHE00110 C L.E. CHIRLIAN CHE00120 C CHE00130 C OCTOBER 1985 CHE00140 C PRINCETON CHEMISTRY DEPARTMENT VAX 11/780 CHE00150 C VMS 3.7 CHE00160 C CHE00170 C FEBRUARY 1988 CHE00180 C MODIFIED TO USE GAUSSIAN86 CHECKPOINT FILES CHE00190 C Modified to use G88/90 checkpoint files 1/89 CHE00200 C YALE UNIVERSITY DEPARTMENT OF CHEMISTRY CHE00210 C WIBERG GROUP VMS 4.5 CHE00220 C CURT BRENEMAN CHE00230 C CHE00240 IMPLICIT REAL*8 (A-H,O-Z) CHE00250 INTEGER*4 HANDLE1 CHE00260 HANDLE1=0 CHE00270 C*** TRACE-7 CHE00280 C ISTAT1=LIB$INIT_TIMER(HANDLE1) CHE00290 C*** CHE00300 C CHE00310 C READ IN DATA FROM CHECKPOINT FILE CHE00320 C CHE00330 CALL READIN CHE00340 C CHE00350 C CHE00360 C SELECT POINTS FOR FITTING, BEGIN WITH SHELL OF RADIUS 2A AND CHE00370 C INCREASING BY .5A SELECT POINTS FROM THE ROUGHLY RADIAL DISTRIBCHE00380 C WHICH ARE NOT ENCLOSED BY THE VAN DER WAALS ENVELOPE OF THE MOLCHE00390 C UNTIL A PREDETERMINED MAXIMUM NUMBER OF POINTS HAS BEEN REACHEDCHE00400 C CHE00410 CALL BALL CHE00420 C CHE00430 C CALCULATE THE ELECTROSTATIC POTENTIAL USING FIRST ORDER HARTREECHE00440 C PERTURBATION THEORY CHE00450 C CHE00460 CALL EP CHE00470 C CHE00480 C USING METHOD OF LAGRANGE MULTIPLIERS, FIT BY LEAST SQUARES THE CHE00490 C TO THE ELECTROSTATIC POTENTIAL, CONSTRAINING THE FIT TO REPRODUCHE00500 C TOTAL MOLECULAR CHARGE CHE00510 C CHE00520 CALL FIT CHE00530 C CHE00540 C PRINT OUT TABLE OF RESULTS CHE00550 C CHE00560 CALL OUTPUT CHE00570 C CHE00580 C*** TRACE-7 CHE00590 C ISTAT1=LIB$SHOW_TIMER(HANDLE1) CHE00600 C*** CHE00610 END CHE00620 C CHE00630 C CHE00640 SUBROUTINE BALL CHE00650 C CHE00660 C ROUTINE TO SELECT POINTS FOR FITTING TO THE ELECTROSTATIC POTENCHE00670 C CHE00680 C POINTS WHICH LIE WITHIN THE VAN DER WAALS ENVELOPE OF THE MOLECCHE00690 C ARE EXCLUDED. CHE00700 C CHE00710 C POINTS ARE INITIALLY SELECTED IN A CUBE AROUND THE MOLECULE WHICHE00720 C IS SCALED TO THE SIZE OF THE MOLECULE+RMAX. THIS IS PRESENTLY AN INPUCHE00730 C PARAMETER. POINTS ARE THEN EXCLUDED IF THEY FALL WITHIN THE INPUT CHE00740 C VDW RADIUS OF ANY OF THE ATOMS, OR, IF THEY FALL OUTSIDE CHE00750 C A DESIGNATED DISTANCE (RMAX) FROM ALL OF THE ATOMS. THE REMAINING CHE00760 C POINTS ARE PACKED IN A SET OF THREE (X,Y,Z) VECTORS, AND SENT TO THE CHE00770 C LAGRANGE LEAST-SQUARES FITTING ROUTINE. THE ORIGINAL CHELP INPUT CHE00780 C DECK IS AUGMENTED BY ADDING TWO FREE-FORMAT VARIABLES AT THE END. CHE00790 C THE TWO NEW INPUT VARIABLES ARE 'RMAX' AND 'DELR', WHERE RMAX CHE00800 C IS THE MAXIMUM DISTANCE A POINT CAN BE FROM ANY ATOM AND STILL CHE00810 C BE CONSIDERED IN THE FIT, AND DELR IS THE DISTANCE BETWEEN POINTS CHE00820 C IN THE GRID. BOTH RMAX AND DELR ARE IN ANGSTROMS. CHE00830 C CHE00840 C CURT BRENEMAN AND TERESA LEPAGE CHE00850 C YALE UNIVERSITY DEPARTMENT OF CHEMISTRY 3/88 CHE00860 C CHE00870 C ORIGINAL CODE BY: CHE00880 C CHE00890 C L.E. CHIRLIAN CHE00900 C M.M. FRANCL CHE00910 C APRIL 1985 CHE00920 C CHE00930 IMPLICIT REAL*8 (A-H,O-Z) CHE00940 C CHE00950 PARAMETER (NPOINTS = 50000) CHE00960 COMMON /IO/ IN,IOUT CHE00970 C+++ CHE00980 COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS, CHE00990 $ IAN(401),ATMCHG(400),C(3,400) CHE01000 C+++ CHE01010 COMMON /IPO/ IPO(5) CHE01020 COMMON /SPHERE/ RADII(400),NTOTP CHE01030 COMMON /POINTS/ P(3,NPOINTS), MAXPNTS CHE01040 C CHE01050 DATA ANG2AU /1.889726878D0/ CHE01060 C CHE01070 C*** READ IN THE THE RMAX AND DELR VALUES IN ANGSTROMS. CHE01080 C CHE01090 read(IN,*) RMAX, DELR CHE01100 write(IOUT,*) ' RMAX = ',RMAX,' (ANGS), DELR = ',DELR,' (ANGS).' CHE01110 C*** CHE01120 C CHE01130 C CONVERT RADII TO AU CHE01140 C CHE01150 DELR = DELR * ANG2AU CHE01160 RMAX = RMAX * ANG2AU CHE01170 C CHE01180 C WHILE CONVERTING THE VDW RADII TO AU, FIND THE EXTREMA OF THE CHE01190 C MOLECULAR GEOMETRY. CHE01200 C CHE01210 XMAX=-50.0D0 CHE01220 XMIN=50.0D0 CHE01230 YMAX=-50.0D0 CHE01240 YMIN=50.0D0 CHE01250 ZMAX=-50.0D0 CHE01260 ZMIN=50.0D0 CHE01270 C CHE01280 WRITE(IOUT,*) ' THERE ARE ',NATOMS,' ATOMS TO CONSIDER.' CHE01290 DO 10 I=1,NATOMS CHE01300 RADII(I) = RADII(I) * ANG2AU CHE01310 C CHE01320 IF (C(1,I) .GT. XMAX) XMAX = C(1,I) CHE01330 IF (C(1,I) .LT. XMIN) XMIN = C(1,I) CHE01340 IF (C(2,I) .GT. YMAX) YMAX = C(2,I) CHE01350 IF (C(2,I) .LT. YMIN) YMIN = C(2,I) CHE01360 IF (C(3,I) .GT. ZMAX) ZMAX = C(3,I) CHE01370 IF (C(3,I) .LT. ZMIN) ZMIN = C(3,I) CHE01380 10 CONTINUE CHE01390 C CHE01400 WRITE(IOUT,*) ' XMAX = ',XMAX,' (AU), XMIN = ',XMIN,' (AU).' CHE01410 WRITE(IOUT,*) ' YMAX = ',YMAX,' (AU), YMIN = ',YMIN,' (AU).' CHE01420 WRITE(IOUT,*) ' ZMAX = ',ZMAX,' (AU), ZMIN = ',ZMIN,' (AU).' CHE01430 C CHE01440 C DETERMINE THE MINIMUM CUBE DIMENSIONS REQUIRED TO CONTAIN CHE01450 C THE MOLECULE, INCLUDING THE MAXIMUM SELECTION RADIUS (RMAX) CHE01460 C ON BOTH SIDES. CHE01470 C CHE01480 XRANGE = XMAX - XMIN + 2.0D0 * RMAX CHE01490 YRANGE = YMAX - YMIN + 2.0D0 * RMAX CHE01500 ZRANGE = ZMAX - ZMIN + 2.0D0 * RMAX CHE01510 C CHE01520 NXPTS = INT(XRANGE/DELR) CHE01530 NYPTS = INT(YRANGE/DELR) CHE01540 NZPTS = INT(ZRANGE/DELR) CHE01550 C CHE01560 WRITE(IOUT,*) ' NUMBER OF X POINTS REQUIRED = ',NXPTS CHE01570 WRITE(IOUT,*) ' NUMBER OF Y POINTS REQUIRED = ',NYPTS CHE01580 WRITE(IOUT,*) ' NUMBER OF Z POINTS REQUIRED = ',NZPTS CHE01590 MAXPOSS = NXPTS * NYPTS * NZPTS CHE01600 WRITE(IOUT,*) ' TOTAL NUMBER OF POINTS CONSIDERED = ',MAXPOSS CHE01610 C CHE01620 C CHE01630 C RESET POINT COUNTER FOR NUMBER OF SELECTED POINTS CHE01640 C CHE01650 IPOINT = 0 CHE01660 C CHE01670 C LOOP OVER POSSIBLE POINTS CHE01680 C CHE01690 DO 200 II = 1,NXPTS + 1 CHE01700 C CHE01710 P1 = XMIN - RMAX + DBLE(II-1) * DELR CHE01720 C CHE01730 DO 200 JJ = 1,NYPTS + 1 CHE01740 C CHE01750 P2 = YMIN - RMAX + DBLE(JJ-1) * DELR CHE01760 C CHE01770 DO 200 KK = 1,NZPTS + 1 CHE01780 C CHE01790 P3 = ZMIN - RMAX + DBLE(KK-1) * DELR CHE01800 C CHE01810 C CHE01820 C IS THIS POINT WITHIN A VAN DER WAALS SPHERE OR OUTSIDE THE CHE01830 C RMAX DISTANCE FROM ALL ATOMS? CHE01840 C CHE01850 RADMIN=50.0D0 CHE01860 DO 100 I=1,NATOMS CHE01870 VRAD = RADII(I) CHE01880 DIST = (P1 - C(1,I))**2 + (P2 - C(2,I))**2 + (P3 - C(3,I))**2 CHE01890 DIST = DSQRT(DIST) CHE01900 IF (DIST .LT. VRAD) GOTO 210 CHE01910 IF (DIST .LT. RADMIN) RADMIN = DIST CHE01920 100 CONTINUE CHE01930 IF (RADMIN .GT. RMAX) GOTO 210 CHE01940 C CHE01950 C STORE POINTS (IN ATOMIC UNITS) CHE01960 C CHE01970 IPOINT = IPOINT + 1 CHE01980 P(1,IPOINT) = P1 CHE01990 P(2,IPOINT) = P2 CHE02000 P(3,IPOINT) = P3 CHE02010 IF (IPO(2) .EQ. 1) CHE02020 $ WRITE(IOUT,*) 'POINT ',IPOINT,' X,Y,Z ',P1,P2,P3 CHE02030 210 CONTINUE CHE02040 200 CONTINUE CHE02050 C CHE02060 MAXPNTS = IPOINT CHE02070 WRITE(IOUT,*) ' NUMBER OF POINTS SELECTED FOR FITTING : ',MAXPNTS CHE02080 RETURN CHE02090 END CHE02100 C CHE02110 SUBROUTINE EP CHE02120 C CHE02130 C ROUTINE TO CALCULATE THE ELECTROSTATIC POTENTIAL FROM FIRST ORDCHE02140 C PERTURBATION THEORY CHE02150 C CHE02160 C M.M. FRANCL APRIL 1985 CHE02170 C MODIFIED VERSION OF A MEPHISTO ROUTINE CHE02180 C RESTRICTED TO CLOSED SHELL MOLECULES CHE02190 C CHE02200 IMPLICIT REAL*8 (A-H,O-Z) CHE02210 PARAMETER (NPOINTS = 50000) CHE02220 INTEGER*4 SHELLA,SHELLN,SHELLT,AOS,SHELLC,AON,HANDLE CHE02230 CHARACTER*40 CHKFIL CHE02240 C CHE02250 COMMON /IO/ IN,IOUT CHE02260 COMMON /IPO/ IPO(5) CHE02270 C+++ CHE02280 COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS, CHE02290 $ IAN(401),ATMCHG(400),C(3,400) CHE02300 C CHE02310 C=== Gaussian88 Modification for enlarged common /b/. CHE02320 Common/B/EXX(6000),C1(6000),C2(6000),C3(6000),X(2000),Y(2000), CHE02330 $Z(2000),JAN(2000),ShellA(2000),ShellN(2000),ShellT(2000), CHE02340 $ShellC(2000),AOS(2000),AON(2000),NShell,MaxTyp CHE02350 C==== Old G86 Version of common /b/ CHE02360 c COMMON/B/EXX(1200),C1(1200),C2(1200),C3(1200), CHE02370 c $ X(400),Y(400),Z(400),JAN(400),SHELLA(400),SHELLN(400), CHE02380 c $ SHELLT(400),SHELLC(400),AOS(400),AON(400),NSHELL,MAXTYP CHE02390 C+++ CHE02400 C COMMON /B/ EXX(240),C1(240),C2(240),C3(240),X(80),Y(80),Z(80), CHE02410 C $ JAN(80),SHELLA(80),SHELLN(80),SHELLT(80),SHELLC(80) CHE02420 C $ ,AOS(80),AON(80),NSHELL,MAXTYP CHE02430 C COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS,IAN(101), CHE02440 C $ ATMCHG(100),C(3,100) CHE02450 COMMON /POINTS/ P(3,NPOINTS),MAXPNTS CHE02460 COMMON /ELP/ ELECP(NPOINTS) CHE02470 COMMON /CHARGE/ COEF_ALPHA(100000),COEF_BETA(100000),IUHF CHE02480 COMMON /OUT/ Q(400),RMS,PERCENT,NTITLE(20,3),I6TO5,NLIN,NEND(3), CHE02490 1 CHKFIL CHE02500 C CHE02510 DIMENSION HPERT(100000),INDEX(1280) CHE02520 C CHE02530 DATA IPTCHG/1.0/ CHE02540 DATA ZERO/0.0/, TWO/2.0/, VNUCMAX/30.0/ CHE02550 C DIVERT TO ROUTINE UEP IF WAVEFUNCTION IS UNRESTRICTED CHE02560 C HARTREE-FOCK WAVEFUNCTION CHE02570 C CHE02580 IF (IUHF .EQ. 1) THEN CHE02590 CALL UEP CHE02600 RETURN CHE02610 END IF CHE02620 C CHE02630 HANDLE = 0 CHE02640 C CHE02650 C SET UP THE INDEXING TABLE FOR HPERT CHE02660 C CHE02670 DO 100 I=1,NBASIS CHE02680 INDEX(I) = (I-1)*I/2 CHE02690 100 CONTINUE CHE02700 C CHE02710 C BEGIN LOOP TO CALCULATE ELECTROSTATIC POTENTIAL CHE02720 C CHE02730 NOCC = NEL / 2 CHE02740 MVIR = NOCC + 1 CHE02750 C CHE02760 C START OF LOOP CHE02770 C CHE02780 DO 200 NPNT=1,MAXPNTS CHE02790 X1 = P(1,NPNT) CHE02800 X2 = P(2,NPNT) CHE02810 X3 = P(3,NPNT) CHE02820 C CHE02830 C CALCULATE THE ONE-ELECTRON INTEGRALS CHE02840 C CHE02850 IF (IPO(5).EQ.1) THEN CHE02860 WRITE(IOUT,3010) CHE02870 3010 FORMAT(1X,'TIME FOR INTEGRALS') CHE02880 C*** CHE02890 C ISTAT = LIB$INIT_TIMER(HANDLE) CHE02900 C*** CHE02910 END IF CHE02920 C CHE02930 CALL INTGRL (HPERT,X1,X2,X3,IPTCHG,I6TO5) CHE02940 C CHE02950 C*** CHE02960 C IF (IPO(5).EQ.1) ISTAT = LIB$SHOW_TIMER(HANDLE) CHE02970 C*** CHE02980 C CHE02990 IF (IPO(4).EQ.1) CALL LINOUT (HPERT,NBASIS,0,0) CHE03000 C CHE03010 IF (IPO(5).EQ.1) THEN CHE03020 WRITE(IOUT,3000) CHE03030 3000 FORMAT(1X,'TIME FOR TRANSFORM') CHE03040 C*** CHE03050 C ISTAT = LIB$INIT_TIMER(HANDLE) CHE03060 C*** CHE03070 END IF CHE03080 C CHE03090 C FORM THE HPERT MATRIX ELEMENTS CHE03100 C CHE03110 E = ZERO CHE03120 ICOEFI = -NBASIS CHE03130 C CHE03140 C SUM OVER OCCUPIED MOS CHE03150 C CHE03160 DO 220 II=1,NOCC CHE03170 ICOEFI = ICOEFI + NBASIS CHE03180 C CHE03190 C CALCULATE ELECTROSTATIC POTENTIAL CHE03200 C CHE03210 DO 221 IP=1,NBASIS CHE03220 CPI = COEF_ALPHA(ICOEFI+IP) CHE03230 IPDEX = INDEX(IP) CHE03240 C CHE03250 DO 222 IQ=1,IP CHE03260 E = E + CPI * COEF_ALPHA(ICOEFI+IQ) * HPERT(IPDEX+IQ) CHE03270 222 CONTINUE CHE03280 DO 223 IQ=IP+1,NBASIS CHE03290 E = E + CPI * COEF_ALPHA(ICOEFI+IQ) * HPERT(IP+INDEX(IQ)) CHE03300 223 CONTINUE CHE03310 C CHE03320 221 CONTINUE CHE03330 220 CONTINUE CHE03340 C CHE03350 C*** CHE03360 C IF (IPO(5).EQ.1) ISTAT = LIB$SHOW_TIMER(HANDLE) CHE03370 C*** CHE03380 C CHE03390 C CALCULATE NUCLEAR PART OF ELECTROSTATIC POTENTIAL CHE03400 C CHE03410 VNUC = ZERO CHE03420 DO 300 IATOM=1,NATOMS CHE03430 DEL1 = C(1,IATOM) - X1 CHE03440 DEL2 = C(2,IATOM) - X2 CHE03450 DEL3 = C(3,IATOM) - X3 CHE03460 RA = DSQRT(DEL1*DEL1 + DEL2*DEL2 + DEL3*DEL3) CHE03470 IF (RA.EQ.ZERO) THEN CHE03480 VNUC=VNUCMAX CHE03490 GOTO 310 CHE03500 END IF CHE03510 VNUC = VNUC + IAN(IATOM) / RA CHE03520 300 CONTINUE CHE03530 310 CONTINUE CHE03540 C CHE03550 ELECP(NPNT) = (E * TWO + VNUC * IPTCHG) CHE03560 IF (IPO(5) .EQ. 1) WRITE(IOUT,*) 'E(',NPNT,') = ',E CHE03570 200 CONTINUE CHE03580 RETURN CHE03590 END CHE03600 SUBROUTINE FIT CHE03610 C CHE03620 C ROUTINE TO USE METHOD OF LAGRANGE MULTIPLIERS TO OBTAIN BEST CHE03630 C LEAST SQUARE FIT WITH CONSTRAINTS CHE03640 C CHE03650 C M.M. FRANCL CHE03660 C APRIL 1985 CHE03670 C CHE03680 IMPLICIT REAL*8 (A-H,O-Z) CHE03690 PARAMETER (NPOINTS = 50000) CHE03700 INTEGER*4 WHICH1 CHE03710 CHARACTER*40 CHKFIL CHE03720 C CHE03730 COMMON /IO/ IN,IOUT CHE03740 COMMON /IPO/ IPO(5) CHE03750 COMMON /ELP/ E(NPOINTS) CHE03760 COMMON /POINTS/ P(3,NPOINTS),MAXPNTS CHE03770 COMMON /OUT/ X(400),RMS,PERCENT,NTITLE(20,3),I6TO5,NLIN,NEND(3), CHE03780 1 CHKFIL CHE03790 C+++ CHE03800 COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS, CHE03810 $ IAN(401),ATMCHG(400),C(3,400) CHE03820 C+++ CHE03830 C COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS,IAN(101), CHE03840 C $ ATMCHG(100),C(3,100) CHE03850 C CHE03860 DIMENSION A(400,400),Y(400),IS(2,400),IAD1(400),IAD2(400) CHE03870 DIMENSION D(400),WHICH1(3) CHE03880 C CHE03890 C DEBYE = CONVERSION FROM DEBYES TO AU CHE03900 C CHE03910 DATA ONE/1.0/, ZERO/0.0/, DEBYE/0.393427328/, MAXDIM/400/ CHE03920 DATA AU2CAL/627.51/, HALF/0.5/, HUNDRED/100.0/,NCONSTR/1/ CHE03930 C CHE03940 C SET UP MATRIX OF LINEAR COEFFICIENTS, A CHE03950 C CHE03960 C BEGIN LOOP OVER ROWS CHE03970 C CHE03980 DO 100 K=1,NATOMS CHE03990 C CHE04000 C BEGIN LOOP OVER COLUMNS CHE04010 C CHE04020 DO 200 MU=1,NATOMS CHE04030 C CHE04040 SUM = ZERO CHE04050 DO 400 I=1,MAXPNTS CHE04060 RIK = (P(1,I)-C(1,K))**2 + (P(2,I)-C(2,K))**2 + (P(3,I)-C(3,K))**2CHE04070 RIK = DSQRT(RIK) CHE04080 RIMU = (P(1,I)-C(1,MU))**2 + (P(2,I)-C(2,MU))**2 + CHE04090 $ (P(3,I)-C(3,MU))**2 CHE04100 RIMU = DSQRT(RIMU) CHE04110 SUM = SUM + ONE / (RIK * RIMU) CHE04120 400 CONTINUE CHE04130 C CHE04140 A(K,MU) = SUM CHE04150 200 CONTINUE CHE04160 C CHE04170 C FILL OUT COLUMNS CORRESPONDING TO LAGRANGE MULTIPLIERS CHE04180 C CHE04190 A(K,NATOMS+1) = HALF CHE04200 C CHE04210 C CHE04220 100 CONTINUE CHE04230 C CHE04240 C FILL OUT THE ROWS CORRESPONDING TO CONSTRAINTS CHE04250 C CHE04260 DO 500 MU=1,NATOMS CHE04270 A(NATOMS+1,MU) = ONE CHE04280 C CHE04290 500 CONTINUE CHE04300 C CHE04310 C FILL OUT THE BLOCK WHICH CONNECTS LAGRANGE MULTIPLIERS TO CHE04320 C CONSTRAINTS CHE04330 C CHE04340 DO 600 K=NATOMS+1,NATOMS+NCONSTR CHE04350 DO 600 MU=NATOMS+1,NATOMS+NCONSTR CHE04360 A(K,MU) = ZERO CHE04370 600 CONTINUE CHE04380 C CHE04390 C****DEBUG***** CHE04400 C CHE04410 IF (IPO(3) .EQ. 1) THEN CHE04420 WRITE(IOUT,*) 'A MATRIX' CHE04430 DO 699 K=1,NATOMS+NCONSTR CHE04440 WRITE(IOUT,1699) (A(K,MU),MU=1,NATOMS+NCONSTR) CHE04450 1699 FORMAT(1X,10F10.4) CHE04460 699 CONTINUE CHE04470 END IF CHE04480 C*************** CHE04490 C CHE04500 C CONSTRUCT COLUMN VECTOR, Y CHE04510 C CHE04520 DO 700 K=1,NATOMS CHE04530 SUM = ZERO CHE04540 DO 710 I=1,MAXPNTS CHE04550 RIK = (P(1,I)-C(1,K))**2 + (P(2,I)-C(2,K))**2 + CHE04560 $ (P(3,I)-C(3,K))**2 CHE04570 RIK = DSQRT(RIK) CHE04580 SUM = SUM + E(I) / RIK CHE04590 710 CONTINUE CHE04600 Y(K) = SUM CHE04610 IF (IPO(3) .EQ. 1) WRITE(IOUT,*) K,Y(K) CHE04620 700 CONTINUE CHE04630 C CHE04640 C CONSTRUCT THE PORTION OF Y CORRESPONDING TO LAGRANGE MULTIPLIERCHE04650 C CHE04660 C CHE04670 Y(NATOMS+1) = DFLOAT(ICHARG) CHE04680 C CHE04690 C CHE04700 IF (IPO(3) .EQ. 1) CHE04710 $ WRITE(IOUT,*) 'COL VECTR Y', (Y(KK),KK=1,NATOMS+NCONSTR) CHE04720 C CHE04730 C SOLVE MATRIX EQUATION AX = Y; CHE04740 C WHERE X = (Q1,Q2, ... QN,L1,L2, ... ,LN) CHE04750 C CHE04760 C X = A(INV)Y CHE04770 C CHE04780 C INVERT A CHE04790 C CHE04800 CALL INV(A,NATOMS+NCONSTR,IS,IAD1,IAD2,D,MAXDIM) CHE04810 C CHE04820 C****DEBUG***** CHE04830 C CHE04840 IF (IPO(3) .EQ. 1) THEN CHE04850 WRITE(IOUT,*) 'A INVERSE' CHE04860 DO 799 K=1,NATOMS+NCONSTR CHE04870 WRITE(IOUT,1699) (A(K,MU),MU=1,NATOMS+NCONSTR) CHE04880 799 CONTINUE CHE04890 END IF CHE04900 C************** CHE04910 C CHE04920 C PERFORM MATRIX MULTIPLICATION A(INV)Y CHE04930 C CHE04940 CALL MULTAY(A,Y,X,NATOMS+NCONSTR,MAXDIM) CHE04950 C CHE04960 IF (IPO(3) .EQ. 1) THEN CHE04970 WRITE(IOUT,*) 'CHARGES: ' CHE04980 DO 899 I=1,NATOMS CHE04990 WRITE(IOUT,*) IAN(I),X(I) CHE05000 899 CONTINUE CHE05010 END IF CHE05020 C CHE05030 C COMPUTE RMS DEVIATION AND MEAN ABSOLUTE % DEVIATION CHE05040 C CHE05050 RMS = ZERO CHE05060 PERCENT = ZERO CHE05070 DO 800 I=1,MAXPNTS CHE05080 EQ = ZERO CHE05090 DO 810 J=1,NATOMS CHE05100 DIST = (P(1,I)-C(1,J))**2 + (P(2,I)-C(2,J))**2 + CHE05110 $ (P(3,I)-C(3,J))**2 CHE05120 DIST = DSQRT(DIST) CHE05130 EQ = EQ + X(J) / DIST CHE05140 810 CONTINUE CHE05150 RMS = RMS + (E(I) - EQ)**2 CHE05160 PERCENT = PERCENT + DABS((E(I) - EQ) / E(I) * HUNDRED) CHE05170 IF (IPO(3) .EQ. 1) WRITE(IOUT,*) 'ACTUAL,CALC ',E(I),EQ CHE05180 800 CONTINUE CHE05190 IF (IPO(3) .EQ. 1) WRITE(IOUT,*) 'SUM OF SQUARES ',RMS CHE05200 RMS = DSQRT(RMS) * AU2CAL / MAXPNTS CHE05210 PERCENT = PERCENT / MAXPNTS CHE05220 IF (IPO(3) .EQ. 1) WRITE(IOUT,*) 'RMS, %',RMS,PERCENT CHE05230 RETURN CHE05240 END CHE05250 SUBROUTINE FMGEN(F,T,M) CHE05260 C CHE05270 IMPLICIT REAL*8 (A-H,O-Z) CHE05280 COMMON/IO/IN,IOUT CHE05290 C CHE05300 DIMENSION F(M) CHE05310 DIMENSION GA(35) CHE05320 C CHE05330 EQUIVALENCE (APPROX,OLDSUM) CHE05340 C CHE05350 DATA ZERO/0.0E0/, HALF/0.5E0/, ONE/1.0E0/, TWO/2.0E0/, TEN/10.0E0/CHE05360 $ ,PI/3.14159265358979E0/, F42/42.0E0/, F80/80.0E0/ CHE05370 C CHE05380 2001 FORMAT(42H1FAILURE IN FMGEN FOR SMALL T: IX.GT.50, / CHE05390 $ 6H IX = ,I3,7H, T = ,E20.14) CHE05400 2002 FORMAT(37H1FAILURE IN FMGEN FOR INTERMEDIATE T,/ CHE05410 $ 6H T = ,E20.14) CHE05420 C CHE05430 TEXP=ZERO CHE05440 IF(T-F80)2,3,3 CHE05450 2 TEXP=EXP(-T) CHE05460 3 CONTINUE CHE05470 IF(T-TEN)10,70,70 CHE05480 C***********************************************************************CHE05490 C 0 .LT. T .LT. 10 CHE05500 C***********************************************************************CHE05510 10 TERM=HALF*GA(M)*TEXP CHE05520 TX=ONE CHE05530 IX=M+1 CHE05540 SUM=TX/GA(IX) CHE05550 OLDSUM=SUM CHE05560 20 IX=IX+1 CHE05570 TX=TX*T CHE05580 IF(IX - 35) 40,40,30 CHE05590 30 WRITE(IOUT,2001)IX,T CHE05600 STOP 'FMGEN' CHE05610 40 SUM=SUM+TX/GA(IX) CHE05620 IF(TOL-ABS(OLDSUM/SUM-ONE))50,60,60 CHE05630 50 OLDSUM=SUM CHE05640 GO TO 20 CHE05650 60 F(M)=SUM*TERM CHE05660 GO TO 160 CHE05670 C CHE05680 70 IF(T-F42)80,150,150 CHE05690 C***********************************************************************CHE05700 C 10 .LE. T .LT. 42 CHE05710 C***********************************************************************CHE05720 80 A=FLOAT(M-1) CHE05730 B=A+HALF CHE05740 A=A-HALF CHE05750 TX=ONE/T CHE05760 MM1=M-1 CHE05770 APPROX=RPITWO*SQRT(TX)*(TX**MM1) CHE05780 IF(MM1)90,110,90 CHE05790 90 DO 100 IX=1,MM1 CHE05800 B=B-ONE CHE05810 100 APPROX=APPROX*B CHE05820 110 FIMULT=HALF*TEXP*TX CHE05830 SUM=ZERO CHE05840 IF(FIMULT)120,140,120 CHE05850 120 FIPROP=FIMULT/APPROX CHE05860 TERM=ONE CHE05870 SUM =ONE CHE05880 NOTRMS=INT(T)+MM1 CHE05890 DO 130 IX=2,NOTRMS CHE05900 TERM=TERM*A*TX CHE05910 SUM=SUM+TERM CHE05920 IF(ABS(TERM*FIPROP/SUM)-TOL)140,140,130 CHE05930 130 A=A-ONE CHE05940 WRITE(IOUT,2002)T CHE05950 STOP 'FMGEN' CHE05960 140 F(M)=APPROX-FIMULT*SUM CHE05970 GO TO 160 CHE05980 C***********************************************************************CHE05990 C T .GE. 42 CHE06000 C***********************************************************************CHE06010 150 TX=FLOAT(M)-HALF CHE06020 F(M)=HALF*GA(M)/(T**TX) CHE06030 C***********************************************************************CHE06040 C RECUR DOWNWARDS TO F(1) CHE06050 C***********************************************************************CHE06060 160 TX=T+T CHE06070 SUM=FLOAT(M+M-3) CHE06080 MM1=M-1 CHE06090 IF(MM1)170,190,170 CHE06100 170 DO 180 IX=1,MM1 CHE06110 F(M-IX)=(TX*F(M-IX+1)+TEXP)/SUM CHE06120 180 SUM=SUM-TWO CHE06130 190 RETURN CHE06140 C CHE06150 ENTRY FMSET CHE06160 C CHE06170 GA(1)=SQRT(PI) CHE06180 TOL=HALF CHE06190 DO 200 I=2,35 CHE06200 GA(I)=GA(I-1)*TOL CHE06210 200 TOL=TOL+ONE CHE06220 TOL = 5.0E-09 CHE06230 RPITWO=HALF*GA(1) CHE06240 RETURN CHE06250 END CHE06260 CHE06270 SUBROUTINE INTGRL (H,X1,X2,X3,ICHARG,I6TO5) CHE06280 C CHE06290 C ROUTINE TO CALCULATE THE ELECTRON-CHARGE MATRIX ELEMENTS FOR THE CHE06300 C POLARIZATION POTENTIAL. CODE REVISED FROM THE ONE ELECTRON PACKAGECHE06310 C AS IT EXISTED AUGUST, 1983. CHE06320 C CHE06330 C CHE06340 C REVISED BY M.M. FRANCL JANUARY 1984 FOR PRINCETON CHEMISTRY CHE06350 C DEPARTMENT VAX 11/780 CHE06360 C CHE06370 C REVISED TO BE COMPATIBLE WITH COMMON /B/ FROM GAUSSIAN 82 CHE06380 C MAY 1984 M.M. FRANCL CHE06390 C CHE06400 C REVISED TO USE ** BASIS SETS AND THOSE HAVING P ONLY SHELLS CHE06410 C JANUARY 1986 M.M. FRANCL CHE06420 C CHE06430 C REVISED FOR GAUSSIAN 86 CHECKPOINT FILES FOR YALE UNIVERSITY CHE06440 C FEBRUARY 1988 CURT BRENEMAN CHE06450 C CHE06460 C CHE06470 IMPLICIT REAL*8 (A-H,O-Z) CHE06480 INTEGER*4 SHELLA,SHELLN,SHELLT,SHELLC,AOS,AON,SHLADF CHE06490 C CHE06500 C+++ CHE06510 COMMON /MOL/ NATOMS,JCHARG,MULTIP,NAE,NBE,NEL,NBASIS, CHE06520 $ IAN(401),ATMCHG(400),C(3,400) CHE06530 C CHE06540 C=== Gaussian88 Modification. New Common /b/ size. CHE06550 Common/B/EXX(6000),C1(6000),C2(6000),C3(2000),CF(2000), CHE06560 $SHLADF(4000),X(2000),Y(2000), CHE06570 $Z(2000),JAN(2000),ShellA(2000),ShellN(2000),ShellT(2000), CHE06580 $ShellC(2000),AOS(2000),AON(2000),NShell,MaxTyp CHE06590 C CHE06600 C=== Old G86 common /b/ CHE06610 c COMMON/B/EXX(1200),C1(1200),C2(1200),C3(400),CF(400),SHLADF(800),CHE06620 c $ X(400),Y(400),Z(400),JAN(400),SHELLA(400),SHELLN(400), CHE06630 c $ SHELLT(400),SHELLC(400),AOS(400),AON(400),NSHELL,MAXTYP CHE06640 c CHE06650 C+++ CHE06660 C COMMON /B/ EXX(240),C1(240),C2(240),C3(80),CF(80),SHLADF(160), CHE06670 C $ X(80),Y(80),Z(80), CHE06680 C $ JAN(80),SHELLA(80),SHELLN(80),SHELLT(80),SHELLC(80) CHE06690 C $ ,AOS(80),AON(80),NSHELL,MAXTYP CHE06700 C COMMON /MOL/ NATOMS,JCHARG,MULTIP,NAE,NBE,NEL,NBASIS,IAN(101), CHE06710 C $ ATMCHG(100),C(3,100) CHE06720 COMMON /IPO/ IPO(10) CHE06730 COMMON/IO/ IN,IOUT CHE06740 C CHE06750 DIMENSION H(1) CHE06760 DIMENSION RENORM(10) CHE06770 DIMENSION OF(9),OX(9),TX(13),ABX(5),ABY(5),ABZ(5),ABSQ(5), CHE06780 *A(5),B(5),F(5),APB(5),CPX(5),CPY(5),CPZ(5),FM(5) CHE06790 DIMENSION EPN(100) CHE06800 C CHE06810 COMMON/H100/ CHE06820 $EP00,EP10,EP20,EP30,EP40,EP50,EP60,EP70,EP80,EP90, CHE06830 $EP01,EP11,EP21,EP31,EP41,EP51,EP61,EP71,EP81,EP91, CHE06840 $EP02,EP12,EP22,EP32,EP42,EP52,EP62,EP72,EP82,EP92, CHE06850 $EP03,EP13,EP23,EP33,EP43,EP53,EP63,EP73,EP83,EP93, CHE06860 $EP04,EP14,EP24,EP34,EP44,EP54,EP64,EP74,EP84,EP94, CHE06870 $EP05,EP15,EP25,EP35,EP45,EP55,EP65,EP75,EP85,EP95, CHE06880 $EP06,EP16,EP26,EP36,EP46,EP56,EP66,EP76,EP86,EP96, CHE06890 $EP07,EP17,EP27,EP37,EP47,EP57,EP67,EP77,EP87,EP97, CHE06900 $EP08,EP18,EP28,EP38,EP48,EP58,EP68,EP78,EP88,EP98, CHE06910 $EP09,EP19,EP29,EP39,EP49,EP59,EP69,EP79,EP89,EP99 CHE06920 C CHE06930 DIMENSION EEP(100) CHE06940 DIMENSION MAX(6) CHE06950 C CHE06960 C LOCAL VARIABLES. CHE06970 C CHE06980 DIMENSION AG(6),CSA(6),CPA(6),CDA(6), CHE06990 $ BG(6),CSB(6),CPB(6),CDB(6), CHE07000 $ DPP(9) CHE07010 EQUIVALENCE(OF0,OF(1)),(OF1,OF(2)),(OF2,OF(3)), CHE07020 $ (OF3,OF(4)),(OF4,OF(5)),(OF5,OF(6)), CHE07030 $ (OF6,OF(7)),(OF7,OF(8)),(OF8,OF(9)) CHE07040 EQUIVALENCE(OX0,OX(1)),(OX1,OX(2)),(OX2,OX(3)), CHE07050 $ (OX3,OX(4)),(OX4,OX(5)),(OX5,OX(6)), CHE07060 $ (OX6,OX(7)),(OX7,OX(8)),(OX8,OX(9)) CHE07070 EQUIVALENCE(A1,A(2)),(A2,A(3)),(A3,A(4)),(A4,A(5)) CHE07080 EQUIVALENCE(B1,B(2)),(B2,B(3)),(B3,B(4)),(B4,B(5)) CHE07090 EQUIVALENCE(T01,T0),(T02,T1),(T03,T2), CHE07100 $ (T04,T3),(T05,T4),(T06,T5), CHE07110 $ (T07,T6),(T08,T7),(T09,T8) CHE07120 EQUIVALENCE(T10,TX(10)),(T11,TX(11)),(T12,TX(12)),(T13,TX(13)) CHE07130 EQUIVALENCE(T0,TX(1)),(T1,TX(2)),(T2,TX(3)), CHE07140 $ (T3,TX(4)),(T4,TX(5)),(T5,TX(6)), CHE07150 $ (T6,TX(7)),(T7,TX(8)),(T8,TX(9)) CHE07160 EQUIVALENCE(C001,T01),(C050,T02),(C054,T09), CHE07170 $ (C067,T13),(C068,T08),(C074,T03) CHE07180 EQUIVALENCE(ABX1,ABX(2)),(ABX2,ABX(3)), CHE07190 $ (ABX3,ABX(4)),(ABX4,ABX(5)) CHE07200 EQUIVALENCE(AB004,ABX1),(AB006,ABX2),(AB023,ABX3),(AB029,ABX4) CHE07210 EQUIVALENCE(ABY1,ABY(2)),(ABY2,ABY(3)), CHE07220 $ (ABY3,ABY(4)),(ABY4,ABY(5)) CHE07230 EQUIVALENCE(AB007,ABY1),(AB010,ABY2),(AB032,ABY3),(AB035,ABY4) CHE07240 EQUIVALENCE(ABZ1,ABZ(2)),(ABZ2,ABZ(3)), CHE07250 $ (ABZ3,ABZ(4)),(ABZ4,ABZ(5)) CHE07260 EQUIVALENCE(AB002,ABZ1),(AB003,ABZ2),(AB011,ABZ3),(AB017,ABZ4) CHE07270 EQUIVALENCE(ABSQ1,ABSQ(2)),(ABSQ2,ABSQ(3)), CHE07280 $ (ABSQ3,ABSQ(4)),(ABSQ4,ABSQ(5)) CHE07290 EQUIVALENCE(APB1,APB(2)),(APB2,APB(3)), CHE07300 $ (APB3,APB(4)),(APB4,APB(5)) CHE07310 EQUIVALENCE(CPX1,CPX(2)),(CPX2,CPX(3)), CHE07320 $ (CPX3,CPX(4)),(CPX4,CPX(5)) CHE07330 EQUIVALENCE(CPY1,CPY(2)),(CPY2,CPY(3)), CHE07340 $ (CPY3,CPY(4)),(CPY4,CPY(5)) CHE07350 EQUIVALENCE(CPZ1,CPZ(2)),(CPZ2,CPZ(3)), CHE07360 $ (CPZ3,CPZ(4)),(CPZ4,CPZ(5)) CHE07370 EQUIVALENCE(F1,F(2)),(F2,F(3)),(F3,F(4)),(F4,F(5)) CHE07380 EQUIVALENCE(FM0,FM(1)),(FM1,FM(2)),(FM2,FM(3)),(FM3,FM(4)), CHE07390 $ (FM4,FM(5)) CHE07400 EQUIVALENCE (D001,FM0) CHE07410 EQUIVALENCE(EP00,EEP(1)) CHE07420 C CHE07430 DATA MAX/1,4,9,1,4,10/ CHE07440 DATA TX/1.0E0,0.5E0,0.25E0,0.125E0,0.375E0,0.625E-01,0.1875E0, CHE07450 $ 0.75E0,1.5E0,2.25E0,1.125E0,0.0E0,3.0E0/ CHE07460 DATA ZERO/0.0/,HALF/0.5/,ONE/1.0/,ONEPT5/1.5/,TWO/2.0/,THREE/3.0/,CHE07470 *ROOT3/1.732050808/,PI/3.14159265358979/ CHE07480 DATA ANTOAU /1.889726878D0/ CHE07490 C CHE07500 2010 FORMAT(/1X,'ELECTRON-CHARGE MATRIX ELEMENTS'/) CHE07510 C CHE07520 C CALL ROUTINE TO MODIFY COMMON /B/ IF P ONLY SHELLS ARE PRESENT CHE07530 C CHE07540 CALL STAR (NBASIS,SHELLT,SHELLC,AOS,NSHELL,NOSTAR) CHE07550 C CHE07560 C***********************************************************************CHE07570 C INITIALIZE THIS SEGMENT. CHE07580 C***********************************************************************CHE07590 C CHE07600 C ******************************************************************CHE07610 C COMPUTE SIZE OF S T AND V ARRAYS CHE07620 C ******************************************************************CHE07630 NTT=(NBASIS*(NBASIS+1))/2 CHE07640 I5OR6=3 CHE07650 CC IF(IGO(4) .NE. 0) I5OR6 = 0 CHE07660 C ******************************************************************CHE07670 C INITIALIZE RENORM USED TO NORMALIZE D FUNCTIONS CHE07680 C ******************************************************************CHE07690 DO 100 I=1,10 CHE07700 100 RENORM(I)=ONE CHE07710 RENORM(5)=ROOT3 CHE07720 RENORM(8)=ROOT3 CHE07730 RENORM(9)=ROOT3 CHE07740 C ******************************************************************CHE07750 C CLEAR H ARRAY CHE07760 C ******************************************************************CHE07770 DO 50 I=1,NTT CHE07780 50 H(I)=ZERO CHE07790 C ******************************************************************CHE07800 C * INITIALIZE THE VARIABLES USED BY ROUTINE FMGEN. *CHE07810 C ******************************************************************CHE07820 CALL FMSET CHE07830 DO 95 I=1,5 CHE07840 95 FM(I)=ZERO CHE07850 ABX(1)=ONE CHE07860 ABY(1)=ONE CHE07870 ABZ(1)=ONE CHE07880 A(1)=ONE CHE07890 B(1)=ONE CHE07900 F(1)=ONE CHE07910 CPX(1)=ONE CHE07920 CPY(1)=ONE CHE07930 CPZ(1)=ONE CHE07940 APB(1)=ONE CHE07950 ABSQ(1)=ONE CHE07960 C***********************************************************************CHE07970 C LOOP OVER SHELLS ISHELL AND JSHELL. CHE07980 C***********************************************************************CHE07990 DO 1000 ISHELL=1,NSHELL CHE08000 DO 1000 JSHELL=1,ISHELL CHE08010 SYMFAC = ONE CHE08020 C ******************************************************************CHE08030 C ZERO LOCATIONS CHE08040 C ******************************************************************CHE08050 80 CONTINUE CHE08060 DO 9447 JI=1,100 CHE08070 EPN(JI)=ZERO CHE08080 9447 CONTINUE CHE08090 IF(SHELLT(ISHELL)-SHELLT(JSHELL))120,120,110 CHE08100 110 INEW=JSHELL CHE08110 JNEW=ISHELL CHE08120 LA=SHELLT(JSHELL) CHE08130 LB=SHELLT(ISHELL) CHE08140 GO TO 200 CHE08150 120 INEW=ISHELL CHE08160 JNEW=JSHELL CHE08170 LA=SHELLT(ISHELL) CHE08180 LB=SHELLT(JSHELL) CHE08190 200 CONTINUE CHE08200 LAP1=LA+1 CHE08210 LBP1=LB+1 CHE08220 LAMAX=MAX(LAP1+I5OR6) CHE08230 LBMAX=MAX(LBP1+I5OR6) CHE08240 ITYPE=3*LB+LA CHE08250 M=LA+LB+1 CHE08260 NGA=SHELLN(INEW) CHE08270 NGB=SHELLN(JNEW) CHE08280 AX=X(INEW) CHE08290 BX=X(JNEW) CHE08300 AY=Y(INEW) CHE08310 BY=Y(JNEW) CHE08320 AZ=Z(INEW) CHE08330 BZ=Z(JNEW) CHE08340 ISHA=SHELLA(INEW) CHE08350 ISHB=SHELLA(JNEW) CHE08360 ISHAD = SHLADF(INEW) CHE08370 ISHBD = SHLADF(JNEW) CHE08380 IAOS=AOS(INEW) CHE08390 JAOS=AOS(JNEW) CHE08400 C ******************************************************************CHE08410 C OBTAIN INFORMATION ABOUT SHELLS INEW AND JNEW CHE08420 C ******************************************************************CHE08430 DO 101 I=1,NGA CHE08440 N=ISHA+I-1 CHE08450 ND = ISHAD + I -1 CHE08460 IF (MAXTYP .LE. 1) ND=1 CHE08470 AG(I)=EXX(N) CHE08480 CSA(I)=C1(N) CHE08490 CPA(I)=C2(N) CHE08500 101 CDA(I)=C3(ND) CHE08510 CHE08520 DO 102 I=1,NGB CHE08530 N=ISHB+I-1 CHE08540 ND = ISHBD + I -1 CHE08550 BG(I)=EXX(N) CHE08560 CSB(I)=C1(N) CHE08570 CPB(I)=C2(N) CHE08580 102 CDB(I)=C3(ND) CHE08590 CHE08600 ABX(2)=BX-AX CHE08610 ABY(2)=BY-AY CHE08620 ABZ(2)=BZ-AZ CHE08630 RABSQ=ABX(2)*ABX(2)+ABY(2)*ABY(2)+ABZ(2)*ABZ(2) CHE08640 ABSQ(2)=RABSQ CHE08650 DO 103 I=3,5 CHE08660 ABX(I)=ABX(I-1)*ABX(2) CHE08670 ABY(I)=ABY(I-1)*ABY(2) CHE08680 ABZ(I)=ABZ(I-1)*ABZ(2) CHE08690 103 ABSQ(I)=ABSQ(I-1)*ABSQ(2) CHE08700 AB001=ONE CHE08710 AB005=ABX1*ABZ1 CHE08720 AB008=ABY1*ABZ1 CHE08730 AB009=ABX1*ABY1 CHE08740 AB012=ABX1*ABZ2 CHE08750 AB013=ABX2*ABZ1 CHE08760 AB014=ABY1*ABZ2 CHE08770 AB015=ABX1*ABY1*ABZ1 CHE08780 AB016=ABY2*ABZ1 CHE08790 AB018=ABX1*ABZ3 CHE08800 AB019=ABX2*ABZ2 CHE08810 AB020=ABY1*ABZ3 CHE08820 AB021=ABX1*ABY1*ABZ2 CHE08830 AB022=ABY2*ABZ2 CHE08840 AB024=ABX2*ABY1 CHE08850 AB025=ABX1*ABY2 CHE08860 AB026=ABX3*ABZ1 CHE08870 AB027=ABX2*ABY1*ABZ1 CHE08880 AB028=ABX1*ABY2*ABZ1 CHE08890 AB030=ABX3*ABY1 CHE08900 AB031=ABX2*ABY2 CHE08910 AB033=ABY3*ABZ1 CHE08920 AB034=ABX1*ABY3 CHE08930 C***********************************************************************CHE08940 C LOOP OVER GAUSSIANS (CONTRACTION LOOP). CHE08950 C***********************************************************************CHE08960 DO 105 IGAUSS=1,NGA CHE08970 AA=AG(IGAUSS) CHE08980 DO 105 JGAUSS=1,NGB CHE08990 BB=BG(JGAUSS) CHE09000 AAPBB=AA+BB CHE09010 APBB=ONE/AAPBB CHE09020 F2=TWO*AA*BB*APBB CHE09030 PX=(AA*AX+BB*BX)*APBB CHE09040 PY=(AA*AY+BB*BY)*APBB CHE09050 PZ=(AA*AZ+BB*BZ)*APBB CHE09060 A(2)=ONE/AA CHE09070 B(2)=ONE/BB CHE09080 F(2)=F2 CHE09090 APB(2)=APBB CHE09100 YX=PI*APBB CHE09110 EXX1=HALF*F2*RABSQ CHE09120 IF(EXX1-80.0E0)4172,4173,4173 CHE09130 4173 EXX1=ZERO CHE09140 GO TO 4714 CHE09150 4172 EXX1=EXP(-EXX1) CHE09160 4714 CONTINUE CHE09170 OV=(YX**ONEPT5)*EXX1 CHE09180 OVEK=THREE*AA*BB*APBB CHE09190 EK=F2*AA*BB*APBB*OV CHE09200 EP=TWO*YX*EXX1 CHE09210 DO 119 I=3,5 CHE09220 A(I)=A(I-1)*A(2) CHE09230 B(I)=B(I-1)*B(2) CHE09240 APB(I)=APB(I-1)*APB(2) CHE09250 119 F(I)=F(I-1)*F(2) CHE09260 DPP(1)=CSA(IGAUSS)*CSB(JGAUSS) CHE09270 DPP(2)=CPA(IGAUSS)*CSB(JGAUSS) CHE09280 DPP(3)=CDA(IGAUSS)*CSB(JGAUSS) CHE09290 DPP(4)=CSA(IGAUSS)*CPB(JGAUSS) CHE09300 DPP(5)=CPA(IGAUSS)*CPB(JGAUSS) CHE09310 DPP(6)=CDA(IGAUSS)*CPB(JGAUSS) CHE09320 DPP(7)=CSA(IGAUSS)*CDB(JGAUSS) CHE09330 DPP(8)=CPA(IGAUSS)*CDB(JGAUSS) CHE09340 DPP(9)=CDA(IGAUSS)*CDB(JGAUSS) CHE09350 DO 2132 I=1,9 CHE09360 OF(I)=DPP(I)*OV CHE09370 2132 OX(I)=DPP(I)*EK CHE09380 DO 2139 I=1,100 CHE09390 2139 EEP(I)=ZERO CHE09400 C002=T02*A1*F1 CHE09410 C006=T02*B1*F1 CHE09420 C007=T03*A1*B1*F2 CHE09430 C008=T03*A1*B1*F1 CHE09440 C027=T01*A1 CHE09450 C031=T01*A1*B1*F1 CHE09460 C032=T02*A1*B1 CHE09470 C051=T02*A1*B1*F2 CHE09480 C012=T02*B1 CHE09490 C013=T03*B2*F2 CHE09500 C014=T03*B2*F1 CHE09510 C036=T01*B2*F1 CHE09520 C037=T02*B2 CHE09530 C056=T01*B1*F1 CHE09540 C030=T01*B1 CHE09550 C018=T04*A1*B2*F2 CHE09560 IF(ITYPE-7)3060,3040,3041 CHE09570 3041 CONTINUE CHE09580 C003=T02*A1 CHE09590 C004=T03*A2*F2 CHE09600 C005=T03*A2*F1 CHE09610 C009=T04*A2*B1*F3 CHE09620 C010=T05*A2*B1*F2 CHE09630 C011=T04*A2*B1*F2 CHE09640 C017=T03*A1*B1 CHE09650 C019=T04*A1*B2*F1 CHE09660 C020=T04*A2*B1*F1 CHE09670 C021=T06*A2*B2*F4 CHE09680 C022=T05*A2*B2*F3 CHE09690 C023=T07*A2*B2*F2 CHE09700 C024=T07*A2*B2*F3 CHE09710 C025=T06*A2*B2*F3 CHE09720 C026=T06*A2*B2*F2 CHE09730 C028=T01*A2*F1 CHE09740 C029=T02*A2 CHE09750 C033=T08*A2*B1*F2 CHE09760 C034=T09*A2*B1*F1 CHE09770 C035=T02*A2*B1*F1 CHE09780 C040=T02*A1*B2*F1 CHE09790 C041=T03*A1*B2 CHE09800 C042=T03*A2*B1 CHE09810 C043=T02*A2*B2*F3 CHE09820 C044=T10*A2*B2*F2 CHE09830 C045=T08*A2*B2*F1 CHE09840 C046=T11*A2*B2*F2 CHE09850 C047=T05*A2*B2*F2 CHE09860 C048=T03*A2*B2*F1 CHE09870 C049=T01*A1*F1 CHE09880 C057=T12*A1*B1*F1 CHE09890 C058=T03*A1 CHE09900 C059=T03*B1 CHE09910 C060=T03*A1*B2*F3 CHE09920 C061=T04*B2*F2 CHE09930 C062=T04*B2*F1 CHE09940 C063=T03*A2*B1*F3 CHE09950 C064=T01*A1*B1*F2 CHE09960 C065=T09*B1*F1 CHE09970 C066=T09*A1*F1 CHE09980 C069=T04*A2*F2 CHE09990 C070=T04*A2*F1 CHE10000 C071=T03*A2*B1*F2 CHE10010 C072=T08*A1*F1 CHE10020 C073=T03*A1*B2*F2 CHE10030 C075=T08*B1*F1 CHE10040 C076=T04*A1*B1*F2 CHE10050 3040 CONTINUE CHE10060 C015=T04*A1*B2*F3 CHE10070 C016=T05*A1*B2*F2 CHE10080 C038=T08*A1*B2*F2 CHE10090 C039=T09*A1*B2*F1 CHE10100 C040=T02*A1*B2*F1 CHE10110 C052=T02*A1*B1*F1 CHE10120 C053=T03*B1*F1 CHE10130 C055=T03*A1*F1 CHE10140 3060 CONTINUE CHE10150 CX=X1 CHE10160 CY=X2 CHE10170 CZ=X3 CHE10180 CPX(2)=PX-CX CHE10190 CPY(2)=PY-CY CHE10200 CPZ(2)=PZ-CZ CHE10210 CP2=CPX(2)*CPX(2)+CPY(2)*CPY(2)+CPZ(2)*CPZ(2) CHE10220 CALL FMGEN(FM,AAPBB*CP2,M) CHE10230 DO 108 I=3,5 CHE10240 CPX(I)=CPX(I-1)*CPX(2) CHE10250 CPY(I)=CPY(I-1)*CPY(2) CHE10260 108 CPZ(I)=CPZ(I-1)*CPZ(2) CHE10270 EPAN=EP*FLOAT(-ICHARG) CHE10280 DO 2136 I=1,9 CHE10290 2136 OF(I)=DPP(I)*EPAN CHE10300 D002=CPZ1*FM1 CHE10310 D003=CPZ2*FM2 CHE10320 D004=APB1*FM1 CHE10330 D005=CPX1*FM1 CHE10340 D006=CPX1*CPZ1*FM2 CHE10350 D007=CPX2*FM2 CHE10360 D008=CPY1*FM1 CHE10370 D009=CPY1*CPZ1*FM2 CHE10380 D010=CPX1*CPY1*FM2 CHE10390 D011=CPY2*FM2 CHE10400 D012=CPZ3*FM3 CHE10410 D013=APB1*CPZ1*FM2 CHE10420 D014=CPX1*CPZ2*FM3 CHE10430 D015=APB1*CPX1*FM2 CHE10440 D016=CPX2*CPZ1*FM3 CHE10450 D017=CPY1*CPZ2*FM3 CHE10460 D018=APB1*CPY1*FM2 CHE10470 D019=CPX1*CPY1*CPZ1*FM3 CHE10480 D020=CPY2*CPZ1*FM3 CHE10490 D034=CPX3*FM3 CHE10500 D035=CPX2*CPY1*FM3 CHE10510 D036=CPX1*CPY2*FM3 CHE10520 D043=CPY3*FM3 CHE10530 C ******************************************************************CHE10540 C * SS *CHE10550 C ******************************************************************CHE10560 EP00=OF0*(+C001*AB001*D001) CHE10570 IF(ITYPE)3230,3262,3230 CHE10580 C ******************************************************************CHE10590 C * SP *CHE10600 C ******************************************************************CHE10610 3230 CONTINUE CHE10620 EP01=OF3*(-C006*AB002*D001-C001*AB001*D002) CHE10630 EP03=OF3*(-C006*AB004*D001-C001*AB001*D005) CHE10640 EP06=OF3*(-C006*AB007*D001-C001*AB001*D008) CHE10650 IF(ITYPE-7)3240,3242,3241 CHE10660 3240 IF(ITYPE-4)3262,3261,3260 CHE10670 C ******************************************************************CHE10680 C * DD *CHE10690 C ******************************************************************CHE10700 3241 CONTINUE CHE10710 D021=CPZ4*FM4 CHE10720 D022=APB1*CPZ2*FM3 CHE10730 D023=APB2*FM2 CHE10740 D024=CPX1*CPZ3*FM4 CHE10750 D025=APB1*CPX1*CPZ1*FM3 CHE10760 D026=CPX2*CPZ2*FM4 CHE10770 D027=APB1*CPX2*FM3 CHE10780 D028=CPY1*CPZ3*FM4 CHE10790 D029=APB1*CPY1*CPZ1*FM3 CHE10800 D030=CPX1*CPY1*CPZ2*FM4 CHE10810 D031=APB1*CPX1*CPY1*FM3 CHE10820 D032=CPY2*CPZ2*FM4 CHE10830 D033=APB1*CPY2*FM3 CHE10840 D037=CPX3*CPZ1*FM4 CHE10850 D038=CPX2*CPY1*CPZ1*FM4 CHE10860 D039=CPX1*CPY2*CPZ1*FM4 CHE10870 D040=CPX4*FM4 CHE10880 D041=CPX3*CPY1*FM4 CHE10890 D042=CPX2*CPY2*FM4 CHE10900 D044=CPY3*CPZ1*FM4 CHE10910 D045=CPX1*CPY3*FM4 CHE10920 D046=CPY4*FM4 CHE10930 EP20=OF2*(+C003*AB001*D001+C004*AB003*D001-C005*AB001*D001-C049*ABCHE10940 $002*D002+C001*AB001*D003-C050*AB001*D004) CHE10950 EP40=OF2*(+C004*AB005*D001-C002*AB004*D002-C002*AB002*D005+C001*ABCHE10960 $001*D006) CHE10970 EP50=OF2*(+C003*AB001*D001+C004*AB006*D001-C005*AB001*D001-C049*ABCHE10980 $004*D005+C001*AB001*D007-C050*AB001*D004) CHE10990 EP70=OF2*(+C004*AB008*D001-C002*AB007*D002-C002*AB002*D008+C001*ABCHE11000 $001*D009) CHE11010 EP80=OF2*(+C004*AB009*D001-C002*AB004*D008-C002*AB007*D005+C001*ABCHE11020 $001*D010) CHE11030 EP90=OF2*(+C003*AB001*D001+C004*AB010*D001-C005*AB001*D001-C049*ABCHE11040 $007*D008+C001*AB001*D011-C050*AB001*D004) CHE11050 EP21=OF5*(-C008*AB002*D001-C003*AB001*D002-C009*AB011*D001+C010*ABCHE11060 $002*D001+C051*AB003*D002-C052*AB001*D002-C006*AB002*D003+C053*AB00CHE11070 $2*D004-C004*AB003*D002+C005*AB001*D002+C049*AB002*D003-C002*AB002*CHE11080 $D004-C001*AB001*D012+C054*AB001*D013) CHE11090 EP41=OF5*(-C009*AB012*D001+C011*AB004*D001+C007*AB005*D002+C007*ABCHE11100 $003*D005-C008*AB001*D005-C006*AB002*D006-C004*AB005*D002+C002*AB00CHE11110 $4*D003-C055*AB004*D004+C002*AB002*D006-C001*AB001*D014+C050*AB001*CHE11120 $D015) CHE11130 EP51=OF5*(-C008*AB002*D001-C003*AB001*D002-C009*AB013*D001+C011*ABCHE11140 $002*D001+C051*AB005*D005-C006*AB002*D007+C053*AB002*D004-C004*AB00CHE11150 $6*D002+C005*AB001*D002+C049*AB004*D006-C001*AB001*D016+C050*AB001*CHE11160 $D013) CHE11170 EP71=OF5*(-C009*AB014*D001+C011*AB007*D001+C007*AB008*D002+C007*ABCHE11180 $003*D008-C008*AB001*D008-C006*AB002*D009-C004*AB008*D002+C002*AB00CHE11190 $7*D003-C055*AB007*D004+C002*AB002*D009-C001*AB001*D017+C050*AB001*CHE11200 $D018) CHE11210 EP81=OF5*(-C009*AB015*D001+C007*AB005*D008+C007*AB008*D005-C006*ABCHE11220 $002*D010-C004*AB009*D002+C002*AB004*D009+C002*AB007*D006-C001*AB00CHE11230 $1*D019) CHE11240 EP91=OF5*(-C008*AB002*D001-C003*AB001*D002-C009*AB016*D001+C011*ABCHE11250 $002*D001+C051*AB008*D008-C006*AB002*D011+C053*AB002*D004-C004*AB01CHE11260 $0*D002+C005*AB001*D002+C049*AB007*D009-C001*AB001*D020+C050*AB001*CHE11270 $D013) CHE11280 EP22=OF8*(+C017*AB001*D001+C018*AB003*D001-C019*AB001*D001+C057*ABCHE11290 $002*D002+C003*AB001*D003-C058*AB001*D004+C011*AB003*D001-C020*AB00CHE11300 $1*D001+C012*AB001*D003-C059*AB001*D004+C021*AB017*D001-C022*AB003*CHE11310 $D001-C060*AB011*D002+C023*AB001*D001+C038*AB002*D002+C013*AB003*D0CHE11320 $03-C061*AB003*D004-C014*AB001*D003+C062*AB001*D004+C063*AB011*D002CHE11330 $-C033*AB002*D002-C064*AB003*D003+C051*AB003*D004+C031*AB001*D003-CCHE11340 $052*AB001*D004+C056*AB002*D012-C065*AB002*D013+C004*AB003*D003-C00CHE11350 $5*AB001*D003-C049*AB002*D012+C066*AB002*D013+C001*AB001*D021-C067*CHE11360 $AB001*D022+C068*AB001*D023-C069*AB003*D004+C070*AB001*D004) CHE11370 EP42=OF8*(+C011*AB005*D001-C008*AB004*D002-C008*AB002*D005+C012*ABCHE11380 $001*D006+C021*AB018*D001-C024*AB005*D001-C015*AB012*D002-C015*AB01CHE11390 $1*D005+C016*AB002*D005+C013*AB003*D006+C018*AB004*D002-C014*AB001*CHE11400 $D006+C063*AB012*D002-C071*AB004*D002-C051*AB005*D003+C007*AB005*D0CHE11410 $04-C051*AB003*D006+C052*AB001*D006+C056*AB002*D014-C006*AB002*D015CHE11420 $+C004*AB005*D003-C002*AB004*D012+C072*AB004*D013-C002*AB002*D014+CCHE11430 $001*AB001*D024-C054*AB001*D025-C069*AB005*D004+C055*AB002*D015) CHE11440 EP52=OF8*(+C017*AB001*D001+C018*AB003*D001-C019*AB001*D001+C052*ABCHE11450 $002*D002+C003*AB001*D003-C058*AB001*D004+C011*AB006*D001-C020*AB00CHE11460 $1*D001-C052*AB004*D005+C012*AB001*D007-C059*AB001*D004+C021*AB019*CHE11470 $D001-C025*AB003*D001-C060*AB012*D005+C013*AB003*D007-C061*AB003*D0CHE11480 $04-C025*AB006*D001+C026*AB001*D001+C073*AB004*D005-C014*AB001*D007CHE11490 $+C062*AB001*D004+C063*AB013*D002-C071*AB002*D002-C064*AB005*D006+CCHE11500 $056*AB002*D016-C006*AB002*D013+C004*AB006*D003-C005*AB001*D003-C04CHE11510 $9*AB004*D014+C001*AB001*D026-C050*AB001*D022-C069*AB006*D004+C070*CHE11520 $AB001*D004+C002*AB004*D015-C050*AB001*D027+C074*AB001*D023) CHE11530 EP72=OF8*(+C011*AB008*D001-C008*AB007*D002-C008*AB002*D008+C012*ABCHE11540 $001*D009+C021*AB020*D001-C024*AB008*D001-C015*AB014*D002-C015*AB01CHE11550 $1*D008+C016*AB002*D008+C013*AB003*D009+C018*AB007*D002-C014*AB001*CHE11560 $D009+C063*AB014*D002-C071*AB007*D002-C051*AB008*D003+C007*AB008*D0CHE11570 $04-C051*AB003*D009+C052*AB001*D009+C056*AB002*D017-C006*AB002*D018CHE11580 $+C004*AB008*D003-C002*AB007*D012+C072*AB007*D013-C002*AB002*D017+CCHE11590 $001*AB001*D028-C054*AB001*D029-C069*AB008*D004+C055*AB002*D018) CHE11600 EP82=OF8*(+C011*AB009*D001-C008*AB004*D008-C008*AB007*D005+C012*ABCHE11610 $001*D010+C021*AB021*D001-C015*AB012*D008-C015*AB014*D005+C013*AB00CHE11620 $3*D010-C025*AB009*D001+C018*AB004*D008+C018*AB007*D005-C014*AB001*CHE11630 $D010+C063*AB015*D002-C051*AB005*D009-C051*AB008*D006+C056*AB002*D0CHE11640 $19+C004*AB009*D003-C002*AB004*D017-C002*AB007*D014+C001*AB001*D030CHE11650 $-C069*AB009*D004+C055*AB004*D018+C055*AB007*D015-C050*AB001*D031) CHE11660 EP92=OF8*(+C017*AB001*D001+C018*AB003*D001-C019*AB001*D001+C052*ABCHE11670 $002*D002+C003*AB001*D003-C058*AB001*D004+C011*AB010*D001-C020*AB00CHE11680 $1*D001-C052*AB007*D008+C012*AB001*D011-C059*AB001*D004+C021*AB022*CHE11690 $D001-C025*AB003*D001-C060*AB014*D008+C013*AB003*D011-C061*AB003*D0CHE11700 $04-C025*AB010*D001+C026*AB001*D001+C073*AB007*D008-C014*AB001*D011CHE11710 $+C062*AB001*D004+C063*AB016*D002-C071*AB002*D002-C064*AB008*D009+CCHE11720 $056*AB002*D020-C006*AB002*D013+C004*AB010*D003-C005*AB001*D003-C04CHE11730 $9*AB007*D017+C001*AB001*D032-C050*AB001*D022-C069*AB010*D004+C070*CHE11740 $AB001*D004+C002*AB007*D018-C050*AB001*D033+C074*AB001*D023) CHE11750 EP23=OF5*(-C008*AB004*D001-C003*AB001*D005-C009*AB012*D001+C011*ABCHE11760 $004*D001+C051*AB005*D002-C006*AB004*D003+C053*AB004*D004-C004*AB00CHE11770 $3*D005+C005*AB001*D005+C049*AB002*D006-C001*AB001*D014+C050*AB001*CHE11780 $D015) CHE11790 EP43=OF5*(-C009*AB013*D001+C007*AB006*D002+C011*AB002*D001-C008*ABCHE11800 $001*D002+C007*AB005*D005-C006*AB004*D006-C004*AB005*D005+C002*AB00CHE11810 $4*D006+C002*AB002*D007-C001*AB001*D016-C055*AB002*D004+C050*AB001*CHE11820 $D013) CHE11830 EP53=OF5*(-C008*AB004*D001-C003*AB001*D005-C009*AB023*D001+C010*ABCHE11840 $004*D001+C051*AB006*D005-C052*AB001*D005-C006*AB004*D007+C053*AB00CHE11850 $4*D004-C004*AB006*D005+C005*AB001*D005+C049*AB004*D007-C002*AB004*CHE11860 $D004-C001*AB001*D034+C054*AB001*D015) CHE11870 EP73=OF5*(-C009*AB015*D001+C007*AB009*D002+C007*AB005*D008-C006*ABCHE11880 $004*D009-C004*AB008*D005+C002*AB007*D006+C002*AB002*D010-C001*AB00CHE11890 $1*D019) CHE11900 EP83=OF5*(-C009*AB024*D001+C007*AB006*D008+C011*AB007*D001-C008*ABCHE11910 $001*D008+C007*AB009*D005-C006*AB004*D010-C004*AB009*D005+C002*AB00CHE11920 $4*D010+C002*AB007*D007-C001*AB001*D035-C055*AB007*D004+C050*AB001*CHE11930 $D018) CHE11940 EP93=OF5*(-C008*AB004*D001-C003*AB001*D005-C009*AB025*D001+C011*ABCHE11950 $004*D001+C051*AB009*D008-C006*AB004*D011+C053*AB004*D004-C004*AB01CHE11960 $0*D005+C005*AB001*D005+C049*AB007*D010-C001*AB001*D036+C050*AB001*CHE11970 $D015) CHE11980 EP24=OF8*(+C018*AB005*D001+C008*AB004*D002+C008*AB002*D005+C003*ABCHE11990 $001*D006+C021*AB018*D001-C024*AB005*D001-C060*AB012*D002+C073*AB00CHE12000 $4*D002+C013*AB005*D003-C061*AB005*D004+C009*AB012*D002-C011*AB004*CHE12010 $D002-C051*AB005*D003+C007*AB005*D004+C006*AB004*D012-C075*AB004*D0CHE12020 $13+C009*AB011*D005-C010*AB002*D005-C051*AB003*D006+C052*AB001*D006CHE12030 $+C006*AB002*D014-C053*AB002*D015+C004*AB003*D006-C005*AB001*D006-CCHE12040 $049*AB002*D014+C002*AB002*D015+C001*AB001*D024-C054*AB001*D025) CHE12050 EP44=OF8*(+C021*AB019*D001-C025*AB006*D001-C015*AB013*D002-C025*ABCHE12060 $003*D001+C026*AB001*D001+C018*AB002*D002-C015*AB012*D005+C018*AB00CHE12070 $4*D005+C013*AB005*D006+C009*AB013*D002-C007*AB006*D003+C076*AB006*CHE12080 $D004-C011*AB002*D002+C008*AB001*D003-C008*AB001*D004-C051*AB005*D0CHE12090 $06+C006*AB004*D014-C053*AB004*D015+C009*AB012*D005-C011*AB004*D005CHE12100 $-C007*AB003*D007+C008*AB001*D007+C006*AB002*D016+C076*AB003*D004-CCHE12110 $053*AB002*D013+C004*AB005*D006-C002*AB004*D014+C055*AB004*D015-C00CHE12120 $2*AB002*D016+C001*AB001*D026-C050*AB001*D027+C055*AB002*D013-C050*CHE12130 $AB001*D022+C074*AB001*D023) CHE12140 EP54=OF8*(+C018*AB005*D001+C008*AB004*D002+C008*AB002*D005+C003*ABCHE12150 $001*D006+C021*AB026*D001-C024*AB005*D001-C060*AB013*D005+C073*AB00CHE12160 $2*D005+C013*AB005*D007-C061*AB005*D004+C009*AB023*D002-C010*AB004*CHE12170 $D002-C051*AB006*D006+C052*AB001*D006+C006*AB004*D016-C053*AB004*D0CHE12180 $13+C009*AB013*D005-C011*AB002*D005-C051*AB005*D007+C007*AB005*D004CHE12190 $+C006*AB002*D034-C075*AB002*D015+C004*AB006*D006-C005*AB001*D006-CCHE12200 $049*AB004*D016+C002*AB004*D013+C001*AB001*D037-C054*AB001*D025) CHE12210 EP74=OF8*(+C021*AB021*D001-C025*AB009*D001-C015*AB015*D002-C015*ABCHE12220 $012*D008+C018*AB004*D008+C013*AB005*D009+C009*AB015*D002-C007*AB00CHE12230 $9*D003+C076*AB009*D004-C007*AB005*D009+C006*AB004*D017-C053*AB004*CHE12240 $D018+C009*AB014*D005-C011*AB007*D005-C007*AB008*D006-C007*AB003*D0CHE12250 $10+C008*AB001*D010+C006*AB002*D019+C004*AB008*D006-C002*AB007*D014CHE12260 $+C055*AB007*D015-C002*AB002*D019+C001*AB001*D030-C050*AB001*D031) CHE12270 EP84=OF8*(+C021*AB027*D001-C015*AB013*D008-C025*AB008*D001+C018*ABCHE12280 $002*D008-C015*AB015*D005+C013*AB005*D010+C009*AB024*D002-C007*AB00CHE12290 $6*D009-C011*AB007*D002+C008*AB001*D009-C007*AB009*D006+C006*AB004*CHE12300 $D019+C009*AB015*D005-C007*AB005*D010-C007*AB008*D007+C006*AB002*D0CHE12310 $35+C076*AB008*D004-C053*AB002*D018+C004*AB009*D006-C002*AB004*D019CHE12320 $-C002*AB007*D016+C001*AB001*D038+C055*AB007*D013-C050*AB001*D029) CHE12330 EP94=OF8*(+C018*AB005*D001+C008*AB004*D002+C008*AB002*D005+C003*ABCHE12340 $001*D006+C021*AB028*D001-C025*AB005*D001-C060*AB015*D008+C013*AB00CHE12350 $5*D011-C061*AB005*D004+C009*AB025*D002-C011*AB004*D002-C051*AB009*CHE12360 $D009+C006*AB004*D020-C053*AB004*D013+C009*AB016*D005-C011*AB002*D0CHE12370 $05-C051*AB008*D010+C006*AB002*D036-C053*AB002*D015+C004*AB010*D006CHE12380 $-C005*AB001*D006-C049*AB007*D019+C001*AB001*D039-C050*AB001*D025) CHE12390 EP25=OF8*(+C017*AB001*D001+C018*AB006*D001-C019*AB001*D001+C052*ABCHE12400 $004*D005+C003*AB001*D007-C058*AB001*D004+C011*AB003*D001-C020*AB00CHE12410 $1*D001-C052*AB002*D002+C012*AB001*D003-C059*AB001*D004+C021*AB019*CHE12420 $D001-C025*AB006*D001-C060*AB013*D002+C013*AB006*D003-C061*AB006*D0CHE12430 $04-C025*AB003*D001+C026*AB001*D001+C073*AB002*D002-C014*AB001*D003CHE12440 $+C062*AB001*D004+C063*AB012*D005-C071*AB004*D005-C064*AB005*D006+CCHE12450 $056*AB004*D014-C006*AB004*D015+C004*AB003*D007-C005*AB001*D007-C04CHE12460 $9*AB002*D016+C001*AB001*D026-C050*AB001*D027-C069*AB003*D004+C070*CHE12470 $AB001*D004+C002*AB002*D013-C050*AB001*D022+C074*AB001*D023) CHE12480 EP45=OF8*(+C011*AB005*D001-C008*AB004*D002-C008*AB002*D005+C012*ABCHE12490 $001*D006+C021*AB026*D001-C015*AB023*D002-C024*AB005*D001+C016*AB00CHE12500 $4*D002-C015*AB013*D005+C013*AB006*D006+C018*AB002*D005-C014*AB001*CHE12510 $D006+C063*AB013*D005-C051*AB006*D006-C071*AB002*D005+C052*AB001*D0CHE12520 $06-C051*AB005*D007+C056*AB004*D016+C007*AB005*D004-C006*AB004*D013CHE12530 $+C004*AB005*D007-C002*AB004*D016-C002*AB002*D034+C001*AB001*D037+CCHE12540 $072*AB002*D015-C054*AB001*D025-C069*AB005*D004+C055*AB004*D013) CHE12550 EP55=OF8*(+C017*AB001*D001+C018*AB006*D001-C019*AB001*D001+C057*ABCHE12560 $004*D005+C003*AB001*D007-C058*AB001*D004+C011*AB006*D001-C020*AB00CHE12570 $1*D001+C012*AB001*D007-C059*AB001*D004+C021*AB029*D001-C022*AB006*CHE12580 $D001-C060*AB023*D005+C023*AB001*D001+C038*AB004*D005+C013*AB006*D0CHE12590 $07-C061*AB006*D004-C014*AB001*D007+C062*AB001*D004+C063*AB023*D005CHE12600 $-C033*AB004*D005-C064*AB006*D007+C051*AB006*D004+C031*AB001*D007-CCHE12610 $052*AB001*D004+C056*AB004*D034-C065*AB004*D015+C004*AB006*D007-C00CHE12620 $5*AB001*D007-C049*AB004*D034+C066*AB004*D015+C001*AB001*D040-C067*CHE12630 $AB001*D027+C068*AB001*D023-C069*AB006*D004+C070*AB001*D004) CHE12640 EP75=OF8*(+C011*AB008*D001-C008*AB007*D002-C008*AB002*D008+C012*ABCHE12650 $001*D009+C021*AB027*D001-C015*AB024*D002-C015*AB013*D008+C013*AB00CHE12660 $6*D009-C025*AB008*D001+C018*AB007*D002+C018*AB002*D008-C014*AB001*CHE12670 $D009+C063*AB015*D005-C051*AB009*D006-C051*AB005*D010+C056*AB004*D0CHE12680 $19+C004*AB008*D007-C002*AB007*D016-C002*AB002*D035+C001*AB001*D038CHE12690 $-C069*AB008*D004+C055*AB007*D013+C055*AB002*D018-C050*AB001*D029) CHE12700 EP85=OF8*(+C011*AB009*D001-C008*AB004*D008-C008*AB007*D005+C012*ABCHE12710 $001*D010+C021*AB030*D001-C015*AB023*D008-C024*AB009*D001+C016*AB00CHE12720 $4*D008-C015*AB024*D005+C013*AB006*D010+C018*AB007*D005-C014*AB001*CHE12730 $D010+C063*AB024*D005-C051*AB006*D010-C071*AB007*D005+C052*AB001*D0CHE12740 $10-C051*AB009*D007+C056*AB004*D035+C007*AB009*D004-C006*AB004*D018CHE12750 $+C004*AB009*D007-C002*AB004*D035-C002*AB007*D034+C001*AB001*D041+CCHE12760 $072*AB007*D015-C054*AB001*D031-C069*AB009*D004+C055*AB004*D018) CHE12770 EP95=OF8*(+C017*AB001*D001+C018*AB006*D001-C019*AB001*D001+C052*ABCHE12780 $004*D005+C003*AB001*D007-C058*AB001*D004+C011*AB010*D001-C020*AB00CHE12790 $1*D001-C052*AB007*D008+C012*AB001*D011-C059*AB001*D004+C021*AB031*CHE12800 $D001-C025*AB006*D001-C060*AB024*D008+C013*AB006*D011-C061*AB006*D0CHE12810 $04-C025*AB010*D001+C026*AB001*D001+C073*AB007*D008-C014*AB001*D011CHE12820 $+C062*AB001*D004+C063*AB025*D005-C071*AB004*D005-C064*AB009*D010+CCHE12830 $056*AB004*D036-C006*AB004*D015+C004*AB010*D007-C005*AB001*D007-C04CHE12840 $9*AB007*D035+C001*AB001*D042-C050*AB001*D027-C069*AB010*D004+C070*CHE12850 $AB001*D004+C002*AB007*D018-C050*AB001*D033+C074*AB001*D023) CHE12860 EP26=OF5*(-C008*AB007*D001-C003*AB001*D008-C009*AB014*D001+C011*ABCHE12870 $007*D001+C051*AB008*D002-C006*AB007*D003+C053*AB007*D004-C004*AB00CHE12880 $3*D008+C005*AB001*D008+C049*AB002*D009-C001*AB001*D017+C050*AB001*CHE12890 $D018) CHE12900 EP46=OF5*(-C009*AB015*D001+C007*AB009*D002+C007*AB008*D005-C006*ABCHE12910 $007*D006-C004*AB005*D008+C002*AB004*D009+C002*AB002*D010-C001*AB00CHE12920 $1*D019) CHE12930 EP56=OF5*(-C008*AB007*D001-C003*AB001*D008-C009*AB024*D001+C011*ABCHE12940 $007*D001+C051*AB009*D005-C006*AB007*D007+C053*AB007*D004-C004*AB00CHE12950 $6*D008+C005*AB001*D008+C049*AB004*D010-C001*AB001*D035+C050*AB001*CHE12960 $D018) CHE12970 EP76=OF5*(-C009*AB016*D001+C007*AB010*D002+C011*AB002*D001-C008*ABCHE12980 $001*D002+C007*AB008*D008-C006*AB007*D009-C004*AB008*D008+C002*AB00CHE12990 $7*D009+C002*AB002*D011-C001*AB001*D020-C055*AB002*D004+C050*AB001*CHE13000 $D013) CHE13010 EP86=OF5*(-C009*AB025*D001+C011*AB004*D001+C007*AB009*D008+C007*ABCHE13020 $010*D005-C008*AB001*D005-C006*AB007*D010-C004*AB009*D008+C002*AB00CHE13030 $4*D011-C055*AB004*D004+C002*AB007*D010-C001*AB001*D036+C050*AB001*CHE13040 $D015) CHE13050 EP96=OF5*(-C008*AB007*D001-C003*AB001*D008-C009*AB032*D001+C010*ABCHE13060 $007*D001+C051*AB010*D008-C052*AB001*D008-C006*AB007*D011+C053*AB00CHE13070 $7*D004-C004*AB010*D008+C005*AB001*D008+C049*AB007*D011-C002*AB007*CHE13080 $D004-C001*AB001*D043+C054*AB001*D018) CHE13090 EP27=OF8*(+C018*AB008*D001+C008*AB007*D002+C008*AB002*D008+C003*ABCHE13100 $001*D009+C021*AB020*D001-C024*AB008*D001-C060*AB014*D002+C073*AB00CHE13110 $7*D002+C013*AB008*D003-C061*AB008*D004+C009*AB014*D002-C011*AB007*CHE13120 $D002-C051*AB008*D003+C007*AB008*D004+C006*AB007*D012-C075*AB007*D0CHE13130 $13+C009*AB011*D008-C010*AB002*D008-C051*AB003*D009+C052*AB001*D009CHE13140 $+C006*AB002*D017-C053*AB002*D018+C004*AB003*D009-C005*AB001*D009-CCHE13150 $049*AB002*D017+C002*AB002*D018+C001*AB001*D028-C054*AB001*D029) CHE13160 EP47=OF8*(+C021*AB021*D001-C025*AB009*D001-C015*AB015*D002-C015*ABCHE13170 $014*D005+C018*AB007*D005+C013*AB008*D006+C009*AB015*D002-C007*AB00CHE13180 $9*D003+C076*AB009*D004-C007*AB008*D006+C006*AB007*D014-C053*AB007*CHE13190 $D015+C009*AB012*D008-C011*AB004*D008-C007*AB005*D009-C007*AB003*D0CHE13200 $10+C008*AB001*D010+C006*AB002*D019+C004*AB005*D009-C002*AB004*D017CHE13210 $+C055*AB004*D018-C002*AB002*D019+C001*AB001*D030-C050*AB001*D031) CHE13220 EP57=OF8*(+C018*AB008*D001+C008*AB007*D002+C008*AB002*D008+C003*ABCHE13230 $001*D009+C021*AB027*D001-C025*AB008*D001-C060*AB015*D005+C013*AB00CHE13240 $8*D007-C061*AB008*D004+C009*AB024*D002-C011*AB007*D002-C051*AB009*CHE13250 $D006+C006*AB007*D016-C053*AB007*D013+C009*AB013*D008-C011*AB002*D0CHE13260 $08-C051*AB005*D010+C006*AB002*D035-C053*AB002*D018+C004*AB006*D009CHE13270 $-C005*AB001*D009-C049*AB004*D019+C001*AB001*D038-C050*AB001*D029) CHE13280 EP77=OF8*(+C021*AB022*D001-C025*AB010*D001-C015*AB016*D002-C025*ABCHE13290 $003*D001+C026*AB001*D001+C018*AB002*D002-C015*AB014*D008+C018*AB00CHE13300 $7*D008+C013*AB008*D009+C009*AB016*D002-C007*AB010*D003+C076*AB010*CHE13310 $D004-C011*AB002*D002+C008*AB001*D003-C008*AB001*D004-C051*AB008*D0CHE13320 $09+C006*AB007*D017-C053*AB007*D018+C009*AB014*D008-C011*AB007*D008CHE13330 $-C007*AB003*D011+C008*AB001*D011+C006*AB002*D020+C076*AB003*D004-CCHE13340 $053*AB002*D013+C004*AB008*D009-C002*AB007*D017+C055*AB007*D018-C00CHE13350 $2*AB002*D020+C001*AB001*D032-C050*AB001*D033+C055*AB002*D013-C050*CHE13360 $AB001*D022+C074*AB001*D023) CHE13370 EP87=OF8*(+C021*AB028*D001-C025*AB005*D001-C015*AB015*D008-C015*ABCHE13380 $016*D005+C018*AB002*D005+C013*AB008*D010+C009*AB025*D002-C011*AB00CHE13390 $4*D002-C007*AB009*D009-C007*AB010*D006+C008*AB001*D006+C006*AB007*CHE13400 $D019+C009*AB015*D008-C007*AB005*D011+C076*AB005*D004-C007*AB008*D0CHE13410 $10+C006*AB002*D036-C053*AB002*D015+C004*AB009*D009-C002*AB004*D020CHE13420 $+C055*AB004*D013-C002*AB007*D019+C001*AB001*D039-C050*AB001*D025) CHE13430 EP97=OF8*(+C018*AB008*D001+C008*AB007*D002+C008*AB002*D008+C003*ABCHE13440 $001*D009+C021*AB033*D001-C024*AB008*D001-C060*AB016*D008+C073*AB00CHE13450 $2*D008+C013*AB008*D011-C061*AB008*D004+C009*AB032*D002-C010*AB007*CHE13460 $D002-C051*AB010*D009+C052*AB001*D009+C006*AB007*D020-C053*AB007*D0CHE13470 $13+C009*AB016*D008-C011*AB002*D008-C051*AB008*D011+C007*AB008*D004CHE13480 $+C006*AB002*D043-C075*AB002*D018+C004*AB010*D009-C005*AB001*D009-CCHE13490 $049*AB007*D020+C002*AB007*D013+C001*AB001*D044-C054*AB001*D029) CHE13500 EP28=OF8*(+C018*AB009*D001+C008*AB004*D008+C008*AB007*D005+C003*ABCHE13510 $001*D010+C021*AB021*D001-C025*AB009*D001-C060*AB015*D002+C013*AB00CHE13520 $9*D003-C061*AB009*D004+C009*AB012*D008-C011*AB004*D008-C051*AB005*CHE13530 $D009+C006*AB004*D017-C053*AB004*D018+C009*AB014*D005-C011*AB007*D0CHE13540 $05-C051*AB008*D006+C006*AB007*D014-C053*AB007*D015+C004*AB003*D010CHE13550 $-C005*AB001*D010-C049*AB002*D019+C001*AB001*D030-C050*AB001*D031) CHE13560 EP48=OF8*(+C021*AB027*D001-C015*AB024*D002-C025*AB008*D001+C018*ABCHE13570 $007*D002-C015*AB015*D005+C013*AB009*D006+C009*AB013*D008-C007*AB00CHE13580 $6*D009-C011*AB002*D008+C008*AB001*D009-C007*AB005*D010+C006*AB004*CHE13590 $D019+C009*AB015*D005-C007*AB009*D006-C007*AB008*D007+C006*AB007*D0CHE13600 $16+C076*AB008*D004-C053*AB007*D013+C004*AB005*D010-C002*AB004*D019CHE13610 $-C002*AB002*D035+C001*AB001*D038+C055*AB002*D018-C050*AB001*D029) CHE13620 EP58=OF8*(+C018*AB009*D001+C008*AB004*D008+C008*AB007*D005+C003*ABCHE13630 $001*D010+C021*AB030*D001-C024*AB009*D001-C060*AB024*D005+C073*AB00CHE13640 $7*D005+C013*AB009*D007-C061*AB009*D004+C009*AB023*D008-C010*AB004*CHE13650 $D008-C051*AB006*D010+C052*AB001*D010+C006*AB004*D035-C053*AB004*D0CHE13660 $18+C009*AB024*D005-C011*AB007*D005-C051*AB009*D007+C007*AB009*D004CHE13670 $+C006*AB007*D034-C075*AB007*D015+C004*AB006*D010-C005*AB001*D010-CCHE13680 $049*AB004*D035+C002*AB004*D018+C001*AB001*D041-C054*AB001*D031) CHE13690 EP78=OF8*(+C021*AB028*D001-C015*AB025*D002-C025*AB005*D001+C018*ABCHE13700 $004*D002-C015*AB015*D008+C013*AB009*D009+C009*AB015*D008-C007*AB00CHE13710 $9*D009-C007*AB005*D011+C006*AB004*D020+C076*AB005*D004-C053*AB004*CHE13720 $D013+C009*AB016*D005-C007*AB010*D006-C011*AB002*D005+C008*AB001*D0CHE13730 $06-C007*AB008*D010+C006*AB007*D019+C004*AB008*D010-C002*AB007*D019CHE13740 $-C002*AB002*D036+C001*AB001*D039+C055*AB002*D015-C050*AB001*D025) CHE13750 EP88=OF8*(+C021*AB031*D001-C025*AB006*D001-C015*AB024*D008-C025*ABCHE13760 $010*D001+C026*AB001*D001+C018*AB007*D008-C015*AB025*D005+C018*AB00CHE13770 $4*D005+C013*AB009*D010+C009*AB024*D008-C007*AB006*D011+C076*AB006*CHE13780 $D004-C011*AB007*D008+C008*AB001*D011-C008*AB001*D004-C051*AB009*D0CHE13790 $10+C006*AB004*D036-C053*AB004*D015+C009*AB025*D005-C011*AB004*D005CHE13800 $-C007*AB010*D007+C008*AB001*D007+C006*AB007*D035+C076*AB010*D004-CCHE13810 $053*AB007*D018+C004*AB009*D010-C002*AB004*D036+C055*AB004*D015-C00CHE13820 $2*AB007*D035+C001*AB001*D042-C050*AB001*D027+C055*AB007*D018-C050*CHE13830 $AB001*D033+C074*AB001*D023) CHE13840 EP98=OF8*(+C018*AB009*D001+C008*AB004*D008+C008*AB007*D005+C003*ABCHE13850 $001*D010+C021*AB034*D001-C024*AB009*D001-C060*AB025*D008+C073*AB00CHE13860 $4*D008+C013*AB009*D011-C061*AB009*D004+C009*AB025*D008-C011*AB004*CHE13870 $D008-C051*AB009*D011+C007*AB009*D004+C006*AB004*D043-C075*AB004*D0CHE13880 $18+C009*AB032*D005-C010*AB007*D005-C051*AB010*D010+C052*AB001*D010CHE13890 $+C006*AB007*D036-C053*AB007*D015+C004*AB010*D010-C005*AB001*D010-CCHE13900 $049*AB007*D036+C002*AB007*D015+C001*AB001*D045-C054*AB001*D031) CHE13910 EP29=OF8*(+C017*AB001*D001+C018*AB010*D001-C019*AB001*D001+C052*ABCHE13920 $007*D008+C003*AB001*D011-C058*AB001*D004+C011*AB003*D001-C020*AB00CHE13930 $1*D001-C052*AB002*D002+C012*AB001*D003-C059*AB001*D004+C021*AB022*CHE13940 $D001-C025*AB010*D001-C060*AB016*D002+C013*AB010*D003-C061*AB010*D0CHE13950 $04-C025*AB003*D001+C026*AB001*D001+C073*AB002*D002-C014*AB001*D003CHE13960 $+C062*AB001*D004+C063*AB014*D008-C071*AB007*D008-C064*AB008*D009+CCHE13970 $056*AB007*D017-C006*AB007*D018+C004*AB003*D011-C005*AB001*D011-C04CHE13980 $9*AB002*D020+C001*AB001*D032-C050*AB001*D033-C069*AB003*D004+C070*CHE13990 $AB001*D004+C002*AB002*D013-C050*AB001*D022+C074*AB001*D023) CHE14000 EP49=OF8*(+C011*AB005*D001-C008*AB004*D002-C008*AB002*D005+C012*ABCHE14010 $001*D006+C021*AB028*D001-C015*AB025*D002-C015*AB016*D005+C013*AB01CHE14020 $0*D006-C025*AB005*D001+C018*AB004*D002+C018*AB002*D005-C014*AB001*CHE14030 $D006+C063*AB015*D008-C051*AB009*D009-C051*AB008*D010+C056*AB007*D0CHE14040 $19+C004*AB005*D011-C002*AB004*D020-C002*AB002*D036+C001*AB001*D039CHE14050 $-C069*AB005*D004+C055*AB004*D013+C055*AB002*D015-C050*AB001*D025) CHE14060 EP59=OF8*(+C017*AB001*D001+C018*AB010*D001-C019*AB001*D001+C052*ABCHE14070 $007*D008+C003*AB001*D011-C058*AB001*D004+C011*AB006*D001-C020*AB00CHE14080 $1*D001-C052*AB004*D005+C012*AB001*D007-C059*AB001*D004+C021*AB031*CHE14090 $D001-C025*AB010*D001-C060*AB025*D005+C013*AB010*D007-C061*AB010*D0CHE14100 $04-C025*AB006*D001+C026*AB001*D001+C073*AB004*D005-C014*AB001*D007CHE14110 $+C062*AB001*D004+C063*AB024*D008-C071*AB007*D008-C064*AB009*D010+CCHE14120 $056*AB007*D035-C006*AB007*D018+C004*AB006*D011-C005*AB001*D011-C04CHE14130 $9*AB004*D036+C001*AB001*D042-C050*AB001*D033-C069*AB006*D004+C070*CHE14140 $AB001*D004+C002*AB004*D015-C050*AB001*D027+C074*AB001*D023) CHE14150 EP79=OF8*(+C011*AB008*D001-C008*AB007*D002-C008*AB002*D008+C012*ABCHE14160 $001*D009+C021*AB033*D001-C015*AB032*D002-C024*AB008*D001+C016*AB00CHE14170 $7*D002-C015*AB016*D008+C013*AB010*D009+C018*AB002*D008-C014*AB001*CHE14180 $D009+C063*AB016*D008-C051*AB010*D009-C071*AB002*D008+C052*AB001*D0CHE14190 $09-C051*AB008*D011+C056*AB007*D020+C007*AB008*D004-C006*AB007*D013CHE14200 $+C004*AB008*D011-C002*AB007*D020-C002*AB002*D043+C001*AB001*D044+CCHE14210 $072*AB002*D018-C054*AB001*D029-C069*AB008*D004+C055*AB007*D013) CHE14220 EP89=OF8*(+C011*AB009*D001-C008*AB004*D008-C008*AB007*D005+C012*ABCHE14230 $001*D010+C021*AB034*D001-C024*AB009*D001-C015*AB025*D008-C015*AB03CHE14240 $2*D005+C016*AB007*D005+C013*AB010*D010+C018*AB004*D008-C014*AB001*CHE14250 $D010+C063*AB025*D008-C071*AB004*D008-C051*AB009*D011+C007*AB009*D0CHE14260 $04-C051*AB010*D010+C052*AB001*D010+C056*AB007*D036-C006*AB007*D015CHE14270 $+C004*AB009*D011-C002*AB004*D043+C072*AB004*D018-C002*AB007*D036+CCHE14280 $001*AB001*D045-C054*AB001*D031-C069*AB009*D004+C055*AB007*D015) CHE14290 EP99=OF8*(+C017*AB001*D001+C018*AB010*D001-C019*AB001*D001+C057*ABCHE14300 $007*D008+C003*AB001*D011-C058*AB001*D004+C011*AB010*D001-C020*AB00CHE14310 $1*D001+C012*AB001*D011-C059*AB001*D004+C021*AB035*D001-C022*AB010*CHE14320 $D001-C060*AB032*D008+C023*AB001*D001+C038*AB007*D008+C013*AB010*D0CHE14330 $11-C061*AB010*D004-C014*AB001*D011+C062*AB001*D004+C063*AB032*D008CHE14340 $-C033*AB007*D008-C064*AB010*D011+C051*AB010*D004+C031*AB001*D011-CCHE14350 $052*AB001*D004+C056*AB007*D043-C065*AB007*D018+C004*AB010*D011-C00CHE14360 $5*AB001*D011-C049*AB007*D043+C066*AB007*D018+C001*AB001*D046-C067*CHE14370 $AB001*D033+C068*AB001*D023-C069*AB010*D004+C070*AB001*D004) CHE14380 C ******************************************************************CHE14390 C * PD *CHE14400 C ******************************************************************CHE14410 3242 CONTINUE CHE14420 EP12=OF7*(+C008*AB002*D001-C012*AB001*D002+C015*AB011*D001-C016*ABCHE14430 $002*D001-C013*AB003*D002+C014*AB001*D002+C051*AB003*D002-C052*AB00CHE14440 $1*D002-C056*AB002*D003+C006*AB002*D004+C002*AB002*D003-C001*AB001*CHE14450 $D012+C054*AB001*D013-C055*AB002*D004) CHE14460 EP32=OF7*(+C008*AB004*D001-C012*AB001*D005+C015*AB012*D001-C013*ABCHE14470 $003*D005-C018*AB004*D001+C014*AB001*D005+C051*AB005*D002-C056*AB00CHE14480 $2*D006+C002*AB004*D003-C001*AB001*D014-C055*AB004*D004+C050*AB001*CHE14490 $D015) CHE14500 EP62=OF7*(+C008*AB007*D001-C012*AB001*D008+C015*AB014*D001-C013*ABCHE14510 $003*D008-C018*AB007*D001+C014*AB001*D008+C051*AB008*D002-C056*AB00CHE14520 $2*D009+C002*AB007*D003-C001*AB001*D017-C055*AB007*D004+C050*AB001*CHE14530 $D018) CHE14540 EP14=OF7*(+C015*AB012*D001-C018*AB004*D001-C013*AB005*D002+C007*ABCHE14550 $005*D002-C006*AB004*D003+C053*AB004*D004+C007*AB003*D005-C008*AB00CHE14560 $1*D005-C006*AB002*D006+C002*AB002*D006-C001*AB001*D014+C050*AB001*CHE14570 $D015) CHE14580 EP34=OF7*(+C015*AB013*D001-C018*AB002*D001-C013*AB005*D005+C007*ABCHE14590 $006*D002-C008*AB001*D002-C006*AB004*D006+C007*AB005*D005-C006*AB00CHE14600 $2*D007+C053*AB002*D004+C002*AB004*D006-C001*AB001*D016+C050*AB001*CHE14610 $D013) CHE14620 EP64=OF7*(+C015*AB015*D001-C013*AB005*D008+C007*AB009*D002-C006*ABCHE14630 $004*D009+C007*AB008*D005-C006*AB002*D010+C002*AB007*D006-C001*AB00CHE14640 $1*D019) CHE14650 EP15=OF7*(+C008*AB002*D001-C012*AB001*D002+C015*AB013*D001-C013*ABCHE14660 $006*D002-C018*AB002*D001+C014*AB001*D002+C051*AB005*D005-C056*AB00CHE14670 $4*D006+C002*AB002*D007-C001*AB001*D016-C055*AB002*D004+C050*AB001*CHE14680 $D013) CHE14690 EP35=OF7*(+C008*AB004*D001-C012*AB001*D005+C015*AB023*D001-C016*ABCHE14700 $004*D001-C013*AB006*D005+C014*AB001*D005+C051*AB006*D005-C052*AB00CHE14710 $1*D005-C056*AB004*D007+C006*AB004*D004+C002*AB004*D007-C001*AB001*CHE14720 $D034+C054*AB001*D015-C055*AB004*D004) CHE14730 EP65=OF7*(+C008*AB007*D001-C012*AB001*D008+C015*AB024*D001-C013*ABCHE14740 $006*D008-C018*AB007*D001+C014*AB001*D008+C051*AB009*D005-C056*AB00CHE14750 $4*D010+C002*AB007*D007-C001*AB001*D035-C055*AB007*D004+C050*AB001*CHE14760 $D018) CHE14770 EP17=OF7*(+C015*AB014*D001-C018*AB007*D001-C013*AB008*D002+C007*ABCHE14780 $008*D002-C006*AB007*D003+C053*AB007*D004+C007*AB003*D008-C008*AB00CHE14790 $1*D008-C006*AB002*D009+C002*AB002*D009-C001*AB001*D017+C050*AB001*CHE14800 $D018) CHE14810 EP37=OF7*(+C015*AB015*D001-C013*AB008*D005+C007*AB009*D002-C006*ABCHE14820 $007*D006+C007*AB005*D008-C006*AB002*D010+C002*AB004*D009-C001*AB00CHE14830 $1*D019) CHE14840 EP67=OF7*(+C015*AB016*D001-C018*AB002*D001-C013*AB008*D008+C007*ABCHE14850 $010*D002-C008*AB001*D002-C006*AB007*D009+C007*AB008*D008-C006*AB00CHE14860 $2*D011+C053*AB002*D004+C002*AB007*D009-C001*AB001*D020+C050*AB001*CHE14870 $D013) CHE14880 EP18=OF7*(+C015*AB015*D001-C013*AB009*D002+C007*AB005*D008-C006*ABCHE14890 $004*D009+C007*AB008*D005-C006*AB007*D006+C002*AB002*D010-C001*AB00CHE14900 $1*D019) CHE14910 EP38=OF7*(+C015*AB024*D001-C018*AB007*D001-C013*AB009*D005+C007*ABCHE14920 $006*D008-C008*AB001*D008-C006*AB004*D010+C007*AB009*D005-C006*AB00CHE14930 $7*D007+C053*AB007*D004+C002*AB004*D010-C001*AB001*D035+C050*AB001*CHE14940 $D018) CHE14950 EP68=OF7*(+C015*AB025*D001-C018*AB004*D001-C013*AB009*D008+C007*ABCHE14960 $009*D008-C006*AB004*D011+C053*AB004*D004+C007*AB010*D005-C008*AB00CHE14970 $1*D005-C006*AB007*D010+C002*AB007*D010-C001*AB001*D036+C050*AB001*CHE14980 $D015) CHE14990 EP19=OF7*(+C008*AB002*D001-C012*AB001*D002+C015*AB016*D001-C013*ABCHE15000 $010*D002-C018*AB002*D001+C014*AB001*D002+C051*AB008*D008-C056*AB00CHE15010 $7*D009+C002*AB002*D011-C001*AB001*D020-C055*AB002*D004+C050*AB001*CHE15020 $D013) CHE15030 EP39=OF7*(+C008*AB004*D001-C012*AB001*D005+C015*AB025*D001-C013*ABCHE15040 $010*D005-C018*AB004*D001+C014*AB001*D005+C051*AB009*D008-C056*AB00CHE15050 $7*D010+C002*AB004*D011-C001*AB001*D036-C055*AB004*D004+C050*AB001*CHE15060 $D015) CHE15070 EP69=OF7*(+C008*AB007*D001-C012*AB001*D008+C015*AB032*D001-C016*ABCHE15080 $007*D001-C013*AB010*D008+C014*AB001*D008+C051*AB010*D008-C052*AB00CHE15090 $1*D008-C056*AB007*D011+C006*AB007*D004+C002*AB007*D011-C001*AB001*CHE15100 $D043+C054*AB001*D018-C055*AB007*D004) CHE15110 C ******************************************************************CHE15120 C * SD *CHE15130 C ******************************************************************CHE15140 3260 CONTINUE CHE15150 EP02=OF6*(+C012*AB001*D001+C013*AB003*D001-C014*AB001*D001+C056*ABCHE15160 $002*D002+C001*AB001*D003-C050*AB001*D004) CHE15170 EP04=OF6*(+C013*AB005*D001+C006*AB004*D002+C006*AB002*D005+C001*ABCHE15180 $001*D006) CHE15190 EP05=OF6*(+C012*AB001*D001+C013*AB006*D001-C014*AB001*D001+C056*ABCHE15200 $004*D005+C001*AB001*D007-C050*AB001*D004) CHE15210 EP07=OF6*(+C013*AB008*D001+C006*AB007*D002+C006*AB002*D008+C001*ABCHE15220 $001*D009) CHE15230 EP08=OF6*(+C013*AB009*D001+C006*AB004*D008+C006*AB007*D005+C001*ABCHE15240 $001*D010) CHE15250 EP09=OF6*(+C012*AB001*D001+C013*AB010*D001-C014*AB001*D001+C056*ABCHE15260 $007*D008+C001*AB001*D011-C050*AB001*D004) CHE15270 IF(ITYPE-6)3261,3262,3261 CHE15280 C ******************************************************************CHE15290 C * PP *CHE15300 C ******************************************************************CHE15310 3261 CONTINUE CHE15320 EP10=OF1*(+C002*AB002*D001-C001*AB001*D002) CHE15330 EP30=OF1*(+C002*AB004*D001-C001*AB001*D005) CHE15340 EP60=OF1*(+C002*AB007*D001-C001*AB001*D008) CHE15350 EP11=OF4*(-C007*AB003*D001+C008*AB001*D001+C006*AB002*D002-C002*ABCHE15360 $002*D002+C001*AB001*D003-C050*AB001*D004) CHE15370 EP31=OF4*(-C007*AB005*D001+C006*AB002*D005-C002*AB004*D002+C001*ABCHE15380 $001*D006) CHE15390 EP61=OF4*(-C007*AB008*D001+C006*AB002*D008-C002*AB007*D002+C001*ABCHE15400 $001*D009) CHE15410 EP13=OF4*(-C007*AB005*D001+C006*AB004*D002-C002*AB002*D005+C001*ABCHE15420 $001*D006) CHE15430 EP33=OF4*(-C007*AB006*D001+C008*AB001*D001+C006*AB004*D005-C002*ABCHE15440 $004*D005+C001*AB001*D007-C050*AB001*D004) CHE15450 EP63=OF4*(-C007*AB009*D001+C006*AB004*D008-C002*AB007*D005+C001*ABCHE15460 $001*D010) CHE15470 EP16=OF4*(-C007*AB008*D001+C006*AB007*D002-C002*AB002*D008+C001*ABCHE15480 $001*D009) CHE15490 EP36=OF4*(-C007*AB009*D001+C006*AB007*D005-C002*AB004*D008+C001*ABCHE15500 $001*D010) CHE15510 EP66=OF4*(-C007*AB010*D001+C008*AB001*D001+C006*AB007*D008-C002*ABCHE15520 $007*D008+C001*AB001*D011-C050*AB001*D004) CHE15530 3262 CONTINUE CHE15540 DO 2137 I=1,100 CHE15550 2137 EPN(I)=EPN(I)+EEP(I) CHE15560 105 CONTINUE CHE15570 C ******************************************************************CHE15580 C END OF LOOP OVER GAUSSIANS CHE15590 C STORE IN ARRAYS CHE15600 C ******************************************************************CHE15610 INTC=0 CHE15620 DO 500 J=1,10 CHE15630 R3B=RENORM(J) CHE15640 DO 500 I=1,10 CHE15650 R3A=R3B*RENORM(I) CHE15660 INTC=INTC+1 CHE15670 500 EPN(INTC) = ( EPN(INTC) )*R3A*SYMFAC CHE15680 CALL REDUC1(EPN,LAMAX,LBMAX,I6TO5) CHE15690 CALL MATFIL(H,EPN,AOS,SHELLT,INEW,JNEW,LAMAX,LBMAX,LA,LB) CHE15700 1000 CONTINUE CHE15710 C CHE15720 C REFORMAT COMMON /B/ AND THE H ARRAY IF THIS BASIS CONTAINS CHE15730 C P ONLY SHELLS CHE15740 C CHE15750 IF (IPO(4) .EQ. 0) GOTO 1285 CHE15760 WRITE(IOUT,*) 'DEBUG OF UNSTAR' CHE15770 CALL LINOUT (H,NBASIS,0,0) CHE15780 1285 CONTINUE CHE15790 C CHE15800 CALL UNSTAR (NBASIS,SHELLT,SHELLC,AOS,NSHELL,H,NOSTAR) CHE15810 C CHE15820 IF(IPO(4).EQ.0) GOTO 1500 CHE15830 WRITE(IOUT,2010) CHE15840 CALL LINOUT(H,NBASIS,0,0) CHE15850 1500 CONTINUE CHE15860 RETURN CHE15870 END CHE15880 SUBROUTINE INV(A,N,IS,IAD1,IAD2,D,MDM) CHE15890 IMPLICIT DOUBLE PRECISION (A-H,O-Z) CHE15900 C ******************************************************************CHE15910 C INVERSION OF SQUARE MATRIX A BY MEANS OF THE GAUSS-JORDAN CHE15920 C ALGORITHM CHE15930 C CHE15940 C APRIL 72/RS9B CHE15950 C ******************************************************************CHE15960 DIMENSION A(MDM,MDM),IS(2,MDM),IAD1(MDM),IAD2(MDM),D(MDM) CHE15970 C CHE15980 COMMON/IO/IN,IOUT,IPUNCH CHE15990 C CHE16000 DATA ZERO/0.0D0/, ONE/1.0D0/, SMALL/1.0D-20/ CHE16010 C CHE16020 2000 FORMAT(' WARNING FROM INV: MATRIX IS SINGULAR') CHE16030 C ******************************************************************CHE16040 DO 1 L=1,N CHE16050 IS(1,L)=0 CHE16060 1 IS(2,L)=0 CHE16070 DO 9 IMA=1,N CHE16080 B= ZERO CHE16090 DO 2 L=1,N CHE16100 DO 2 M=1,N CHE16110 IF(IS(1,L).EQ.1.OR.IS(2,M).EQ.1) GOTO 2 CHE16120 E=DABS(A(L,M)) CHE16130 IF(E.LT.B) GOTO 8 CHE16140 I=L CH