1 : C ORDO11 SOURCE CHAT 05/01/13 02:05:49 5004 2 : SUBROUTINE ORDO11 (XLIST,LLIST,CROISS) 3 : ************************************************************************ 4 : * 5 : * O R D O 1 1 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. 13 : * 14 : * MODE D'APPEL: 15 : * ------------- 16 : * 16 : * CALL ORDO11 (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 23 AVRIL 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,XL100A,XL110A 45 : * 46 : LOGICAL CROISS,DECROI 47 : * 48 : DECROI = .NOT.CROISS 49 : * 50 : DO 100 IB100=2,LLIST 51 : * 52 : XL100 = XLIST(IB100) 53 : XL100A = ABS(XL100) 54 : IB101 = IB100 - 1 55 : * 56 : NRANG = IB100 57 : DO 110 IB110=IB101,1,-1 58 : XL110A = ABS(XLIST(IB110)) 59 : IF ( (CROISS .AND. XL100A.LT.XL110A) 60 : & .OR. (DECROI .AND. XL100A.GT.XL110A) ) THEN 61 : NRANG = NRANG - 1 62 : ELSE 63 : * --> SORTIE DE BOUCLE N.110 64 : GOTO 112 65 : END IF 66 : 110 CONTINUE 67 : * END DO 68 : 112 CONTINUE 69 : * 70 : DO 120 IB120=IB101,NRANG,-1 71 : XLIST(IB120+1) = XLIST(IB120) 72 : 120 CONTINUE 73 : * END DO 74 : XLIST(NRANG) = XL100 75 : * 76 : 100 CONTINUE 77 : * END DO 78 : * 79 : END 80 :
© Cast3M 2003 - All rights reserved.
Disclaimer