| http://server.ccl.net/cca/software/SOURCES/FORTRAN/chelpg/chelpgunix.shtml |
|
CCL chelpgunix | |||
|
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 CHE16150
K=M CHE16160
8 B=DMAX1(B,E) CHE16170
2 CONTINUE CHE16180
IS(1,I)=1 CHE16190
IS(2,K)=1 CHE16200
IAD1(K)=I CHE16210
IAD2(I)=K CHE16220
B=A(I,K) CHE16230
C.....PIVOT CHE16240
IF(DABS(B).LT. SMALL) GOTO 20 CHE16250
A(I,K)=ONE/B CHE16260
DO 6 L=1,N CHE16270
IF(L.EQ.K) GOTO 6 CHE16280
C.....KELLERZEILE CHE16290
A(I,L)=-A(I,L)/B CHE16300
6 CONTINUE CHE16310
DO 5 L=1,N CHE16320
DO 5 M=1,N CHE16330
IF(L.EQ.I.OR.M.EQ.K) GOTO 5 CHE16340
C.....RECHTECK-REGEL CHE16350
A(L,M)=A(L,M)+A(L,K)*A(I,M) CHE16360
5 CONTINUE CHE16370
DO 11 L=1,N CHE16380
IF(L.EQ.I) GOTO 11 CHE16390
C.....PIVOT-SPALTE CHE16400
A(L,K)=A(L,K)/B CHE16410
11 CONTINUE CHE16420
9 CONTINUE CHE16430
C.....PERMUTATION DER ZEILEN, UM DIE NATUERLICHE ORDNUNG WIEDER HERZUSTECHE16440
DO 15 L=1,N CHE16450
DO 13 J=1,N CHE16460
K=IAD1(J) CHE16470
13 D(J)=A(K,L) CHE16480
DO 14 J=1,N CHE16490
14 A(J,L)=D(J) CHE16500
15 CONTINUE CHE16510
C.....PERMUTATION DER SPALTEN CHE16520
DO 16 L=1,N CHE16530
DO 17 J=1,N CHE16540
K=IAD2(J) CHE16550
17 D(J)=A(L,K) CHE16560
DO 18 J=1,N CHE16570
18 A(L,J)=D(J) CHE16580
16 CONTINUE CHE16590
RETURN CHE16600
C CHE16610
C ERROR EXIT: MATRIX IS SINGULAR CHE16620
20 WRITE(IOUT,2000) CHE16630
STOP 'INV IN POLAR' CHE16640
END CHE16650
SUBROUTINE LINOUT(X,N,KEY,IZERO) CHE16660
C CHE16670
C GENERAL LINEAR MATRIX OUTPUT ROUTINE CHE16680
C CHE16690
C KEY=0 MATRIX SYMMETRIC CHE16700
C KEY=1 MATRIX SQUARE ASYMMETRIC CHE16710
C CHE16720
C IZERO=0 ZERO MATRIX ELEMENTS LESS THAN CUTOFF CHE16730
C IZERO=1 DO NOT ZERO MATRIX ELEMENTS CHE16740
C CHE16750
C CUTOFF=1.0E-06 CHE16760
C CHE16770
IMPLICIT REAL*8 (A-H,O-Z) CHE16780
COMMON/IO/IN,IOUT CHE16790
C CHE16800
DIMENSION S(9),X(1) CHE16810
C CHE16820
DATA CUTOFF/1.0E-06/ CHE16830
DATA ZERO/0.0E0/ CHE16840
C CHE16850
IA(I)=(I*(I-1))/2 CHE16860
C CHE16870
C CHE16880
ILOWER=1 CHE16890
100 IUPPER=MIN0(ILOWER+8,N) CHE16900
IRANGE=MIN0(IUPPER-ILOWER+1,9) CHE16910
WRITE (IOUT,9000) (J,J=ILOWER,IUPPER) CHE16920
WRITE (IOUT,9010) CHE16930
DO 160 I=1,N CHE16940
K=1 CHE16950
DO 150 J=ILOWER,IUPPER CHE16960
IF(KEY)110,120,110 CHE16970
110 IJ=N*(J-1)+I CHE16980
GO TO 140 CHE16990
120 IJ=IA(I)+J CHE17000
IF(I-J)130,140,140 CHE17010
130 IJ=IA(J)+I CHE17020
140 S(K)=X(IJ) CHE17030
IF(IZERO.EQ.0.AND.ABS(S(K)).LE.CUTOFF) S(K)=ZERO CHE17040
150 K=K+1 CHE17050
160 WRITE (IOUT,9020) I,(S(J),J=1,IRANGE) CHE17060
WRITE (IOUT,9010) CHE17070
ILOWER=ILOWER+9 CHE17080
IF(N-IUPPER)170,170,100 CHE17090
170 RETURN CHE17100
9000 FORMAT(12X,8(I3,11X),I3) CHE17110
9010 FORMAT(/) CHE17120
9020 FORMAT(1X,I3,2X,9E14.6) CHE17130
END CHE17140
SUBROUTINE MATFIL(A,AA,AOS,SHELLT,INEW,JNEW,LAMAX,LBMAX,LA,LB) CHE17150
C CHE17160
C GAUSSIAN 77/UCI CHE17170
C CHE17180
IMPLICIT REAL*8 (A-H,O-Z) CHE17190
INTEGER AOS(1), SHELLT(1) CHE17200
C CHE17210
DIMENSION A(1),AA(1) CHE17220
C CHE17230
LIND(I)=(I*(I-1))/2 CHE17240
C CHE17250
ISTART=AOS(INEW) CHE17260
JSTART=AOS(JNEW) CHE17270
IAL = 0 CHE17280
IAU = 5 CHE17290
IBL = 0 CHE17300
IBU = 5 CHE17310
IMA = 0 CHE17320
IMB = 0 CHE17330
IF(SHELLT(INEW) .EQ. 2) IMA = 1 CHE17340
IF(SHELLT(JNEW) .EQ. 2) IMB = 1 CHE17350
C CHE17360
120 INTC=0 CHE17370
DO 170 J=1,LBMAX CHE17380
DO 170 I=1,LAMAX CHE17390
INTC=INTC+1 CHE17400
IF( LA.GT.1 .AND. I.GT.IAL .AND. I.LT.IAU )GO TO 170 CHE17410
IF( LA.EQ.1 .AND. I.EQ.IMA )GO TO 170 CHE17420
IF( LB.GT.1 .AND. J.GT.IBL .AND. J.LT.IBU )GO TO 170 CHE17430
IF( LB.EQ.1 .AND. J.EQ.IMB )GO TO 170 CHE17440
IND=ISTART+I-1 CHE17450
JND=JSTART+J-1 CHE17460
IF(IND-JND)130,140,150 CHE17470
130 IJ=LIND(JND)+IND CHE17480
GO TO 160 CHE17490
140 IJ=LIND(IND+1) CHE17500
GO TO 160 CHE17510
150 IJ=LIND(IND)+JND CHE17520
160 A(IJ)=AA(INTC) CHE17530
170 CONTINUE CHE17540
RETURN CHE17550
END CHE17560
SUBROUTINE MULTAY(A,Y,X,N,MAXDIM) CHE17570
C CHE17580
C MATRIX MULTIPLICATION ROUTINE CHE17590
C CHE17600
IMPLICIT REAL*8 (A-H,O-Z) CHE17610
C CHE17620
DIMENSION A(MAXDIM,MAXDIM),Y(MAXDIM),X(MAXDIM) CHE17630
C CHE17640
DATA ZERO/0.0/ CHE17650
C CHE17660
DO 200 IROW=1,N CHE17670
SUM = ZERO CHE17680
DO 100 JCOL=1,N CHE17690
SUM = SUM + A(IROW,JCOL) * Y(JCOL) CHE17700
100 CONTINUE CHE17710
X(IROW) = SUM CHE17720
200 CONTINUE CHE17730
RETURN CHE17740
END CHE17750
C CHE17760
SUBROUTINE OUTPUT CHE17770
C CHE17780
C CHE17790
C L.E. CHIRLIAN CHE17800
C APRIL 1985 CHE17810
C CHE17820
C A SUBROUTINE TO OUTPUT THE CHARGES AND OTHER PERTINANT CHE17830
C INFORMATION FROM THE CHELP PROGRAM CHE17840
C CHE17850
C Slightly Modified for CHELPG operations by Curt Breneman CHE17860
C Yale University Department of Chemistry, 2/88 CHE17870
C CHE17880
IMPLICIT REAL*8 (A-H,O-Z) CHE17890
PARAMETER (NPOINTS = 50000) CHE17900
INTEGER*4 SHELLA,SHELLN,SHELLT,SHELLC,AOS,AON,SHLADF CHE17910
CHARACTER*40 CHKFIL CHE17920
C CHE17930
COMMON /IO/ IN,IOUT CHE17940
COMMON /IPO/ IPO(5) CHE17950
C+++ CHE17960
COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NE,NBASIS, CHE17970
$ IAN(401),ATMCHG(400),C(3,400) CHE17980
C+++ CHE17990
C COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NE,NBASIS,IAN(101), CHE18000
C 1 ATMCHG(100),C(3,100) CHE18010
COMMON /OUT/ Q(400),RMS,PD,NTITLE(20,3),ND,NLIN,NEND(3), CHE18020
1 CHKFIL CHE18030
COMMON /POINTS/ P(3,NPOINTS), NP CHE18040
DATA DEB/0.393427328/ CHE18050
c CHE18060
c CHE18070
c write(6,*) 'Debug --', nlin,nend(1),nend(2),nend(3),nwords CHE18080
C CHE18090
C CALCULATE THE DIPOLE MOMENT FROM THE FITTED CHARGES CHE18100
C CHE18110
C CHE18120
DIPX=0. CHE18130
DIPY=0. CHE18140
DIPZ=0. CHE18150
DO 99 I=1,NATOMS CHE18160
DIPX=DIPX+(Q(I)*C(1,I)) CHE18170
DIPY=DIPY+(Q(I)*C(2,I)) CHE18180
DIPZ=DIPZ+(Q(I)*C(3,I)) CHE18190
99 CONTINUE CHE18200
DIPX=DIPX/DEB CHE18210
DIPY=DIPY/DEB CHE18220
DIPZ=DIPZ/DEB CHE18230
C CHE18240
C CALCULATE TOTAL DIPOLE MOMENT CHE18250
C CHE18260
DIPTOT = DSQRT(DIPX**2+DIPY**2+DIPZ**2) CHE18270
C CHE18280
C CREATE OUTPUT CHE18290
C CHE18300
WRITE (IOUT,100) CHE18310
100 FORMAT (/,/,17X,'CHARGES FROM ELECTROSTATIC POTENTIAL GRID') CHE18320
WRITE (IOUT,110) CHE18330
WRITE (IOUT,111) CHE18340
110 FORMAT (/,36X,'CHELPGrid',/) CHE18350
111 FORMAT (/,15X,'Grid Modification.') CHE18360
DO 24 I=1,NLIN CHE18370
WRITE (6,1200)(NTITLE(J,I),J=1,NEND(I)) CHE18380
1200 FORMAT(2X,19A4) CHE18390
24 CONTINUE CHE18400
C CHE18410
C WRITE CHECKPOINT FILE NAME CHE18420
C CHE18430
WRITE (IOUT,150)CHKFIL CHE18440
150 FORMAT(/2X,'CHECKPOINT FILE: ',A40) CHE18450
C CHE18460
C PRINT DATE CHE18470
C CHE18480
C*** Take out for Trace-7 CHE18490
C CALL FOR$JDATE(IMONTH,IDATE,IYEAR) CHE18500
C*** CHE18510
WRITE (IOUT,170)IMONTH,IDATE,IYEAR CHE18520
170 FORMAT (/2X,I2,'-',I2,'-',I2) CHE18530
C CHE18540
C***********************************************************************CHE18550
C WRITE GEOMETRY CHE18560
C***********************************************************************CHE18570
C CHE18580
WRITE (IOUT,180) CHE18590
180 FORMAT (/2X,36X,'MOLECULAR GEOMETRY') CHE18600
WRITE (IOUT,190) CHE18610
190 FORMAT (/,/,17X,'ATOMIC NUMBER',8X,'X',12X,'Y',12X,'Z') CHE18620
DO 30 I=1,NATOMS CHE18630
WRITE (IOUT,200)IAN(I),C(1,I),C(2,I),C(3,I) CHE18640
200 FORMAT (/,23X,I2,8X,F10.7,3X,F10.7,3X,F10.7) CHE18650
30 CONTINUE CHE18660
WRITE (IOUT,210)ICHARG CHE18670
210 FORMAT (/2X,'THE TOTAL CHARGE IS CONSTRAINED TO: ',I3) CHE18680
WRITE (IOUT,240) CHE18690
240 FORMAT (/,36X,'NET CHARGES') CHE18700
WRITE (IOUT,250) CHE18710
250 FORMAT (/,28X,'ATOMIC NUMBER',5X,'CHARGE') CHE18720
WRITE (IOUT,260)(IAN(I),Q(I),I=1,NATOMS) CHE18730
WRITE (6,101) DIPTOT CHE18740
101 FORMAT (/,2X,'THE DIPOLE MOMENT OF THESE CHARGES IS: ',F8.5) CHE18750
260 FORMAT (/,34X,I2,10X,F8.4) CHE18760
WRITE (IOUT,270)NP CHE18770
270 FORMAT(/,2X,'FIT TO ELECTROSTATIC POTENTIAL AT ',I6,' POINTS') CHE18780
WRITE (IOUT,280)RMS CHE18790
280 FORMAT (/,2X,'ROOT MEAN SQUARE DEVIATION IS ',F6.4,' KCAL/MOLE') CHE18800
RETURN CHE18810
END CHE18820
CHE18830
SUBROUTINE READIN CHE18840
C CHE18850
C WRITTEN BY M.M. FRANCL FOR THE CHE18860
C PRINCETON CHEMISTRY DEPARTMENT VAX 11/780 UNDER VMS 3.4. CHE18870
C MODIFIED BY L.E. CHIRLIAN UNDER VMS 3.7. CHE18880
C CHE18890
C MODIFIED FOR GAUSSIAN 86 BY CURT BRENEMAN (VMS 4.5) CHE18900
C Modified for G88/90 by Curt Breneman, 2/89 CHE18910
C YALE UNIVERSITY DEPARTMENT OF CHEMISTRY. CHE18920
C CHE18930
C THIS VERSION IS COMPATIBLE WITH GAUSSIAN 82 FROM CARNEGIE- CHE18940
C MELLON UNIVERSITY AND IS DESIGNED FOR THE INPUT OF MO AND CHE18950
C BASIS INFORMATION FROM CHECKPOINT FILES. THIS VERSION IS CHE18960
C TO BE USED FOR THE DETERMINATION OF ATOMIC CHARGES FROM CHE18970
C ELECTROSTATIC POTENTIALS DETERMINED BY FIRST ORDER HARTREE CHE18980
C FOCK PERURBATION THEORY. CHE18990
C CHE19000
C OLD LIMITATIONS: NO MORE THAN 256 BASIS FUNCTIONS CHE19010
C NO MORE THAN 80 SHELLS CHE19020
C CHE19030
C NEW LIMITATIONS: NO MORE THAN 1280 BASIS FUNCTIONS CHE19040
C NO MORE THAN 400 SHELLS CHE19050
C CHE19060
IMPLICIT REAL*8 (A-H,O-Z) CHE19070
INTEGER*4 SHELLA,SHELLN,SHELLT,SHELLC,AOS,AON,SHLADF,FILNUM CHE19080
CHARACTER*40 CHKFIL CHE19090
PARAMETER (NUMPTS = 20) CHE19100
DIMENSION LINE(20) CHE19110
C CHE19120
COMMON /IO/ IN,IOUT CHE19130
c+++ CHE19140
c Change for G86 : New Commons /MOL/ and /B/ CHE19150
c CHE19160
COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NE,NBASIS, CHE19170
$ IAN(401),ATMCHG(400),C(3,400) CHE19180
C CHE19190
C=== Gaussian88 Modification. New Common /b/ size. CHE19200
Common/B/EXX(6000),C1(6000),C2(6000),C3(2000),CF(2000), CHE19210
$SHLADF(4000),X(2000),Y(2000), CHE19220
$Z(2000),JAN(2000),ShellA(2000),ShellN(2000),ShellT(2000), CHE19230
$ShellC(2000),AOS(2000),AON(2000),NShell,MaxTyp CHE19240
C=== Old G86 Common /b/ CHE19250
c COMMON/B/EXX(1200),C1(1200),C2(1200),C3(400),CF(400),SHLADF(800),CHE19260
c $ X(400),Y(400),Z(400),JAN(400),SHELLA(400),SHELLN(400), CHE19270
c $ SHELLT(400),SHELLC(400),AOS(400),AON(400),NSHELL,MAXTYP CHE19280
c CHE19290
c+++ CHE19300
C%%% CHE19310
c Original CHELP common /B/ CHE19320
c CHE19330
c COMMON /B/ EXX(240),C1(240),C2(240),C3(80),CF(80),SHLADF(160), CHE19340
c $ X(80),Y(80),Z(80), CHE19350
c $ JAN(80),SHELLA(80),SHELLN(80),SHELLT(80),SHELLC(80), CHE19360
c $ AOS(80),AON(80),NSHELL,MAXTYP CHE19370
C COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NE,NBASIS,IAN(101), CHE19380
C $ ATMCHG(100),C(3,100) CHE19390
C%%% CHE19400
COMMON /IPO/ IPO(5) CHE19410
COMMON /OUT/ Q(400),RMS,PD,NTITLE(20,3),ND,NLIN,NEND(3), CHE19420
1 CHKFIL CHE19430
COMMON /CHARGE/ COEF_ALPHA(100000),COEF_BETA(100000),IUHF CHE19440
COMMON /SPHERE/ VDWR(400), NPTS CHE19450
C VECT(3,NUMPTS) CHE19460
C CHE19470
DATA MAXBAS /1280/ CHE19480
DATA MAXPTS/ 50000/ CHE19490
DATA NPO/ 5/ CHE19500
DATA IUNIT/ 3/, IREAD/ 2/, IFIND/11/, IBLNK/4H / CHE19510
C DATA VECT/0.00000000, 0.00000000, 1.00000000, CHE19520
C $ 0.23807485, -0.08801514, -0.96725059, CHE19530
C $ -0.46055608, 0.17026540, 0.87114740, CHE19540
C $ 0.65287142, -0.24136347, -0.71798508, CHE19550
C $ -0.80242446, 0.29665251, 0.51779559, CHE19560
C $ 0.00000000, 0.00000000, 1.00000000, CHE19570
C $ -0.20401674, -0.15100817, -0.96725059, CHE19580
C $ 0.39467063, 0.29212549, 0.87114740, CHE19590
C $ -0.55947405, -0.41410893, -0.71798508, CHE19600
C $ 0.68763258, 0.50896872, 0.51779559, CHE19610
C $ -0.94978689, -0.28553486, -0.12796369, CHE19620
C $ 0.88757697, 0.26683266, 0.37550960, CHE19630
C $ -0.76723180, -0.23065324, -0.59846007, CHE19640
C $ 0.59663385, 0.17936630, 0.78221211, CHE19650
C $ -0.38695708, -0.11633108, -0.91473018, CHE19660
C $ 0.28119199, 0.95108168, -0.12796369, CHE19670
C $ -0.26277424, -0.88878695, 0.37550960, CHE19680
C $ 0.22714509, 0.76827772, -0.59846007, CHE19690
C $ -0.17663821, -0.59744720, 0.78221211, CHE19700
C $ 0.11456173, 0.38748460, -0.91473018/ CHE19710
C CHE19720
C Old "spherical" unit vectors (14 of them) CHE19730
C CHE19740
c 0.5773502691896258,0.5773502691896258, CHE19750
c $ 0.5773502691896258, CHE19760
c 1 -0.5773502691896258,-0.5773502691896258,0.5773502691896258, CHE19770
c 2 0.5773502691896258,-0.5773502691896258,-0.5773502691896258, CHE19780
c 3 -0.5773502691896258,0.5773502691896258,-0.5773502691896258, CHE19790
c 4 0.0000000000000000E+00,-1.000000000000000, CHE19800
c $ 0.0000000000000000E+00, CHE19810
c 5 0.0000000000000000E+00,0.0000000000000000E+00, CHE19820
c $ -1.000000000000000, CHE19830
c 6 -1.000000000000000,0.0000000000000000E+00, CHE19840
c $ 0.0000000000000000E+00, CHE19850
c 7 -0.5773502691896258,-0.5773502691896258,-0.5773502691896258, CHE19860
c 8 1.000000000000000,0.0000000000000000E+00, CHE19870
c $ 0.0000000000000000E+00, CHE19880
c 9 0.0000000000000000E+00,1.000000000000000, CHE19890
c $ 0.0000000000000000E+00, CHE19900
c $ 0.5773502691896258,0.5773502691896258,-0.5773502691896258, CHE19910
c $ 0.0000000000000000E+00,0.0000000000000000E+00, CHE19920
c $ 1.000000000000000, CHE19930
c $ -0.5773502691896258,0.5773502691896258,0.5773502691896258, CHE19940
c $ 0.5773502691896258,-0.5773502691896258,0.5773502691896258, CHE19950
CHE19960
IN = 5 CHE19970
IOUT = 6 CHE19980
C CHE19990
C CHECKPOINT FILE NAME CHE20000
C CHE20010
READ(IN,1000) CHKFIL CHE20020
1000 FORMAT(A40) CHE20030
C CHE20040
C INPUT INFORMATION CHE20050
C CHE20060
1010 FORMAT(20A4) CHE20070
DO 1921 I=1,3 CHE20080
NLIN= I CHE20090
READ (5,1010) LINE CHE20100
IF (LINE(1) .EQ. IBLNK) THEN CHE20110
NLIN=NLIN-1 CHE20120
GOTO 192 CHE20130
END IF CHE20140
DO 1922 J=1,20 CHE20150
L=20-J CHE20160
IF (LINE(L) .NE. IBLNK) THEN CHE20170
NEND(I) = L CHE20180
DO 1923 K=1,NEND(I) CHE20190
NTITLE(K,I) = LINE(K) CHE20200
1923 CONTINUE CHE20210
GOTO 1921 CHE20220
END IF CHE20230
1922 CONTINUE CHE20240
1921 CONTINUE CHE20250
NLIN=NLIN+1 CHE20260
192 CONTINUE CHE20270
C CHE20280
C CHE20290
C READ IN PRINT OPTIONS CHE20300
C CHE20310
3000 READ(IN,*) (IPO(I),I=1,NPO) CHE20320
C CHE20330
C READ IN # OF D FUNCTIONS CHE20340
C NOTE: IF THE BASIS SET USES 5 D FUNCTION, ND MUST BE CHE20350
C SET EQUAL TO 1 TO ACCOMODATE THE INTEGRAL PACKAGE. CHE20360
C IF THE BASIS SET USES 6 D FUNCTIONS, ND IS SET EQUAL TO CHE20370
C 0. CHE20380
C CHE20390
READ(IN,*) ND CHE20400
IF (ND .NE. 5 .AND. ND .NE. 6) THEN CHE20410
STOP '# OF D FUNCTIONS MUST BE 5 OR 6' CHE20420
END IF CHE20430
IF (ND .EQ. 5) THEN CHE20440
ND = 1 CHE20450
GOTO 15 CHE20460
END IF CHE20470
ND = 0 CHE20480
15 CONTINUE CHE20490
C CHE20500
C CHE20510
C INITIATE FILEIO CHE20520
C CHE20530
C*** Different Fopen statement for Trace-7 CHE20540
CALL FOPEN (IUNIT,5,CHKFIL,IALLOC,junk) CHE20550
c CALL FOPEN (IUNIT,'old',CHKFIL(1:linend(chkfil))//char(0)) CHE20560
C CHE20570
IWWRIT = IPO(1) CHE20580
C***********************************************************************CHE20590
C CHE20600
C READ IN COMMON /MOL/ CHE20610
C CHE20620
c NWORDS = 1804 CHE20630
c IFILENO = 30997 CHE20640
c CALL FILEIO (IREAD,IFILENO,NWORDS,NATOMS,IALLOC) CHE20650
IRwMol=997 CHE20660
MaxAtm=400 CHE20670
LenMol = 4*MaxAtm + InToWP(8+MaxAtm) CHE20680
Call FileIO(2,-FilNum(IRwMol,IUnit),LenMol,NAtoms,0) CHE20690
C CHE20700
C***********************************************************************CHE20710
C CHE20720
C READ IN SPHERE DATA (VAN DER WAALS RADII, # OF POINTS TO CHE20730
C FIT CHE20740
C CHE20750
C CHE20760
READ (IN,*)(VDWR(I),I=1,NATOMS) CHE20770
READ (IN,*)NPTS CHE20780
IF (NPTS .GT. MAXPTS) THEN CHE20790
STOP 'MAXIMUM NUMBER OF POINTS MUST BE LESS THAN 50000' CHE20800
END IF CHE20810
C CHE20820
C SET MAXIMUM VAN DER WAALS RADII TO 4 CHE20830
C CHE20840
VMAX=4. CHE20850
DO 20 I=1,NATOMS CHE20860
IF (VDWR(I) .GT. VMAX) THEN CHE20870
WRITE (IOUT, 2500) I CHE20880
2500 FORMAT (3X, 'THE VAN DER WAALS RADII OF ATOM', I3,CHE20890
1 'IS OUT OF RANGE') CHE20900
STOP CHE20910
END IF CHE20920
20 CONTINUE CHE20930
C CHE20940
READ (IN,*) VFACT CHE20950
DO 21 I=1,NATOMS CHE20960
VDWR(I)=VDWR(I)*VFACT CHE20970
21 CONTINUE CHE20980
C***********************************************************************CHE20990
C CHE21000
C READ IN BASIS SET INFORMATION (COMMON /B/) CHE21010
C CHE21020
IFILENO = 30506 CHE21030
CALL FILEIO (IFIND,IFILENO,NWORDS,EXX,0) CHE21040
CALL FILEIO (IREAD,-IFILENO,NWORDS,EXX,0) CHE21050
C***********************************************************************CHE21060
IF(IWWRIT .NE. 1) GOTO 170 CHE21070
WRITE(IOUT,8000)(C(1,I),C(2,I),C(3,I),I=1,NATOMS) CHE21080
8000 FORMAT(/1X,'COORDINATES'/(1X,3F12.6)) CHE21090
WRITE(IOUT,8020) NATOMS,ICHARG,MULTIP,NAE,NBE,NE,NBASIS CHE21100
$ ,NSHELL,MAXTYP CHE21110
8020 FORMAT(/1X,'NATOMS = ',I3 CHE21120
$/1X,'ICHARG = ',I3 CHE21130
$/1X,'MULTIP = ',I3 CHE21140
$/1X,'NAE = ',I3 CHE21150
$/1X,'NBE = ',I3 CHE21160
$/1X,'NE = ',I3 CHE21170
$/1X,'NBASIS = ',I3 CHE21180
$/1X,'NSHELL = ',I3 CHE21190
$/1X,'MAXTYP = ',I3) CHE21200
WRITE(IOUT,8030) (IAN(I),I=1,NATOMS) CHE21210
8030 FORMAT(/1X,'IAN'/(1X,20I3)) CHE21220
WRITE(IOUT,8050) (JAN(I),SHELLT(I),SHELLA(I),I=1,NSHELL) CHE21230
8050 FORMAT(/1X,'CENTER TYPE SHELLA'/(1X,3I7)) CHE21240
WRITE(IOUT,8055) SHELLA(NSHELL+1) CHE21250
8055 FORMAT(1X,14X,I7) CHE21260
WRITE(IOUT,8060) (EXX(I),C1(I),C2(I),I=1,NSHELL) CHE21270
8060 FORMAT(/1X,12X,'EXPON',8X,'EXPCOF(S)',8X,'EXPCOF(P)', CHE21280
$/(1X,3E17.9)) CHE21290
WRITE(IOUT,8070) (C3(I),CF(I),I=1,NSHELL) CHE21300
8070 FORMAT(/1X,12X,'EXPCOF(D)',8X,'EXPCOF(F)', CHE21310
$/(1X,2E17.9)) CHE21320
WRITE (IOUT,3575) CHE21330
3575 FORMAT(/,15X,'ATOM #',5X,'V.D.W. RADII (MULTIPLIED BY FACTOR)') CHE21340
DO 3500 I=1,NATOMS CHE21350
WRITE (IOUT,4000)I,VDWR(I) CHE21360
4000 FORMAT (15X,I5,20X,F5.2) CHE21370
3500 CONTINUE CHE21380
c WRITE (IOUT,4500)NPTS CHE21390
4500 FORMAT(/2X,'NUMBER OF POINTS TO FIT',I6) CHE21400
170 CONTINUE CHE21410
C***********************************************************************CHE21420
C CHE21430
C READ IN ALPHA MO COEFFICIENTS CHE21440
C CHE21450
IFILENO = 30524 CHE21460
CALL FILEIO (IFIND,-IFILENO,NWORDS,COEF_ALPHA,0) CHE21470
CALL FILEIO (IREAD,-IFILENO,NWORDS,COEF_ALPHA,0) CHE21480
C***********************************************************************CHE21490
C CHE21500
C READ IN THE BETA MO COEFFICIENTS CHE21510
C CHE21520
IFILENO = 30526 CHE21530
CALL FILEIO (IFIND,IFILENO,NWORDS,COEF_BETA,0) CHE21540
IF (NWORDS.EQ.0) THEN CHE21550
IUHF = 0 CHE21560
GOTO 300 CHE21570
END IF CHE21580
IUHF = 1 CHE21590
CALL FILEIO (IREAD,-IFILENO,NWORDS,COEF_BETA,0) CHE21600
C***********************************************************************CHE21610
300 CONTINUE CHE21620
C***********************************************************************CHE21630
RETURN CHE21640
END CHE21650
SUBROUTINE REDUC1(X,LAMAX,LBMAX,I6TO5) CHE21660
C CHE21670
C MODIFIED FOR POLARIZATION POTENTIAL CALCULATIONS CHE21680
C M.M. FRANCL FEBRUARY 1984 CHE21690
C CHE21700
IMPLICIT REAL*8 (A-H,O-Z) CHE21710
C CHE21720
DIMENSION X(100),S(100),IND5(9),IND6(10) CHE21730
C CHE21740
DATA PT5/0.5/ CHE21750
DATA R3OV2/0.8660254040/ CHE21760
DATA IND5/1, CHE21770
$ 4,7,2, CHE21780
$ 3,6,9,5,8/ CHE21790
DATA IND6/1, CHE21800
$ 4,7,2, CHE21810
$ 6,10,3,9,5,8/ CHE21820
C CHE21830
C ******************************************************************CHE21840
C ROUTINE REORDERS FROM ARRANGEMENT: S,Z,ZZ,X,XZ,XX,Y,YZ,XY,YY CHE21850
C TO S,X,Y,Z,XX,YY,ZZ,XY,XZ,YZ CHE21860
C OR FROM S,Z,X,Y TO S,X,Y,Z CHE21870
C THIS ENSURES LABELING COMPATIBILITY BETWEEN THE SP AND D PACKAGES CHE21880
C AT THE SAME TIME THE INTEGRALS ARE MOVED TO THE FIRST 1,4,10,16, CHE21890
C 40 OR 100 LOCATIONS, DEPENDING ON THE SHELL QUANTUM NUMBERS CHE21900
C ******************************************************************CHE21910
NWORD=LAMAX*LBMAX CHE21920
IF(NWORD-1)5,180,5 CHE21930
5 INTC=0 CHE21940
IF(I6TO5 .EQ. 1) GOTO 40 CHE21950
10 DO 20 I=1,LBMAX CHE21960
ISB=10*(IND6(I)-1) CHE21970
DO 20 J=1,LAMAX CHE21980
ISA=ISB+IND6(J) CHE21990
INTC=INTC+1 CHE22000
20 S(INTC)=X(ISA) CHE22010
GO TO 160 CHE22020
C ******************************************************************CHE22030
C ROUTINE TO REDUCE SIX D FUNCTIONS TO FIVE CHE22040
C ALSO REORDERS FROM : S,Z,ZZ,X,XZ,XX,Y,YZ,YX,YY CHE22050
C TO S,X,Y,Z,ZZ,XX-YY,XY,XZ,YZ CHE22060
C OR FROM S,Z,X,Y TO S,X,Y,Z CHE22070
C FOR COMPATIBILITY WITH SP PACKAGE CHE22080
C ******************************************************************CHE22090
40 DO 150 I=1,LBMAX CHE22100
ISB=10*(IND5(I)-1) CHE22110
C IFB=0 FOR S,X,Y,Z,XY,XZ,YZ, IFB=1 FOR ZZ-RR, IFB=2 FOR XX-YY CHE22120
IFB = 0 CHE22130
IF(I .EQ. 5) IFB = 1 CHE22140
IF(I .EQ. 6) IFB = 2 CHE22150
80 DO 150 J=1,LAMAX CHE22160
ISA=ISB+IND5(J) CHE22170
IFA = 0 CHE22180
IF(J .EQ. 5) IFA = 1 CHE22190
IF(J .EQ. 6) IFA = 2 CHE22200
120 IHOP = 3*IFB + IFA + 1 CHE22210
GOTO(130,122,123,124,125,126,127,128,129),IHOP CHE22220
C CHE22230
C ******************************************************************CHE22240
C * (F,O,ZA2) *CHE22250
C ******************************************************************CHE22260
122 XX=ZZ1(X,ISA,3,7) CHE22270
GO TO 140 CHE22280
C CHE22290
C ******************************************************************CHE22300
C * (F,O,XA2-YA2) *CHE22310
C ******************************************************************CHE22320
123 XX=XY1(X,ISA,4) CHE22330
GO TO 140 CHE22340
C CHE22350
C ******************************************************************CHE22360
C * (ZB2,O,F) *CHE22370
C ******************************************************************CHE22380
124 XX=ZZ1(X,ISA,30,70) CHE22390
GO TO 140 CHE22400
C CHE22410
C ******************************************************************CHE22420
C * (ZB2,O,ZA2) *CHE22430
C ******************************************************************CHE22440
125 XX=ZZ1(X,ISA,30,70)-PT5*(ZZ1(X,ISA+3,30,70)+ZZ1(X,ISA+7,30,70)) CHE22450
GO TO 140 CHE22460
C CHE22470
C ******************************************************************CHE22480
C * (ZB2,O,XA2-YA2) *CHE22490
C ******************************************************************CHE22500
126 XX=R3OV2*(ZZ1(X,ISA,30,70)-ZZ1(X,ISA+4,30,70)) CHE22510
GO TO 140 CHE22520
C CHE22530
C ******************************************************************CHE22540
C * (XB2-YB2,O,F) *CHE22550
C ******************************************************************CHE22560
127 XX=XY1(X,ISA,40) CHE22570
GO TO 140 CHE22580
C CHE22590
C ******************************************************************CHE22600
C * (XB2-YB2,O,ZA2) *CHE22610
C ******************************************************************CHE22620
128 XX=R3OV2*(ZZ1(X,ISA,3,7)-ZZ1(X,ISA+40,3,7)) CHE22630
GO TO 140 CHE22640
C CHE22650
C ******************************************************************CHE22660
C * (XB2-YB2,O,XA2-YA2) *CHE22670
C ******************************************************************CHE22680
129 XX=R3OV2*(XY1(X,ISA,4)-XY1(X,ISA+40,4)) CHE22690
GO TO 140 CHE22700
C CHE22710
C ******************************************************************CHE22720
C * (F,O,F) *CHE22730
C ******************************************************************CHE22740
130 XX=X(ISA) CHE22750
140 INTC=INTC+1 CHE22760
150 S(INTC)=XX CHE22770
160 DO 170 I=1,NWORD CHE22780
170 X(I)=S(I) CHE22790
180 RETURN CHE22800
END CHE22810
SUBROUTINE STAR(NBASIS,SHELLT,SHELLC,AOS,NSHELL,NOSTAR) CHE22820
C CHE22830
C ROUTINE TO MODIFY COMMON /B/ TO THE EXPECTED FORMAT FOR INTGRL CHE22840
C FOR BASIS SETS HAVING P ONLY SHELLS, SUCH AS THE 6-31G** BASIS CHE22850
C CHE22860
IMPLICIT REAL*8 (A-H,O-Z) CHE22870
INTEGER*4 SHELLC,SHELLT,AOS CHE22880
C CHE22890
DIMENSION SHELLC(2000),SHELLT(2000),AOS(2000) CHE22900
C CHE22910
C LOOP OVER SHELLS CHE22920
C CHE22930
DO 100 I=1,NSHELL CHE22940
IF (SHELLT(I).EQ.1 .AND. SHELLC(I).EQ.1) THEN CHE22950
NBASIS = NBASIS + 1 CHE22960
NOSTAR = 1 CHE22970
DO 200 J=I,NSHELL CHE22980
AOS(J) = AOS(J) + 1 CHE22990
200 CONTINUE CHE23000
END IF CHE23010
100 CONTINUE CHE23020
RETURN CHE23030
END CHE23040
SUBROUTINE UEP CHE23050
C CHE23060
C ROUTINE TO CALCULATE THE ELECTROSTATIC POTENTIAL FROM FIRST ORDCHE23070
C PERTURBATION THEORY CHE23080
C CHE23090
C M.M. FRANCL JULY 1985 CHE23100
C MODIFIED VERSION OF A MEPHISTO ROUTINE CHE23110
C RESTRICTED TO UNRESTRICTED HARTREE-FOCK WAVEFUNCTIONS CHE23120
C CHE23130
IMPLICIT REAL*8 (A-H,O-Z) CHE23140
PARAMETER (NPOINTS = 50000) CHE23150
INTEGER*4 SHELLA,SHELLN,SHELLT,AOS,SHELLC,AON,HANDLE CHE23160
CHARACTER*40 CHKFIL CHE23170
C CHE23180
COMMON /IO/ IN,IOUT CHE23190
COMMON /IPO/ IPO(5) CHE23200
C+++ CHE23210
COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS, CHE23220
$ IAN(401),ATMCHG(400),C(3,400) CHE23230
C CHE23240
C=== Gaussian88 Modification for enlarged common /b/. CHE23250
Common/BB/EXX(6000),C1(6000),C2(6000),C3(6000),X(2000),Y(2000), CHE23260
$Z(2000),JAN(2000),ShellA(2000),ShellN(2000),ShellT(2000), CHE23270
$ShellC(2000),AOS(2000),AON(2000),NShell,MaxTyp CHE23280
C CHE23290
C=== Old G86 Common /b/ CHE23300
c COMMON/B/EXX(1200),C1(1200),C2(1200),C3(1200), CHE23310
c $ X(400),Y(400),Z(400),JAN(400),SHELLA(400),SHELLN(400), CHE23320
c $ SHELLT(400),SHELLC(400),AOS(400),AON(400),NSHELL,MAXTYP CHE23330
C+++ CHE23340
C COMMON /B/ EXX(240),C1(240),C2(240),C3(240),X(80),Y(80),Z(80), CHE23350
C $ JAN(80),SHELLA(80),SHELLN(80),SHELLT(80),SHELLC(80) CHE23360
C $ ,AOS(80),AON(80),NSHELL,MAXTYP CHE23370
C COMMON /MOL/ NATOMS,ICHARG,MULTIP,NAE,NBE,NEL,NBASIS,IAN(101), CHE23380
C $ ATMCHG(100),C(3,100) CHE23390
COMMON /POINTS/ P(3,NPOINTS),MAXPNTS CHE23400
COMMON /ELP/ ELECP(NPOINTS) CHE23410
COMMON /CHARGE/ COEF_ALPHA(100000),COEF_BETA(100000),IUHF CHE23420
COMMON /OUT/ Q(400),RMS,PERCENT,NTITLE(20,3),I6TO5,NLIN,NEND(3), CHE23430
1 CHKFIL CHE23440
C CHE23450
DIMENSION HPERT(100000),INDEX(1280) CHE23460
C CHE23470
DATA IPTCHG/1.0/ CHE23480
DATA ZERO/0.0/, TWO/2.0/, VNUCMAX/30.0/ CHE23490
C CHE23500
C INTIALIZE TIMING CHE23510
C CHE23520
HANDLE = 0 CHE23530
C CHE23540
C SET UP THE INDEXING TABLE FOR HPERT CHE23550
C CHE23560
DO 100 I=1,NBASIS CHE23570
INDEX(I) = (I-1)*I/2 CHE23580
100 CONTINUE CHE23590
C CHE23600
C BEGIN LOOP TO CALCULATE ELECTROSTATIC POTENTIAL CHE23610
C CHE23620
DO 200 NPNT=1,MAXPNTS CHE23630
X1 = P(1,NPNT) CHE23640
X2 = P(2,NPNT) CHE23650
X3 = P(3,NPNT) CHE23660
C CHE23670
C CALCULATE THE ONE-ELECTRON INTEGRALS CHE23680
C CHE23690
IF (IPO(5).EQ.1) THEN CHE23700
WRITE(IOUT,3010) CHE23710
3010 FORMAT(1X,'TIME FOR INTEGRALS') CHE23720
C*** CHE23730
C ISTAT = LIB$INIT_TIMER(HANDLE) CHE23740
C*** CHE23750
END IF CHE23760
C CHE23770
CALL INTGRL (HPERT,X1,X2,X3,IPTCHG,I6TO5) CHE23780
C CHE23790
C*** CHE23800
C IF (IPO(5).EQ.1) ISTAT = LIB$SHOW_TIMER(HANDLE) CHE23810
C*** CHE23820
C CHE23830
IF (IPO(4).EQ.1) CALL LINOUT (HPERT,NBASIS,0,0) CHE23840
C CHE23850
IF (IPO(5).EQ.1) THEN CHE23860
WRITE(IOUT,3000) CHE23870
3000 FORMAT(1X,'TIME FOR TRANSFORM') CHE23880
C*** CHE23890
C ISTAT = LIB$INIT_TIMER(HANDLE) CHE23900
C*** CHE23910
END IF CHE23920
C CHE23930
C FORM THE HPERT MATRIX ELEMENTS CHE23940
C CHE23950
C ALPHA CODE CHE23960
C CHE23970
E = ZERO CHE23980
ICOEFI = -NBASIS CHE23990
C CHE24000
C SUM OVER OCCUPIED ALPHA MOS CHE24010
C CHE24020
DO 220 II=1,NAE CHE24030
ICOEFI = ICOEFI + NBASIS CHE24040
C CHE24050
C CALCULATE ELECTROSTATIC POTENTIAL CHE24060
C CHE24070
DO 221 IP=1,NBASIS CHE24080
CPI = COEF_ALPHA(ICOEFI+IP) CHE24090
IPDEX = INDEX(IP) CHE24100
C CHE24110
DO 222 IQ=1,IP CHE24120
E = E + CPI * COEF_ALPHA(ICOEFI+IQ) * HPERT(IPDEX+IQ) CHE24130
222 CONTINUE CHE24140
DO 223 IQ=IP+1,NBASIS CHE24150
E = E + CPI * COEF_ALPHA(ICOEFI+IQ) * HPERT(IP+INDEX(IQ)) CHE24160
223 CONTINUE CHE24170
C CHE24180
221 CONTINUE CHE24190
220 CONTINUE CHE24200
C CHE24210
C BETA CODE CHE24220
C CHE24230
ICOEFI = -NBASIS CHE24240
C CHE24250
C SUM OVER OCCUPIED BETA MOS CHE24260
C CHE24270
DO 420 II=1,NBE CHE24280
ICOEFI = ICOEFI + NBASIS CHE24290
C CHE24300
C CALCULATE ELECTROSTATIC POTENTIAL CHE24310
C CHE24320
DO 421 IP=1,NBASIS CHE24330
CPI = COEF_BETA(ICOEFI+IP) CHE24340
IPDEX = INDEX(IP) CHE24350
C CHE24360
DO 422 IQ=1,IP CHE24370
E = E + CPI * COEF_BETA(ICOEFI+IQ) * HPERT(IPDEX+IQ) CHE24380
422 CONTINUE CHE24390
DO 423 IQ=IP+1,NBASIS CHE24400
E = E + CPI * COEF_BETA(ICOEFI+IQ) * HPERT(IP+INDEX(IQ)) CHE24410
E = E + CPI * COEF_* HPERT(IP+INDEX(IQ)) CHE24420
423 CONTINUE CHE24430
C CHE24440
421 CONTINUE CHE24450
420 CONTINUE CHE24460
C CHE24470
C*** CHE24480
C IF (IPO(5) .EQ. 1) ISTAT = LIB$SHOW_TIMER(HANDLE) CHE24490
C*** CHE24500
C CHE24510
C CALCULATE NUCLEAR PART OF ELECTROSTATIC POTENTIAL CHE24520
C CHE24530
VNUC = ZERO CHE24540
DO 300 IATOM=1,NATOMS CHE24550
DEL1 = C(1,IATOM) - X1 CHE24560
DEL2 = C(2,IATOM) - X2 CHE24570
DEL3 = C(3,IATOM) - X3 CHE24580
RA = DSQRT(DEL1*DEL1 + DEL2*DEL2 + DEL3*DEL3) CHE24590
IF (RA.EQ.ZERO) THEN CHE24600
VNUC=VNUCMAX CHE24610
GOTO 310 CHE24620
END IF CHE24630
VNUC = VNUC + IAN(IATOM) / RA CHE24640
300 CONTINUE CHE24650
310 CONTINUE CHE24660
C CHE24670
ELECP(NPNT) = (E + VNUC * IPTCHG) CHE24680
IF (IPO(5) .EQ. 1) WRITE(IOUT,*) 'E(',NPNT,') = ',E CHE24690
200 CONTINUE CHE24700
RETURN CHE24710
END CHE24720
SUBROUTINE UNSTAR(NBASIS,SHELLT,SHELLC,AOS,NSHELL,H,NOSTAR) CHE24730
C CHE24740
C ROUTINE TO REFORMAT COMMON/B/ AND THE H ARRAY FOR BASIS CHE24750
C SETS HAVING P ONLY SHELLS CHE24760
C CHE24770
IMPLICIT REAL*8 (A-H,O-Z) CHE24780
INTEGER*4 SHELLC,SHELLT,AOS CHE24790
C CHE24800
DIMENSION SHELLC(2000),SHELLT(2000),AOS(2000),H(1) CHE24810
C CHE24820
IF (NOSTAR.EQ.0) RETURN CHE24830
C CHE24840
C LOOP OVER SHELLS CHE24850
C CHE24860
DO 100 I=1,NSHELL CHE24870
IF (SHELLT(I).EQ.1 .AND. SHELLC(I).EQ.1) THEN CHE24880
C CHE24890
C REMOVE EXTRA ROWS AND COLUMNS CHE24900
C CHE24910
C LOOP OVER ROWS CHE24920
C CHE24930
IBASIS = AOS(I) CHE24940
ITEM = (IBASIS-1) * IBASIS / 2 CHE24950
DO 200 J=IBASIS+1,NBASIS CHE24960
C CHE24970
C LOOP OVER COLUMNS CHE24980
C CHE24990
NEWITEM = (J-1) * J /2 CHE25000
DO 250 K=1,IBASIS-1 CHE25010
ITEM = ITEM + 1 CHE25020
NEWITEM = NEWITEM + 1 CHE25030
H(ITEM) = H(NEWITEM) CHE25040
250 CONTINUE CHE25050
C CHE25060
C SKIP THE VALUE IN THE IBASIS TH COLUMN CHE25070
C CHE25080
NEWITEM = NEWITEM + 1 CHE25090
C CHE25100
DO 260 K=IBASIS+1,J CHE25110
ITEM = ITEM + 1 CHE25120
NEWITEM = NEWITEM + 1 CHE25130
H(ITEM) = H(NEWITEM) CHE25140
260 CONTINUE CHE25150
200 CONTINUE CHE25160
NBASIS = NBASIS - 1 CHE25170
C CHE25180
C RESTRUCTURE AOS TO ACCOUNT FOR THE S SHELL REMOVED CHE25190
C CHE25200
DO 300 IAOS = I,NSHELL CHE25210
AOS(IAOS) = AOS(IAOS) - 1 CHE25220
300 CONTINUE CHE25230
C CHE25240
END IF CHE25250
100 CONTINUE CHE25260
RETURN CHE25270
END CHE25280
FUNCTION XY1(X,I,IY) CHE25290
C CHE25300
DIMENSION X(100) CHE25310
C CHE25320
DATA HALFR3/0.8660254040/ CHE25330
C CHE25340
XY1=HALFR3*(X(I)-X(I+IY)) CHE25350
RETURN CHE25360
END CHE25370
FUNCTION ZZ1(X,I,IX,IY) CHE25380
C CHE25390
DIMENSION X(100) CHE25400
C CHE25410
DATA HALF/0.5/ CHE25420
C CHE25430
ZZ1=X(I)-HALF*(X(I+IX)+X(I+IY)) CHE25440
RETURN CHE25450
END CHE25460
|
[ CCL Home Page ]
[ chelpg ]
[ Raw Version of this page ]
| Modified: Mon Apr 20 16:00:00 1992 GMT |
| Page accessed 1964 times since Sat Apr 17 21:34:27 1999 GMT |