Télécharger ordo03.eso

Retour à la liste

Numérotation des lignes :

  1. C ORDO03 SOURCE JC220346 14/12/16 21:15:08 8324
  2. SUBROUTINE ORDO03 (XLIST,LLIST,CROISS,IORDR)
  3. ************************************************************************
  4. *
  5. * O R D O 0 3
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE DE REELS
  12. * ET RETOURNER UNE LISTE CONTENANT LE NOUVEL ORDRE DES ELEMENTS
  13. *
  14. * MODE D'APPEL:
  15. * -------------
  16. *
  17. * CALL ORDO03 (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. * IORDR (E) TABLEAU D'ENTIERS ALLANT DE 1 A AU MOINS
  29. * LLIST.
  30. * (S) MEME TABLEAU, CONTENANT LE NOUVEL ORDRE
  31. * DES ELEMENTS DE XLIST.
  32. *
  33. * AUTEUR, DATE DE CREATION:
  34. * -------------------------
  35. *
  36. * JCARDO 10 DEC 2014
  37. *
  38. * LANGAGE:
  39. * --------
  40. *
  41. * FORTRAN77
  42. *
  43. ************************************************************************
  44. *
  45. IMPLICIT INTEGER(I-N)
  46. REAL*8 XLIST(*)
  47. INTEGER IORDR(*)
  48. REAL*8 XL100,XL110
  49. *
  50. LOGICAL CROISS,DECROI
  51. *
  52. DECROI = .NOT.CROISS
  53. *
  54. DO 100 IB100=2,LLIST
  55. *
  56. XL100 = XLIST(IB100)
  57. IO100 = IORDR(IB100)
  58. IB101 = IB100 - 1
  59. *
  60. NRANG = IB100
  61. DO 110 IB110=IB101,1,-1
  62. XL110 = XLIST(IB110)
  63. IF ( (CROISS .AND. XL100.LT.XL110)
  64. & .OR. (DECROI .AND. XL100.GT.XL110) ) THEN
  65. NRANG = NRANG - 1
  66. ELSE
  67. * --> SORTIE DE BOUCLE N.110
  68. GOTO 112
  69. END IF
  70. 110 CONTINUE
  71. * END DO
  72. 112 CONTINUE
  73. *
  74. DO 120 IB120=IB101,NRANG,-1
  75. XLIST(IB120+1) = XLIST(IB120)
  76. IORDR(IB120+1) = IORDR(IB120)
  77. 120 CONTINUE
  78. * END DO
  79. XLIST(NRANG) = XL100
  80. IORDR(NRANG) = IO100
  81. *
  82. 100 CONTINUE
  83. * END DO
  84. *
  85. END
  86.  
  87.  
  88.  

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