Télécharger dimpmt.eso

Retour à la liste

Numérotation des lignes :

  1. C DIMPMT SOURCE CHAT 05/01/12 22:51:09 5004
  2. SUBROUTINE DIMPMT(NTTDDL,NNZA,NNZB,
  3. $ IA,JA,IB,JB,
  4. $ IWORK,
  5. $ NNZC)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : DIMPMT
  10. C DESCRIPTION : Profil Morse (non ordonné) de A + profil Morse (non
  11. C ordonné) de B => dimension (NNZ) du profil Morse de (A +
  12. C B)
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELE PAR : FUSPRM
  19. C***********************************************************************
  20. C ENTREES : NTTDDL, NNZA, NNZB, IA, JA, IB, JB
  21. C ENTREES/SORTIES : IWORK
  22. C SORTIES : NNZC
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 21/12/99, version initiale
  26. C HISTORIQUE : v1, 21/12/99, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. *
  35. INTEGER NTTDDL,NNZA,NNZB
  36. INTEGER IA(NTTDDL+1)
  37. INTEGER JA(NNZA)
  38. INTEGER IB(NTTDDL+1)
  39. INTEGER JB(NNZB)
  40. INTEGER IWORK(NTTDDL)
  41. *
  42. INTEGER NNZC
  43. *
  44. INTEGER LDG,ILDG,IPREC,LAST
  45. INTEGER ITTDDL
  46. INTEGER JNZA,JNZB,JACOL,JBCOL
  47. *
  48. * Executable statements
  49. *
  50. NNZC=0
  51. *
  52. * Calculons le nombre de termes non nuls sur chaque ligne de C
  53. *
  54. DO 1 ITTDDL=1,NTTDDL
  55. LDG=0
  56. * Fin de la liste chaînée
  57. LAST=-1
  58. * Parcourons la ligne de A
  59. DO 12 JNZA=IA(ITTDDL),IA(ITTDDL+1)-1
  60. JACOL=JA(JNZA)
  61. * optimisation : on suppose unicité des colonnes dans le profil Morse
  62. * de A
  63. * IF (IWORK(JACOL).EQ.0) THEN
  64. LDG=LDG+1
  65. IWORK(JACOL)=LAST
  66. LAST=JACOL
  67. * ENDIF
  68. 12 CONTINUE
  69. * Parcourons la ligne de B
  70. DO 14 JNZB=IB(ITTDDL),IB(ITTDDL+1)-1
  71. JBCOL=JB(JNZB)
  72. IF (IWORK(JBCOL).EQ.0) THEN
  73. LDG=LDG+1
  74. IWORK(JBCOL)=LAST
  75. LAST=JBCOL
  76. ENDIF
  77. 14 CONTINUE
  78. *
  79. NNZC=NNZC+LDG
  80. * Remise à zéro du segment de travail
  81. DO 16 ILDG=1,LDG
  82. IPREC=IWORK(LAST)
  83. IWORK(LAST)=0
  84. LAST=IPREC
  85. 16 CONTINUE
  86. 1 CONTINUE
  87. *
  88. * Normal termination
  89. *
  90. RETURN
  91. *
  92. * Format handling
  93. *
  94. *
  95. * End of subroutine DIMPMT
  96. *
  97. END
  98.  
  99.  
  100.  

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