C FUSPRM SOURCE PV 20/09/26 21:17:01 10724 SUBROUTINE FUSPRM(PM1,PM2, $ PMTOT, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : FUSPRM C PROJET : Assemblage matrice élémentaire -> matrice Morse C DESCRIPTION : Profil Morse (non ordonné) de A + profil Morse (non C ordonné) de B => profil Morse (non ordonné) de (A + B) C C On effectue un ET sur les profils Morses non C ordonnés PM1 et PM2. C Le résultat est dans PMTOT. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : DIMPMT, CALPMT C APPELE PAR : PRASEM, MAKPMT C*********************************************************************** C ENTREES : PM1, PM2 C SORTIES : PMTOT C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 13/12/99, version initiale C HISTORIQUE : v1, 13/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*********************************************************************** * -INC PPARAM -INC CCOPTIO -INC SMMATRIK INTEGER NTT,NJA POINTEUR PM1.PMORS POINTEUR PM2.PMORS POINTEUR PMTOT.PMORS -INC SMLENTI INTEGER JG POINTEUR IWORK.MLENTI * INTEGER IMPR,IRET * INTEGER NTTDD2,NTTDDL INTEGER NNZ1,NNZ2,NNZTOT * * Executable statements * IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fusprm' SEGACT PM1 NTTDDL=PM1.IA(/1)-1 NNZ1=PM1.JA(/1) SEGACT PM2 NTTDD2=PM2.IA(/1)-1 NNZ2=PM2.JA(/1) IF (NTTDDL.NE.NTTDD2) THEN WRITE(IOIMP,*) 'Matrices à fusionner incompatibles...' GOTO 9999 ENDIF * * Effectuons le dimensionnement de PMTOT * JG=NTTDDL SEGINI,IWORK CALL DIMPMT(NTTDDL,NNZ1,NNZ2, $ PM1.IA,PM1.JA,PM2.IA,PM2.JA, $ IWORK.LECT, $ NNZTOT) * * Remplissage de PMTOT * NTT=NTTDDL NJA=NNZTOT SEGINI PMTOT CALL CALPMT(NTTDDL,NNZ1,NNZ2,NNZTOT, $ PM1.IA,PM1.JA,PM2.IA,PM2.JA, $ IWORK.LECT, $ PMTOT.IA,PMTOT.JA) IF (IRET.NE.0) GOTO 9999 SEGSUP IWORK SEGDES PMTOT SEGDES PM2 SEGDES PM1 * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine fusprm' RETURN * * End of subroutine FUSPRM * END