Télécharger la plaquette Cast3M


fr en

Télécharger placn.eso

Retour à la liste

Numérotation des lignes : 

placn

  1. C PLACN     SOURCE    CB215821  26/06/25    21:15:20     12581          
  2.        subroutine placn(itab,iel,iplace,invLis,numlis)
  3. c
  4. c
  5. c   ajoute un element (de valeur iel) dans un segment extensible
  6. c    s il n y est deja a la place iplace.
  7. C   Sort en erreur si l'element etait deja present
  8. c   et renseigne le segment invLis pour aller plus vite
  9. c   numlis indique s'il faut maintenir une liste inverse ou non
  10. c
  11.       integer nlisse
  12.       integer invPGD
  13.       integer iel,iplace,ilis,ntab,ilocal
  14.       integer numlis
  15.  
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC TMCOLAC
  20.       segment TABSEG
  21.         integer  leau(nTab)
  22.       endsegment
  23.       pointeur invLis.ILISSE
  24.       pointeur itab.TABSEG
  25.       nlisse = invLis.iliseg(/1)
  26.       invPGD = invLis.npgcd
  27.       if(numlis.eq.1) then
  28.         ilocal = (iel-1)/invPGD
  29.          if(ilocal.gt.nlisse) then
  30.             nlisse =INT(REAL(ilocal)*1.2D0)
  31.             segadj invLis
  32.          endif
  33.          ilis= invLis.iliseg((iel-1)/invPGD)
  34.          if(ilis.eq.0) then
  35. C           l'element n est pas encore dans le tableau
  36.             nTab=itab.leau(/1)
  37.             if(iplace.gt.nTab) then
  38.                nTab=iplace
  39.                segadj itab
  40.             endif
  41.             itab.leau(iplace)=iel
  42.             invLis.iliseg((iel-1)/invPGD)=iplace
  43.          else
  44. *  verif que c'est la bonne pile
  45.             if (itab.leau(ilis).ne.iel) then
  46.                write (6,*) ' incoherence placn ',itab,iel,ilis,nlisse,
  47.      &                                       numlis,itab.leau(ilis)
  48.             else
  49.                write(6,*) 'PLACN Probleme:'
  50.                write(6,*) 'l element est dans deja dans la liste'
  51.             endif
  52.             moterr(1:8)='ajoun'
  53.             interr(1)=iel
  54.             call erreur(861)
  55.             return
  56.          endif
  57.       else
  58.          nTab=itab.leau(/1)
  59.          do ilis=1,nTab
  60.             if(itab.leau(ilis).eq.iel) then
  61.                write(6,*) 'PLACN Probleme:'
  62.                write(6,*) 'l element est dans deja dans la liste'
  63.                call erreur(861)
  64.                return
  65.             endif
  66.          enddo
  67.          if(iplace.gt.nTab) then
  68.             nTab=iplace
  69.             segadj itab
  70.          endif
  71.          itab.leau(iplace)=iel
  72.       endif
  73.       return
  74.       end
  75.  
  76.  
  77.  
  78.  
  79.  

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