1 : C ORDON2 SOURCE CHAT 05/01/13 02:06:00 5004 2 : SUBROUTINE ORDON2 (IPLIST,CROISS,ABSOLU) 3 : ************************************************************************ 4 : * 5 : * O R D O N 2 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * RANGER EN ORDRE CROISSANT OU DECROISSANT UN 'LISTENTI'. 12 : * 13 : * MODE D'APPEL: 14 : * ------------- 15 : * 15 : * CALL ORDON2 (IPLIST,CROISS,ABSOLU) 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 18 : * ----------- 19 : * 20 : * IPLIST ENTIER (E) POINTEUR SUR LA LISTE A ORDONNER. 21 : * (S) MEME POINTEUR, LISTE REORDONNEE. 22 : * CROISS LOGIQUE (E) INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE 23 : * CROISSANT OU NON. 24 : * ABSOLU LOGIQUE (E) INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE 25 : * EN CONSIDERANT LES VALEURS ABSOLUES OU LES 26 : * VRAIES VALEURS. 27 : * 28 : * SOUS-PROGRAMMES APPELES: 29 : * ------------------------ 30 : * 31 : * ORDO02, ORDO12. 32 : * 33 : * AUTEUR, DATE DE CREATION: 34 : * ------------------------- 35 : * 36 : * PASCAL MANIGOT 19 MARS 1985 37 : * 38 : * OPTION "ABSOLU" AJOUTEE LE 23 AVRIL 1985 (P. MANIGOT) 39 : * 40 : * LANGAGE: 41 : * -------- 42 : * 43 : * ESOPE + FORTRAN77 44 : * 45 : ************************************************************************ 46 : * 47 : IMPLICIT INTEGER(I-N) 48 : -INC SMLENTI 49 : -INC CCOPTIO 50 : -INC TMCOLAC 51 : * 52 : LOGICAL CROISS,ABSOLU 53 : * 54 : MLENTI = IPLIST 55 : SEGACT,MLENTI 56 : LLIST = LECT(/1) 57 : IF (LLIST .LE. 1) THEN 58 : SEGDES,MLENTI 59 : RETURN 60 : END IF 61 : * 62 : IF (ABSOLU) THEN 62 : CALL ORDO12 (LECT(1),LLIST,CROISS) 63 : ELSE 63 : CALL ORDO02 (LECT(1),LLIST,CROISS) 64 : END IF 65 : * 66 : SEGDES,MLENTI 67 : IF(IPSAUV.NE.0) THEN 68 : ICOLAC = IPSAUV 69 : SEGACT ICOLAC 70 : ILISSE=ILISSG 71 : SEGACT ILISSE*MOD 71 : CALL TYPFIL('LISTENTI',ICO) 72 : ITLACC = KCOLA(ICO) 73 : SEGACT ITLACC*MOD 73 : CALL AJOUN0(ITLACC,MLENTI,ILISSE,1) 74 : SEGDES ICOLAC,ILISSE 75 : ENDIF 76 : * 77 : END 78 : 79 : 80 : 81 : 82 : 83 :
© Cast3M 2003 - All rights reserved.
Disclaimer