C
C Program GRDTRANS to transpose the coordinate axes of the gridded data C C Version: 7.40 C Date: 2017, May 18 C C Coded by: Ludek Klimes C Department of Geophysics, Charles University Prague, C Ke Karlovu 3, 121 16 Praha 2, Czech Republic, C http://sw3d.cz/staff/klimes.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 the SEP C parameter file. The parameters, which do not differ from their C defaults, need not be specified in file 'SEP'. C Names of the input and output files: C GRD='string'... Names of the input ASCII file with the grid C values. C Default: GRD='grd.out' C GRDNEW='string'... Name of the output ASCII file containing the C input grid values ordered according to the transposed C coordinates. C Default: GRDNEW='grdnew.out' C For general description of the files with gridded data refer C to file forms.htm. C Data specifying dimensions of the input grid: C N1=positive integer... Number of gridpoints along the fastest X1 C axis (inner loop). C Default: N1=1 C N2=positive integer... Number of gridpoints along the X2 axis C (intermediate loop). C Default: N2=1 C N3=positive integer... Number of gridpoints along the slowest C spatial X3 axis (outer spatial loop). C N4=positive integer... Number of gridpoints along optional time X4 C axis (outermost, temporal loop). C Default: N4=1 C Data specifying the output grid coordinates: C NEWX1=positive integer... Index of the input axis, corresponding C to the fastest output axis NEWX1 (inner output loop). C NEWX1=1: Fastest input axis (inner input loop), C NEWX1=2: Medium input axis (intermediate input loop), C NEWX1=3: Slowest input spatial axis (outer spatial input C loop). C NEWX1=4: Input time axis (outermost, temporal input loop). C Default: NEWX1=1 C NEWX2=positive integer... Index of the input axis, corresponding C to the output axis NEWX2. Analogous to NEWX1. C Default: NEWX2=2 C NEWX3=positive integer... Index of the input axis, corresponding C to the slowest output axis NEWX3. Analogous to NEWX1. C Default: NEWX3=3 C NEWX4=positive integer... Index of the input axis, corresponding C to the slowest output axis NEWX4. Analogous to NEWX1. C Default: NEWX4=4 C Optional parameters specifying the form of the quantities C written in the output formatted files: C MINDIG,MAXDIG=positive integers ... See the description in file C forms.for. C NUMLIN=positive integer ... Number of reals or integers in one C line of the output file. See the description in file C forms.for. C Value of undefined quantities: C UNDEF=real... The value to be used for undefined real quantities. C Default: UNDEF=undefined value used in forms.for C C======================================================================= C C Common block /RAMC/: INCLUDE 'ram.inc' C ram.inc C C....................................................................... C EXTERNAL UARRAY REAL UARRAY C C Filenames and parameters: CHARACTER*80 FSEP,FGRD1,FGRD2 INTEGER LU REAL UNDEF PARAMETER (LU=1) C Input data: INTEGER N1,N2,N3,N4,NEWX1,NEWX2,NEWX3,NEWX4 C Other variables: INTEGER NEWN1,NEWN2,NEWN3,NEWN4,ITRANS(4),I1,I2,I3,I4,I,J3,J4,J C C----------------------------------------------------------------------- C C Reading name of SEP file with input data: WRITE(*,'(A)') '+GRDTRANS: Enter input filename: ' FSEP=' ' READ(*,*) FSEP WRITE(*,'(A)') '+GRDTRANS: Working ... ' C C Reading all data from the SEP file into the memory: IF (FSEP.NE.' ') THEN CALL RSEP1(LU,FSEP) ELSE C GRDTRANS-01 CALL ERROR('GRDTRANS-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 UNDEF=UARRAY() C C Reading input parameters from the SEP file: CALL RSEP3T('GRD' ,FGRD1,'grd.out' ) CALL RSEP3T('GRDNEW',FGRD2,'grdnew.out') CALL RSEP3I('N1',N1,1) CALL RSEP3I('N2',N2,1) CALL RSEP3I('N3',N3,1) CALL RSEP3I('N4',N4,1) IF(2*N1*N2*N3*N4.GT.MRAM) THEN C GRDTRANS-02 CALL ERROR('GRDTRANS-02: Too small array RAM(MRAM)') C Array RAM(MRAM) allocated in include file 'ram.inc' is too small C to contain two input grids (2*N1*N2*N3*N4 values). You may wish C to increase the dimension MRAM in file 'ram.inc'. C ram.inc END IF CALL RSEP3I('NEWX1',NEWX1,1) CALL RSEP3I('NEWX2',NEWX2,2) CALL RSEP3I('NEWX3',NEWX3,3) CALL RSEP3I('NEWX4',NEWX4,4) IF(NEWX1.LT.1.OR.4.LT.NEWX1) THEN C GRDTRANS-03 CALL ERROR('GRDTRANS-03: Incorrect value of parameter NEWX1') END IF IF(NEWX2.LT.1.OR.4.LT.NEWX2) THEN C GRDTRANS-04 CALL ERROR('GRDTRANS-04: Incorrect value of parameter NEWX2') END IF IF(NEWX3.LT.1.OR.4.LT.NEWX3) THEN C GRDTRANS-05 CALL ERROR('GRDTRANS-05: Incorrect value of parameter NEWX3') END IF IF(NEWX4.LT.1.OR.4.LT.NEWX4) THEN C GRDTRANS-06 CALL ERROR('GRDTRANS-06: Incorrect value of parameter NEWX4') END IF IF(NEWX1.EQ.NEWX2.OR.NEWX1.EQ.NEWX3.OR.NEWX2.EQ.NEWX3.OR. * NEWX1.EQ.NEWX4.OR.NEWX2.EQ.NEWX4.OR.NEWX3.EQ.NEWX4) THEN C GRDTRANS-07 CALL ERROR('GRDTRANS-07: Coinciding output axes') END IF C ITRANS(1)=N1 ITRANS(2)=N2 ITRANS(3)=N3 ITRANS(4)=N4 NEWN1=ITRANS(NEWX1) NEWN2=ITRANS(NEWX2) NEWN3=ITRANS(NEWX3) NEWN4=ITRANS(NEWX4) ITRANS(1)=1 ITRANS(2)=N1 ITRANS(3)=N1*N2 ITRANS(4)=N1*N2*N3 NEWX1=ITRANS(NEWX1) NEWX2=ITRANS(NEWX2) NEWX3=ITRANS(NEWX3) NEWX4=ITRANS(NEWX4) C C Reading input grid: CALL RARAY(LU,FGRD1,'FORMATTED',.TRUE.,UNDEF,N1*N2*N3,N4,RAM) C C Tranposing the grid: I=N1*N2*N3*N4 DO 14 I4=0,NEWN4-1 J4=1+I4*NEWX4 DO 13 I3=0,NEWN3-1 J3=J4+I3*NEWX3 DO 12 I2=0,NEWN2-1 J=J3+I2*NEWX2 DO 11 I1=0,NEWN1-1 I=I+1 RAM(I)=RAM(J) J=J+NEWX1 11 CONTINUE 12 CONTINUE 13 CONTINUE 14 CONTINUE C C Writing output grid: CALL WARAY(LU,FGRD2,'FORMATTED',.TRUE.,UNDEF,.FALSE.,0.,N1*N2*N3, * N4,RAM(N1*N2*N3*N4+1)) WRITE(*,'(A)') '+GRDTRANS: 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