Esope source files

   1 : C FUSPRM    SOURCE    MAGN      09/07/30    21:17:07     6458           
   2 :       SUBROUTINE FUSPRM(PM1,PM2,
   3 :      $     PMTOT,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : FUSPRM
   9 : C PROJET      : Assemblage matrice élémentaire -> matrice Morse
  10 : C DESCRIPTION : Profil Morse (non ordonné) de A + profil Morse (non
  11 : C               ordonné) de B => profil Morse (non ordonné) de (A + B) 
  12 : C
  13 : C               On effectue un ET sur les profils Morses non
  14 : C               ordonnés PM1 et PM2.
  15 : C               Le résultat est dans PMTOT.
  16 : C
  17 : C LANGAGE     : ESOPE
  18 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19 : C               mél : gounand@semt2.smts.cea.fr
  20 : C***********************************************************************
  21 : C APPELES          : DIMPMT, CALPMT
  22 : C APPELE PAR       : PRASEM, MAKPMT
  23 : C***********************************************************************
  24 : C ENTREES            : PM1, PM2
  25 : C SORTIES            : PMTOT
  26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27 : C***********************************************************************
  28 : C VERSION    : v1, 13/12/99, version initiale
  29 : C HISTORIQUE : v1, 13/12/99, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 : *
  38 : -INC CCOPTIO
  39 : -INC SMMATRIK
  40 :       INTEGER NTT,NJA
  41 :       POINTEUR PM1.PMORS
  42 :       POINTEUR PM2.PMORS
  43 :       POINTEUR PMTOT.PMORS
  44 : -INC SMLENTI
  45 :       INTEGER JG
  46 :       POINTEUR IWORK.MLENTI
  47 : *
  48 :       INTEGER IMPR,IRET
  49 : *
  50 :       INTEGER NTTDD2,NTTDDL
  51 :       INTEGER NNZ1,NNZ2,NNZTOT
  52 : *
  53 : * Executable statements
  54 : *
  55 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fusprm'
  56 :       SEGACT PM1
  57 :       NTTDDL=PM1.IA(/1)-1
  58 :       NNZ1=PM1.JA(/1)
  59 :       SEGACT PM2
  60 :       NTTDD2=PM2.IA(/1)-1
  61 :       NNZ2=PM2.JA(/1)
  62 :       IF (NTTDDL.NE.NTTDD2) THEN
  63 :          WRITE(IOIMP,*) 'Matrices à fusionner incompatibles...'
  64 :          GOTO 9999
  65 :       ENDIF
  66 : *
  67 : * Effectuons le dimensionnement de PMTOT
  68 : *
  69 :       JG=NTTDDL
  70 :       SEGINI,IWORK
  70 :       CALL DIMPMT(NTTDDL,NNZ1,NNZ2,
  71 :      $     PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  72 :      $     IWORK.LECT,
  73 :      $     NNZTOT)
  74 : *
  75 : * Remplissage de PMTOT
  76 : *
  77 :       NTT=NTTDDL
  78 :       NJA=NNZTOT
  79 :       SEGINI PMTOT
  79 :       CALL CALPMT(NTTDDL,NNZ1,NNZ2,NNZTOT,
  80 :      $     PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  81 :      $     IWORK.LECT,
  82 :      $     PMTOT.IA,PMTOT.JA)
  83 :       IF (IRET.NE.0) GOTO 9999
  84 :       SEGSUP IWORK
  85 :       SEGDES PMTOT
  86 :       SEGDES PM2
  87 :       SEGDES PM1
  88 : *
  89 : * Normal termination
  90 : *
  91 :       IRET=0
  92 :       RETURN
  93 : *
  94 : * Format handling
  95 : *
  96 : *
  97 : * Error handling
  98 : *
  99 :  9999 CONTINUE
 100 :       IRET=1
 101 :       WRITE(IOIMP,*) 'An error was detected in subroutine fusprm'
 102 :       RETURN
 103 : *
 104 : * End of subroutine FUSPRM
 105 : *
 106 :       END
 107 : 
 108 :  
 109 :  
 110 :  
 111 :