CTITLEMRDTM -- DATUM ELEVATION SMOOTHING 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR GALEN WHIPPLE 00000200 CA DESIGNER GALEN WHIPPLE 00000300 CA LANGUAGE S/370 FORTRAN G/H (OR H EXTENDED) 00000400 CA SYSTEM IBM AND CRAY 00000500 CA WRITTEN 10-11-77 00000600 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON. 00000700 C REVISED 03-12-86 DCB. CONVERTED CODE TO A SINGLE 00000800 C SOURCE FOR EXECUTION ON BOTH THE 00000900 C IBM AND CRAY SYSTEMS. 00001000 CA 00001100 CA 00001200 CA CALL MRDTM (ELEV, NPTS, NSUM, FACTOR, DTMEL) 00001300 CA INPUT ELEV = SHOT/RECEIVER ELEVATIONS I2 00001400 CA INPUT NPTS = NUMBER OF SHOT/RECEIVER ELEVATIONS I4 00001500 CA INPUT NSUM = NUMBER OF POINTS IN SMOOTHING OPERATOR I4 00001600 CA INPUT FACTOR= REFERENCE DATUM FACTOR R4 00001700 CA INPUT/OUTPUT DTMEL = SHOT/RECEIVER DATUM ELEVATIONS I2 00001800 CA 00001900 CA 00002000 CA THIS SUBROUTINE SMOOTHS DATUM ELEVATIONS IN THE FOLLOWING 00002100 CA MANNER. 00002200 CA DTMEL(I) = (ESMTH - DTMEL(I))*FACTOR + DTMEL(I) 00002300 CA 00002400 CA I+NSUM/2 00002500 CA WHERE: ESMTH = ( SUM ELEV(I) )/NSUM 00002600 CA I-NSUM/2 00002700 CA 00002800 CA NOTE: NSUM SHOULD BE ODD, IF NSUM IS EVEN NSUM+1 WILL 00002900 CA BE USED AS THE OPERATOR LENGTH. 00003000 CAEND 00003100 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 00003200 C 00003300 C K = LENGTH OF SMOOTHING OPERATOR /2 I4 00003400 C I = DO VARIABLE I4 00003500 C N1 = INITIAL DO LOOP VARIABLE I4 00003600 C N2 = DO LOOP TEST VALUE 00003700 C SUM = ACCUMULATOR FOR SUMMING ELEVATIONS R4 00003800 C FSAVE = INTERMEDIATE DATUM ELEVATION USED FOR ROUNDING R4 00003900 C 00004000 C EJECT 00004100 SUBROUTINE MRDTM(ELEV,NPTS,NSUM,FACTOR,DTMEL) 00004200 IMPLICIT INTEGER (I-N) 00004300 INTEGER*2 ELEV(1),DTMEL(1) 00004400 REAL FSAVE 00004500 REAL FACTOR 00004600 K = NSUM/2 00004700 C 00004800 DO 40 00004900 * I=1,NPTS 00005000 N1 = I-K 00005100 N2 = I+K 00005200 IF (N1 .GE. 1) GO TO 10 00005300 N1 = 1 00005400 N2 = I+I-1 00005500 GO TO 20 00005600 C 00005700 10 IF (N2 .LE. NPTS) GO TO 20 00005800 N1 = I - (NPTS-I) 00005900 N2 = NPTS 00006000 C 00006100 20 SUM = 0 00006200 C 00006300 DO 30 00006400 * J=N1,N2 00006500 IF (ELEV(J) .EQ. -9999) GO TO 30 00006600 SUM = SUM + ELEV(J) 00006700 C 00006800 30 CONTINUE 00006900 C 00007000 FSAVE = FACTOR*( SUM/(N2-N1+1) - DTMEL(I) ) + DTMEL(I) 00007100 00007200 C 00007300 40 DTMEL(I) = FSAVE + SIGN(.5,FSAVE) 00007400 C 00007500 RETURN 00007600 END 00007700