Esope source files

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