Télécharger ajoun.eso

Retour à la liste

Numérotation des lignes :

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

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