Télécharger label.eso

Retour à la liste

Numérotation des lignes :

  1. C LABEL SOURCE CHAT 05/01/13 01:11:46 5004
  2. SUBROUTINE LABEL(N,E2,ADJ,XADJ,
  3. $ NNN,
  4. $ IW,
  5. $ IMPR,IRET)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : LABEL
  10. C DESCRIPTION : Label a graph for small profile and rms wavefront
  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 : DIAMTR, NUMBER
  27. C APPELE PAR : PRSLOA
  28. C***********************************************************************
  29. C ENTREES :
  30. C N - Number of nodes in graph
  31. C E2 - Twice the number of edges in the graph = XADJ(N+1)-1
  32. C ADJ - Adjacency list for all nodes in graph
  33. C - List of length 2E where E is the number of edges in
  34. C the graph and 2E = XADJ(N+1)-1
  35. C XADJ - Index vector for ADJ
  36. C - Nodes adjacent to node I are found in ADJ(J), where
  37. C J = XADJ(I),...,XADJ(I+1)-1
  38. C - Degree of node I given by XADJ(I+1)-XADJ(I)
  39. C ENTREES/SORTIES : -
  40. C SORTIES :
  41. C NNN - List of new node numbers
  42. C - New number for node I given by NNN(I)
  43. C TABLEAU DE TRAVAIL : IW
  44. C
  45. C
  46. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  47. C***********************************************************************
  48. C VERSION : v1, 05/11/99, version initiale
  49. C HISTORIQUE : v1, 10/03/89, création
  50. C HISTORIQUE :
  51. C HISTORIQUE :
  52. C***********************************************************************
  53. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  54. C en cas de modification de ce sous-programme afin de faciliter
  55. C la maintenance !
  56. C***********************************************************************
  57. -INC CCOPTIO
  58. INTEGER N,I1,I2,I3,SNODE,LSTNUM,NC,E2
  59. INTEGER XADJ(N+1),ADJ(E2),NNN(N),IW(3*N+1)
  60. INTEGER IMPR,IRET
  61. *
  62. * Executable statements
  63. *
  64. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans label'
  65. *
  66. * Set all new node numbers = 0
  67. * This is used to denote all visible nodes
  68. * (already done)
  69. *
  70. * DO 10 I=1,N
  71. * NNN(I)=0
  72. * 10 CONTINUE
  73. *
  74. * Define offsets
  75. *
  76. I1=1
  77. I2=I1+N
  78. I3=I2+N+1
  79. *
  80. * Loop while some nodes remain unnumbered
  81. *
  82. LSTNUM=0
  83. 20 CONTINUE
  84. IF (LSTNUM.LT.N) THEN
  85. *
  86. * Find end points of p-diameter for nodes in this component
  87. * Compute distances of nodes from end node
  88. *
  89. CALL DIAMTR(N,E2,ADJ,XADJ,
  90. $ NNN,
  91. $ IW(I1),IW(I2),IW(I3),
  92. $ SNODE,NC,
  93. $ IMPR,IRET)
  94. IF (IRET.NE.0) GOTO 9999
  95. *
  96. * Number nodes in this component
  97. *
  98. CALL NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,
  99. $ NNN,
  100. $ IW(I1),IW(I2),
  101. $ IMPR,IRET)
  102. IF (IRET.NE.0) GOTO 9999
  103. GOTO 20
  104. ENDIF
  105. *
  106. * Normal termination
  107. *
  108. IRET=0
  109. RETURN
  110. *
  111. * Format handling
  112. *
  113. *
  114. * Error handling
  115. *
  116. 9999 CONTINUE
  117. IRET=1
  118. WRITE(IOIMP,*) 'An error was detected in subroutine label'
  119. RETURN
  120. *
  121. * End of subroutine LABEL
  122. *
  123. END
  124.  
  125.  
  126.  
  127.  

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