!
!##################################################################
!##################################################################
!###### ######
!###### subroutine linearint_2d ######
!###### ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. ######
!###### ######
!##################################################################
!##################################################################
!
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! linear interpolation in 2D.
!
!-----------------------------------------------------------------------
!
! AUTHOR:
!
! Jidong Gao, CAPS, July, 2000
!
!-----------------------------------------------------------------------
!
!
SUBROUTINE linearint_2df(nx,ny,vbl2,pxx,pyy,pval) 5
!
IMPLICIT NONE
!
!
INTEGER :: nx, ny, i, j
REAL vbl2(nx,ny)
REAL :: pxx, pyy
REAL :: pval
REAL :: deltadx,deltady,deltadxm,deltadym
!
!
i = IFIX(pxx)
j = IFIX(pyy)
!
! print*,'ij=',i,j,' pxx=',pxx,pyy
!
IF((0 < i) .AND. (i < nx) .AND. (0 < j) .AND. (j < ny)) THEN
!
!
deltadx = pxx - FLOAT(i)
deltady = pyy - FLOAT(j)
!
deltadxm= 1. - deltadx
deltadym= 1. - deltady
!
!
pval = deltadxm*deltadym * vbl2(i, j ) &
+ deltadx *deltadym * vbl2(i+1,j ) &
+ deltadxm*deltady * vbl2(i, j+1) &
+ deltadx *deltady * vbl2(i+1,j+1)
!
!
! ELSE
!
!
! WRITE (0,'(2(a,f10.2))') ' pxx = ',pxx,' pyy = ',pyy
! WRITE (0,'(a,/)') ' no interpolation was performed'
!
END IF
!
RETURN
END SUBROUTINE linearint_2df
!
!
!##################################################################
!##################################################################
!###### ######
!###### subroutine alinearint_2d ######
!###### ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. ######
!###### ######
!##################################################################
!##################################################################
!
!
!
SUBROUTINE alinearint_2df(nx, ny, vbl2, pxx, pyy, pval) 3
!
IMPLICIT NONE
!
INTEGER :: nx, ny, i, j
REAL vbl2 (nx,ny)
REAL :: pxx, pyy
REAL :: pval
REAL :: deltadx,deltady,deltadxm,deltadym
!
i = IFIX (pxx)
j = IFIX (pyy)
!
!
IF ((0 < i) .AND. (i < nx) .AND. (0 < j) .AND. (j < ny)) THEN
!
deltadx = pxx - FLOAT(i)
deltady = pyy - FLOAT(j)
!
deltadxm= 1. - deltadx
deltadym= 1. - deltady
!
vbl2(i+1,j+1)=vbl2(i+1,j+1) + deltadx*deltady *pval
vbl2(i ,j+1)=vbl2(i ,j+1) + deltadxm*deltady*pval
vbl2(i+1,j )=vbl2(i+1,j ) + deltadx*deltadym*pval
vbl2(i ,j )=vbl2(i ,j ) + deltadxm*deltadym*pval
pval = 0.
!
! ELSE
! WRITE (0,*) ' no interpolation was performed'
END IF
!
RETURN
END SUBROUTINE alinearint_2df
!
!
!##################################################################
!##################################################################
!###### ######
!###### subroutine map_to_mod2 ######
!###### ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. ######
!###### ######
!##################################################################
!##################################################################
!
!
SUBROUTINE map_to_mod2(nx,ny,mxobs,nobs,pgx,pgy,px,py,pxx,pyy) 3
!
IMPLICIT NONE
!
INTEGER :: nx, ny, i, j, n, nobs,mxobs
REAL pgx(nx)
REAL pgy(ny)
REAL :: px(mxobs), py(mxobs)
REAL :: pxx(mxobs),pyy(mxobs)
!
!
pxx = -99999.
pyy = -99999.
DO n = 1, nobs
!
DO j=1,ny-1
DO i=1,nx-1
IF( (px(n) >= pgx(i )) &
.AND. (px(n) < pgx(i+1)) &
.AND. (py(n) >= pgy(j )) &
.AND. (py(n) < pgy(j+1)) ) THEN
!
pxx(n) = FLOAT(i)+ ( px(n)-pgx(i) )/( pgx(i+1)-pgx(i) )
pyy(n) = FLOAT(j)+ ( py(n)-pgy(j) )/( pgy(j+1)-pgy(j) )
!
GOTO 100
END IF
!
END DO
END DO
100 continue
END DO
!
RETURN
END SUBROUTINE map_to_mod2
SUBROUTINE map_to_modz(nzk,mxobs,nlev,nobs,nx,ny,nz, & 3,2
pgz, pxx, pyy, hgt, ihgt, pz1, pz2)
!
!
IMPLICIT NONE
!
INTEGER :: nzk,mxobs,nobs
INTEGER :: nx,ny,nz,k,ii,kk
INTEGER :: nlev(mxobs)
REAL :: pgz(nx,ny,nz)
REAL :: pxx(mxobs), pyy(mxobs)
REAL :: pz1(nzk,mxobs),pz2(nzk,mxobs)
REAL :: hgt(nzk,mxobs)
INTEGER :: ihgt(nzk,mxobs)
!
ihgt = -1
DO ii = 1,nobs
DO kk = 1, nlev(ii)
!
if(pxx(ii)<-99990.0 .or. pyy(ii)<-99990.0) THEN
go to 100
END IF
DO k = 1, nz-1
CALL linearint_2df
(nx,ny,pgz(1,1,k ), &
pxx(ii),pyy(ii),pz1(kk,ii) )
CALL linearint_2df
(nx,ny,pgz(1,1,k+1), &
pxx(ii),pyy(ii),pz2(kk,ii) )
!
IF( hgt(kk,ii) <= pz1(kk,ii) ) THEN
ihgt(kk,ii) = 0
goto 100
ELSE IF( (hgt(kk,ii) > pz1(kk,ii) ) .AND. &
(hgt(kk,ii)<= pz2(kk,ii))) THEN
ihgt(kk,ii) = k
goto 100
END IF
END DO
100 continue
END DO
END DO
!
!
RETURN
END SUBROUTINE map_to_modz