Télécharger la plaquette Cast3M


fr en

Télécharger dimpmt.eso

Retour à la liste

Numérotation des lignes : 

dimpmt

  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