Library Routines

The call arguments for all of the subroutines in the acesii utilities library are included below. All of the auxilliary symmetry routines performing functions such as transposition, antisymmetrization and permutation of symmetry-packed lists are included in this set of subroutines. Along with the SUBROUTINE statement for each routine, an appropriately detailed description of the routine is given along with the definition of the variables which must be passed in the CALL statement. This documentation should be sufficiently detailed to allow anyone to easily call these routines. If anyone finds errors in this documentation, or finds it unsatisfactory in any regard, please contact one of the authors listed on the title sheet.

In addition to the routines listed on the following pages, the acesii program system makes extensive use of Cray SCILIB and Blas subroutines. The call arguments for these routines are not included here, but can be found in documents available from Cray Research (SCILIB) and most computer vendors (Blas). Fortran equivalents for these routines have either been taken from the standard Unix distribution, or written by the authors of acesii. For the Blas routines, the standard distribution contains two routines of each type for performing floating point arithmetic. Generally, those which begin with an "S" are associated with single-precision arithmetic, while those starting with a "D" are the corresponding double-precision equivlanents (many routines using complex numbers also exist and begin with a "C", but no complex arithmetic is presently performed in acesii). In acesii, however, the "S" names are used for 64-bit floating point arithmetic on all machines. This means that the "S" routines used by acesii on unix boxes and other machines with 32-bit arithmetic are actually the double precision routines. Since acesii is written primarily for Crays, this convention has been followed since the "S" calls are appropriate for these machines and machine dependent "S" versus "D" calls represents an alternative which the authors find unpalatable.

      SUBROUTINE AMPSUM(ICORE,MAXCOR,IUHF,NLIST,SING1,TYPE)
C
C THIS ROUTINE DRIVES A NUMBER OF ROUTINES WHICH DETERMINE AND PRINT
C  OUT THE LARGEST T2 AMPLITUDES.  ALL THREE SPIN CASES DONE FOR UHF,
C  AB ONLY FOR RHF.
C
 
      SUBROUTINE ANTSYM(X,NA,ISWTCH)
C
C THIS ROUTINE ANTISYMMETRIZES THE LOWER TRIANGLE OF A SQUARE MATRIX X (
C  INCLUDING THE DIAGONAL) AND RETURNS THE RESULT IN PACKED TRIANGULAR F
C
C IF ISWTCH IS SET TO A NON-ZERO VALUE, IT RETURNS THE VALUES OF THE
C  UPPER TRIANGULAR ELEMENTS OF THE ANTISYMMETRIZED MATRIX.
C
      SUBROUTINE AO2MO2(ZAO,ZMO,EVEC,SCR,NBAS,NBAST,ISPIN)
C
C TRANSFORMS A TWO-INDEX QUANTITY (I.E. FOCK MATRIX) FROM THE AO
C  TO THE MO BASIS
C
C INPUT:
C       ZAO  - TWO-INDEX QUANTITY IN AO BASIS (LENGTH: NBAST*NBAST)
C       NBAST- NUMBER OF BASIS FUNCTIONS 
C       NBAS - NUMBER OF BASIS FUNCTIONS AFTER TRANSFORMATION
C       ISPIN- 1 FOR ALPHA, 2 FOR BETA
C
C OUTPUT:
C       ZMO  - TWO-INDEX QUANTITY IN MO BASIS (LENGTH: NBAS*NBAS)
C       
C SCRATCH:
C       EVEC - HOLDS EIGENVECTOR MATRIX (LENGTH: NBAS*NBAST)
C       SCR  - HOLDS INTERMEDIATE QUANTITIES (LENGTH: 2*NBAST*NBAST) 
C
      SUBROUTINE ASSYM(IRREP,NUM,DSZA,DSZB,A,B)
C
C     THIS ROUTINE ANTISYMMETRIZES AN SYMMETRY
C     PACKED ARRAY
C
C     A(AB,IJ) = B(AB,IJ) - B(AB,JI) FOR A<B
C
C     B IS AN ARRAY WITH I,J WHILE A IS AN ARRAY 
C     WITH I<J
C
C     INPUT : IRREP = IRREP OF (A,B) BLOCK
C             NUM = POPULATION IN EACH IRREP FOR I AND J
C             DSZA = DISTRIBUTION SIZE IN OUTPUT ARRAY
C             DSZB = DISTRIBUTION SIZE IN INPUT ARRAY
C             B = INPUT ARRAY WITh ELEMENTS TO BE ANTISYMMTRIZED
C     OUTPUT : A = ANTISYMMETRIZED OUTPUT ARRAY
C
      SUBROUTINE ASSYM2(IRREP,NUM,DSZ,A)
C
C     THIS ROUTINE ANTISYMMETRIZES AN SYMMETRY
C     PACKED ARRAY IN PLACE
C
C     A(AB,IJ) = A(AB,IJ) - A(AB,JI) FOR ALL AB
C
C
C     INPUT : IRREP = IRREP OF (A,B) BLOCK
C             NUM = POPULATION IN EACH IRREP FOR I AND J
C             DSZ = DISTRIBUTION SIZE OF A
C             A   = INPUT MATRIX
C     OUTPUT : A  = ANTISYMMETRIZED OUTPUT MATRIX
C
      SUBROUTINE BLKCPY(MATFRM,NROWFRM,NCOLFRM,MATTAR,NROWTAR,NCOLTAR,
     &                  IROWTAR,ICOLTAR)
C
C THIS ROUTINE COPIES AN NROWFRM BY NCOLFRM BLOCK MATRIX (MATFRM)
C  INTO AN NROWTAR BY NCOLTAR TARGET MATRIX (MATTAR) SUCH THAT 
C  THE (1,1) ELEMENT IN MATFRM BECOMES THE IROWTAR,ICOLTAR ELEMENT 
C  IN MATTAR.
C
      SUBROUTINE BLKCPY2(MATFRM,NROWFRM,NCOLFRM,MATTAR,NROWTAR,NCOLTAR,
     &                  IROWFRM,ICOLFRM)
C
C THIS ROUTINE COPIES AN NROWTAR BY NCOLTAR BLOCK SUBMATRIX 
C  INTO AN NROWTAR BY NCOLTAR TARGET MATRIX (MATTAR) SUCH THAT 
C  THE IROWFRM,ICOLFRM ELEMENT IN MATFRM BECOMES THE (1,1) ELEMENT 
C  IN MATTAR.
C
C THE PHYSICAL DIMENSION OF MATFRM IS (NROWFRM,NCOLFRM)
C THE PHYSICAL DIMENSION OF MATTAR IS THE SAME AS THE SUBMATRIX SIZE
C
      SUBROUTINE CHECKIN
C
C INITIALIZES TIMING INFORMATION FOR PROGRAM
C

      SUBROUTINE CHECKOUT
C
C DETERMINES TOTAL EXECUTION TIME FOR PROGRAM
C

      
      SUBROUTINE CHKSUM(V,LEN)
C
C SUMS THE FIRST LEN ELEMENTS OF VECTOR V AND WRITES IT TO STANDARD OUTPUT.
C
      SUBROUTINE CIDENOM(N,ECORR,VEC)
C
C THIS ROUTIONE CONVERTS FROM THE MBPT/CC DENOMINATOR
C
C     1/(Fii + Fjj - Faa - Fbb) 
C
C TO THE CI DENOMINATOR
C
C     1/(Fii + Fjj - Faa - Fbb + Ecorr)
C
      SUBROUTINE CLMOIO(ICORE,MAXCOR,NOCCO,NVRTO,IUHF)
C
C THIS ROUTINE CALCULATES THE ADDRESSES OF THE VARIOUS LISTS
C  IN THE MOINTS FILE.  
C
C THIS ROUTINE IS CALLED IN INTPRC TO INITIALIZE THE MOINTS FILE
C AND TO CREATE ALL THE INTEGRAL AND AMPLITUDE LISTS ON MOINTS
C (AT LEAST THE STANDARD LISTS)
C

      SUBROUTINE CLOSMO(IUNIT)
C
C  THIS ROUTINE CLOSES THE FILE WITH THE UNIT NUMBER IUNIT
C
      SUBROUTINE CMPENG(ICORE,MAXCOR,NLIST2,NLIST1,ECORR,ETOT,ETOTT2,
     &                  IUHF,IPRINT)
C
C  DRIVER FOR THE  CALCULATION OF THE CORRELATION ENERGY FOR A GIVEN SET
C  OF AMPLITUDES
C 
C  ARGUMENTS :  ICORE ..... ICORE ARRAY
C               MAXCOR .... DIMENSION OF ICORE
C               NLIST2 .... OFFSET OF T2 LIST ON MOINTS (WITH RESPECT TO
C                            TYPE)
C               NLIST1 .... OFFSET OF T1 LISTS ON MOINTS (WITH RESPECT TO
C                            SPIN TYPE)
C               ECORR ..... RETURNS THE CORRELATION ENERGY FOR ALL SPIN CASES
C               ETOT .....  RETURNS TOTAL CORRELATION ENERGY
C               ETOTT2 ...  RETURNS LINEAR CONTRIBUTION TO 
C                            THE CORRELATION ENERGY
C               IUHF .....  IUHF FLAG
C               IPRINT ...  PRINT FLAG
C
      SUBROUTINE CRAPSI(ICORE,IUHF,IENTRY)
C
C VERY IMPORTANT ROUTINE.  INITIALIZES ENVIRONMENT FOR A CRAPS MODULE.
C  THIS MUST BE CALLED IN THE FIRST EXECUTABLE STATEMENT IN ALL PROGRAMS.
C
      SUBROUTINE CRAPSO
C
C THIS ROUTINE WRITES OUT INFORMATION WHICH ALLOWS LATER MODULES TO
C  RUN SUCCESSFULLY.  THIS MUST BE CALLED BY THE LAST EXECUTABLE STATEMENT
C  IN ALL PROGRAMS.
C
      SUBROUTINE DOT24(IRREP,Z,Z1,W,BUF,DISSIZ,POPP,POPQ,
     &                 POP1,POP2,POP3,POP4,TYPE)
C
C THIS ROUTINE PERFORMS UNCOMPLICATED BUT MESSY CONTRACTIONS OF
C  THE GENERIC FORM
C
C      Z(P,Q) = Z1(M,N) * I(MP,NQ)  [TYPE='STST']
C      
C      Z(P,Q) = Z1(M,N) * I(PM,NQ)  [TYPE='TSST']
C
C      Z(P,Q) = Z1(M,N) * I(PM,QN)  [TYPE='TSTS']
C
C      Z(P,Q) = Z1(M,N) * I(MP,QN)  [TYPE='STTS']
C
C WHERE I IS ASSUMED TO BE ONE IRREP OF A SYMMETRY PACKED 
C  [GAMMA(MP)=GAMMA(NQ)] FOUR-INDEX QUANTITY AND Z1 AND Z
C  ARE TWO INDEX ARRAYS WHICH ARE SYMMETRY PACKED IN THE USUAL
C  MANNER.  THIS ROUTINE SHOULD BE USED FOR THESE CASES SINCE
C  THEY HAVE ONLY AN N**4 COMPUTATIONAL DEPENDENCE AND ALTERNATIVES
C  SUCH AS FANCYGET/FANCYPUT CALLS CANNOT BE JUSTIFIED.
C
C INPUT:
C       IRREP - THE IRREDUCIBLE REPRESENTATION TO WHICH THE FOUR-INDEX
C               LIST BELONGS.
C       Z     - THE TARGET VECTOR 
C       Z1    - THE TWO-INDEX QUANTITY WHICH WILL BE CONTRACTED WITH
C               THE FOUR-INDEX LIST.
C       W     - THE FOUR-INDEX QUANTITY
C       BUF   - A SCRATCH ARRAY WHICH HAS THE SAME LENGTH AS Z1.
C       DISSIZ- THE DISTRIBUTION SIZE OF THE FOUR-INDEX QUANTITY
C       POPP  - POPULATION VECTOR FOR P.
C       POPQ  - POPULATION VECTOR FOR Q.
C       POP1  - POPULATION VECTOR FOR FASTEST INDEX IN W.
C       POP2  - POPULATION VECTOR FOR SECOND FASTEST INDEX IN W.
C       POP3  - POPULATION VECTOR FOR THIRD FASTEST INDEX IN W.
C       POP4  - POPULATION VECTOR FOR SLOWEST INDEX IN W.
C       TYPE  - SPECIFIES THE ORDERING OF THE FOUR-INDEX INDICES
C               ON INPUT (CHARACTER*4).
C
      SUBROUTINE DRMOVE(ICORE,MAXCOR,IUHF,NLIST,SING1)
C
C DRIVER FOR CALLS WHICH MOVE THE T AMPLITUDE INCREMENT LISTS (LIST 61 - 63
C AND 90-91) INTO THE REFERENCE T AMPLITUDE LIST AREA (LIST 44+NLIST - 46+
C NLIST AND 90+NLIST 91+NLIST)
C
C NLIST = 0   USUAL REFERENCE LIST    NLIST=100   LAMBDA REFERENCE LIST
C
C SING1 = TRUE, SINGLES SHOULD BE MOVED AS WELL
C SING1 = FALSE, NO SINGLES 
C
      SUBROUTINE DRRLE(ICORE,MAXCOR,IUHF,RLECYC,LAMBDA)
C
C DRIVER FOR RLE EXTRAPOLATION ROUTINES.
C

      SUBROUTINE DRTSTS(ICORE,MAXCOR,ICYCLE,IUHF,ICONVG,
     &                  ICONTL,SING1,NLIST,TYPE)
C
C DRIVER FOR ROUTINE WHICH LOOKS AT OLD AND NEW T VECTORS,
C   AND RETURNS STATISTICS ON THEM.
C
      SUBROUTINE DSYMRHF(IRREPL,IRREPR,NUML,NUMR,DISSIZE,A,
     &                  SCR,ISCRL,ISCRR)
C
C  THIS ROUTINE FORMS THE TERM 
C
C   A(I,J,K,L) --> A(I,J,K,L) + A(J,I,L,K)  
C
C  WHICH IS REQUIRED IN RHF CCSD CALCULATIONS
C
C  INPUT :  IRREPR  ...   IRREP OF K,L   
C           IRREPL  .... IRREP OF I,J
C           NUMR   ....  POPULATION VECTOR FOR K,L
C           NUML   ....  POPULATION VECTOR FOR I,J
C           DISSIZE ...  DISTRIBUTION SIZE OF A
C           A      ....  HOLDS THE MATRIX A         
C           SCR,ISCRL,ISCRR ... THREE SCRATCH ARRAYS OF SIZE DISSIZE
C
C  OUTPUT :  A     ....  THE RHF SYMMETRIZED MATRIX
C
      SUBROUTINE DUMP(ZLIST,FILE,RECNUM,IWRDOFF,NWORDS)
C
C THIS ROUTINE IS A DEPENDENT OF PUTLST AND PERFORMS THE
C  REQUIRED LOGIC TO WRITE A DIRECT ACCESS RECORD.  IT IS
C  EITHER WRITTEN TO THE CACHE AREA OR TO DISK.
C
      SUBROUTINE DUMPJA(IENTRY)
C
C THIS ROUTINE SERVES AS AN INTERFACE BETWEEN THE GETREC/PUTREC I/O
C  TO THE JOBARC FILE AND THE DIFFERENT PROGRAMS IN THE PROGRAM SYSTEM.
C  IT IS A DEPENDENT OF BOTH CRAPSI AND CRAPSO AND SHOULD NEVER NEED
C  TO BE CALLED EXPLICITLY.
c
c  Now opens or initializes JOBARC, so GET/PUTREC do not have to.
C
C INPUT:
C        IENTRY - 'I' FOR INITIATION OF PROGRAM (READS IN WORD ADDRESSES
C                         AND LABELS FROM JASMRY)
C
C                 'O' FOR EXIT FROM PROGRAM (DUMPS WORD ADDRESS AND LABELS
C                         TO JASMRY)
C
      SUBROUTINE EIG(A,B,L,N,N1)
C
C Shell to drive Householder algorithm.
C A - MATRIX TO BE DIAGONALIZED (EIGENVALUES IN DIAGS AFTERWARDS)
C B - EIGENVECTORS RETURNED IN COLUMNS
C L - DIMENSION OF MATRIX
C N - SIZE OF SUBMATRIX USED
C N1 - A FLAG INDICATING WHETHER THE EIGENVECTORS AND
C      EIGENVALUES ARE TO BE REORDERED.
C 
      SUBROUTINE ENDSEQ(IUNIT)
C
C POSITIONS POINTER AT END OF SEQUENTIAL FILE.  IUNIT IS THE UNIT NUMBER.
C
      SUBROUTINE ERREX
C
C EXIT HANDLER FOR CRAPS.  THIS ROUTINE IS INCLUDED SO THAT ALL
C  ERROR EXITS WILL GO THROUGH THE SAME END POINT, WHICH MAY
C  BE USEFUL LATER.
C
      SUBROUTINE EXPND2(WPACK,WFULL,NDIM)
C
C  This routine expands a triangularly packed vector of numbers
C  into a square matrix.
C
C   WPACK((NDIM*(NDIM+1))/2) ==> WFULL(NDIM,NDIM)
C
      SUBROUTINE EXPND3(WPACK,WFULL,NDIM)
C
C THIS ROUTINE EXPANDS A COMPRESSED ARRAY TO 
C  A FULL ANTISYMMETRIC ARRAY
C
      SUBROUTINE EXTRAP(Z,ETOT,ET2,TAU,ERLE,IORDER,SINGLE,RLETYP)
C
C FORMS THE QUANTITY:
C
C         E = SUM  [E(1) + TAU(i) * [E(i)-E(1)]]   
C              i
C
C FOR QCISD, LCCD AND CCD, ONLY THE T2 PART OF THE ENERGY IS ADDED IN,
C  WHILE THE T1**2 PIECE IS ADDED FOR ALL OTHER CC MODELS.
C
C WHICH IS USED TO COMPUTE THE RLE ENERGY APPROXIMANT.
C
      SUBROUTINE F2TAU(T2,T1A,T1B,DISSYT,NUMSYT,POP1,POP2,
     &               VRT1,VRT2,IRREP,FACT,ITYPE)
