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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. POINTEUR AMORS.PMORS
  38. POINTEUR AMORS2.PMORS
  39. POINTEUR AISA.IZA
  40. INTEGER NTT,NJA
  41. INTEGER NBVA
  42. POINTEUR PMWRK.PMORS
  43. POINTEUR IZAWRK.IZA
  44. *
  45. INTEGER IMPR,IRET
  46. *
  47. INTEGER IMAXI,IMAXS,IPROFS,IMIN,ITT
  48. INTEGER J,JSTRT,JSTOP
  49. INTEGER NBDDL,NBSTO
  50. INTEGER IPROFI
  51. LOGICAL LSPKIT
  52. *
  53. * Executable statements
  54. *
  55. IF (IMPR.GT.0) THEN
  56. LSPKIT=.FALSE.
  57. *SPSKIT LSPKIT=.TRUE.
  58. * Les calculs à effectuer
  59. IF (IMPR.GT.1) THEN
  60. SEGACT AMORS
  61. NBDDL=AMORS.IA(/1)-1
  62. NBSTO=AMORS.JA(/1)
  63. SEGDES AMORS
  64. WRITE(IOIMP,*) 'Matrice Morse : nb.ddl=',NBDDL,
  65. $ ' ; nb.termesstockés=',NBSTO
  66. CALL PROFI2(AMORS,IPROFI,0,IRET)
  67. IF (IMPR.GT.2)THEN
  68. WRITE(IOIMP,*) 'Profil (tri. inf.) = ',IPROFI
  69. ELSEIF (IMPR.GT.3) THEN
  70. SEGACT AMORS
  71. NTT=AMORS.IA(/1)-1
  72. IPROFI=0
  73. IMAXI=0
  74. DO 9 ITT=1,NTT
  75. IPROFI=IPROFI+(ITT-AMORS.JA(AMORS.IA(ITT)))
  76. IMAXI=MAX(IMAXI,ITT-AMORS.JA(AMORS.IA(ITT)))
  77. 9 CONTINUE
  78. SEGDES AMORS
  79. WRITE(IOIMP,*) 'Profil (tri. inf.) = ',IPROFI
  80. WRITE(IOIMP,*) 'Max. larg. bande = ',IMAXI
  81. CALL MAKPMT(AMORS,
  82. $ AMORS2,
  83. $ IMPR,IRET)
  84. IF (IRET.NE.0) GOTO 9999
  85. IPROFS=0
  86. IMAXS=0
  87. SEGACT AMORS2
  88. NTT=AMORS2.IA(/1)-1
  89. DO 91 ITT=1,NTT
  90. JSTRT=AMORS2.IA(ITT)
  91. JSTOP=AMORS2.IA(ITT+1)-1
  92. IMIN=AMORS2.JA(JSTRT)
  93. DO 912 J=JSTRT+1,JSTOP
  94. IMIN=MIN(IMIN,AMORS2.JA(J))
  95. 912 CONTINUE
  96. IMIN=ITT-IMIN
  97. IPROFS=IPROFS+IMIN
  98. IMAXS=MAX(IMAXS,IMIN)
  99. 91 CONTINUE
  100. SEGSUP AMORS2
  101. WRITE(IOIMP,*) 'Profil (tri. sup.) = ',IPROFS
  102. WRITE(IOIMP,*) 'Max larg. bande = ',IMAXS
  103. WRITE(IOIMP,*) 'Total = ',IPROFS+IPROFI+ITT
  104. ENDIF
  105. ENDIF
  106. IF (LSPKIT) THEN
  107. SEGACT AMORS
  108. SEGACT AISA
  109. NTT=AMORS.IA(/1)-1
  110. NBVA=AISA.A(/1)
  111. NJA=MAX(2*NTT+1,NBVA)
  112. SEGINI PMWRK
  113. SEGINI IZAWRK
  114. *SPSKIT CALL DINF13(NTT,IOIMP,AISA.A,AMORS.JA,AMORS.IA,.TRUE.,
  115. *SPSKIT $ ' Matrice qui tue '//
  116. *SPSKIT $ ' ',
  117. *SPSKIT $ 'MAT ',' N ',IZAWRK.A,PMWRK.JA,PMWRK.IA)
  118. SEGSUP IZAWRK
  119. SEGSUP PMWRK
  120. SEGDES AISA
  121. SEGDES AMORS
  122. ENDIF
  123. ENDIF
  124. *
  125. * Normal termination
  126. *
  127. IRET=0
  128. RETURN
  129. *
  130. * Format handling
  131. *
  132. *
  133. * Error handling
  134. *
  135. 9999 CONTINUE
  136. IRET=1
  137. WRITE(IOIMP,*) 'An error was detected in subroutine infmat'
  138. RETURN
  139. *
  140. * End of subroutine infmat
  141. *
  142. END
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  

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