Télécharger ordvec.eso

Retour à la liste

Numérotation des lignes :

  1. C ORDVEC SOURCE CHAT 05/01/13 02:06:17 5004
  2. C ORDVEC SOURCE WP 23/08/94
  3. C SUBROUTINE ORDVEC ( IPLVAL, IPLVEC )
  4. ************************************************************************
  5. *
  6. * GRAAMO
  7. * -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * -- TRI D'UNE LISTE DE VECTEURS PROPRES. LES VECEURS PROPRES DONT
  13. * LES VALEURS PROPRES ASSOCIEES SONT LES PLUS PETITES EN MODULE
  14. * SONT PLACES EN PREMIER DANS LA LISTE --
  15. *
  16. * MODE D'APPEL:
  17. * -------------
  18. *
  19. * CALL ORDVEC ( IPLVAL, IPLVEC )
  20. *
  21. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  22. * -----------
  23. *
  24. * IPLVAL ENTIER (E) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  25. * LA SUITE DE 'FLOTTANTS' A TRIER
  26. * (S) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  27. * LA SUITE DE 'FLOTTANTS' TRIES
  28. *
  29. * IPLVEC ENTIER (E) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  30. * LA SUITE DE 'CHPOINT' ASSOCIE A IPLVAL.
  31. * (S) MEME CHOSE, MAIS TRIEE.
  32. *
  33. *
  34. * MODE DE FONCTIONNEMENT:
  35. * -----------------------
  36. *
  37. * TRI A BULLES. ( LA LISTE EST PETITE ! )
  38. *
  39. * AUTEUR, DATE DE CREATION:
  40. * -------------------------
  41. *
  42. * A.M. JOLIVALT, W. PASILLAS 06 / 07 / 94. ( ESOPE )
  43. *
  44. ***************************************************
  45.  
  46. ******
  47. * SUBROUTINES:
  48. * SWAP ( ECHANGE DES TERMES DANS LES LISTES )
  49. * ORDVEC ( TRI A BULLES )
  50. ******
  51. ******
  52. * -- ON EFFECTUE UN TRI A BULLES --
  53. ******
  54. SUBROUTINE ORDVEC ( IPLVAL, IPLVEC )
  55. IMPLICIT INTEGER(I-N)
  56. IMPLICIT REAL*8 (A-H,O-Z)
  57. -INC CCOPTIO
  58. -INC SMLCHPO
  59. -INC SMLREEL
  60.  
  61. POINTEUR IPLVAL.MLREEL, IPLVEC.MLCHPO
  62. REAL*8 XVAL1, XVAL2
  63. INTEGER ILDIM, IB100
  64. LOGICAL BSWAP
  65.  
  66. SEGACT ,IPLVAL
  67. ILDIM = IPLVAL.PROG(/1)
  68. SEGDES, IPLVAL
  69.  
  70. 10 CONTINUE
  71. BSWAP = .FALSE.
  72. DO 100 IB100 = 1, ILDIM - 1
  73. SEGACT ,IPLVAL
  74. XVAL1 = IPLVAL.PROG( IB100 )
  75. XVAL2 = IPLVAL.PROG( IB100 + 1 )
  76. SEGDES, IPLVAL
  77. IF ( ABS(XVAL1) .GT. ABS(XVAL2) ) THEN
  78. CALL SWAP( IB100, IPLVAL, IPLVEC )
  79. IF ( IERR .NE. 0 ) RETURN
  80. BSWAP = .TRUE.
  81. ENDIF
  82. 100 CONTINUE
  83. IF ( BSWAP ) GOTO 10
  84. SEGDES, IPLVAL
  85.  
  86. RETURN
  87. END
  88.  
  89.  

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