Télécharger clis2p.eso

Retour à la liste

Numérotation des lignes :

  1. C CLIS2P SOURCE PV 16/11/26 21:15:17 9205
  2. SUBROUTINE clis2p (jcolac,argume)
  3. C=======================================================================
  4. C Recherche de la position pointeurs arguments dans la pile de
  5. C communication (COLlaborateur LIste: numero Segment vers numero ds Pile
  6. C La routine renumerote la liste des arguments et remplace le pointeur
  7. C esope par la position dans pile
  8. C=======================================================================
  9. integer iArgu
  10. integer nArg
  11. integer iPile
  12. integer iPoint,iPoPi
  13. integer iNoeud,nNoeud,iNoLu,iNoRec
  14. character*8 typNom
  15. integer invPGD
  16. -INC CCOPTIO
  17. -INC TMCOLAC
  18. segment LISARG
  19. character*8 nom(nArg)
  20. integer adress(nArg)
  21. endsegment
  22. pointeur invPil.ILISSE
  23. pointeur pile.ITLACC
  24. pointeur argume.LISARG
  25. pointeur jcolac.ICOLAC
  26. c Recupere la liste d'argument
  27. c Pour chaque pile
  28. nArg = argume.adress(/1)
  29. C write(ioimp,*) 'Entre dans CLIS2P'
  30. C write(ioimp,*) 'Nombre d argu',nArg
  31. c
  32. C Liste de correspondance inverse (depuis le numero de segment vers
  33. C le numero dans la pile)
  34. invPil = jcolac.ilissg
  35. invPGD = invPil.npgcd
  36. C write(ioimp,*) 'PGCD est' ,invPGD
  37. C write(ioimp,*) 'La taille de invPil est' ,invPil.iliseg(/1)
  38. C Remplacement dans argume des numeros de pointeurs vers les numero de
  39. C liste
  40. C pour chaque argument
  41. do iArgu =1,nArg
  42. C recuperer son type
  43. typNom = argume.nom(iArgu)
  44. C recuper le numero de pile associe
  45. call typfil (typNom,iPile)
  46. C chercher le numero de segment dans ilisse
  47. pile = jcolac.kcola(iPile)
  48. C write(ioimp,*) 'Dump pile '
  49. C write(ioimp,*) (pile.itlac(i),i=1,pile.itlac(/1))
  50. C write(ioimp,*) 'pile',iPile
  51. C Les piles suivants n'ont pas de illiseg associe
  52. C if (iPile.eq.24) then
  53. C else if (iPile.eq.25) then
  54. C else if (iPile.eq.26) then
  55. C else if (iPile.eq.27) then
  56. C else
  57. if(iPile.eq.32) then
  58. C write(ioimp,*) 'On cherche le manuellement la pile positiom'
  59. C par contre, les points peuvent être ajouté automatiquement, il
  60. C faut donc les chercher dans les pies
  61. iNoRec = argume.adress(iArgu)
  62. C write(ioimp,*) iNoRec
  63. nNoeud = pile.itlac(/1)
  64. C write(ioimp,*) 'dans une pile de taille',nNoeud
  65. do iNoeud=1,nNoeud
  66. iNoLu = pile.itlac(iNoeud)
  67. C write(ioimp,*) 'Le ',iNoLu
  68. if(iNoRec.eq.iNoLu) goto 42
  69. enddo
  70. iNoeud=0
  71. 42 argume.adress(iArgu)=iNoeud
  72. C write(ioimp,*)'Argu :',iArgu,typNom,iNoeud
  73. elseif(iPile.ge.24.and.iPile.le.27) then
  74. C Pas ce changement de numerotation a faire
  75. else
  76. C on tape dans ilisseg
  77. iPoint = argume.adress(iArgu)
  78. C write(ioimp,*) 'iPoint',iPoint
  79. C write(ioimp,*) 'invPGD',invPGD
  80. iPoPi= invPil.iliseg((iPoint-1)/invPGD)
  81. C write(ioimp,*) 'iPoPi',iPoPi
  82. if(iPoPi.eq.0 .or. pile.itlac(iPoPi).ne.iPoint ) then
  83. write(ioimp,*)'Incoherence clis2p.'
  84. write(ioimp,*) 'La liste inverse n est pas correcte.'
  85. write(ioimp,*)'Probleme sur l argu :',iArgu,typNom,iPoint
  86. write (6,*) 'Recherche manuelle.'
  87. moterr(1:8)='clis2p'
  88. interr(1)=iPoint
  89. call erreur(861)
  90. do iPoPi=1,pile.itlac(/1)
  91. iNoLu = pile.itlac(iNoeud)
  92. if(iNoLu.eq.iPoint) goto 12
  93. enddo
  94. iPoPi=0
  95. endif
  96. 12 argume.adress(iArgu)=iPoPi
  97. C write(ioimp,*)'Argu :',iArgu,typNom,iPoPi
  98. endif
  99. enddo
  100. C write(ioimp,*) 'Sortie de CLIS2P'
  101. END
  102.  
  103.  
  104.  
  105.  

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