Numérotation des lignes :

C DIAMTR    SOURCE    CHAT      05/01/12    22:49:57     5004      SUBROUTINE DIAMTR(N,E2,ADJ,XADJ,     $MASK,$     LS,XLS,HLEVEL,     $SNODE,NC,$     IMPR,IRET)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)C***********************************************************************C NOM         : DIAMTRC DESCRIPTION : Find nodes which define a pseudo-diameter of a graphC               and store distances from end nodeCC LANGAGE     : FORTRAN 77 (sauf E/S)CC AUTEUR      : Scott SloanCC BIBLIO      : @Article{,C  author =       {S. W. Sloan},C  title =        {A Fortran Program for Profile and Wavefront Reduction},C  journal =      {International Journal for Numerical Methods in Engineering},C  year =         {1989},C  volume =    {28},C  pages =     {2651-2679}C}CC***********************************************************************C APPELES          : ROOTLS, ISHELIIC APPELE PAR       : LABELC***********************************************************************C ENTREES            :C     N      - The total number of nodes in the graphC     E2     - Twice the number of edges in the graph = XADJ(N+1)-1C     ADJ    - Adjacency list for all nodes in graphC            - List of length 2E where E is the number of edges inC              the graph and 2E = XADJ(N+1)-1C     XADJ   - Index vector for ADJC            - Nodes adjacent to node I are found in ADJ(J), whereC              J = XADJ(I),...,XADJ(I+1)-1C            - Degree of node I given by XADJ(I+1)-XADJ(I)C ENTREES/SORTIES    : -C     MASK(E)- Masking vector for graphC            - Visible nodes have MASK = 0, node invisible otherwiseC     MASK(S)- List of distances of nodes from the end nodeC SORTIES            :C     LS     - List of nodes in the componentC     SNODE  - Starting node for numberingC     NC     - The number of nodes in this component of the graphC TABLEAUX DE TRAVAIL :C     XLS    - Not usedC     HLEVEL - Not usedCC NOTES              :CC     SNODE and ENODE define a pseudo-diameterCC CODE RETOUR (IRET) : = 0 si tout s'est bien passéC***********************************************************************C VERSION    : v1, 05/11/99, version initialeC HISTORIQUE : v1, 10/03/89, créationC HISTORIQUE :     21/02/00, correction d'un bug apparaissant pour unC                            graphe plein.C HISTORIQUE :C***********************************************************************C Prière de PRENDRE LE TEMPS de compléter les commentairesC en cas de modification de ce sous-programme afin de faciliterC la maintenance !C*********************************************************************** -INC PPARAM-INC CCOPTIO      INTEGER NC,J,SNODE,DEGREE,MINDEG,ISTRT,ISTOP,HSIZE,NODE      INTEGER JSTRT,JSTOP,EWIDTH,I,WIDTH,DEPTH,ENODE,N,SDEPTH,E2      INTEGER XADJ(N+1),ADJ(E2),XLS(N+1),LS(N),MASK(N),HLEVEL(N)      INTEGER IMPR,IRET** Executable statements*      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans diamtr'**     Choose first guess for starting node by min degree*     Ignore nodes that are invisible (MASK ne 0)*      MINDEG=N      DO 10 I=1,N         IF (MASK(I).EQ.0) THEN            DEGREE=XADJ(I+1)-XADJ(I)CAvant 21/02/00             IF (DEGREE.LT.MINDEG) THEN            IF (DEGREE.LE.MINDEG) THEN               SNODE=I               MINDEG=DEGREE            ENDIF         ENDIF 10   CONTINUE**     Generate level structure for node with min degree*      CALL ROOTLS(N,SNODE,N+1,E2,ADJ,XADJ,MASK,     $LS,XLS,SDEPTH,WIDTH,$     IMPR,IRET)      IF (IRET.NE.0) GOTO 9999**     Store number of nodes in this component*      NC=XLS(SDEPTH+1)-1**     Iterate to find start and end nodes* 15   CONTINUE**     Store list of nodes that are at max distance from starting node*     Store their degrees in XLS*      HSIZE=0      ISTRT=XLS(SDEPTH)      ISTOP=XLS(SDEPTH+1)-1      DO 20 I=ISTRT,ISTOP         NODE=LS(I)         HSIZE=HSIZE+1         HLEVEL(HSIZE)=NODE         XLS(NODE)=XADJ(NODE+1)-XADJ(NODE) 20   CONTINUE**     Sort list of nodes in ascending sequence of their degree*     Use (insertion sort algorithm) Shell's method*      IF (HSIZE.GT.1) THEN         CALL ISHELI(HSIZE,HLEVEL,N,XLS,     $IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF** Remove nodes with duplicate degrees* ISTOP=HSIZE HSIZE=1 DEGREE=XLS(HLEVEL(1)) DO 25 I=2,ISTOP NODE=HLEVEL(I) IF (XLS(NODE).NE.DEGREE) THEN DEGREE=XLS(NODE) HSIZE=HSIZE+1 HLEVEL(HSIZE)=NODE ENDIF 25 CONTINUE** Loop over nodes in shrunken level* EWIDTH=NC+1 DO 30 I=1,HSIZE NODE=HLEVEL(I)** Form rooted level structures for each node in shrunken level* CALL ROOTLS(N,NODE,EWIDTH,E2,ADJ,XADJ,MASK,$        LS,XLS,DEPTH,WIDTH,     $IMPR,IRET) IF (IRET.NE.0) GOTO 9999 IF (WIDTH.LT.EWIDTH) THEN** Level structure was not aborted during assembly* IF (DEPTH.GT.SDEPTH) THEN** Level structure of greater depth found* Store new starting node, new max depth, and begin* a new iteration* SNODE=NODE SDEPTH=DEPTH GOTO 15 ENDIF** Level structure width for this end node is smallest so far* store end node and new min width* ENODE=NODE EWIDTH=WIDTH ENDIF 30 CONTINUE** Generate level structure rooted at end node if necessary* IF (NODE.NE.ENODE) THEN CALL ROOTLS(N,ENODE,NC+1,E2,ADJ,XADJ,MASK,$        LS,XLS,DEPTH,WIDTH,     \$        IMPR,IRET)         IF (IRET.NE.0) GOTO 9999      ENDIF**     Store distances of each node from end node*      DO 50 I=1,DEPTH         JSTRT=XLS(I)         JSTOP=XLS(I+1)-1         DO 40 J=JSTRT,JSTOP            MASK(LS(J))=I-1 40      CONTINUE 50   CONTINUE** Normal termination*      IRET=0      RETURN** Format handling*** Error handling* 9999 CONTINUE      IRET=1      WRITE(IOIMP,*) 'An error was detected in subroutine diamtr'      RETURN** End of subroutine DIAMTR*      END

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