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

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