Numérotation des lignes :

ordon2
C ORDON2    SOURCE    PV        21/01/21    21:15:30     10862                SUBROUTINE ORDON2 (IPLIST,CROISS,ABSOLU,IORDRE)**************************************************************************                             O R D O N 2*                             -----------** FONCTION:* ---------**     RANGER EN ORDRE CROISSANT OU DECROISSANT UN 'LISTENTI'.** MODE D'APPEL:* -------------**     CALL ORDON2 (IPLIST,CROISS,ABSOLU)** PARAMETRES:   (E)=ENTREE   (S)=SORTIE* -----------**     IPLIST  ENTIER    (E)  POINTEUR SUR LA LISTE A ORDONNER.*                       (S)  MEME POINTEUR, LISTE REORDONNEE.*     CROISS  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE*                            CROISSANT OU NON.*     ABSOLU  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE*                            EN CONSIDERANT LES VALEURS ABSOLUES OU LES*                            VRAIES VALEURS.*     IORDRE  ENTIER    (E)  SI NON NUL, INDIQUE QUE L'ON SOUHAITE*                            RENVOYER LE NOUVEL ORDRE DE LA LISTE*                       (S)  POINTEUR VERS UN LISTENTI CONTENANT LE*                            NOUVEL ORDRE DES ELEMENTS** SOUS-PROGRAMMES APPELES:* ------------------------**               TRI PAR FUSION                    TRI PAR INSERTION**           | IORDRE=0 | IORDRE#0 |            | IORDRE=0 | IORDRE#0 |*   --------+----------+----------+    --------+----------+----------+*    ABSO=F |  ORDM02  |  ORDM04  |     ABSO=F |  ORDO04  |  ORDO04  |*   --------+----------+----------+    --------+----------+----------+*    ABSO=V |  ORDM12  |  ORDM14  |     ABSO=V |  ORDO14  |  ORDO14  |*   --------+----------+----------+    --------+----------+----------+*** AUTEUR, DATE DE CREATION:* -------------------------**     PASCAL MANIGOT     19 MARS 1985**     OPTION "ABSOLU" AJOUTEE LE 23 AVRIL 1985 (P. MANIGOT)**     OPTION "IORDRE" AJOUTEE LE 10 DEC 2014 (JCARDO)** LANGAGE:* --------**     ESOPE + FORTRAN77**************************************************************************      IMPLICIT INTEGER(I-N)      LOGICAL CROISS,ABSOLU      integer ICO, IPILE, IPLIST, LLIST -INC PPARAM-INC CCOPTIO-INC COCOLL-INC SMLENTI-INC TMCOLAC       pointeur piles.LISPIL      pointeur jcolac.ICOLAC      pointeur jlisse.ILISSE      pointeur jtlacc.ITLACC*      iun=1*      MLENTI = IPLIST      SEGACT,MLENTI      LLIST = LECT(/1)**     Preparation de la liste donnant le nouvel ordre de MLENTI      IF (IORDRE.NE.0) THEN          JG = LLIST          SEGINI,MLENT1          IORDRE=MLENT1          DO I=1,LLIST              MLENT1.LECT(I)=I          ENDDO      ENDIF*      IF (LLIST.LE.1) THEN         SEGDES,MLENTI         IF (IORDRE.NE.0) SEGDES,MLENT1         RETURN      END IF***     ===========================*     TRI PAR FUSION (MERGE SORT)*     ===========================*      IF (LLIST.GT.100) THEN          JG = (LLIST+1)/2          SEGINI,MLENT2*          IF (IORDRE.EQ.0) THEN              IF (ABSOLU) THEN                  CALL ORDM12(LECT(1),LLIST,MLENT2.LECT(1),CROISS)              ELSE                  CALL ORDM02(LECT(1),LLIST,MLENT2.LECT(1),CROISS)              END IF          ELSE              SEGINI,MLENT3              IF (ABSOLU) THEN                  CALL ORDM14(LECT(1),MLENT1.LECT(1),LLIST,     &                        MLENT2.LECT(1),MLENT3.LECT(1),CROISS)              ELSE                  CALL ORDM04(LECT(1),MLENT1.LECT(1),LLIST,     &                        MLENT2.LECT(1),MLENT3.LECT(1),CROISS)              END IF              SEGSUP,MLENT3              SEGDES,MLENT1          ENDIF*          SEGSUP,MLENT2***     =================*     TRI PAR INSERTION*     =================*      ELSE          IF (IORDRE.EQ.0) THEN              IF (ABSOLU) THEN                  CALL ORDO12(LECT(1),LLIST,CROISS)              ELSE                  CALL ORDO02(LECT(1),LLIST,CROISS)              END IF          ELSE              IF (ABSOLU) THEN                  CALL ORDO14(LECT(1),LLIST,CROISS,MLENT1.LECT(1))              ELSE                  CALL ORDO04(LECT(1),LLIST,CROISS,MLENT1.LECT(1))              END IF              SEGDES,MLENT1          ENDIF      ENDIF**      SEGDES,MLENTI      IF(IPSAUV.NE.0) THEN        ICOLAC = IPSAUV        SEGACT ICOLAC        ILISSE=ILISSG        SEGACT ILISSE*MOD        CALL TYPFIL('LISTENTI',ICO)        ITLACC = KCOLA(ICO)        SEGACT ITLACC*MOD        CALL AJOUN0(ITLACC,MLENTI,ILISSE,iun)        SEGDES ICOLAC,ILISSE      ENDIFC     Suppression des piles d'objets communiques      if(piComm.gt.0) then         piles=piComm         segact piles         call typfil('LISTENTI',ico)         do ipile=1,piles.proc(/1)            jcolac= piles.proc(ipile)            if(jcolac.ne.0) then               segact jcolac               jlisse=jcolac.ilissg               segact jlisse*mod               jtlacc=jcolac.kcola(ico)               segact jtlacc*mod               call ajoun0(jtlacc,MLENTI,jlisse,iun)               segdes jtlacc               segdes jlisse               segdes jcolac            endif         enddo         segdes piles      endif*      RETURN*      END     

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