      SUBROUTINE IMAGE(NATOMS,LENGTH,IDEGEN,IOPNUM,
     &                 IPTR,NBFATM,ILCATM,VREF,VGEN,
     &                 SCR,IANG,NBAS,SYOP,INORM)
C
C THIS ROUTINE COMPUTES THE CHARACTER OF A GROUP REPRESENTATION 
C  AND IS USED IN DETERMINING THE IRREDUCIBLE REPRESENTATION OF
C  MOLECULAR ORBITALS, VIBRATIONS, ETC.  
C
C INPUT:
C
C       NATOMS        - THE NUMBER OF "ATOMS" IN THE VECTOR VREF
C       LENGTH        - THE LENGTH OF EACH COMPONENT OF THE REPRESENTATION
C                       (THERE ARE IDEGEN COMPONENTS)
C       IDEGEN        - THE DEGENERACY ASSOCIATED WITH VREF
C       IOPNUM        - THE SYMMETRY OPERATION NUMBER
C       IPTR          - THE PERMUTATION ARRAY FOR THE SYMMETRY OPERATIONS
C       NBFATM        - THE NUMBER OF ELEMENTS ASSOCIATED WITH EACH 
C                       CENTER (STORED AS A VECTOR)
C       ILCATM        - THE OFFSET IN THE VECTOR WHERE EACH ATOM BEGINS
C       VREF          - THE REFERENCE VECTOR (NORMALIZED ON OUTPUT)
C       SCR           - A SCRATCH VECTOR OF LENGTH MAX(3,NATOMS)*3
C       IANG          - THE TYPE OF REPRESENTATION (0 FOR S, 1 FOR P,
C                       ETC)
C       NBAS          - THE MAXIMUM OF ALL ELEMENTS IN THE LENGTH ARRAY
C       SYOP          - A VECTOR WHICH CONTAINS THE GROUP SYMMETRY OPS 
C
C RETURNED:
C
C       VGEN          - THE IMAGE OF VREF UNDER THE GROUP OPERATION 
C
CEND
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION VREF(LENGTH,IDEGEN),VGEN(LENGTH*IDEGEN),IPTR(1)
      DIMENSION NBFATM(NATOMS),ILCATM(NATOMS),SCR(1)
      DIMENSION SYOP(1),DBUF(81),DBUF2(81)
C
      COMMON /SYMCHAR/ CHAR
C
      DATA ZILCH /0.0/
C
      IPOS(I) =1+(I-1)*NATOMS
      IPOS2(I)=1+(I-1)*9
C
      CALL ZERO(VGEN,LENGTH*IDEGEN)
      CHAR=ZILCH
C
C LOOP OVER THE LEVEL OF DEGENERACY OF THE REPRESENTATION
C
      DO 10 ICOUNT=1,IDEGEN
       C=ZILCH
       ZIT=ZILCH
       ZRT=ZILCH
       IOFFGEN=(ICOUNT-1)*LENGTH
C
C NORMALIZE VECTOR
C
       IF(INORM.NE.0)THEN
        Z=SNRM2(LENGTH,VREF(1,ICOUNT),1)
        IF(Z.EQ.ZILCH) THEN
         RETURN
        ELSE
         X=1.0/Z
         CALL SSCAL(LENGTH,X,VREF(1,ICOUNT),1)
        ENDIF
       ENDIF
C
C NOW APPLY THE PERMUTATION COMPONENT OF THE OPERATION
C
       DO 20 I=1,NATOMS
        LENATM=NBFATM(I)
        IF(LENATM.EQ.-1)GOTO 20
        ISTART=ILCATM(I)
        ICENGEN=IPTR(I+IPOS(IOPNUM)-1)
        ISTART2=ILCATM(ICENGEN)+IOFFGEN
        CALL SCOPY(LENATM,VREF(ISTART,ICOUNT),1,VGEN(ISTART2),1)
20     CONTINUE
C
       IF(IANG.EQ.0)THEN
        ZI=SNRM2(LENGTH,VGEN(IOFFGEN+1),1)
        ZR=SNRM2(LENGTH,VREF(1,ICOUNT),1)
        ZIT=ZI*ZI
        ZRT=ZR*ZR
        C=SDOT(LENGTH,VGEN(IOFFGEN+1),1,VREF(1,ICOUNT),1)
