Sources Esope | Cast3M

valpr2
C VALPR2    SOURCE    CHAT      09/11/25    21:15:32     6548
      SUBROUTINE VALPR2 (DIAG,NTERME,SSDIAG,NBITER,PRECI1,PRECI2)
      implicit real*8(a-H,o-Z)
************************************************************************
*
*                             V A L P R 2
*                             -----------
*
* 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 |
*
*     PAR "ITERATIONS L.R"
*
* MODE D'APPEL:
* -------------
*
*     CALL VALPR2 (DIAG,NTERME,SSDIAG,NBITER,PRECI1,PRECI2)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     DIAG    REEL DP   (E)  LISTE DES TERMES DIAGONAUX DE LA MATRICE.
*                       (S)  LISTE DES VALEURS PROPRES DE LA MATRICE.
*     NTERME  ENTIER    (E)  DIMENSION DE LA MATRICE (CARREE).
*     SSDIAG  REEL DP   (E)  LISTE DES TERMES DE LA SOUS-DIAGONALE DE LA
*                            MATRICE.
*                       (S)  LA LISTE D'ENTREE EST DETRUITE. ON TROUVE A
*                            LA PLACE LES NOMBRES QUI ONT ETE COMPARES A
*                            "0" DANS LE TEST DE CONVERGENCE, POUR
*                            CHAQUE VALEUR PROPRE.
*     NBITER  ENTIER    (E)  NOMBRE D'ITERATIONS PERMISES PAR VALEUR
*                            PROPRE.
*     PRECI1  REEL DP   (E)  PRECISION ABSOLUE DE CONVERGENCE.
*                            = 0  SI LE TEST DOIT SE FAIRE AVEC "PRECI2"
*     PRECI2  REEL DP   (E)  PRECISION RELATIVE DE CONVERGENCE.
*                            = 0  SI LE TEST DOIT SE FAIRE AVEC "PRECI1"
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     DIAG    REEL DP   CONTIENT ALTERNATIVEMENT LES TERMES DIAGONAUX DE
*                       "T" ET LES TERMES DIAGONAUX DE "R".
*     NRESTE  ENTIER    DIMENSION DE LA MATRICE TRIDIAGONALE EXTRAITE
*                       (DEFINIE AU PARAGRAPHE "MODE DE FONCTIONNEMENT")
*     SSDIAG  REEL DP   CONTIENT ALTERNATIVEMENT LES TERMES
*                       SOUS-DIAGONAUX DE "T" ET CEUX DE "L".
*
*     LES NOTATIONS "T", "R" ET "L" SONT DEFINIES AU PARAGRAPHE "MODE DE
*     FONCTIONNEMENT".
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     PRINCIPE DES "ITERATIONS L.R":
*
*     EN REPETANT LES OPERATIONS DE DECOMPOSITION DE "T" (MATRICE
*     TRIDIAGONALE) EN PRODUIT "L.R" ("L" MATRICE TRIANGULAIRE
*     INFERIEURE UNITAIRE ET "R" MATRICE TRIANGULAIRE SUPERIEURE) ET DE
*     RECOMBINAISON DE "R" ET "L" EN "T = R.L" (NOUVELLE MATRICE
*     TRIDIAGONALE), ON ARRIVE A UNE MATRICE "L" UNITAIRE  ET DES
*     MATRICES "T" ET "R" CONTENANT LES VALEURS PROPRES SUR LA
*     DIAGONALE.
*
*     DANS LE CAS PARTICULIER D'UNE MATRICE "T" TRIDIAGONALE, LES
*     MATRICES "L" ET "R" ONT LES FORMES PARTICULIERES SUIVANTES:
*
*           |  1  0  0  0  0  0 |            | R1  1  0  0  0  0 |
*           | L1  1  0  0  0  0 |            |  0 R2  1  0  0  0 |
*     "L" = |  0 L2  1  0  0  0 |      "R" = |  0  0 R3  1  0  0 |
*           |  0  0 L3  1  0  0 |            |  0  0  0 R4  1  0 |
*           |  0  0  0 L4  1  0 |            |  0  0  0  0 R5  1 |
*           |  0  0  0  0 L5  1 |            |  0  0  0  0  0 R6 |
*
*     ET LES DECOMPOSITIONS ET RECOMBINAISONS PRENNENT UNE FORME TRES
*     SIMPLE.
*
*     PAR LA TECHNIQUE DU DECALAGE, ON PROVOQUE LA CONVERGENCE DU
*     DERNIER TERME DIAGONAL DE "T" EN PREMIER.
*     APRES CHAQUE CONVERGENCE, ON CONSIDERE UNE NOUVELLE MATRICE "T"
*     EXTRAITE DE LA PRECEDENTE EN ENLEVANT LA DERNIERE LIGNE ET LA
*     DERNIERE COLONNE.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     27 FEVRIER 1985
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
**    RQ: PROBLEME NON REGLE: TERME DIAGONAL NUL ET TEST DE CONVERGENCE
**        SUR DES VALEURS RELATIVES.
*
      IMPLICIT INTEGER(I-N)
      REAL*8 DIAG(*),SSDIAG(*),PRECI1,PRECI2
      REAL*8 SOMDEC,DEC,DD
