C                                                            <HTML><PRE>
C Program GREENMUL to read given formatted file containing
C the ray-theory elastodynamic Green function in the form of the output
C file <A HREF="../green.for#GREEN">GREEN</A> generated by program
C 'green.for'. This program multiplies the amplitudes of the Green
C function by given parameter GREENAMP, and writes the results to the
C formated output file of the same form as the file GREEN.
      PROGRAM GREENMUL
C
C Version: 5.30
C Date: 1999, June 1
C
C Coded by: Petr Bulant
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: bulant@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C                                                    <A NAME="data"></A>
C Description of data files:
C
C Main input data read from external interactive device (*):
C     The data consist of a character string read by list directed (free
C     format) input.  The string have thus to be enclosed in
C     apostrophes.
C (1) 'SEP'/
C     'SEP'...Name of the file with input parameters.
C             If blank, default values of the corresponding data are
C             considered.
C     Default: 'SEP'=' '.
C
C Input file 'SEP' in the SEP format:
C     The file has the form of a SEP parameter file.
C     For the description of the SEP format refer to file
C     <A HREF="../../forms/sep.for#data">'sep.for'</A>.
C   Name of the input file with the Green function:
C     GREEN='string'... Name of the input formatted file with the Green
C       tensor.
C       <A HREF="../green.for#GREEN">Description of file GREEN</A>
C       Default: GREEN='green.out'
C   Name of the output file:
C     GREENMUL='string'... Name of the output formatted file with the
C       Green tensor multiplied by GREENAMP. The file has the same
C       format as the file GREEN.
C       Default: GREENMUL='greenmul.out'
C   Data describing the frequency domain:
C     NF=integer ... Number of frequencies.
C       Default: NF=1
C   Data describing the amplitude multiplication factor:
C     GREENAMP=real ... Amplitudes from the file GREEN are multiplied
C       by GREENAMP and written into the file GREENMUL.
C       Default: GREENAMP=1.
C
C-----------------------------------------------------------------------
C
C Subroutines and external functions required:
      INTEGER LENGTH
      EXTERNAL RSEP1,RSEP3I,RSEP3T,RSEP3R,FORM2,LENGTH
C     RSEP1,RSEP3I,RSEP3T,RSEP3R... File 'sep.for'.
C     FORM2...File 'forms.for'.
C     FORM1...File 'forms.for' (called by FORM2).
C     LENGTH..File 'length.for' (called by TXT2).
C
C-----------------------------------------------------------------------
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     <A HREF="../../forms/ram.inc">ram.inc</A>
C
      CHARACTER*80 FILSEP,FILIN,FILOUT
      CHARACTER*80 TEXT,TXTSRC,TXTREC
      CHARACTER*260 FORMAT
      INTEGER NF,NGREEN
      REAL AMP
      INTEGER LU1,LU2,I1,I
      PARAMETER (LU1=1,LU2=2)
C     Undefined value:
      REAL UNDEF
      PARAMETER (UNDEF=-999999.)
C
C     Main input data:
      FILSEP=' '
      WRITE(*,'(A)')
     *'+GREENMUL: Enter input filename: '
      READ(*,*) FILSEP
      WRITE(*,'(A)')
     *'+GREENMUL: Working...                                           '
C
C     Reading all the data from the SEP file into the memory:
      CALL RSEP1(LU1,FILSEP)
C
C     Name of the input file:
      CALL RSEP3T('GREEN',FILIN,'green.out')
C     Name of the output file:
      CALL RSEP3T('GREENMUL',FILOUT,'greenmul.out')
C     Number of frequencies:
      CALL RSEP3I('NF',NF,1)
C     Number for multiplication:
      CALL RSEP3R('GREENAMP',AMP,1.)
C
C     Opening input file with the Green function:
      OPEN(LU1,FILE=FILIN,STATUS='OLD')
      READ(LU1,*) (TEXT,I=1,20)
C
C     Opening the output file:
      OPEN(LU2,FILE=FILOUT)
      WRITE(LU2,'(A)') '/'
C
C     Loop over the records in file GREEN:
  10  CONTINUE
        NGREEN=14+18*NF
        DO 12, I1=1,NGREEN
          RAM(I1)=0.
  12    CONTINUE
        RAM(33)=UNDEF
C       Reading:
        TXTREC='$'
        READ(LU1,*) TXTREC,TXTSRC,(RAM(I),I=1,NGREEN)
        IF (TXTREC.EQ.'$') GOTO 20
        IF (RAM(33).EQ.UNDEF) THEN
C         Frequency-independent Green function:
          NGREEN=32
        ENDIF
C       Multiplying:
        DO 14, I1=15,NGREEN
          RAM(I1)=RAM(I1)*AMP
  14    CONTINUE
C       Writing:
        FORMAT(1:4)='(6A,'
        IF (NGREEN.LE.32) THEN
          CALL FORM2(32,RAM,RAM,FORMAT(5:260))
          WRITE(LU2,FORMAT) '''',TXTREC(1:LENGTH(TXTREC)),''' ''',
     *                      TXTSRC(1:LENGTH(TXTSRC)),'''',
     *                        (' ',RAM(I),I=1,NGREEN),' /'
        ELSE
          CALL FORM2(14,RAM,RAM,FORMAT(5:260))
          WRITE(LU2,FORMAT) '''',TXTREC(1:LENGTH(TXTREC)),''' ''',
     *                      TXTSRC(1:LENGTH(TXTSRC)),'''',
     *                        (' ',RAM(I),I=1,14)
          DO 16 I1=15,NGREEN-18,18
            FORMAT(1:4)='(1A,'
            CALL FORM2(18,RAM(I1),RAM(I1),FORMAT(5:260))
            WRITE(LU2,FORMAT) (' ',RAM(I),I=I1,I1+17)
  16      CONTINUE
          FORMAT(1:4)='(1A,'
          CALL FORM2(18,RAM(NGREEN-17),RAM(NGREEN-17),FORMAT(5:260))
          WRITE(LU2,FORMAT) (' ',RAM(I),I=NGREEN-17,NGREEN),' /'
        ENDIF
      GOTO 10
C
  20  CONTINUE
      WRITE(LU2,'(A)') '/'
      CLOSE(LU1)
      CLOSE(LU2)
      WRITE(*,'(A)')
     *'+GREENMUL: Done.                                                '
      END
C
C=======================================================================
C
      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>
C
C=======================================================================
C                                                                 </PRE>