C
C THIS SUBROUTINE FORMS THE SYMMETRY PACKED TAU(AB,IJ) 
C AMPLITUDES FOR CCSD GIVEN THE SYMMETRY PACKED T2(AB,IJ)
C AND T1(A,I) AMPLITUDES. TAU(AB,IJ) IS DEFINED AS
C
C  TAU(AB,IJ) = T2(AB,IJ) + T1(A,I)*T1(B,J)*FACT
C
C NOTE THAT SYMMETRY PACKING IS USED AND THAT THE
C SYMMETRY INFORMATION IS ALSO USED IN ORDER TO
C DECIDE IF THERE ARE ANY SINGLE CONTRIBUTION OR NOT.
C FOR THE ABAB SPIN CASE, THERE ARE ONLY CONTRIBUTIONS
C WHEN THE IRREP OF A IS EQUAL TO THE IRREP OF I (AND
C IRREPB EQUAL TO IRREPJ, WHICH IS FORCED BY THE REQUIREMENT
C THAT THE T2 AMPLITUDES ARE TOTAL SYMMETRIC) IN THE AAAA
C AND BBBB SPIN CASES, THERE ARE CONTRIBUTIONS IF EITHERE
C IRREPA EQUALS IRREPI (FIRST TERM) OR IRREPA EQUALS IRREPJ 
C (SECOND TERM)
C
C INPUT :
C       T2 ............... T2 LIST
C       T1A .............. FIRST T1 LIST
C       T1B .............. SECOND T1 LIST
C       DISSYT, NUMSYT ... DIMENSIONING OF T2
C       POP1,VRT1 ........ POPULATION VECTORS FOR T1A
C       POP2, VRT2 ....... POPULATION VECTOR FOR T1B
C       IRREP ............ IRREP OF T2 LIST
C       FACT ............. MULTIPLICATION FACTOR FOR T1**2 CONTRIBUTION
C
C OUTPUT :
C       T2 ............... TAU ARRAY
      SUBROUTINE FANCYGET(Z,BUF,GETTYP,PERM,NUMP,NUMQ,NUMR,NUMS,
     &                    IFIRST,NUMREC,ICACHE,IRREPGET,LIST)
