Télécharger la plaquette Cast3M


fr en

Télécharger ordo11.eso

Retour à la liste

Numérotation des lignes : 

ordo11

  1. C ORDO11    SOURCE    CHAT      05/01/13    02:05:49     5004
  2.       SUBROUTINE ORDO11 (XLIST,LLIST,CROISS)
  3. ************************************************************************
  4. *
  5. *                             O R D O 1 1
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE DE REELS EN NE TENANT
  12. *     COMPTE QUE DES VALEURS ABSOLUES.
  13. *
  14. * MODE D'APPEL:
  15. * -------------
  16. *
  17. *     CALL ORDO11 (XLIST,LLIST,CROISS)
  18. *
  19. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  20. * -----------
  21. *
  22. *     XLIST   REEL DP   (E)  TABLEAU UNICOLONNE A REORDONNER.
  23. *                       (S)  MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.
  24. *     LLIST   ENTIER    (E)  DIMENSION DE "XLIST".
  25. *     CROISS  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI LE TABLEAU
  26. *                            DOIT ETRE REORDONNE EN ORDRE CROISSANT.
  27. *                            SINON, CE SERA FAIT EN ORDRE DECROISSANT.
  28. *
  29. * AUTEUR, DATE DE CREATION:
  30. * -------------------------
  31. *
  32. *     PASCAL MANIGOT     23 AVRIL 1985
  33. *
  34. *     NOUVEL ALGORITHME PLUS PERFORMANT LE 14 MAI 1985 (P. MANIGOT)
  35. *
  36. * LANGAGE:
  37. * --------
  38. *
  39. *     FORTRAN77
  40. *
  41. ************************************************************************
  42. *
  43.       IMPLICIT INTEGER(I-N)
  44.       REAL*8 XLIST(*)
  45.       REAL*8 XL100,XL100A,XL110A
  46. *
  47.       LOGICAL CROISS,DECROI
  48. *
  49.       DECROI = .NOT.CROISS
  50. *
  51.       DO 100 IB100=2,LLIST
  52. *
  53.          XL100 = XLIST(IB100)
  54.          XL100A = ABS(XL100)
  55.          IB101 = IB100 - 1
  56. *
  57.          NRANG = IB100
  58.          DO 110 IB110=IB101,1,-1
  59.             XL110A = ABS(XLIST(IB110))
  60.             IF ( (CROISS .AND. XL100A.LT.XL110A)
  61.      &      .OR. (DECROI .AND. XL100A.GT.XL110A) ) THEN
  62.                NRANG = NRANG - 1
  63.             ELSE
  64. *              --> SORTIE DE BOUCLE N.110
  65.                GOTO 112
  66.             END IF
  67.   110       CONTINUE
  68. *        END DO
  69.   112    CONTINUE
  70. *
  71.          DO 120 IB120=IB101,NRANG,-1
  72.             XLIST(IB120+1) = XLIST(IB120)
  73.   120       CONTINUE
  74. *        END DO
  75.          XLIST(NRANG) = XL100
  76. *
  77.   100    CONTINUE
  78. *     END DO
  79. *
  80.       END
  81.  
  82.  

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