Télécharger la plaquette Cast3M


fr en

Télécharger retop2.eso

Retour à la liste

Numérotation des lignes : 

retop2

  1. C RETOP2    SOURCE    GOUNAND   21/04/06    21:15:23     10940          
  2.       SUBROUTINE RETOP2(TRAVJ,IMPR)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : RETOP2
  7. C DESCRIPTION : Remplit une topologie inverse avec les NEL premiers
  8. C     éléments de MELEME. Si NEL est négatif, on prend tous les éléments
  9. C     de MELEME. Si le premier noeud d'un élément de MELEME est 0,
  10. C     l'élément est sauté. Si un autre noeud de l'élément est nul , on
  11. C     part en erreur.
  12. C         
  13. C      
  14. C      
  15. C
  16. C LANGAGE     : ESOPE
  17. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  18. C               mél : gounand@semt2.smts.cea.fr
  19. C***********************************************************************
  20. C***********************************************************************
  21. C SYNTAXE GIBIANE    : 
  22. C ENTREES            : MELEME (Activé), NEL
  23. C ENTREES/SORTIES    : TOPINV (Activé *MOD)
  24. C SORTIES            :
  25. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26. C***********************************************************************
  27. C VERSION    : v1, 02/10/2017, version initiale
  28. C HISTORIQUE : v1, 02/10/2017, création
  29. C HISTORIQUE :
  30. C HISTORIQUE :
  31. C***********************************************************************
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMELEME
  35.       POINTEUR JTOPO.MELEME
  36. -INC TMATOP1      
  37. *-INC STOPINV
  38. *-INC STRAVJ
  39. *     
  40. * Executable statements
  41. *
  42.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans retop2.eso'
  43.       IDIMP=IDIM+1
  44.       TOPINV=TRAVJ.TOPI
  45.       JTOPO=TRAVJ.TOPO
  46. * Il y a un problème ici ????      
  47.       NBELEM=JTOPO.NUM(/2)
  48.       NEL=NVCOU
  49.       IF (NEL.GT.NBELEM) THEN
  50.          write(ioimp,*) 'Nombre d''elements a ajouter trop grand'
  51.          goto 9999
  52.       ENDIF
  53.       IF (NEL.GE.0) NBELEM=NEL
  54. *
  55. * Remplissage de la topologie inverse
  56. *
  57.       DO 1 IEL=1,NEL
  58.          DO 10 INO=1,IDIMP
  59.             IP=JTOPO.NUM(INO,IEL)
  60. *            IF (IP.EQ.0) THEN
  61. **     On saute l'élément
  62. *               IF (INO.EQ.1) GOTO 1
  63. *               write(ioimp,*) 'Meleme incorrect, noeud nul'
  64. *               goto 9999
  65. *            ENDIF
  66. * Ajout de IP dans la bonne liste chaînée 
  67.             LDGT=LDGT+1
  68.             IF (IP.NE.0) THEN
  69.                LAST=TIC(IP)
  70.                TLC(LDGT)=LAST
  71.                TIC(IP)=LDGT
  72.                TDC(IP)=TDC(IP)+1
  73.             ENDIF
  74.  10      CONTINUE
  75.  1    CONTINUE
  76. *
  77. * Normal termination
  78. *
  79.       RETURN
  80. *     
  81. * Error handling     
  82. *     
  83.  9999 CONTINUE
  84.       MOTERR(1:8)='RETOP2   '
  85. * 349 2
  86. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  87.       CALL ERREUR(349)
  88.       RETURN
  89. *
  90. * End of subroutine RETOP2
  91. *
  92.       END
  93.  
  94.  
  95.  

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