C 
C Program BINASC to convert gridded data (data cubes) from binary files
C to formatted ascii files
C
C Version: 5.80
C Date: 2004, June 11
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C Attention:  Functionality of program BINASC is strongly affected by
C the Fortran compiler and by the options of the compiler.
C Program BINASC can work only if the compiler supports unformatted
C direct-access files "without headers".
C Binary data on little-endian hardware (PC's) and big-endian hardware
C (VAX, Alpha, RISC workstations) should strictly be distinguished.
C
C.......................................................................
C                                                    
C Description of data files:
C
C Input data read from the standard input device (*):
C     The data are read by the list directed input (free format) and
C     consist of a single string 'SEP':
C     'SEP'...String in apostrophes containing the name of the input
C             SEP parameter or history file with the input data.
C     No default, 'SEP' must be specified and cannot be blank.
C
C                                                     
C Input data file 'SEP':
C     File 'SEP' has the form of the SEP
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
C Data specifying dimensions of the input grid:
C     N1=positive integer... Number of gridpoints along the X1 axis.
C             Default: N1=1
C     N2=positive integer... Number of gridpoints along the X2 axis.
C             Default: N2=1
C     N3=positive integer... Number of gridpoints along the X3 axis.
C             Default: N3=1
C Optional data enabling to output a sparser grid:
C     N1NEW=positive integer... Number of output gridpoints along the X1
C             axis.
C             Default: N1NEW=N1
C     N2NEW=positive integer... Number of output gridpoints along the X2
C             axis.
C             Default: N2NEW=N2
C     N3NEW=positive integer... Number of output gridpoints along the X3
C             axis.
C             Default: N3NEW=N3
C     NO1=positive integer... Index of the first output gridpoint along
C             the X1 axis.
C             Default: NO1=1
C     NO2=positive integer... Index of the first output gridpoint along
C             the X2 axis.
C             Default: NO2=1
C     NO3=positive integer... Index of the first output gridpoint along
C             the X3 axis.
C             Default: NO3=1
C     ND1=positive integer... Multiplication factor of the grid interval
C             along the X1 axis.
C             Default: ND1=1
C     ND2=positive integer... Multiplication factor of the grid interval
C             along the X2 axis.
C             Default: ND2=1
C     ND3=positive integer... Multiplication factor of the grid interval
C             along the X3 axis.
C             Default: ND3=1
C Names of the grid files:
C     IN='string'... String with the name of the input unformatted file
C             containing the gridded values.  The file should contain
C             just the 4 byte IEEE reals.  The length of the file is
C             thus exactly 4*N1*N2*N3 bytes.
C             No default, IN must be specified and cannot be blank.
C     GRD='string'... String with the name of the output formatted file
C             to contain the gridded values.  The file contains N1*N2*N3
C             reals designed to be read by a single list directed (free
C             format) read statement.
C             No default, GRD must be specified and cannot be blank.
C Data specifying input/output format:
C     ESIZE=integer... Number of bytes per a real in the input binary
C             file.  Must be ESIZE=4.
C             Default: ESIZE=4
C     NDIG=integer...
C             NDIG=0: Optimization of the output format is entrusted to
C               the subroutines of file 'forms.for'.  This option is
C               recommended for calculations with the data.  The output
C               file will usually be only sligtly longer than twice the
C               input file.
C             NDIG.NE.0: The output format is '(5(Emm.nn,1X))'), with
C               mm=IABS(NDIG)+6, nn=IABS(NDIG).  Value of NDIG=9 is
C               probably the smallest one which enables to read exactly
C               the same values from unformatted and formatted files.
C               For NDIG=9, the output file will be 4 times (Unix) or
C               4.05 times (DOS) longer than the input file.
C               In general, (NDIG+7)/4 times (Unix) or (NDIG+7.2)/4
C               times (DOS).
C               Minus sign disables to read the formatted file and to
C               compare the values read from both the files.  The minus
C               option thus saves the time and requires twice less
C               memory.
C               Reading the formatted file and comparing the values read
C               from both the files is also disabled in this version if
C               the output grid is sparser than the input grid.
C             Default: NDIG=9
C Optional parameters specifying the form of the quantities
C written in the output formatted files:
C     MINDIG,MAXDIG=positive integers ... See the description in file
C             forms.for.
C     NUMLIN=positive integer ... Number of reals or integers in one
C             line of the output file. See the description in file
C             forms.for.
C
C=======================================================================
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
C
C.......................................................................
C
      CHARACTER*80 FILE1,FILE2
      INTEGER LU1,LU2
      PARAMETER (LU1=1,LU2=2)
