SUBROUTINE HorizontalInterpCubic 1HORCUB1A.3
& (LowerBound, HORCUB1A.4
& Len1In, Len2In, HORCUB1A.5
& Len1Out, Len2Out, HORCUB1A.6
& DataExt, HORCUB1A.7
& WtLambda, HORCUB1A.8
& WtPhi, HORCUB1A.9
& IOut, HORCUB1A.10
& JOut, HORCUB1A.11
& DataOut) HORCUB1A.12
HORCUB1A.13
! Description: Performs cubic Lagrange interpolation of a 2-d field to a HORCUB1A.14
! 2-d set of points defined by IOut, JOut, and WtLambda, HORCUB1A.15
! WtPhi. HORCUB1A.16
! HORCUB1A.17
! Method: This is a modified version of the routine cubic_lagrange HORCUB1A.18
! written by Mark Mawson and described in: HORCUB1A.19
! HORCUB1A.20
! The proposed semi-Lagrangian advection scheme for the HORCUB1A.21
! semi-Implicit Unified Model integration scheme. HORCUB1A.22
! F.R. Division working paper No 162. HORCUB1A.23
! Mark H. Mawson HORCUB1A.24
! HORCUB1A.25
! Owner: Stuart Bell HORCUB1A.26
! HORCUB1A.27
! History: HORCUB1A.28
! Version Date Comment HORCUB1A.29
! ------- ---- ------- HORCUB1A.30
! 4.0 6/6/95 Equiv. to VAR code as at time of build:Stuart Bell HORCUB1A.31
! HORCUB1A.32
! Code Description: HORCUB1A.33
! Language: Fortran 77 plus HORCUB1A.34
! Software Standards: "UM and Met O standards". HORCUB1A.35
! HORCUB1A.36
! HORCUB1A.37
! Declarations: HORCUB1A.38
HORCUB1A.39
IMPLICIT NONE HORCUB1A.40
HORCUB1A.41
!* Subroutine arguments HORCUB1A.42
! Scalar arguments with INTENT(in): HORCUB1A.43
INTEGER LowerBound ! lower bounds of DataExt HORCUB1A.44
INTEGER Len1In ! Dimension of DataIn in i direction. HORCUB1A.45
INTEGER Len2In ! Dimension of DataIn in j direction. HORCUB1A.46
INTEGER Len1Out ! Dimension of DataOut in i direction. HORCUB1A.47
INTEGER Len2Out ! Dimension of DataOut in j direction. HORCUB1A.48
HORCUB1A.49
! Array arguments with INTENT(in): HORCUB1A.50
INTEGER IOut (Len1Out,Len2Out) ! Point such that HORCUB1A.51
INTEGER JOut (Len1Out,Len2Out) ! the desired output point HORCUB1A.52
! ! lies between it and it+1. HORCUB1A.53
REAL DataExt(LowerBound:Len1In+1-LowerBound, HORCUB1A.54
& LowerBound:Len2In+1-LowerBound) ! Data interpolated HORCUB1A.55
REAL WtLambda (Len1Out,Len2Out) ! A number between 0 & 1. HORCUB1A.56
REAL WtPhi (Len1Out,Len2Out) ! A number between 0 & 1. HORCUB1A.57
HORCUB1A.58
! Array arguments with INTENT(out): HORCUB1A.59
REAL DataOut (Len1Out,Len2Out) ! Data interpolated to HORCUB1A.60
! ! desired locations. HORCUB1A.61
!* End of Subroutine arguments HORCUB1A.62
HORCUB1A.63
! Local scalars: HORCUB1A.64
INTEGER i !} Loop HORCUB1A.65
INTEGER j !} indices. HORCUB1A.66
HORCUB1A.67
REAL Recip6 !} Useful local scalars. HORCUB1A.68
REAL ZIminus !} HORCUB1A.69
REAL ZI !} HORCUB1A.70
REAL ZIplus !} HORCUB1A.71
REAL ZIplus2 !} HORCUB1A.72
REAL phi_3 !} HORCUB1A.73
REAL phi_2 !} HORCUB1A.74
REAL phi !} HORCUB1A.75
REAL lambda_3 !} HORCUB1A.76
REAL lambda_2 !} HORCUB1A.77
REAL lambda !} HORCUB1A.78
REAL Coeffminus !} HORCUB1A.79
REAL Coeffzero !} HORCUB1A.80
REAL Coeffplus !} HORCUB1A.81
REAL Coeffplus2 !} HORCUB1A.82
REAL CoeffLminus !} HORCUB1A.83
REAL CoeffLzero !} HORCUB1A.84
REAL CoeffLplus !} HORCUB1A.85
REAL CoeffLplus2 !} HORCUB1A.86
HORCUB1A.87
!- End of header ------------------------------------------------------- HORCUB1A.88
HORCUB1A.89
!----------------------------------------------------------------------- HORCUB1A.90
! 1.0 Set up useful scalar and loop over position. HORCUB1A.91
!----------------------------------------------------------------------- HORCUB1A.92
HORCUB1A.93
Recip6 = 1.0 / 6.0 HORCUB1A.94
HORCUB1A.95
DO j = 1, Len2Out HORCUB1A.96
DO i = 1, Len1Out HORCUB1A.97
HORCUB1A.98
! ---------------------------------------------------------------------- HORCUB1A.99
! 2.0 Perform cubic interpolation in j direction. HORCUB1A.100
! ---------------------------------------------------------------------- HORCUB1A.101
HORCUB1A.102
phi = WtPhi (i,j) HORCUB1A.103
phi_2 = phi * phi HORCUB1A.104
phi_3 = phi * phi_2 HORCUB1A.105
HORCUB1A.106
Coeffplus2 = Recip6 * ( phi_3 - phi ) HORCUB1A.107
HORCUB1A.108
Coeffplus = 0.5 * ( phi_3 - phi_2 - 2.0*phi ) HORCUB1A.109
HORCUB1A.110
Coeffzero = 0.5 * ( phi_3 - 2.0*phi_2 - phi + 2.0 ) HORCUB1A.111
HORCUB1A.112
Coeffminus = Recip6 * ( phi_3 - 3.0*phi_2 + 2.0*phi ) HORCUB1A.113
HORCUB1A.114
ZIminus = Coeffplus2 * DataExt (IOut(i,j) - 1, JOut(i,j) + 2) HORCUB1A.115
& - Coeffplus * DataExt (IOut(i,j) - 1, JOut(i,j) + 1) HORCUB1A.116
& + Coeffzero * DataExt (IOut(i,j) - 1, JOut(i,j) ) HORCUB1A.117
& - Coeffminus * DataExt (IOut(i,j) - 1, JOut(i,j) - 1) HORCUB1A.118
HORCUB1A.119
ZI = Coeffplus2 * DataExt (IOut(i,j), JOut(i,j) + 2) HORCUB1A.120
& - Coeffplus * DataExt (IOut(i,j), JOut(i,j) + 1) HORCUB1A.121
& + Coeffzero * DataExt (IOut(i,j), JOut(i,j) ) HORCUB1A.122
& - Coeffminus * DataExt (IOut(i,j), JOut(i,j) - 1) HORCUB1A.123
HORCUB1A.124
ZIplus = Coeffplus2 * DataExt (IOut(i,j) + 1, JOut(i,j) + 2) HORCUB1A.125
& - Coeffplus * DataExt (IOut(i,j) + 1, JOut(i,j) + 1) HORCUB1A.126
& + Coeffzero * DataExt (IOut(i,j) + 1, JOut(i,j) ) HORCUB1A.127
& - Coeffminus * DataExt (IOut(i,j) + 1, JOut(i,j) - 1) HORCUB1A.128
HORCUB1A.129
ZIplus2 = Coeffplus2 * DataExt (IOut(i,j) + 2, JOut(i,j) + 2) HORCUB1A.130
& - Coeffplus * DataExt (IOut(i,j) + 2, JOut(i,j) + 1) HORCUB1A.131
& + Coeffzero * DataExt (IOut(i,j) + 2, JOut(i,j) ) HORCUB1A.132
& - Coeffminus * DataExt (IOut(i,j) + 2, JOut(i,j) - 1) HORCUB1A.133
HORCUB1A.134
!----------------------------------------------------------------------- HORCUB1A.135
! 3.0 Interpolate in i direction and calculate final answer. HORCUB1A.136
!----------------------------------------------------------------------- HORCUB1A.137
HORCUB1A.138
lambda = WtLambda (i,j) HORCUB1A.139
lambda_2 = lambda * lambda HORCUB1A.140
lambda_3 = lambda * lambda_2 HORCUB1A.141
HORCUB1A.142
CoeffLplus2 = Recip6 * ( lambda_3 - lambda ) HORCUB1A.143
HORCUB1A.144
CoeffLplus = - 0.5 * ( lambda_3 - lambda_2 - 2.0*lambda ) HORCUB1A.145
HORCUB1A.146
CoeffLzero = 0.5 * ( lambda_3 - 2.0*lambda_2 - lambda + 2.0 ) HORCUB1A.147
HORCUB1A.148
CoeffLminus = - Recip6 *( lambda_3 - 3.0*lambda_2 + 2.0*lambda ) HORCUB1A.149
HORCUB1A.150
DataOut (i,j) = CoeffLplus2 * ZIplus2 HORCUB1A.151
& + CoeffLplus * ZIplus HORCUB1A.152
& + CoeffLzero * ZI HORCUB1A.153
& + CoeffLminus * ZIminus HORCUB1A.154
HORCUB1A.155
HORCUB1A.156
END DO ! Close i loop. HORCUB1A.157
END DO ! Close j loop. HORCUB1A.158
HORCUB1A.159
! End of routine. HORCUB1A.160
RETURN HORCUB1A.161
END HORCUB1A.162
*ENDIF HORCUB1A.163