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

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