      SUBROUTINE DETM
      DOUBLE PRECISION P,DETX,PS1,DET1
      INTEGER PREC,SCR1,SCR2,SCR3,SCR4,SCR5,SCR6,SCR7
      INTEGER NAME(2)
      COMMON /DETMX/P(4),DETX(4),PS1(4),DET1(4),N2EV,IPSAV,IPS,IDET,
     1  IPDETA,PREC,NSTART,NDCMP,IC, NSMOVE,ITERM,IS,ND,IADD,SML1,
     2  IPDETX(4),IPDET1(4), IFAIL,K,FACT1,IFFND,NFAIL
     3, NPOLE,ISNG
      COMMON  /REGEAN/ IM(7),IK(7),IEV(7),SCR1,SCR2,SCR3,SCR4,SCR5,LCORE
     1 , RMAX,RMIN,MZ,NEV,EPSI,RMINR,NE,NIT,NEVM,SCR6,SCR7
     2  ,NFOUND,LAMA
      DATA NAME/4HDETE,4HRM  /
C
C     RMAX = APPROXIMATE MAGNITUDE OF LARGEST EIGENVALUE OF INTEREST
C
C     RMIN = LOWEST  NON-ZERO  EIGENVALUE
C
C     MZ = NUMBER OF ZERO EIGENVALUES
C
C     NEV = NUMBER OF NON-ZERO EIGENVALUES IN RANGE OF INTEREST
C
C     EPSI = CONVERGENCE CRITERION
C
C     RMINR = LOWEST EIGENVALUE OF INTEREST
C
C     NE   =  NUMBER OF PERMISSIBLE CHANGES OF EPSI
C
C     NIT = INTERATIONS TO AN EIGENVALUE
C
C     NEVM = MAXIMUM NUMBER OF EIGENVALUES DESIRED
C
C     IS  = STARTING SET COUNTER
C
C     IC  = COUNTER FOR CHANGE OF CONVERGENCE CRITERIA
C
C     NFOUND  = THE NUMBER OF EIGENVALUES FOUND TO DATA
C
C      IM = MASS MATRIX CONTROL BLOCK
C
C      IK = K MATRIX CONTROL BLOCK
C
C        A = M +P*K
C
C     IEV = EIGENVECTOR CONTROL BLOCK
C
      NSTART =0
      LCORE=0
      NDCMP = 0
      NSMOVE =0
      NPOLE =0
      ITERM = 1
      IFFND = 0
      NFAIL =0
C*****
      PREC = IK(5)
C*****
      ISCR7 = SCR7
      IF(MZ .GT. NEVM) GO TO 40
      IF (IM(1) .GT. 0) GO TO 5
C
C     MASS MATRIX PURGED -- ASSUME IDENTITY
C
      IM(1) =  IK(1)
      CALL RDTRL(IM(1))
      IM(4) =8
    5 CONTINUE
      CALL DETM1(*60)
   10 CALL KLOCK(ITIME1)
      CALL DETM3(*30,*40,*11)
      NFOUND = NFOUND+1
      CALL FDVECT(SML1,P(3))
      IDONE=NFOUND+1
      IF(MZ .GT. 0)  IDONE=IDONE+MZ
      CALL DETM4
      IF(IDONE .GT. NEVM) GO TO 50
      CALL KLOCK(ITIME2)
      CALL TMTOGO(ITLEFT)
      IF(2*(ITIME2-ITIME1) .LE. ITLEFT) GO TO 10
C
C     INSUFFICIENT TIME TO FIND ANOTHER E. V.
C
   11 CONTINUE
      CALL MESAGE(45,NEVM-IDONE,NAME)
      ITERM = 3
      GO TO 50
   20 RETURN
   30 CALL DETM2
      GO TO 10
   40 ITERM = 2
   50 SCR7 = ISCR7
      CALL DETM5
      GO TO 20
C
C     SINGULAR MATRIX EVERYWHERE
C
   60 ITERM = 4
      GO TO 50
      END
