C
C Program GMGM to compute product GM3=GM1*GM2 of two general matrices
C GM1 and GM2.
C
C Version: 5.40
C Date: 2000, February 21
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 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 matrices:
C M1='string'... Name of the file containing a single integer number
C specifying the number of rows of matrices GM1 and GM3.
C Default: M1=' ' means that the number is 1.
C M2='string'... Name of the file containing a single integer number
C specifying the number of columns of matrix GM1 and the
C number of rows of matrix GM2.
C Default: M2=' ' means that the number is 1.
C M3='string'... Name of the file containing a single integer number
C specifying the number of columns of matrices GM2 and GM3.
C Default: M3=' ' means that the number is 1.
C Filenames of the files with the matrices:
C GM1='string' ... Name of the file containing matrix GM1 (input).
C No default, 'GM1' must be specified and cannot be blank.
C GM2='string' ... Name of the file containing matrix GM2 (input).
C No default, 'GM2' must be specified and cannot be blank.
C GM3='string' ... Name of the output file containing general matrix
C GM3=GM1*GM2.
C No default, 'GM3' must be specified and cannot be blank.
C For general description of the files with matrices refer to file
C forms.htm.
C
C-----------------------------------------------------------------------
C Subroutines and external functions required:
EXTERNAL ERROR,RSEP1,RSEP3T,RMAT,WMAT
C ERROR ... File error.for.
C RSEP1,RSEP3T ... File sep.for.
C RMAT,WMAT ... File forms.for.
C
C Common block /RAMC/:
INCLUDE 'ram.inc'
C ram.inc
C
CHARACTER*80 FILSEP,FILE1,FILE2,FILE3
INTEGER M1,M2,M3,NA,NB,NR,LU1,I1,I2,I3,J1,J2,J3
REAL CIJ
PARAMETER (LU1=1)
C
C-----------------------------------------------------------------------
C
C Reading a name of the file with the input data:
WRITE(*,'(A)') '+GMGM: Enter input filename: '
FILSEP=' '
READ(*,*) FILSEP
C
C Reading all the data from the SEP file into the memory:
IF (FILSEP.NE.' ') THEN
CALL RSEP1(LU1,FILSEP)
ELSE
C GMGM-01
CALL ERROR('GMGM-01: SEP file not given')
ENDIF
C
C Reading the dimensions of the matrices:
CALL RSEP3T('M1',FILE1,' ')
IF (FILE1.EQ.' ') THEN
M1=1
ELSE
OPEN(LU1,FILE=FILE1,STATUS='OLD')
READ(LU1,*) M1
CLOSE(LU1)
ENDIF
CALL RSEP3T('M2',FILE1,' ')
IF (FILE1.EQ.' ') THEN
M2=1
ELSE
OPEN(LU1,FILE=FILE1,STATUS='OLD')
READ(LU1,*) M2
CLOSE(LU1)
ENDIF
CALL RSEP3T('M3',FILE1,' ')
IF (FILE1.EQ.' ') THEN
M3=1
ELSE
OPEN(LU1,FILE=FILE1,STATUS='OLD')
READ(LU1,*) M3
CLOSE(LU1)
ENDIF
NA=M1*M2
NB=M2*M3
NR=M1*M3
C
IF (NA+NB+NR.GT.MRAM) THEN
C GMGM-02
CALL ERROR('GMGM-02: Small dimension MRAM of array RAM')
END IF
C
C Reading the names of the files with the matrices:
CALL RSEP3T('GM1',FILE1,' ')
CALL RSEP3T('GM2',FILE2,' ')
CALL RSEP3T('GM3',FILE3,' ')
C
C Reading input matrices:
IF (FILE1.EQ.' ') THEN
C GMGM-03
CALL ERROR('GMGM-03: Input file with matrix GM1 not given')
ENDIF
IF (FILE2.EQ.' ') THEN
C GMGM-04
CALL ERROR('GMGM-04: Input file with matrix GM2 not given')
ENDIF
IF (FILE3.EQ.' ') THEN
C GMGM-05
CALL ERROR('GMGM-05: Output file with matrix GM3 not given')
ENDIF
CALL RMAT(LU1,FILE1,M1,M2,RAM)
CALL RMAT(LU1,FILE2,M2,M3,RAM(NA+1))
C
WRITE(*,'(A)') '+GMGM: Working... '
C
C Multiplication:
J3=NA+NB
C Loop over columns:
DO 10, I1=1,M3
C Loop over lines:
DO 20, I2=1,M1
J3=J3+1
CIJ=0.
DO 30, I3=1,M2
C Element of the first matrix:
J1=(I3-1)*M1+I2
C Element of the second matrix:
J2=NA+(I1-1)*M2+I3
CIJ=CIJ+RAM(J1)*RAM(J2)
30 CONTINUE
RAM(J3)=CIJ
20 CONTINUE
10 CONTINUE
C
C Writing output matrix GM3:
IF (FILE3.NE.' ') THEN
CALL WMAT(LU1,FILE3,M1,M3,RAM(NA+NB+1))
ENDIF
WRITE(*,'(A)') '+GMGM: Done. '
C
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