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