Télécharger calpmt.eso

Retour à la liste

Numérotation des lignes :

  1. C CALPMT SOURCE CHAT 05/01/12 21:47:56 5004
  2. SUBROUTINE CALPMT(NTTDDL,NNZA,NNZB,NNZC,
  3. $ IA,JA,IB,JB,
  4. $ IWORK,
  5. $ IC,JC)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM : CALPMT
  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) => Profil Morse non ordonné de (A + 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, NNZC
  21. C IA, JA, IB, JB
  22. C ENTREES/SORTIES : IWORK
  23. C SORTIES : IC, JC
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION : v1, 21/12/99, version initiale
  27. C HISTORIQUE : v1, 21/12/99, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35. *
  36. INTEGER NTTDDL,NNZA,NNZB,NNZC
  37. INTEGER IA(NTTDDL+1)
  38. INTEGER JA(NNZA)
  39. INTEGER IB(NTTDDL+1)
  40. INTEGER JB(NNZB)
  41. *
  42. INTEGER IWORK(NTTDDL)
  43. *
  44. INTEGER IC(NTTDDL+1)
  45. INTEGER JC(NNZC)
  46. *
  47. INTEGER JNZA,JNZB,JNZC,INZC
  48. INTEGER ITTDDL
  49. INTEGER JACOL,JBCOL
  50. *
  51. * Executable statements
  52. *
  53. JNZC=0
  54. IC(1)=1
  55. *
  56. * Calculons le nombre de termes non nuls sur chaque ligne de C
  57. *
  58. DO 1 ITTDDL=1,NTTDDL
  59. * Parcourons la ligne de A
  60. DO 12 JNZA=IA(ITTDDL),IA(ITTDDL+1)-1
  61. JACOL=JA(JNZA)
  62. JNZC=JNZC+1
  63. JC(JNZC)=JACOL
  64. IWORK(JACOL)=JNZC
  65. 12 CONTINUE
  66. * Parcourons la ligne de B
  67. DO 14 JNZB=IB(ITTDDL),IB(ITTDDL+1)-1
  68. JBCOL=JB(JNZB)
  69. IF (IWORK(JBCOL).EQ.0) THEN
  70. JNZC=JNZC+1
  71. JC(JNZC)=JBCOL
  72. IWORK(JBCOL)=JNZC
  73. ENDIF
  74. 14 CONTINUE
  75. * Remise à zéro du segment de travail
  76. DO 16 INZC=IC(ITTDDL),JNZC
  77. IWORK(JC(INZC))=0
  78. 16 CONTINUE
  79. IC(ITTDDL+1)=JNZC+1
  80. 1 CONTINUE
  81. *
  82. * Normal termination
  83. *
  84. RETURN
  85. *
  86. * Format handling
  87. *
  88. *
  89. * End of subroutine CALPMT
  90. *
  91. END
  92.  
  93.  
  94.  

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