Télécharger valpro.eso

Retour à la liste

Numérotation des lignes :

  1. C VALPRO SOURCE CHAT 05/01/13 04:01:08 5004
  2. SUBROUTINE VALPRO
  3. ************************************************************************
  4. *
  5. * V A L P R O
  6. * -----------
  7. *
  8. * SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "VALPROPRE"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * CALCULER LES VALEURS PROPRES D'UNE MATRICE TRIDIAGONALE DE LA
  14. * FORME:
  15. *
  16. * | A1 1 0 0 0 0 |
  17. * | B1 A2 1 0 0 0 |
  18. * | 0 B2 A3 1 0 0 |
  19. * | 0 0 B3 A4 1 0 |
  20. * | 0 0 0 B4 A5 1 |
  21. * | 0 0 0 0 B5 A6 |
  22. *
  23. * PHRASE D'APPEL (EN GIBIANE):
  24. * ----------------------------
  25. *
  26. * |ABSOLU |
  27. * VV = VALPROPRE AA BB (ITERATIO II) (| | EE) ;
  28. * |RELATIF|
  29. *
  30. * LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS.
  31. *
  32. * OPERANDES ET RESULTATS:
  33. * -----------------------
  34. *
  35. * AA 'LISTREEL' TERMES DE LA DIAGONALE DE LA MATRICE.
  36. * BB 'LISTREEL' TERMES DE LA SOUS-DIAGONALE DE LA MATRICE.
  37. * ITERATIO 'MOT ' MOT-CLE INDIQUANT QUE L'ON FOURNIT LE
  38. * NOMBRE MAXIMUM D'ITERATIONS A FAIRE DANS LES
  39. * CALCULS.
  40. * II 'ENTIER ' NOMBRE MAXIMUM D'ITERATIONS PERMIS DANS LES
  41. * CALCULS.
  42. * ABSOLU 'MOT ' MOT-CLE INDIQUANT QUE L'ON FOURNIT LA
  43. * PRECISION ABSOLUE DE CONVERGENCE.
  44. * RELATIF 'MOT ' MOT-CLE INDIQUANT QUE L'ON FOURNIT LA
  45. * PRECISION RELATIVE DE CONVERGENCE.
  46. * EE 'FLOTTANT' PRECISION DE CONVERGENCE.
  47. * VV 'LISTREEL' LISTE DES VALEURS PROPRES, DANS L'ORDRE DE
  48. * CALCUL.
  49. *
  50. * LES MOTS-CLES "ABSOLU" ET "RELATIF" S'EXCLUENT MUTUELLEMENT.
  51. *
  52. * LEXIQUE: (ORDRE ALPHABETIQUE)
  53. * --------
  54. *
  55. * IPDIAG ENTIER POINTEUR SUR L'OBJET "AA".
  56. * IPSOUS ENTIER POINTEUR SUR L'OBJET "BB".
  57. * IPVALP ENTIER POINTEUR SUR L'OBJET "VV".
  58. * LUPARM LOGIQUE TABLEAU DONT L'ELEMENT N."I" INDIQUE PAR "VRAI"
  59. * OU "FAUX" SI LE PARAMETRE DE CALCUL NUMEROTE "I"
  60. * A DEJA ETE DONNE.
  61. * NBITER ENTIER NOMBRE MAXIMUM D'ITERATIONS PERMISES.
  62. * NUMPAR ENTIER NUMERO COURANT DE PARAMETRE DE CALCUL.
  63. * PRECI1 REEL DP PRECISION ABSOLUE DE CONVERGENCE, OU BIEN "0".
  64. * PRECI2 REEL DP PRECISION RELATIVE DE CONVERGENCE, OU BIEN "0".
  65. *
  66. * AUTEUR, DATE DE CREATION:
  67. * -------------------------
  68. *
  69. * PASCAL MANIGOT 27 FEVRIER 1985
  70. *
  71. * LANGAGE:
  72. * --------
  73. *
  74. * FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  75. *
  76. ************************************************************************
  77. *
  78. IMPLICIT INTEGER(I-N)
  79. -INC CCOPTIO
  80. *
  81. REAL*8 PRECI1,PRECI2,XMINIM
  82. *
  83. PARAMETER (NBMOTS = 3)
  84. PARAMETER (NBPARM = 2)
  85. *
  86. LOGICAL LUPARM(NBPARM)
  87. *
  88. CHARACTER*4 LISMOT(NBMOTS)
  89. *
  90. DATA LISMOT/'ITER','ABSO','RELA'/
  91. *
  92. * -- LECTURE DES PARAMETRES DE CALCUL --
  93. *
  94. DO 100 IB100=1,NBPARM
  95. LUPARM(IB100) = .FALSE.
  96. 100 CONTINUE
  97. * END DO
  98. *
  99. DO 200 IB200=1,NBPARM
  100. *
  101. ICODE = 0
  102. NBMOT = NBMOTS
  103. CALL LIRMOT (LISMOT,NBMOT,NUMLIS,ICODE)
  104. IF (NUMLIS.EQ.0) GO TO 200
  105. *
  106. IF (NUMLIS .GT. 2) THEN
  107. NUMPAR = NUMLIS - 1
  108. ELSE
  109. NUMPAR = NUMLIS
  110. END IF
  111. *
  112. IF (LUPARM(NUMPAR)) THEN
  113. NUMERR = 202
  114. CALL ERREUR (NUMERR)
  115. RETURN
  116. END IF
  117. LUPARM(NUMPAR) = .TRUE.
  118. *
  119. IF (NUMLIS .EQ. 1) THEN
  120. ICODE = 1
  121. MINIME = 1
  122. * LECTURE D'UN 'ENTIER' POSITIF:
  123. CALL LIRE03 (MINIME,NBITER,ICODE,IRETOU)
  124. IF (IERR .NE. 0) RETURN
  125. ELSE IF (NUMLIS .EQ. 2) THEN
  126. ICODE = 1
  127. XMINIM = 0.D0
  128. * LECTURE D'UN 'FLOTTANT' POSITIF:
  129. CALL LIRE04 (XMINIM,PRECI1,0,ICODE,IRETOU)
  130. IF (IERR .NE. 0) RETURN
  131. PRECI2 = 0.D0
  132. ELSE IF (NUMLIS .EQ. 3) THEN
  133. ICODE = 1
  134. XMINIM = 0.D0
  135. * LECTURE D'UN 'FLOTTANT' POSITIF:
  136. CALL LIRE04 (XMINIM,PRECI2,0,ICODE,IRETOU)
  137. IF (IERR .NE. 0) RETURN
  138. PRECI1 = 0.D0
  139. END IF
  140. *
  141. 200 CONTINUE
  142. * END DO
  143. *
  144. * RQ: ON NE TESTE PAS SI TOUS LES PARAMETRES NECESSAIRES ONT ETE
  145. * LUS. "VALPR1" DOIT CONTENIR DES TESTS ET DES VALEURS DE
  146. * REMPLACEMENT.
  147. *
  148. * -- LECTURE DE LA MATRICE TRIDIAGONALE NON SYMETRIQUE --
  149. *
  150. * LECTURE DES TERMES DIAGONAUX:
  151. ICODE = 1
  152. CALL LIROBJ ('LISTREEL',IPDIAG,ICODE,IRETOU)
  153. IF (IERR .NE. 0) RETURN
  154. *
  155. * LECTURE DES TERMES SOUS-DIAGONAUX:
  156. ICODE = 1
  157. CALL LIROBJ ('LISTREEL',IPSOUS,ICODE,IRETOU)
  158. IF (IERR .NE. 0) RETURN
  159. *
  160. * -- CALCUL DES VALEURS PROPRES --
  161. *
  162. CALL VALPR1 (IPDIAG,IPSOUS,NBITER,PRECI1,PRECI2, IPVALP)
  163. IF (IERR .NE. 0) RETURN
  164. *
  165. CALL ECROBJ ('LISTREEL',IPVALP)
  166. *
  167. END
  168.  
  169.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales