Télécharger la plaquette Cast3M


fr en

Télécharger cajppi.eso

Retour à la liste

Numérotation des lignes : 

cajppi

  1. C CAJPPI    SOURCE    PV        17/12/05    21:15:06     9646           
  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.  
  17. -INC PPARAM
  18. -INC CCOPTIO 
  19.       pointeur pilPri.ICOLAC
  20.       pointeur pilAjo.ICOLAC
  21.       pointeur pilP.ITLACC
  22.       pointeur pilA.ITLACC
  23.       pointeur seg2pi.ILISSE
  24. C      write(ioimp,*) 'Entree dans CAJPPI'
  25. C      call imppil(pilPri,0)
  26. C      call imppil(pilAjo,0)
  27.       seg2pi = pilPri.ilissg
  28.       nbPile=pilAjo.kcola(/1)
  29.       do  iPil=1,nbPile
  30.          pilP=pilPri.kcola(iPil)
  31.          pilA=pilAjo.kcola(iPil)
  32. C         segact pilP*mod
  33.          if(iPil.ge.24.and.iPil.le.27) then
  34. C        Pile de reel, logique,entier ou mot, rien a faire
  35.          elseif(iPil.eq.32) then
  36. C     Pile des noeuds, construction d'une liste inverse
  37.             pilP=pilPri.kcola(iPil)
  38.             pilA=pilAjo.kcola(iPil)
  39. C            if(renum) then
  40. C               segact pilA*mod
  41. C            else
  42. C               segact pilA
  43. C            endif
  44.             call ajouLN(pilA,pilP,renum)
  45.          else
  46.             if(iPil.eq.36)then
  47.                lisInv=0
  48.             else
  49.                lisInv=1
  50.             endif
  51.  
  52.             if(renum) then
  53. C               segact pilA*mod
  54.                nbObj=pilA.itlac(/1)
  55.                do iObj=1,nbObj
  56.                   iPoint =pilA.itlac(iObj)
  57.                   call ajoun(pilP,iPoint,seg2pi,lisInv)
  58.                   pilA.itlac(iObj)=iPoint
  59.                enddo
  60.             else
  61. C               segact pilA
  62.                nbObj=pilA.itlac(/1)
  63.                do iObj=1,nbObj
  64.                   iPoint =pilA.itlac(iObj)
  65.                   call ajoun(pilP,iPoint,seg2pi,lisInv)
  66.                enddo
  67.             endif
  68.          endif
  69.       enddo
  70. C      write(ioimp,*) 'Sortie de CAJPPI'
  71.       return
  72.       end
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  

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