*
      LOGICAL CONVRG
*
*        write(6,*) ' entreee dans valpr2 nterme',nterme
*        write(6,*) ' diag(nterme-1),ssdiag(nterme-1)'
*        write(6,*) diag(nterme-1),ssdiag(nterme-1)
*        write(6,*) ' diag ', ( diag(iou),iou=1,nterme)
*        write(6,*) ' ssdiag ',( ssdiag(iou),iou=1,nterme)
      DO 100 IB100=1,(NTERME-1)
*
         NREST1 = NTERME - IB100
         NRESTE = NREST1 + 1
         SOMDEC = 0.D0
*
         DO 110 IB110=1,NBITER
*
*           DECOMPOSITION: "T" --> "L.R"
            DO 120 IB=2,NRESTE
               IBM1 = IB - 1
               if(diag(ibm1).eq.0.D0) then
                 write(6,*) ' ib110 ib ', ib110,ib
               endif
               SSDIAG(IBM1) = SSDIAG(IBM1)/DIAG(IBM1)
               DIAG(IB) = DIAG(IB) - SSDIAG(IBM1)
  120          CONTINUE
*           END DO
*
*           RECOMBINAISON: "R.L" --> "T"
            DO 130 IB=1,NREST1
               DIAG(IB) = DIAG(IB) + SSDIAG(IB)
               SSDIAG(IB) = SSDIAG(IB) * DIAG(IB+1)
  130          CONTINUE
*           END DO
*
            IF (PRECI1 .LE. 0.D0) THEN
*              TEST RELATIF:
               DD = DIAG(NRESTE) + SOMDEC
               CONVRG = ABS(SSDIAG(NREST1)) .LT. ABS(DD * PRECI2)
            ELSE
*              "PRECI2" VAUT "0."
*              TEST ABSOLU:
               CONVRG = ABS(SSDIAG(NREST1)) .LT. PRECI1
            END IF
*
            IF (CONVRG) THEN
*              --> SORTIE DE BOUCLE N.110
               GOTO 112
            END IF
*
            DEC = DIAG(NRESTE)
            SOMDEC = SOMDEC + DEC
*
*           DECALAGE:
            DO 140 IB140=1,NRESTE
               DIAG(IB140) = DIAG(IB140) - DEC
  140          CONTINUE
*           END DO
*
  110       CONTINUE
        write(6,*)'on a pas convergé dans les ',nbiter,' iterations'
        write(6,*)' ib100 = ' , ib100
*        END DO
  112    CONTINUE
*
         DO 150 IB=1,NRESTE
            DIAG(IB) = DIAG(IB) + SOMDEC
  150       CONTINUE
*        END DO
*
  100    CONTINUE
 
*     END DO
*
*     RQ: LES VALEURS PROPRES SONT DANS "DIAG".
*
      END