Esope source files

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