Sources Esope | Cast3M

valpro
C VALPRO    SOURCE    CHAT      05/01/13    04:01:08     5004
      SUBROUTINE VALPRO
************************************************************************
*
*                             V A L P R O
*                             -----------
*
*            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "VALPROPRE"
*
* FONCTION:
* ---------
*
*     CALCULER LES VALEURS PROPRES D'UNE MATRICE TRIDIAGONALE DE LA
*     FORME:
*
*     | A1   1   0   0   0   0 |
*     | B1  A2   1   0   0   0 |
*     |  0  B2  A3   1   0   0 |
*     |  0   0  B3  A4   1   0 |
*     |  0   0   0  B4  A5   1 |
*     |  0   0   0   0  B5  A6 |
*
* PHRASE D'APPEL (EN GIBIANE):
* ----------------------------
*
*                                         |ABSOLU |
*     VV = VALPROPRE AA BB (ITERATIO II) (|       | EE) ;
*                                         |RELATIF|
*
*     LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS.
*
* OPERANDES ET RESULTATS:
* -----------------------
*
*     AA        'LISTREEL'  TERMES DE LA DIAGONALE DE LA MATRICE.
*     BB        'LISTREEL'  TERMES DE LA SOUS-DIAGONALE DE LA MATRICE.
*     ITERATIO  'MOT     '  MOT-CLE INDIQUANT QUE L'ON FOURNIT LE
*                           NOMBRE MAXIMUM D'ITERATIONS A FAIRE DANS LES
*                           CALCULS.
*     II        'ENTIER  '  NOMBRE MAXIMUM D'ITERATIONS PERMIS DANS LES
*                           CALCULS.
*     ABSOLU    'MOT     '  MOT-CLE INDIQUANT QUE L'ON FOURNIT LA
*                           PRECISION ABSOLUE DE CONVERGENCE.
*     RELATIF   'MOT     '  MOT-CLE INDIQUANT QUE L'ON FOURNIT LA
*                           PRECISION RELATIVE DE CONVERGENCE.
*     EE        'FLOTTANT'  PRECISION DE CONVERGENCE.
*     VV        'LISTREEL'  LISTE DES VALEURS PROPRES, DANS L'ORDRE DE
*                           CALCUL.
*
*     LES MOTS-CLES "ABSOLU" ET "RELATIF" S'EXCLUENT MUTUELLEMENT.
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     IPDIAG  ENTIER    POINTEUR SUR L'OBJET "AA".
*     IPSOUS  ENTIER    POINTEUR SUR L'OBJET "BB".
*     IPVALP  ENTIER    POINTEUR SUR L'OBJET "VV".
*     LUPARM  LOGIQUE   TABLEAU DONT L'ELEMENT N."I" INDIQUE PAR "VRAI"
*                       OU "FAUX" SI LE PARAMETRE DE CALCUL NUMEROTE "I"
*                       A DEJA ETE DONNE.
*     NBITER  ENTIER    NOMBRE MAXIMUM D'ITERATIONS PERMISES.
*     NUMPAR  ENTIER    NUMERO COURANT DE PARAMETRE DE CALCUL.
*     PRECI1  REEL DP   PRECISION ABSOLUE DE CONVERGENCE, OU BIEN "0".
*     PRECI2  REEL DP   PRECISION RELATIVE DE CONVERGENCE, OU BIEN "0".
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     27 FEVRIER 1985
*
* LANGAGE:
* --------
*
*     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
*
      REAL*8 PRECI1,PRECI2,XMINIM
*
      PARAMETER (NBMOTS = 3)
      PARAMETER (NBPARM = 2)
*
      LOGICAL LUPARM(NBPARM)
*
      CHARACTER*4 LISMOT(NBMOTS)
*
      DATA LISMOT/'ITER','ABSO','RELA'/
*
*     -- LECTURE DES PARAMETRES DE CALCUL --
*
      DO 100 IB100=1,NBPARM
         LUPARM(IB100) = .FALSE.
  100    CONTINUE
*     END DO
*
      DO 200 IB200=1,NBPARM
*
         ICODE = 0
         NBMOT = NBMOTS
         CALL LIRMOT (LISMOT,NBMOT,NUMLIS,ICODE)
         IF (NUMLIS.EQ.0) GO TO 200
*
         IF (NUMLIS .GT. 2) THEN
            NUMPAR = NUMLIS - 1
         ELSE
            NUMPAR = NUMLIS
         END IF
*
         IF (LUPARM(NUMPAR)) THEN
            NUMERR = 202
            CALL ERREUR (NUMERR)
            RETURN
         END IF
         LUPARM(NUMPAR) = .TRUE.
*
         IF (NUMLIS .EQ. 1) THEN
            ICODE = 1
            MINIME = 1
*           LECTURE D'UN 'ENTIER' POSITIF:
            CALL LIRE03 (MINIME,NBITER,ICODE,IRETOU)
            IF (IERR .NE. 0) RETURN
         ELSE IF (NUMLIS .EQ. 2) THEN
            ICODE = 1
            XMINIM = 0.D0
*           LECTURE D'UN 'FLOTTANT' POSITIF:
            CALL LIRE04 (XMINIM,PRECI1,0,ICODE,IRETOU)
            IF (IERR .NE. 0) RETURN
            PRECI2 = 0.D0
         ELSE IF (NUMLIS .EQ. 3) THEN
            ICODE = 1
            XMINIM = 0.D0
*           LECTURE D'UN 'FLOTTANT' POSITIF:
            CALL LIRE04 (XMINIM,PRECI2,0,ICODE,IRETOU)
            IF (IERR .NE. 0) RETURN
            PRECI1 = 0.D0
         END IF
*
  200    CONTINUE
*     END DO
*
*     RQ: ON NE TESTE PAS SI TOUS LES PARAMETRES NECESSAIRES ONT ETE
*         LUS. "VALPR1" DOIT CONTENIR DES TESTS ET DES VALEURS DE
*         REMPLACEMENT.
*
*     -- LECTURE DE LA MATRICE TRIDIAGONALE NON SYMETRIQUE --
*
*     LECTURE DES TERMES DIAGONAUX:
      ICODE = 1
      CALL LIROBJ ('LISTREEL',IPDIAG,ICODE,IRETOU)
      IF (IERR .NE. 0) RETURN
*
*     LECTURE DES TERMES SOUS-DIAGONAUX:
      ICODE = 1
      CALL LIROBJ ('LISTREEL',IPSOUS,ICODE,IRETOU)
      IF (IERR .NE. 0) RETURN
*
*     -- CALCUL DES VALEURS PROPRES --
*
      CALL VALPR1 (IPDIAG,IPSOUS,NBITER,PRECI1,PRECI2,  IPVALP)
      IF (IERR .NE. 0) RETURN
*
      CALL ECROBJ ('LISTREEL',IPVALP)
*
      END