C 
C Program GREENMUL to multiply Green function by given parameter.
C The program reads given formatted file GREEN containing
C the ray-theory elastodynamic Green function in the form of the output
C file GREEN
C generated by program GREEN. The program then multiplies the amplitudes
C of the Green function by given parameter GREENAMP, and writes the
C results to the formated output file GREENMUL. The form of file
C GREENMUL is the same as the form of file GREEN.
C
C Version: 6.00
C Date: 2005, November 12
C
C Coded by: Petr Bulant
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     http://sw3d.cz/staff/bulant.htm
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 a SEP
C     parameter file.  The parameters, which do not differ from their
C     defaults, need not be specified in file 'SEP'.
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             Description of file
C        GREEN.
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             form as 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:
      EXTERNAL ERROR,RSEP1,RSEP3I,RSEP3T,RSEP3R,FORM2,UARRAY
      REAL UARRAY
C     ERROR ... File
C     error.for.
C     RSEP1,RSEP3I,RSEP3T,RSEP3R ...
C     File sep.for.
C     FORM2,UARRAY ... File
C     forms.for.
C
C-----------------------------------------------------------------------
C
C Common block /RAMC/:
      INCLUDE 'ram.inc'
C     ram.inc
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
C
      UNDEF=UARRAY()
C
C-----------------------------------------------------------------------
C
C     Main input data:
      FILSEP=' '
      WRITE(*,'(A)') '+GREENMUL: Enter input filename: '
      READ(*,*) FILSEP
      IF (FILSEP.EQ.' ') THEN
C       GREENMUL-01
        CALL ERROR('GREENMUL-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
      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.                 '
      STOP
      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