Télécharger fusprm.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSPRM SOURCE PV 16/11/17 21:59:28 9180
  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
  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
  71. CALL DIMPMT(NTTDDL,NNZ1,NNZ2,
  72. $ PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  73. $ IWORK.LECT,
  74. $ NNZTOT)
  75. *
  76. * Remplissage de PMTOT
  77. *
  78. NTT=NTTDDL
  79. NJA=NNZTOT
  80. SEGINI PMTOT
  81. CALL CALPMT(NTTDDL,NNZ1,NNZ2,NNZTOT,
  82. $ PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  83. $ IWORK.LECT,
  84. $ PMTOT.IA,PMTOT.JA)
  85. IF (IRET.NE.0) GOTO 9999
  86. SEGSUP IWORK
  87. SEGDES PMTOT
  88. SEGDES PM2
  89. SEGDES PM1
  90. *
  91. * Normal termination
  92. *
  93. IRET=0
  94. RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101. 9999 CONTINUE
  102. IRET=1
  103. WRITE(IOIMP,*) 'An error was detected in subroutine fusprm'
  104. RETURN
  105. *
  106. * End of subroutine FUSPRM
  107. *
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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