Télécharger la plaquette Cast3M


fr en

Télécharger trlsup.eso

Retour à la liste

Numérotation des lignes : 

trlsup

  1. C TRLSUP    SOURCE    GOUNAND   21/04/06    21:15:40     10940          
  2.       SUBROUTINE TRLSUP(TRAVL)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : TRLSUP
  7. C DESCRIPTION : Suppression d'un segment TRAVL 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 TMATOP2
  34. -INC TMATOP1
  35. *-INC SMELEMX
  36.       POINTEUR LMCANS.MELEMX
  37.       POINTEUR IPBTL.MELEMX
  38. -INC SMLENTI
  39.       POINTEUR LIDXCA.MLENTI
  40.       POINTEUR LOKVOL.MLENTI
  41.       POINTEUR LNQUAL.MLENTI
  42.       POINTEUR LINDI.MLENTI
  43.       POINTEUR LINDJ.MLENTI
  44. -INC SMLREEL
  45.       POINTEUR LQUALS.MLREEL
  46. *-INC STRAVL
  47.       logical lchang
  48.       INTEGER IMPR,IRET
  49. *     
  50. * Executable statements
  51. *
  52.       if (impr.ge.5) WRITE(IOIMP,*) 'Entrée dans trlsup.eso'
  53. *
  54.       LMCANS=TRAVL.MCANS
  55.       if (lmcans.ne.0) segsup lmcans
  56.       LIDXCA=TRAVL.IDXCA
  57.       if (lidxca.ne.0) segsup lidxca
  58.       LOKVOL=TRAVL.OKVOL
  59.       if (lokvol.ne.0) segsup lokvol
  60.       LQUALS=TRAVL.QUALS
  61.       if (lquals.ne.0) segsup lquals
  62.       LNQUAL=TRAVL.NQUAL
  63.       if (lnqual.ne.0) segsup lnqual
  64.       LINDI=TRAVL.INDI
  65.       if (lindi.ne.0) segsup lindi
  66.       LINDJ=TRAVL.INDJ
  67.       if (lindj.ne.0) segsup lindj
  68.       IPBTL=TRAVL.PBTL
  69.       if (ipbtl.ne.0) segsup ipbtl
  70. *
  71.       segsup travl
  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)='TRLSUP  '
  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 TRLSUP
  96. *
  97.       END
  98.  
  99.  
  100.  

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