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    PV        17/12/05    21:17:01     9646           
  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
  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.          if((iel-1)/invPGD.gt.nlisse) then
  29.             nlisse = (iel-1)/invPGD*1.2
  30.             segadj invLis
  31.          endif
  32.          ilis= invLis.iliseg((iel-1)/invPGD)
  33.          if(ilis.eq.0) then
  34. C           l'element n est pas encore dans le tableau
  35.             nTab=itab.leau(/1)
  36.             if(iplace.gt.nTab) then
  37.                nTab=iplace
  38.                segadj itab
  39.             endif
  40.             itab.leau(iplace)=iel
  41.             invLis.iliseg((iel-1)/invPGD)=iplace
  42.          else
  43. *  verif que c'est la bonne pile
  44.             if (itab.leau(ilis).ne.iel) then
  45.                write (6,*) ' incoherence placn ',itab,iel,ilis,nlisse,
  46.      &                                       numlis,itab.leau(ilis)
  47.             else
  48.                write(6,*) 'PLACN Probleme:'
  49.                write(6,*) 'l element est dans deja dans la liste'
  50.             endif
  51.             moterr(1:8)='ajoun'
  52.             interr(1)=iel
  53.             call erreur(861)
  54.             return
  55.          endif
  56.       else
  57.          nTab=itab.leau(/1)
  58.          do ilis=1,nTab
  59.             if(itab.leau(ilis).eq.iel) then
  60.                write(6,*) 'PLACN Probleme:'
  61.                write(6,*) 'l element est dans deja dans la liste'
  62.                call erreur(861)
  63.                return
  64.             endif
  65.          enddo
  66.          if(iplace.gt.nTab) then
  67.             nTab=iplace
  68.             segadj itab
  69.          endif
  70.          itab.leau(iplace)=iel
  71.       endif
  72.       return
  73.       end
  74.  
  75.  
  76.  
  77.  

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