Télécharger la plaquette Cast3M


fr en

Télécharger profi1.eso

Retour à la liste

Numérotation des lignes : 

profi1

  1. C PROFI1    SOURCE    CB215821  17/11/30    21:16:54     9639           
  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 PPARAM
  61. -INC CCOPTIO
  62.       INTEGER NEWPRO,I,J,N,JSTRT,JSTOP,OLDPRO,NEWMIN,OLDMIN,E2
  63.       INTEGER NNN(N),XADJ(N+1),ADJ(E2)
  64.       INTEGER IMPR,IRET
  65. *
  66. * Executable statements
  67. *
  68.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi1'
  69. *
  70. *     Set profiles and loop over each node in graph
  71. *
  72.       OLDPRO=0
  73.       NEWPRO=0
  74.       DO 20 I=1,N
  75.          JSTRT=XADJ(I)
  76.          JSTOP=XADJ(I+1)-1
  77.          OLDMIN=ADJ(JSTRT)
  78.          NEWMIN=NNN(ADJ(JSTRT))
  79. *
  80. *     Find lowest numbered neighbour of node I
  81. *     (using both old and new node numbers)
  82. *
  83.          DO 10 J=JSTRT+1,JSTOP
  84.             OLDMIN=MIN(OLDMIN,ADJ(J))
  85.             NEWMIN=MIN(NEWMIN,NNN(ADJ(J)))
  86.  10      CONTINUE
  87. *
  88. *     Update profiles
  89. *
  90.          OLDPRO=OLDPRO+DIM(I,OLDMIN)
  91.          NEWPRO=NEWPRO+DIM(NNN(I),NEWMIN)
  92.  20   CONTINUE
  93. *
  94. *     Add diagonal terms to profiles
  95. *
  96.       OLDPRO=OLDPRO+N
  97.       NEWPRO=NEWPRO+N
  98. *
  99. * Normal termination
  100. *
  101.       IRET=0
  102.       RETURN
  103. *
  104. * Format handling
  105. *
  106. *
  107. * Error handling
  108. *
  109.  9999 CONTINUE
  110.       IRET=1
  111.       WRITE(IOIMP,*) 'An error was detected in subroutine profi1'
  112.       RETURN
  113. *
  114. * End of subroutine PROFI1
  115. *
  116.       END
  117.  
  118.  
  119.  
  120.  
  121.  

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