Esope source files

   1 : C OPENRB    SOURCE    JC220346  13/12/16    21:16:06     7884           
   2 : C SORMAT    SOURCE    JC220346  12/06/18    21:15:25     7403
   3 : ************************************************************************
   4 : * NOM         : openrb.eso
   5 : * DESCRIPTION : Ouverture d'un fichier au format RUTHERFORD BOEING (.rb)
   6 : * REFERENCES  : The Rutherford-Boeing Sparse Matrix Collection,
   7 : *               Duff I. S., Grimes R. G., Lewis G. L. (Sep 1997)
   8 : ************************************************************************
   9 : * HISTORIQUE :  4/12/2012 : JCARDO : création de la subroutine
  10 : * HISTORIQUE :
  11 : * HISTORIQUE :
  12 : ************************************************************************
  13 : * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  14 : * en cas de modification de ce sous-programme afin de faciliter
  15 : * la maintenance !
  16 : ************************************************************************
  17 : * APPELÉ PAR : sormat.eso
  18 : ************************************************************************
  19 : 
  20 :       SUBROUTINE OPENRB(CHNOMF,CHTYPE,CHTITR,
  21 :      &                  IVA1,IVA2,IVA3,IVA4,IVA5,IVA6,IVA7,IVA8,
  22 :      &                  CVA1,CVA2,CVA3,CVA4)
  23 : 
  24 : *              |    Fichier matrice    |  Fichier auxiliaire  |
  25 : *      --------+-----------------------+----------------------+
  26 : *        IVA1  |        TOTCRD         |        M             |
  27 : *        IVA2  |        PTRCRD         |        NVEC          |
  28 : *        IVA3  |        INDCRD         |        NAUXD         |
  29 : *        IVA4  |        VALCRD         |                      |
  30 : *        IVA5  |     NROW ou MVAR      |                      |
  31 : *        IVA6  |     NCOL ou NELT      |                      |
  32 : *        IVA7  |   NNZERO ou NVARIX    |                      |
  33 : *        IVA8  |        NELTVL         |                      |
  34 : *      --------+-----------------------+----------------------+
  35 : *        CVA1  |        MXTYPE         | DATTYP+POSITN+ORGNIZ |
  36 : *              |                       |       +CASEID+NUMERF |
  37 : *        CVA2  |        PTRFMT         |        AUXFM1        |
  38 : *        CVA3  |        INDFMT         |        AUXFM2        |
  39 : *        CVA4  |        VALFMT         |        AUXFM3        |
  40 : *
  41 : 
  42 :       IMPLICIT INTEGER(I-N)
  43 :       IMPLICIT REAL*8(A-H,O-Z)
  44 : 
  45 :       EXTERNAL LONG
  46 : 
  47 : -INC CCOPTIO
  48 : 
  49 :       CHARACTER*(*) CHNOMF,CHTYPE,CHTITR,CVA1,CVA2,CVA3,CVA4
  50 : 
  51 :       CHARACTER*8   NOMFUC,NOMFLC
  52 :       CHARACTER*256 CHDIRF
  53 :       CHARACTER*8   CHA8
  54 : 
  55 :       CHARACTER*26  MINUSC,MAJUSC
  56 :       CHARACTER*11  MDIGIT
  57 :       CHARACTER*63  MCHARS
  58 :       PARAMETER (MINUSC='abcdefghijklmnopqrstuvwxyz')
  59 :       PARAMETER (MAJUSC='ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  60 :       PARAMETER (MDIGIT='0123456789_')
  61 :       PARAMETER (MCHARS=MINUSC//MAJUSC//MDIGIT)
  62 : 
  63 : 
  64 : *     VERIFICATION DU NOM
  65 : *     ===================
  66 : 
  67 : *     On récupère le nom du répertoire dans NOM1, s'il existe
  68 :       IREP=INDEX(CHNOMF,'/',BACK=.TRUE.)
  69 :       CHDIRF='./'
  70 :       IF (IREP.GT.0) THEN
  71 :           CHDIRF=CHNOMF(1:IREP)
  72 :           CHNOMF=CHNOMF(IREP+1:LONG(CHNOMF))
  73 :       ENDIF
  74 : 
  75 : *     Longueur du nom du fichier
  76 :       LC=LONG(CHNOMF)
  77 :       IF (LC.GT.8) THEN
  78 :           WRITE(*,*) 'le nom doit faire 8 char. max'
  79 :           MOTERR(1:8)=CHNOMF(1:5)//'...'
  79 :           CALL ERREUR(705)
  80 :           RETURN
  81 :       ENDIF
  82 :       MOTERR=CHNOMF
  83 :       
  84 : *     Conversion en majuscules/minuscules
  85 :       NOMFUC=CHNOMF
  86 :       NOMFLC=CHNOMF
  87 :       DO K=1,LC
  88 :           IC=INDEX(MCHARS,CHNOMF(K:K))
  89 :           IF (IC.EQ.0) THEN
  90 :               WRITE(*,*) 'le nom contient des caracteres interdits'
  90 :               CALL ERREUR(705)
  91 :               RETURN
  92 :           ENDIF
  93 :           IF (IC.LE.26) THEN
  94 :               NOMFUC(K:K)=MAJUSC(IC:IC)
  95 :           ELSEIF (IC.LE.52) THEN
  96 :               ID=IC-26
  97 :               NOMFLC(K:K)=MINUSC(ID:ID)
  98 :           ENDIF
  99 :       ENDDO
 100 : 
 101 : *     Le premier caractère ne peut pas être un _
 102 :       IF (NOMFUC(1:1).EQ.'_') THEN
 103 :           WRITE(*,*) 'le premier caractère doit etre alphanumerique'
 103 :           CALL ERREUR(705)
 104 :           RETURN
 105 :       ENDIF
 106 : 
 107 : 
 108 : 
 109 : *     OUVERTURE DU FICHIER
 110 : *     ====================
 111 : 
 112 :       OPEN(UNIT   = IOPER        ,
 113 :      &     STATUS = 'UNKNOWN'    ,
 114 :      &     FILE   = CHDIRF(1:LONG(CHDIRF))//CHNOMF(1:LC)//'.'//
 115 :      &              CHTYPE(1:LONG(CHTYPE))//'.rb' ,
 116 :      &     IOSTAT = IOS          ,
 117 :      &     FORM   = 'FORMATTED'  )
 118 : 
 119 : 
 120 : 
 121 : *     ÉCRITURE DE L'ENTETE
 122 : *     ====================
 123 : 
 124 : *     Ligne 1 : TITLE + MTRXID
 125 :       WRITE(UNIT=IOPER,FMT='(A71,A8)')
 126 :      .CHTITR(1:71),
 127 :      .NOMFUC(1:LC)
 128 : 
 129 : 
 130 :       IF (CHTYPE.EQ.'mtx') THEN
 131 : 
 132 : *         Ligne 2 : TOTCRD + PTRCRD + INDCRD + VALCRD
 133 :           WRITE(IOPER,FMT='(I14,3(1X,I13))')
 134 :      &    IVA1,IVA2,IVA3,IVA4
 135 : 
 136 : *         Ligne 3 : MXTYPE NROW NCOL NNZERO
 137 : *                ou MXTYPE MVAR NELT NVARIX NELTVL
 138 :           WRITE(IOPER,FMT='(A3,11X,4(1X,I13))')
 139 :      &    CVA1(1:3),IVA5,IVA6,IVA7,IVA8
 140 : 
 141 : *         Ligne 4 : PTRFMT + INDFMT + VALFMT
 142 :           WRITE(IOPER,FMT='(2A16,A20)')
 143 :      &    CVA2,CVA3,CVA4
 144 : 
 145 :       ELSE
 146 : 
 147 : *         Ligne 2 : DATTYP/POSITN/ORGNIZ/CASEID/NUMERF + M + NVEC + NAUXD
 148 :           WRITE(IOPER,FMT='(A5,1X,A8,1X,A1,3(1X,I13))')
 149 :      &    CVA1(1:5),CVA1(6:13),CVA1(14:14),IVA1,IVA2,IVA3
 150 : 
 151 : *         Ligne 3 : AUXFM1 + AUXFM2 + AUXFM3
 152 :           WRITE(IOPER,FMT='(3A20)')
 153 :      &    CVA2,CVA3,CVA4
 154 : 
 155 :       ENDIF
 156 : 
 157 : 
 158 : 
 159 :       RETURN
 160 : 
 161 :       END
 162 :