[updated 8.Sep.2008]

Qui appelle isvecp ?

      SUBROUTINE ISVECP (NMMATR,NVMATR,NMVECT,NVVECT,NIVIMP,IMPFCH)

  Auteur : D.Martin (24 Aout 2000)
  Derniere modification : D.Martin (24 Aout 2000)
  Version 1.0.0
 
  Pour tester si un ou des vecteurs sont vecteurs propres d'un matrice ou non
 
 -- Arguments d'entree --
  NMMATR nom du terme contenant la matrice
  NVMATR niveau du terme contenant la matrice
  NMVECT nom du terme contenant les vecteurs
  NVVECT niveau du terme contenant les vecteurs
  NIVIMP niveau d'impression
  IMPFCH unite logique d'impression du resultat

      CHARACTER*(*) NMMATR,NMVECT
      INTEGER       NVMATR,NVVECT,NIVIMP,IMPFCH
 
      INCLUDE 'CONTEX'
      INCLUDE 'ALLOC'
 
      CHARACTER PRFXAS*8
      REAL      VALPRO,ECART,ECARTM,SEUIL
      INTEGER   KLTERM
      INTEGER   MCMTRM,MCDTRM,LGETRM,NBTERM,INCTRM,NCHTRM,NUTERM
     &         ,NVINUT,ITVECT,KTYCAL,KUKALE,KUDONN,KTYSYM,NVDSMV,KUINCV
     &         ,KVDUMV,NBVECT,KVNUMV,NUINCV,NVDUMV,NBNELV,NVNUMV,KNSTOK
     &         ,KVSTOK,NVCOOR,KATRDO,NIVIVC,ADTRVE
     &         ,LGVECT,MCVECT,MCVEC1,MCVEC2,LGRESU,MCRESU,MCRES1,MCRES2
     &         ,NBLIGN,NUVECT,NULIGN
      CHARACTER     ERCODE*120,VECRES*6
      COMMON/FORMAH/ERCODE

      CALL PRFXMJ (1,'*IsVecP*')
      SEUIL=1.E-6
 
      VECRES='VecZzZ'
      CALL TBAR2  (ERCODE,'#OMTRM',1,MCMTRM,'$SDTRM',1,MCDTRM)
      CALL SDEXDB (IST(MCDTRM),LGETRM,NBTERM,INCTRM,NCHTRM)             !utilite
 
 --   Caracteristiques du vecteur
 
      NUTERM=KLTERM (NMVECT,NVVECT,AST(MCMTRM),IST(MCDTRM))             !sdexplo
      IF (NUTERM.LE.0) CALL ERTERM (1,NMVECT,NVVECT)                    !utilite
      ADTRVE=LGETRM+(NUTERM-1)*INCTRM
      CALL GETTRM (IST(MCDTRM+ADTRVE)  ,NVINUT,ITVECT,KTYCAL,KUKALE
     &            ,KUDONN,KTYSYM,NVDSMV,KUINCV,KVDUMV,NBVECT,KVNUMV
     &            ,NUINCV,NVDUMV,NBNELV,NVNUMV,KNSTOK,KVSTOK,NVCOOR
     &            ,KATRDO,NIVIVC)                                       !sdexplo
      Il s'agit a priori d'un vecteur colonne
      IF (KUINCV.NE.NDFINC) THEN
         NBVECT=NBNELV
      ENDIF
 
      CALL MATVEC (NMMATR,NVMATR,NMVECT,NVVECT,VECRES,0,-1)             !assembl
 
      CALL TBRR2  (ERCODE,NMVECT,NVVECT,LGVECT,VECRES,0,LGRESU)
      NBLIGN=LGRESU/NBVECT
      CALL TBAR2  (ERCODE,NMVECT,NVVECT,MCVECT,VECRES,0,MCRESU)
 
      MCVEC1=MCVECT
      MCRES1=MCRESU
      DO 20 NUVECT=1,NBVECT
         MCVEC2=MCVEC1
         MCRES2=MCRES1
         DO 11 NULIGN=1,NBLIGN
            IF (ABS(RST(MCVEC2)).GT.SEUIL.AND.
     &          ABS(RST(MCRES2)).GT.SEUIL) THEN
                Candidat a la valeur propurete
                VALPRO=RST(MCRES2)/RST(MCVEC2)
                GOTO 13
            ENDIF
11       CONTINUE
 
         L'un des vecteurs est nul, donc pas vecteur propre
         WRITE (IMPFCH,10000) PRFXAS(0),NUVECT
         GOTO 19
 
13       MCVEC2=MCVEC1
         MCRES2=MCRES1
         ECARTM=0.
         DO 15 NULIGN=1,NBLIGN
            ECART=ABS(RST(MCRES2)-VALPRO*RST(MCVEC2))
            IF (ECART.GT.SEUIL) THEN
               Le candidat a la valeur propurete ne convient pas
               WRITE (IMPFCH,10001) PRFXAS(0),NUVECT
               GOTO 19
            ENDIF
            IF (ECART.GT.ECARTM) ECARTM=ECART
15       CONTINUE
 
         Le vecteur est vecteur propre
         WRITE (IMPFCH,10002) PRFXAS(0),NUVECT,VALPRO,ECARTM
 
         Passage au vecteur sivant
19       MCVEC1=MCVEC1+NBLIGN
         MCRES1=MCRES1+NBLIGN
20    CONTINUE
 
      CALL TBSAVE (NMVECT,NVVECT)
      CALL TBTUER (VECRES,0)                                        

99999 CALL PRFXMJ (-1,'*IsVecP*')
      RETURN

10000 FORMAT (T2,A,' Le ',I3,'eme vecteur est nul!')
10001 FORMAT (T2,A,' Le ',I3,'eme vecteur n''est pas vecteur propre.')
10002 FORMAT (T2,A,' Le ',I3,'eme vecteur est vecteur propre avec'
     &,' Lambda=',E10.4,' (a ',E10.4,' pres).')

                                                                    END !IsSyme

isvecp est appelé dans

• gettrm-calls.txt