Télécharger la plaquette Cast3M


fr en

Télécharger topclv.eso

Retour à la liste

Numérotation des lignes : 

topclv

  1. C TOPCLV    SOURCE    GOUNAND   21/04/06    21:15:29     10940          
  2.       SUBROUTINE TOPCLV(TRAVJ,lchang)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPCLV
  7. C DESCRIPTION : Nettoyage des éléments nulles dans la topologie et
  8. C     dans son inverse (ces éléments nuls apparaissent dans TOPDIF et
  9. C     ne sont pas nettoyés tout de suite pour raison supposée de
  10. C     performance) 
  11. C
  12. * On utilise le segment JNBL pour noter le nouveau numéro d'élément
  13. C
  14. C     
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : 
  20. C APPELES (E/S)    :
  21. C APPELES (BLAS)   :
  22. C APPELES (CALCUL) :
  23. C APPELE PAR       :
  24. C***********************************************************************
  25. C SYNTAXE GIBIANE    :
  26. C ENTREES            :
  27. C ENTREES/SORTIES    :
  28. C SORTIES            :
  29. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  30. C***********************************************************************
  31. C VERSION    : v1, 17/10/2017, version initiale
  32. C HISTORIQUE : v1, 17/10/2017, création
  33. C HISTORIQUE :
  34. C HISTORIQUE :
  35. C***********************************************************************
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC TMATOP2
  39. -INC SMLENTI
  40.       POINTEUR JNBL.MLENTI
  41.       POINTEUR NEXTO.MLENTI
  42. -INC SMELEME
  43. *
  44. *     Le nombre d'éléments de JTOPO et le nombre de points de JCOORD
  45. *     vont être variables. Pour ne pas avoir à ajuster ces segments en
  46. *     permanence, on va dimensionner plus large, mais du coup, il faut
  47. *     aussi maintenir à la main le nombre de noeuds et d'éléments
  48. *     courants.
  49. *
  50. *     Le nombre d'éléments courants est NVCOU et le nombre d'éléments
  51. *     max est NVMAX. Idem pour le nombre de noeuds courants et max :
  52. *     NPCOU et NPMAX.
  53. *      
  54. * Numerotation locale des éléments JTOPO.NUM(NBNN,NBELEM)
  55. *      INTEGER NVCOU,NVMAX
  56.       POINTEUR JTOPO.MELEME
  57. -INC TMATOP1
  58. *-INC STOPINV
  59. *-INC STRAVJ
  60. *
  61.       logical lchang
  62. *     
  63. * Executable statements
  64. *
  65.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topclv.eso'
  66. *
  67. * Initialisation et extension des segments JTOPO et JCOORD
  68. *
  69.       IDIMP=IDIM+1
  70. *      
  71.       JTOPO=TRAVJ.TOPO
  72. *
  73. *     On compte le nombre d'éléments à enlever et ceux qui sont en
  74. *     dernière position
  75. *
  76.       nvenle=0
  77.       do iel=1,nvcou
  78.          if (jtopo.num(1,iel).eq.0) nvenle=nvenle+1
  79.       enddo
  80.       do iel=nvcou,1,-1
  81.          if (jtopo.num(1,iel).ne.0) then
  82.             nvco2=iel
  83.             goto 44
  84.          endif
  85.       enddo
  86.  44   continue
  87.       nvenl2=nvcou-nvco2
  88. *
  89.       if (impr.gt.5) then
  90.          write(ioimp,185) 'nvcou,nvenle,nvenle2=',nvcou,nvenle,nvenl2
  91.       endif         
  92. *
  93.       lchang=(nvenle.gt.0)
  94.       if (nvenle.gt.0) then
  95.          topinv=travj.topi
  96.          if (nvenle.ne.nvenl2) then
  97.             jnbl=travj.nbl
  98.             if (impr.gt.5) then
  99.                write(ioimp,*) 'Nettoyage elem avant'
  100.                call ecmai1(jtopo,0)
  101.                segact jtopo*mod
  102.                call ectopi(topinv,1)
  103.                call ectopi(topinv,2)
  104.                segact topinv*mod
  105.             endif
  106.  
  107.             iell=0
  108.             do iel=1,nvcou
  109.                if (jtopo.num(1,iel).ne.0) then
  110.                   iell=iell+1
  111.                   jnbl.lect(iel)=iell
  112.                   do ino=1,idimp
  113.                      jtopo.num(ino,iell)=jtopo.num(ino,iel)
  114.                   enddo
  115.                endif
  116.             enddo
  117.             do iel=iell+1,nvcou
  118.                do ino=1,idimp
  119.                   jtopo.num(ino,iel)=0
  120.                enddo
  121.             enddo
  122. *     
  123.             if (impr.gt.5) then
  124.                write(ioimp,*) 'Jtopo nettoyée'
  125.                call ecmai1(jtopo,0)
  126.                segact jtopo*mod
  127. *     
  128.                write(ioimp,*) 'Elements de la topologie a nettoyer :'
  129.                write(ioimp,187) (jnbl.lect(I),I=1,nvcou)
  130.             endif
  131.  
  132. *
  133.             kell=0
  134.             do iel=1,nvcou
  135.                iell=jnbl.lect(iel)
  136.                if (iell.ne.0) then
  137.                   kell=iell
  138.                   do ino=1,idimp
  139.                      last=tlc((iel-1)*idimp+ino)
  140.                      if (last.gt.0) then
  141.                         jel=((last-1)/idimp)+1
  142.                         jell=jnbl.lect(jel)
  143.                         if (impr.gt.6) then
  144.                            write(ioimp,185)
  145.      $                          'last,ino,iel,iell,jel,jell=',last,ino
  146.      $                          ,iel,iell,jel,jell
  147.                         endif
  148.                         last=last-((jel-jell)*idimp)
  149.                         if (impr.gt.6) then
  150.                            write(ioimp,185) 'last2=',last
  151.                         endif
  152.                      endif                     
  153.                      tlc((iell-1)*idimp+ino)=last
  154.                   enddo
  155.                endif
  156.             enddo
  157. * kell est le dernier élément non nul de jnbl         
  158.             do iel=kell+1,nvcou
  159.                do ino=1,idimp
  160.                   tlc((iel-1)*idimp+ino)=0
  161.                enddo
  162.             enddo
  163. *     
  164.             do ino=1,npcou
  165.                last=tic(ino)
  166.                if (last.gt.0) then
  167.                   jel=((last-1)/idimp)+1
  168.                   jell=jnbl.lect(jel)
  169.                   last=last-((jel-jell)*idimp)
  170.                endif                     
  171. *faux            if (last.gt.0) last=last-(nvenle*idimp)
  172.                tic(ino)=last
  173.             enddo
  174. * Nettoyage de jnbl
  175.             do iel=1,nvcou
  176.                iell=jnbl.lect(iel)
  177.                if (iell.ne.0) jnbl.lect(iel)=0
  178.             enddo
  179. *     
  180.             if (impr.gt.6) then
  181.                write(ioimp,*) 'Topinv nettoyée'
  182.                call ectopi(topinv,1)
  183.                call ectopi(topinv,2)
  184.                goto 9999
  185.             endif
  186.          endif
  187. * Dimensions         
  188.          nvcou=nvcou-nvenle
  189.          ldgt=ldgt-(nvenle*idimp)
  190.       endif
  191.       if (impr.gt.2) then
  192.          if (lchang) write(ioimp,185) 'topclv : nvenle=',nvenle
  193.       endif         
  194. *
  195. * Normal termination
  196. *
  197.       RETURN
  198. *
  199. * Format handling
  200. *
  201.  185  FORMAT (5X,A32,6I8)
  202.  186  FORMAT ('Segment ',A6,' ',A6,' ajusté de ',I6,' à ',I6)
  203.  187  FORMAT (5X,10I8)
  204.  188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  205.  189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  206.      $     ,' a le plus petit nb de voisins :',I3)
  207. *     
  208. * Error handling     
  209. *     
  210.  9999 CONTINUE
  211.       MOTERR(1:8)='TOPCLV  '
  212. * 349 2
  213. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  214.       CALL ERREUR(349)
  215.       RETURN
  216. *
  217. * End of subroutine TOPCLV
  218. *
  219.       END
  220.  
  221.  
  222.  

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