Télécharger la plaquette Cast3M


fr en

Télécharger infmat.eso

Retour à la liste

Numérotation des lignes : 

infmat

  1. C INFMAT    SOURCE    GOUNAND   25/04/30    21:15:07     12258          
  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
  38.       POINTEUR AMORS.PMORS
  39.       POINTEUR AMORS2.PMORS
  40.       POINTEUR AISA.IZA
  41.       INTEGER NTT,NJA
  42.       INTEGER NBVA
  43.       POINTEUR PMWRK.PMORS
  44.       POINTEUR IZAWRK.IZA
  45. *
  46.       INTEGER IMPR,IRET
  47. *
  48.       INTEGER IMAXI,IMAXS,IPROFS,IMIN,ITT
  49.       INTEGER J,JSTRT,JSTOP
  50.       INTEGER NBDDL,NBSTO
  51.       INTEGER IPROFI
  52.       LOGICAL LSPKIT
  53. *
  54. * Executable statements
  55. *
  56.       IF (IMPR.GT.0) THEN
  57.          LSPKIT=.FALSE.
  58. *SPSKIT      LSPKIT=.TRUE.
  59. * Les calculs à effectuer
  60.          IF (IMPR.GT.1) THEN
  61.             SEGACT AMORS
  62.             NBDDL=AMORS.IA(/1)-1
  63.             NBSTO=AMORS.JA(/1)
  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.                WRITE(IOIMP,*) 'Profil (tri. inf.) = ',IPROFI
  79.                WRITE(IOIMP,*) 'Max. larg. bande = ',IMAXI
  80.                CALL MAKPMT(AMORS,
  81.      $              AMORS2,
  82.      $              IMPR,IRET)
  83.                IF (IRET.NE.0) GOTO 9999
  84.                IPROFS=0
  85.                IMAXS=0
  86.                SEGACT AMORS2
  87.                NTT=AMORS2.IA(/1)-1
  88.                DO 91 ITT=1,NTT
  89.                   JSTRT=AMORS2.IA(ITT)
  90.                   JSTOP=AMORS2.IA(ITT+1)-1
  91.                   IMIN=AMORS2.JA(JSTRT)
  92.                   DO 912 J=JSTRT+1,JSTOP
  93.                      IMIN=MIN(IMIN,AMORS2.JA(J))
  94.  912              CONTINUE
  95.                   IMIN=ITT-IMIN
  96.                   IPROFS=IPROFS+IMIN
  97.                   IMAXS=MAX(IMAXS,IMIN)
  98.  91            CONTINUE
  99.                SEGSUP AMORS2
  100.                WRITE(IOIMP,*) 'Profil (tri. sup.) = ',IPROFS
  101.                WRITE(IOIMP,*) 'Max larg. bande = ',IMAXS
  102.                WRITE(IOIMP,*) 'Total = ',IPROFS+IPROFI+ITT
  103.             ENDIF
  104.          ENDIF
  105.          IF (LSPKIT) THEN
  106.             SEGACT AMORS
  107.             SEGACT AISA
  108.             NTT=AMORS.IA(/1)-1
  109.             NBVA=AISA.A(/1)
  110.             NJA=MAX(2*NTT+1,NBVA)
  111.             SEGINI PMWRK
  112.             SEGINI IZAWRK
  113. *SPSKIT         CALL DINF13(NTT,IOIMP,AISA.A,AMORS.JA,AMORS.IA,.TRUE.,
  114. *SPSKIT     $        ' Matrice qui tue                               '//
  115. *SPSKIT     $        '                                               ',
  116. *SPSKIT     $        'MAT     ',' N ',IZAWRK.A,PMWRK.JA,PMWRK.IA)
  117.             SEGSUP IZAWRK
  118.             SEGSUP PMWRK
  119.          ENDIF
  120.       ENDIF
  121. *
  122. * Normal termination
  123. *
  124.       IRET=0
  125.       RETURN
  126. *
  127. * Format handling
  128. *
  129. *
  130. * Error handling
  131. *
  132.  9999 CONTINUE
  133.       IRET=1
  134.       WRITE(IOIMP,*) 'An error was detected in subroutine infmat'
  135.       RETURN
  136. *
  137. * End of subroutine infmat
  138. *
  139.       END
  140.  
  141.  

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