Télécharger la plaquette Cast3M


fr en

Télécharger rpenen.eso

Retour à la liste

Numérotation des lignes : 

rpenen

  1. C RPENEN    SOURCE    CHAT      05/01/13    03:07:02     5004
  2.       SUBROUTINE RPENEN(LETOUT,KRENTI,
  3.      $     LESLCT,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : RPENEN
  9. C DESCRIPTION : On repère les entiers de LETOUT tels que :
  10. C               KRENTI(LETOUT(i)).NE.0
  11. C
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          : -
  18. C APPELE PAR       : PROMAT
  19. C***********************************************************************
  20. C ENTREES            : LETOUT, KRENTI
  21. C SORTIES            : LESLCT
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION    : v1, 03/02/2000, version initiale
  25. C HISTORIQUE : v1, 03/02/2000, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMLENTI
  37.       POINTEUR LETOUT.MLENTI
  38.       POINTEUR KRENTI.MLENTI
  39.       INTEGER JG
  40.       POINTEUR LESLCT.MLENTI
  41. *
  42.       INTEGER IMPR,IRET
  43.       INTEGER ITOUT,ISLCT
  44.       INTEGER NTOUT
  45. *
  46. * Executable statements
  47. *
  48.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpenen.eso'
  49.       SEGACT LETOUT
  50.       NTOUT=LETOUT.LECT(/1)
  51.       SEGACT KRENTI
  52.       JG=NTOUT
  53.       SEGINI LESLCT
  54.       ISLCT=0
  55.       DO 1 ITOUT=1,NTOUT
  56.          IF (KRENTI.LECT(LETOUT.LECT(ITOUT)).NE.0) THEN
  57.             ISLCT=ISLCT+1
  58.             LESLCT.LECT(ISLCT)=ITOUT
  59.          ENDIF
  60.  1    CONTINUE
  61.       JG=ISLCT
  62.       SEGADJ,LESLCT
  63.       SEGDES LESLCT
  64.       SEGDES KRENTI
  65.       SEGDES LETOUT
  66. *
  67. * Normal termination
  68. *
  69.       IRET=0
  70.       RETURN
  71. *
  72. * Format handling
  73. *
  74. *
  75. * Error handling
  76. *
  77.  9999 CONTINUE
  78.       IRET=1
  79.       WRITE(IOIMP,*) 'An error was detected in subroutine rpenen'
  80.       RETURN
  81. *
  82. * End of subroutine RPENEN
  83. *
  84.       END
  85.  
  86.  
  87.  
  88.  

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