Sources Esope | Cast3M

openrb
C OPENRB    SOURCE    JC220346  13/12/16    21:16:06     7884
C SORMAT    SOURCE    JC220346  12/06/18    21:15:25     7403
************************************************************************
* NOM         : openrb.eso
* DESCRIPTION : Ouverture d'un fichier au format RUTHERFORD BOEING (.rb)
* REFERENCES  : The Rutherford-Boeing Sparse Matrix Collection,
*               Duff I. S., Grimes R. G., Lewis G. L. (Sep 1997)
************************************************************************
* HISTORIQUE :  4/12/2012 : JCARDO : création de la subroutine
* HISTORIQUE :
* HISTORIQUE :
************************************************************************
* Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
* en cas de modification de ce sous-programme afin de faciliter
* la maintenance !
************************************************************************
* APPELÉ PAR : sormat.eso
************************************************************************
 
      SUBROUTINE OPENRB(CHNOMF,CHTYPE,CHTITR,
     &                  IVA1,IVA2,IVA3,IVA4,IVA5,IVA6,IVA7,IVA8,
     &                  CVA1,CVA2,CVA3,CVA4)
 
*              |    Fichier matrice    |  Fichier auxiliaire  |
*      --------+-----------------------+----------------------+
*        IVA1  |        TOTCRD         |        M             |
*        IVA2  |        PTRCRD         |        NVEC          |
*        IVA3  |        INDCRD         |        NAUXD         |
*        IVA4  |        VALCRD         |                      |
*        IVA5  |     NROW ou MVAR      |                      |
*        IVA6  |     NCOL ou NELT      |                      |
*        IVA7  |   NNZERO ou NVARIX    |                      |
*        IVA8  |        NELTVL         |                      |
*      --------+-----------------------+----------------------+
*        CVA1  |        MXTYPE         | DATTYP+POSITN+ORGNIZ |
*              |                       |       +CASEID+NUMERF |
*        CVA2  |        PTRFMT         |        AUXFM1        |
*        CVA3  |        INDFMT         |        AUXFM2        |
*        CVA4  |        VALFMT         |        AUXFM3        |
*
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
      EXTERNAL LONG
 
 
-INC PPARAM
-INC CCOPTIO
 
      CHARACTER*(*) CHNOMF,CHTYPE,CHTITR,CVA1,CVA2,CVA3,CVA4
 
      CHARACTER*8   NOMFUC,NOMFLC
      CHARACTER*256 CHDIRF
      CHARACTER*8   CHA8
 
      CHARACTER*26  MINUSC,MAJUSC
      CHARACTER*11  MDIGIT
      CHARACTER*63  MCHARS
      PARAMETER (MINUSC='abcdefghijklmnopqrstuvwxyz')
      PARAMETER (MAJUSC='ABCDEFGHIJKLMNOPQRSTUVWXYZ')
      PARAMETER (MDIGIT='0123456789_')
      PARAMETER (MCHARS=MINUSC//MAJUSC//MDIGIT)
 
 
*     VERIFICATION DU NOM
*     ===================
 
*     On récupère le nom du répertoire dans NOM1, s'il existe
      IREP=INDEX(CHNOMF,'/',BACK=.TRUE.)
      CHDIRF='./'
      IF (IREP.GT.0) THEN
          CHDIRF=CHNOMF(1:IREP)
          CHNOMF=CHNOMF(IREP+1:LONG(CHNOMF))
      ENDIF
 
*     Longueur du nom du fichier
      LC=LONG(CHNOMF)
      IF (LC.GT.8) THEN
          WRITE(*,*) 'le nom doit faire 8 char. max'
          MOTERR(1:8)=CHNOMF(1:5)//'...'
          CALL ERREUR(705)
          RETURN
      ENDIF
      MOTERR=CHNOMF
 
*     Conversion en majuscules/minuscules
      NOMFUC=CHNOMF
      NOMFLC=CHNOMF
      DO K=1,LC
          IC=INDEX(MCHARS,CHNOMF(K:K))
          IF (IC.EQ.0) THEN
              WRITE(*,*) 'le nom contient des caracteres interdits'
              CALL ERREUR(705)
              RETURN
          ENDIF
          IF (IC.LE.26) THEN
              NOMFUC(K:K)=MAJUSC(IC:IC)
          ELSEIF (IC.LE.52) THEN
              ID=IC-26
              NOMFLC(K:K)=MINUSC(ID:ID)
          ENDIF
      ENDDO
 
*     Le premier caractère ne peut pas être un _
      IF (NOMFUC(1:1).EQ.'_') THEN
          WRITE(*,*) 'le premier caractère doit etre alphanumerique'
          CALL ERREUR(705)
          RETURN
      ENDIF
 
 
 
*     OUVERTURE DU FICHIER
*     ====================
 
      OPEN(UNIT   = IOPER        ,
     &     STATUS = 'UNKNOWN'    ,
     &     FILE   = CHDIRF(1:LONG(CHDIRF))//CHNOMF(1:LC)//'.'//
     &              CHTYPE(1:LONG(CHTYPE))//'.rb' ,
     &     IOSTAT = IOS          ,
     &     FORM   = 'FORMATTED'  )
 
 
 
*     ÉCRITURE DE L'ENTETE
*     ====================
 
*     Ligne 1 : TITLE + MTRXID
      WRITE(UNIT=IOPER,FMT='(A71,A8)')
     .CHTITR(1:71),
     .NOMFUC(1:LC)
 
 
      IF (CHTYPE.EQ.'mtx') THEN
 
*         Ligne 2 : TOTCRD + PTRCRD + INDCRD + VALCRD
          WRITE(IOPER,FMT='(I14,3(1X,I13))')
     &    IVA1,IVA2,IVA3,IVA4
 
*         Ligne 3 : MXTYPE NROW NCOL NNZERO
*                ou MXTYPE MVAR NELT NVARIX NELTVL
          WRITE(IOPER,FMT='(A3,11X,4(1X,I13))')
     &    CVA1(1:3),IVA5,IVA6,IVA7,IVA8
 
*         Ligne 4 : PTRFMT + INDFMT + VALFMT
          WRITE(IOPER,FMT='(2A16,A20)')
     &    CVA2,CVA3,CVA4
 
      ELSE
 
*         Ligne 2 : DATTYP/POSITN/ORGNIZ/CASEID/NUMERF + M + NVEC + NAUXD
          WRITE(IOPER,FMT='(A5,1X,A8,1X,A1,3(1X,I13))')
     &    CVA1(1:5),CVA1(6:13),CVA1(14:14),IVA1,IVA2,IVA3
 
*         Ligne 3 : AUXFM1 + AUXFM2 + AUXFM3
          WRITE(IOPER,FMT='(3A20)')
     &    CVA2,CVA3,CVA4
 
      ENDIF
 
 
 
      RETURN
 
      END