Télécharger la plaquette Cast3M


fr en

Télécharger cdpili.eso

Retour à la liste

Numérotation des lignes : 

cdpili

  1. C CDPILI    SOURCE    PV        17/12/05    21:15:08     9646           
  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.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC TMCOLAC
  18.       segment LISARG
  19.          character*8 nom(nArg)
  20.          integer     adress(nArg)
  21.       endsegment
  22.       pointeur jcolac.ICOLAC
  23.       pointeur pile.ITLACC
  24.       pointeur argume.LISARG
  25.       pointeur diff.LISARG
  26. C      write(ioimp,*) 'Entree dans CDPILI'
  27.       nArgu=argume.adress(/1)
  28.       if(iimpi.ge.7) then
  29.          write(ioimp,*) 'Nombe d objets a verifier',nArgu
  30.       endif
  31.       nArg0=diff.adress(/1)
  32.       nArg=nArg0+nArgu
  33.  
  34.       segadj diff
  35.       narg=nArg0
  36.  
  37. C pour chaque argument
  38.       do iArgu =1,nArgu
  39. C        recuperer son type
  40.          typNom = argume.nom(iArgu)
  41.          if(iimpi.gt.0) then
  42.                   if (typnom.ne.'POINT') then
  43.             write(ioimp,*) 'Objet ',iArgu,' de type ',typnom
  44.                endif
  45.          endif
  46. C        recuper le numero de pile associe
  47.          call typfil (typNom,iPile)
  48.          iPopi = argume.adress(iArgu)
  49.          pile=jcolac.kcola(iPile)
  50.          nObj=pile.itlac(/1)
  51.          if(iPopi.gt.0.and.iPopi.le.nObj)  then
  52.             iPoint=pile.itlac(iPopi)
  53.             if(iPoint.le.0) then
  54.                if(iimpi.ge.7) then
  55.                   write(ioimp,*) 'A recevoir  en memoire'
  56.                   write(ioimp,*) 'Pointeur nul'
  57.                endif
  58.                nArg=nArg+1
  59.                diff.nom(nArg)=argume.nom(iArgu)
  60.                diff.adress(nArg)=argume.adress(iArgu)
  61.             else
  62.                if(iimpi.gt.0) then
  63.                   if (typnom.ne.'POINT') then
  64.                   write(ioimp,*) ' deja en memoire'
  65.                endif
  66.                endif
  67.  
  68.             endif
  69.          else
  70.             if(iimpi.ge.7) then
  71.                   write(ioimp,*) 'A recevoir  en memoire'
  72.               write(ioimp,*) 'Position en dehors des limites',iPoPi,'/',
  73.      &nObj
  74.             endif
  75.             nArg=nArg+1
  76.             diff.nom(nArg)=argume.nom(iArgu)
  77.             diff.adress(nArg)=argume.adress(iArgu)
  78.          endif
  79.       enddo
  80.       segadj diff
  81.  
  82. C      write(ioimp,*) 'Sortie de CDPILI'
  83.       end
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  

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