*IF DEF,C92_1A NEARPT1A.2
C ******************************COPYRIGHT****************************** GTS2F400.6103
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.6104
C GTS2F400.6105
C Use, duplication or disclosure of this code is subject to the GTS2F400.6106
C restrictions as set forth in the contract. GTS2F400.6107
C GTS2F400.6108
C Meteorological Office GTS2F400.6109
C London Road GTS2F400.6110
C BRACKNELL GTS2F400.6111
C Berkshire UK GTS2F400.6112
C RG12 2SZ GTS2F400.6113
C GTS2F400.6114
C If no contract has been raised with this copy of the code, the use, GTS2F400.6115
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.6116
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.6117
C Modelling at the above address. GTS2F400.6118
C ******************************COPYRIGHT****************************** GTS2F400.6119
C GTS2F400.6120
CLL SUBROUTINE NEAR_PT------------------------------------------------- NEARPT1A.3
CLL NEARPT1A.4
CLL Purpose: To produce gather indices which map each point on the NEARPT1A.5
CLL target grid onto the nearest point on the source grid. NEARPT1A.6
CLL This allows interpolation by choosing the value of the NEARPT1A.7
CLL nearest neighbour. The code uses coefficients and gather NEARPT1A.8
CLL indices calculated by subroutine H_INT_CO. NEARPT1A.9
CLL NEARPT1A.10
CLL Written by A. Dickinson NEARPT1A.11
CLL NEARPT1A.12
CLL Model Modification history from model version 3.0: NEARPT1A.13
CLL version date NEARPT1A.14
CLL NEARPT1A.15
CLL Programming standard: NEARPT1A.16
CLL Unified Model Documentation Paper No 3 NEARPT1A.17
CLL Version No 1 15/1/90 NEARPT1A.18
CLL NEARPT1A.19
CLL System component: NEARPT1A.20
CLL NEARPT1A.21
CLL System task: S123 NEARPT1A.22
CLL NEARPT1A.23
CLL Documentation: The interpolation formulae are described in NEARPT1A.24
CLL unified model on-line documentation paper S1. NEARPT1A.25
CLL NEARPT1A.26
CLL ------------------------------------------------------------------- NEARPT1A.27
C*L Arguments:--------------------------------------------------------- NEARPT1A.28
NEARPT1A.29
SUBROUTINE NEAR_PT 2NEARPT1A.30
*(INDEX_B_L,INDEX_B_R,WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L NEARPT1A.31
*,POINTS,POINTS_LAMBDA_SRCE,INDEX_NEAREST) NEARPT1A.32
NEARPT1A.33
IMPLICIT NONE NEARPT1A.34
NEARPT1A.35
INTEGER NEARPT1A.36
* POINTS_LAMBDA_SRCE !IN Number of lambda points on source grid NEARPT1A.37
*,POINTS !IN Total number of points on target grid NEARPT1A.38
*,INDEX_B_L(POINTS) !IN Index of bottom lefthand corner NEARPT1A.39
* ! of source gridbox NEARPT1A.40
*,INDEX_B_R(POINTS) !IN Index of bottom righthand corner NEARPT1A.41
* ! of source gridbox NEARPT1A.42
*,INDEX_NEAREST(POINTS)!OUT Index of nearest source point to NEARPT1A.43
* ! each target point NEARPT1A.44
NEARPT1A.45
REAL NEARPT1A.46
* WEIGHT_T_R(POINTS) !IN Weight applied to value at top right NEARPT1A.47
* ! hand corner of source gridbox NEARPT1A.48
*,WEIGHT_B_L(POINTS) !IN Weight applied to value at bottom left NEARPT1A.49
* ! hand corner of source gridbox NEARPT1A.50
*,WEIGHT_B_R(POINTS) !IN Weight applied to value at bottom right NEARPT1A.51
* ! hand corner of source gridbox NEARPT1A.52
*,WEIGHT_T_L(POINTS) !IN Weight applied to value at top left NEARPT1A.53
* ! hand corner of source gridbox NEARPT1A.54
NEARPT1A.55
C Local arrays:--------------------------------------------------------- NEARPT1A.56
INTEGER NEARPT1A.57
* INDEX_TEMP(POINTS,4) ! Index of 4 sourrounding source points NEARPT1A.58
* ! ordered by distance NEARPT1A.59
NEARPT1A.60
REAL NEARPT1A.61
* MAX_WEIGHT(POINTS,4) ! Linear interpolation weights ordered by NEARPT1A.62
! distance NEARPT1A.63
NEARPT1A.64
C*L External subroutines called:---------------------------------------- NEARPT1A.65
C None NEARPT1A.66
C*---------------------------------------------------------------------- NEARPT1A.67
C Local variables:------------------------------------------------------ NEARPT1A.68
REAL TEMP NEARPT1A.69
INTEGER I,J,K,ITEMP NEARPT1A.70
C ---------------------------------------------------------------------- NEARPT1A.71
NEARPT1A.72
C 1. Accumulate source weights and indices associated with NEARPT1A.73
C each coastal point on target grid. NEARPT1A.74
NEARPT1A.75
DO 100 I=1,POINTS NEARPT1A.76
NEARPT1A.77
MAX_WEIGHT(I,1)=WEIGHT_B_L(I) NEARPT1A.78
MAX_WEIGHT(I,2)=WEIGHT_B_R(I) NEARPT1A.79
MAX_WEIGHT(I,3)=WEIGHT_T_L(I) NEARPT1A.80
MAX_WEIGHT(I,4)=WEIGHT_T_R(I) NEARPT1A.81
INDEX_TEMP(I,1)=INDEX_B_L(I) NEARPT1A.82
INDEX_TEMP(I,2)=INDEX_B_R(I) NEARPT1A.83
INDEX_TEMP(I,3)=INDEX_B_L(I) NEARPT1A.84
* -POINTS_LAMBDA_SRCE NEARPT1A.85
INDEX_TEMP(I,4)=INDEX_B_R(I) NEARPT1A.86
* -POINTS_LAMBDA_SRCE NEARPT1A.87
100 CONTINUE NEARPT1A.88
NEARPT1A.89
C 2. Sort gather indices of the 4 surrounding source NEARPT1A.90
C gridpoints according to distance from target gridpoint; NEARPT1A.91
C arranged so that nearest point comes first in list (ie K=1). NEARPT1A.92
NEARPT1A.93
DO 200 K=1,3 NEARPT1A.94
DO 200 J=K+1,4 NEARPT1A.95
DO 210 I=1,POINTS NEARPT1A.96
IF(MAX_WEIGHT(I,K).LT.MAX_WEIGHT(I,J))THEN NEARPT1A.97
TEMP=MAX_WEIGHT(I,K) NEARPT1A.98
MAX_WEIGHT(I,K)=MAX_WEIGHT(I,J) NEARPT1A.99
MAX_WEIGHT(I,J)=TEMP NEARPT1A.100
ITEMP=INDEX_TEMP(I,K) NEARPT1A.101
INDEX_TEMP(I,K)=INDEX_TEMP(I,J) NEARPT1A.102
INDEX_TEMP(I,J)=ITEMP NEARPT1A.103
ENDIF NEARPT1A.104
210 CONTINUE NEARPT1A.105
200 CONTINUE NEARPT1A.106
NEARPT1A.107
C 3. Assign index of nearest source point to output array NEARPT1A.108
NEARPT1A.109
DO 300 I=1,POINTS NEARPT1A.110
INDEX_NEAREST(I)=INDEX_TEMP(I,1) NEARPT1A.111
300 CONTINUE NEARPT1A.112
NEARPT1A.113
RETURN NEARPT1A.114
END NEARPT1A.115
*ENDIF NEARPT1A.116