C
      INTEGER NDIG,N1IN,N2IN,N3IN,N1,N2,N3,I1,I2
      REAL DIF
C
C.......................................................................
C
C     Reading main input data:
      WRITE(*,'(A)') '+BINASC: Enter input filename: '
      FILE1=' '
      READ(*,*) FILE1
      IF (FILE1.NE.' ') THEN
        CALL RSEP1(LU1,FILE1)
      ELSE
C       BINASC-01
        CALL ERROR('BINASC-01: SEP file not given')
C       Input file in the form of the SEP (Stanford Exploration Project)
C       parameter or history file must be specified.
C       There is no default filename.
      ENDIF
C
C     Input and output files with gridded data:
      CALL RSEP3T('IN',FILE1,' ')
      IF (FILE1.EQ.' ') THEN
C       BINASC-02
        CALL ERROR('BINASC-02: Input file not specified')
      END IF
      CALL RSEP3T('GRD',FILE2,' ')
      IF (FILE2.EQ.' ') THEN
C       BINASC-03
        CALL ERROR('BINASC-03: Output file not specified')
      END IF
      CALL RSEP3I('ESIZE',I1,4)
      IF (I1.NE.4) THEN
C       BINASC-04
        CALL ERROR('BINASC-04: Binary reals not 4-byte long')
      END IF
      CALL RSEP3I('NDIG',NDIG,9)
C
C     Reading grid dimensions:
      CALL RSEP3I('N1',N1IN,1)
      CALL RSEP3I('N2',N2IN,1)
      CALL RSEP3I('N3',N3IN,1)
      CALL RSEP3I('N1NEW',N1,N1IN)
      CALL RSEP3I('N2NEW',N2,N2IN)
      CALL RSEP3I('N3NEW',N3,N3IN)
      IF (N1*N2*N3.GT.MRAM) THEN
C       BINASC-05
        CALL ERROR('BINASC-05: Small dimension MRAM of array RAM')
      END IF
C
C     Reading input grid values:
      WRITE(*,'(A)') '+BINASC: Reading...            '
      CALL RBIN(LU1,FILE1,RAM,N1*N2*N3)
C
C     Writing output grid values:
      IF (NDIG.EQ.0) THEN
        CALL WARRAY(LU2,FILE2,'FORMATTED',.FALSE.,0.,.FALSE.,0.,
     *                                                     N1*N2*N3,RAM)
      ELSE
        WRITE(*,'(A)') '+BINASC: Writing...            '
        CALL WASC(LU2,FILE2,RAM,N1*N2*N3,NDIG)
      END IF
C
C     Comparison of values read from unformatted and formatted files:
      IF (NDIG.GT.0.AND.N1.EQ.N1IN
     *             .AND.N2.EQ.N2IN
     *             .AND.N3.EQ.N3IN) THEN
C       Twice the memory is required for the comparison
        IF (2*N1*N2*N3.GT.MRAM) THEN
C         BINASC-06
          CALL ERROR('BINASC-06: Small dimension MRAM of array RAM')
        END IF
C       Reading output grid values
        CALL RARRAY(LU2,FILE2,'FORMATTED',.TRUE.,0.,
     *                                         N1*N2*N3,RAM(N1*N2*N3+1))
C       Comparing grid values
        WRITE(*,'(A)') '+BINASC: Checking...                           '
        DIF=0.
        I2=N1*N2*N3
        DO 10 I1=1,N1*N2*N3
          I2=I2+1
          IF(RAM(I1).NE.RAM(I2)) THEN
            DIF=AMAX1(ABS((RAM(I1)-RAM(I2))/RAM(I1)),DIF)
          END IF
   10   CONTINUE
        WRITE(*,'(A,E15.7)') '+BINASC: Done.  Max.rel.difference: ',DIF
      ELSE
        WRITE(*,'(A)') '+BINASC: Done.                                 '
      END IF
C
      STOP
      END
