! !################################################################## !################################################################## !###### ###### !###### 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