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 : * 15 : * CALL ORDO01 (XLIST,LLIST,CROISS) 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 18 : * ----------- 19 : * 20 : * XLIST REEL DP (E) TABLEAU UNICOLONNE A REORDONNER. 21 : * (S) MEME TABLEAU, AVEC LES ELEMENTS REORDONNES. 22 : * LLIST ENTIER (E) DIMENSION DE "XLIST". 23 : * CROISS LOGIQUE (E) INDIQUE PAR "VRAI" OU "FAUX" SI LE TABLEAU 24 : * DOIT ETRE REORDONNE EN ORDRE CROISSANT. 25 : * SINON, CE SERA FAIT EN ORDRE DECROISSANT. 26 : * 27 : * AUTEUR, DATE DE CREATION: 28 : * ------------------------- 29 : * 30 : * PASCAL MANIGOT 19 MARS 1985 31 : * 32 : * NOUVEL ALGORITHME PLUS PERFORMANT LE 14 MAI 1985 (P. MANIGOT) 33 : * 34 : * LANGAGE: 35 : * -------- 36 : * 37 : * FORTRAN77 38 : * 39 : ************************************************************************ 40 : * 41 : IMPLICIT INTEGER(I-N) 42 : REAL*8 XLIST(*) 43 : REAL*8 XL100,XL110 44 : * 45 : LOGICAL CROISS,DECROI 46 : * 47 : DECROI = .NOT.CROISS 48 : * 49 : DO 100 IB100=2,LLIST 50 : * 51 : XL100 = XLIST(IB100) 52 : IB101 = IB100 - 1 53 : * 54 : NRANG = IB100 55 : DO 110 IB110=IB101,1,-1 56 : XL110 = XLIST(IB110) 57 : IF ( (CROISS .AND. XL100.LT.XL110) 58 : & .OR. (DECROI .AND. XL100.GT.XL110) ) THEN 59 : NRANG = NRANG - 1 60 : ELSE 61 : * --> SORTIE DE BOUCLE N.110 62 : GOTO 112 63 : END IF 64 : 110 CONTINUE 65 : * END DO 66 : 112 CONTINUE 67 : * 68 : DO 120 IB120=IB101,NRANG,-1 69 : XLIST(IB120+1) = XLIST(IB120) 70 : 120 CONTINUE 71 : * END DO 72 : XLIST(NRANG) = XL100 73 : * 74 : 100 CONTINUE 75 : * END DO 76 : * 77 : END 78 :
© Cast3M 2003 - All rights reserved.
Disclaimer