Sources Esope | Cast3M

label
C LABEL     SOURCE    CHAT      05/01/13    01:11:46     5004
      SUBROUTINE LABEL(N,E2,ADJ,XADJ,
     $     NNN,
     $     IW,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : LABEL
C DESCRIPTION : Label a graph for small profile and rms wavefront
C
C LANGAGE     : FORTRAN 77 (sauf E/S)
C
C AUTEUR      : Scott Sloan
C
C 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}
C
C***********************************************************************
C APPELES          : DIAMTR, NUMBER
C APPELE PAR       : PRSLOA
C***********************************************************************
C ENTREES            :
C     N      - Number of nodes in graph
C     E2     - Twice the number of edges in the graph = XADJ(N+1)-1
C     ADJ    - Adjacency list for all nodes in graph
C            - List of length 2E where E is the number of edges in
C              the graph and 2E = XADJ(N+1)-1
C     XADJ   - Index vector for ADJ
C            - Nodes adjacent to node I are found in ADJ(J), where
C              J = XADJ(I),...,XADJ(I+1)-1
C            - Degree of node I given by XADJ(I+1)-XADJ(I)
C ENTREES/SORTIES    : -
C SORTIES            :
C     NNN    - List of new node numbers
C            - New number for node I given by NNN(I)
C TABLEAU DE TRAVAIL : IW
C
C
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 05/11/99, version initiale
C HISTORIQUE : v1, 10/03/89, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
      INTEGER N,I1,I2,I3,SNODE,LSTNUM,NC,E2
      INTEGER XADJ(N+1),ADJ(E2),NNN(N),IW(3*N+1)
      INTEGER IMPR,IRET
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans label'
*
*     Set all new node numbers = 0
*     This is used to denote all visible nodes
*     (already done)
*
*      DO 10 I=1,N
*         NNN(I)=0
* 10   CONTINUE
*
*     Define offsets
*
      I1=1
      I2=I1+N
      I3=I2+N+1
*
*     Loop while some nodes remain unnumbered
*
      LSTNUM=0
 20   CONTINUE
      IF (LSTNUM.LT.N) THEN
*
*     Find end points of p-diameter for nodes in this component
*     Compute distances of nodes from end node
*
         CALL DIAMTR(N,E2,ADJ,XADJ,
     $        NNN,
     $        IW(I1),IW(I2),IW(I3),
     $        SNODE,NC,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*
*     Number nodes in this component
*
         CALL NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,
     $        NNN,
     $        IW(I1),IW(I2),
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         GOTO 20
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine label'
      RETURN
*
* End of subroutine LABEL
*
      END