*IF DEF,C92_1A COASAJ1A.2
C ******************************COPYRIGHT****************************** GTS2F400.1009
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1010
C GTS2F400.1011
C Use, duplication or disclosure of this code is subject to the GTS2F400.1012
C restrictions as set forth in the contract. GTS2F400.1013
C GTS2F400.1014
C Meteorological Office GTS2F400.1015
C London Road GTS2F400.1016
C BRACKNELL GTS2F400.1017
C Berkshire UK GTS2F400.1018
C RG12 2SZ GTS2F400.1019
C GTS2F400.1020
C If no contract has been raised with this copy of the code, the use, GTS2F400.1021
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1022
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1023
C Modelling at the above address. GTS2F400.1024
C ******************************COPYRIGHT****************************** GTS2F400.1025
C GTS2F400.1026
CLL SUBROUTINE COAST_AJ----------------------------------------------- COASAJ1A.3
CLL COASAJ1A.4
CLL Written by A. Dickinson COASAJ1A.5
CLL COASAJ1A.6
CLL Purpose: COASAJ1A.7
CLL (i) To produce gather indices which map each coastal point COASAJ1A.8
CLL on the target grid onto its nearest point on the source COASAJ1A.9
CLL grid. This allows correction of those surface fields COASAJ1A.10
CLL which are non-homogeneous across land/sea boundaries COASAJ1A.11
CLL after horizontal interpolation by subroutine H_INT. COASAJ1A.12
CLL The algorithm uses linear interpolation weights and COASAJ1A.13
CLL gather indices calculated by subroutine H_INT_CO. COASAJ1A.14
CLL COASAJ1A.15
CLL (ii) If a land-sea mask for the target grid is not provided, COASAJ1A.16
CLL one is created. When a target land/sea mask is provided, COASAJ1A.17
CLL further index is output containing those points on the COASAJ1A.18
CLL target grid for which the 4 surrounding source points COASAJ1A.19
CLL are not of the same land/sea type as the target point. COASAJ1A.20
CLL These points will generally be new islands etc resolved b COASAJ1A.21
CLL a hires land/sea mask. They should be set to appropriate COASAJ1A.22
CLL values (eg climatology) as required. COASAJ1A.23
CLL COASAJ1A.24
CLL Model Modification history from model version 3.0: COASAJ1A.25
CLL version Date COASAJ1A.26
CLL AD100293.6
CLL 3.1 10/02/93 Bug removed in initialisation of variables AD100293.7
CLL Author: A. Dickinson Reviewer: F. Rawlins AD100293.8
CLL 3.4 25/10/93 Output arguments INDEX_TARG_SEA_UNRES and UDG1F304.1
CLL INDEX_TARG_LAND_UNRES declared as arrays. UDG1F304.2
CLL Although previously declared as scalars, no UDG1F304.3
CLL detremental effects were observed from the error. UDG1F304.4
CLL Author: D.M.Goddard Reviewer: UDG1F304.5
CLL COASAJ1A.27
CLL Programming standard: Unified Model Documentation Paper No 3 COASAJ1A.28
CLL Version No 1 15/1/90 COASAJ1A.29
CLL COASAJ1A.30
CLL Logical component number: S122 COASAJ1A.31
CLL COASAJ1A.32
CLL Project task: S1 COASAJ1A.33
CLL COASAJ1A.34
CLL Documentation: The interpolation formulae are described in COASAJ1A.35
CLL unified model on-line documentation paper S1. COASAJ1A.36
CLL COASAJ1A.37
CLL ------------------------------------------------------------------ COASAJ1A.38
C COASAJ1A.39
C*L Arguments:--------------------------------------------------------- COASAJ1A.40
COASAJ1A.41
SUBROUTINE COAST_AJ 6COASAJ1A.42
*(INDEX_B_L,INDEX_B_R,WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L COASAJ1A.43
*,POINTS_LAMBDA_SRCE,POINTS_PHI_SRCE,POINTS,LAND_SEA_SRCE COASAJ1A.44
*,LAND_SEA_TARG,INDEX_TARG,INDEX_SRCE,COASTAL_POINTS,MASK COASAJ1A.45
*,INDEX_TARG_SEA_UNRES,SEA_POINTS_UNRES COASAJ1A.46
*,INDEX_TARG_LAND_UNRES,LAND_POINTS_UNRES) COASAJ1A.47
COASAJ1A.48
IMPLICIT NONE COASAJ1A.49
COASAJ1A.50
INTEGER COASAJ1A.51
* POINTS_LAMBDA_SRCE !IN Number of lambda points on source grid COASAJ1A.52
*,POINTS_PHI_SRCE !IN Number of phi points on source grid COASAJ1A.53
*,POINTS !IN Total number of points on target grid COASAJ1A.54
*,COASTAL_POINTS !OUT Number of coastal points on target grid COASAJ1A.55
*,LAND_POINTS_UNRES !OUT No of unresolved land pts when MASK=T COASAJ1A.56
*,SEA_POINTS_UNRES !OUT No of unresolved sea pts when MASK=T COASAJ1A.57
*,INDEX_B_L(POINTS) !IN Index of bottom lefthand corner COASAJ1A.58
* ! of source gridbox COASAJ1A.59
*,INDEX_B_R(POINTS) !IN Index of bottom righthand corner COASAJ1A.60
* ! of source gridbox COASAJ1A.61
*,LAND_SEA_TARG(POINTS)!INOUT Land/sea mask on target grid. If MASK COASAJ1A.62
* !then precalculated land/sea mask on input. COASAJ1A.63
*,LAND_SEA_SRCE(POINTS_LAMBDA_SRCE*POINTS_PHI_SRCE) COASAJ1A.64
* !IN Land/sea mask on source grid COASAJ1A.65
COASAJ1A.66
INTEGER COASAJ1A.67
* INDEX_TARG(POINTS) !OUT Index of target coastal points COASAJ1A.68
*,INDEX_SRCE(POINTS) !OUT Index of source points mapped onto COASAJ1A.69
* !target coastal points COASAJ1A.70
*,INDEX_TARG_SEA_UNRES(POINTS) UDG1F304.6
* !OUT Index of sea pts on target grid which a UDG1F304.7
* !unresolved when MASK=T COASAJ1A.72
*,INDEX_TARG_LAND_UNRES(POINTS) UDG1F304.8
* !OUT Index of land pts on target grid which UDG1F304.9
* !unresolved when MASK=T COASAJ1A.74
COASAJ1A.75
REAL COASAJ1A.76
* WEIGHT_T_R(POINTS) !IN Weight applied to value at top right COASAJ1A.77
* ! hand corner of source gridbox COASAJ1A.78
*,WEIGHT_B_L(POINTS) !IN Weight applied to value at bottom left COASAJ1A.79
* ! hand corner of source gridbox COASAJ1A.80
*,WEIGHT_B_R(POINTS) !IN Weight applied to value at bottom right COASAJ1A.81
* ! hand corner of source gridbox COASAJ1A.82
*,WEIGHT_T_L(POINTS) !IN Weight applied to value at top left COASAJ1A.83
* ! hand corner of source gridbox COASAJ1A.84
COASAJ1A.85
LOGICAL COASAJ1A.86
* MASK !IN =F, then land/sea mask estimated COASAJ1A.87
* ! =T, then land/sea mask input as LAND_SEA_TARG COASAJ1A.88
COASAJ1A.89
C Local arrays:--------------------------------------------------------- COASAJ1A.90
INTEGER COASAJ1A.91
* LAND_SEA_TEMP(POINTS) ! Array used to accumulate output land/sea COASAJ1A.92
*,INDEX_TEMP(POINTS,4) ! Index of 4 sourrounding source points COASAJ1A.93
* ! order by distance COASAJ1A.94
*,LAND_SEA_COAST(POINTS) ! Mask of coastal points on target grid COASAJ1A.95
COASAJ1A.96
REAL COASAJ1A.97
* MAX_WEIGHT(POINTS,4) ! Linear interpolation weights ordered by COASAJ1A.98
COASAJ1A.99
LOGICAL COASAJ1A.100
* LOGIC_TEST(POINTS) ! Logical string used to accumulate tests COASAJ1A.101
COASAJ1A.102
C*L External subroutines called:---------------------------------------- COASAJ1A.103
C*---------------------------------------------------------------------- COASAJ1A.105
C Local variables:------------------------------------------------------ COASAJ1A.106
REAL TEMP COASAJ1A.107
INTEGER I,J,K,START,ITEMP COASAJ1A.108
C ---------------------------------------------------------------------- COASAJ1A.109
COASAJ1A.110
CL 1. Sum of land/sea mask values on source grid surrounding each point COASAJ1A.111
CL on target grid. This assumes that the mask is integer 1's and 0's. COASAJ1A.112
COASAJ1A.113
DO 100 I=1,POINTS COASAJ1A.114
COASAJ1A.115
LAND_SEA_TEMP(I)=LAND_SEA_SRCE(INDEX_B_L(I)) COASAJ1A.116
* +LAND_SEA_SRCE(INDEX_B_R(I)) COASAJ1A.117
* +LAND_SEA_SRCE(INDEX_B_L(I)-POINTS_LAMBDA_SRCE) COASAJ1A.118
* +LAND_SEA_SRCE(INDEX_B_R(I)-POINTS_LAMBDA_SRCE) COASAJ1A.119
COASAJ1A.120
100 CONTINUE COASAJ1A.121
COASAJ1A.122
CL 2. Generate coastal gather indices and new land/sea mask COASAJ1A.123
COASAJ1A.124
C 2.1 Gather index for coastal points on target grid COASAJ1A.125
COASAJ1A.126
DO 210 I=1,POINTS COASAJ1A.127
LOGIC_TEST(I)=LAND_SEA_TEMP(I).GT.0.AND.LAND_SEA_TEMP(I).LT.4 COASAJ1A.128
210 CONTINUE COASAJ1A.129
COASAJ1A.130
COASTAL_POINTS = 0 GSS5F402.400
DO I=1,POINTS GSS5F402.401
IF(LOGIC_TEST(I))THEN GSS5F402.402
COASTAL_POINTS=COASTAL_POINTS + 1 GSS5F402.403
INDEX_TARG(COASTAL_POINTS) = I GSS5F402.404
END IF GSS5F402.405
END DO GSS5F402.406
COASAJ1A.133
COASAJ1A.134
C Set target land-sea mask to land if all 4 surrounding COASAJ1A.135
C source points are also land. COASAJ1A.136
COASAJ1A.137
DO 211 I=1,POINTS COASAJ1A.138
IF(LAND_SEA_TEMP(I).EQ.4)LAND_SEA_TEMP(I)=1 COASAJ1A.139
211 CONTINUE COASAJ1A.140
COASAJ1A.141
COASAJ1A.142
C 2.2 Gather index for points which differ between input COASAJ1A.143
C land/sea mask and first estimate and are not first COASAJ1A.144
C estimate coastal points. COASAJ1A.145
COASAJ1A.146
IF(MASK)THEN COASAJ1A.147
J=COASTAL_POINTS COASAJ1A.148
COASAJ1A.149
DO 220 I=1,POINTS COASAJ1A.150
LAND_SEA_COAST(I)=0 COASAJ1A.151
220 CONTINUE COASAJ1A.152
DO 221 I=1,COASTAL_POINTS COASAJ1A.153
LAND_SEA_COAST(INDEX_TARG(I))=1 COASAJ1A.154
221 CONTINUE COASAJ1A.155
COASAJ1A.156
DO 222 I=1,POINTS COASAJ1A.157
LOGIC_TEST(I)=LAND_SEA_TEMP(I).NE.LAND_SEA_TARG(I) COASAJ1A.158
*.AND.LAND_SEA_COAST(I).EQ.0 COASAJ1A.159
222 CONTINUE COASAJ1A.160
COASAJ1A.161
START=COASTAL_POINTS GSS5F402.407
COASTAL_POINTS = 0 GSS5F402.408
DO I=1,POINTS GSS5F402.409
IF(LOGIC_TEST(I))THEN GSS5F402.410
COASTAL_POINTS=COASTAL_POINTS + 1 GSS5F402.411
INDEX_TARG(START+COASTAL_POINTS) = I GSS5F402.412
END IF GSS5F402.413
END DO GSS5F402.414
COASTAL_POINTS=COASTAL_POINTS+J COASAJ1A.165
COASAJ1A.166
ENDIF COASAJ1A.167
COASAJ1A.168
C 2.3 Accumulate source weights and indices associated with COASAJ1A.169
C each coastal point on target grid. COASAJ1A.170
COASAJ1A.171
DO 230 I=1,COASTAL_POINTS COASAJ1A.172
COASAJ1A.173
MAX_WEIGHT(I,1)=WEIGHT_B_L(INDEX_TARG(I)) COASAJ1A.174
MAX_WEIGHT(I,2)=WEIGHT_B_R(INDEX_TARG(I)) COASAJ1A.175
MAX_WEIGHT(I,3)=WEIGHT_T_L(INDEX_TARG(I)) COASAJ1A.176
MAX_WEIGHT(I,4)=WEIGHT_T_R(INDEX_TARG(I)) COASAJ1A.177
INDEX_TEMP(I,1)=INDEX_B_L(INDEX_TARG(I)) COASAJ1A.178
INDEX_TEMP(I,2)=INDEX_B_R(INDEX_TARG(I)) COASAJ1A.179
INDEX_TEMP(I,3)=INDEX_B_L(INDEX_TARG(I)) COASAJ1A.180
* -POINTS_LAMBDA_SRCE COASAJ1A.181
INDEX_TEMP(I,4)=INDEX_B_R(INDEX_TARG(I)) COASAJ1A.182
* -POINTS_LAMBDA_SRCE COASAJ1A.183
230 CONTINUE COASAJ1A.184
COASAJ1A.185
C 2.4 Sort gather indices of the 4 surrounding source COASAJ1A.186
C gridpoints according to distance from target gridpoint; COASAJ1A.187
C arranged so that nearest point comes first in list (ie K=1). COASAJ1A.188
COASAJ1A.189
DO 240 K=1,3 COASAJ1A.190
DO 240 J=K+1,4 COASAJ1A.191
DO 241 I=1,COASTAL_POINTS COASAJ1A.192
IF(MAX_WEIGHT(I,K).LT.MAX_WEIGHT(I,J))THEN COASAJ1A.193
TEMP=MAX_WEIGHT(I,K) COASAJ1A.194
MAX_WEIGHT(I,K)=MAX_WEIGHT(I,J) COASAJ1A.195
MAX_WEIGHT(I,J)=TEMP COASAJ1A.196
ITEMP=INDEX_TEMP(I,K) COASAJ1A.197
INDEX_TEMP(I,K)=INDEX_TEMP(I,J) COASAJ1A.198
INDEX_TEMP(I,J)=ITEMP COASAJ1A.199
ENDIF COASAJ1A.200
241 CONTINUE COASAJ1A.201
240 CONTINUE COASAJ1A.202
COASAJ1A.203
COASAJ1A.204
C 2.5 Initialise source gather index as nearest point on source grid COASAJ1A.205
C to target coastal point. COASAJ1A.206
DO 250 I=1,COASTAL_POINTS COASAJ1A.207
INDEX_SRCE(I)=INDEX_TEMP(I,1) COASAJ1A.208
250 CONTINUE COASAJ1A.209
COASAJ1A.210
C 2.6 Select source gather index as nearest point of same land/sea type COASAJ1A.211
C when a land/sea mask has been input on target grid COASAJ1A.212
IF(MASK) THEN COASAJ1A.213
COASAJ1A.214
DO 260 K=4,1,-1 COASAJ1A.215
DO 261 I=1,COASTAL_POINTS COASAJ1A.216
IF(LAND_SEA_TARG(INDEX_TARG(I)).EQ.LAND_SEA_SRCE(INDEX_TEMP(I,K))) COASAJ1A.217
* INDEX_SRCE(I)=INDEX_TEMP(I,K) COASAJ1A.218
261 CONTINUE COASAJ1A.219
260 CONTINUE COASAJ1A.220
COASAJ1A.221
ENDIF COASAJ1A.222
COASAJ1A.223
C 2.7 Update coastal values of land-sea mask COASAJ1A.224
COASAJ1A.225
DO 270 I=1,COASTAL_POINTS COASAJ1A.226
LAND_SEA_TEMP(INDEX_TARG(I))=LAND_SEA_SRCE(INDEX_SRCE(I)) COASAJ1A.227
270 CONTINUE COASAJ1A.228
COASAJ1A.229
COASAJ1A.230
C 2.8 Overwrite target land/sea mask with estimate or output COASAJ1A.231
C indices of target land/sea points for which none of 4 surrounding COASAJ1A.232
C source points are of same type. COASAJ1A.233
COASAJ1A.234
IF(.NOT.MASK)THEN COASAJ1A.235
DO 280 I=1,POINTS COASAJ1A.236
LAND_SEA_TARG(I)=LAND_SEA_TEMP(I) COASAJ1A.237
280 CONTINUE COASAJ1A.238
LAND_POINTS_UNRES=0 AD100293.9
SEA_POINTS_UNRES=0 AD100293.10
COASAJ1A.239
ELSE COASAJ1A.240
COASAJ1A.241
DO 281 I=1,POINTS COASAJ1A.242
LOGIC_TEST(I)=LAND_SEA_TARG(I).EQ.0.AND. COASAJ1A.243
* (LAND_SEA_TEMP(I).NE.LAND_SEA_TARG(I)) COASAJ1A.244
281 CONTINUE COASAJ1A.245
COASAJ1A.246
SEA_POINTS_UNRES = 0 GSS5F402.415
DO I=1,POINTS GSS5F402.416
IF(LOGIC_TEST(I))THEN GSS5F402.417
SEA_POINTS_UNRES=SEA_POINTS_UNRES + 1 GSS5F402.418
INDEX_TARG_SEA_UNRES(SEA_POINTS_UNRES) = I GSS5F402.419
END IF GSS5F402.420
END DO GSS5F402.421
COASAJ1A.249
DO 282 I=1,POINTS COASAJ1A.250
LOGIC_TEST(I)=LAND_SEA_TARG(I).EQ.1.AND. COASAJ1A.251
* (LAND_SEA_TEMP(I).NE.LAND_SEA_TARG(I)) COASAJ1A.252
282 CONTINUE COASAJ1A.253
COASAJ1A.254
LAND_POINTS_UNRES = 0 GSS5F402.422
DO I=1,POINTS GSS5F402.423
IF(LOGIC_TEST(I))THEN GSS5F402.424
LAND_POINTS_UNRES=LAND_POINTS_UNRES + 1 GSS5F402.425
INDEX_TARG_LAND_UNRES(LAND_POINTS_UNRES) = I GSS5F402.426
END IF GSS5F402.427
END DO GSS5F402.428
COASAJ1A.257
ENDIF COASAJ1A.258
COASAJ1A.259
RETURN COASAJ1A.260
END COASAJ1A.261
*ENDIF COASAJ1A.262