C
C=======================================================================
C
      SUBROUTINE RBIN(LU,FILE,GRID,N)
      INTEGER LU,N
      CHARACTER*(*) FILE
      REAL GRID(N)
C
C-----------------------------------------------------------------------
C
      INTEGER N1IN,N2IN,N3IN,N1,N2,N3,NO1,NO2,NO3,ND1,ND2,ND3
      INTEGER I1,I2,I3,I1MIN,I2MIN,I3MIN,I1MAX,I2MAX,I3MAX,IREC,I
C
C     Any Fortran 77 compiler (option "direct files without headers"):
      OPEN(LU,FILE=FILE,FORM='UNFORMATTED',ACCESS='DIRECT',RECL=4,
     *                                                     STATUS='OLD')
C
C     Reading grid dimensions:
      CALL RSEP3I('N1',N1IN,1)
      CALL RSEP3I('N2',N2IN,1)
      CALL RSEP3I('N3',N3IN,1)
      CALL RSEP3I('N1NEW',N1,N1IN)
      CALL RSEP3I('N2NEW',N2,N2IN)
      CALL RSEP3I('N3NEW',N3,N3IN)
      IF (N1.EQ.N1IN.AND.N2.EQ.N2IN.AND.N3.EQ.N3IN) THEN
        DO 10 I=1,N
          READ(LU,REC=I) GRID(I)
   10   CONTINUE
C
C       Lahey F77L3 (compiler-dependent Fortran extension):
*       OPEN(LU,FILE=FILE,FORM='UNFORMATTED',ACCESS='TRANSPARENT')
*       READ(LU) GRID
      ELSE
        CALL RSEP3I('NO1',NO1,1)
        CALL RSEP3I('NO2',NO2,1)
        CALL RSEP3I('NO3',NO3,1)
        CALL RSEP3I('ND1',ND1,1)
        CALL RSEP3I('ND2',ND2,1)
        CALL RSEP3I('ND3',ND3,1)
        I1MIN=NO1
        I2MIN=NO2-1
        I3MIN=NO3-1
        I1MAX=I1MIN+(N1-1)*ND1
        I2MAX=I2MIN+(N2-1)*ND2
        I3MAX=I3MIN+(N3-1)*ND3
        I=0
        DO 23 I3=I3MIN,I3MAX,ND3
          DO 22 I2=I2MIN,I2MAX,ND2
            IREC=I1MIN+N1IN*(I2+N2IN*I3)
            DO 21 I1=I1MIN,I1MAX,ND1
              I=I+1
              READ(LU,REC=IREC) GRID(I)
              IREC=IREC+ND1
   21       CONTINUE
   22     CONTINUE
   23   CONTINUE
      END IF
C
      CLOSE(LU)
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE WASC(LU,FILE,GRID,N,NDIG)
      INTEGER LU,N,NDIG
      CHARACTER*(*) FILE
      REAL GRID(N)
C
C-----------------------------------------------------------------------
C
      INTRINSIC IABS,MOD
      INTEGER IABS,MOD
      CHARACTER*14 FORMAT
C
      OPEN(LU,FILE=FILE,FORM='FORMATTED')
      FORMAT='(5(E06.00,1X))'
      FORMAT(9:9)=CHAR(ICHAR('0')+MOD(IABS(NDIG),10))
      FORMAT(8:8)=CHAR(ICHAR('0')+    IABS(NDIG)/10 )
      FORMAT(6:6)=CHAR(ICHAR('0')+MOD(IABS(NDIG)+6,10))
      FORMAT(5:5)=CHAR(ICHAR('0')+   (IABS(NDIG)+6)/10)
      WRITE(LU,FORMAT) GRID
      CLOSE(LU)
      RETURN
      END
C
C=======================================================================
C
      SUBROUTINE RASC(LU,FILE,GRID,N)
      INTEGER LU,N
      CHARACTER*(*) FILE
      REAL GRID(N)
C
C-----------------------------------------------------------------------
C
      OPEN(LU,FILE=FILE,FORM='FORMATTED',STATUS='OLD')
      READ(LU,*) GRID
      CLOSE(LU)
      RETURN
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
      INCLUDE 'sep.for'
C     sep.for
      INCLUDE 'forms.for'
C     forms.for
      INCLUDE 'length.for'
C     length.for
C
C=======================================================================
C