Télécharger ordo14.eso

Retour à la liste

Numérotation des lignes :

  1. C ORDO14 SOURCE JC220346 14/12/16 21:15:09 8324
  2. SUBROUTINE ORDO14 (MLIST,LLIST,CROISS,IORDR)
  3. ************************************************************************
  4. *
  5. * O R D O 1 4
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE D'ENTIERS EN NE TENANT
  12. * COMPTE QUE DES VALEURS ABSOLUES ET RETOURNER UNE LISTE CONTENANT
  13. * LE NOUVEL ORDRE DES ELEMENTS
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. * CALL ORDO14 (MLIST,LLIST,CROISS)
  19. *
  20. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  21. * -----------
  22. *
  23. * MLIST ENTIER (E) TABLEAU UNICOLONNE A REORDONNER.
  24. * (S) MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.
  25. * LLIST ENTIER (E) DIMENSION DE "MLIST".
  26. * CROISS LOGIQUE (E) INDIQUE PAR "VRAI" OU "FAUX" SI LE TABLEAU
  27. * DOIT ETRE REORDONNE EN ORDRE CROISSANT.
  28. * SINON, CE SERA FAIT EN ORDRE DECROISSANT.
  29. * IORDR (E) TABLEAU D'ENTIERS ALLANT DE 1 A AU MOINS
  30. * LLIST.
  31. * (S) MEME TABLEAU, CONTENANT LE NOUVEL ORDRE
  32. * DES ELEMENTS DE MLIST.
  33. *
  34. * AUTEUR, DATE DE CREATION:
  35. * -------------------------
  36. *
  37. * JCARDO 10 DEC 2014
  38. *
  39. * LANGAGE:
  40. * --------
  41. *
  42. * FORTRAN77
  43. *
  44. ************************************************************************
  45. *
  46. IMPLICIT INTEGER(I-N)
  47. INTEGER MLIST(*)
  48. INTEGER IORDR(*)
  49. *
  50. LOGICAL CROISS,DECROI
  51. *
  52. DECROI = .NOT.CROISS
  53. *
  54. DO 100 IB100=2,LLIST
  55. *
  56. ML100 = MLIST(IB100)
  57. ML100A = ABS(ML100)
  58. IO100 = IORDR(IB100)
  59. IB101 = IB100 - 1
  60. *
  61. NRANG = IB100
  62. DO 110 IB110=IB101,1,-1
  63. ML110A = ABS(MLIST(IB110))
  64. IF ( (CROISS .AND. ML100A.LT.ML110A)
  65. & .OR. (DECROI .AND. ML100A.GT.ML110A) ) THEN
  66. NRANG = NRANG - 1
  67. ELSE
  68. * --> SORTIE DE BOUCLE N.110
  69. GOTO 112
  70. END IF
  71. 110 CONTINUE
  72. * END DO
  73. 112 CONTINUE
  74. *
  75. DO 120 IB120=IB101,NRANG,-1
  76. MLIST(IB120+1) = MLIST(IB120)
  77. IORDR(IB120+1) = IORDR(IB120)
  78. 120 CONTINUE
  79. * END DO
  80. MLIST(NRANG) = ML100
  81. IORDR(NRANG) = IO100
  82. *
  83. 100 CONTINUE
  84. * END DO
  85. *
  86. END
  87.  
  88.  
  89.  

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