Télécharger placn.eso

Retour à la liste

Numérotation des lignes :

  1. C PLACN SOURCE PV 17/12/05 21:17:01 9646
  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.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC TMCOLAC
  20. segment TABSEG
  21. integer leau(nTab)
  22. endsegment
  23. pointeur invLis.ILISSE
  24. pointeur itab.TABSEG
  25. nlisse = invLis.iliseg(/1)
  26. invPGD = invLis.npgcd
  27. if(numlis.eq.1) then
  28. if((iel-1)/invPGD.gt.nlisse) then
  29. nlisse = (iel-1)/invPGD*1.2
  30. segadj invLis
  31. endif
  32. ilis= invLis.iliseg((iel-1)/invPGD)
  33. if(ilis.eq.0) then
  34. C l'element n est pas encore dans le tableau
  35. nTab=itab.leau(/1)
  36. if(iplace.gt.nTab) then
  37. nTab=iplace
  38. segadj itab
  39. endif
  40. itab.leau(iplace)=iel
  41. invLis.iliseg((iel-1)/invPGD)=iplace
  42. else
  43. * verif que c'est la bonne pile
  44. if (itab.leau(ilis).ne.iel) then
  45. write (6,*) ' incoherence placn ',itab,iel,ilis,nlisse,
  46. & numlis,itab.leau(ilis)
  47. else
  48. write(6,*) 'PLACN Probleme:'
  49. write(6,*) 'l element est dans deja dans la liste'
  50. endif
  51. moterr(1:8)='ajoun'
  52. interr(1)=iel
  53. call erreur(861)
  54. return
  55. endif
  56. else
  57. nTab=itab.leau(/1)
  58. do ilis=1,nTab
  59. if(itab.leau(ilis).eq.iel) then
  60. write(6,*) 'PLACN Probleme:'
  61. write(6,*) 'l element est dans deja dans la liste'
  62. call erreur(861)
  63. return
  64. endif
  65. enddo
  66. if(iplace.gt.nTab) then
  67. nTab=iplace
  68. segadj itab
  69. endif
  70. itab.leau(iplace)=iel
  71. endif
  72. return
  73. end
  74.  
  75.  
  76.  
  77.  

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