1 : C PRSLOA SOURCE CHAT 05/01/13 02:35:35 5004
2 : SUBROUTINE PRSLOA(ADJAC,
3 : $ NEWNUM,
4 : $ IMPR,IRET)
5 : IMPLICIT INTEGER(I-N)
6 : IMPLICIT REAL*8 (A-H,O-Z)
7 : C***********************************************************************
8 : C NOM : PRSLOA
9 : C DESCRIPTION : Renumérotation d'un graphe par la méthode de SLOAN
10 : C
11 : C LANGAGE : ESOPE
12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
13 : C mél : gounand@semt2.smts.cea.fr
14 : C BIBLIO : @Article{,
15 : C author = {S. W. Sloan},
16 : C title = {A Fortran Program for Profile and Wavefront Reduction},
17 : C journal = {International Journal for Numerical Methods in Engineering},
18 : C year = {1989},
19 : C volume = {28},
20 : C pages = {2651-2679}
21 : C}
22 : C
23 : C***********************************************************************
24 : C APPELES : LABEL, PROFIL
25 : C APPELE PAR : RENUME
26 : C***********************************************************************
27 : C ENTREES : ADJAC
28 : C SORTIES : NEWNUM
29 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
30 : C***********************************************************************
31 : C VERSION : v1, 10/11/99, version initiale
32 : C HISTORIQUE : v1, 10/11/99, création
33 : C HISTORIQUE :
34 : C HISTORIQUE :
35 : C***********************************************************************
36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
37 : C en cas de modification de ce sous-programme afin de faciliter
38 : C la maintenance !
39 : C***********************************************************************
40 : -INC CCOPTIO
41 : -INC SMLENTI
42 : INTEGER JG
43 : POINTEUR IWORK.MLENTI
44 : POINTEUR NEWNUM.MLENTI
45 : *
46 : * Segment LSTIND (liste séquentielle indexée)
47 : *
48 : SEGMENT LSTIND
49 : INTEGER IDX(NBM+1)
50 : INTEGER IVAL(NBTVAL)
51 : ENDSEGMENT
52 : *
53 : * LISTE SEQUENTIELLE INDEXEE D'ENTIERS
54 : *
55 : * NBM : NOMBRE DE MULTIPLETS
56 : * NBTVAL : NOMBRE TOTAL DE VALEURS
57 : * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME
58 : * MULTIPLET DANS LE TABLEAU IVAL
59 : * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET
60 : *
61 : *-INC SLSTIND
62 : POINTEUR ADJAC.LSTIND
63 : *
64 : INTEGER E2,NTOTPO
65 : INTEGER IMPR,IRET
66 : *
67 : * Executable statements
68 : *
69 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prsloa'
70 : SEGACT ADJAC
71 : NTOTPO=ADJAC.IDX(/1)-1
72 : JG=NTOTPO
73 : SEGINI NEWNUM
74 : JG=(3*NTOTPO)+1
75 : SEGINI IWORK
76 : E2=ADJAC.IDX(NTOTPO+1)-1
76 : CALL LABEL(NTOTPO,E2,ADJAC.IVAL,ADJAC.IDX,
77 : $ NEWNUM.LECT,
78 : $ IWORK.LECT,
79 : $ IMPR,IRET)
80 : IF (IRET.NE.0) GOTO 9999
81 : SEGSUP IWORK
82 : SEGDES NEWNUM
83 : SEGDES ADJAC
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 prsloa'
98 : RETURN
99 : *
100 : * End of subroutine PRSLOA
101 : *
102 : END
103 :
104 :
105 :
106 :
© Cast3M 2003 - All rights reserved.
Disclaimer