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.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. INTEGER N,I1,I2,I3,SNODE,LSTNUM,NC,E2
  61. INTEGER XADJ(N+1),ADJ(E2),NNN(N),IW(3*N+1)
  62. INTEGER IMPR,IRET
  63. *
  64. * Executable statements
  65. *
  66. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans label'
  67. *
  68. * Set all new node numbers = 0
  69. * This is used to denote all visible nodes
  70. * (already done)
  71. *
  72. * DO 10 I=1,N
  73. * NNN(I)=0
  74. * 10 CONTINUE
  75. *
  76. * Define offsets
  77. *
  78. I1=1
  79. I2=I1+N
  80. I3=I2+N+1
  81. *
  82. * Loop while some nodes remain unnumbered
  83. *
  84. LSTNUM=0
  85. 20 CONTINUE
  86. IF (LSTNUM.LT.N) THEN
  87. *
  88. * Find end points of p-diameter for nodes in this component
  89. * Compute distances of nodes from end node
  90. *
  91. CALL DIAMTR(N,E2,ADJ,XADJ,
  92. $ NNN,
  93. $ IW(I1),IW(I2),IW(I3),
  94. $ SNODE,NC,
  95. $ IMPR,IRET)
  96. IF (IRET.NE.0) GOTO 9999
  97. *
  98. * Number nodes in this component
  99. *
  100. CALL NUMBER(N,NC,SNODE,LSTNUM,E2,ADJ,XADJ,
  101. $ NNN,
  102. $ IW(I1),IW(I2),
  103. $ IMPR,IRET)
  104. IF (IRET.NE.0) GOTO 9999
  105. GOTO 20
  106. ENDIF
  107. *
  108. * Normal termination
  109. *
  110. IRET=0
  111. RETURN
  112. *
  113. * Format handling
  114. *
  115. *
  116. * Error handling
  117. *
  118. 9999 CONTINUE
  119. IRET=1
  120. WRITE(IOIMP,*) 'An error was detected in subroutine label'
  121. RETURN
  122. *
  123. * End of subroutine LABEL
  124. *
  125. END
  126.  
  127.  
  128.  
  129.  

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