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 CCOPTIO
  39. INTEGER NTT,NJA
  40. POINTEUR PM1.PMORS
  41. POINTEUR PM2.PMORS
  42. POINTEUR PMTOT.PMORS
  43. -INC SMLENTI
  44. INTEGER JG
  45. POINTEUR IWORK.MLENTI
  46. *
  47. INTEGER IMPR,IRET
  48. *
  49. INTEGER NTTDD2,NTTDDL
  50. INTEGER NNZ1,NNZ2,NNZTOT
  51. *
  52. * Executable statements
  53. *
  54. IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fusprm'
  55. SEGACT PM1
  56. NTTDDL=PM1.IA(/1)-1
  57. NNZ1=PM1.JA(/1)
  58. SEGACT PM2
  59. NTTDD2=PM2.IA(/1)-1
  60. NNZ2=PM2.JA(/1)
  61. IF (NTTDDL.NE.NTTDD2) THEN
  62. WRITE(IOIMP,*) 'Matrices à fusionner incompatibles...'
  63. GOTO 9999
  64. ENDIF
  65. *
  66. * Effectuons le dimensionnement de PMTOT
  67. *
  68. JG=NTTDDL
  69. 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
  80. CALL CALPMT(NTTDDL,NNZ1,NNZ2,NNZTOT,
  81. $ PM1.IA,PM1.JA,PM2.IA,PM2.JA,
  82. $ IWORK.LECT,
  83. $ PMTOT.IA,PMTOT.JA)
  84. IF (IRET.NE.0) GOTO 9999
  85. SEGSUP IWORK
  86. SEGDES PMTOT
  87. SEGDES PM2
  88. SEGDES PM1
  89. *
  90. * Normal termination
  91. *
  92. IRET=0
  93. RETURN
  94. *
  95. * Format handling
  96. *
  97. *
  98. * Error handling
  99. *
  100. 9999 CONTINUE
  101. IRET=1
  102. WRITE(IOIMP,*) 'An error was detected in subroutine fusprm'
  103. RETURN
  104. *
  105. * End of subroutine FUSPRM
  106. *
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  

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