Télécharger ajoun.eso

Retour à la liste

Numérotation des lignes :

  1. C AJOUN SOURCE PV 18/02/13 21:15:00 9744
  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. -INC CCOPTIO
  17. -INC TMCOLAC
  18. SEGMENT ITAB(0)
  19. segact ITAB*mod
  20. NLISSE = ILISEG(/1)
  21. *
  22. IF(NUMLIS.EQ.1) THEN
  23. *
  24. IF((IEL-1)/npgcd.GT.NLISSE) THEN
  25. NLISSE = (IEL-1)/npgcd*1.2+1
  26. SEGADJ ILISSE
  27. ENDIF
  28. NLIS= ILISEG((IEL-1)/npgcd)
  29. IF(NLIS.EQ.0) THEN
  30. ITAB(**)=IEL
  31. ILISEG((IEL-1)/npgcd)=ITAB(/1)
  32. IEL=ILISEG((IEL-1)/npgcd)
  33. ELSE
  34. * verif que c'est la bonne pile
  35. if (itab(nlis).ne.iel) then
  36. moterr(1:8)='ajoun'
  37. interr(1)=iel
  38. call erreur(861)
  39. write (6,*) ' incoherence ajoun ',itab,iel,nlis,nlisse,numlis,
  40. > itab(nlis)
  41. L=itab(/1)
  42. DO I=1,L
  43. IF(ITAB(I).EQ.IEL) GOTO 12
  44. enddo
  45. ITAB(**)=IEL
  46. I=L+1
  47. 12 CONTINUE
  48. iliseg((iel-1)/npgcd)=i
  49. nlis=I
  50. endif
  51. IEL=NLIS
  52. ENDIF
  53. *
  54. ELSEIF(NUMLIS.EQ.3) THEN
  55. *
  56. IF(IEL.GT.NLISSE) THEN
  57. NLISSE = IEL*1.2+1
  58. SEGADJ ILISSE
  59. ENDIF
  60. NLIS= ILISEG(IEL)
  61. IF(NLIS.EQ.0) THEN
  62. ITAB(**)=IEL
  63. ILISEG(IEL)=ITAB(/1)
  64. IEL=ILISEG(IEL)
  65. ELSE
  66. * verif que c'est la bonne pile
  67. if (itab(nlis).ne.iel) then
  68. ** moterr(1:8)='ajoun'
  69. ** interr(1)=iel
  70. ** write (6,*) ' ajoun itab iliseg '
  71. ** write (6,*) (itab(i),i=1,itab(/1))
  72. ** write (6,*) (iliseg(i),i=1,6 )
  73. ** call erreur(861)
  74. ** write (6,*) ' incoherence ajoun point ',itab,iel,nlis,nlisse,
  75. ** > numlis,itab(nlis)
  76. *** on peut etre incoherent apres une renumerotation. On remet en silence ilissp en ordre de marche
  77. **
  78. L=itab(/1)
  79. DO I=1,L
  80. IF(ITAB(I).EQ.IEL) GOTO 22
  81. enddo
  82. ITAB(**)=IEL
  83. I=L+1
  84. 22 CONTINUE
  85. ILISEG(IEL)=I
  86. nlis=I
  87. endif
  88. IEL=NLIS
  89. ENDIF
  90. *
  91. ELSE
  92. *
  93. L=ITAB(/1)
  94. * write (6,*) ' ajoun ',itab,l,numlis,iel
  95. DO 1 I=1,L
  96. IF(ITAB(I).EQ.IEL) GOTO 2
  97. 1 CONTINUE
  98. ITAB(**)=IEL
  99. I=L+1
  100. 2 CONTINUE
  101. IEL=I
  102. ENDIF
  103. RETURN
  104. END
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

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