Télécharger topsup.eso

Retour à la liste

Numérotation des lignes :

topsup
  1. C TOPSUP SOURCE GOUNAND 21/04/06 21:15:32 10940
  2. SUBROUTINE TOPSUP(TRAVJ)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : TOPSUP
  7. C DESCRIPTION : Suppression d'un segment TRAVJ et de ses éventuels
  8. C sous-objets.
  9. C
  10. C LANGAGE : ESOPE
  11. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  12. C mél : gounand@semt2.smts.cea.fr
  13. C***********************************************************************
  14. C APPELES :
  15. C APPELES (E/S) :
  16. C APPELES (BLAS) :
  17. C APPELES (CALCUL) :
  18. C APPELE PAR :
  19. C***********************************************************************
  20. C SYNTAXE GIBIANE :
  21. C ENTREES :
  22. C ENTREES/SORTIES :
  23. C SORTIES :
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 18/10/2017, version initiale
  27. C HISTORIQUE : v1, 18/10/2017, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMCOORD
  34. POINTEUR JCOORD.MCOORD
  35. -INC SMLENTI
  36. POINTEUR JNBL.MLENTI
  37. POINTEUR JNNO.MLENTI
  38. -INC SMELEME
  39. POINTEUR JTOPO.MELEME
  40. -INC TMATOP2
  41. -INC TMATOP1
  42. *-INC STOPINV
  43. *-INC SMETRIQ
  44. POINTEUR JCMETR.METRIQ
  45. *-INC STRAVJ
  46. -INC SMLMOTS
  47. POINTEUR JNMETR.MLMOTS
  48. *
  49. * Executable statements
  50. *
  51. if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans topsup.eso'
  52. *
  53. JCOORD=TRAVJ.COORD
  54. if (jcoord.ne.0) segsup jcoord
  55. JNMETR=TRAVJ.NMETR
  56. if (jnmetr.ne.0) segsup jnmetr
  57. JCMETR=TRAVJ.CMETR
  58. if (jcmetr.ne.0) segsup jcmetr
  59. JTOPO=TRAVJ.TOPO
  60. if (jtopo.ne.0) segsup jtopo
  61. *
  62. TOPINV=TRAVJ.TOPI
  63. if (topinv.ne.0) segsup topinv
  64. *
  65. jnbl=travj.nbl
  66. if (jnbl.ne.0) segsup jnbl
  67. *
  68. jnno=travj.nno
  69. if (jnno.ne.0) segsup jnno
  70. *
  71. segsup travj
  72. *
  73. * Normal termination
  74. *
  75. RETURN
  76. *
  77. * Format handling
  78. *
  79. 286 FORMAT ('Segment TRAV=',I8,' nbel max ajusté de ',I6,' à ',I6,
  80. $ ' (nbel. courant=',I6,')')
  81. * 187 FORMAT (5X,10I8)
  82. * 188 FORMAT ('Apres point IELEM(',I2,',1)=',I6,' ; NBL=')
  83. * 189 FORMAT ('Le noeud ',I2,'/',I2,' de IELEM de numero',I6
  84. * $ ,' a le plus petit nb de voisins :',I3)
  85. *
  86. * Error handling
  87. *
  88. 9999 CONTINUE
  89. MOTERR(1:8)='TOPSUP '
  90. * 349 2
  91. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  92. CALL ERREUR(349)
  93. RETURN
  94. *
  95. * End of subroutine TOPSUP
  96. *
  97. END
  98.  
  99.  
  100.  

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