SUBROUTINE HorizontalInterpQuintic 1HORQUI1A.3
& (LowerBound, HORQUI1A.4
& Len1In, Len2In, HORQUI1A.5
& Len1Out, Len2Out, HORQUI1A.6
& DataExt, HORQUI1A.7
& WtLambda, HORQUI1A.8
& WtPhi, HORQUI1A.9
& IOut, HORQUI1A.10
& JOut, HORQUI1A.11
& DataOut) HORQUI1A.12
HORQUI1A.13
! Description: Performs quintic Lagrange interpolation of a 2-d field to HORQUI1A.14
! a 2-d set of points defined by IOut, JOut and WtLambda, HORQUI1A.15
! WtPhi. HORQUI1A.16
! HORQUI1A.17
! Method: This is a modified version of the routine quintic_lagrange HORQUI1A.18
! written by Sue Coulter and described in: HORQUI1A.19
! HORQUI1A.20
! The proposed semi-Lagrangian advection scheme for the HORQUI1A.21
! semi-Implicit Unified Model integration scheme. HORQUI1A.22
! F.R. Division working paper No 162. HORQUI1A.23
! Mark H. Mawson HORQUI1A.24
! HORQUI1A.25
! HORQUI1A.26
! Owner: Stuart Bell HORQUI1A.27
! HORQUI1A.28
! History: HORQUI1A.29
! Version Date Comment HORQUI1A.30
! ------- ---- ------- HORQUI1A.31
! 4.0 6/6/95 Equiv. to VAR code as at time of build:Stuart Bell HORQUI1A.32
! HORQUI1A.33
! Code Description: HORQUI1A.34
! Language: Fortran 77 plus HORQUI1A.35
! Software Standards: "UM and Met O standards". HORQUI1A.36
! HORQUI1A.37
! HORQUI1A.38
! Declarations: HORQUI1A.39
HORQUI1A.40
IMPLICIT NONE HORQUI1A.41
HORQUI1A.42
!* Subroutine arguments HORQUI1A.43
! Scalar arguments with INTENT(in): HORQUI1A.44
INTEGER LowerBound ! lower bounds of DataExt HORQUI1A.45
INTEGER Len1In ! Dimension of DataIn in i direction. HORQUI1A.46
INTEGER Len2In ! Dimension of DataIn in j direction. HORQUI1A.47
INTEGER Len1Out ! Dimension of DataOut in i direction. HORQUI1A.48
INTEGER Len2Out ! Dimension of DataOut in j direction. HORQUI1A.49
HORQUI1A.50
! Array arguments with INTENT(in): HORQUI1A.51
INTEGER IOut (Len1Out,Len2Out) ! Point such that HORQUI1A.52
INTEGER JOut (Len1Out,Len2Out) ! the desired output point HORQUI1A.53
! ! lies between it and it+1. HORQUI1A.54
REAL DataExt(LowerBound:Len1In+1-LowerBound, HORQUI1A.55
& LowerBound:Len2In+1-LowerBound) ! Data interpolated HORQUI1A.56
REAL WtLambda (Len1Out,Len2Out) ! A number between 0 & 1. HORQUI1A.57
REAL WtPhi (Len1Out,Len2Out) ! A number between 0 & 1. HORQUI1A.58
HORQUI1A.59
! Array arguments with INTENT(out): HORQUI1A.60
REAL DataOut (Len1Out,Len2Out) ! Data interpolated to HORQUI1A.61
! ! desired locations. HORQUI1A.62
!* End of Subroutine arguments HORQUI1A.63
HORQUI1A.64
! Local scalars: HORQUI1A.65
INTEGER i ! } Loop HORQUI1A.66
INTEGER j ! } indices. HORQUI1A.67
HORQUI1A.68
REAL Recip6 ! } A multitude of useful HORQUI1A.69
REAL Recip12 ! } local scalars... HORQUI1A.70
REAL Recip24 ! } HORQUI1A.71
REAL Recip120 ! } HORQUI1A.72
REAL ZIminus ! } HORQUI1A.73
REAL ZIminus2 ! } HORQUI1A.74
REAL ZI ! } HORQUI1A.75
REAL ZIplus ! } HORQUI1A.76
REAL ZIplus2 ! } HORQUI1A.77
REAL ZIplus3 ! } HORQUI1A.78
REAL phi ! } HORQUI1A.79
REAL phi_3 ! } HORQUI1A.80
REAL phi_2 ! } HORQUI1A.81
REAL phi_4 ! } HORQUI1A.82
REAL phi_5 ! } HORQUI1A.83
REAL lambda_3 ! } HORQUI1A.84
REAL lambda_2 ! } HORQUI1A.85
REAL lambda ! } HORQUI1A.86
REAL lambda_4 ! } HORQUI1A.87
REAL lambda_5 ! } HORQUI1A.88
REAL Coeffminus2 ! } HORQUI1A.89
REAL Coeffminus ! } HORQUI1A.90
REAL Coeffzero ! } HORQUI1A.91
REAL Coeffplus ! } HORQUI1A.92
REAL Coeffplus2 ! } HORQUI1A.93
REAL Coeffplus3 ! } HORQUI1A.94
REAL CoeffLminus2 ! } HORQUI1A.95
REAL CoeffLminus ! } HORQUI1A.96
REAL CoeffLzero ! } HORQUI1A.97
REAL CoeffLplus ! } HORQUI1A.98
REAL CoeffLplus2 ! } HORQUI1A.99
REAL CoeffLplus3 ! } HORQUI1A.100
HORQUI1A.101
!- End of header ------------------------------------------------------- HORQUI1A.102
HORQUI1A.103
!----------------------------------------------------------------------- HORQUI1A.104
! 1.0 Set up some useful scalars. HORQUI1A.105
!----------------------------------------------------------------------- HORQUI1A.106
HORQUI1A.107
Recip6 = 1.0 / 6.0 HORQUI1A.108
Recip12 = 1.0 / 12.0 HORQUI1A.109
Recip24 = 1.0 / 24.0 HORQUI1A.110
Recip120 = 1.0 / 120.0 HORQUI1A.111
HORQUI1A.112
HORQUI1A.113
DO j = 1, Len2Out HORQUI1A.114
DO i = 1, Len1Out HORQUI1A.115
HORQUI1A.116
!----------------------------------------------------------------------- HORQUI1A.117
! 2.0 Perform quintic Lagrange interpolation in j direction HORQUI1A.118
!----------------------------------------------------------------------- HORQUI1A.119
HORQUI1A.120
phi = WtPhi (i,j) HORQUI1A.121
phi_2 = phi * phi HORQUI1A.122
phi_3 = phi_2 * phi HORQUI1A.123
phi_4 = phi_2 * phi_2 HORQUI1A.124
phi_5 = phi_2 * phi_3 HORQUI1A.125
HORQUI1A.126
Coeffplus3 = Recip120 * ( phi_5 - 5.0 * phi_3 + 4.0 * phi ) HORQUI1A.127
HORQUI1A.128
Coeffplus2 = - Recip24 * HORQUI1A.129
& ( phi_5 - phi_4 - 7.0 * phi_3 + phi_2 + 6.0 * phi ) HORQUI1A.130
HORQUI1A.131
Coeffplus = Recip12 * HORQUI1A.132
& ( phi_5 - 2.0 * phi_4 - 7.0 * phi_3 + HORQUI1A.133
& 8.0 * phi_2 + 12.0 * phi ) HORQUI1A.134
HORQUI1A.135
Coeffzero = - Recip12 * HORQUI1A.136
& ( phi_5 - 3.0 * phi_4 - 5.0 * phi_3 + HORQUI1A.137
& 15.0 * phi_2 + 4.0 * phi -12.0 ) HORQUI1A.138
HORQUI1A.139
Coeffminus = Recip24 * HORQUI1A.140
& ( phi_5 - 4.0 * phi_4 - phi_3 + HORQUI1A.141
& 16.0 * phi_2 - 12.0 * phi ) HORQUI1A.142
HORQUI1A.143
Coeffminus2 = - Recip120 * HORQUI1A.144
& ( phi_5 - 5.0 * phi_4 + 5.0 * phi_3 + HORQUI1A.145
& 5.0 * phi_2 - 6.0 * phi ) HORQUI1A.146
HORQUI1A.147
ZIminus2 = Coeffplus3 * HORQUI1A.148
& DataExt (IOut(i,j) - 2, JOut(i,j) + 3) HORQUI1A.149
& + Coeffplus2 * HORQUI1A.150
& DataExt (IOut(i,j) - 2, JOut(i,j) + 2) HORQUI1A.151
& + Coeffplus * HORQUI1A.152
& DataExt (IOut(i,j) - 2, JOut(i,j) + 1) HORQUI1A.153
& + Coeffzero * HORQUI1A.154
& DataExt (IOut(i,j) - 2, JOut(i,j)) HORQUI1A.155
& + Coeffminus * HORQUI1A.156
& DataExt (IOut(i,j) - 2, JOut(i,j) - 1) HORQUI1A.157
& + Coeffminus2 * HORQUI1A.158
& DataExt (IOut(i,j) - 2, JOut(i,j) - 2) HORQUI1A.159
HORQUI1A.160
ZIminus = Coeffplus3 * HORQUI1A.161
& DataExt (IOut(i,j) - 1, JOut(i,j) + 3) HORQUI1A.162
& + Coeffplus2 * HORQUI1A.163
& DataExt (IOut(i,j) - 1, JOut(i,j) + 2) HORQUI1A.164
& + Coeffplus * HORQUI1A.165
& DataExt (IOut(i,j) - 1, JOut(i,j) + 1) HORQUI1A.166
& + Coeffzero * HORQUI1A.167
& DataExt (IOut(i,j) - 1, JOut(i,j)) HORQUI1A.168
& + Coeffminus * HORQUI1A.169
& DataExt (IOut(i,j) - 1, JOut(i,j) - 1) HORQUI1A.170
& + Coeffminus2 * HORQUI1A.171
& DataExt (IOut(i,j) - 1,JOut(i,j) - 2) HORQUI1A.172
HORQUI1A.173
ZI = Coeffplus3 * HORQUI1A.174
& DataExt (IOut(i,j), JOut(i,j) + 3) HORQUI1A.175
& + Coeffplus2 * HORQUI1A.176
& DataExt (IOut(i,j), JOut(i,j) + 2) HORQUI1A.177
& + Coeffplus * HORQUI1A.178
& DataExt (IOut(i,j), JOut(i,j) + 1) HORQUI1A.179
& + Coeffzero * HORQUI1A.180
& DataExt (IOut(i,j), JOut(i,j)) HORQUI1A.181
& + Coeffminus * HORQUI1A.182
& DataExt (IOut(i,j), JOut(i,j) - 1) HORQUI1A.183
& + Coeffminus2 * HORQUI1A.184
& DataExt (IOut(i,j), JOut(i,j) - 2) HORQUI1A.185
HORQUI1A.186
ZIplus = Coeffplus3 * HORQUI1A.187
& DataExt (IOut(i,j) + 1, JOut(i,j) + 3) HORQUI1A.188
& + Coeffplus2 * HORQUI1A.189
& DataExt (IOut(i,j) + 1, JOut(i,j) + 2) HORQUI1A.190
& + Coeffplus * HORQUI1A.191
& DataExt (IOut(i,j) + 1, JOut(i,j) + 1) HORQUI1A.192
& + Coeffzero * HORQUI1A.193
& DataExt (IOut(i,j) + 1, JOut(i,j)) HORQUI1A.194
& + Coeffminus * HORQUI1A.195
& DataExt (IOut(i,j) + 1, JOut(i,j) - 1) HORQUI1A.196
& + Coeffminus2 * HORQUI1A.197
& DataExt (IOut(i,j) + 1, JOut(i,j) - 2) HORQUI1A.198
HORQUI1A.199
ZIplus2 = Coeffplus3 * HORQUI1A.200
& DataExt (IOut(i,j) + 2, JOut(i,j) + 3) HORQUI1A.201
& + Coeffplus2 * HORQUI1A.202
& DataExt (IOut(i,j) + 2, JOut(i,j) + 2) HORQUI1A.203
& + Coeffplus * HORQUI1A.204
& DataExt (IOut(i,j) + 2, JOut(i,j) + 1) HORQUI1A.205
& + Coeffzero * HORQUI1A.206
& DataExt (IOut(i,j) + 2,JOut(i,j)) HORQUI1A.207
& + Coeffminus * HORQUI1A.208
& DataExt (IOut(i,j) + 2, JOut(i,j) - 1) HORQUI1A.209
& + Coeffminus2 * HORQUI1A.210
& DataExt (IOut(i,j) + 2,JOut(i,j) - 2) HORQUI1A.211
HORQUI1A.212
HORQUI1A.213
ZIplus3 = Coeffplus3 * HORQUI1A.214
& DataExt (IOut(i,j) + 3, JOut(i,j) + 3) HORQUI1A.215
& + Coeffplus2 * HORQUI1A.216
& DataExt (IOut(i,j) + 3, JOut(i,j) + 2) HORQUI1A.217
& + Coeffplus * HORQUI1A.218
& DataExt (IOut(i,j) + 3, JOut(i,j) + 1) HORQUI1A.219
& + Coeffzero * HORQUI1A.220
& DataExt (IOut(i,j) + 3, JOut(i,j)) HORQUI1A.221
& + Coeffminus * HORQUI1A.222
& DataExt (IOut(i,j) + 3, JOut(i,j) - 1) HORQUI1A.223
& + Coeffminus2 * HORQUI1A.224
& DataExt (IOut(i,j) + 3, JOut(i,j) - 2) HORQUI1A.225
HORQUI1A.226
!----------------------------------------------------------------------- HORQUI1A.227
! 3.0 Interpolate in i direction and calculate final answer. HORQUI1A.228
!----------------------------------------------------------------------- HORQUI1A.229
HORQUI1A.230
lambda = WtLambda (i,j) HORQUI1A.231
lambda_2 = lambda * lambda HORQUI1A.232
lambda_3 = lambda_2 * lambda HORQUI1A.233
lambda_4 = lambda_2 * lambda_2 HORQUI1A.234
lambda_5 = lambda_2 * lambda_3 HORQUI1A.235
HORQUI1A.236
CoeffLplus3 = Recip120 * HORQUI1A.237
& ( lambda_5 - 5.0 * lambda_3 + 4.0 * lambda ) HORQUI1A.238
HORQUI1A.239
CoeffLplus2 = - Recip24 * HORQUI1A.240
& ( lambda_5 - lambda_4 - 7.0 * lambda_3 + HORQUI1A.241
& lambda_2 + 6.0 * lambda ) HORQUI1A.242
HORQUI1A.243
CoeffLplus = Recip12 * HORQUI1A.244
& ( lambda_5 - 2.0 * lambda_4 - 7.0 * lambda_3 + HORQUI1A.245
& 8.0 * lambda_2 + 12.0 * lambda ) HORQUI1A.246
HORQUI1A.247
CoeffLzero = - Recip12 * HORQUI1A.248
& ( lambda_5 - 3.0 * lambda_4 - 5.0 * lambda_3 + HORQUI1A.249
& 15.0 * lambda_2 + 4.0 * lambda - 12.0 ) HORQUI1A.250
HORQUI1A.251
CoeffLminus = Recip24 * HORQUI1A.252
& ( lambda_5 - 4.0 * lambda_4 - lambda_3 + HORQUI1A.253
& 16.0 * lambda_2 - 12.0 * lambda ) HORQUI1A.254
HORQUI1A.255
CoeffLminus2 = - Recip120 * HORQUI1A.256
& ( lambda_5 - 5.0 * lambda_4 + 5.0 * lambda_3 + HORQUI1A.257
& 5.0 *lambda_2 - 6.0 * lambda ) HORQUI1A.258
HORQUI1A.259
HORQUI1A.260
DataOut (i,j) = CoeffLplus3 * ZIplus3 HORQUI1A.261
& + CoeffLplus2 * ZIplus2 HORQUI1A.262
& + CoeffLplus * ZIplus HORQUI1A.263
& + CoeffLzero * ZI HORQUI1A.264
& + CoeffLminus * ZIminus HORQUI1A.265
& + CoeffLminus2 * ZIminus2 HORQUI1A.266
HORQUI1A.267
END DO ! Close i loop. HORQUI1A.268
END DO ! Close j loop. HORQUI1A.269
HORQUI1A.270
HORQUI1A.271
! End of routine. HORQUI1A.272
RETURN HORQUI1A.273
END HORQUI1A.274
*ENDIF HORQUI1A.275