Télécharger ajoun.eso

Retour à la liste

Numérotation des lignes :

  1. C AJOUN SOURCE PV 16/11/28 21:15:02 9209
  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. nlis=I
  49. endif
  50. IEL=NLIS
  51. ENDIF
  52. *
  53. ELSEIF(NUMLIS.EQ.3) THEN
  54. *
  55. IF(IEL.GT.NLISSE) THEN
  56. NLISSE = IEL*1.2+1
  57. SEGADJ ILISSE
  58. ENDIF
  59. NLIS= ILISEG(IEL)
  60. IF(NLIS.EQ.0) THEN
  61. ITAB(**)=IEL
  62. ILISEG(IEL)=ITAB(/1)
  63. IEL=ILISEG(IEL)
  64. ELSE
  65. * verif que c'est la bonne pile
  66. if (itab(nlis).ne.iel) then
  67. moterr(1:8)='ajoun'
  68. interr(1)=iel
  69. call erreur(861)
  70. write (6,*) ' incoherence ajoun ',itab,iel,nlis,nlisse,numlis,
  71. > itab(nlis)
  72. L=itab(/1)
  73. DO I=1,L
  74. IF(ITAB(I).EQ.IEL) GOTO 22
  75. enddo
  76. ITAB(**)=IEL
  77. I=L+1
  78. 22 CONTINUE
  79. nlis=I
  80. endif
  81. IEL=NLIS
  82. ENDIF
  83. *
  84. ELSE
  85. *
  86. L=ITAB(/1)
  87. * write (6,*) ' ajoun ',itab,l,numlis,iel
  88. DO 1 I=1,L
  89. IF(ITAB(I).EQ.IEL) GOTO 2
  90. 1 CONTINUE
  91. ITAB(**)=IEL
  92. I=L+1
  93. 2 CONTINUE
  94. IEL=I
  95. ENDIF
  96. RETURN
  97. END
  98.  
  99.  
  100.  
  101.  
  102.  

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