Télécharger la plaquette Cast3M


fr en

Télécharger fusprm.eso

Retour à la liste

Numérotation des lignes : 

fusprm

  1. C FUSPRM    SOURCE    GOUNAND   25/04/30    21:15:05     12258          
  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 PPARAM
  39. -INC CCOPTIO
  41.       INTEGER NTT,NJA
  42.       POINTEUR PM1.PMORS
  43.       POINTEUR PM2.PMORS
  44.       POINTEUR PMTOT.PMORS
  45. -INC SMLENTI
  46.       INTEGER JG
  47.       POINTEUR IWORK.MLENTI
  48. *
  49.       INTEGER IMPR,IRET
  50. *
  51.       INTEGER NTTDD2,NTTDDL
  52.       INTEGER NNZ1,NNZ2,NNZTOT
  53. *
  54. * Executable statements
  55. *
  56.       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fusprm'
  57.       SEGACT PM1
  58.       NTTDDL=PM1.IA(/1)-1
  59.       NNZ1=PM1.JA(/1)
  60.       SEGACT PM2
  61.       NTTDD2=PM2.IA(/1)-1
  62.       NNZ2=PM2.JA(/1)
  63.       IF (NTTDDL.NE.NTTDD2) THEN
  64.          WRITE(IOIMP,*) 'Matrices à fusionner incompatibles...'
  65.          GOTO 9999
  66.       ENDIF
  67. *
  68. * Effectuons le dimensionnement de PMTOT
  69. *
  70.       JG=NTTDDL
  71.       SEGINI,IWORK
  72.       CALL DIMPMT(NTTDDL,NNZ1,NNZ2,
  73.      $     PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  74.      $     IWORK.LECT,
  75.      $     NNZTOT)
  76. *
  77. * Remplissage de PMTOT
  78. *
  79.       NTT=NTTDDL
  80.       NJA=NNZTOT
  81.       SEGINI PMTOT
  82.       CALL CALPMT(NTTDDL,NNZ1,NNZ2,NNZTOT,
  83.      $     PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  84.      $     IWORK.LECT,
  85.      $     PMTOT.IA,PMTOT.JA)
  86.       IF (IRET.NE.0) GOTO 9999
  87.       SEGSUP IWORK
  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.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales