Télécharger cajppi.eso

Retour à la liste

Numérotation des lignes :

  1. C CAJPPI SOURCE PV 16/11/26 21:15:04 9205
  2. subroutine cajppi(pilAjo,pilPri,renum)
  3. C=======================================================================
  4. C Sous-programme cajppi (Collaborateur AJoute Pile dans PIles
  5. C Ajoute les objets de la piles pilAjo dans la pile pilPri
  6. C si renum est vrai, la pile pilAjo est renumerote avec la position
  7. C dans la pile pilPri
  8.  
  9. C=======================================================================
  10. logical renum
  11. integer iPil,nbPile
  12. integer iPoint
  13. integer iObj,nbObj
  14. integer lisInv
  15. -INC TMCOLAC
  16. -INC CCOPTIO
  17. pointeur pilPri.ICOLAC
  18. pointeur pilAjo.ICOLAC
  19. pointeur pilP.ITLACC
  20. pointeur pilA.ITLACC
  21. pointeur seg2pi.ILISSE
  22. C write(ioimp,*) 'Entree dans CAJPPI'
  23. C call imppil(pilPri,0)
  24. C call imppil(pilAjo,0)
  25. seg2pi = pilPri.ilissg
  26. nbPile=pilAjo.kcola(/1)
  27. do iPil=1,nbPile
  28. pilP=pilPri.kcola(iPil)
  29. pilA=pilAjo.kcola(iPil)
  30. C segact pilP*mod
  31. if(iPil.ge.24.and.iPil.le.27) then
  32. C Pile de reel, logique,entier ou mot, rien a faire
  33. elseif(iPil.eq.32) then
  34. C Pile des noeuds, construction d'une liste inverse
  35. pilP=pilPri.kcola(iPil)
  36. pilA=pilAjo.kcola(iPil)
  37. C if(renum) then
  38. C segact pilA*mod
  39. C else
  40. C segact pilA
  41. C endif
  42. call ajouLN(pilA,pilP,renum)
  43. else
  44. if(iPil.eq.36)then
  45. lisInv=0
  46. else
  47. lisInv=1
  48. endif
  49.  
  50. if(renum) then
  51. C segact pilA*mod
  52. nbObj=pilA.itlac(/1)
  53. do iObj=1,nbObj
  54. iPoint =pilA.itlac(iObj)
  55. call ajoun(pilP,iPoint,seg2pi,lisInv)
  56. pilA.itlac(iObj)=iPoint
  57. enddo
  58. else
  59. C segact pilA
  60. nbObj=pilA.itlac(/1)
  61. do iObj=1,nbObj
  62. iPoint =pilA.itlac(iObj)
  63. call ajoun(pilP,iPoint,seg2pi,lisInv)
  64. enddo
  65. endif
  66. endif
  67. enddo
  68. C write(ioimp,*) 'Sortie de CAJPPI'
  69. return
  70. end
  71.  
  72.  
  73.  
  74.  
  75.  

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