Télécharger la plaquette Cast3M


fr en

Télécharger clis2p.eso

Retour à la liste

Numérotation des lignes : 

clis2p

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

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