You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
92 lines
2.9 KiB
Fortran
92 lines
2.9 KiB
Fortran
5 years ago
|
SUBROUTINE GETGRDELEV(M,IERREL)
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
USE BLKMAP
|
||
|
|
REAL*8 XXX,YYY
|
||
|
|
|
||
|
|
XXX=XUSR(M)
|
||
|
|
YYY=YUSR(M)
|
||
|
|
|
||
|
|
! test for XXX and YYY outside grid limits
|
||
|
|
|
||
|
|
IF(XXX .LT. XXORG-CELLSIZX/2. .OR. XXX .GT. XXORG+(FLOAT(NCOLS1)+0.5)*CELLSIZX) THEN
|
||
|
|
WD(M)=-9998.
|
||
|
|
RETURN
|
||
|
|
ELSE
|
||
|
|
IF(YYY .LT. YYORG-CELLSIZY/2. .OR. YYY .GT. YYORG+(FLOAT(NROWS1)+0.5)*CELLSIZY) THEN
|
||
|
|
WD(M)=-9998.
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
! Set row length in bytes and set temp origin
|
||
|
|
LENROW=NCOLS1*4
|
||
|
|
XORGT=XXORG
|
||
|
|
YORGT=YYORG
|
||
|
|
! Get row and column from lower left
|
||
|
|
|
||
|
|
NCOL=INT((XXX-XORGT)/CELLSIZX)+1
|
||
|
|
NROWU=INT((YYY-YORGT)/CELLSIZY)+1
|
||
|
|
|
||
|
|
! Establish fraction within cell
|
||
|
|
|
||
|
|
XFRAC=(XXX-XORGT-(NCOL-1)*CELLSIZX)/CELLSIZX
|
||
|
|
YFRAC=((YYY-YORGT-(NROWU-1)*CELLSIZY))/CELLSIZY
|
||
|
|
|
||
|
|
! Let fraction overlap outer edge
|
||
|
|
|
||
|
|
IF(XFRAC .LT. 0.) XFRAC=0.
|
||
|
|
IF(YFRAC .LT. 0.) YFRAC=0.
|
||
|
|
|
||
|
|
! Set up file position across columns, up rows and combine
|
||
|
|
NCOLFIL=(NCOL-1)*4
|
||
|
|
NROWFIL=(NROWS1-NROWU+1)*LENROW
|
||
|
|
NFILPOS=NCOLFIL+NROWFIL
|
||
|
|
|
||
|
|
! Read lower left the lower right allow fo upper limit
|
||
|
|
|
||
|
|
READ(203,POS=NFILPOS+1) ELEVLL
|
||
|
|
IF(NCOL .LT. NCOLS1) NFILPOS=NFILPOS+4
|
||
|
|
READ(203,POS=NFILPOS+1) ELEVLR
|
||
|
|
|
||
|
|
! Test for point ouside grid
|
||
|
|
|
||
|
|
IF(ELEVLL .LT. -9000. .OR. ELEVLR .LT. -9000.) THEN
|
||
|
|
WD(M)=-9998.
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
! Now mode to next row up and column
|
||
|
|
|
||
|
|
NROWFIL=(NROWS1-NROWU)*LENROW
|
||
|
|
NFILPOS=NCOLFIL+NROWFIL
|
||
|
|
READ(203,POS=NFILPOS+1) ELEVUL
|
||
|
|
IF(NCOL .LT. NCOLS1) NFILPOS=NFILPOS+4
|
||
|
|
READ(203,POS=NFILPOS+1) ELEVUR
|
||
|
|
|
||
|
|
! Test again
|
||
|
|
|
||
|
|
IF(ELEVUL .LT. -9000. .OR. ELEVUR .LT. -9000.) THEN
|
||
|
|
WD(M)=-9998.
|
||
|
|
RETURN
|
||
|
|
ENDIF
|
||
|
|
! interpolate along along lower and upper level
|
||
|
|
|
||
|
|
ELEVL=XFRAC*(ELEVLR-ELEVLL)+ELEVLL
|
||
|
|
ELEVU=XFRAC*(ELEVUR-ELEVUL)+ELEVUL
|
||
|
|
|
||
|
|
! Get final value, store and display
|
||
|
|
|
||
|
|
AMAPVAL=YFRAC*(ELEVU-ELEVL)+ELEVL
|
||
|
|
wd(m)=amapval
|
||
|
|
FPN = WD(M)*10.
|
||
|
|
X = CORD(M,1)
|
||
|
|
Y = CORD(M,2) - .11
|
||
|
|
IF(X .GT. 0. .AND. X .LT. HSIZE .AND. Y .GT. 0. .AND. Y .LT. 7.5) THEN
|
||
|
|
CALL RRED
|
||
|
|
CALL NUMBR(X,Y,0.1,FPN,0.0,-1)
|
||
|
|
endif
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
|
||
|
|
END
|