Télécharger cdpili.eso

Retour à la liste

Numérotation des lignes :

  1. C CDPILI SOURCE PV 16/11/26 21:15:07 9205
  2. subroutine cdpili(argume,jcolac,diff)
  3. C=======================================================================
  4. C Sous-programme cdpili (Collaborateur Difference PIle LIste)
  5. C Recheche les objets de la liste argume qui ne sont pas dans la pile
  6. C jcolac. Le resultat est enregistre dans la liste diff
  7. C=======================================================================
  8. integer iArgu,nArgu
  9. integer nArg
  10. integer iPile,iPoPi
  11. integer nObj
  12. integer iPoint
  13. character*(8) typNom
  14. -INC CCOPTIO
  15. -INC TMCOLAC
  16. segment LISARG
  17. character*8 nom(nArg)
  18. integer adress(nArg)
  19. endsegment
  20. pointeur jcolac.ICOLAC
  21. pointeur pile.ITLACC
  22. pointeur argume.LISARG
  23. pointeur diff.LISARG
  24. C write(ioimp,*) 'Entree dans CDPILI'
  25. nArgu=argume.adress(/1)
  26. if(iimpi.ge.7) then
  27. write(ioimp,*) 'Nombe d objets a verifier',nArgu
  28. endif
  29. nArg0=diff.adress(/1)
  30. nArg=nArg0+nArgu
  31.  
  32. segadj diff
  33. narg=nArg0
  34.  
  35. C pour chaque argument
  36. do iArgu =1,nArgu
  37. C recuperer son type
  38. typNom = argume.nom(iArgu)
  39. if(iimpi.gt.0) then
  40. if (typnom.ne.'POINT') then
  41. write(ioimp,*) 'Objet ',iArgu,' de type ',typnom
  42. endif
  43. endif
  44. C recuper le numero de pile associe
  45. call typfil (typNom,iPile)
  46. iPopi = argume.adress(iArgu)
  47. pile=jcolac.kcola(iPile)
  48. nObj=pile.itlac(/1)
  49. if(iPopi.gt.0.and.iPopi.le.nObj) then
  50. iPoint=pile.itlac(iPopi)
  51. if(iPoint.le.0) then
  52. if(iimpi.ge.7) then
  53. write(ioimp,*) 'A recevoir en memoire'
  54. write(ioimp,*) 'Pointeur nul'
  55. endif
  56. nArg=nArg+1
  57. diff.nom(nArg)=argume.nom(iArgu)
  58. diff.adress(nArg)=argume.adress(iArgu)
  59. else
  60. if(iimpi.gt.0) then
  61. if (typnom.ne.'POINT') then
  62. write(ioimp,*) ' deja en memoire'
  63. endif
  64. endif
  65.  
  66. endif
  67. else
  68. if(iimpi.ge.7) then
  69. write(ioimp,*) 'A recevoir en memoire'
  70. write(ioimp,*) 'Position en dehors des limites',iPoPi,'/',
  71. &nObj
  72. endif
  73. nArg=nArg+1
  74. diff.nom(nArg)=argume.nom(iArgu)
  75. diff.adress(nArg)=argume.adress(iArgu)
  76. endif
  77. enddo
  78. segadj diff
  79.  
  80. C write(ioimp,*) 'Sortie de CDPILI'
  81. end
  82.  
  83.  
  84.  
  85.  
  86.  

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