120 lines
3.2 KiB
Fortran
120 lines
3.2 KiB
Fortran
!!!! Derived from interp_2p5min.f from http://earth-info.nga.mil/GandG/wgs84/gravitymod/egm2008/interp_2p5min.f
|
|
!!!! Modified for ISCE by Piyush Agram
|
|
|
|
FUNCTION IFRAC(R)
|
|
implicit none
|
|
double precision :: R
|
|
integer :: IFRAC
|
|
|
|
IFRAC=R
|
|
IF (R.GE.0) RETURN
|
|
IF (R.EQ.IFRAC) RETURN
|
|
IFRAC = IFRAC - 1
|
|
END FUNCTION IFRAC
|
|
|
|
SUBROUTINE INITSPLINE(Y, N, R, Q)
|
|
|
|
implicit none
|
|
integer :: N,K
|
|
double precision, dimension(N) :: Y,R,Q
|
|
double precision :: P
|
|
Q(1) = 0.0
|
|
R(1) = 0.0
|
|
DO K = 2, N-1
|
|
P = Q(K-1)/2+2
|
|
Q(K) = -0.5/P
|
|
R(K) = (3*(Y(K+1)-2*Y(K)+Y(K-1)) - R(K-1)/2)/P
|
|
ENDDO
|
|
|
|
R(N) = 0.0
|
|
DO K = N-1, 2, -1
|
|
R(K) = Q(K)*R(K+1)+R(K)
|
|
END DO
|
|
END SUBROUTINE INITSPLINE
|
|
|
|
|
|
FUNCTION SPLINE(X, Y, N, R)
|
|
|
|
implicit none
|
|
integer :: N,J
|
|
integer :: IFRAC
|
|
double precision, dimension(N) :: Y,R
|
|
double precision :: X, XX
|
|
double precision :: SPLINE
|
|
|
|
IF (X.LT.1) THEN
|
|
SPLINE = Y(1) + (X-1)*(Y(2)-Y(1)-R(2)/6)
|
|
ELSEIF (X.GT.N) THEN
|
|
SPLINE = Y(N) + (X-N)*(Y(N)-Y(N-1)+R(N-1)/6)
|
|
ELSE
|
|
J = IFRAC(X)
|
|
XX = X - J
|
|
SPLINE = Y(J) + XX * ((Y(J+1)-Y(J)-R(J)/3-R(J+1)/6) + XX * (R(J)/2 + XX * (R(J+1)-R(J))/6))
|
|
ENDIF
|
|
END FUNCTION SPLINE
|
|
|
|
|
|
|
|
function interp2DSpline(order,nx,ny,z,x,y)
|
|
|
|
implicit none
|
|
|
|
integer :: order
|
|
integer :: nx,ny
|
|
real*4, dimension(ny,nx) :: z
|
|
double precision :: x, y
|
|
real*4:: interp2DSpline
|
|
double precision :: SPLINE
|
|
|
|
integer :: MINORDER, MAXORDER
|
|
parameter(MINORDER=3, MAXORDER=20)
|
|
double precision, dimension(MAXORDER) :: A, R, Q, HC
|
|
integer :: I,J,I0, J0, II, JJ,INDI,INDJ
|
|
double precision :: temp,inx,iny
|
|
|
|
LOGICAL LODD
|
|
|
|
if ((order.lt.MINORDER).or.(order.gt.MAXORDER)) then
|
|
print *, 'Spline order must be between ', MINORDER, ' and ', MAXORDER
|
|
stop
|
|
endif
|
|
|
|
LODD=(order/2)*2.NE.order
|
|
IF(LODD) THEN
|
|
I0=y-0.5
|
|
J0=x-0.5
|
|
ELSE
|
|
I0=y
|
|
J0=x
|
|
ENDIF
|
|
|
|
I0=I0-order/2+1
|
|
J0=J0-order/2+1
|
|
II=I0+order-1
|
|
JJ=J0+order-1
|
|
|
|
!! print *, 'Y: ', y, I0, II, Z(100,100)
|
|
!! print *, 'X: ', x, J0, JJ, Z(200,200)
|
|
|
|
DO I=1,order
|
|
INDI = min( max(I0+I,1), ny)
|
|
DO J=1,order
|
|
INDJ = min( max(J0+J,1), nx)
|
|
!! print *, 'IND: ', INDI, INDJ, Z(1200,1200), Z(INDI,INDJ)
|
|
A(J)=Z(INDI,INDJ)
|
|
ENDDO
|
|
|
|
!! print *, 'I: ', i, x-J0+1.
|
|
CALL INITSPLINE(A,order,R,Q)
|
|
HC(I) = SPLINE(x-J0,A,order,R)
|
|
ENDDO
|
|
|
|
!! print *, 'J: ', j, y-I0+1.
|
|
CALL INITSPLINE(HC,order,R,Q)
|
|
temp = SPLINE(y-I0,HC,order,R)
|
|
interp2DSpline = sngl(temp)
|
|
RETURN
|
|
END FUNCTION interp2Dspline
|
|
|
|
|