Télécharger la plaquette Cast3M


fr en

Télécharger ordvec.eso

Retour à la liste

Numérotation des lignes : 

ordvec

  1. C ORDVEC    SOURCE    BP208322  19/04/29    21:15:12     10213          
  2. ************************************************************************
  3. *
  4. *                                ORDVEC
  5. *                             -----------
  6. *
  7. * FONCTION:
  8. * ---------
  9. *
  10. *     TRI D'UNE LISTE DE VECTEURS PROPRES. LES VECEURS PROPRES DONT
  11. *     LES VALEURS PROPRES ASSOCIEES SONT LES PLUS PETITES EN MODULE
  12. *     SONT PLACES EN PREMIER DANS LA LISTE
  13. *
  14. *
  15. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  16. * -----------
  17. *
  18. *     IPLVAL  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  19. *                            LA SUITE DE 'FLOTTANTS' A TRIER
  20. *                       (S)  POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
  21. *                            LA SUITE DE 'FLOTTANTS' TRIES
  22. *
  23. *     IPLVEC  ENTIER    (E)  POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
  24. *                            LA SUITE DE 'CHPOINT' ASSOCIE A IPLVAL.
  25. *                       (S)  MEME CHOSE, MAIS TRIEE.
  26. *
  27. *
  28. * MODE DE FONCTIONNEMENT:
  29. * -----------------------
  30. *
  31. *           TRI A BULLES.  ( LA LISTE EST PETITE ! )
  32. *
  33. * SUBROUTINES APPELEES :
  34. * -----------------------
  35. *           SWAP           ( ECHANGE DES TERMES DANS LES LISTES )
  36. *
  37. ************************************************************************
  38.       SUBROUTINE ORDVEC ( IPLVAL, IPLVEC , ZABS )
  39.  
  40.       IMPLICIT INTEGER(I-N)
  41.       IMPLICIT REAL*8 (A-H,O-Z)
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC  SMLCHPO
  46. -INC  SMLREEL
  47.  
  48.       POINTEUR IPLVAL.MLREEL, IPLVEC.MLCHPO
  49.       REAL*8   XVAL1, XVAL2
  50.       INTEGER  ILDIM, IB100
  51.       LOGICAL  BSWAP,ZABS
  52.  
  53.       SEGACT ,IPLVAL*MOD,IPLVEC*MOD
  54.       ILDIM = IPLVAL.PROG(/1)
  55.  
  56. c     --------------------------------------------------------      
  57. c     cas ou on trie selon les valeurs absolues des frequences
  58. c     --------------------------------------------------------      
  59.       IF(ZABS) THEN
  60.  
  61.  10      CONTINUE
  62.             BSWAP = .FALSE.
  63.             DO 100 IB100 = 1, ILDIM - 1
  64.                XVAL1 = IPLVAL.PROG( IB100 )
  65.                XVAL2 = IPLVAL.PROG( IB100 + 1 )
  66.                IF ( ABS(XVAL1) .GT. ABS(XVAL2) ) THEN
  67.                   CALL SWAP( IB100, IPLVAL, IPLVEC )
  68.                   IF ( IERR .NE. 0 ) RETURN
  69.                   BSWAP = .TRUE.
  70.                ENDIF
  71.  100        CONTINUE
  72.          IF ( BSWAP ) GOTO 10
  73.  
  74. c     --------------------------------------------------------      
  75. c     tri selon la valeur algebrique des frequences (>0 ou <0)
  76. c     --------------------------------------------------------      
  77.       ELSE
  78.  
  79.  20      CONTINUE
  80.             BSWAP = .FALSE.
  81.             DO 200 IB100 = 1, ILDIM - 1
  82.                XVAL1 = IPLVAL.PROG( IB100 )
  83.                XVAL2 = IPLVAL.PROG( IB100 + 1 )
  84.                IF ( XVAL1 .GT. XVAL2 ) THEN
  85.                   CALL SWAP( IB100, IPLVAL, IPLVEC )
  86.                   IF ( IERR .NE. 0 ) RETURN
  87.                   BSWAP = .TRUE.
  88.                ENDIF
  89.  200        CONTINUE
  90.          IF ( BSWAP ) GOTO 20
  91.  
  92.       ENDIF
  93.  
  94.       SEGDES, IPLVAL,IPLVEC
  95.  
  96.       RETURN
  97.       END
  98.  
  99.  
  100.  

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