Télécharger placn.eso

Retour à la liste

Numérotation des lignes :

  1. C PLACN SOURCE PV 16/11/26 21:16:17 9205
  2. subroutine placn(itab,iel,iplace,invLis,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 a la place iplace.
  7. C Sort en erreur si l'element etait deja present
  8. c et renseigne le segment invLis pour aller plus vite
  9. c numlis indique s'il faut maintenir une liste inverse ou non
  10. c
  11. integer nlisse
  12. integer invPGD
  13. integer iel,iplace,ilis,ntab
  14. integer numlis
  15.  
  16. -INC CCOPTIO
  17. -INC TMCOLAC
  18. segment TABSEG
  19. integer leau(nTab)
  20. endsegment
  21. pointeur invLis.ILISSE
  22. pointeur itab.TABSEG
  23. nlisse = invLis.iliseg(/1)
  24. invPGD = invLis.npgcd
  25. if(numlis.eq.1) then
  26. if((iel-1)/invPGD.gt.nlisse) then
  27. nlisse = (iel-1)/invPGD*1.2
  28. segadj invLis
  29. endif
  30. ilis= invLis.iliseg((iel-1)/invPGD)
  31. if(ilis.eq.0) then
  32. C l'element n est pas encore dans le tableau
  33. nTab=itab.leau(/1)
  34. if(iplace.gt.nTab) then
  35. nTab=iplace
  36. segadj itab
  37. endif
  38. itab.leau(iplace)=iel
  39. invLis.iliseg((iel-1)/invPGD)=iplace
  40. else
  41. * verif que c'est la bonne pile
  42. if (itab.leau(ilis).ne.iel) then
  43. write (6,*) ' incoherence placn ',itab,iel,ilis,nlisse,
  44. & numlis,itab.leau(ilis)
  45. else
  46. write(6,*) 'PLACN Probleme:'
  47. write(6,*) 'l element est dans deja dans la liste'
  48. endif
  49. moterr(1:8)='ajoun'
  50. interr(1)=iel
  51. call erreur(861)
  52. return
  53. endif
  54. else
  55. nTab=itab.leau(/1)
  56. do ilis=1,nTab
  57. if(itab.leau(ilis).eq.iel) then
  58. write(6,*) 'PLACN Probleme:'
  59. write(6,*) 'l element est dans deja dans la liste'
  60. call erreur(861)
  61. return
  62. endif
  63. enddo
  64. if(iplace.gt.nTab) then
  65. nTab=iplace
  66. segadj itab
  67. endif
  68. itab.leau(iplace)=iel
  69. endif
  70. return
  71. end
  72.  
  73.  
  74.  

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