Télécharger la plaquette Cast3M


fr en

Télécharger prgrap.eso

Retour à la liste

Numérotation des lignes : 

prgrap

  1. C PRGRAP    SOURCE    PV        20/09/26    21:19:24     10724          
  2.       SUBROUTINE PRGRAP(PMTOT,
  3.      $     ADJAC,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : PRGRAP
  9. C DESCRIPTION : Construit un graphe symétrique correspondant à un profil
  10. C               de matrice Morse.
  11. C
  12. C LANGAGE     : ESOPE
  13. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14. C               mél : gounand@semt2.smts.cea.fr
  15. C
  16. C***********************************************************************
  17. C APPELES          : RSETI
  18. C APPELE PAR       : RENUME
  19. C***********************************************************************
  20. C ENTREES            : PMTOT
  21. C SORTIES            : ADJAC
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION    : v1, 26/11/99, version initiale
  25. C HISTORIQUE : v1, 26/11/99, 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. -INC PPARAM
  34. -INC CCOPTIO
  36.       POINTEUR PMTOT.PMORS
  37.       POINTEUR PMTRAN.PMORS
  38.       POINTEUR PMSYM.PMORS
  39. *
  40. *     Segment LSTIND (liste séquentielle indexée)
  41. *
  42.       SEGMENT LSTIND
  43.       INTEGER IDX(NBM+1)
  44.       INTEGER IVAL(NBTVAL)
  45.       ENDSEGMENT
  46. *
  47. *     LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  48. *
  49. *     NBM      : NOMBRE DE MULTIPLETS
  50. *     NBTVAL   : NOMBRE TOTAL DE VALEURS
  51. *     IDX(I)   : INDICE DE LA PREMIERE VALEUR DU IEME
  52. *                MULTIPLET DANS LE TABLEAU IVAL
  53. *     IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  54. *
  55. *-INC SLSTIND
  56.       INTEGER NBM,NBTVAL
  57.       POINTEUR ADJAC.LSTIND
  58. *
  59.       INTEGER IMPR,IRET
  60. *
  61. * Executable statements
  62. *
  63.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prgrap'
  64. * In MAKPMT : SEGINI PMTRAN
  65.       CALL MAKPMT(PMTOT,
  66.      $     PMTRAN,
  67.      $     IMPR,IRET)
  68.       IF (IRET.NE.0) GOTO 9999
  69. * In FUSPRM : SEGINI PMSYM
  70.       CALL FUSPRM(PMTOT,PMTRAN,
  71.      $     PMSYM,
  72.      $     IMPR,IRET)
  73.       IF (IRET.NE.0) GOTO 9999
  74.       SEGSUP PMTRAN
  75.       SEGACT PMSYM
  76.       NBM=PMSYM.IA(/1)-1
  77.       NBTVAL=PMSYM.JA(/1)
  78.       SEGINI ADJAC
  79.       CALL RSETI(ADJAC.IDX,PMSYM.IA,PMSYM.IA(/1))
  80.       CALL RSETI(ADJAC.IVAL,PMSYM.JA,PMSYM.JA(/1))
  81.       SEGDES ADJAC
  82. *      SEGDES PMSYM
  83.       SEGSUP PMSYM
  84. *
  85. * Normal termination
  86. *
  87.       IRET=0
  88.       RETURN
  89. *
  90. * Format handling
  91. *
  92. *
  93. * Error handling
  94. *
  95.  9999 CONTINUE
  96.       IRET=1
  97.       WRITE(IOIMP,*) 'An error was detected in subroutine prgrap'
  98.       RETURN
  99. *
  100. * End of subroutine PRGRAP
  101. *
  102.       END
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

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