Download ajoun.eso

Back to the list

   1 : C AJOUN     SOURCE    PV        13/04/11    21:15:01     7755           
   2 :        SUBROUTINE AJOUN(ITAB,IEL,ILISSE,NUMLIS)
   3 : C
   4 : C  
   5 : C   AJOUTE UN ELEMENT (de valeur iel) DANS UN SEGMENT EXTENSIBLE
   6 : C    S IL N Y EST DEJA.
   7 : C   et renseigne le segment ilisse pour aller plus vite
   8 : C   numlis est le numero de la pile 
   9 : C   RENVOIE DANS IEL LA PLACE DE L OBJET
  10 : C
  11 : C
  12 :       IMPLICIT INTEGER(I-N)
  13 : -INC CCOPTIO
  14 : -INC TMCOLAC
  15 :       SEGMENT ITAB(0)
  16 :       NLISSE = ILISEG(/1)
  17 :       IF(NUMLIS.EQ.1) THEN
  18 :       IF((IEL-1)/npgcd.GT.NLISSE) THEN
  19 :         NLISSE = (IEL-1)/npgcd*1.2
  20 :         SEGADJ ILISSE
  21 :       ENDIF
  22 :          NLIS= ILISEG((IEL-1)/npgcd)
  23 :          IF(NLIS.EQ.0) THEN
  24 :            ITAB(**)=IEL
  25 :            ILISEG((IEL-1)/npgcd)=ITAB(/1)
  26 :            IEL=ILISEG((IEL-1)/npgcd)
  27 :          ELSE
  28 : *  verif que c'est la bonne pile
  29 :           if (itab(nlis).ne.iel) then
  30 :            moterr(1:8)='ajoun'
  31 :            interr(1)=iel
  31 :            call erreur(861)
  32 :          write (6,*) ' incoherence ajoun ',itab,iel,nlis,nlisse,numlis,
  33 :      >   itab(nlis)
  34 :            L=itab(/1)
  35 :            DO I=1,L
  36 :             IF(ITAB(I).EQ.IEL) GOTO 12
  37 :            enddo
  38 :            ITAB(**)=IEL
  39 :            I=L+1
  40 :  12        CONTINUE
  41 :            nlis=I
  42 :           endif
  43 :           IEL=NLIS
  44 :          ENDIF
  45 :       ELSE
  46 :          L=ITAB(/1)
  47 :          DO 1 I=1,L
  48 :           IF(ITAB(I).EQ.IEL) GOTO 2
  49 :  1       CONTINUE
  50 :          ITAB(**)=IEL
  51 :          I=L+1
  52 :  2       CONTINUE
  53 :          IEL=I
  54 :       ENDIF
  55 :       RETURN
  56 :       END
  57 : *    anciemme programmation
  58 : *      L=ITAB(/1)
  59 : *      DO 1 I=1,L
  60 : *         IF(ITAB(I).EQ.IEL) GOTO 2
  61 : * 1    CONTINUE
  62 : *      ITAB(**)=IEL
  63 : *      I=L+1
  64 : * 2    CONTINUE
  65 : *      IEL=I
  66 : *      RETURN
  67 : *      END
  68 :  
  69 :  
  70 :  
  71 :  
  72 :  
  73 :  
  74 :  
  75 :  

© Cast3M 2003 - All rights reserved.
Disclaimer