Esope source files

   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 :