Télécharger la plaquette Cast3M


fr en

Télécharger ajoun.eso

Retour à la liste

Numérotation des lignes : 

ajoun

  1. C AJOUN     SOURCE    PV090527  25/01/07    18:18:21     12116          
  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   RENVOIE DANS IEL LA PLACE DE L OBJET
  9. C
  10. C
  11.       IMPLICIT INTEGER(I-N)
  12.       integer NLISSE
  13.       integer NUMLIS
  14.       integer iel,i,L
  15.       integer NLIS
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC TMCOLAC
  20.       SEGMENT ITAB(0)
  21.       if (numlis.lt.0.or.numlis.gt.7) then
  22.        write (6,*) ' ajoun numlis incorrect ',numlis
  23.        call erreur(5)
  24.       endif
  25.  
  26.       segact ITAB*mod
  27.       NLISSE = ILISEG(/1)
  28. *
  29. *
  30.       IF(NUMLIS.EQ.1) THEN
  31. *
  32.       if (msurve.gt.0) then
  33.         if (iel.eq.msurve) then
  34.           write (6,*) ' surveillance dans ajoun element: ',msurve,
  35.      >                'pile: ',itab
  36.         endif
  37.       endif
  38. *
  39.       IF((IEL-1)/npgcd.GT.NLISSE) THEN
  40.         NLISSE = (IEL-1)/npgcd*1.2+2
  41.         SEGADJ ILISSE
  42.       ENDIF
  43.          NLIS= ILISEG((IEL-1)/npgcd)
  44.          IF(NLIS.EQ.0) THEN
  45.            ITAB(**)=IEL
  46.            ILISEG((IEL-1)/npgcd)=ITAB(/1)
  47.            IEL=ILISEG((IEL-1)/npgcd)
  48.          ELSE
  49. *  verif que c'est la bonne pile
  50.            L=itab(/1)
  51.           ier=0
  52.           if (nlis.le.L) then
  53.            if(itab(nlis).ne.iel) ier=1
  54.           else
  55.            ier=1
  56.           endif
  57.           if(ier.eq.1) then
  58.            moterr(1:8)='ajoun'
  59.            interr(1)=iel
  60.            call erreur(861)
  61.          write (6,*) ' incoherence ajoun ',itab,iel,nlis,nlisse,numlis,
  62.      >   L
  63.            DO I=1,L
  64.             IF(ITAB(I).EQ.IEL) GOTO 12
  65.            enddo
  66.            ITAB(**)=IEL
  67.            I=L+1
  68.  12        CONTINUE
  69.            iliseg((iel-1)/npgcd)=i
  70.            nlis=I
  71.           endif
  72.           IEL=NLIS
  73.          ENDIF
  74. *
  75.       ELSEIF(NUMLIS.EQ.3) THEN
  76. *
  77.       IF(IEL.GT.NLISSE) THEN
  78.         NLISSE = IEL*1.2+1
  79.         SEGADJ ILISSE
  80.       ENDIF
  81.          NLIS= ILISEG(IEL)
  82.          IF(NLIS.EQ.0) THEN
  83.            ITAB(**)=IEL
  84.            ILISEG(IEL)=ITAB(/1)
  85.            IEL=ILISEG(IEL)
  86.          ELSE
  87. *  verif que c'est la bonne pile
  88.           if (itab(nlis).ne.iel) then
  89.            L=itab(/1)
  90.            DO I=1,L
  91.             IF(ITAB(I).EQ.IEL) GOTO 22
  92.            enddo
  93.            ITAB(**)=IEL
  94.            I=L+1
  95.  22        CONTINUE
  96.            ILISEG(IEL)=I
  97.            nlis=I
  98.           endif
  99.           IEL=NLIS
  100.          ENDIF
  101. *
  102.       ELSE
  103. *
  104.          L=ITAB(/1)
  105. *        write (6,*) ' ajoun ',itab,l,numlis,iel
  106.          DO 1 I=1,L
  107.           IF(ITAB(I).EQ.IEL) GOTO 2
  108.  1       CONTINUE
  109.          ITAB(**)=IEL
  110.          I=L+1
  111.  2       CONTINUE
  112.          IEL=I
  113.       ENDIF
  114.       RETURN
  115.       END
  116.  
  117.  
  118.  
  119.  
  120.  

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