Télécharger la plaquette Cast3M


fr en

Télécharger retopi.eso

Retour à la liste

Numérotation des lignes : 

retopi

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

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