Télécharger vvectp.eso

Retour à la liste

Numérotation des lignes :

vvectp
  1. C VVECTP SOURCE GOUNAND 25/10/23 21:15:13 12385
  2. SUBROUTINE VVECTP(S,N,NX,VALP,VECP,XPRE,V)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : VVECTP
  7. C DESCRIPTION : Verifie qu'un vecteur VECP est bien un vecteur propre
  8. C de la matrice S pour la valeur propre VALP a XPRE pres
  9. C sinon erreur.
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  14. C mel : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C***********************************************************************
  17. C SYNTAXE GIBIANE :
  18. C ENTREES : X, NX, VALP, VECP, XPRE
  19. C ENTREES/SORTIES : V (espace de stockage de dimension nx)
  20. C SORTIES :
  21. C***********************************************************************
  22. C VERSION : v1, 20/10/2025, version initiale
  23. C HISTORIQUE : v1, 20/10/2025, creation
  24. C HISTORIQUE :
  25. C HISTORIQUE :
  26. C***********************************************************************
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. *
  30. dimension s(nx,nx),vecp(nx)
  31. * logical ldbg
  32. dimension v(nx)
  33. *
  34. * Executable statements
  35. *
  36. do i=1,n
  37. v(i)=0.d0
  38. do j=1,n
  39. if (i.eq.j) then
  40. v(i)=v(i)+(S(i,j)-valp)*vecp(j)
  41. else
  42. v(i)=v(i)+S(i,j)*vecp(j)
  43. endif
  44. enddo
  45. enddo
  46. do i=1,n
  47. if (abs(v(i)).gt.xpre) then
  48. write(6,*) '!!!! v(i) non nul,i=',i,v(i)
  49. write(6,*) '!!!! xpre=',xpre
  50. goto 9999
  51. endif
  52. enddo
  53. *
  54. * Normal termination
  55. *
  56. RETURN
  57. *
  58. * Format handling
  59. *
  60. *
  61. * Error handling
  62. *
  63. 9999 CONTINUE
  64. MOTERR(1:8)='VVECTP'
  65. call erreur(1127)
  66. RETURN
  67. *
  68. * End of subroutine VVECTP
  69. *
  70. END
  71.  
  72.  

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