Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/pltlib/cmisc1/grider.for
There is 1 other file named grider.for in the archive. Click here to see a list.
SUBROUTINE GRIDER (N,X,Y,Z,GRDSIZ,IX,IY,ZZ,NX,NY,
* MXMN,XMAX,XMIN,YMAX,YMIN,ZMAX,ZMIN)
C
C
C THIS ROUTINE ENABLES THE USER TO GRID IRREGULARY SPACED
C THREE-DIMENSIONAL DATA INTO EQUALLY SPACED ELEVATIONS
C (A WEIGHTED MOVING AVERAGE IS USED)
C
C
C CALLING SEQUENCE:
C
C CALL GRIDER (N,X,Y,Z,GRDSIZ,IX,IY,ZZ,NX,NY,
C * MXMN,XMAX,XMIN,YMAX,YMIN,ZMAX,ZMIN)
C
C
C N - (INPUT) THE NUMBER OF (X,Y,Z) TRIPLICATES TO BE GRIDDED
C
C (X,Y,Z) - (INPUT) THE COORDINATES OF THE IRREGULARY SPACED
C THREE-DIMENSIONAL DATA TO BE GRIDDED
C (NOTE - THE X ARRAY CONTAINS THE X VALUES
C THE Y ARRAY CONTAINS THE Y VALUES
C THE Z ARRAY CONTAINS THE Z VALUES)
C
C GRDSIZ - (INPUT)^1 THE DESIRED LENGTH OF EACH SQUARE IN THE GRID
C (NOTE - IF GRDSIZ .LE. 0 CALCULATE THE BEST GRDSIZ)
C (OUTPUT) THE LENGTH OF EACH SQUARE USED IN THE GRID
C (WARNING - GRDSIZ MAY BE CHANGED BY GRIDER)
C
C IX - (INPUT)^2 THE NUMBER OF GRID LINES WANTED IN THE X
C DIRECTION (NOTE - IF IX .LE. 1 CALCUATE THE BEST IX)
C (OUTPUT) THE NUMBER OF GRID LINES USED IN THE X DIRECTION
C (WARNING - IX MAY BE CHANGED BY GRIDER)
C
C IY - (INPUT)^3 THE NUMBER OF GRID LINES WANTED IN THE Y
C DIRECTION (NOTE - IF IY .LE. 1 CALCUATE THE BEST IY)
C (OUTPUT) THE NUMBER OF GRID LINES USED IN THE Y DIRECTION
C (WARNING - IY MAY BE CHANGED BY GRIDER)
C
C ZZ - (OUTPUT) THE TWO-DIMENSIONAL ARRAY THAT CONTAINS THE
C GRIDDED DATA
C
C NX - (INPUT) THE X DIMENSION OF THE ZZ ARRAY
C
C NY - (INPUT) THE Y DIMENSION OF THE ZZ ARRAY
C
C MXMN - (INPUT) FLAG TO CALCULATE X AND Y MAXIMUMS AND MINUMIMS
C IF MXMN .EQ. 0, CALCULATE XMAX, XMIN, YMAX, AND YMIN
C IF MXMN .NE. 0, DON'T CALCULTE XMAX, XMIN, YMAX, AND
C YMIN USE WHAT THE CALLER SENDS
C
C XMAX - (INPUT) THE MAXIMUM X VALUE
C (OUTPUT) THE MAXIMUM X VALUE (WARNING - XMAX MAY BE
C CHANGED BY GRIDER)
C
C XMIN - (INPUT) THE MINIMUM X VALUE
C (OUTPUT) THE MINIMUM X VALUE (WARNING - XMIN MAY BE
C CHANGED BY GRIDER)
C
C YMAX - (INPUT) THE MAXIMUM Y VALUE
C (OUTPUT) THE MAXIMUM Y VALUE (WARNING - YMAX MAY BE
C CHANGED BY GRIDER)
C
C YMIN - (INPUT) THE MINIMUM Y VALUE
C (OUTPUT) THE MINIMUM Y VALUE (WARNING - YMIN MAY BE
C CHANGED BY GRIDER)
C
C ZMAX - (OUTPUT) THE MAXIMUM Z VALUE
C
C ZMIN - (OUTPUT) THE MINIMUM Z VALUE
C
C
C NOTE: REQUIRED SUBROUTINES - MAXMIN
C
C
DIMENSION X(1),Y(1),Z(1),ZZ(NX,NY),D(0:6),N1(6)
EQUIVALENCE (DX,XP),(DY,YP)
REAL MINX,MINY,MINZ,MAXZ
DATA D(0)/1.0E-37/
C
C BOUNDARIES AREN'T DEFINED BY THE CALLER, SO GO GET THEM
C
1000 IF (MXMN .NE. 0) GOTO 1100
CALL MAXMIN (X,N,XMAX,XMIN)
CALL MAXMIN (Y,N,YMAX,YMIN)
C
C COMPUTE THE MAXIMUM AND MINIMUM Z VALUES
C AND GET SOME DELTA VALUES
C
1100 CALL MAXMIN (Z,N,ZMAX,ZMIN)
DX = XMAX - XMIN
DY = YMAX - YMIN
C
C GRID SPACING SPECIFIED
C
IF (GRDSIZ .LE. 0.) GOTO 1200
IX = DX / GRDSIZ + 1.5
IY = DY / GRDSIZ + 1.5
GOTO 1700
C
C NUMBER OF X GRID LINES SPECIFIED
C
1200 IF (IX .LE. 1) GOTO 1400
1300 GRDSIZ = DX / FLOAT(IX - 1)
IY = DY / GRDSIZ + 1.5
GOTO 1700
C
C NUMBER OF Y GRID LINES SPECIFIED
C
1400 IF (IY .LE. 1) GOTO 1600
1500 GRDSIZ = DY / FLOAT(IY - 1)
IX = DX / GRDSIZ + 1.5
GOTO 1700
C
C NO SPECIFICATIONS GIVEN
C PROGRAM COMPUTES BEST GRID SIZE
C
1600 GRDSIZ = SQRT((DX * DY) / FLOAT(N))
IX = DX / GRDSIZ + 1.5
IY = DY / GRDSIZ + 1.5
1700 IF (IX .LE. NX) GOTO 1800
IX = NX
GOTO 1200
1800 IF (IY .LE. NY) GOTO 1900
IY = NY
GOTO 1500
C
C PERFORM INTERPOLATION
C
1900 MINX = XMIN + (DX - FLOAT(IX - 1) * GRDSIZ ) / 2.
MINY = YMIN + (DY - FLOAT(IY - 1) * GRDSIZ ) / 2.
CLOSE = GRDSIZ / 25.
DUM = (ZMAX - ZMIN) / 2.
MAXZ = ZMAX + DUM
MINZ = ZMIN - DUM
C
C LOOP THROUGH THE GRID 'X' BY 'X'
C
2000 DO 2800 I = 1,IX
XP = MINX + (FLOAT(I - 1)) * GRDSIZ
C
C LOOP THROUGH EACH 'X', 'Y' BY 'Y'
C
DO 2700 J = 1,IY
YP = MINY + (FLOAT(J - 1)) * GRDSIZ
L = 0
C
C TEST EACH DATA POINT TO FIND THE NEAREST ONES
C
DO 2500 M = 1,N
DIST = (XP - X(M))**2 + (YP - Y(M))**2
IF (DIST .GE. CLOSE) GOTO 2100
C
C AN ORIGINAL DATA POINT LIES WITHIN A 1/25TH OF A GRID
C SPACING, INTERPOLATION STOPPED FOR THIS POINT
C
ZZ(I,J) = Z(M)
GOTO 2700
C
C FIND SIX NEAREST POINTS
C
2100 IF (DIST .GE. D(L)) GOTO 2400
IF (L .LT. 6) L = L + 1
L1 = L - 1
KK = L1
DO 2200 K = L1,1,-1
IF (DIST .GE. D(K)) GOTO 2300
D(K+1) = D(K)
N1(K+1) = N1(K)
2200 KK=K
2300 D(KK) = DIST
N1(KK) = M
GOTO 2500
2400 IF(L .GE. 6) GOTO 2500
L = L + 1
D(L) = DIST
N1(L) = M
2500 CONTINUE
C
C COMPUTE WEIGHTED MOVING AVERAGE
C
DUM2 = 0.
PSUM = 0.
DO 2600 M = 1,6
DUM = 1. / (SQRT(D(M)))
PSUM = PSUM + DUM
2600 DUM2 = DUM2 + Z(N1(M)) * DUM
DUM1 = Z(N1(1))
DUM = (DUM1 + DUM2 / PSUM) / 2.
IF (DUM .LE. MAXZ .AND. DUM .GE. MINZ) DUM1 = DUM
ZZ(I,J) = DUM1
2700 CONTINUE
2800 CONTINUE
RETURN
END