Télécharger prgrap.eso

Retour à la liste

Numérotation des lignes :

  1. C PRGRAP SOURCE PV 16/11/17 22:01:07 9180
  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 CCOPTIO
  34. POINTEUR PMTOT.PMORS
  35. POINTEUR PMTRAN.PMORS
  36. POINTEUR PMSYM.PMORS
  37. *
  38. * Segment LSTIND (liste séquentielle indexée)
  39. *
  40. SEGMENT LSTIND
  41. INTEGER IDX(NBM+1)
  42. INTEGER IVAL(NBTVAL)
  43. ENDSEGMENT
  44. *
  45. * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
  46. *
  47. * NBM : NOMBRE DE MULTIPLETS
  48. * NBTVAL : NOMBRE TOTAL DE VALEURS
  49. * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
  50. * MULTIPLET DANS LE TABLEAU IVAL
  51. * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
  52. *
  53. *-INC SLSTIND
  54. INTEGER NBM,NBTVAL
  55. POINTEUR ADJAC.LSTIND
  56. *
  57. INTEGER IMPR,IRET
  58. *
  59. * Executable statements
  60. *
  61. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prgrap'
  62. * In MAKPMT : SEGINI PMTRAN
  63. CALL MAKPMT(PMTOT,
  64. $ PMTRAN,
  65. $ IMPR,IRET)
  66. IF (IRET.NE.0) GOTO 9999
  67. * In FUSPRM : SEGINI PMSYM
  68. CALL FUSPRM(PMTOT,PMTRAN,
  69. $ PMSYM,
  70. $ IMPR,IRET)
  71. IF (IRET.NE.0) GOTO 9999
  72. SEGSUP PMTRAN
  73. SEGACT PMSYM
  74. NBM=PMSYM.IA(/1)-1
  75. NBTVAL=PMSYM.JA(/1)
  76. SEGINI ADJAC
  77. CALL RSETI(ADJAC.IDX,PMSYM.IA,PMSYM.IA(/1))
  78. CALL RSETI(ADJAC.IVAL,PMSYM.JA,PMSYM.JA(/1))
  79. SEGDES ADJAC
  80. * SEGDES PMSYM
  81. SEGSUP PMSYM
  82. *
  83. * Normal termination
  84. *
  85. IRET=0
  86. RETURN
  87. *
  88. * Format handling
  89. *
  90. *
  91. * Error handling
  92. *
  93. 9999 CONTINUE
  94. IRET=1
  95. WRITE(IOIMP,*) 'An error was detected in subroutine prgrap'
  96. RETURN
  97. *
  98. * End of subroutine PRGRAP
  99. *
  100. END
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  

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