C
C Program GMT to compute general transposed matrix GM2=GM1T. C C Version: 5.40 C Date: 2000, February 21 C C Coded by Petr Bulant C 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 input general matrix GM1 C and the number of columns of output general matrix GM2. 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 Filenames of the files with the matrices: C GM1='string'... Name of the input file containing general matrix C GM1. C No default, 'GM1' must be specified and cannot be blank. C GM2='string'... Name of the output file to contain general matrix C GM2=GM1T (GM1 transposed). C No default, 'GM2' 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 FILE1 INTEGER M1,M2,M1M2,LU1,I1,I2 PARAMETER (LU1=1) C C----------------------------------------------------------------------- C C Reading name of SEP file with input data: WRITE(*,'(A)') '+GMT: Enter input filename: ' FILE1=' ' READ(*,*) FILE1 C C Reading all data from the SEP file into the memory: IF (FILE1.NE.' ') THEN CALL RSEP1(LU1,FILE1) ELSE C GMT-01 CALL ERROR('GMT-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 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 M1M2=M1*M2 C IF (2*M1M2.GT.MRAM) THEN C GMT-02 CALL ERROR('GMT-02: Small dimension MRAM of array RAM') ENDIF C C Reading input matrices: CALL RSEP3T('GM1',FILE1,' ') IF (FILE1.EQ.' ') THEN C GMT-03 CALL ERROR('GMT-03: Input file with matrix GM1 not given.') ENDIF CALL RMAT(LU1,FILE1,M1,M2,RAM) CALL RSEP3T('GM2',FILE1,' ') IF (FILE1.EQ.' ') THEN C GMT-05 CALL ERROR('GMT-05: Output file with matrix GM2 not given.') ENDIF C C Multiplication: WRITE(*,'(A)') '+GMT: Calculating... ' DO 13 I2=1,M2 DO 12 I1=1,M1 RAM(M1M2+(I1-1)*M2+I2)=RAM((I2-1)*M1+I1) 12 CONTINUE 13 CONTINUE C C Writing output matrix GM2: CALL WMAT(LU1,FILE1,M2,M1,RAM(M1M2+1)) C WRITE(*,'(A)') '+GMT: Finished. ' 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