C                                                            <HTML><PRE>
C Program NEWPAR to modify the effective elastic parameters (harmonic
C averages of elastic parameters) for 2-D elastic finite differences
C
C Date: 1998, November 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                                                    <A NAME="data"></A>
C Description of data files:
C
C Main input data read from the * input device:
C     The data are read in by the list directed input (free format), by
C     a single READ statement.  The data consist of character strings
C     which have to be enclosed in apostrophes.  Note that the
C     interactive * external unit may be piped or redirected to a file.
C     The following items are read:
C     'FSEP'..String in apostrophes containing the name of the input
C             file with the data specifying the dimensions of the basic
C             grid of N1*N2*N3 gridpoints.
C     /...    Input data line should be terminated by a slash.
C     Defaults: 'FSEP'='fd.h'.
C
C Data file 'FSEP' specifying grid dimensions have the form of the SEP
C (Stanford Exploration Project) parameter file:
C     All the data are specified in the form of PARAMETER=VALUE, e.g.
C     N1=50, with PARAMETER directly preceding = without intervening
C     spaces and with VALUE directly following = without intervening
C     spaces.  The PARAMETER=VALUE couple must be delimited by a space
C     or comma from both sides.
C     The PARAMETER string is not case-sensitive.
C     PARAMETER= followed by a space resets the default parameter value.
C     All other text in the input files is ignored.  The file thus may
C     contain unused data or comments without leading comment character.
C     Everything between comment character # and the end of the
C     respective line is ignored, too.
C     The PARAMETER=VALUE couples may be specified in any order.
C     The last appearance takes precedence.
C This program understands the following parameters common to nearly all
C programs dealing with SEP-like gridded data formats:
C     N1=positive integer... Number of gridpoints of the basic grid
C             along the X1 axis.  Default: N1=1
C     N2=positive integer... Number of gridpoints of the basic grid
C             along the X2 axis.  Default: N2=1
C     N3=positive integer... Number of gridpoints of the basic grid
C             along the X3 axis.  Default: N3=1
C And the following parameters specific to effective-parameter FD codes:
C     FORM='string'... Form of the input and output files:
C             FORM='formatted': Formatted ASCII files,
C             FORM='unformatted': Unformatted files.
C     A13='string', B13='string', C13='string'... Strings in apostrophes
C             containing the names of the input files with
C             (N1-1)*N2*(N3-1) values of the elastic parameters averaged
C             in the direction the X1 axis, along the gridlines shifted
C             half a grid interval in the direction of the X3 axis.
C             Defaults: A13=' ', B13=' ', C13=' '.
C     A31='string', B31='string', C31='string'... Strings in apostrophes
C             containing the names of the input files with
C             (N1-1)*N2*(N3-1) values of the elastic parameters averaged
C             in the direction the X3 axis, along the gridlines shifted
C             half a grid interval in the direction of the X1 axis.
C             Defaults: A31=' ', B31=' ', C31=' '.
C     AA13='string', BB13='string', CC13='string'... Strings in
c             apostrophes containing the names of the output files with
C             (N1-1)*N2*(N3-1) values of the average values of elastic
C             parameters A13 and A31, B13 and B31, C13 and C31,
C             respectively.
C             Defaults: AA13=' ', BB13=' ', CC13=' '.
C     Analogously A12, B12, C12, A21, B21, C21, AA12, BB12, CC12, A23,
C             B23, C23, A32, B32, C32, AA23, BB23 and CC23.
C
C=======================================================================
C
C Common block /RAMC/ to allocate large array RAM:
      INCLUDE 'ram.inc'
C     <A HREF="../forms/ram.inc">ram.inc</A>
C
C-----------------------------------------------------------------------
C
C     Input and output data filenames and logical unit numbers:
      CHARACTER*80 FSEP
      INTEGER LU
      PARAMETER (LU=1)
C     FSEP... The name of the input data file with FD parameters in SEP
C             format.
C     LU...   Logical unit number to be used to read and write data
C             files.
C
      INTEGER NX,NZ,N,I
      REAL DX
C
C.......................................................................
C
C     Main input data:
C     Default:
      FSEP='fd.h'
C     Reading main input data:
      WRITE (*,'(2A)')
     *  ' Enter name of input SEP file [''fd.h'']: '
      READ (*,*) FSEP
C
C     Reading all the data from input SEP parameter file:
      CALL RSEP1(LU,FSEP)
C
C     Data specifying grid dimensions
      CALL FDGRID(MRAM/3,MRAM/3,MRAM/3,NX,NZ,DX)
      N=(NX-1)*(NZ-1)
C
C     Modifying the gridded effective elastic parameters A:
      CALL FDIN1(LU,NX-1,NZ-1,'A13',RAM     ,RAM(2*N+1),0,RAM)
      CALL FDIN1(LU,NX-1,NZ-1,'A31',RAM(N+1),RAM(2*N+1),0,RAM)
      DO 10 I=1,N
        RAM(I)=0.5*(RAM(I)+RAM(N+I))
   10 CONTINUE
      CALL FDOUT1(LU,NX-1,NZ-1,'AA13',RAM,RAM(2*N+1))
C
C     Modifying the gridded effective elastic parameters B:
      CALL FDIN1(LU,NX-1,NZ-1,'B13',RAM     ,RAM(2*N+1),0,RAM)
      CALL FDIN1(LU,NX-1,NZ-1,'B31',RAM(N+1),RAM(2*N+1),0,RAM)
      DO 20 I=1,N
        RAM(I)=0.5*(RAM(I)+RAM(N+I))
   20 CONTINUE
      CALL FDOUT1(LU,NX-1,NZ-1,'BB13',RAM,RAM(2*N+1))
C
C     Modifying the gridded effective elastic parameters C:
      CALL FDIN1(LU,NX-1,NZ-1,'C13',RAM     ,RAM(2*N+1),0,RAM)
      CALL FDIN1(LU,NX-1,NZ-1,'C31',RAM(N+1),RAM(2*N+1),0,RAM)
      DO 30 I=1,N
        RAM(I)=0.5*(RAM(I)+RAM(N+I))
   30 CONTINUE
      CALL FDOUT1(LU,NX-1,NZ-1,'CC13',RAM,RAM(2*N+1))
C
      WRITE(*,'(A)') '+NEWPAR: done.                                   '
C
      STOP
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     <A HREF="../forms/error.for">error.for</A>
      INCLUDE 'sep.for'
C     <A HREF="../forms/sep.for">sep.for</A>
      INCLUDE 'forms.for'
C     <A HREF="../forms/forms.for">forms.for</A>
      INCLUDE 'length.for'
C     <A HREF="../forms/length.for">length.for</A>
      INCLUDE 'fdaux.for'
C     <A HREF="fdaux.for">fdaux.for</A>
      INCLUDE 'gmtra.for'
C     <A HREF="gmtra.for">gmtra.for</A>
C
C=======================================================================
C                                                                 </PRE>
