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 http://sw3d.cz/staff/klimes.htm 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