Télécharger ordo01.eso

Retour à la liste

Numérotation des lignes :

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

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