Télécharger profi1.eso

Retour à la liste

Numérotation des lignes :

  1. C PROFI1 SOURCE CHAT 05/01/13 02:30:38 5004
  2. SUBROUTINE PROFI1(N,NNN,E2,ADJ,XADJ,
  3. $ OLDPRO,NEWPRO,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PROFI1
  9. C DESCRIPTION : Compute the profile using original and new node numbers
  10. C
  11. C LANGAGE : FORTRAN 77 (sauf E/S)
  12. C
  13. C AUTEUR : Scott Sloan
  14. C
  15. C BIBLIO : @Article{,
  16. C author = {S. W. Sloan},
  17. C title = {A Fortran Program for Profile and Wavefront Reduction},
  18. C journal = {International Journal for Numerical Methods in Engineering},
  19. C year = {1989},
  20. C volume = {28},
  21. C pages = {2651-2679}
  22. C}
  23. C
  24. C***********************************************************************
  25. C APPELE PAR : LABEL
  26. C***********************************************************************
  27. C ENTREES :
  28. C N - Number of nodes in graph
  29. C NNN - List of new node numbers
  30. C - New number for node I given by NNN(I)
  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 OLDPRO - Profile with original node numbering
  42. C NEWPRO - Profile with new node numbering
  43. C
  44. C NOTES :
  45. C
  46. C Profiles include diagonal terms
  47. C
  48. C
  49. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  50. C***********************************************************************
  51. C VERSION : v1, 05/11/99, version initiale
  52. C HISTORIQUE : v1, 10/03/89, création
  53. C HISTORIQUE :
  54. C HISTORIQUE :
  55. C***********************************************************************
  56. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  57. C en cas de modification de ce sous-programme afin de faciliter
  58. C la maintenance !
  59. C***********************************************************************
  60. -INC CCOPTIO
  61. INTEGER NEWPRO,I,J,N,JSTRT,JSTOP,OLDPRO,NEWMIN,OLDMIN,E2
  62. INTEGER NNN(N),XADJ(N+1),ADJ(E2)
  63. INTEGER IMPR,IRET
  64. *
  65. * Executable statements
  66. *
  67. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi1'
  68. *
  69. * Set profiles and loop over each node in graph
  70. *
  71. OLDPRO=0
  72. NEWPRO=0
  73. DO 20 I=1,N
  74. JSTRT=XADJ(I)
  75. JSTOP=XADJ(I+1)-1
  76. OLDMIN=ADJ(JSTRT)
  77. NEWMIN=NNN(ADJ(JSTRT))
  78. *
  79. * Find lowest numbered neighbour of node I
  80. * (using both old and new node numbers)
  81. *
  82. DO 10 J=JSTRT+1,JSTOP
  83. OLDMIN=MIN(OLDMIN,ADJ(J))
  84. NEWMIN=MIN(NEWMIN,NNN(ADJ(J)))
  85. 10 CONTINUE
  86. *
  87. * Update profiles
  88. *
  89. OLDPRO=OLDPRO+DIM(I,OLDMIN)
  90. NEWPRO=NEWPRO+DIM(NNN(I),NEWMIN)
  91. 20 CONTINUE
  92. *
  93. * Add diagonal terms to profiles
  94. *
  95. OLDPRO=OLDPRO+N
  96. NEWPRO=NEWPRO+N
  97. *
  98. * Normal termination
  99. *
  100. IRET=0
  101. RETURN
  102. *
  103. * Format handling
  104. *
  105. *
  106. * Error handling
  107. *
  108. 9999 CONTINUE
  109. IRET=1
  110. WRITE(IOIMP,*) 'An error was detected in subroutine profi1'
  111. RETURN
  112. *
  113. * End of subroutine PROFI1
  114. *
  115. END
  116.  
  117.  
  118.  
  119.  

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