 
      SUBROUTINE FMREVC(IRERDR,OCCORB,IRRORB,NBAS,NIRREP,ISPIN,IUHF,
     &                  CALLER)
C
C FORMS THE REORDERING VECTOR FROM A LIST OF EIGENVALUES AND
C  OCCUPANCIES.
C
C  IRERDR  = REORDERING VECTOR (CONSTRUCTED AND DUMPED)
C  NOCCORB = ORBITAL OCCUPANCY VECTOR (PASSED IN)
C  IRRPOP  = IRREP. POPULATION VECTOR (CONSTRUCTED AND DUMPED)
C  IRRORB  = IRREPS OF INDIVIDUAL ORBITALS (PASSED IN, MODIFIED AND DUMP
C  NBAS    = NUMBER OF BASIS FUNCTIONS (PASSED IN)
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER*3 LABEL(2)
      CHARACTER*1 LABL2(2)
      CHARACTER*5 CALLER
      DIMENSION OCCORB(NIRREP),IRRPOP(8),IRRORB(NBAS),IRERDR(NBAS)
      DATA LABEL /'ALP','BET'/
      DATA LABL2 /'A','B'/
C
C FIGURE OUT HOW MANY BASIS FUNCTIONS THERE ARE IN EACH IRREP.
C
      CALL IZERO(IRRPOP,8)
      DO 5 I=1,NBAS
       IX=IRRORB(I)
       IRRPOP(IX)=IRRPOP(IX)+1
5     CONTINUE
C
C CONSTRUCT REORDERING VECTOR.  START WITH THE OCCUPIED ORBITALS,
C  SINCE THESE GET MAPPED TO THE BOTTOM OF THE UMBPT ORDERING.
C
      IOFF=0
      IX=0
      DO 10 I=1,NIRREP
       DO 20 J=1,OCCORB(I)
        IX=IX+1
        IRERDR(J+IOFF)=IX
20     CONTINUE
       IOFF=IOFF+IRRPOP(I)
10    CONTINUE
C
C NOW DO VIRTUALS WHICH GO AT THE TOP OF THE HEAP.
C
      IOFF=0
      DO 30 I=1,NIRREP
       DO 40 J=1,IRRPOP(I)-OCCORB(I)
        IX=IX+1
        IRERDR(J+OCCORB(I)+IOFF)=IX
40     CONTINUE
       IOFF=IOFF+IRRPOP(I)
30    CONTINUE
C
C NOW RECONSTRUCT THE IRRORB VECTOR TO CORRESPOND TO THE
C  UMBPT ORDERING.
C
      IX=0
      DO 50 I=1,NIRREP
       DO 60 J=1,OCCORB(I)
        IX=IX+1
        IRRORB(IX)=I
60     CONTINUE
50    CONTINUE
      DO 70 I=1,NIRREP
       DO 80 J=1,IRRPOP(I)-OCCORB(I)
        IX=IX+1
        IRRORB(IX)=I
80     CONTINUE
70    CONTINUE
C
C DUMP IRREP POPULATION VECTOR, REORDERING VECTOR AND IRRORB VECTOR.
C
      IF (CALLER .EQ. "VTRAN") THEN
          CALL PUTREC(20,'JOBARC','IRREPPOP',NIRREP,IRRPOP)
          CALL PUTREC(20,'JOBARC','REORDER'//LABL2(ISPIN),NBAS,
     &                IRERDR)
          CALL PUTREC(20,'JOBARC','IRREP'//LABEL(ISPIN),NBAS,
     &                IRRORB)
          IF(IUHF.EQ.0)THEN
             CALL PUTREC(20,'JOBARC','IRREPBET',NBAS,IRRORB)
          ENDIF

      ELSE IF (CALLER .EQ. "VSCF ") THEN

          CALL PUTREC(20,'JOBARC','REORDER'//LABL2(ISPIN),NBAS,
     &                IRERDR)
      ENDIF

   
C
      RETURN
      END
