Télécharger la plaquette Cast3M


fr en

Télécharger topdi2.eso

Retour à la liste

Numérotation des lignes : 

topdi2

  1. C TOPDI2    SOURCE    GOUNAND   21/04/06    21:15:30     10940          
  2.       SUBROUTINE TOPDI2(TRAVJ,TRAVX)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TOPDI2
  7. C DESCRIPTION : Etant donné une liste de numéros d'éléments à
  8. C     extraire, on les retire d'une topologie et de son inverse.
  9. C
  10. C     On essaie d'accélérer TOPDIF lorsque nexto est grand car cela a
  11. C     ete identifie comme une source de lenteur par gprof
  12. C     repris de topdif
  13. C
  14. C     On utilise JNBL comme segment inverse de NEXTO      
  15. C       
  16. C
  17. C LANGAGE     : ESOPE
  18. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  19. C               mél : gounand@semt2.smts.cea.fr
  20. C***********************************************************************
  21. C APPELES          : 
  22. C APPELES (E/S)    :
  23. C APPELES (BLAS)   :
  24. C APPELES (CALCUL) :
  25. C APPELE PAR       :
  26. C***********************************************************************
  27. C SYNTAXE GIBIANE    :
  28. C ENTREES            : JELEM
  29. C ENTREES/SORTIES    : JCOORD, JTOPO
  30. C SORTIES            :
  31. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  32. C***********************************************************************
  33. C VERSION    : v1, 18/12/2017, version initiale
  34. C HISTORIQUE : v1, 18/12/2017, création
  35. C HISTORIQUE :
  36. C HISTORIQUE :
  37. C***********************************************************************
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC TMATOP2
  41. -INC SMLENTI
  42.       POINTEUR NEXTO.MLENTI
  43.       POINTEUR JNBL.MLENTI
  44. -INC SMELEME
  45. *
  46. *     Le nombre d'éléments de JTOPO et le nombre de points de JCOORD
  47. *     vont être variables. Pour ne pas avoir à ajuster ces segments en
  48. *     permanence, on va dimensionner plus large, mais du coup, il faut
  49. *     aussi maintenir à la main le nombre de noeuds et d'éléments
  50. *     courants.
  51. *
  52. *     Le nombre d'éléments courants est NVCOU et le nombre d'éléments
  53. *     max est NVMAX. Idem pour le nombre de noeuds courants et max :
  54. *     NPCOU et NPMAX.
  55. *      
  56. * Numerotation locale des éléments JTOPO.NUM(NBNN,NBELEM)
  57. *      INTEGER NVCOU,NVMAX
  58.       POINTEUR JTOPO.MELEME
  59. -INC TMATOP1
  60. *-INC STOPINV
  61. *-INC STRAVJ
  62.       POINTEUR TRAVX.TRAVJ
  63. *
  64.       logical lchang
  65. *     
  66. * Executable statements
  67. *
  68.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topdi2.eso'
  69.  
  70. *
  71.       JTOPO=TRAVJ.TOPO
  72.       TOPINV=TRAVJ.TOPI
  73.       NEXTO=TRAVX.NBL
  74.       JNBL=TRAVJ.NBL
  75.       IDIMP=IDIM+1
  76.  
  77. *tst         write(ioimp,*) 'DIFF avant'
  78. *tst         call ecmai1(jtopo,0)
  79. *tst      write(ioimp,*) 'Elements de la topologie extraits :'
  80. *tst      write(ioimp,187) (nexto.lect(I),I=1,travx.nvcou)
  81. *tst         segact jtopo*mod
  82. *tst         call ectopi(topinv,1)
  83. *tst         call ectopi(topinv,2)
  84. *     tst         segact topinv*mod
  85. * Init JNBL      
  86.       do ielx=1,travx.nvcou
  87.          jnbl.lect(nexto.lect(ielx))=1
  88.       enddo      
  89.  
  90. *     Mise à jour de TOPINV
  91. *     Seuls les noeuds appartenant à jexto sont susceptibles d'être
  92. *     impactés. On utilise le signe de ldg pour savoir si on a déjà
  93. *     corrigé la liste chaînée du noeud
  94. *     On parcourt les éléments à l'envers, comme la liste chaînée.         
  95.       do ielx=travx.nvcou,1,-1
  96. *      do ielx=1,travx.nvcou
  97.          do inox=1,IDIMP
  98.             ip=JTOPO.NUM(inox,nexto.lect(ielx))
  99. *     Parcours de la liste chaînée ip si pas deja fait
  100.             ldg=tdc(ip)
  101. *tst               write(ioimp,185) 'ip,ldg=',ip,ldg
  102.             if (ldg.gt.0) then
  103.                lastp=0
  104.                last=tic(ip)
  105. *               jelx=ielx
  106. *               nelx=nexto.lect(jelx)
  107. *     idgx=1
  108.                ldgx=ldg
  109. *tst                  write(ioimp,185) 'idg,lastp,last,nelx=',0,lastp,last
  110. *tst     $                 ,nelx
  111.                do 77 idg=1,ldg
  112.                   iel=((last-1)/idimp)+1
  113. *tst                     write(ioimp,185) 'idg,nelx,iel,last=',idg,nelx,iel
  114. *tst     $                    ,last
  115.                   if (jnbl.lect(iel).eq.1) then
  116. * 771              continue
  117. *                  if (iel.eq.nelx) then
  118.                      lastn=tlc(last)
  119. *tst                        write(ioimp,185) 'idg,nelx,lastp,last,lastn='
  120. *tst     $                       ,idg,nelx,lastp,last,lastn
  121. * suppression d'un indice de la chaîne
  122.                      if (lastp.eq.0) then
  123.                         tic(ip)=lastn
  124.                      else
  125.                         tlc(lastp)=lastn
  126.                      endif
  127.                      tlc(last)=0
  128.                      last=lastn
  129.                      ldgx=ldgx-1
  130. *                     jelx=jelx-1
  131. *                     if (jelx.lt.1) then
  132. *                        goto 78
  133. *                     else
  134. *                        nelx=nexto.lect(jelx)
  135. *                     endif
  136. *                  elseif (iel.lt.nelx) then
  137. *                     jelx=jelx-1
  138. *                     if (jelx.lt.1) then
  139. *                        goto 78
  140. *                     else
  141. *                        nelx=nexto.lect(jelx)
  142. *                     endif
  143. *                     goto 771
  144. *     Si nelx<iel                        
  145.                   else
  146. *     idgx=idgx+1
  147.                      lastp=last
  148.                      last=tlc(last)
  149.                   endif
  150.  77            continue
  151.  78            continue
  152.                tdc(ip)=-ldgx
  153. *                  goto 79
  154.             endif
  155.          enddo
  156.       enddo
  157. *     79      continue
  158. * Raz JNBL
  159.       do ielx=1,travx.nvcou
  160.          jnbl.lect(nexto.lect(ielx))=0
  161.       enddo      
  162.  
  163. *
  164. *     On annule les éléments de JTOPO qui appartenait à JEXTO
  165. *     et on remet tdc positif         
  166. *
  167.       do iel=1,travx.nvcou
  168.          do ino=1,IDIMP
  169.             ip=JTOPO.NUM(INO,nexto.lect(iel))
  170.             tdc(ip)=abs(tdc(ip))
  171.             JTOPO.NUM(INO,nexto.lect(iel))=0
  172.          enddo
  173.       enddo
  174. * On vérifie la consistance de la topologie inverse
  175. *tst         write(ioimp,*) 'Changement detecte TOPINV apres'
  176. *tst         call ectopi(topinv,1)
  177. *tst         call ectopi(topinv,2)
  178.       travj.nvzer=travj.nvzer+travx.nvcou
  179. *     critere de nettoyage
  180.       if (travj.nvzer.gt.int((0.3d0*nvmax)+0.5d0)) then
  181.          call topclv(travj,lchang)
  182.          if (ierr.ne.0) return
  183.          if (iveri.ge.2.and.lchang) call vetopi(travj
  184.      $        ,'topdi2 : Apres nettoyage elem auto')
  185.          if (ierr.ne.0) return
  186.          travj.nvzer=0
  187.       endif
  188.  
  189. *
  190. * Normal termination
  191. *
  192.       RETURN
  193. *
  194. * Format handling
  195. *
  196.  185  FORMAT (5X,A32,6I8)
  197.  186  FORMAT ('Segment ',A6,' ',A6,' ajusté de ',I6,' à ',I6)
  198.  187  FORMAT (5X,10I8)
  199.  188  FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  200.  189  FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  201.      $     ,' a le plus petit nb de voisins :',I3)
  202. *     
  203. * Error handling     
  204. *     
  205.  9999 CONTINUE
  206.       MOTERR(1:8)='TOPDI2  '
  207. * 349 2
  208. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  209.       CALL ERREUR(349)
  210.       RETURN
  211. *
  212. * End of subroutine TOPDI2
  213. *
  214.       END
  215.  
  216.  
  217.  

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