Télécharger la plaquette Cast3M


fr en

Télécharger rootls.eso

Retour à la liste

Numérotation des lignes : 

rootls

  1. C ROOTLS    SOURCE    CHAT      05/01/13    03:04:26     5004
  2.       SUBROUTINE ROOTLS(N,ROOT,MAXWID,E2,ADJ,XADJ,MASK,
  3.      $     LS,XLS,DEPTH,WIDTH,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : ROOTLS
  9. C DESCRIPTION : Generate rooted level structure using a FORTRAN 77
  10. C               implementation of the algorithm given by George and Liu
  11. C
  12. C LANGAGE     : FORTRAN 77 (sauf E/S)
  13. C
  14. C AUTEUR      : Scott Sloan
  15. C
  16. C BIBLIO      : @Article{,
  17. C  author =  {S. W. Sloan},
  18. C  title =   {A Fortran Program for Profile and Wavefront Reduction},
  19. C  journal = {International Journal for Numerical Methods in Engineering},
  20. C  year =    {1989},
  21. C  volume =  {28},
  22. C  pages =   {2651-2679}
  23. C}
  24. C
  25. C***********************************************************************
  26. C APPELES          : ROOTLS, ISHELI
  27. C APPELE PAR       : DIAMTR
  28. C***********************************************************************
  29. C ENTREES            :
  30. C     N      - Number of nodes
  31. C     ROOT   - Root node for level structure
  32. C     MAXWID - Max permissible width of rooted level structure
  33. C            - Abort assembly of level structure if width is ge MAXWID
  34. C            - Assembly insured by setting MAXWID = N+1
  35. C     E2     - Twice the number of edges in the graph = XADJ(N+1)-1
  36. C     ADJ    - Adjacency list for all nodes in graph
  37. C            - List of length 2E where E is the number of edges in
  38. C              the graph and 2E = XADJ(N+1)-1
  39. C     XADJ   - Index vector for ADJ
  40. C            - Nodes adjacent to node I are found in ADJ(J), where
  41. C              J = XADJ(I),...,XADJ(I+1)-1
  42. C            - Degree of node I given by XADJ(I+1)-XADJ(I)
  43. C     MASK   - Masking vector for graph
  44. C            - Visible nodes have MASK = 0
  45. C ENTREES/SORTIES    : -
  46. C SORTIES            :
  47. C     LS     - List containing a rooted level structure
  48. C            - List of length NC
  49. C     XLS    - Index vector for LS
  50. C            - Nodes in level I are found in LS(J), where
  51. C              J = XLS(I),...,XLS(I+1)-1
  52. C            - List of max length NC+1
  53. C     DEPTH  - Number of levels in rooted level structure
  54. C     WIDTH  - Width of rooted level structure
  55. C
  56. C NOTES              :
  57. C
  58. C     If WIDTH ge MAXWID then assembly has been aborted
  59. C
  60. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  61. C***********************************************************************
  62. C VERSION    : v1, 05/11/99, version initiale
  63. C HISTORIQUE : v1, 10/03/89, création
  64. C HISTORIQUE :
  65. C HISTORIQUE :
  66. C***********************************************************************
  67. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  68. C en cas de modification de ce sous-programme afin de faciliter
  69. C la maintenance !
  70. C***********************************************************************
  71. -INC PPARAM
  72. -INC CCOPTIO
  73.       INTEGER ROOT,DEPTH,NBR,MAXWID,LSTRT,LSTOP,LWDTH
  74.       INTEGER NODE,NC,WIDTH,N,JSTRT,JSTOP,I,J,E2
  75.       INTEGER XADJ(N+1),ADJ(E2),MASK(N),XLS(N+1),LS(N)
  76.       INTEGER IMPR,IRET
  77. *
  78. * Executable statements
  79. *
  80.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rootls'
  81. *
  82. *     Initialisation
  83. *
  84.       MASK(ROOT)=1
  85.       LS(1)=ROOT
  86.       NC   =1
  87.       WIDTH=1
  88.       DEPTH=0
  89.       LSTOP=0
  90.       LWDTH=1
  91.  10   CONTINUE
  92.       IF (LWDTH.GT.0) THEN
  93. *
  94. *     LWDTH is the width of the current level
  95. *     LSTRT points to start of current level
  96. *     LSTOP points to ende of current level
  97. *     NC counts the nodes in component
  98. *
  99.          LSTRT=LSTOP+1
  100.          LSTOP=NC
  101.          DEPTH=DEPTH+1
  102.          XLS(DEPTH)=LSTRT
  103. *
  104. *     Generate next levle by finding all visible neighbours
  105. *     of node in current level
  106. *
  107.          DO 30 I=LSTRT,LSTOP
  108.             NODE=LS(I)
  109.             JSTRT=XADJ(NODE)
  110.             JSTOP=XADJ(NODE+1)-1
  111.             DO 20 J=JSTRT,JSTOP
  112.                NBR=ADJ(J)
  113.                IF (MASK(NBR).EQ.0) THEN
  114.                   NC=NC+1
  115.                   LS(NC)=NBR
  116.                   MASK(NBR)=1
  117.                ENDIF
  118.  20         CONTINUE
  119.  30      CONTINUE
  120. *
  121. *     Compute width of level just assembled and the width of the
  122. *     level structure so far
  123. *
  124.          LWDTH=NC-LSTOP
  125.          WIDTH=MAX(LWDTH,WIDTH)
  126. *
  127. *     Abort assembly if level structure is too wide
  128. *
  129.          IF (WIDTH.GE.MAXWID) GOTO 35
  130.          GOTO 10
  131.       ENDIF
  132.       XLS(DEPTH+1)=LSTOP+1
  133. *
  134. *     Reset MASK=0 for nodes in the level structure
  135. *
  136.  35   CONTINUE
  137.       DO 40 I=1,NC
  138.          MASK(LS(I))=0
  139.  40   CONTINUE
  140. *
  141. * Normal termination
  142. *
  143.       IRET=0
  144.       RETURN
  145. *
  146. * Format handling
  147. *
  148. *
  149. * Error handling
  150. *
  151.  9999 CONTINUE
  152.       IRET=1
  153.       WRITE(IOIMP,*) 'An error was detected in subroutine rootls'
  154.       RETURN
  155. *
  156. * End of subroutine ROOTLS
  157. *
  158.       END
  159.  
  160.  
  161.  
  162.  

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