Download dimpmt.eso

Back to the list

   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 :  

© Cast3M 2003 - All rights reserved.
Disclaimer