SUBROUTINE H_INT_INIT_BL(ICOF,IDIM 1,18HINTIBL1.4
&, P_FIELD_OUT,P_ROWS_IN,P_ROWS_OUT HINTIBL1.5
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTIBL1.6
&, U_FIELD_IN,U_FIELD_OUT HINTIBL1.7
&, U_ROWS_IN,U_ROWS_OUT,GRIB HINTIBL1.8
&, FIXHD_IN,FIXHD_OUT,REALHD_IN,REALHD_OUT HINTIBL1.9
&, INDEX_B_L,INDEX_B_R,INDEX_NEAREST HINTIBL1.10
&, COEFF1,COEFF2,COEFF3,COEFF4 HINTIBL1.11
&, WEIGHT_T_R,WEIGHT_B_R HINTIBL1.12
&, WEIGHT_T_L,WEIGHT_B_L) HINTIBL1.13
! HINTIBL1.14
! Subroutine Interface: HINTIBL1.15
HINTIBL1.16
IMPLICIT NONE HINTIBL1.17
! HINTIBL1.18
! Description: HINTIBL1.19
! Initialises arrays used in horizontal interpolation. HINTIBL1.20
! This replaces routine SETWTS1 (A Dickinson) whose function it HINTIBL1.21
! incorporates. HINTIBL1.22
! HINTIBL1.23
! Method: HINTIBL1.24
! Sets up gather index and weight arrays for later call to H_INT_BL h HINTIBL1.25
! Also sets up rotation coefficients for use in ROTATE with rotated HINTIBL1.26
! grids. HINTIBL1.27
! HINTIBL1.28
! Current Code Owner: D.M. Goddard HINTIBL1.29
! HINTIBL1.30
! History: HINTIBL1.31
! Version Date Comment HINTIBL1.32
! ------- ---- ------- HINTIBL1.33
! vn4.4 9/4/97 Reset the number of of lat points for UIE2F404.73
! v wind on C grid. Ian Edmond UIE2F404.74
! 4.0 12/04/95 Original code. D.M. Goddard HINTIBL1.34
! 4.5 10/11/98 Only set LAMBDA_IN and LAMBDA_OUT for one UDG6F405.25
! element when dealing with zonal means. UDG6F405.26
! Prevents out of bounds if there are more UDG6F405.27
! columns than rows. UDG6F405.28
! Author D.M. Goddard. UDG6F405.29
! HINTIBL1.35
! Code Description: HINTIBL1.36
! Language: FORTRAN 77 + common extensions. HINTIBL1.37
! This code is written to UMDP3 v7 programming standards. HINTIBL1.38
! HINTIBL1.39
! System component covered: S121 HINTIBL1.40
! System Task: S1 HINTIBL1.41
! HINTIBL1.42
! Declarations: HINTIBL1.43
! These are of the form:- HINTIBL1.44
! INTEGER ExampleVariable !Description of variable HINTIBL1.45
! HINTIBL1.46
! Global variables (*CALLed COMDECKs etc...): HINTIBL1.47
*CALL CPHINT 
HINTIBL1.48
HINTIBL1.49
! Subroutine arguments HINTIBL1.50
! Scalar arguments with intent(in): HINTIBL1.51
INTEGER ICOF !Second dimension of coefficents ary HINTIBL1.52
INTEGER IDIM !Second dimension of index arrays HINTIBL1.53
INTEGER P_FIELD_OUT !No of P pts on target grid HINTIBL1.54
INTEGER P_ROWS_IN !No of P rows on source grid HINTIBL1.55
INTEGER P_ROWS_OUT !No of P rows on target grid HINTIBL1.56
INTEGER ROW_LENGTH_IN !No of pts per row on source grid HINTIBL1.57
INTEGER ROW_LENGTH_OUT !No of pts per row on target grid HINTIBL1.58
INTEGER U_FIELD_OUT !No of U pts on target grid HINTIBL1.59
INTEGER U_FIELD_IN !No of U pts on source grid HINTIBL1.60
INTEGER U_ROWS_IN !No of U rows on source grid HINTIBL1.61
INTEGER U_ROWS_OUT !No of U rows on target grid HINTIBL1.62
LOGICAL GRIB !=T if winds imported on A-grid HINTIBL1.63
HINTIBL1.64
! Array arguments with intent(in): HINTIBL1.65
INTEGER FIXHD_IN(*) !Fixed length header for source grid HINTIBL1.66
INTEGER FIXHD_OUT(*) !Fixed length header for target grid HINTIBL1.67
REAL REALHD_IN(*) !Real constants from source grid HINTIBL1.68
REAL REALHD_OUT(*) !Real constants from target grid HINTIBL1.69
HINTIBL1.70
! Array arguments with intent(Out): HINTIBL1.71
HINTIBL1.72
INTEGER INDEX_B_L(P_FIELD_OUT,IDIM) HINTIBL1.73
!Gather index for bottom l.h.c of HINTIBL1.74
!source grid box. 1=P-pts; 2=UV-pts HINTIBL1.75
INTEGER INDEX_B_R(P_FIELD_OUT,IDIM) HINTIBL1.76
!Gather index for bottom r.h.c of HINTIBL1.77
!source grid box. 1=P-pts; 2=UV-pts HINTIBL1.78
INTEGER INDEX_NEAREST(P_FIELD_OUT) HINTIBL1.79
!Gather index for nearest point on HINTIBL1.80
!source grid for each target P-pt HINTIBL1.81
REAL COEFF1(U_FIELD_OUT,ICOF)!Coefficient of rotation no 1 HINTIBL1.82
REAL COEFF2(U_FIELD_OUT,ICOF)!Coefficient of rotation no 2 HINTIBL1.83
REAL COEFF3(U_FIELD_IN,ICOF) !Coefficient of rotation no 1 HINTIBL1.84
REAL COEFF4(U_FIELD_IN,ICOF) !Coefficient of rotation no 2 HINTIBL1.85
REAL WEIGHT_T_R(P_FIELD_OUT,IDIM) ! Weights for bilinear HINTIBL1.86
REAL WEIGHT_B_R(P_FIELD_OUT,IDIM) !\horizontal interpolatn HINTIBL1.87
REAL WEIGHT_T_L(P_FIELD_OUT,IDIM) !/ 1=P-pts; 2=U-pts; HINTIBL1.88
REAL WEIGHT_B_L(P_FIELD_OUT,IDIM) ! 3=V-pts;4=zonal mean HINTIBL1.89
HINTIBL1.90
! ErrorStatus <Delete if ErrorStatus not used> HINTIBL1.91
! INTEGER ErrorStatus ! Error flag (0 = OK) HINTIBL1.92
HINTIBL1.93
! Local parameters: HINTIBL1.94
HINTIBL1.95
! Local scalars: HINTIBL1.96
INTEGER I !\ HINTIBL1.97
INTEGER IJ ! \ Loop HINTIBL1.98
INTEGER J ! /variables HINTIBL1.99
INTEGER K !/ HINTIBL1.100
INTEGER POINTS_PHI_SRCE !No of lat points on wind grid HINTIBL1.101
REAL DELTA_LAT_SOURCE !\ HINTIBL1.102
REAL DELTA_LAT_TARGET ! \Grid spacing HINTIBL1.103
REAL DELTA_LON_SOURCE ! / HINTIBL1.104
REAL DELTA_LON_TARGET !/ HINTIBL1.105
REAL MAX_LAMBDA_IN !\ HINTIBL1.106
REAL MAX_LAMBDA_OUT ! \ HINTIBL1.107
REAL MAX_PHI_IN ! \ Max and min of lat and long HINTIBL1.108
REAL MAX_PHI_OUT ! \ of source and target grids HINTIBL1.109
REAL MIN_LAMBDA_IN ! / when converted to standard HINTIBL1.110
REAL MIN_LAMBDA_OUT ! / coordinates. Used to check HINTIBL1.111
REAL MIN_PHI_IN ! / that target area is within HINTIBL1.112
REAL MIN_PHI_OUT !/source area. HINTIBL1.113
REAL NPOLE_LAT_SOURCE !\ HINTIBL1.114
REAL NPOLE_LAT_TARGET ! \North pole coordinatest HINTIBL1.115
REAL NPOLE_LON_SOURCE ! / HINTIBL1.116
REAL NPOLE_LON_TARGET !/ HINTIBL1.117
REAL START_LAT_SOURCE !\ HINTIBL1.118
REAL START_LAT_TARGET ! \Coordinates of first data point HINTIBL1.119
REAL START_LON_SOURCE ! / HINTIBL1.120
REAL START_LON_TARGET !/ HINTIBL1.121
LOGICAL CYCLIC !T= Data cyclic HINTIBL1.122
LOGICAL ROT_IN !T= Source grid has rotated coords HINTIBL1.123
LOGICAL ROT_OUT !T= Target grid has rotated coords HINTIBL1.124
HINTIBL1.125
! Local dynamic arrays: HINTIBL1.126
REAL D_LAMBDA_IN(ICOF) HINTIBL1.127
REAL D_LAMBDA_OUT(ICOF) HINTIBL1.128
REAL D_PHI_IN(ICOF) HINTIBL1.129
REAL D_PHI_OUT(ICOF) HINTIBL1.130
REAL LAMBDA_IN(ROW_LENGTH_IN) HINTIBL1.131
! Latitude coords of source p-grid HINTIBL1.132
REAL LAMBDA_INN(U_FIELD_IN) HINTIBL1.133
! Latitude coords of source u-grid HINTIBL1.134
REAL LAMBDA_OUT(P_FIELD_OUT) HINTIBL1.135
! Latitude coords of target grid HINTIBL1.136
REAL LAMBDA_ROT(U_FIELD_IN) HINTIBL1.137
! Standard lat coords of source grid HINTIBL1.138
REAL LAMBDA_TMP(U_FIELD_OUT) HINTIBL1.139
! Standard lat coords of target grid HINTIBL1.140
REAL PHI_IN(P_ROWS_IN) HINTIBL1.141
! Longitude coords of source p-grid HINTIBL1.142
REAL PHI_INN(U_FIELD_IN) HINTIBL1.143
! Longitude coords of source u-grid HINTIBL1.144
REAL PHI_OUT(P_FIELD_OUT) HINTIBL1.145
! Longitude coords of target grid HINTIBL1.146
REAL PHI_TMP(U_FIELD_OUT) HINTIBL1.147
! Standard lon coords of target grid HINTIBL1.148
HINTIBL1.149
! Function & Subroutine calls: HINTIBL1.150
External H_INT_CO,W_COEFF,EQTOLL,NEAR_PT,LLTOEQ HINTIBL1.151
HINTIBL1.152
!- End of header HINTIBL1.153
HINTIBL1.154
! 1: Test if requested horizontal interpolation is sensible HINTIBL1.155
HINTIBL1.156
! 1.1: Hemispheric or LAM -> global not allowed HINTIBL1.157
IF(FIXHD_OUT(ITYPE).EQ.0.AND.FIXHD_IN(ITYPE).GT.0)THEN HINTIBL1.158
WRITE(6,'('' *ERROR* Trying to interpolate from a hemispheric'' HINTIBL1.159
&, '' or LAM to a global domain'')') HINTIBL1.160
CALL ABORT HINTIBL1.161
END IF HINTIBL1.162
HINTIBL1.163
! 1.2: LAM -> hemispheric not allowed HINTIBL1.164
IF(FIXHD_OUT(ITYPE).LT.3.AND.FIXHD_IN(ITYPE).GT.2)THEN HINTIBL1.165
WRITE(6,'('' *ERROR* Trying to interpolate from a limited area'' HINTIBL1.166
&, '' domain to a global or hemispheric domain'')') HINTIBL1.167
CALL ABORT HINTIBL1.168
END IF HINTIBL1.169
HINTIBL1.170
! 2: Initialise local constants HINTIBL1.171
HINTIBL1.172
! 2.1: Grid spacing HINTIBL1.173
DELTA_LAT_SOURCE=REALHD_IN(IDLAT) HINTIBL1.174
DELTA_LAT_TARGET=REALHD_OUT(IDLAT) HINTIBL1.175
DELTA_LON_SOURCE=REALHD_IN(IDLON) HINTIBL1.176
DELTA_LON_TARGET=REALHD_OUT(IDLON) HINTIBL1.177
HINTIBL1.178
! 2.2: Coordinates of north pole on grid HINTIBL1.179
NPOLE_LAT_SOURCE=REALHD_IN(IPLAT) HINTIBL1.180
NPOLE_LAT_TARGET=REALHD_OUT(IPLAT) HINTIBL1.181
NPOLE_LON_SOURCE=REALHD_IN(IPLON) HINTIBL1.182
NPOLE_LON_TARGET=REALHD_OUT(IPLON) HINTIBL1.183
HINTIBL1.184
! 2.3: Coordinates of top left hand p-point on grid HINTIBL1.185
START_LAT_SOURCE=REALHD_IN(ISLAT) HINTIBL1.186
START_LAT_TARGET=REALHD_OUT(ISLAT) HINTIBL1.187
START_LON_SOURCE=REALHD_IN(ISLON) HINTIBL1.188
START_LON_TARGET=REALHD_OUT(ISLON) HINTIBL1.189
HINTIBL1.190
! 2.4: Logical to indicate output grid is rotated HINTIBL1.191
ROT_OUT=NPOLE_LAT_TARGET.NE.90..OR.NPOLE_LON_TARGET.NE.0. HINTIBL1.192
HINTIBL1.193
! 2.5: Logical to indicate input grid is rotated HINTIBL1.194
ROT_IN=NPOLE_LAT_SOURCE.NE.90..OR.NPOLE_LON_SOURCE.NE.0. HINTIBL1.195
HINTIBL1.196
! 2.6: Logical to indicate if input data cyclic HINTIBL1.197
CYCLIC=FIXHD_IN(ITYPE).LT.3 HINTIBL1.198
HINTIBL1.199
HINTIBL1.200
! 3: Weights and indices for P points: HINTIBL1.201
HINTIBL1.202
! 3.1: Lat and lon of new grid HINTIBL1.203
IJ=0 HINTIBL1.204
DO J=1,P_ROWS_OUT HINTIBL1.205
DO I=1,ROW_LENGTH_OUT HINTIBL1.206
IJ=IJ+1 HINTIBL1.207
LAMBDA_OUT(IJ)=START_LON_TARGET+DELTA_LON_TARGET*(I-1) HINTIBL1.208
PHI_OUT(IJ)=START_LAT_TARGET-DELTA_LAT_TARGET*(J-1) HINTIBL1.209
ENDDO HINTIBL1.210
ENDDO HINTIBL1.211
HINTIBL1.212
! 3.2: Convert output grid to standard lat-lon if output grid rotated HINTIBL1.213
IF(ROT_OUT)THEN HINTIBL1.214
CALL EQTOLL(PHI_OUT,LAMBDA_OUT,PHI_OUT,LAMBDA_OUT HINTIBL1.215
&, NPOLE_LAT_TARGET,NPOLE_LON_TARGET,P_FIELD_OUT) HINTIBL1.216
END IF HINTIBL1.217
HINTIBL1.218
! 3.3: Convert output grid to input lat-lon if input grid rotated HINTIBL1.219
IF(ROT_IN)THEN HINTIBL1.220
CALL LLTOEQ(PHI_OUT,LAMBDA_OUT,PHI_OUT,LAMBDA_OUT HINTIBL1.221
&, NPOLE_LAT_SOURCE,NPOLE_LON_SOURCE,P_FIELD_OUT) HINTIBL1.222
END IF HINTIBL1.223
HINTIBL1.224
! 3.4: Scale longitude if LAM output grid HINTIBL1.225
! to make it monotonically increasing HINTIBL1.226
IF(ROT_IN)THEN HINTIBL1.227
DO I=1,P_FIELD_OUT HINTIBL1.228
IF(LAMBDA_OUT(I).GT.180.)THEN HINTIBL1.229
LAMBDA_OUT(I)=LAMBDA_OUT(I)-360. HINTIBL1.230
ELSE HINTIBL1.231
LAMBDA_OUT(I)=LAMBDA_OUT(I) HINTIBL1.232
ENDIF HINTIBL1.233
END DO HINTIBL1.234
END IF HINTIBL1.235
HINTIBL1.236
! 3.5: Lat and lon of old grid HINTIBL1.237
DO J=1,P_ROWS_IN HINTIBL1.238
PHI_IN(J)=START_LAT_SOURCE-DELTA_LAT_SOURCE*(J-1) HINTIBL1.239
END DO HINTIBL1.240
DO I=1,ROW_LENGTH_IN HINTIBL1.241
LAMBDA_IN(I)=START_LON_SOURCE+DELTA_LON_SOURCE*(I-1) HINTIBL1.242
END DO HINTIBL1.243
HINTIBL1.244
! 3.6: Scale longitude if LAM input grid HINTIBL1.245
! to make it monotonically increasing HINTIBL1.246
HINTIBL1.247
IF(ROT_IN)THEN HINTIBL1.248
DO I=1,ROW_LENGTH_IN HINTIBL1.249
IF(LAMBDA_IN(I).GT.180.)THEN HINTIBL1.250
LAMBDA_IN(I)=LAMBDA_IN(I)-360. HINTIBL1.251
ELSE HINTIBL1.252
LAMBDA_IN(I)=LAMBDA_IN(I) HINTIBL1.253
HINTIBL1.254
ENDIF HINTIBL1.255
END DO HINTIBL1.256
END IF HINTIBL1.257
HINTIBL1.258
! 3.7: Check if target area contained within source area when HINTIBL1.259
! LAM->LAM HINTIBL1.260
IF(ROT_IN)THEN HINTIBL1.261
MAX_LAMBDA_OUT=LAMBDA_OUT(1) HINTIBL1.262
MIN_LAMBDA_OUT=LAMBDA_OUT(1) HINTIBL1.263
MAX_PHI_OUT=PHI_OUT(1) HINTIBL1.264
MIN_PHI_OUT=PHI_OUT(1) HINTIBL1.265
DO I=2,P_FIELD_OUT HINTIBL1.266
MAX_LAMBDA_OUT=AMAX1(LAMBDA_OUT(I),MAX_LAMBDA_OUT) HINTIBL1.267
MIN_LAMBDA_OUT=AMIN1(LAMBDA_OUT(I),MIN_LAMBDA_OUT) HINTIBL1.268
MAX_PHI_OUT=AMAX1(PHI_OUT(I),MAX_PHI_OUT) HINTIBL1.269
MIN_PHI_OUT=AMIN1(PHI_OUT(I),MIN_PHI_OUT) HINTIBL1.270
END DO HINTIBL1.271
HINTIBL1.272
MAX_LAMBDA_IN=LAMBDA_IN(ROW_LENGTH_IN) HINTIBL1.273
MIN_LAMBDA_IN=LAMBDA_IN(1) HINTIBL1.274
MAX_PHI_IN=PHI_IN(1) HINTIBL1.275
MIN_PHI_IN=PHI_IN(P_ROWS_IN) HINTIBL1.276
HINTIBL1.277
IF(MAX_PHI_IN.LT.MAX_PHI_OUT-SMALL.OR. HINTIBL1.278
& MIN_PHI_IN.GT.MIN_PHI_OUT+SMALL.OR. HINTIBL1.279
& MAX_LAMBDA_IN.LT.MAX_LAMBDA_OUT-SMALL.OR. HINTIBL1.280
& MIN_LAMBDA_IN.GT.MIN_LAMBDA_OUT+SMALL)THEN HINTIBL1.281
WRITE(6,'('' *ERROR* Target LAM not contained within '' HINTIBL1.282
&, ''source LAM'')') HINTIBL1.283
WRITE(6,'(''MAX_PHI_IN,MAX_PHI_OUT'',2F8.2)') HINTIBL1.284
& MAX_PHI_IN,MAX_PHI_OUT HINTIBL1.285
WRITE(6,'(''MIN_PHI_IN,MIN_PHI_OUT'',2F8.2)') HINTIBL1.286
& MIN_PHI_IN,MIN_PHI_OUT HINTIBL1.287
WRITE(6,'(''MAX_LAMBDA_IN,MAX_LAMBDA_OUT'',2F8.2)') HINTIBL1.288
& MAX_LAMBDA_IN,MAX_LAMBDA_OUT HINTIBL1.289
WRITE(6,'(''MIN_LAMBDA_IN,MIN_LAMBDA_OUT'',2F8.2)') HINTIBL1.290
& MIN_LAMBDA_IN,MIN_LAMBDA_OUT HINTIBL1.291
CALL ABORT HINTIBL1.292
END IF HINTIBL1.293
ENDIF HINTIBL1.294
HINTIBL1.295
! 3.8: Initialise Indices and weights for Bi-linear interpolation HINTIBL1.296
! As these are required for coastal adjustment, this must be HINTIBL1.297
! called whether bi-linear interpolation is requested or not. HINTIBL1.298
HINTIBL1.299
! 3.8.1: Call H_INT_CO HINTIBL1.300
HINTIBL1.301
*IF DEF,TIMER HINTIBL1.302
CALL TIMER('HINTCO1 ',3) HINTIBL1.303
*ENDIF HINTIBL1.304
HINTIBL1.305
CALL H_INT_CO(INDEX_B_L(1,1),INDEX_B_R(1,1) HINTIBL1.306
&, WEIGHT_T_R(1,1),WEIGHT_B_R(1,1) HINTIBL1.307
&, WEIGHT_T_L(1,1),WEIGHT_B_L(1,1) HINTIBL1.308
&, LAMBDA_IN,PHI_IN,LAMBDA_OUT,PHI_OUT HINTIBL1.309
&, ROW_LENGTH_IN,P_ROWS_IN,P_FIELD_OUT,CYCLIC) HINTIBL1.310
HINTIBL1.311
*IF DEF,TIMER HINTIBL1.312
CALL TIMER('HINTCO1 ',4) HINTIBL1.313
*ENDIF HINTIBL1.314
HINTIBL1.315
! 3.8.2: Initialise index of nearest P-points on source grid HINTIBL1.316
CALL NEAR_PT(INDEX_B_L(1,1),INDEX_B_R(1,1) HINTIBL1.317
&, WEIGHT_T_R(1,1),WEIGHT_B_R(1,1) HINTIBL1.318
&, WEIGHT_T_L(1,1),WEIGHT_B_L(1,1) HINTIBL1.319
&, P_FIELD_OUT,ROW_LENGTH_IN,INDEX_NEAREST) HINTIBL1.320
HINTIBL1.321
! 4: Weights and indices for UV points: HINTIBL1.322
HINTIBL1.323
IF(FIXHD_IN(ISTAG).EQ.3)THEN HINTIBL1.324
D_LAMBDA_IN(1)=0.5 HINTIBL1.325
D_PHI_IN(1)=0.0 HINTIBL1.326
D_LAMBDA_IN(2)=0.0 HINTIBL1.327
D_PHI_IN(2)=0.5 HINTIBL1.328
ELSE HINTIBL1.329
D_LAMBDA_IN(1)=0.5 HINTIBL1.330
D_PHI_IN(1)=0.5 HINTIBL1.331
D_LAMBDA_IN(2)=0.5 HINTIBL1.332
D_PHI_IN(2)=0.5 HINTIBL1.333
END IF HINTIBL1.334
HINTIBL1.335
IF(FIXHD_OUT(ISTAG).EQ.3)THEN HINTIBL1.336
D_LAMBDA_OUT(1)=0.5 HINTIBL1.337
D_PHI_OUT(1)=0.0 HINTIBL1.338
D_LAMBDA_OUT(2)=0.0 HINTIBL1.339
D_PHI_OUT(2)=0.5 HINTIBL1.340
ELSE HINTIBL1.341
D_LAMBDA_OUT(1)=0.5 HINTIBL1.342
D_PHI_OUT(1)=0.5 HINTIBL1.343
D_LAMBDA_OUT(2)=0.5 HINTIBL1.344
D_PHI_OUT(2)=0.5 HINTIBL1.345
END IF HINTIBL1.346
HINTIBL1.347
! Loop over u, then v HINTIBL1.348
DO K=1,2 HINTIBL1.349
HINTIBL1.350
! 4.1: Lat and lon of target grid HINTIBL1.351
IJ=0 HINTIBL1.352
DO J=1,U_ROWS_OUT HINTIBL1.353
DO I=1,ROW_LENGTH_OUT HINTIBL1.354
IJ=IJ+1 HINTIBL1.355
LAMBDA_OUT(IJ)=START_LON_TARGET+DELTA_LON_TARGET HINTIBL1.356
& *(I-1+D_LAMBDA_OUT(K)) HINTIBL1.357
PHI_OUT(IJ)=START_LAT_TARGET-DELTA_LAT_TARGET HINTIBL1.358
& *(J-1+D_PHI_OUT(K)) HINTIBL1.359
END DO HINTIBL1.360
END DO HINTIBL1.361
HINTIBL1.362
! 4.2: Lat and lon of source grid HINTIBL1.363
IF(GRIB)THEN HINTIBL1.364
! 4.2.1: Source winds on A grid HINTIBL1.365
DO J=1,P_ROWS_IN HINTIBL1.366
PHI_IN(J)=START_LAT_SOURCE-DELTA_LAT_SOURCE*(J-1) HINTIBL1.367
END DO HINTIBL1.368
DO I=1,ROW_LENGTH_IN HINTIBL1.369
LAMBDA_IN(I)=START_LON_SOURCE+DELTA_LON_SOURCE*(I-1) HINTIBL1.370
END DO HINTIBL1.371
POINTS_PHI_SRCE=P_ROWS_IN HINTIBL1.372
HINTIBL1.373
ELSE HINTIBL1.374
! 4.2.2 Source winds on B or C grid HINTIBL1.375
DO J=1,U_ROWS_IN HINTIBL1.376
PHI_IN(J)=START_LAT_SOURCE-DELTA_LAT_SOURCE HINTIBL1.377
& *(J-1+D_PHI_IN(K)) HINTIBL1.378
END DO HINTIBL1.379
DO I=1,ROW_LENGTH_IN HINTIBL1.380
LAMBDA_IN(I)=START_LON_SOURCE+DELTA_LON_SOURCE HINTIBL1.381
& *(I-1+D_LAMBDA_IN(K)) HINTIBL1.382
END DO HINTIBL1.383
POINTS_PHI_SRCE=U_ROWS_IN HINTIBL1.384
! Reset the number of PHI_SRCE points for C grid v field. UIE2F404.75
IF ((FIXHD_IN(9).EQ.3).AND.(K.EQ.2)) THEN UIE2F404.76
POINTS_PHI_SRCE=U_ROWS_IN-1 UIE2F404.77
END IF UIE2F404.78
END IF HINTIBL1.385
HINTIBL1.386
! 4.3: Convert to standard lat-lon if new grid rotated HINTIBL1.387
IF(ROT_OUT)THEN HINTIBL1.388
CALL EQTOLL(PHI_OUT,LAMBDA_OUT,PHI_TMP,LAMBDA_TMP HINTIBL1.389
&, NPOLE_LAT_TARGET,NPOLE_LON_TARGET,U_FIELD_OUT) HINTIBL1.390
HINTIBL1.391
! 4.4: Calculate coefficients for rotating wind HINTIBL1.392
CALL W_COEFF(COEFF1(1,K),COEFF2(1,K),LAMBDA_TMP,LAMBDA_OUT HINTIBL1.393
&, NPOLE_LAT_TARGET,NPOLE_LON_TARGET,U_FIELD_OUT) HINTIBL1.394
HINTIBL1.395
! 4.5: Copy across latitude and longitude of target grid in standard HINTIBL1.396
! coords for next step HINTIBL1.397
DO I=1,U_FIELD_OUT HINTIBL1.398
LAMBDA_OUT(I)=LAMBDA_TMP(I) HINTIBL1.399
PHI_OUT(I)=PHI_TMP(I) HINTIBL1.400
END DO HINTIBL1.401
HINTIBL1.402
END IF HINTIBL1.403
HINTIBL1.404
! 4.6: Convert target grid to source lat-lon if source grid rotated HINTIBL1.405
IF(ROT_IN)THEN HINTIBL1.406
CALL LLTOEQ(PHI_OUT,LAMBDA_OUT,PHI_OUT,LAMBDA_OUT HINTIBL1.407
&, NPOLE_LAT_SOURCE,NPOLE_LON_SOURCE,U_FIELD_OUT) HINTIBL1.408
ENDIF HINTIBL1.409
HINTIBL1.410
! 4.7: Scale longitude if LAM target grid HINTIBL1.411
! to make it monotonically increasing HINTIBL1.412
IF(ROT_IN)THEN HINTIBL1.413
DO I=1,P_FIELD_OUT HINTIBL1.414
IF(LAMBDA_OUT(I).GT.180.)THEN HINTIBL1.415
LAMBDA_OUT(I)=LAMBDA_OUT(I)-360. HINTIBL1.416
ELSE HINTIBL1.417
LAMBDA_OUT(I)=LAMBDA_OUT(I) HINTIBL1.418
ENDIF HINTIBL1.419
END DO HINTIBL1.420
END IF HINTIBL1.421
HINTIBL1.422
! 4.8: Scale longitude if LAM source grid HINTIBL1.423
! to make it monotonically increasing HINTIBL1.424
IF(ROT_IN)THEN HINTIBL1.425
DO I=1,ROW_LENGTH_IN HINTIBL1.426
IF(LAMBDA_IN(I).GT.180.)THEN HINTIBL1.427
LAMBDA_IN(I)=LAMBDA_IN(I)-360. HINTIBL1.428
ELSE HINTIBL1.429
LAMBDA_IN(I)=LAMBDA_IN(I) HINTIBL1.430
ENDIF HINTIBL1.431
END DO HINTIBL1.432
END IF HINTIBL1.433
HINTIBL1.434
IF(ROT_IN)THEN HINTIBL1.435
! 4.8: Calculate wind rotation coefficients from source to standard HINTIBL1.436
! lat_long grid. Used to rotate winds in CONTROL when they are HINTIBL1.437
! first read in. B-grids or C-grids supported. HINTIBL1.438
HINTIBL1.439
IJ=0 HINTIBL1.440
DO J=1,U_ROWS_IN HINTIBL1.441
DO I=1,ROW_LENGTH_IN HINTIBL1.442
IJ=IJ+1 HINTIBL1.443
LAMBDA_INN(IJ)=START_LON_SOURCE+DELTA_LON_SOURCE HINTIBL1.444
& *(I-1+D_LAMBDA_IN(K)) HINTIBL1.445
PHI_INN(IJ)=START_LAT_SOURCE-DELTA_LAT_SOURCE HINTIBL1.446
& *(J-1+D_PHI_IN(K)) HINTIBL1.447
END DO HINTIBL1.448
END DO HINTIBL1.449
HINTIBL1.450
CALL EQTOLL(PHI_INN,LAMBDA_INN,PHI_INN,LAMBDA_ROT HINTIBL1.451
&, NPOLE_LAT_SOURCE,NPOLE_LON_SOURCE,U_FIELD_IN) HINTIBL1.452
HINTIBL1.453
! Calculate coefficients for rotating wind HINTIBL1.454
CALL W_COEFF(COEFF3(1,K),COEFF4(1,K),LAMBDA_ROT,LAMBDA_INN HINTIBL1.455
&, NPOLE_LAT_SOURCE,NPOLE_LON_SOURCE,U_FIELD_IN) HINTIBL1.456
HINTIBL1.457
ENDIF HINTIBL1.458
HINTIBL1.459
! 4.9: Indices and weights for horizontal interpolation HINTIBL1.460
HINTIBL1.461
CALL H_INT_CO(INDEX_B_L(1,K+1),INDEX_B_R(1,K+1) HINTIBL1.462
&, WEIGHT_T_R(1,K+1),WEIGHT_B_R(1,K+1) HINTIBL1.463
&, WEIGHT_T_L(1,K+1),WEIGHT_B_L(1,K+1) HINTIBL1.464
&, LAMBDA_IN,PHI_IN,LAMBDA_OUT,PHI_OUT HINTIBL1.465
&, ROW_LENGTH_IN,POINTS_PHI_SRCE,U_FIELD_OUT,CYCLIC) HINTIBL1.466
HINTIBL1.467
END DO HINTIBL1.468
HINTIBL1.469
! 5: Weights and indices for zonal mean P points: HINTIBL1.470
HINTIBL1.471
! 5.1: Lat and lon of target grid HINTIBL1.472
LAMBDA_OUT(1)=START_LON_TARGET UDG6F405.30
DO J=1,P_ROWS_OUT HINTIBL1.473
PHI_OUT(J)=START_LAT_TARGET-DELTA_LAT_TARGET*(J-1) HINTIBL1.475
END DO HINTIBL1.476
HINTIBL1.477
! 5.2: Lat and lon of source grid HINTIBL1.478
LAMBDA_IN(1)=START_LON_SOURCE UDG6F405.31
DO J=1,P_ROWS_IN HINTIBL1.479
UDG6F405.32
UDG6F405.33
PHI_IN(J)=START_LAT_SOURCE-DELTA_LAT_SOURCE*(J-1) HINTIBL1.481
END DO HINTIBL1.482
HINTIBL1.483
! 5.3: Convert output grid to standard lat-lon if target grid rotated HINTIBL1.484
IF(ROT_OUT)THEN HINTIBL1.485
CALL EQTOLL(PHI_OUT,LAMBDA_OUT,PHI_OUT,LAMBDA_OUT HINTIBL1.486
&, NPOLE_LAT_TARGET,NPOLE_LON_TARGET,P_ROWS_OUT) HINTIBL1.487
ENDIF HINTIBL1.488
HINTIBL1.489
! 5.4: Convert targget grid to source lat-lon if source grid rotated HINTIBL1.490
IF(ROT_IN)THEN HINTIBL1.491
CALL LLTOEQ(PHI_OUT,LAMBDA_OUT,PHI_OUT,LAMBDA_OUT HINTIBL1.492
&, NPOLE_LAT_SOURCE,NPOLE_LON_SOURCE,P_ROWS_OUT) HINTIBL1.493
ENDIF HINTIBL1.494
HINTIBL1.495
! 5.5: Initialise indices and weights for horizontal interpolation HINTIBL1.496
HINTIBL1.497
CALL H_INT_CO(INDEX_B_L(1,4),INDEX_B_R(1,4) HINTIBL1.498
&, WEIGHT_T_R(1,4),WEIGHT_B_R(1,4) HINTIBL1.499
&, WEIGHT_T_L(1,4),WEIGHT_B_L(1,4) HINTIBL1.500
&, LAMBDA_IN,PHI_IN,LAMBDA_OUT,PHI_OUT HINTIBL1.501
&, 1,P_ROWS_IN,P_ROWS_OUT,CYCLIC) HINTIBL1.502
HINTIBL1.503
RETURN HINTIBL1.504
END HINTIBL1.505
*ENDIF HINTIBL1.506