C
C IF THIS IS A P FUNCTION REP. THEN ROTATE THE X,Y AND Z COMPONENTS BY
C   THE CARTESIAN REPRESENTATION OF THE SYMMETRY OPERATION
C
       ELSEIF(IANG.EQ.1)THEN
        ITOTATM=LENGTH/3
        CALL MXM(SYOP(IPOS2(IOPNUM)),3,VGEN(IOFFGEN+1),3,SCR,ITOTATM)
        CALL SCOPY(ITOTATM*3,SCR,1,VGEN(IOFFGEN+1),1)
        ZI=SNRM2(LENGTH,VGEN(IOFFGEN+1),1)
        ZR=SNRM2(LENGTH,VREF(1,ICOUNT),1)
        ZIT=ZI*ZI
        ZRT=ZR*ZR
        C=SDOT(LENGTH,VGEN(IOFFGEN+1),1,VREF(1,ICOUNT),1)
C
C IF THIS IS A D FUNCTION REP. THEN ROTATE THIS AS WELL.
C
       ELSEIF(IANG.EQ.2)THEN
        ITOTATM=LENGTH/6
        IOFF1=1+IOFFGEN
        IOFFV=1
        DO 30 NATOM=1,ITOTATM
         CALL EXPND4(VGEN(IOFF1),DBUF2,3,2)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF2,3,SCR,3)
         CALL TRANSP(SCR,DBUF,3,3)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,3)
         CALL TRANSP(SCR,DBUF,3,3)
         CALL EXPND4(VREF(IOFFV,ICOUNT),DBUF2,3,2)
         ZI=SNRM2(9,DBUF,1)
         ZR=SNRM2(9,DBUF2,1)
         ZIT=ZIT+ZI*ZI
         ZRT=ZRT+ZR*ZR
         C=C+SDOT(9,DBUF,1,DBUF2,1)
         CALL SQUEZ4(DBUF,VGEN(IOFF1),3,2)
         IOFF1=IOFF1+6
         IOFFV=IOFFV+6
30      CONTINUE 
C
C F FUNCTIONS - UGH
C
       ELSEIF(IANG.EQ.3)THEN
        ITOTATM=LENGTH/10
        IOFF1=1+IOFFGEN
        IOFFV=1
        DO 40 NATOM=1,ITOTATM
         CALL EXPND4(VGEN(IOFF1),DBUF2,3,3)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF2,3,SCR,9)
         CALL TRANSP(SCR,DBUF,3,9)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,9)
         CALL TRANSP(SCR,DBUF,3,9)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,9)
         CALL TRANSP(SCR,DBUF,3,9)
         CALL SQUEZ4(DBUF,VGEN(IOFF1),3,3)
         CALL EXPND4(VREF(IOFFV,ICOUNT),DBUF2,3,3)
         ZI=SNRM2(27,DBUF,1)
         ZR=SNRM2(27,DBUF2,1)
         ZIT=ZIT+ZI*ZI
         ZRT=ZRT+ZR*ZR
         C=C+SDOT(27,DBUF,1,DBUF2,1)
         IOFF1=IOFF1+10
         IOFFV=IOFFV+10
40      CONTINUE
C
C G FUNCTIONS - VOMITROCIOUS
C
       ELSEIF(IANG.EQ.4)THEN
        ITOTATM=LENGTH/15
        IOFF1=1+IOFFGEN
        IOFFV=1
        DO 50 NATOM=1,ITOTATM
         CALL EXPND4(VGEN(IOFF1),DBUF2,3,4)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF2,3,SCR,27)
         CALL TRANSP(SCR,DBUF,3,27)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,27)
         CALL TRANSP(SCR,DBUF,3,27)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,27)
         CALL TRANSP(SCR,DBUF,3,27)
         CALL MXM(SYOP(IPOS2(IOPNUM)),3,DBUF,3,SCR,27)
         CALL TRANSP(SCR,DBUF,3,27)
         CALL SQUEZ4(DBUF,VGEN(IOFF1),3,4)
         CALL EXPND4(VREF(IOFFV,ICOUNT),DBUF2,3,4)
         ZI=SNRM2(81,DBUF,1)
         ZR=SNRM2(81,DBUF2,1)
         ZIT=ZIT+ZI*ZI
         ZRT=ZRT+ZR*ZR
         C=C+SDOT(81,DBUF,1,DBUF2,1)
         IOFF1=IOFF1+15
         IOFFV=IOFFV+15
50      CONTINUE
C 
       ENDIF       
C
       Z=SQRT(ZIT)*SQRT(ZRT)
       IF(Z.NE.ZILCH)THEN
        C=C/Z
       ELSE
        C=ZILCH
       ENDIF
       CHAR=CHAR+C
C
10    CONTINUE
      RETURN
      END
