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    OF166741  24/08/02    21:15:02     11974          
  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+1
  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.           if (itab(nlis).ne.iel) then
  51.            moterr(1:8)='ajoun'
  52.            interr(1)=iel
  53.            call erreur(861)
  54.          write (6,*) ' incoherence ajoun ',itab,iel,nlis,nlisse,numlis,
  55.      >   itab(nlis)
  56.            L=itab(/1)
  57.            DO I=1,L
  58.             IF(ITAB(I).EQ.IEL) GOTO 12
  59.            enddo
  60.            ITAB(**)=IEL
  61.            I=L+1
  62.  12        CONTINUE
  63.            iliseg((iel-1)/npgcd)=i
  64.            nlis=I
  65.           endif
  66.           IEL=NLIS
  67.          ENDIF
  68. *
  69.       ELSEIF(NUMLIS.EQ.3) THEN
  70. *
  71.       IF(IEL.GT.NLISSE) THEN
  72.         NLISSE = IEL*1.2+1
  73.         SEGADJ ILISSE
  74.       ENDIF
  75.          NLIS= ILISEG(IEL)
  76.          IF(NLIS.EQ.0) THEN
  77.            ITAB(**)=IEL
  78.            ILISEG(IEL)=ITAB(/1)
  79.            IEL=ILISEG(IEL)
  80.          ELSE
  81. *  verif que c'est la bonne pile
  82.           if (itab(nlis).ne.iel) then
  83. **         moterr(1:8)='ajoun'
  84. **         interr(1)=iel
  85. **         write (6,*) ' ajoun itab iliseg '
  86. **         write (6,*) (itab(i),i=1,itab(/1))
  87. **         write (6,*) (iliseg(i),i=1,6         )
  88. **         call erreur(861)
  89. **       write (6,*) ' incoherence ajoun point ',itab,iel,nlis,nlisse,
  90. **   >             numlis,itab(nlis)
  91. *** on peut etre incoherent apres une renumerotation. On remet en silence ilissp en ordre de marche
  92. **
  93.            L=itab(/1)
  94.            DO I=1,L
  95.             IF(ITAB(I).EQ.IEL) GOTO 22
  96.            enddo
  97.            ITAB(**)=IEL
  98.            I=L+1
  99.  22        CONTINUE
  100.            ILISEG(IEL)=I
  101.            nlis=I
  102.           endif
  103.           IEL=NLIS
  104.          ENDIF
  105. *
  106.       ELSE
  107. *
  108.          L=ITAB(/1)
  109. *        write (6,*) ' ajoun ',itab,l,numlis,iel
  110.          DO 1 I=1,L
  111.           IF(ITAB(I).EQ.IEL) GOTO 2
  112.  1       CONTINUE
  113.          ITAB(**)=IEL
  114.          I=L+1
  115.  2       CONTINUE
  116.          IEL=I
  117.       ENDIF
  118.       RETURN
  119.       END
  120.  
  121.  
  122.  

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