Télécharger infmat.eso

Retour à la liste

Numérotation des lignes :

  1. C INFMAT SOURCE PV 16/11/17 21:59:41 9180
  2. SUBROUTINE INFMAT(AMORS,AISA,IMPR,IRET)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C NOM : INFMAT
  7. C DESCRIPTION : Affiche des informations sur une matrice Morse.
  8. C
  9. C
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELE PAR : KRES2
  16. C***********************************************************************
  17. C ENTREES : AMORS, AISA
  18. C ENTREES/SORTIES : -
  19. C SORTIES : -
  20. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  21. C***********************************************************************
  22. C VERSION : v1.1, 22/03/2000, version initiale
  23. C HISTORIQUE : v1.1, 22/03/2000,
  24. C Donne plus d'informations (maxi largeur de bande, profil supérieur et
  25. C inférieur).
  26. C HISTORIQUE : v1, 17/01/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34. -INC CCOPTIO
  35. POINTEUR AMORS.PMORS
  36. POINTEUR AMORS2.PMORS
  37. POINTEUR AISA.IZA
  38. INTEGER NTT,NJA
  39. INTEGER NBVA
  40. POINTEUR PMWRK.PMORS
  41. POINTEUR IZAWRK.IZA
  42. *
  43. INTEGER IMPR,IRET
  44. *
  45. INTEGER IMAXI,IMAXS,IPROFS,IMIN,ITT
  46. INTEGER J,JSTRT,JSTOP
  47. INTEGER NBDDL,NBSTO
  48. INTEGER IPROFI
  49. LOGICAL LSPKIT
  50. *
  51. * Executable statements
  52. *
  53. IF (IMPR.GT.0) THEN
  54. LSPKIT=.FALSE.
  55. *SPSKIT LSPKIT=.TRUE.
  56. * Les calculs à effectuer
  57. IF (IMPR.GT.1) THEN
  58. SEGACT AMORS
  59. NBDDL=AMORS.IA(/1)-1
  60. NBSTO=AMORS.JA(/1)
  61. SEGDES AMORS
  62. WRITE(IOIMP,*) 'Matrice Morse : nb.ddl=',NBDDL,
  63. $ ' ; nb.termesstockés=',NBSTO
  64. CALL PROFI2(AMORS,IPROFI,0,IRET)
  65. IF (IMPR.GT.2)THEN
  66. WRITE(IOIMP,*) 'Profil (tri. inf.) = ',IPROFI
  67. ELSEIF (IMPR.GT.3) THEN
  68. SEGACT AMORS
  69. NTT=AMORS.IA(/1)-1
  70. IPROFI=0
  71. IMAXI=0
  72. DO 9 ITT=1,NTT
  73. IPROFI=IPROFI+(ITT-AMORS.JA(AMORS.IA(ITT)))
  74. IMAXI=MAX(IMAXI,ITT-AMORS.JA(AMORS.IA(ITT)))
  75. 9 CONTINUE
  76. SEGDES AMORS
  77. WRITE(IOIMP,*) 'Profil (tri. inf.) = ',IPROFI
  78. WRITE(IOIMP,*) 'Max. larg. bande = ',IMAXI
  79. CALL MAKPMT(AMORS,
  80. $ AMORS2,
  81. $ IMPR,IRET)
  82. IF (IRET.NE.0) GOTO 9999
  83. IPROFS=0
  84. IMAXS=0
  85. SEGACT AMORS2
  86. NTT=AMORS2.IA(/1)-1
  87. DO 91 ITT=1,NTT
  88. JSTRT=AMORS2.IA(ITT)
  89. JSTOP=AMORS2.IA(ITT+1)-1
  90. IMIN=AMORS2.JA(JSTRT)
  91. DO 912 J=JSTRT+1,JSTOP
  92. IMIN=MIN(IMIN,AMORS2.JA(J))
  93. 912 CONTINUE
  94. IMIN=ITT-IMIN
  95. IPROFS=IPROFS+IMIN
  96. IMAXS=MAX(IMAXS,IMIN)
  97. 91 CONTINUE
  98. SEGSUP AMORS2
  99. WRITE(IOIMP,*) 'Profil (tri. sup.) = ',IPROFS
  100. WRITE(IOIMP,*) 'Max larg. bande = ',IMAXS
  101. WRITE(IOIMP,*) 'Total = ',IPROFS+IPROFI+ITT
  102. ENDIF
  103. ENDIF
  104. IF (LSPKIT) THEN
  105. SEGACT AMORS
  106. SEGACT AISA
  107. NTT=AMORS.IA(/1)-1
  108. NBVA=AISA.A(/1)
  109. NJA=MAX(2*NTT+1,NBVA)
  110. SEGINI PMWRK
  111. SEGINI IZAWRK
  112. *SPSKIT CALL DINF13(NTT,IOIMP,AISA.A,AMORS.JA,AMORS.IA,.TRUE.,
  113. *SPSKIT $ ' Matrice qui tue '//
  114. *SPSKIT $ ' ',
  115. *SPSKIT $ 'MAT ',' N ',IZAWRK.A,PMWRK.JA,PMWRK.IA)
  116. SEGSUP IZAWRK
  117. SEGSUP PMWRK
  118. SEGDES AISA
  119. SEGDES AMORS
  120. ENDIF
  121. ENDIF
  122. *
  123. * Normal termination
  124. *
  125. IRET=0
  126. RETURN
  127. *
  128. * Format handling
  129. *
  130. *
  131. * Error handling
  132. *
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine infmat'
  136. RETURN
  137. *
  138. * End of subroutine infmat
  139. *
  140. END
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  

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