Sources Esope | Cast3M

calpmt
C CALPMT    SOURCE    CHAT      05/01/12    21:47:56     5004
      SUBROUTINE CALPMT(NTTDDL,NNZA,NNZB,NNZC,
     $     IA,JA,IB,JB,
     $     IWORK,
     $     IC,JC)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : CALPMT
C DESCRIPTION : Profil Morse (non ordonné) de A + profil Morse (non
C               ordonné) de B + dimension (NNZ) du profil Morse de (A +
C               B)  => Profil Morse non ordonné de (A + B).
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELE PAR       : FUSPRM
C***********************************************************************
C ENTREES            : NTTDDL, NNZA, NNZB, NNZC
C                      IA, JA, IB, JB
C ENTREES/SORTIES    : IWORK
C SORTIES            : IC, JC
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 21/12/99, version initiale
C HISTORIQUE : v1, 21/12/99, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
*
      INTEGER NTTDDL,NNZA,NNZB,NNZC
      INTEGER IA(NTTDDL+1)
      INTEGER JA(NNZA)
      INTEGER IB(NTTDDL+1)
      INTEGER JB(NNZB)
*
      INTEGER IWORK(NTTDDL)
*
      INTEGER IC(NTTDDL+1)
      INTEGER JC(NNZC)
*
      INTEGER JNZA,JNZB,JNZC,INZC
      INTEGER ITTDDL
      INTEGER JACOL,JBCOL
*
* Executable statements
*
      JNZC=0
      IC(1)=1
*
* Calculons le nombre de termes non nuls sur chaque ligne de C
*
      DO 1 ITTDDL=1,NTTDDL
* Parcourons la ligne de A
         DO 12 JNZA=IA(ITTDDL),IA(ITTDDL+1)-1
            JACOL=JA(JNZA)
            JNZC=JNZC+1
            JC(JNZC)=JACOL
            IWORK(JACOL)=JNZC
 12      CONTINUE
* Parcourons la ligne de B
         DO 14 JNZB=IB(ITTDDL),IB(ITTDDL+1)-1
            JBCOL=JB(JNZB)
            IF (IWORK(JBCOL).EQ.0) THEN
               JNZC=JNZC+1
               JC(JNZC)=JBCOL
               IWORK(JBCOL)=JNZC
            ENDIF
 14      CONTINUE
* Remise à zéro du segment de travail
         DO 16 INZC=IC(ITTDDL),JNZC
            IWORK(JC(INZC))=0
 16      CONTINUE
         IC(ITTDDL+1)=JNZC+1
 1    CONTINUE
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* End of subroutine CALPMT
*
      END