* PACKAGE LSLFRQ  !" $@8GM-CM2r@O(J $@?6F0?tA*Br(J
*
*"  [HIS] 93/02/19(takepiro) 
*"        95/06/21(takepiro)  $@=PNO8GM-4X?t7W;;?tF3F~(J
*
**********************************************************************
      SUBROUTINE LSLFRQ
     M           (  GROWTH , FRQENC ,
     M              EIGVCR , EIGVCI ,
     O              NUMEIG ,
     I              NMKMAX , NVEC      )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" $@3J;RE@?t(J, $@GH?t(J
      INCLUDE   (ZLDIM)                      !" $@%Q%i%a%?!<?t(J, $@78?t9TNs(J
#else
#include        "zcdim.F"                    !" $@3J;RE@?t(J, $@GH?t(J
#include        "zldim.F"                    !" $@%Q%i%a%?!<?t(J, $@78?t9TNs(J
#endif
*
*   [MODIFY]
      REAL       GROWTH( MATDMX )            !" $@@.D9N((J($@8GM-CM<B?tIt(J)
      REAL       FRQENC( MATDMX )            !" $@?6F0?t(J($@8GM-CM5u?tIt(J)
      REAL       EIGVCR( MATDMX, * )         !" $@8GM-%Y%/%H%k<B?tIt(J
      REAL       EIGVCI( MATDMX, * )         !" $@8GM-%Y%/%H%k5u?tIt(J
*
*   [OUTPUT]
      INTEGER    NUMEIG                      !" $@8GM-CM$N?t(J
*
*   [INPUT]
      INTEGER    NMKMAX                      !" $@78?t9TNs$N:GBgE:$(;z(J
      INTEGER    NVEC                        !" $@8GM-4X?t7W;;?t(J
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/ WORK
      INTEGER    JORDER( MATDMX )            !" $@F~$l49$(=g=x(J
      REAL       WORK  ( MATDMX, MATDMX )    !" $@F~$l49$(MQ:n6HNN0h(J
      COMPLEX    ACS , ASN, EI
      DATA       EI/ ( 0.0, 1.0 )/
      INTEGER    I, J, JN, K
*
      JN = 0 
*
      DO 1000 J = 1, NMKMAX
         IF ( FRQENC( J ) . NE. 0 ) THEN
            DO 1100 I = 2, NMKMAX, 2
               ACS = EIGVCR( I-1,J ) + EI * EIGVCI( I-1,J )
               ASN = - ( EIGVCR( I,J )   + EI * EIGVCI( I,J ) )
               IF( ABS( ACS ) .NE. 0 )THEN
                  IF ( IMAG ( ASN/ACS ) .GT. 0 )THEN
                     JN = JN + 1
                     JORDER( JN ) = J 
                  ENDIF
                  GOTO 1000
               ENDIF
 1100       CONTINUE 
         ELSE
            JN = JN + 1
            JORDER( JN ) = J
         ENDIF
 1000 CONTINUE 
*
      NUMEIG = JN
*
*"  < 2. $@8GM-CM(J, $@8GM-%Y%/%H%k$N%=!<%H(J ; $@8GM-CM5u?tIt"*?6F0?t(J>
*
      CALL COPY( WORK, GROWTH, NMKMAX )
      DO 2100 J = 1, NUMEIG
         GROWTH( J ) = WORK( JORDER(J),1  )
 2100 CONTINUE
*
      CALL COPY ( WORK, FRQENC , NMKMAX )
      DO 2200 J = 1, NUMEIG
         FRQENC( J ) = - WORK( JORDER(J),1  )
 2200 CONTINUE
*
      CALL COPY( WORK, EIGVCR, MATDMX*NVEC )
      DO 2300 K = 1, MIN( NUMEIG, NVEC )
         DO 2300 J = 1, NMKMAX
            EIGVCR( J,K ) = WORK( J,JORDER(K) )
 2300 CONTINUE
*
      CALL COPY( WORK, EIGVCI, MATDMX*NVEC )
      DO 2400 K = 1, MIN( NUMEIG, NVEC )
         DO 2400 J = 1, NMKMAX
            EIGVCI( J,K ) = WORK( J,JORDER(K) )
 2400 CONTINUE
*
      RETURN
      END