C
C WITH THIS SUBROUTINE, CERTAIN GAMES CAN BE PLAYED WITH I/O
C  WHICH ALLOW SOME CONTRACTIONS TO BE CARRIED OUT EASILY WITH
C  MATRIX MULTIPLICATION.  THE PURPOSE OF THE ROUTINE IS TO READ
C  A SYMMETRY PACKED FOUR-INDEX LIST [I(PQ,RS) OR I(P<Q,RS) WITH 
C  A GAMMA(PQ)=GAMMA(RS) DPD] ACCORDING TO AN ALTERNATIVE DPD.
C  SPECIFICALLY IT ALLOWS THE FOLLOWING:
C
C          ON DISK                  READ AS
C          -------                  -------
C         I(PQ,RS)        I(PS,RQ), I(PS,QR), I(PR,QS) OR I(PR,SQ)
C         I(PQ,RS)                 I(RQ,PS), I(QR,PS) OR I(QS,PR)
C         I(P<Q,RS)       I(PS,RQ), I(PS,QR), I(PR,QS) OR I(PR,SQ)
C         I(P<Q,RS)                I(RQ,PS), I(QR,PS)
C         
C
C THIS ROUTINE ACCESSES ALL IRREPS FOR A GIVEN LIST TO FILL ONE
C  IRREP OF THE ALTERNATIVE DPD LIST, AND THEREFORE SHOULD BE USED
C  ONLY WHEN THE REORDERING CANNOT BE DONE EASILY IN CORE.  THE
C  DISK ACCESS IS SEQUENTIAL WITH NON-SEQUENTIAL MEMORY ADDRESSING.
C
C INPUT:
C       Z - TARGET VECTOR FOR I/O OPERATIONS (AS IN GETLST).
C     BUF - SCRATCH ARRAY.  THE LENGTH OF THIS ARRAY MUST BE
C            AT LEAST THAT OF THE LARGEST LOGICAL RECORD FOR
C            THIS SPECIFIC LIST (MAX(IRPDPD(1..NIRREP,ISYTYP(1,LIST)).
C  GETTYP - REFERS TO THE MODE OF STORAGE AND THE WAY THAT THE
C            ARRAY WILL BE READ. (CHARACTER*2) 
C
C            'FF' - ARRAY IS STORED ON DISK AS I(PQ,RS)
C            'PF' - ARRAY IS STORED ON DISK AS I(P<Q,RS)
C
C            ("P" REFERS TO PACKED, "F" TO FULL)
C
C    NUMP - POPULATION BY IRREP CORRESPONDING TO FASTEST LEFT INDEX ON DISK.
C    NUMQ - POPULATION BY IRREP CORRESPONDING TO SLOWEST LEFT INDEX ON DISK.
C    NUMR - POPULATION BY IRREP CORRESPONDING TO FASTEST RIGHT INDEX ON DISK.
C    NUMS - POPULATION BY IRREP CORRESPONDING TO SLOWEST RIGHT INDEX ON DISK.
C
C    PERM - PERMUTATION TYPE FOR DPD (CHARACTER*4)
C 
C            '1432' - I(PQ,RS) -> I(PS,RQ)
C            '1423' - I(PQ,RS) -> I(PS,QR)
C            '1324' - I(PQ,RS) -> I(PR,QS)
C            '1342' - I(PQ,RS) -> I(PR,SQ)
C
C  IFIRST - FIRST LOGICAL RECORD OF *ALTERNATIVE DPD* WHICH IS
C           REQUIRED (LIKE GETLST).
C  NUMREC - THE NUMBER OF LOGICAL RECORDS TO RETRIEVE (LIKE GETLST).
C  ICACHE - THE I/O CACHE TO BE USED (LIKE GETLST).
CIRREPGET - THE IRREP OF THE ALTERNATIVE DPD WHICH IS REQUESTED
C           (LIKE GETLST).
C    LIST - THE MOINTS LIST NUMBER (LIKE GETLST).
C
C ***IMPORTANT*** 
C   1. THIS ROUTINE HAS NOT BEEN EXTENSIVELY DEBUGGED.  DO NOT
C      ASSUME THAT IT IS CORRECT FOR ALL CASES.
C   2. PRESENTLY, THE ARGUMENTS IFIRST AND NUMREC ARE IGNORED, AND
C      THIS ROUTINE WILL RETRIEVE THE FULL LIST FOR A GIVEN IRREP.
C   3. CURRENTLY, THE ROUTINE CAN NOT HANDLE LISTS WITH PACKED KET
C      INDICES.  THIS MAY BE ADDED IF THE NEED ARISES.
C
      SUBROUTINE FANCYPUT(Z,BUF,PUTTYP,PERM,ANTI,AUGTYP,FACTOR,
     &                    NUMP,NUMQ,NUMR,NUMS,
     &                    IFIRST,NUMREC,ICACHE,IRREPGET,LIST)
C
C WITH THIS SUBROUTINE, CERTAIN GAMES CAN BE PLAYED WITH I/O
C  WHICH ALLOW SOME CONTRACTIONS TO BE CARRIED OUT EASILY WITH
C  MATRIX MULTIPLICATION.  THE PURPOSE OF THE ROUTINE IS TO WRITE
C  A SYMMETRY PACKED FOUR-INDEX LIST [I(PQ,RS) OR I(P<Q,RS) WITH 
C  A GAMMA(PQ)=GAMMA(RS) DPD] FROM A SOURCE VECTOR BELONGING TO 
C  A DIFFERENT DPD.  
C
C  SPECIFICALLY IT ALLOWS THE FOLLOWING:
C
C-------------------------------------------------------------------         
C         IN MEMORY                                    WRITTEN AS 
C          -------                                       -------
C I(PS,RQ), I(PR,SQ), I(PR,QS) OR I(PS,QR)               I(PQ,RS) 
C I(PS,RQ), I(PR,SQ), I(PR,QS) OR I(PS,QR)              I(P<Q,RS) 
C-------------------------------------------------------------------         
C
C THIS ROUTINE ACCESSES ALL IRREPS FOR A GIVEN LIST TO FILL ONE
C  IRREP OF THE ALTERNATIVE DPD LIST, AND THEREFORE SHOULD BE USED
C  ONLY WHEN THE REORDERING CANNOT BE DONE EASILY IN CORE.  THE
C  DISK ACCESS IS SEQUENTIAL WITH NON-SEQUENTIAL MEMORY ADDRESSING.
C
C INPUT:
C       Z - TARGET VECTOR FOR I/O OPERATIONS (AS IN GETLST).
C     BUF - SCRATCH ARRAY.  THE LENGTH OF THIS ARRAY MUST BE
C            AT LEAST THAT OF THE LARGEST LOGICAL RECORD FOR
C            THIS SPECIFIC LIST (MAX(IRPDPD(1..NIRREP,ISYTYP(1,LIST)).
C  PUTTYP - REFERS TO THE MODE OF STORAGE AND THE WAY THAT THE
C            ARRAY WILL BE READ. (CHARACTER*2) 
C
C            'FF' - ARRAY IS STORED ON DISK AS I(PQ,RS)
C            'PF' - ARRAY IS STORED ON DISK AS I(P<Q,RS)
C
C            ("P" REFERS TO PACKED, "F" TO FULL)
C
C    PERM - PERMUTATION TYPE (CHARACTER*4)
C            '1432' - WRITE I(PS,RQ) AS I(PQ,RS)
C            '1423' - WRITE I(PR,SQ) AS I(PQ,RS)
C            '1324' - WRITE I(PR,QS) AS I(PQ,RS)
C            '1342' - WRITE I(PS,QR) AS I(PQ,RS)
C
C    ANTI - ANTISYMMETRIZATION TYPE (CHARACTER*1) [IGNORED FOR PUTTYP 'FF']
C            'Y' - ANTISYMMETRIZE BRA INDICES AND WRITE I(P<Q,RS). 
C            'N' - DO NOT ANTISYMMETRIZE BRA INDICES AND WRITE I(P<Q,RS).
C
C  AUGTYP - HOW THE LIST WILL BE INCREMENTED (CHARACTER*1)
C            'S' - PERFORM SAXPY OPERATION INVOLVING INPUT ELEMENTS
C                   OF SOURCE VECTOR AND CORRESPONDING ELEMENTS ON LIST.
C            'O' - OVERWRITE EXISTING ELEMENTS.
C
C  FACTOR - COEFFICIENT TO USE IN SAXPY OPERATIONS SPECIFIED BY AUGTYP='S'
C           (DOUBLE PRECISION REAL). [IGNORED FOR AUGTYP='O'] 
C    NUMP - POPULATION BY IRREP CORRESPONDING TO FASTEST LEFT INDEX ON DISK.
C    NUMQ - POPULATION BY IRREP CORRESPONDING TO SLOWEST LEFT INDEX ON DISK.
C    NUMR - POPULATION BY IRREP CORRESPONDING TO FASTEST RIGHT INDEX ON DISK.
C    NUMS - POPULATION BY IRREP CORRESPONDING TO SLOWEST RIGHT INDEX ON DISK.
C
C  IFIRST - FIRST LOGICAL RECORD OF *ALTERNATIVE DPD* WHICH IS
C           REQUIRED (LIKE GETLST).
C  NUMREC - THE NUMBER OF LOGICAL RECORDS TO RETRIEVE (LIKE GETLST).
C  ICACHE - THE I/O CACHE TO BE USED (LIKE GETLST).
CIRREPGET - THE IRREP OF THE ALTERNATIVE DPD WHICH IS REQUESTED
C           (LIKE GETLST).
C    LIST - THE MOINTS LIST NUMBER (LIKE GETLST).
C
C ***IMPORTANT*** 
C   1. THIS ROUTINE HAS NOT BEEN EXTENSIVELY DEBUGGED.  DO NOT
C      ASSUME THAT IT IS CORRECT FOR ALL CASES.
C   2. PRESENTLY, THE ARGUMENTS IFIRST AND NUMREC ARE IGNORED, AND
C      THIS ROUTINE WILL RETRIEVE THE FULL LIST FOR A GIVEN IRREP.
C   3. CURRENTLY, THE ROUTINE CAN NOT HANDLE LISTS WITH PACKED KET
C      INDICES.  THIS MAY BE ADDED IF THE NEED ARISES.
C
      SUBROUTINE FETCH(ZLIST,FILE,RECNUM,IWRDOFF,NWORDS)
C
C THIS ROUTINE RETRIEVES LOGICAL RECORDS FROM LIST FILES.  IT IS
C  A PRIMITIVE ROUTINE CALLED BY PUTLST WHICH SHOULD NOT BE CALLED
C  DIRECTLY.
C


      SUBROUTINE FILIRP(IVEC,IRREP)
C
C PRIMITIVE ROUTINE USED BY THE FANCY I/O ROUTINES.  REST ASSURED THAT
C  YOU WILL NEVER WANT TO KNOW WHAT THIS ROUTINE DOES.
C

      SUBROUTINE FILPOP
C
C FILLS THE SYMMETRY POPULATION VECTOR COMMON BLOCK.
C
      SUBROUTINE FILSUM(IUHF)
C
C  THIS ROUTINE WRITES OUT INFORMATION ABOUT THE PHYSICAL LOCATION
C   OF ALL LISTS.
C
      SUBROUTINE FILTER(A,LENGTH,TOL)
C
C THIS ROUTINE SETS ALL VALUES IN A VECTOR A TO ZERO IF
C  THEY ARE BELOW A SPECIFIED TOLERANCE (TOL).
C
      DOUBLE PRECISION FUNCTION FNDLRGAB(V,LEN)
C
C THIS IS AN EMULATOR OF THE CRAY SCILIB ROUTINE HAVING THE SAME NAME.
C  IT RETURNS THE LARGEST ABSOLUTE VALUE IN A VECTOR (V) OF LENGTH LEN.
C


      SUBROUTINE FRMRIJ(ICORE,MAXCOR,IUHF,RLECYC,MAXORD,IBOT,I,J,
     &                  SINGLE)
C
C THIS ROUTINE IS USED TO FORM THE R MATRIX USED IN THE RLE SOLUTION
C  OF THE CC EQUATIONS.  RLECYC IS THE NUMBER OF CYCLES WHICH HAVE BEEN
C  COMPLETED, I IS THE ROW NUMBER OF THE MATRIX ELEMENT WHICH IS TO BE 
C  COMPUTED AND J IS THE COLUMN NUMBER.  IF I IS NONZERO AND J IS ZERO,
C  THE THE ENTIRE Ith ROW WILL BE CONSTRUCTED.  SIMILARLY, IF I IS ZERO AND
C  J IS NONZERO, THE Jth COLUMN WILL BE FORMED.
C
C THE FORMULA FOR AN R MATRIX ELEMENT IS:
C
C                (i)     (j)   (i)     (j+1)      (i)
C      R(I,J) = T   D   T   - T   D   T       -  Q
C
C WHERE Q IS THE T2 CONTRIBUTION TO THE ENERGY FOR HF CASES AND
C  E<-T2 + E<-T1 FOR NON-HF CASES.
C
      SUBROUTINE FRMRIJ2(ICORE,MAXCOR,IUHF,RLECYC,MAXORD,IBOT,I,J,
     &                   SINGLE)
C
C THIS ROUTINE IS USED TO FORM THE R MATRIX USED IN THE RLE-1 METHOD.
C  PUT THREE T2 VECTORS IN CORE UNTIL WE KNOW WHETHER THIS WORKS OR NOT
C
C THE FORMULA FOR AN R MATRIX ELEMENT IS:
C
C                 (i)   (i-1)      (j)    (j-1)
C      R(I,J) = [T   - T     ] * [T    - T     ]
C


      SUBROUTINE FRMRIJ3(ICORE,MAXCOR,IUHF,RLECYC,MAXORD,IBOT,I,J,
     &                  SINGLE)
C
C THIS ROUTINE IS USED TO FORM THE R MATRIX USED IN THE RLE SOLUTION
C  OF THE CC EQUATIONS.  RLECYC IS THE NUMBER OF CYCLES WHICH HAVE BEEN
C  COMPLETED, I IS THE ROW NUMBER OF THE MATRIX ELEMENT WHICH IS TO BE 
C  COMPUTED AND J IS THE COLUMN NUMBER.  IF I IS NONZERO AND J IS ZERO,
C  THE THE ENTIRE Ith ROW WILL BE CONSTRUCTED.  SIMILARLY, IF I IS ZERO AND
C  J IS NONZERO, THE Jth COLUMN WILL BE FORMED.
C
C THE FORMULA FOR AN R MATRIX ELEMENT IS:
C
C                [i]     [j]   [i]     (j+1)      (i)
C      R(I,J) = T   D   T   - T   D   T       -  Q
C
C WHERE Q IS THE T2 CONTRIBUTION TO THE ENERGY FOR HF CASES AND
C  E<-T2 + E<-T1 FOR NON-HF CASES.
C
      SUBROUTINE FRMTAU(SCR,MAXCOR,IUHF,RLECYC,MAXORD,NEWT,IBOT,
     &                  SINGLE,RLETYP)
C
C FORMS THE TAU VECTOR USED TO EXTRAPOLATE THE AMPLITUDES.
C
      SUBROUTINE FTAU(T2,T1A,T1B,DISSYT,NUMSYT,POP1,POP2,
     &               VRT1,VRT2,IRREP,ISPIN,FACT)
C
C THIS SUBROUTINE FORMS THE SYMMETRY PACKED TAU(AB,IJ) 
C AMPLITUDES FOR CCSD GIVEN THE SYMMETRY PACKED T2(AB,IJ)
C AND T1(A,I) AMPLITUDES. TAU(AB,IJ) IS DEFINED AS
C
C  TAU(AB,IJ) = T2(AB,IJ) + T1(A,I)*T1(B,J)*FACT
C                         - T1(A,J)*T1(B,I)*FACT
C
C FOR ISPIN =1 (AAAA CASE) AND ISPIN =2 (BBBB CASE)
C THE EQUATION GIVEN APLIES DIRECTLY. FOR ISPIN=3
C (ABAB CASE) IT REDUCES TO
C
C TAU(Ab,Ij) = T2(Ab,Ij) + T1(A,I)*T1(b,j)*FACT
C
C NOTE THAT SYMMETRY PACKING IS USED AND THAT THE
C SYMMETRY INFORMATION IS ALSO USED IN ORDER TO
C DECIDE IF THERE ARE ANY SINGLE CONTRIBUTION OR NOT.
C FOR THE ABAB SPIN CASE, THERE ARE ONLY CONTRIBUTIONS
C WHEN THE IRREP OF A IS EQUAL TO THE IRREP OF I (AND
C IRREPB EQUAL TO IRREPJ, WHICH IS FORCED BY THE REQUIREMENT
C THAT THE T2 AMPLITUDES ARE TOTAL SYMMETRIC) IN THE AAAA
C AND BBBB SPIN CASES, THERE ARE CONTRIBUTIONS IF EITHERE
C IRREPA EQUALS IRREPI (FIRST TERM) OR IRREPA EQUALS IRREPJ 
C (SECOND TERM)
C
      SUBROUTINE GETALL(Z,LENGTH,ICACHE,LSTNUM)
C
C THIS ROUTINE RETRIEVES ALL IRREPS OF A SYMMETRY PACKED DISTRIBUTION
C  AND PLACES THEM IN THE VECTOR Z.  LENGTH IS THE TOTAL LENGTH OF THE
C  LIST, LSTNUM IS THE NUMBER OF THE LIST ON THE MOINTS FILE.
C
      SUBROUTINE GETALT(Z,LENGTH,ICACHE,LSTNUM)
C
C THIS ROUTINE RETRIEVES ALL IRREPS OF A SYMMETRY PACKED DISTRIBUTION
C  AND PLACES THEIR *TRANSPOSES* IN VECTOR Z.  LENGTH IS THE TOTAL LENGTH 
C  OF THE LIST, LSTNUM IS THE NUMBER OF THE LIST ON THE MOINTS FILE.
C
      SUBROUTINE GETDPT
C
C FORMS THE VMOL DIRECT PRODUCT TABLE.  CODE IS STRAIGHT OUT
C  OF VMOL, EXCEPT THAT THE IDIOTIC VARIABLE NAMES (AND, OR AND
C  EOR) HAVE BEEN CHANGED TO SOMETHING LESS DANGEROUS.
C
      SUBROUTINE GETFAST(Z,IFIRST,NDIS,ISPIN,ITYPE)
C
C THIS ROUTINE DOES A FAST IN-CORE FETCH OF A LIST HELD IN
C  THE AUXILIARY CACHE
C
      SUBROUTINE GETGSI(LEFTP,LENGTH,RIGHTP,NUMDIS,NIRREP,NUMIRR,IBUF)
C
C THIS ROUTINE RETURNS THE APPROPRIATE GATHER/SCATTER VECTORS NEEDED
C   TO READ IN A FULL DISTRIBUTION INTO A SYMMETRY-PACKED ARRAY.
C   THIS ROUTINE GETS THE INVERSE SYMMETRY VECTORS
C
C  INPUT:
C
C    LEFTP = STORAGE SCHEME FOR DISTRIBUTION MEMBERS (SEE JOBARC LIST).
C    LENGTH= DISTRIBUTION SIZE (IN FLOATING POINT WORDS).
C    RIGHTP= STORAGE SCHEME FOR DISTRIBUTIONS (SEE JOBARC LIST).
C    NUMDIS= NUMBER OF TOTAL DISTRIBUTIONS.
C    NIRREP= THE TOTAL NUMBER OF IRREDUCIBLE REPRESENTATIONS.
C
C  OUTPUT:
C
C    NUMIRR= POPULATION COUNT SYMMETRY VECTORS (SEE JOBARC LIST).
C             THE FIRST NIRREP ELEMENTS CORRESPOND TO THE DISTRIBUTIONS
C             WHILE THE LAST NIRREP ELEMENTS REFER TO THE DISTRIBUTION
C             MEMBERS.
C    IBUF  = SYMMETRY VECTORS (SEE JOBARC LIST).  
C             THE FIRST NUMDIS MEMBERS REFER TO THE DISTRIBUTIONS WHILE
C             THE LAST LENGTH MEMBERS REFER TO THE DISTRIBUTION MEMBERS.
C
      
      SUBROUTINE GETGSV(LEFTP,LENGTH,RIGHTP,NUMDIS,NIRREP,NUMIRR,IBUF)
C
C THIS ROUTINE RETURNS THE APPROPRIATE GATHER/SCATTER VECTORS NEEDED
C   TO READ IN A FULL DISTRIBUTION INTO A SYMMETRY-PACKED ARRAY.
C
C  INPUT:
C
C    LEFTP = STORAGE SCHEME FOR DISTRIBUTION MEMBERS (SEE JOBARC LIST).
C    LENGTH= DISTRIBUTION SIZE (IN FLOATING POINT WORDS).
C    RIGHTP= STORAGE SCHEME FOR DISTRIBUTIONS (SEE JOBARC LIST).
C    NUMDIS= NUMBER OF TOTAL DISTRIBUTIONS.
C    NIRREP= THE TOTAL NUMBER OF IRREDUCIBLE REPRESENTATIONS.
C
C  OUTPUT:
C
C    NUMIRR= POPULATION COUNT SYMMETRY VECTORS (SEE JOBARC LIST).
C             THE FIRST NIRREP ELEMENTS CORRESPOND TO THE DISTRIBUTIONS
C             WHILE THE LAST NIRREP ELEMENTS REFER TO THE DISTRIBUTION
C             MEMBERS.
C    IBUF  = SYMMETRY VECTORS (SEE JOBARC LIST).  
C             THE FIRST NUMDIS MEMBERS REFER TO THE DISTRIBUTIONS WHILE
C             THE LAST LENGTH MEMBERS REFER TO THE DISTRIBUTION MEMBERS.
      SUBROUTINE GETLST(ZLIST,NFIRST,NBLOCK,USECXN,ISPIN,ITYPE)
C
C THIS SUBROUTINE RETRIEVES NBLOCK DISTRIBUTIONS OF A PARTICULAR INTEGRA
C  LIST, BEGINNING WITH DISTRIBUTION NFIRST.  THE VALUES ARE RETURNED IN
C  VECTOR ZLIST.
C
C   OUTPUT:
C
C         ZLIST - THE TARGET VECTOR USED IN I/O OPERATIONS.
C
C   INPUT PARAMETERS:
C
C         NFIRST- THE NUMBER OF THE FIRST DISTRIBUTION WHICH WILL BE
C                 WRITTEN TO OR READ FROM DISK.
C         NBLOCK- THE NUMBER OF DISTRIBUTIONS WHICH WILL BE HANDLED.
C         USECIN- THE CACHE BUFFER WHICH IS TO BE USED FOR I/O OPERATION
C                 BEST PERFORMANCE IS ACHIEVED IF THIS IS SET TO 1 FOR
C                 T AMPLITUDE I/O AND 2 FOR INTEGRAL I/O.
C         ISPIN - THE LEFT-HAND INDEX OF THE LIST [MOIO(ISPIN,ITYPE)].
C         ITYPE - THE RIGHT-HAND INDEX OF THE LIST [MOIO(ISPIN,ITYPE)].
C
C  MOIO PARAMETERS (FROM COMMON BLOCK /LISTS/):
C
C        >>>ALL OF THESE VALUES ARE COMPUTED BY ROUTINE UPDMOI<<<
C
C         MOIO(ISPIN,ITYPE)  - THE PHYSICAL RECORD NUMBER ON WHICH
C                              LIST ITYPE[ISPIN] BEGINS.
C         MOIOWD(ISPIN,ITYPE)- THE WORD ADDRESS AT WHICH LIST
C                              ITYPE[ISPIN] BEGINS.
C         MOIODS(ISPIN,ITYPE)- THE NUMBER OF TOTAL DISTRIBUTIONS
C                              IN LIST ITYPE[ISPIN].
C         MOIOSZ(ISPIN,ITYPE)- THE SIZE OF THE INDIVIDUAL DISTRIBUTIONS
C                              IN LIST ITYPE[ISPIN] (IN *FLOATING-POINT*
C                              WORDS.
C         MOIOFL(ISPIN,ITYPE)- THE FILE ON WHICH THE LIST RESIDES.
C
      SUBROUTINE GETREC(LUJNK,FILNAM,LABEL,LENGTH,ISTUFF)
C
C THIS ROUTINE RETRIEVES A LOGICAL RECORD FROM THE JOBARC FILE.
C
C   INPUT:
C         LUJNK - INTEGER 
c                 > 0 missing records are reported and run aborts
c                 = 0 length of record returned in length
c                 < 0 zeros are silently returned
C         FILNAM- CHARACTER*(*) ignored
C         LABEL - IDENTIFIER FOR LOGICAL RECORD.  CHARACTER*(*) STRING.
C         LENGTH- LENGTH OF LOGICAL RECORD IN *INTEGER* WORDS.
C
C   OUTPUT:
C         ISTUFF- CONTENTS OF LOGICAL RECORD (lujnk .ne. 0 )
c         length- length of record in *integer* words ( lujnk = 0)
C
      SUBROUTINE GETSTF(EVAL,IUHF,IENTRY)
C
C THIS ROUTINE IS A DEPENDENT OF CRAPSI AND INITIALIZES MANY
C  OF THE COMMON BLOCKS USED BY THE PROGRAM SYSTEM.  CALLING
C  THIS ROUTINE EXPLICITLY IS NOT A WISE THING TO DO.
C
      SUBROUTINE GETT1(ICORE,MAXCOR,MXCOR,IUHF,IOFFT1)
C
C THIS ROUTINE LOADS THE T1AA AND T1BB VECTORS INTO THE VERY TOP OF
C  CORE, AND RETURNS A POINTER ARRAY GIVING THE OFFSETS WHERE EACH
C  IRREP OF THE TWO SPIN CASES BEGINS.  FOR RHF, THE ADDRESSES OF THE
C  AA AND BB T1 VECTORS ARE IDENTICAL AND ONLY ONE IS HELD.
C
C  PARAMETERS:
C              ICORE - THE CORE VECTOR (T1 RETURNED AT TOP)
C             MAXCOR - THE TOTAL CORE SIZE 
C              MXCOR - THE SIZE OF CORE BELOW THE START OF THE T1 VECTORS.
C               IUHF - THE UHF/RHF FLAG
C             IOFFT1 - A TWO DIMENSIONAL ARRAY GIVING THE ADDRESS OF
C                       THE BEGINNING OF EACH IRREP IN THE T1 VECTOR.
C                       FOR EXAMPLE, IOFFT1(3,2) GIVES THE ADDRESS OF
C                       THE FIRST ELEMENT OF THE THIRD IRREP FOR SPIN
C                       CASE 2 (BB).
C
      SUBROUTINE GETTRN(Z,BUF,NDSSIZ,NUMDIS,ICACHE,ISPIN,ITYPE)
C
C THIS ROUTINE RETRIEVES THE TRANSPOSE OF A LIST ON DISK.  IT IS
C  SPECIFICALLY ONLY FOR CASES IN WHICH THE ENTIRE LIST CAN BE HELD IN CORE.
C
C  INPUT:
C         NDSSIZ - ACTUAL DISTRIBUTION SIZE OF LIST ON DISK.
C         NUMDIS - NUMBER OF DISTRIBUTIONS ON DISK.
C         ICACHE - I/O CACHE TO BE USED.
C          ISPIN - SPIN OR IRREP SPECIFIER FOR LIST.
C          ITYPE - LIST NUMBER.
C
C  SCRATCH:
C            BUF - INTERMEDIATE ARRAY HOLDING DISTRIBUTIONS (SIZE: NDSSIZ)
C
C  OUTPUT:
C              Z - THE TRANSPOSED LIST, TREATED AS A MATRIX WITH
C                   DIMENSIONS (NUMDIS,NDSSIZ).
C     
      SUBROUTINE GETTRN2(Z,BUF,ISTART,NUMDIS,ICACHE,ISPIN,ITYPE)
C
C THIS ROUTINE READS A (PQ,RS) LIST INTO AN RS,PQ MATRIX.
C
C  INPUT:
C         ISTART - THE FIRST PQ DISTRIBUTION THAT IS REQUESTED.
C         NUMDIS - THE NUMBER OF SEQUENTIAL PQ DISTRIBUTIONS 
C                  (FOLLOWING ISTART) WHICH ARE REQUESTED.
C         ICACHE - I/O CACHE TO BE USED.
C          ISPIN - SPIN OR IRREP SPECIFIER FOR LIST.
C          ITYPE - LIST NUMBER.
C
C  SCRATCH:
C            BUF - INTERMEDIATE ARRAY HOLDING DISTRIBUTIONS (THE SIZE
C                  MUST BE AT LEAST AS LARGE AS THE *ACTUAL* DISTRIBUTION
C                  SIZE OF THE LIST).
C
C  OUTPUT:
C              Z - THE TRANSPOSED LIST, WHICH IS OF DIMENSION
C                     [MOIODS(ISPIN,ITYPE) , NUMDIS-ISTART+1]
C     
   
   
      SUBROUTINE GTSLST(ZLIST,NSTART,NBLOCK,NUMDIS,USECIN,ISPIN,ITYPE,
     &                  GETIRP,NIRREP,NUMIRR,IBUF,ZBUF)
C
C THIS ROUTINE SERVES A FUNCTION SIMILAR TO GETLST, EXCEPT THAT IT RETURNS
C  SYMMETRY PACKED LISTS.  (LARGELY OBSOLETE- USED TO READ UNPACKED
C  INTEGRAL LISTS INTO SYMMETRY PACKED VECTORS)
C
C INPUT:
C
C     GETIRP= THE IRREDUCIBLE REPRESENTATION CORRESPONDING TO THE
C              DIRECT PRODUCT OF THE TWO INDIVIDUAL DISTRIBUTION ELEMENTS.
C     NSTART= THE NUMBER OF THE FIRST DISTRIBUTION *WITHIN THE SYMMETRY
C              BLOCK* THAT IS TO BE READ.
C     NBLOCK= THE NUMBER OF DISTRIBUTIONS WHICH ARE TO BE READ.
C     NUMDIS= THE TOTAL NUMBER OF DISTRIBUTIONS (*NOT* THE TOTAL NUMBER
C              OF SYMMETRY BLOCK DISTRIBUTIONS).
C     USECIN= THE I/O CACHE TO BE USED.
C     ISPIN = THE I OF MOIO(I,J).
C     ITYPE = THE J OF MOIO(I,J).
C     NIRREP= THE TOTAL NUMBER OF IRREDUCIBLE REPRESENTATIONS.
C     NUMIRR= POPULATION COUNT SYMMETRY VECTORS (SEE JOBARC LIST).
C             THE FIRST NIRREP ELEMENTS CORRESPOND TO THE DISTRIBUTIONS
C             WHILE THE LAST NIRREP ELEMENTS REFER TO THE DISTRIBUTION 
C             MEMBERS.  THESE CAN BE FORMED IN GETGSV. [LENGTH: 2*NIRREP].
C     IBUF  = SYMMETRY VECTORS (SEE JOBARC LIST).  
C             THE FIRST NUMDIS MEMBERS REFER TO THE DISTRIBUTIONS WHILE
C             THE LAST LENGTH MEMBERS REFER TO THE DISTRIBUTION MEMBERS.
C             [LENGTH: LENGTH+NUMDIS].
C 
C SCRATCH:
C
C     ZBUF  = SCRATCH VECTOR USED AS A SOURCE VECTOR IN GATHER OPERATIONS.
C               [LENGTH: LENGTH]
C              
C OUTPUT:
C
C     ZLIST = THE SYMMETRY PACKED LIST. [LENGTH: NBLOCK*NUMIRR(NIRREP+GETIRP)].
C
      SUBROUTINE ICOPY(I1,I2,LEN)
C
C THIS ROUTINE COPIES THE FIRST LEN ELEMENTS OF INTEGER
C   VECTOR I1 INTO VECTOR I2.
C
      SUBROUTINE INIPCK(SYTYPL,SYTYPR,LIST)
C
C DRIVES THE CREATION OF MOIO POINTERS FOR SYMMETRY PACKED LISTS.
C  ALSO INITIALIZES THE ISYTYP VECTOR FOR THE LIST.
C
C  INPUT:
C        SYTYPL - THE SYMMETRY TYPE FOR THE DISTRIBUTION ELEMENTS.
C        SYTYPR - THE SYMMETRY TYPE FOR THE DISTRIBUTION TYPE.
C        LIST   - THE LIST ON WHICH THIS QUANTITY WILL BE STORED.
C
      SUBROUTINE INIPCK2(SYTYPL,SYTYPR,LIST,IARG1,IARGX2)
C
C DRIVES THE CREATION OF MOIO POINTERS FOR SYMMETRY PACKED LISTS.
C
      SUBROUTINE INITIO(INTIME,I0)
C
C INITIALIZES I/O SYSTEM.  DEPENDENT OF CRAPSI, SHOULD PROBABLY *NEVER*
C  BE CALLED EXPLICITLY.
C
      SUBROUTINE INITPOP
C
C INITIALIZES COMMON BLOCK /SYM/.
C
C  DESCRIPTION OF /SYM/
C
C         POP1   ...... NUMBER OF OCCUPIED ALPHA ORBITALS WITHIN EACH IRREP
C         POP2   ...... NUMBER OF OCCUPIED BETA ORBITALS WITIN EACH IRREP
C         VRT1   ...... NUMBER OF VIRTUAL ALPHA ORBITALS WITHIN EACH IRREP
C         VRT2   ...... NUMBER OF VIRTUAL BETA ORBITALS WITHIN EACH IRREP
C         NTAA   ...... LENGTH OF T1(A,I) ALPHA
C         NTBB   ...... LENGTH OF T1(A,I) BETA
C         NF1AA  ...... LENGTH OF F(M,I) ALPHA ( NOTE ALL Fs ARE NOT SYMMETRIC)
C         NF1BB  ...... LENGTH OF F(M,I) BETA
C         NF2AA  ...... LENGTH OF F(A,E) ALPHA
C         NF2BB  ...... LENGTH OF F(A,E) BETA
C
     

      SUBROUTINE INSMEM(ROUTINE,INEED,IAVAIL)
C
C THIS ROUTINE SHOULD BE CALLED WHEN THERE IS INSUFFICIENT CORE TO
C  CONTINUE THE CALCULATION.  PRINTS OUT A FATAL ERROR MESSAGE AND
C  CALLS THE CRAPS EXIT HANDLER.
C
C INPUT:
C       ROUTINE - ROUTINE FROM WHICH INSMEM IS CALLED [CHARACTER*(*)]
C       INEED   - AMOUNT OF MEMORY REQUIRED.
C       IAVAIL  - AMOUNT OF MEMORY AVAILABLE.
C
      SUBROUTINE INVERS(A,N)
C
C  THIS ARRAY CALCUATES THE INVERSE OF A GIVEN VECTOR A OF 
C  LENGTH N
C
C     A(I) = ONE/A(I)
C
      SUBROUTINE IOERR(ROUTINE,IUNIT,IERTYP)
C
C ERROR HANDLER FOR I/O ROUTINES.  SHOULD BE CALLED ON ALL I/O ERRORS.
C   PRINTS OUT FATAL ERROR MESSAGE AND CALLS THE CRAPS EXIT HANDLER.
C
C INPUT:
C       ROUTINE - THE ROUTINE FROM WHICH IOERR IS CALLED [CHARACTER*(*)]
C       IUNIT   - THE UNIT ON WHICH THE I/O ERROR OCCURED.
C       IERTYP  - THE I/O ERROR NUMBER (FROM IOSTAT=XXX).
C
      INTEGER FUNCTION ISYMSZ(ITYPL,ITYPR)
C
C THIS ROUTINE RETURNS THE TOTAL SIZE OF A SYMMETRY PACKED
C  DISTRIBUTION (FOR ALL IRREPS).  ITYPL IS THE SYMMETRY TYPE
C  OF THE DISTRIBUTION MEMBERS, ITYPR IS THE SYMMETRY TYPE OF
C  THE DISTRIBUTIONS.  NOTE THAT CHANGING THE MEANING OF THESE
C  VARIABLES MAKES NO DIFFERENCE.
C
      SUBROUTINE IZERO(IVEC,LEN)
C
C ZEROS OUT THE FIRST LEN ELEMENTS OF INTEGER VECTOR IVEC.
C
      SUBROUTINE JASMRY
C
C THIS ROUTINE PRINTS OUT A SUMMARY OF ALL RECORDS IN THE JOBARC FILE,
C  THEIR LOCATION (WORD ADDRESS) AND THE NUMBER OF INTEGER WORDS THAT
C  THE LOGICAL RECORD TAKES UP.
C
       INTEGER FUNCTION LNBLNK (STRING)
C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
C Purpose:   Returns the position of the last non-blank character
C
C Arguments: STRING   character string (input only)
C
C Remarks:   All FORTRAN 77 character variables are blank padded on the
C            right.  The intrinsic function LEN returns the dimension
C            of the character object, not the length of the contents.
C            
C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
      INTEGER FUNCTION LOCCHR(LENGTH,Z,INC,TARGET)
C
C THIS SUBROUTINE LOCATES THE FIRST OCCURANCE OF A CHARACTER*(*) STRING
C  IN A CHARACTER*8 VECTOR.
C
C INPUT: 
C       LENGTH - THE LENGTH OF THE VECTOR (# OF CHARACTER*8 ELEMENTS)
C            Z - THE VECTOR TO BE SEARCHED.
C          INC - THE STRIDE LENGTH THROUGH THE VECTOR
C       TARGET - THE CHARACTER STRING WHICH IS TO BE LOCATED.
C
C THIS ROUTINE IS USED BY PUTREC AND GETREC BUT MAY BE USEFUL FOR OTHER
C  PURPOSES.
C
      SUBROUTINE MAKER(ICORE,MAXCOR,IUHF,RLECYC,MAXORD,IBOT,SINGLE,
     &                 RLETYP)
C
C DRIVER FOR FORMATION OF THE RLE R MATRIX.
C
      SUBROUTINE MATEXP(IRREP,NUM,A,B)
C
C     THIS ROUTINE EXPANDS THE A COMPRESSED MATRIX A(P,Q)
C     P >= Q TO AN ARRAY A(PQ) WITH P,Q. NOTE THIS ROUTINE 
C     EXPECTS THAT THE ARRAY A IS SYMMETRY PACKED
C
C     INPUT : IRREP  ...  THE IRREP OF THE CORRESPONDING PART OF A
C             NUM ......  POPULATION VECTOR FOR I AND J
C             DISSIZE ..  DISTRIBUTION SIZE OF A
C             A     ....  THE MATRIX A
C
C     OUTPUT : B .......  THE EXPANDED MATRIX A
C
      SUBROUTINE MMMT(X,N)
C
C SUBROUTINE FORMS X-X(transpose) AND RETURNS RESULT IN X.
C
      SUBROUTINE MO2AO2(ZMO,ZAO,EVEC,SCR,NBAS,ISPIN)
C
C TRANSFORMS A TWO-INDEX QUANTITY (I.E. DENSITY) FROM THE MO TO
C  THE AO BASIS.
C
C INPUT:
C       ZMO  - TWO-INDEX QUANTITY IN MO BASIS (LENGTH: NBAS*NBAS)
C       NBAS - NUMBER OF BASIS FUNCTIONS
C       ISPIN- 1 FOR ALPHA, 2 FOR BETA
C
C OUTPUT:
C       ZAO  - TWO-INDEX QUANTITY IN AO BASIS (LENGTH: NBAS*NBAS)
C       
C SCRATCH:
C       EVEC - HOLDS EIGENVECTOR MATRIX (LENGTH: NBAS*NBAS)
C       SCR  - HOLDS INTERMEDIATE QUANTITY (LENGTH: NBAS*NBAS) 
C
      SUBROUTINE MPMT(X,N)
C
C SUBROUTINE ADDS SQUARE MATRIX X AND ITS TRANSPOSE AND PUTS RESULT IN
C  ORIGINAL MATRIX.
C
      SUBROUTINE MTRAN2(A,N)
C
C IN-PLACE TRANSPOSITION OF AN N x N MATRIX.
C
      SUBROUTINE MTRAN3(Z,LDIM,NDIM)
C
C IN-PLACE TRANSPOSITION OF A SUBMATRIX OF Z, WHERE Z IS
C  AN LDIM x NDIM MATRIX.  THE UPPER NDIM x NDIM TRIANGLE
C  IS TRANSPOSED IN THIS ROUTINE
C
   
      SUBROUTINE MVLIST(Z,NDSSIZ,NUMDIS,LSTFRM,LSTOUT,ISPFRM,
     &                     ISPOUT,ICACH1,ICACH2)
C
C MOVES LIST ISPFRM,LSTFRM TO ISPOUT,LSTOUT.  
C
C       T2  - SCRATCH USED FOR THE LIST.
C    NDSSIZ - THE DISTRIBUTION SIZE FOR THE LIST.
C    NUMDIS - THE NUMBER OF DISTRIBUTIONS IN THE LIST.
C    ICACH1 - THE I/O CACHE TO BE USED FOR THE GETLST OPERATION.
C    ICACH2 - THE I/O CACHE TO BE USED FOR THE PUTLST OPERATION.
C
   
      SUBROUTINE MVSYM(ICORE,MAXCOR,IUHF,ICACHE,LIST1,LIST2)
C
C MOVES SYMMETRY PACKED LIST LIST1 TO SYMMETRY PACKED LIST LIST2.
C
      SUBROUTINE NEWEVC(EVEC,SCR,NBAS,ISPIN)
C
C THIS ROUTINE REORDERS AN EIGENVECTOR MATRIX FROM THE MO ORDERING
C  TO SCF ORDERING FOR A SPECIFIC SPIN CASE
C
      SUBROUTINE NEWT2(ICORE,MAXCOR,IUHF)
C
C THIS ROUTINE PICKS UP THE FINAL T2 OR T2 INCREMENTS, DENOMINATOR
C  WEIGHTS THEM AND THEN OVERWRITES THE T2 INCREMENT LIST WITH THE NEW VALUES.
C  GOES ONE IRREP AT A TIME OVER ALL SPIN CASES.  FOR RHF CASES,
C  IT ALSO CALLS A ROUTINE WHICH FORMS THE AA AMPLITUDES FROM THE 
C  AB VALUES.
C

      SUBROUTINE NEWTYP(LIST,SYTYPL,SYTYPR,CHANGE)
C
C THIS ROUTINE CHANGES THE CHARACTERISTICS OF A LIST, AND
C  SHOULD BE USED ONLY BY EXPERIENCED CRAPS PROGRAMMERS!
C  
C INPUT: LIST   - THE LIST NUMBER WHICH IS TO BE CHANGED.
C        SYTYPL - THE NEW SYMMETRY TYPE FOR THE BRA INDICES.
C        SYTYPR - THE NEW SYMMETRY TYPE FOR THE KET INDICES.
C        CHANGE - LOGICAL VARIABLE WHICH CONTROLS WHETHER OR
C                 NOT THE CORRESPONDING ISYTYP ENTRIES ARE
C                 CHANGED TO CORRESPOND TO THE NEW LIST TYPE.
C                 SET THIS TO .TRUE. UNLESS YOU REALLY KNOW
C                 WHAT YOU ARE DOING.
C




        
      SUBROUTINE NHFENG(ICORE,MAXCOR,ETOT,NLIST2,NLIST1,NLIST1A,IUHF,
     &                  DOTAU)
C
C  DRIVER FOR THE CALCULATION OF THE CORRELATION ENERGY FOR A GIVEN SET
C  OF AMPLITUDES WHICH IS USED IN ROHF PERTURBATION THEORY CALCULATIONS
C 
C  ARGUMENTS :  ICORE ..... ICORE ARRAY
C               MAXCOR .... DIMENSION OF ICORE
C               NLIST2 .... OFFSET OF T2 LIST ON MOINTS (WITH RESPECT TO
C                            TYPE)
C               NLIST1 .... OFFSET OF T1 LISTS ON MOINTS (WITH RESPECT TO
C                            SPIN TYPE) FOR F-T1 PIECE
C               NLIST1 .... OFFSET OF T1 LISTS ON MOINTS (WITH RESPECT TO
C                            SPIN TYPE) FOR W-T1**2 PIECE
C               TECORR ..... RETURNS THE CORRELATION ENERGY FOR ALL SPIN CASES
C               IUHF .....  IUHF FLAG
C
      SUBROUTINE OPENMO(IUNIT,NAME)
C
C OPENS THE MOINTS FILE WITH THE RECORD LENGTH SPECIFIED IN ROUTINE
C   MCHPRM.
C
      SUBROUTINE OPNFIL(IUNIT)
C
C OPENS THE WORD ADDRESSABLE DIRECT ACCESS FILES USED BY CRAPS
C
      SUBROUTINE PCKIND(IVALUE,ISPIN,SYVEC1,SYVEC2,NSMSZ1,NSMSZ2,
     &                  I,J,A,B)
C
C THIS ROUTINE RETURNS I,J,A AND B FOR IVALUE, WHICH IS THE ABSOLUTE
C  OFFSET IN THE SYMMETRY PACKED LIST.  T
C  IF ISPIN IS 1 OR 2, THE LIST STRUCTURE IS ASSUMED TO BE A<B;I<J AND
C  a<b;i,j RESPECTIVELY.  IF ISPIN IS 3, IT IS ASSUMED TO BE A,b;I,j.
C  NDISSZ IS THE SIZE OF THE DISTRIBUTIONS.
C
        SUBROUTINE PIKSR2(N,ARR,NLIST)
C
C SIMPLE SORTER FROM NUMERICAL RECIPES.
C
      SUBROUTINE POPCORN(MEMSIZ)
C
C INITIALIZES I/O SYSTEM COMMON BLOCKS.  DEPENDENT OF CRAPSI, 
C  SHOULD PROBABLY *NEVER*
C  BE CALLED EXPLICITLY.
C
      SUBROUTINE PRVECI(IVEC,LENGTH)
C
C ROUTINE PRINTS FIRST LENGTH ELEMENTS OF INTEGER VECTOR IVEC,
C  ALONG WITH THE CORRESPONDING INDICES IN I5,I6 FORMAT.
C
      SUBROUTINE PRVECR(VEC,LENGTH)
C
C THIS ROUTINE PRINTS THE FIRST LENGTH ELEMENTS OF VECTOR VEC
C  AND THEIR INDICES IN I3,F13.10 FORMAT.  USEFUL FOR QUANTITIES
C  WHICH HAVE MAGNITUDES COMPARABLE TO INTEGRALS AND AMPLITUDES.
C
      SUBROUTINE PTSLST(ZLIST,NSTART,NBLOCK,NUMDIS,USECIN,ISPIN,ITYPE,
     &                  GETIRP,NIRREP,NUMIRR,IBUF,ZBUF)
C
C THIS ROUTINE SERVES A FUNCTION SIMILAR TO PUTLST, EXCEPT THAT IT ACCEP
C  SYMMETRY PACKED LISTS AND WRITES THEM OUT UNPACKED.
C
C INPUT:
C
C     GETIRP= THE IRREDUCIBLE REPRESENTATION CORRESPONDING TO THE
C              DIRECT PRODUCT OF THE TWO INDIVIDUAL DISTRIBUTION ELEMENT
C     NSTART= THE NUMBER OF THE FIRST DISTRIBUTION *WITHIN THE SYMMETRY
C              BLOCK* THAT IS TO BE WRITTEN.
C     NBLOCK= THE NUMBER OF DISTRIBUTIONS WHICH ARE TO BE WRITTEN.
C     NUMDIS= THE TOTAL NUMBER OF DISTRIBUTIONS (*NOT* THE TOTAL NUMBER
C              OF SYMMETRY BLOCK DISTRIBUTIONS).
C     USECIN= THE I/O CACHE TO BE USED.
C     ISPIN = THE I OF MOIO(I,J).
C     ITYPE = THE J OF MOIO(I,J).
C     NIRREP= THE TOTAL NUMBER OF IRREDUCIBLE REPRESENTATIONS.
C     NUMIRR= POPULATION COUNT SYMMETRY VECTORS (SEE JOBARC LIST).
C             THE FIRST NIRREP ELEMENTS CORRESPOND TO THE DISTRIBUTIONS
C             WHILE THE LAST NIRREP ELEMENTS REFER TO THE DISTRIBUTION
C             MEMBERS.  THESE CAN BE FORMED IN GETGSV. [LENGTH: 2*NIRREP
C     IBUF  = SYMMETRY VECTORS (SEE JOBARC LIST).
C             THE FIRST NUMDIS MEMBERS REFER TO THE DISTRIBUTIONS WHILE
C             THE LAST LENGTH MEMBERS REFER TO THE DISTRIBUTION MEMBERS.
C             [LENGTH: LENGTH+NUMDIS].
C
C SCRATCH:
C
C     ZBUF  = SCRATCH VECTOR USED AS A TARGET VECTOR IN SCATTER
C             OPERATIONS.     [LENGTH: LENGTH]
C
C OUTPUT:
C
C     ZLIST = THE SYMMETRY PACKED LIST. [LENGTH: NBLOCK*NUMIRR(NIRREP+GE
C
      SUBROUTINE PUTALL(Z,LENGTH,ICACHE,LSTNUM)
C
C THIS ROUTINE WRITES OUT ALL IRREPS OF A SYMMETRY PACKED DISTRIBUTION.
C
C      Z  - VECTOR HOLDING THE LIST.
C  LENGTH - THE TOTAL LENGTH.
C  ICACHE - THE CACHE TO BE USED IN I/O OPERATIONS.
C  LSTNUM - THE LIST NUMBER WHICH Z IS WRITTEN TO.
C
      SUBROUTINE PUTFAST(Z,IFIRST,NDIS,ISPIN,ITYPE)
C
C THIS ROUTINE DOES A FAST IN-CORE PUT OF A LIST HELD IN
C  THE AUXILIARY CACHE
C
      SUBROUTINE PUTLST(ZLIST,NFIRST,NBLOCK,USECXN,ISPIN,ITYPE)
C
C THIS SUBROUTINE RETRIEVES NBLOCK DISTRIBUTIONS OF A PARTICULAR INTEGRA
C  LIST, BEGINNING WITH DISTRIBUTION NFIRST.  THE VALUES ARE RETURNED IN
C  VECTOR ZLIST.
C
C   OUTPUT:
C
C         ZLIST - THE TARGET VECTOR USED IN I/O OPERATIONS.
C
C   INPUT PARAMETERS:
C
C         NFIRST- THE NUMBER OF THE FIRST DISTRIBUTION WHICH WILL BE
C                 WRITTEN TO OR READ FROM DISK.
C         NBLOCK- THE NUMBER OF DISTRIBUTIONS WHICH WILL BE HANDLED.
C         USECIN- THE CACHE BUFFER WHICH IS TO BE USED FOR I/O OPERATION
C                 BEST PERFORMANCE IS ACHIEVED IF THIS IS SET TO 1 FOR
C                 T AMPLITUDE I/O AND 2 FOR INTEGRAL I/O.
C         ISPIN - THE LEFT-HAND INDEX OF THE LIST [MOIO(ISPIN,ITYPE)].
C         ITYPE - THE RIGHT-HAND INDEX OF THE LIST [MOIO(ISPIN,ITYPE)].
C
C  MOIO PARAMETERS (FROM COMMON BLOCK /LISTS/):
C
C        >>>ALL OF THESE VALUES ARE COMPUTED BY ROUTINE UPDMOI<<<
C
C         MOIO(ISPIN,ITYPE)  - THE PHYSICAL RECORD NUMBER ON WHICH
C                              LIST ITYPE[ISPIN] BEGINS.
C         MOIOWD(ISPIN,ITYPE)- THE WORD ADDRESS AT WHICH LIST
C                              ITYPE[ISPIN] BEGINS.
C         MOIODS(ISPIN,ITYPE)- THE NUMBER OF TOTAL DISTRIBUTIONS
C                              IN LIST ITYPE[ISPIN].
C         MOIOSZ(ISPIN,ITYPE)- THE SIZE OF THE INDIVIDUAL DISTRIBUTIONS
C                              IN LIST ITYPE[ISPIN] (IN *FLOATING-POINT*
C                              WORDS.
C         MOIOFL(ISPIN,ITYPE)- THE FILE ON WHICH THE LIST RESIDES.
C
      SUBROUTINE PUTREC(LUJNK,FILNAM,LABEL,LENGTH,ISTUFF)
C
C THIS ROUTINE PUTS A LOGICAL RECORD ON THE JOBARC FILE.
C
C   INPUT:
C         LUJNK - INTEGER -- ignored
C         FILNAM- CHARACTER*(*) ignored
C         LABEL - IDENTIFIER FOR LOGICAL RECORD.  CHARACTER*(*) STRING.
C         LENGTH- LENGTH OF LOGICAL RECORD IN *INTEGER* WORDS.
C         ISTUFF- CONTENTS OF LOGICAL RECORD.
C
      SUBROUTINE PUTTRN(Z,BUF,NDSSIZ,NUMDIS,ICACHE,ISPIN,ITYPE)
C
C THIS ROUTINE RETRIEVES THE TRANSPOSE OF A LIST ON DISK.  IT IS
C  SPECIFICALLY FOR CASES IN WHICH THE ENTIRE LIST CAN BE HELD IN CORE.
C
C  INPUT:
C         NDSSIZ - ACTUAL DISTRIBUTION SIZE OF LIST ON DISK.
C         NUMDIS - NUMBER OF DISTRIBUTIONS ON DISK.
C         ICACHE - I/O CACHE TO BE USED.
C          ISPIN - SPIN OR IRREP SPECIFIER FOR LIST.
C          ITYPE - LIST NUMBER.
C              Z - THE TRANSPOSED LIST, TREATED AS A MATRIX WITH
C                   DIMENSIONS (NUMDIS,NDSSIZ).
C  SCRATCH:
C            BUF - INTERMEDIATE ARRAY HOLDING DISTRIBUTIONS (SIZE: NDSSIZ)
C     
   
   
      SUBROUTINE RDDIR(IUNIT,IREC,IVEC,LENGTH,IMOD)
C
C READS A RECORD FROM DIRECT ACCESS UNIT IUNIT.
C
C  INPUT:
C        IUNIT - UNIT NUMBER FOR DIRECT ACCESS FILE.
C        IREC  - NUMBER OF RECORD TO BE READ.
C        LENGTH- LENGTH OF VECTOR IN *INTEGER* WORDS.
C        IMOD  - RETURNED AS ZERO.
C
C        IVEC  - CONTENTS OF RECORD IREC.
C
      SUBROUTINE RDSEQ(IUNIT,IVEC,LENGTH)
C
C READS AN INTEGER VECTOR OF LENGTH IVEC FROM SEQUENTIAL ACCESS
C  UNIT IUNIT.
C
      SUBROUTINE RLELST(ICORE,MAXCOR,IUHF,SINGLE,RLETYP)
C
C THIS ROUTINE CREATES THE T AMPLITUDE LISTS USED BY THE 
C  RLE PROGRAM.
C
      SUBROUTINE RLEVEC(ICORE,MAXCOR,IUHF,TAU,IORDER,SINGLE,E,
     &                  RLETYP)
C
C THIS ROUTINE FORMS AN EXTRAPOLATED T VECTOR ACCORDING TO THE
C  RLE TAU VECTOR.
C
C   T2(new) = [1 - SUM TAU(k)] T(1) + SUM TAU(k) * T(k)
C                   k                  k
      DOUBLE PRECISION FUNCTION RMSVEC(VEC,LENGTH,TOL)
C
C RETURNS THE RMS VALUE OF THE FIRST LENGTH ELEMENTS IN VECTOR VEC.  VALUES
C  BELOW TOL ARE NOT CONSIDERED.
C
      SUBROUTINE RNABIJ(ICORE,MAXCOR,IUHF,TYPE)
C
C THIS SUBROUTINE DRIVES THE FORMATION OF THE RESORTED <Ab|Ij>
C  AND <AB||IJ> INTEGRALS OR T(Ab;Ij) AND T(AB;IJ) AMPLITUDES AND 
C  WRITES THEM TO DISK.
C
C    INPUT - TYPE (CHARACTER*1): 'W' FOR INTEGRAL RESORTS.
C                                'T' FOR T2 VECTOR RESORTS.
C                                'L' FOR L2 VECTOR RESORTS.
C                                'R' FOR T2 INCREMENT RESORTS.
C
C    FOR RHF, THE AI-bj, Aj-bI AND AI-BJ PACKED LISTS ARE WRITTEN.
C    FOR UHF, THE bj-AI, bI-Aj AND ai-bj PACKED LISTS ARE ALSO WRITTEN.
C
      SUBROUTINE ROLLT(ICORE,MAXCOR,IUHF,RLECYC,SINGLE,IENTRY,
     &                 RLETYP,LAMBDA)
C
C UPDATES THE RLE T AMPLITUDE AREA.  IENTRY = -1 PUTS THE 
C  INITIAL T AMPLITUDE ONTO LIST 70.  FOR NONHF CASES, THEN
C  WE HAVE TO ALSO PUT OUT THE T1 AMPLITUDES.
C
      SUBROUTINE S2PROJ(ICORE,MAXCOR,IUHF,SINGLE)
C
C THIS ROUTINE CALCULATES THE PROJECTED VALUE OF THE
C  NORMAL ORDERED S**2 OPERATOR, WHICH REPRESENTS THE
C  CORRELATION CORRECTION TO THE S**2.  THE FORMULA USED
C  IS:
C
C  <0|S**2 exp(T)|0> = SUM T(A,I) * P(A,I) - SUM T(a,i) * P(a,i)
C
C                     - T(Ab,Ij) * DELTA(b,I) * DELTA(A,j)
C
C WHERE:
C
C                 P(A,I) = SUM DELTA(J,e) * DELTA(e,A)
C                           e
C
C                 P(a,i) = SUM DELTA(a,J) * DELTA(J,i)
C      
C AND DELTA(p,Q) ARE ELEMENTS OF THE VIRTUAL-OCCUPIED ALPHA-BETA
C  MO OVERLAP MATRIX.
C
      SUBROUTINE SAXLST(ICORE,MAXCOR,LSTINA,LSTINB,LSTOUT,FA,FB)
C
C THIS ROUTINE READS TWO LISTS, A AND B, AND FORMS A THIRD
C (C) WHICH IS EQUAL TO FA * A + FB * B.  LISTS A AND B ARE
C READ FROM LSTINA AND LSTINB AND THE RESULTANT C IS WRITTEN
C TO LSTOUT.  THE SIZES ARE ASSUMED TO BE THE SAME (NSIZE).
C
 
      SUBROUTINE SCANVC(V,VE,IE,NUMEL,LEN)
C
C THIS ROUTINE SCANS A VECTOR AND PLACES THE NUMEL LARGEST
C  ELEMENTS IN VE AND THEIR INDICES IN IE.
C
C INPUT:
C       V - THE VECTOR TO BE SEARCHED (LENGTH: LEN).
C      VE - THE VECTOR WHICH CONTAINS THE NUMEL LARGEST ABSOLUTE
C           VALUES IN V (LENGTH: LEN).
C      IE - THE INDICES CORRESPONDING TO THE ENTRIES IN VE (LENGTH: LEN).
C
 
      SUBROUTINE SETUP2(ICORE,ICRSIZ,I010,I020,I030,LIST1,LIST2,
     &                  NUMDIS,NDSSIZ)
C
C THIS ROUTINE RETURNS THE SYMMETRY INFORMATION ABOUT THE LIST
C   ON MOIO(LISTT1,LISTT2),ALONG WITH
C   OFFSETS INTO THE CORE ARRAY WHERE THESE LISTS BEGIN.
C
C       ICORE - CORE VECTOR (PASSED IN)
C       ICRSIZ- SIZE OF WORKING AREA.
C       I010  - OFFSET TO BEGINNING OF THE POPULATION COUNT VECTOR FOR
C                THE LIST.
C       I020  - OFFSET TO BEGINNING OF THE SYMMETRY VECTOR FOR
C                THE LIST.
C       I030  - TOTAL CORE REQUIRED FOR SYMMETRY INFORMATION.
C       LIST1 - THE SYMMETRY TYPE FOR THE LIST "SPIN CASE".
C       LIST2 - THE SYMMETRY TYPE FOR THE LIST DISTRIBUTION TYPE.
C       NUMDIS- TOTAL NUMBER OF DISTRIBUTIONS (IN C1).
C       NDSSIZ- SIZE OF DISTRIBUTIONS (IN C1).
C
      SUBROUTINE SETUP3(ICORE,ICRSIZ,I010,I020,I030,LIST1,LIST2,
     &                  NUMDIS,NDSSIZ)
C
C THIS ROUTINE RETURNS THE  (INVERSE) SYMMETRY INFORMATION ABOUT THE LIST
C   ON MOIO(LISTT1,LISTT2),ALONG WITH
C   OFFSETS INTO THE CORE ARRAY WHERE THESE LISTS BEGIN.
C
C       ICORE - CORE VECTOR (PASSED IN)
C       ICRSIZ- SIZE OF WORKING AREA.
C       I010  - OFFSET TO BEGINNING OF THE POPULATION COUNT VECTOR FOR
C                THE LIST.
C       I020  - OFFSET TO BEGINNING OF THE SYMMETRY VECTOR FOR
C                THE LIST.
C       I030  - TOTAL CORE REQUIRED FOR SYMMETRY INFORMATION.
C       LIST1 - THE SYMMETRY TYPE FOR THE LIST "SPIN CASE".
C       LIST2 - THE SYMMETRY TYPE FOR THE LIST DISTRIBUTION TYPE.
C       NUMDIS- TOTAL NUMBER OF DISTRIBUTIONS (IN C1).
C       NDSSIZ- SIZE OF DISTRIBUTIONS (IN C1).
C
      SUBROUTINE SETUPS(ICORE,ICRSIZ,I010,I020,I030,I040,I050,LISTW1,
     &                  LISTW2,LISTT1,LISTT2,NWDIS,NWDSZ,NT2DIS,
     &                  NT2DSZ)
C
C THIS ROUTINE RETURNS THE SYMMETRY INFORMATION ABOUT THE LISTS
C   ON MOIO(LISTT1,LISTT2) AND MOIO(LISTW1,LISTW2), ALONG WITH
C   OFFSETS INTO THE CORE ARRAY WHERE THESE LISTS BEGIN.
C
C       ICORE - CORE VECTOR (PASSED IN)
C       ICRSIZ- SIZE OF WORKING AREA.
C       I010  - OFFSET TO BEGINNING OF THE POPULATION COUNT VECTOR FOR
C                THE MOIO(LISTW1,LISTW2) LIST.
C       I020  - OFFSET TO BEGINNING OF THE SYMMETRY VECTOR FOR
C                THE MOIO(LISTW1,LISTW2) LIST.
C       I030  - OFFSET TO BEGINNING OF THE POPULATION COUNT VECTOR FOR
C                THE MOIO(LISTT1,LISTT2) LIST.
C       I040  - OFFSET TO BEGINNING OF THE SYMMETRY VECTOR FOR
C                THE MOIO(LISTT1,LISTT2) LIST.
C       I050  - TOTAL CORE REQUIRED FOR SYMMETRY INFORMATION.
C       LISTT1- "SPIN CASE" FOR THE T LIST.
C       LISTT2- LIST TYPE FOR T LIST.
C       LISTW1- "SPIN CASE" FOR THE W LIST.
C       LISTW2- LIST TYPE FOR THE W LIST.
C       NWDIS - TOTAL NUMBER OF W DISTRIBUTIONS (IN C1).
C       NWDSZ - SIZE OF W DISTRIBUTIONS (IN C1).
C       NT2DIS- TOTAL NUMBER OF T DISTRIBUTIONS (IN C1).
C       NT2DSZ- SIZE OF T DISTRIBUTIONS (IN C1).
C
      SUBROUTINE SHIFTV(RV,IV,ISKIP,NUMEL)
C
C THIS ROUTINE ACCEPTS VECTORS RV AND IV AND PERFORMS THE
C  FOLLOWING OPERATION: IT LEAVES ENTRIES 1-ISKIP UNCHANGED,
C  AND OVERWRITES RV(J) AND IV(J) WITH RV(J-1) AND IV(J-1)
C  RESPECTIVELY FOR ALL J-1 .GE. ISKIP.  THE VECTORS BOTH HAVE
C  LENGTH NUMEL.  RV IS DOUBLE PRECISION AND IV IS INTEGER.
C  THIS ROUTINE IS A DEPENDENT OF SCANVC.
C

      SUBROUTINE SORTT1(ICORE,MAXCOR,ISPIN,ILIST,NTOP,TYPE)
C
C DRIVER FOR ROUTINE WHICH PICKS UP THE T1 VECTOR FROM DISK FOR A 
C  SPIN CASE AND FIND THE NTOP LARGEST ELEMENTS BY MAGNITUDE.  THESE ARE
C  PRINTED OUT AT THE END OF THE ROUTINE.
C

      SUBROUTINE SORTT2(ICORE,MAXCOR,ISPIN,ILIST,NTOP,TYPE)
C
C DRIVER FOR ROUTINE WHICH PICKS UP THE T2 VECTOR FROM DISK FOR A 
C  SPIN CASE AND FIND THE NTOP LARGEST ELEMENTS BY MAGNITUDE.  THESE ARE
C  PRINTED OUT AT THE END OF THE ROUTINE.
C
      SUBROUTINE SPINAD1(IRREP,NUM1,DIS,A,SCR,ISCR)
C
C THIS ROUTINE SPIN ADAPTS A MATRIX A BY
C
C  A(I,J,K,L) ----> 2*A(I,J,K,L)-A(I,J,L,K) 
C
C NOTE THAT THE SPIN ADAPTION IS CARRIED OUT HERE IN PLACE AND
C ONLY TWO ADDITIONAL ARRAYS OF SIZE NUM ARE REQUIRED
C
C INPUT : IRREP .......... IRREP OF THE GIVEN PAR OF A
C         NUM1 ........... POPULATION VECTOR OF I AND J
C         DIS ............ DISTRIBUTION SIZE OF A
C         A .............. INPUT MATRIX A
C         SCR,ISCR ....... TWO SCRATCH ARRAYS OF DIMENSION DIS
C
C  OUTPUT : A ............ SPIN ADAPTED MATRIX A
C 

      SUBROUTINE SPINAD3(IRREP,NUM1,DIS,NUM,A,SCR,ISCR)
C
C THIS ROUTINE SPIN ADAPTS A MATRIX A BY
C
C  A(I,J,K,L) ----> 2*A(J,I,K,L)-A(I,J,K,L) 
C
C NOTE THAT THE SPIN ADAPTION IS CARRIED OUT HERE IN PLACE AND
C ONLY TWO ADDITIONAL ARRAYS OF SIZE NUM ARE REQUIRED
C
C INPUT : IRREP .......... IRREP OF THE GIVEN PAR OF A
C         NUM1 ........... POPULATION VECTOR OF I AND J
C         DIS ............ DISTRIBUTION SIZE OF A
C         NUM ............ NUMBER OF DISTRIBUTIONS IN A
C         A .............. INPUT MATRIX A
C         SCR,ISCR ....... TWO SCRATCH ARRAYS OF DIMENSION NUM
C
C  OUTPUT : A ............ SPIN ADAPTED MATRIX A
C 

      SUBROUTINE SPSTST(VEC,LEN,TOL,SPARSE)
C
C RETURNS THE SPARSITY LEVEL OF THE FIRST LEN ELEMENTS OF VEC, EXPRESSED
C  AS A DECIMAL FRACTION.  TOLERANCE IS SET BY TOL.
C
      SUBROUTINE SQ3SYM(IRREP,NUM,DSZ,A,B)
C
C     THIS ROUTINE SQUEEZES AN SYMMETRY
C     PACKED ARRAY
C
C     A(AB,IJ) = B(AB,IJ)   I.LE.J IN A AND I,J IN B
C
C
C     INPUT : IRREP = IRREP OF (A,B) BLOCK
C             NUM = POPULATION IN EACH IRREP FOR I AND J
C             DSZ = DISTRIBUTION SIZE IN INPUT AND OUTPUT ARRAY
C             B = INPUT ARRAY WITH ELEMENTS TO BE ANTISYMMTRIZED
C     OUTPUT : A = ANTISYMMETRIZED OUTPUT ARRAY
C
      SUBROUTINE SQ4SYM(IRREP,NUM,DSZA,DSZB,NUMSIZ,A,B)
C
C     THIS ROUTINE SQUEEZES A SYMMETRY PACKED ARRAY
C
C     A(AB,IJ) = B(AB,IJ)  A LE B IN A AND A,B IN B
C
C     B IS AN ARRAY WITH ALL A,B ELEMENTS STORED
C     A AN ARRAY WITH ALL A<B ELEMENTS STORED
C
C     INPUT : IRREP = IRREP OF (A,B) BLOCK
C             NUM = POPULATION IN EACH IRREP FOR I AND J
C             DSZA = DISTRIBUTION SIZE IN OUTPUT ARRAY
C             DSZB = DISTRIBUTION SIZE IN INPUT ARRAY
C             NUMSIZ = NUMBER OF DISTRIBUTIONS IN A AND B
C             B = INPUT ARRAY WITh ELEMENTS TO BE ANTISYMMTRIZED
C     OUTPUT : A = ANTISYMMETRIZED OUTPUT ARRAY
C
      SUBROUTINE SQSYM(IRREP,NUM,DSZA,DSZB,NUMSIZ,A,B)
C
C     THIS ROUTINE SQUEEZES A SYMMETRY PACKED ARRAY
C
C     A(AB,IJ) = B(AB,IJ)  A<B IN A AND A,B IN B
C
C     B IS AN ARRAY WITH ALL A,B ELEMENTS STORED
C     A AN ARRAY WITH ALL A<B ELEMENTS STORED
C
C     INPUT : IRREP = IRREP OF (A,B) BLOCK
C             NUM = POPULATION IN EACH IRREP FOR I AND J
C             DSZA = DISTRIBUTION SIZE IN OUTPUT ARRAY
C             DSZB = DISTRIBUTION SIZE IN INPUT ARRAY
C             NUMSIZ = NUMBER OF DISTRIBUTIONS IN A AND B
C             B = INPUT ARRAY WITh ELEMENTS TO BE ANTISYMMTRIZED
C     OUTPUT : A = ANTISYMMETRIZED OUTPUT ARRAY
C
      SUBROUTINE SQUEEZ(V,N,IDIAG)
C
C ROUTINE ACCEPTS A SYMMETRIC MATRIX V, AND THEN RETURNS THE
C RESULT IN PACKED I.LE.J TRIANGULAR FORM.  THE DIAGONAL IS INCLUDED IF
C IDIAG IS SET TO 0, AND NOT INCLUDED IF IDIAG = 1.
C
 
      SUBROUTINE SQUEZ2(VFULL,VPACK,NSIZE)
C
C THIS ROUTINE ACCEPTS AN INPUT NSIZE x NSIZE SQUARE MATRIX [VFULL]
C  AND CONSTRUCTS THE PACKED LOWER TRIANGULAR MATRIX VPACK [LENGTH:
C  (VFULL*VFULL+1)/2
C
       SUBROUTINE SST002(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX LIST AND RETURNS
C   THE SAME LIST BUT WITH AN ALTERNATIVE SCHEME FOR SYMMETRY PACKING.
C
C THE LIST (A,b;I,j) IS PRESUMED TO BE PACKED Ab-Ij.  THIS ROUTINE RETURNS
C   THE LIST PACKED IN TWO POSSIBLE WAYS (SEE BELOW).
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AB-IJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AABB' FOR (AI-bj) RETURNED
C                        'BBAA' FOR (bj-AI) RETURNED
C
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED AI-bj OR bj-AI LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. 
C                   (SIZE: NVRTA*NVRTB+NOCCA*NOCCB+NVRTA*NOCCB+
C                          NVRTA*NOCCA+NVRTB*NOCCB)
C         





       SUBROUTINE SST003(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE,RERDTP)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX LIST AND RETURNS
C   THE SAME LIST BUT WITH AN ALTERNATIVE SCHEME FOR SYMMETRY PACKING.
C
C THE LIST (A<B;I<J) IS PRESUMED TO BE PACKED AB-IJ.  THIS ROUTINE RETURNS
C   THE LIST AS (A,I;B,J) PACKED AS AI-BJ OR AJ-BI (THESE POSSIBILITIES
C   DIFFER BY A SIGN).
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AB-IJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AAAA' FOR (AB-IJ)
C                        'BBBB' FOR (ab-ij)
C         RERDTP - 'AIBJ' FOR AI-BJ POSITIVE, 'AJBI' FOR AJ-BI POSITIVE.
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED AI-bj OR bj-AI LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. 
C                   (SIZE: NVRT*(NVRT-1)/2+NOCC*(NOCC-1)/2+NOCC*NVRT)
C         
       SUBROUTINE SST004(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX LIST AND RETURNS
C   THE SAME LIST BUT WITH AN ALTERNATIVE SCHEME FOR SYMMETRY PACKING.
C
C THE LIST (A,B;I,J) IS PRESUMED TO BE PACKED AB-IJ.  THIS ROUTINE RETURNS
C   THE LIST PACKED IN TWO POSSIBLE WAYS (SEE BELOW).
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AB-IJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AAAA' FOR (AI-BJ) RETURNED
C                        'BBBB' FOR (ai-bj) RETURNED
C
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED AI-BJ or ai-bj LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. 
C                   (SIZE: NVRT*NVRT+NOCC*NOCC+NVRT*NOCC)
C         





       SUBROUTINE SST02I(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX LIST AND RETURNS
C   THE SAME LIST BUT WITH AN ALTERNATIVE SCHEME FOR SYMMETRY PACKING.
C
C THE LIST (A,b;I,j) IS PRESUMED TO BE PACKED AI-bj OR ai-BJ.  
C   THIS ROUTINE RETURNS THE LIST PACKED AS Ab;Ij.  IN A SENSE,
C   THIS ROUTINE FUNCTIONS AS THE INVERSE OF SST002, HENCE ITS NAME.
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AB-IJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AABB' FOR (AI-bj).
C                        'BBAA' FOR (bj-AI).
C
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED Ab-Ij LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. 
C                   (SIZE: NVRTA*NVRTB+NOCCA*NOCCB+NVRTA*NOCCB+
C                          NVRTA*NOCCA+NVRTB*NOCCB)
C         





       SUBROUTINE SST03I(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE)
C
C THIS ROUTINE ANTISYMMETRIZES THE RING INCREMENT LIST FOR AA AND BB
C   SPIN CASES. 
C
C THE INCREMENT LIST (A,J;B,I) IS PRESUMED TO BE PACKED AJ-BI.  THIS 
C   ROUTINE RETURNS THE ANTISYMMETRIZED INCREMENT LIST AS (A<B;I<J) PACKED
C   AS AB-IJ.  THIS ROUTINE FUNCTIONS AS THE INVERSE OF ROUTINE SST
C   THE LIST AS (A<B;I<J) PACKED AS AB-IJ.  
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AB-IJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AAAA' FOR (AJ-BI)
C                        'BBBB' FOR (aj-bi)
C
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED A<B-I<J OR a<b-i<j LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. 
C                   (SIZE: NVRT*(NVRT-1)/2+NOCC*(NOCC-1)/2+NOCC*NVRT)
C         





       SUBROUTINE SSTRNG(WIN,WOUT,NSIZIN,NSIZOT,ISCR,SPTYPE)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX LIST AND RETURNS
C   THE SAME LIST BUT WITH AN ALTERNATIVE SCHEME FOR SYMMETRY PACKING.
C
C THE LIST (A,I;B,J) IS PRESUMED TO BE PACKED AI-BJ.  THIS ROUTINE RETUR
C   THE LIST PACKED AJ-BI.  USEFUL FOR RINGS AND ALSO FOR THE T1 CONTRIB
C   TO THE RING INTERMEDIATE.  
C
C INPUT: 
C           WIN  - THE SYMMETRY PACKED AI-BJ LIST.
C         NSIZIN - THE TOTAL SIZE OF THE SYM. PACKED INPUT VECTOR.
C         NSIZOT - THE TOTAL SIZE OF THE SYM. PACKED OUTPUT VECTOR.
C         SPTYPE - THE SPIN TYPE FOR THE INPUT LIST
C
C                        'AAAA' FOR (AI-BJ)  (AJ-BI returned)
C                        'BBBB' FOR (ai-bj)  (aj-bi returned)
C                        'ABAB' FOR (Ai-Bj)  (Aj-Bi returned)
C                        'BABA' FOR (aI-bJ)  (aJ-bI returned)
C                        'ABBA' FOR (Ai-bJ)  (AJ-bi returned (type AABB)
C                        'BAAB' FOR (aI-Bj)  (aj-BI returned (type BBAA)
C                        'AABB' FOR (AI-bj)  (Aj-bI returned (type ABBA)
C                        'BBAA' FOR (ai-BJ)  (aJ-Bi returned (type BAAB)
C
C OUTPUT: 
C          WOUT  - THE SYMMETRY PACKED AJ-BI LIST.
C       
C SCRATCH:
C         ISCR   - SCRATCH AREA TO HOLD THE SYMMETRY VECTORS AND INVERSE
C                   SYMMETRY VECTORS WHICH ARE NEEDED. (SIZE: 2*NOCCI*NV
C                   IF SPCASE IS AAAA, BBBB, ABAB OR BABA; 
C                   NVRTA*(NOCCI+NOCCJ)+NVRTB(NOCCI+NOCCJ) OTHERWISE.
C         





      SUBROUTINE SUMLST(ISPIN,LIST1,LIST2,Z,T2,NDSSIZ,NDIS)
C
C SUMS LIST (ISPIN,LIST1) AND (ISPIN,LIST2) AND THEN OVERWRITES
C  (ISPIN,LIST2) WITH THE SUM.  
C
      SUBROUTINE SUMSYM(Z,TARGET,MAXSIZ,NLIST)
C
C SUMS CONTENTS ON LIST NLIST WITH Z AND OVERWRITES NLIST WITH
C  RESULT.
C
C INPUT: 
C            Z    - INCREMENT VECTOR (LENGTH: MAXSIZ)
C          TARGET - SCRATCH TO HOLD VECTOR WITH WHICH Z IS SUMMED
C                   (LENGTH: MAXSIZ)
C          MAXSIZ - THE LENGTH OF THE LARGEST OF THE NIRREP
C                    SYMMETRY SUBLISTS FOR LIST1 AND LIST2.
C           NLIST - ONE OF THE LISTS WHICH IS SUMMED.
C
C SCHEMATICALLY, THE OPERATION IS:
C
C            LIST2=LIST2+LIST1  
C  
C  WITH LIST2 BEING OVERWRITTEN WITH THE RESULT.
C
      SUBROUTINE SUMSYM2(Z,SCR,LENZ,ICACHE,IRREP,NLIST)
C
C THIS ROUTINE AUGMENTS LIST (IRREP,NLIST) WITH THE INPUT VECTOR
C  Z AND THEN OVERWRITES (IRREP,NLIST) WITH THE RESULT.
C
C INPUT: 
C        Z - THE INCREMENT WHICH IS TO BE ADDED TO THE LIST. (LENGTH: LENZ)
C      SCR - SCRATCH AREA TO HOLD CURRENT CONTENTS OF (IRREP,NLIST) AND
C             ITS SUM WITH Z.
C     LENZ - THE LENGTH OF THE LIST.
C   ICACHE - THE I/O CACHE TO BE USED.
C    IRREP - THE IRREDUCIBLE REPRESENTATION TO BE SUMMED.
C    NLIST - THE LIST NUMBER.
C

      SUBROUTINE SUMSYM3(Z,SCR,LENZ,ICACHE,IRREP,NLIST)
C
C THIS ROUTINE AUGMENTS A TWO-INDEX LIST (1,NLIST) WITH THE INPUT VECTOR
C  Z AND THEN OVERWRITES (1,NLIST) WITH THE RESULT.
C
C INPUT: 
C        Z - THE INCREMENT WHICH IS TO BE ADDED TO THE LIST. (LENGTH: LENZ)
C      SCR - SCRATCH AREA TO HOLD CURRENT CONTENTS OF (IRREP,NLIST) AND
C             ITS SUM WITH Z.
C     LENZ - THE LENGTH OF THE LIST.
C   ICACHE - THE I/O CACHE TO BE USED.
C    IRREP - IGNORED.
C    NLIST - THE LIST NUMBER.
C

      subroutine symchk(a,n,tol)
C
C THIS ROUTINE CHECKS THE SYMMETRY OF AN NxN DOUBLE PRECISION 
C  MATRIX (A).  FOR ALL ELEMENTS WHICH DIFFER BY MORE THAN 
C  TOL WITH THEIR PARTNER [(I,J) AND (J,I)], THE INDICES AND
C  VALUES ARE PRINTED OUT [I,J,A(I,J) AND A(J,I)].
C
      SUBROUTINE SYMEXP(IRREP,NUM,DISSIZE,A)
C
C     THIS ROUTINE EXPANDS THE A COMPRESSED ARRAY A(AB,IJ) WITH
C     I < J TO AN ARRAY A(AB,IJ) WITH I,J. NOTE THAT THIS ROUTINE
C     EXPECTS THAT THE ARRAY A IS SYMMETRY PACKED
C
C     INPUT : IRREP  ...  THE IRREP OF THE CORRESPONDING PART OF A
C             NUM ......  POPULATION VECTOR FOR I AND J
C             DISSIZE ..  DISTRIBUTION SIZE OF A
C             A     ....  THE MATRIX A
C
C     OUTPUT : A .......  THE EXPANDED MATRIX A
C
C NOTE THAT THIS IS A VECTORIZED IN-PLACE EXPANSION
C
      SUBROUTINE SYMEXP2(IRREP,NUM,DSZ1,DSZ,DIS,A1,A)
C
C     THIS ROUTINE EXPANDS THE A COMPRESSED ARRAY A(AB,IJ) WITH
C     A < B TO AN ARRAY A(AB,IJ) WITH A,B. NOTE THAT THIS ROUTINE
C     EXPECTS THAT THE ARRAY A IS SYMMETRY PACKED
C
C  USAGE :
C
C          IRREP ....... IRREDUCIBLE REPRESENTATION OF THE BLOCKS
C          NUM ......... POPULATION IN EACH IRREP FOR THE ORBITALS
C                        (EITHER VIRTUAL OR OCCUPIED IN DEPENDENCE
C                        IF A VIRTUAL-VIRTULA OR OCCUPIED-OCCUPIED      
C                        BLOCK MUST BE EXTENDED
C          DSZ1 ........ DISTRIBUTION SIZE OF EXPANDED ARRAY
C          DSZ ......... DISTRIBUTION SIZE OF OLD ARRAY
C          DIS ......... NUMBER OF DISTRIBUTIONS IN A AND A1
C          A1 .......... EXPANDED ARRAY (OUTPUT)
C          A ........... OLD ARRAY (INPUT)
C
C NOTE THAT THIS IS A IN PLACE EXPANSION, HOWEVER THE SAME ADDRESS
C HAS TO BE PASSED TWO TIMES TO THIS ROUTINE ( AS A1 AND A) IN ORDER
C TO DEAL WITH THE DIFFREENT DIMENSIONS OF THE INPUT AND OUTPUT ARRAY
C
      SUBROUTINE SYMEXP3(IRREP,NUM2,NUM1,DIS,NUM,A,B)
C
C  THIS ROUTINE EXPANDS A COMPRESSED ARRAY T(IJ,AB) WITH I.LE.J  
C  TO THE FULL ARRAY USING THE SYMMETRY RELATION
C
C       T(IJ,AB) = T(JI,BA)
C
C  THIS ROUTINE IS USEFUL FOR THE LADDER PART IN THE RHF CASE
C
      SUBROUTINE SYMEXP4(IRREP,NUM1,NUM2,DSZ1,DSZ,DIS,A1,A,B)
C
C     THIS ROUTINE EXPANDS THE A COMPRESSED ARRAY A(AB,IJ) WITH
C     A LE B  TO AN ARRAY A(AB,IJ) WITH I,J USING THE SYMMETRY
C     RELATION A(AB,IJ) = A(BA,JI). NOTE THAT THIS ROUTINE
C     EXPECTS THAT THE ARRAY A IS SYMMETRY PACKED
C
C  USAGE :
C
C          IRREP ....... IRREDUCIBLE REPRESENTATION OF THE BLOCKS
C          NUM ......... POPULATION IN EACH IRREP FOR THE ORBITALS
C                        (EITHER VIRTUAL OR OCCUPIED IN DEPENDENCE
C                        IF A VIRTUAL-VIRTULA OR OCCUPIED-OCCUPIED      
C                        BLOCK MUST BE EXTENDED
C          DSZ1 ........ DISTRIBUTION SIZE OF EXPANDED ARRAY
C          DSZ ......... DISTRIBUTION SIZE OF OLD ARRAY
C          DIS ......... NUMBER OF DISTRIBUTIONS IN A AND A1
C          A1 .......... EXPANDED ARRAY (OUTPUT)
C          A ........... OLD ARRAY (INPUT) 
C          B ........... SCRATCH ARRAY
C
C THIS ROUTINE IS USEFUL FOR THE LADDER PART IN THE CASE OF RHF
C
      SUBROUTINE SYMMET(A,B,NUM)
C
C   THIS ROUTINE SYMMETRIZES A GIVEN MATRIX A
C
C     A(PQ) = 1/2 ( A(PQ)+A(QP))
C
C   WHERE A IS A SYMMETRY PACKED MATRIX AND
C   NUM THE CORRESPONDING POPULATION VECTOR
C
C   THE SYMMETRIZED ARRAY IS RETURNED IN A, B IS ONLY USED
C   AS A SCRATCH ARRAY. IT IS POSSIBLE TO SET UP A ROUTINE WHICH
C   DOES NOT USE A SCRATCH ARRAY, BUT VECTORIZATION SHOULD HERE 
C   SLIGHTLY BETTER
C
      SUBROUTINE SYMMET2(A,NUM)
C
C   THIS ROUTINE SYMMETRIZES A GIVEN MATRIX A
C
C     A(PQ) = 1/2 ( A(PQ)+A(QP))
C
C   WHERE A IS A SYMMETRY PACKED MATRIX AND
C   NUM THE CORRESPONDING POPULATION VECTOR
C
C   THE SYMMETRIZATION IS HERE COMPLETELY DONE IN PLACE
C
      SUBROUTINE SYMMET3(IRREP,LISTG,DISSYG,SCR,MAXSIZE)
C
C   THIS ROUTINE SYMMETRIZES A MATRIX A(N,N) :
C
C    B(I,J) = 1/2 ( A(I,J) + A(J,I))
C
C   THIS VERSION HANDLES THE CASES WHERE THE MATRIX A DOES NOT FIT INTO
C   CORE
C



      SUBROUTINE SYMMET4(A,NDIM,NUM)
C
C   THIS ROUTINE SYMMETRIZES A GIVEN MATRIX A
C
C     A(PQ) = 1/2 ( A(PQ)+A(QP))
C
C   WHERE A IS A SYMMETRY PACKED MATRIX AND
C   NUM THE CORRESPONDING POPULATION VECTOR
C   NDIM IS THE LEADING DIMENSION OF THE MATRIX A
C
C   THE SYMMETRIZATION IS HERE COMPLETELY DONE IN PLACE
C
C   THIS ROUTINE IS REQUIRED IN THE OUT-CORE-SYMMETRIZATION
C   ROUTINE AND CALLED FROM SYMMET3
C
      SUBROUTINE SYMOFF(IOFFSM,IRREPDO)
C
C COMPUTE OFFSETS INTO AN i,A DISTRIBUTION FOR THIS IRREP (RIGHT INDEX - 1)
C                         I,a DISTRIBUTION FOR THIS IRREP (RIGHT INDEX - 2)
C                         b,M DISTRIBUTION FOR THIS IRREP (RIGHT INDEX - 3)
C                         B,m DISTRIBUTION FOR THIS IRREP (RIGHT INDEX - 4)
C
      SUBROUTINE SYMRHF(IRREP,NUML,NUMR,DISSIZE,A,SCR,ISCRL,ISCRR)
C
C  THIS ROUTINE FORMS THE TERM 
C
C   A(I,J,K,L) --> A(I,J,K,L) + A(J,I,L,K)  
C
C  WHICH IS REQUIRED IN RHF CCSD CALCULATIONS
C
C  INPUT :  IRREP  ...   IRREP OF   G(K)*G(L) = G(I)*G(J)
C           NUMR   ....  POPULATION VECTOR FOR K,L
C           NUML   ....  POPULATION VECTOR FOR I,J
C           DISSIZE ...  DISTRIBUTION SIZE OF A
C           A      ....  HOLDS THE MATRIX A         
C           SCR,ISCRL,ISCRR ... THREE SCRATCH ARRAYS OF SIZE DISSIZE
C
C  OUTPUT :  A     ....  THE RHF SYMMETRIZED MATRIX
C
      SUBROUTINE SYMRHF2(IRREP,NUML,NUMR,DISSIZE,BUF1,BUF2,
     &                   ISCRL,ISCRR,LIST)
C
C  THIS ROUTINE FORMS THE TERM 
C
C   A(I,J,K,L) --> A(I,J,K,L) + A(J,I,L,K)  
C
C  WHICH IS REQUIRED IN RHF CCSD CALCULATIONS
C
C  THIS IS THE OUT OF CORE VERSION
C
C  INPUT :  IRREP  ...   IRREP OF   G(K)*G(L) = G(I)*G(J)
C           NUMR   ....  POPULATION VECTOR FOR K,L
C           NUML   ....  POPULATION VECTOR FOR I,J
C           DISSIZE ...  DISTRIBUTION SIZE OF A
C           BUF1, BUF2 . BUFFERS FOR HOLDING THE A MATRIX
C           ISCRL,ISCRR  TWO SCRATCH ARRAYS OF SIZE DISSIZE
C           LIST ....... LISTNUMBER
C
C  OUTPUT :  A     ....  THE RHF SYMMETRIZED MATRIX
C
      SUBROUTINE SYMTR1(IRREP,NUM1,NUM2,DISSIZE,A,SCR1,SCR2,ISCR)
C
C  THIS ROUTINE TRANSPOSES THE LAST TWO INDICES OF A FOUR INDEX ARRAY
C  WITHIN ONE GIVEN IRREP :
C
C   A(I,J,K,L) --> A(I,J,L,K)    WITH G(K)*G(L) = IRREP
C
C  THE TRANPOSITION IS DONE IN PLACE AND REQUIRES ONLY THREE SCRATCH
C  VECTORS OF LENGTH DISSIZE
C
C  INPUT :  IRREP  ...   IRREP OF   G(K)*G(L)
C           NUM1   ....  POPULATION VECTOR FOR K
C           NUM2   ....  POPULATION VECTOR FOR L
C           DISSIZE ...  DISTRIBUTION SIZE
C           A      ....  HOLDS THE MATRIX A         
C           SCR1,SCR2,ISCR ... THREE SCRATCH ARRAYS OF SIZE DISSIZE
C
C  OUTPUT :  A     ....  TRANSPOSED MATRIX
C
      SUBROUTINE SYMTR3(IRREP,NUM1,NUM2,DIS,NUM,A,SCR1,SCR2,ISCR)
C
C THIS ROUTINE TRNSPOSES THE FIRT TWO INDICES OF A GIVEN MATRIX A
C
C  A(I,J,K,L) ----> A(J,I,K,L) 
C
C NOTE THAT THIS TRANSPOSITION IS CARRIED OUT HERE IN PLACE AND
C ONLY THREE ADDITIONAL ARRAYS OF SIZE NUM ARE REQUIRED
C
C INPUT : IRREP .......... IRREP OF THE GIVEN PAR OF A
C         NUM1 ........... POPULATION VECTOR OF I
C         NUM2 ........... POPULATION VECTOR OF J
C         DIS ............ DISTRIBUTION SIZE OF A
C         NUM ............ NUMBER OF DISTRIBUTIONS IN A
C         A .............. INPUT MATRIX A
C         SCR1,SCR2 ...... TWO SCRATCH ARRAYS OF DIMENSION NUM
C         ISCR ........... INTEGER SCRATCH ARRAY OF DIMENSION DIS
C
C  OUTPUT : A ............ TRANSPOSED MATRIX A
C 
      SUBROUTINE SYMTRA(IRREP,NUM1,NUM2,DISSIZE,A,B)
C
C  THIS ROUTINE TRANSPOSES THE LAST TWO INDICES OF A GIVEN MATRIX A
C
C    A(I,J,K,L) --> B(I,J,L,K)
C
C  NOTE THAT THIS IS NOT CARRIED OUT IN PLACE ( SEE THEREFORE SYMTR1)
C
C     INPUT : IRREP ....... IRREP OF THE GIVEN PART OF A
C             NUM1 ........ POPULATION VECTOR OF K
C             NUM2 ........ POPULATION VECTOR OF L
C             DISSIZE ..... DISTRIBUTION SIZE OF A
C             A       ..... INPUT MATRIX
C
C     OUTPUT : B .......... TRANSPOSED INPUT MATRIX A
C
      SUBROUTINE SYMTRA2(IRREP,NUM1,NUM2,DIS,NUM,A,B)
C
C  THIS ROUTINE TRANSPOSES THE FIRST TWO INDICES OF A GIVEN MATRIX A
C
C     A(I,J,K,L) --> B(J,I,K,L)
C
C  THE TRANSPOSITION IS NOT DONE IN PLACE(SEE THEREFORE SYMTR3)
C
C  INPUT : IRREP .......  IRREP OF THE GIVEN PART OF A
C          NUM1 ........  POPULATION VECTOR FOR I
C          NUM2 ........  POPULATION VECTOR FOR J
C          DIS .........  DISTRIBUTION SIZE OF A
C          NUM .........  NUMBER OF DISTRIBUTION OF A
C          A ...........  INPUT MATRIX A
C
C  OUTPUT :
C          B ...........  TRANPOSED OUTPUT MATRIX B
C
      SUBROUTINE SYTRA(A,DISSIZE,NUM1,NUM2,SCR)
C
C   THIS ROUTINE COMPUTES THE TRANSPOSE OF A GIVEN MATRIX
C
C    A(DISSIZE,IJ) ----> A(DISSIZE,JI)
C
C    WHERE     NUM1 AND NUM2 GIVE THE NUMBER OF DIFFERENT
C              I AND J INDICES RESPECTIVELY
C
C    SCR IS AN SCRATCH ARRAY OF LENGTH NUM1*NUM2
C
C    NOTE THIS ROUTINE IS USED IN OUT-CORE ALGORITHMN WHERE
C    ONLY ONE SUB BLOCK OF THE A-MATRIX WITHIN ONE GIVEN
C    SYMMETRY IS AVAILABLE
C
      SUBROUTINE T1RA01(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES ONE OF TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C           W(MBEJ) = - SUM T(J,F) * <FE||BM> + SUM T(N,B) * <NM||JE>    (1)
C           W(mbej) = - SUM T(j,f) * <fe||bm> + SUM T(n,b) * <nm||je>    (2)
C
C ALSO COMPUTED IS THE T1*W CONTRIBUTIONS TO THE F(ea) INTERMEDIATE
C
C           F(EA)   =  SUM T(M,F) * <FE||MA> = - SUM T(M,F) * <FE||AM>  (3)
C           F(ea)   =  SUM T(m,f) * <fe||ma> = - SUM T(m,f) * <fe||am>  (4)
C
C WHICH ARE OBTAINED BY TAKING GENERALIZED TRACES (N**3 DEPENDENCE) OVER THE
C TERMS CALCULATED IN EQS 1 AND 2.
C
C THIS ROUTINE USES IN-CORE ALGORITHMS!!!
C
      SUBROUTINE T1RA02(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES ONE OF TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C           W(MBEJ) = - SUM T(J,F) * <FE||BM> + SUM T(N,B) * <NM||JE>    (1)
C           W(mbej) = - SUM T(j,f) * <fe||bm> + SUM T(n,b) * <nm||je>    (2)
C
C ALSO COMPUTED IS THE T1*W CONTRIBUTIONS TO THE F(ea) INTERMEDIATE
C
C           F(EA)   =  SUM T(M,F) * <FE||MA> = - SUM T(M,F) * <FE||AM>  (3)
C           F(ea)   =  SUM T(m,f) * <fe||ma> = - SUM T(m,f) * <fe||am>  (4)
C
C WHICH ARE OBTAINED BY TAKING GENERALIZED TRACES (N**3 DEPENDENCE) OVER THE
C TERMS CALCULATED IN EQS 1 AND 2.
C
C
      SUBROUTINE T1RB01(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C     W(mBEj) =  SUM T(j,f) * <fE|mB> - SUM T(N,B) * <mN|jE>
C     W(MbeJ) =  SUM T(J,F) * <Fe|Mb> - SUM T(n,b) * <Mn|Je> (UHF only)
C
C ALSO COMPUTE ONE OF THE CONTRIBUTIONS TO THE F(ea) INTERMEDIATE:
C
C     F(EA)   = SUM T(m,f) * <fE|mA> 
C     F(EA)   = SUM T(M,F) * <Fe|Ma>  (UHF only)
C
C BY TAKING A GENERALIZED TRACE OVER THE FIRST TERM IN THE FIRST TWO EQUATIONS
C  ABOVE.
C
C THIS ROUTINE USES IN-CORE ALGORITHMS
C
      SUBROUTINE T1RB02(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C     W(mBEj) =  SUM T(j,f) * <fE|mB> - SUM T(N,B) * <mN|jE>
C     W(MbeJ) =  SUM T(J,F) * <Fe|Mb> - SUM T(n,b) * <Mn|Je> (UHF only)
C
C ALSO COMPUTE ONE OF THE CONTRIBUTIONS TO THE F(ea) INTERMEDIATE:
C
C     F(EA)   = SUM T(m,f) * <fE|mA> 
C     F(EA)   = SUM T(M,F) * <Fe|Ma>  (UHF only)
C
C BY TAKING A GENERALIZED TRACE OVER THE FIRST TERM IN THE FIRST TWO EQUATIONS
C  ABOVE.
C
      SUBROUTINE T1RC01(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C     W(mBeJ) =   SUM T(J,F) * <Fe|Bm> - T(N,B) * <Nm|Je>
C     W(MbEj) =   SUM T(j,f) * <fE|bM> - T(n,b) * <nM|jE>
C
      SUBROUTINE T1RC02(ICORE,MAXCOR,IUHF,LAMBDA)
C
C THIS SUBROUTINE COMPUTES TWO T1*W CONTRIBUTIONS TO THE
C  W(mbej) INTERMEDIATE.  
C
C     W(mBeJ) =   SUM T(J,F) * <Fe|Bm> - T(N,B) * <Nm|Je>
C     W(MbEj) =   SUM T(j,f) * <fE|bM> - T(n,b) * <nM|jE>
C
      SUBROUTINE T1RING(ICORE,MAXCOR,IUHF,LAMBDA)
C
C DRIVER FOR W(MBEJ) <- T1 CONTRIBUTIONS.  SELECTS BETWEEN INCORE
C  AND OUT OF CORE ALGORITHMS AND CALLS THE APPROPRIATE ROUTINES
C
      SUBROUTINE T1STAT(T1OLD,T1NEW,SYVEC,NSIZET,NSMSZ,
     &                  ISPIN,ICONVG,TOL,NLIST,TYPE)
C
C THIS ROUTINE ACCEPTS TWO T1 VECTORS AND FINDS THE LARGEST
C  AND RMS DIFFERENCE BETWEEN THEIR ELEMENTS AND DETERMINES
C  IF THEY ARE IDENTICAL TO WITHIN A SET TOLERANCE.
C
C INPUT:  
C       T1OLD - ONE OF THE TWO T1 VECTORS.
C       T1NEW - THE OTHER T1 VECTOR.
C       SYVEC - THE AI SYMMETRY VECTOR FOR THIS SPIN CASE
C       NSIZET- LENGTH OF THE SYMMETRY-PACKED T1 VECTOR.
C       NSMSZ - LENGTH OF THE AI SYMMETRY VECTOR (Na*na OR Nb*nb)
C       ISPIN - THE SPIN CASE
C       TOL   - THE CONVERGENCE CRITERION
C       NLIST - THE LIST NUMBER ON WHICH THE VALUES RESIDE
C       TYPE  - ???????
C
C OUTPUT:
C       ICONVG- RETURNED AS "0" IF VALUES ARE CONVERGED, "1"
C               OTHERWISE.
C
      SUBROUTINE T1T2AA1(ZT,Z,W,ZT1,Z1,T,POP,VRT,DISSYZ,DISSYW,NUMSYZ,
     &                   NUMSYW,NVRTSQ,LISTZ,LISTW,IRREP,TMP)
C
C PRIMITIVE CONTRACTION ROUTINE FOR T2<-T1
C
      SUBROUTINE T1T2AA2(Z,Z1,W,MAXSIZE,T,POP,VRT,DISSYZ,DISSYW,
     &                   NUMSYZ,NUMSYW,NOCCSQ,LISTZ,LISTW,IRREP,TMP)
C
C PRIMITIVE CONTRACTION ROUTINE FOR T2<-T1
C
      SUBROUTINE T1T2AB1(ZT,Z1,W,Z,TA,TB,POP1,POP2,VRT1,VRT2,DISSYZ,
     &                   DISSYWA,DISSYWB,NUMSYZ,NUMSYWA,NUMSYWB,
     &                   NTASIZ,NTBSIZ,LISTZ,LISTWA,LISTWB,IRREP,
     &                   IUHF,TMP)
C
C PRIMITIVE CONTRACTION ROUTINE FOR T2<-T1
C
      SUBROUTINE T1T2AB2(Z,Z1,W,MAXSIZE,TA,TB,POP1,POP2,VRT1,VRT2,
     &                   DISSYZ,DISSYWA,DISSYWB,NUMSYZ,NUMSYWA,
     &                   NUMSYWB,NTASIZ,NTBSIZ,LISTZ,LISTWA,LISTWB,
     &                   IRREP,IUHF,TMP)
C
C PRIMITIVE CONTRACTION ROUTINE FOR T2<-T1
C
      


      SUBROUTINE T2INS2(TAU,OVRLP,Z,IOVOFF,NROWT,NCOLT,IRREPDO)
C
C  FORM Z(A,j) = SUM TAU(bA,Ij) * DELTA(I,b)
C                b,I
C
      SUBROUTINE T2STAT(T2OLD,T2NEW,SYVEC1,SYVEC2,NSIZET,NSMSZ1,NSMSZ2,
     &                  ISPIN,ICONVG,TOL,NLIST,TYPE)
C
C THIS ROUTINE ACCEPTS TWO T1 VECTORS AND FINDS THE LARGEST
C  AND RMS DIFFERENCE BETWEEN THEIR ELEMENTS AND DETERMINES
C  IF THEY ARE IDENTICAL TO WITHIN A SET TOLERANCE.
C
C INPUT:  
C       T2OLD - ONE OF THE TWO T1 VECTORS.
C       T2NEW - THE OTHER T1 VECTOR.
C       SYVEC1- THE AB SYMMETRY VECTOR FOR THIS SPIN CASE
C       SYVEC2- THE IJ SYMMETRY VECTOR FOR THIS SPIN CASE
C       NSIZET- LENGTH OF THE SYMMETRY-PACKED T2 VECTOR.
C       NSMSZ1- LENGTH OF THE AB SYMMETRY VECTOR 
C       NSMSZ2- LENGTH OF THE IJ SYMMETRY VECTOR 
C       ISPIN - THE SPIN CASE
C       TOL   - THE CONVERGENCE CRITERION
C       NLIST - THE LIST NUMBER ON WHICH THE VALUES RESIDE
C       TYPE  - ?????????
C
C OUTPUT:
C       ICONVG- RETURNED AS "0" IF VALUES ARE CONVERGED, "1"
C               OTHERWISE.
C
      SUBROUTINE T2T1AA1(W,ICORE,MAXCOR,POP,VRT,ISPIN,LAMBDA,LSTOFF)
C
C     THIS SUBROUTINE CALCULATES THE FOLLOWING CONTRIBUTIOBN TO THE
C     T1  INCREMENT (LAMBDA = .FALSE.
C
C      Z(I,A) =  SUM E<F,M T(IM,EF) <AM//EF>
C
C OR   Z(i,a) =  SUM e<f,m T(im,ef) <am//ef)
C
C      OR TO THE L1 INCREMENT (LAMBDA = .TRUE.)
C
C      Z(I,A) =  SUM E<F,M L(IM,EF) <AM//EF>
C
C OR   Z(i,a) =  SUM e<f,m L(im,ef) <am//ef)
C
      SUBROUTINE T2T1AA2(W,ICORE,MAXCOR,POP,VRT,ISPIN,LAMBDA,LSTOFF)
C
C     THIS SUBROUTINE CALCULATES THE FOLLOWING CONTRIBUTIOBN TO 
C     THE T1 INCREMENT (LAMBDA = .FALSE.)
C    
C      Z(I,A) = - SUM M<N,E T(MN,AE) <MN//IE>
C
C OR   Z(i,a) = - SUM m<n,e T(mn,ea) <mn//ej)
C
C     OR THE L1 INCREMENT (LAMBDA = .FALSE.)
C 
C      Z(I,A) = - SUM M<N,E L(MN,AE) <MN//IE>
C
C OR   Z(i,a) = - SUM m<n,e L(mn,ea) <mn//ej)
C 
      SUBROUTINE T2T1AB1(W,ICORE,MAXCOR,POP1,POP2,VRT1,VRT2,ISPIN,IUHF,
     &                LAMBDA,LSTOFF)
C
C     THIS SUBROUTINE CALCULATES THE FOLLOWING CONTRIBUTIOBN TO THE
C     T1 INCREMENT (LAMBDA = .FALSE.)
C
C      Z(I,A) =  SUM E,f,m T(Im,Ef) <Am//Ef>
C
C OR   Z(i,a) =  SUM E,f,M T(Mi,Ef) <Ma//Ef)
C
C     OR THE L1 INCREMENT (LAMBDA = .TRUE>)
C
C      Z(I,A) =  SUM E,f,m L(Im,Ef) <Am//Ef>
C
C OR   Z(i,a) =  SUM E,f,M L(Mi,Ef) <Ma//Ef)
C
      SUBROUTINE T2T1AB2(W,ICORE,MAXCOR,POP1,POP2,VRT1,VRT2,ISPIN,IUHF,
     &                LAMBDA,LSTOFF)
C
C     THIS SUBROUTINE CALCULATES THE FOLLOWING CONTRIBUTIOBN TO THE
C     T1 INCREMENT (LAMBDA = .FALSE.)
C
C      Z(I,A) = - SUM M,n,e T(Mn,Ae) <Mn//Ie>
C
C OR   Z(i,a) = - SUM M,n,E T(Mn,Ea) <Mn//Ei)
C
C     OR TO THE L1 INCREMENT (LAMBDA = .TRUE)
C
C      Z(I,A) = - SUM M,n,e L(Mn,Ae) <Mn//Ie>
C
C OR   Z(i,a) = - SUM M,n,E L(Mn,Ea) <Mn//Ei)
C
C  FOR RHF A SPIN ADAPTED CODE HAS BEEN IMPLEMENTED
C

      SUBROUTINE TENER(NLIST,ET2,EAA,NUMSYT,DISSYT,T2,W,T1A,
     &                 T1B,ISPIN,TAU,IRREP,POP1,POP2,VRT1,
     &                 VRT2,TMP)
C
C THIS ROUTINE CALCULATES THE CORRELATION ENERGY FOR A GIVEN
C SET OF AMPLITUDES (ALWAYS CALLED FOM CMPENG) FOR ONE
C SPECIFIC SPIN CASE
C
C    NLIST ..... OFFSET OF THE T2 LIST    
C    ET2 ....... CORRELATION ENERGY CALCULATED FROM T2 ONLY
C    EAA ....... CORRELATION ENERGY CALCULATED FROM TAU
C    NUMSYT .... NUMBER OF DISTRUBUTION IN T2 LIST
C    DISSYT .... DISTRIBUTION SIZE OF T2 LIST
C    T2 ........ HOLDS T2 AMPLITUDES
C    W ......... HOLDS INTEGRALS <AB//IJ>
C    T1A ....... HOLDS T1 AMPLITUDES (ALPHA)
C    T1B ....... HOLDS T1 AMPLITUDES (BETA)
C       FOR ISPIN=1,2 BOTH T1 ARRAYS ARE IDENTICAL
C    ISPIN ..... SPIN CASE
C    TAU ....... LOGICAl FLAG WHICH TELLS IF TAU AMPLITUDES ARE REQUIRED 
C    IRREP ..... IRREP OF T2 LIST
C    POP1 ...... POPULATION VECTOR OF I (OCCUPIED ORBITALS)
C    POP2 ...... POPULATIOn VECTOR OF J (OCCUPIED ORBITALS)
C    VRT1 ...... POPULATION VECTOR OF A (VIRTUAL ORBITALS)
C    TMP ....... SCRATCH ARRAY
C

 
      SUBROUTINE TERMIO
C
C FLUSHES BUFFERS AND WRITES OUT COMMON BLOCK INFORMATION
C  FOR THE NEXT PROGRAM.  SHOULD NEVER BE CALLED EXPLICITLY,
C  AND IS A DEPENDENT OF CRAPSO.
C
      SUBROUTINE TOPT1S(ISPIN,ILIST,NTOP,NT1SIZ,NOCC,
     &                  NVRT,NSMSZ,T,TOPT1,
     &                  SYVEC,ITOPT1,I,A,TYPE)
C
C THIS ROUTINE PICKS UP A T1 VECTOR FROM MOIO(ISPIN,ILIST) AND RETURNS
C  THE NTOP LARGEST ELEMENTS IN TOPT1 AND THEIR ASSOCIATED INDICES
C  IN THE I AND A VECTORS.
C
C INPUT:
C       ISPIN - THE LIST SUBTYPE
C       ILIST - THE LIST NUMBER
C       NTOP  - THE NUMBER OF LARGEST AMPLITUDES (BY ABSOLUTE VALUE)
C               WHICH ARE TO BE FOUND
C       NT1SIZ- THE TOTAL SIZE OF THE T1 VECTOR
C       NOCC  - THE NUMBER OF OCCUPIED ORBITALS OF THIS SPIN TYPE
C       NVRT  - THE NUMBER OF VIRTUAL ORBITALS OF THIS SPIN TYPE
C       NSMSZ - THE TOTAL SIZE OF THE SYMMETRY VECTOR (NOCC*NVRT)
C       SYVEC - THE SYMMETRY VECTOR FOR THE A,I OR a,i LIST
C       TYPE  - ???????????
C
C OUTPUT:
C       TOPT1 - THE NTOP LARGEST ELEMENTS IN THE T1 VECTOR
C               SORTED BY ABSOLUTE VALUE
C       I     - THE I INDICES CORRESPONDING TO THE VALUES IN TOPT1
C       A     - THE A INDICES CORRESPONDING TO THE VALUES IN TOPT1
C    
C SCRATCH:
C
C       T     - USED TO HOLD THE SYMMETRY-PACKED T VECTOR
C       ITOPT1- USED TO HOLD THE OFFSETS CORRESPONDING TO THE
C               ELEMENTS IN TOPT1
C
      SUBROUTINE TOPT2S(ISPIN,ILIST,NTOP,NT2SIZ,NOCCA,NOCCB,
     &                  NVRTA,NVRTB,NSMSZ1,NSMSZ2,T,TOPT2,
     &                  SYVEC1,SYVEC2,ITOPT2,I,J,A,B,TYPE)
C
C THIS ROUTINE PICKS UP A T2 VECTOR FROM MOIO(ISPIN,ILIST) AND RETURNS
C  THE NTOP LARGEST ELEMENTS IN TOPT1 AND THEIR ASSOCIATED INDICES
C  IN THE I AND A VECTORS.
C
C INPUT:
C       ISPIN - THE LIST SUBTYPE
C       ILIST - THE LIST NUMBER
C       NTOP  - THE NUMBER OF LARGEST AMPLITUDES (BY ABSOLUTE VALUE)
C               WHICH ARE TO BE FOUND
C       NT2SIZ- THE TOTAL SIZE OF THE T2 VECTOR
C       NOCCA - THE NUMBER OF ALPHA OCCUPIED ORBITALS 
C       NOCCB - THE NUMBER OF BETA OCCUPIED ORBITALS 
C       NVRTA - THE NUMBER OF ALPHA VIRTUAL ORBITALS
C       NVRTB - THE NUMBER OF BETA VIRTUAL ORBITALS
C       NSMSZ1- THE TOTAL SIZE OF THE A,B SYMMETRY VECTOR 
C               FOR THIS SPIN CASE (NVRTA*(NVRTA-1))/2 FOR 
C               ISPIN=1, NVRTA*NVRTB FOR ISPIN=3, ETC.)
C       NSMSZ2- THE TOTAL SIZE OF THE I,J SYMMETRY VECTOR 
C               FOR THIS SPIN CASE (NOCCA*(NOCCA-1))/2 FOR 
C               ISPIN=1, NOCCA*NOCCB FOR ISPIN=3, ETC.)
C       SYVEC1- THE A,B SYMMETRY VECTOR
C       SYVEC2- THE I,J SYMMETRY VECTOR
C       TYPE  - ???????
C
C OUTPUT:
C       TOPT2 - THE NTOP LARGEST ELEMENTS IN THE T2 VECTOR
C               SORTED BY ABSOLUTE VALUE
C       I     - THE I INDICES CORRESPONDING TO THE VALUES IN TOPT1
C       J     - THE J INDICES CORRESPONDING TO THE VALUES IN TOPT1
C       A     - THE A INDICES CORRESPONDING TO THE VALUES IN TOPT1
C       B     - THE B INDICES CORRESPONDING TO THE VALUES IN TOPT1
C    
C SCRATCH:
C
C       T     - USED TO HOLD THE SYMMETRY-PACKED T VECTOR
C       ITOPT2- USED TO HOLD THE OFFSETS CORRESPONDING TO THE
C               ELEMENTS IN TOPT2
C
      SUBROUTINE TQLI(D,E,N,NP,Z)
C
C NUMERICAL RECIPES ROUTINE USED IN DIAGONALIZATIONS
C
      SUBROUTINE TRACEOO(TYPE,IRREPIN,POP,VRT,LENW,LENZ,W,Z)
C
C THIS ROUTINE ACCEPTS A SYMMETRY PACKED FOUR-INDEX ARRAY AND FORMS
C  ONE OF THE FOLLOWING SUMS.  THE RETURNED ARRAY (Z) IS ALSO SYMMETRY
C  PACKED. (ALL SUMS BELOW ARE OVER M).
C
C           Z(EB) =  SUM   W(ME-BM)     (TYPE = 'OVVO')
C           Z(EB) =  SUM   W(EM-MB)     (TYPE = 'VOOV')
C           Z(EB) =  SUM   W(EM-BM)     (TYPE = 'VOVO')
C           Z(EB) =  SUM   W(ME-MB)     (TYPE = 'OVOV')
C
C
C INPUT: TYPE    (CHARACTER*4)
C        IRREPIN (INTEGER): THE IRREP OF GAMMA(MB) AND GAMMA(EM).
C        POP (INTEGER [8]): OCCUPATION NUMBERS BY IRREP.
C        VRT (INTEGER [8]): # OF VIRTUAL ORBITALS BY IRREP.
C        NSIZ (INTEGER)   : THE DIMENSION OF W (WHICH IS A SQUARE MATRIX).
C        W (DP ARRAY)     : THE FOUR-INDEX ARRAY TO BE SUMMED OVER.
C
C OUTPUT: Z (DP ARRAY)    : THE SUMS DESCRIBED BY THE EQUATIONS ABOVE.
C
      SUBROUTINE TRANSP(A,B,NUM,DIS)
C
C    THIS ROUTINE PERFORMS A GENERAL MATRIX  TRANSPOSITION 
C
C       B(P,Q) <---  A(Q,P)
C
C    INPUT:
C             A  ......   MATRIX TO BE TRANSPOSED
C             NUM .....   LENGTH OF SECOND INDEX OF A
C                         (NUMBER OF DISTRIBUTIONS IN A)
C             DIS .....   LENGTH OF FIRST INDEX OF A
C                         (DISTRIBUTION LENGTH IN A)
C
C    OUTPUT:
C             B .......   TRANSPOSED MATRIX
C
      SUBROUTINE TRED2(A,N,NP,D,E)
C
C    THIS ROUTINE ....
C
      SUBROUTINE TRIANG(MIN,MOUT,NSIZ,IDIAG)
C
C THIS ROUTINE ACCEPTS AN NSIZ BY NSIZ SYMMETRIC OR ANTISYMMETRIC MATRIX MIN
C  AND RETURNS IT IN PACKED TRIANGULAR FORM IN MOUT.  IF IDIAG IS SET THE
C  'Y', THEN THE DIAGONAL IS INCLUDED, IF 'N' THEN IT IS EXCLUDED. 
C
      SUBROUTINE TRNCHR(LIST1,LIST2)
C
C THIS ROUTINE CHANGES THE CHARACTERISTICS OF A LIST, ALLOWING
C  ITS TRANSPOSE TO BE WRITTEN IN THE SAME AREA.  USED IN THE
C  FULL GAMMA BACK-TRANSFORMATION.
C  
C INPUT: LIST1  - THE SECONDARY LIST NUMBER.
C        LIST2  - THE PRIMARY LIST NUMBER.
C
      SUBROUTINE TRNLST(IRREP,LISTG,DISSYG,SCR,MAXSIZE)
C
C   THIS ROUTINE TRANSPOSES A SQUARE LIST A(N,N)
C
C       A(I,J) --> A(J,I)
C
C   AND WRITES IT BACK TO DISK IN PLACE.  THIS VERSION HANDLES
C   BOTH IN-CORE AND OUT-OF-CORE TRANSPOSITIONS, AND IS JUST
C   A HACKED-UP SYMMET3.
C
 
      CHARACTER*8 FUNCTION TYPEO(I,NI)
C
C  CHARACTER*8 FUNCTION WHICH RETURNS THE TYPE OF AN ORBITAL(OCCUPIED
C  OR VIRTUAL) FOR AN GIVEN ORBITAL BY CHECKING ITS INDEX
C


      SUBROUTINE UPDMOI(LSTDIS,DISSIZ,LSTSPN,LSTNUM,IENTER,IOFF)
C
C UPDATES THE MOIO AND MOIOWD VECTORS WHEN YOU WRITE A NEW LIST.
C
C     LSTDIS= NUMBER OF DISTRIBUTIONS IN THE LIST.
C     DISSIZ= THE SIZE OF THE INDIVIDUAL DISTRIBUTIONS (IN FP WORDS).
C     LSTSPN= "SPIN CASE" FOR LIST [I OF MOIO(I,J)].
C     LSTNUM= NUMBER FOR LIST [J OF MOIO(I,J)].
C     IENTER= 0 UNLESS THE MOINTS FILE IS NEW.  1 IS USED THEN.
C              AT THE END OF EXECUTION OF A LINK, CALL THIS
C              WITH A '2', AND IT WILL WRITE OUT TOTREC TO JOBARC.
C              AT BEGINNING, A '3' WILL INITIALIZE THE VALUE.
C     IOFF  = -1 BEGINS LIST ON A PHYSICAL RECORD BOUNDARY.
C                ANY OTHER VALUE BEGINS AT FIRST AVAILABLE WORD.
C
      SUBROUTINE VADD(A,B,C,LEN,FACTOR)
C
C FORMS A=B+FACTOR*C FOR THE FIRST LEN ELEMENTS OF VECTORS A,B AND
C     C.
C

      SUBROUTINE VECDIV(A,B,C,N)
C
C COMPUTES C(I)=A(I)/B(I) FOR FIRST N ELEMENTS OF VECTORS A AND B.
C

      SUBROUTINE VECPRD(A,B,C,N)
C
C COMPUTES C(I)=A(I)*B(I) FOR FIRST N ELEMENTS OF VECTORS A AND B.
C
      SUBROUTINE VMINUS(V,LEN)
C
C THIS ROUTINE NEGATES THE FIRST LEN ELEMENTS OF A VECTOR V.
C
      SUBROUTINE WRDIR(IUNIT,IREC,IVEC,LENGTH,IMOD)
C
C WRITES A RECORD TO DIRECT ACCESS UNIT IUNIT.
C
C  INPUT:
C        IUNIT - UNIT NUMBER FOR DIRECT ACCESS FILE.
C        IREC  - NUMBER OF RECORD TO BE WRITTEN.
C        IVEC  - VECTOR TO BE WRITTEN.
C        LENGTH- LENGTH OF VECTOR IN *INTEGER* WORDS.
C        IMOD  - RETURNED AS ZERO.
C
C NOTE: THIS ROUTINE IS A DEPENDENT OF GETLST AND PUTLST.  IF THE
C        SPECIFIED RECORD NUMBER IS <0, IT WILL SIMPLY RETURN RATHER
C        THAN CAUSING AN ERROR EXIT.  ALL PEOPLE WHO USE THIS ROUTINE
C        SHOULD BE AWARE OF THIS.
C
      SUBROUTINE WRTSEQ(IUNIT,IVEC,LENGTH)
C
C WRITES AN INTEGER VECTOR OF LENGTH IVEC TO SEQUENTIAL ACCESS
C  UNIT IUNIT.
C
      SUBROUTINE XGEMM(TRANSA,TRANSB,M,N,K,ALPHA,A,LDA,B,LDB,
     $                   BETA, C, LDC )
C
C THIS ROUTINE IS A FRONT-END TO SGEMM, NECESSITATED BY UNICOS VERSION
C  6.0, WHICH CALLS AN ERROR EXIT (XERBLA) IF A ZERO-LENGTH MATRIX IS
C  PASSED TO SGEMM.  THIS ROUTINE CHECKS FOR THE MATRIX LENGTH AND THEN
C  CALLS SGEMM IF THERE ARE THINGS TO BE MULTIPLIED, AND RETURN OTHERWISE.
C
      SUBROUTINE ZERO(A,LEN)
C
C ZEROS OUT THE FIRST LEN ELEMENTS OF DOUBLE PRECISION VECTOR A.
C
      SUBROUTINE ZEROLIST(ICORE,MAXCOR,DOLIST)
C
C THIS ROUTINE ZEROS OUT A DPD LIST
C


      subroutine znorm(a,n)
C
C THIS ROUTINE COMPUTES AND WRITES OUT THE NORM OF a, WHICH IS AN
C  VECTOR OF LENGTH n.
C
The routines listed below may require modification to run on different computers. The source code for both routines is therefore included in full, along with commented instructions which precede all potentially machine dependent code.

      SUBROUTINE GETMEM(GETWRD,IFIRST,IPOS)
C
C THIS ROUTINE IS USED TO ALLOCATE MEMORY.  BY NECESSITY, THIS CODE IS
C  HIGHLY MACHINE-DEPENDENT AND SECTIONS MAY HAVE TO BE WRITTEN WHEN PORTING
C  TO A NEW MACHINE.  THE MEANING OF THE ARGUMENTS IS AS FOLLOWS:
C
C      GETWRD - THE NUMBER OF *INTEGER* WORDS OF MEMORY REQUESTED
C
C      IFIRST - A REFERENCE POSITION, USED AS THE FIRST ELEMENT OF
C               THE BLANK COMMON BLOCK BY CRAPS
C
C      IPOS   - THE RELATIVE OFFSET (IN INTEGER WORDS) RELATIVE TO
C               THE ADDRESS OF IFIRST WHERE THE BLOCK OF GETWRD WORDS
C               OF MEMORY BEGINS.
C
C IN CRAPS, THE BLANK COMMON IS DEFINED AS " COMMON // ICORE(1)".  ICORE(1)
C  IS THEN EVENTUALLY PASSED TO GETMEM, WHICH RETURNS THE VALUE IPOS.  THIS
C  MEANS THAT THE WORKING AREA ACTUALLY STARTS AT ICORE(IPOS), AND THIS 
C  ADDRESS SHOULD THEN BE PASSED FROM MAIN INTO THE DEPENDENT SUBROUTINES.
C
CEND    
      IMPLICIT INTEGER (A-Z)
      DOUBLE PRECISION TELAP
      COMMON /MACHSP/ IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
CUNIXBOX
      INDEX=MALLOC(GETWRD*IINTLN)
      IF(INDEX.EQ.0)THEN
       IPOS=-1
       RETURN
      ENDIF 
      IPOS=1+(INDEX-LOC(IFIRST))/4
CCRAY
C      CALL TIMEF(TELAP)
C      CALL HPALLOC(INDEX,GETWRD,IERR1,0)
C      CALL TIMEF(TELAP)
C      WRITE(6,200)GETWRD,TELAP/1000.0
C200   FORMAT(T3,'@GETMEM-I, Allocation of ',I9,' words of core ',
C     &          'required ',F10.5,' sec.')
C      IF(IERR1.LT.0)THEN
C       IPOS=-1
C        RETURN
C      ENDIF 
C      IPOS=1+(INDEX-LOC(IFIRST))
      RETURN
      END 


      SUBROUTINE MCHPRM
C
C FILLS OUT MACHINE-DEPENDENT COMMON BLOCK VALUES.  
C
C
CEND
      COMMON /MACHSP/ IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
      COMMON /MACHSP2/MASK1,MASK2,ISHFSZ
      COMMON /FILES/ LUOUT,MOINTS
      COMMON /FILSPC/ ILNBUF,IPRCLN,IPRCWD
      COMMON /IOPOS/ ICRSIZ,ICHCSZ,IOFF(2),LENREC
      COMMON /FLAGS/ IFLAGS(100)
C
C IINTLN IS THE INTEGER LENGTH IN BYTES.
C IFLTLN IS THE FLOATING POINT LENGTH IN BYTES.
C IINTFP IS THE RATIO IFLTLN/IINTLN
C
CSUN
      IINTLN=4
      IFLTLN=8
      IINTFP=2
CCRAY
C      IINTLN=8
C      IFLTLN=8
C      IINTFP=1
      ILNBUF=1800
      LUOUT=6
      MOINTS=50
      IALONE=2**(8*IINTLN/4)-1
      IBITWD=8*IINTLN/4
C
      IJUNK=4*IBITWD-3
      ISHFSZ=IJUNK
      MASK1=2**IJUNK-1
      MASK2=7 
C
      IF(IFLAGS(1).GT.100)THEN
       WRITE(LUOUT,100)IINTLN,IFLTLN,ILNBUF
100    FORMAT(T3,'@MCHPRM-I, Machine specific parameters for this run:',
     &/,T10,'Integer length (bytes):',T45,I5,'.',/,T10,'Floating point',
     &' length (bytes)',T45,I5,'.',/,T10,'Integral buffer length ',
     &'(# ints)',T45,I5,'.')
      ENDIF
      RETURN
      END

      
      SUBROUTINE TIMER(TCPU,TSYS,NTYPE)
C
C RETURNS TOTAL EXECUTION TIME IN CPU SECONDS SINCE LAST CALL
C  IF NTYPE=0, AND SINCE BEGINNING OF EXECUTION IF NTYPE=1.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      REAL TARRAY(2)
      SAVE X
CSUN
       A=ETIME(TARRAY)
       Z=DBLE(TARRAY(1))
CCRAY
C      Z=SECOND()
      IF(NTYPE.EQ.0)THEN
       TCPU=Z-X
       X=Z
      ELSE
       TCPU=Z
      ENDIF
      RETURN
      END


aces2@qtp.ufl.edu