Télécharger la plaquette Cast3M


fr en

Télécharger ordo13.eso

Retour à la liste

Numérotation des lignes : 

ordo13

  1. C ORDO13    SOURCE    JC220346  14/12/16    21:15:09     8324
  2.       SUBROUTINE ORDO13 (XLIST,LLIST,CROISS,IORDR)
  3. ************************************************************************
  4. *
  5. *                             O R D O 1 3
  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 ET RETOURNER UNE LISTE CONTENANT
  13. *     LE NOUVEL ORDRE DES ELEMENTS
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. *     CALL ORDO13 (XLIST,LLIST,CROISS)
  19. *
  20. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  21. * -----------
  22. *
  23. *     XLIST   REEL DP   (E)  TABLEAU UNICOLONNE A REORDONNER.
  24. *                       (S)  MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.
  25. *     LLIST   ENTIER    (E)  DIMENSION DE "XLIST".
  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 XLIST.
  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.       REAL*8 XLIST(*)
  48.       INTEGER IORDR(*)
  49.       REAL*8 XL100,XL100A,XL110A
  50. *
  51.       LOGICAL CROISS,DECROI
  52. *
  53.       DECROI = .NOT.CROISS
  54. *
  55.       DO 100 IB100=2,LLIST
  56. *
  57.          XL100 = XLIST(IB100)
  58.          XL100A = ABS(XL100)
  59.          IO100 = IORDR(IB100)
  60.          IB101 = IB100 - 1
  61. *
  62.          NRANG = IB100
  63.          DO 110 IB110=IB101,1,-1
  64.             XL110A = ABS(XLIST(IB110))
  65.             IF ( (CROISS .AND. XL100A.LT.XL110A)
  66.      &      .OR. (DECROI .AND. XL100A.GT.XL110A) ) THEN
  67.                NRANG = NRANG - 1
  68.             ELSE
  69. *              --> SORTIE DE BOUCLE N.110
  70.                GOTO 112
  71.             END IF
  72.   110       CONTINUE
  73. *        END DO
  74.   112    CONTINUE
  75. *
  76.          DO 120 IB120=IB101,NRANG,-1
  77.             XLIST(IB120+1) = XLIST(IB120)
  78.             IORDR(IB120+1) = IORDR(IB120)
  79.   120       CONTINUE
  80. *        END DO
  81.          XLIST(NRANG) = XL100
  82.          IORDR(NRANG) = IO100
  83. *
  84.   100    CONTINUE
  85. *     END DO
  86. *
  87.       END
  88.  
  89.  
  90.  

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