SUBROUTINE H_INT_INIT_AW(ICOF,IDIM,P_FIELD_OUT 1,16HINTIAW1.4
&, P_ROWS_IN,P_ROWS_OUT HINTIAW1.5
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTIAW1.6
&, U_FIELD_IN,U_FIELD_OUT HINTIAW1.7
&, U_ROWS_IN,U_ROWS_OUT HINTIAW1.8
&, GLOBAL,GRIB,FIXHD_IN,FIXHD_OUT HINTIAW1.9
&, REALHD_IN,REALHD_OUT,AW_AREA_BOX HINTIAW1.10
&, AW_INDEX_TARG_LHS,AW_INDEX_TARG_TOP HINTIAW1.11
&, BL_INDEX_B_L,BL_INDEX_B_R,BL_INDEX_NEAREST HINTIAW1.12
&, AW_COLAT_T,AW_LONG_L HINTIAW1.13
&, WEIGHT_T_R,WEIGHT_B_R HINTIAW1.15
&, WEIGHT_T_L,WEIGHT_B_L) HINTIAW1.16
! HINTIAW1.17
! Subroutine Interface: HINTIAW1.18
HINTIAW1.19
IMPLICIT NONE HINTIAW1.20
! HINTIAW1.21
! Description: HINTIAW1.22
! Initialises arrays used in horizontal interpolation. HINTIAW1.23
! This replaces routine SETWTS1 (A Dickinson) whose function it HINTIAW1.24
! incorporates. HINTIAW1.25
! HINTIAW1.26
! Method: HINTIAW1.27
! Sets up gather index and weight arrays for later call to H_INT_BL h HINTIAW1.28
! Also sets up rotation coefficients for use in ROTATE with rotated HINTIAW1.29
! grids. HINTIAW1.30
! HINTIAW1.31
! Current Code Owner: D.M. Goddard HINTIAW1.32
! HINTIAW1.33
! History: HINTIAW1.34
! Version Date Comment HINTIAW1.35
! ------- ---- ------- HINTIAW1.36
! 4.0 12/04/95 Original code. D.M. Goddard HINTIAW1.37
! 4.1 12/06/96 Extended to cope with C_grid. D.M. Goddard UDG2F401.4
! HINTIAW1.38
! Code Description: HINTIAW1.39
! Language: FORTRAN 77 + common extensions. HINTIAW1.40
! This code is written to UMDP3 v7 programming standards. HINTIAW1.41
! HINTIAW1.42
! System component covered: S121 HINTIAW1.43
! System Task: S1 HINTIAW1.44
! HINTIAW1.45
! Declarations: HINTIAW1.46
! These are of the form:- HINTIAW1.47
! INTEGER ExampleVariable !Description of variable HINTIAW1.48
! HINTIAW1.49
! Global variables (*CALLed COMDECKs etc...): HINTIAW1.50
*CALL CPHINT 
HINTIAW1.51
HINTIAW1.52
! Subroutine arguments HINTIAW1.53
! Scalar arguments with intent(in): HINTIAW1.54
INTEGER ICOF !Second dimension of coefficents ary HINTIAW1.55
INTEGER IDIM !Second dimension of index arrays HINTIAW1.56
INTEGER P_FIELD_OUT !No of P pts on target grid HINTIAW1.57
INTEGER P_ROWS_IN !No of P rows on source grid HINTIAW1.58
INTEGER P_ROWS_OUT !No of P rows on target grid HINTIAW1.59
INTEGER ROW_LENGTH_IN !No of pts per row on source grid HINTIAW1.60
INTEGER ROW_LENGTH_OUT !No of pts per row on target grid HINTIAW1.61
! grid HINTIAW1.62
INTEGER U_FIELD_OUT !No of U pts on target grid HINTIAW1.63
INTEGER U_FIELD_IN !No of U pts on source grid HINTIAW1.64
INTEGER U_ROWS_IN !No of U rows on source grid HINTIAW1.65
INTEGER U_ROWS_OUT !No of U rows on target grid HINTIAW1.66
LOGICAL GLOBAL !T= Global; F= LAM. HINTIAW1.67
LOGICAL GRIB !=T if winds imported on A-grid HINTIAW1.68
HINTIAW1.69
! Array arguments with intent(in): HINTIAW1.70
INTEGER FIXHD_IN(*) !Fixed length header for source grid HINTIAW1.71
INTEGER FIXHD_OUT(*) !Fixed length header for target grid HINTIAW1.72
REAL REALHD_IN(*) !Real constants from source grid HINTIAW1.73
REAL REALHD_OUT(*) !Real constants from target grid HINTIAW1.74
HINTIAW1.75
! Array arguments with intent(Out): HINTIAW1.76
HINTIAW1.77
INTEGER AW_INDEX_TARG_LHS(ROW_LENGTH_OUT+1,IDIM) HINTIAW1.78
!Index of source box overlapping HINTIAW1.79
!lhs of target grid-box HINTIAW1.80
INTEGER AW_INDEX_TARG_TOP(P_ROWS_OUT+1,IDIM) HINTIAW1.81
!Index of source box overlapping HINTIAW1.82
!top of target grid-box HINTIAW1.83
INTEGER BL_INDEX_B_L(P_FIELD_OUT,IDIM) HINTIAW1.84
!Gather index for bottom l.h.c of HINTIAW1.85
!source grid box. 1=P-pts; 2=UV-pts HINTIAW1.86
INTEGER BL_INDEX_B_R(P_FIELD_OUT,IDIM) HINTIAW1.87
!Gather index for bottom r.h.c of HINTIAW1.88
!source grid box. 1=P-pts; 2=UV-pts HINTIAW1.89
INTEGER BL_INDEX_NEAREST(P_FIELD_OUT) HINTIAW1.90
!Gather index for nearest point on HINTIAW1.91
!source grid for each target P-pt HINTIAW1.92
REAL AW_AREA_BOX(IDIM) !area of grid box in sq units of HINTIAW1.93
! source grid HINTIAW1.94
REAL AW_COLAT_T(P_ROWS_OUT+1,IDIM) HINTIAW1.95
!Colatitude of top of target grd-box HINTIAW1.96
! (in units of DELTA_LAT_SRCE) HINTIAW1.97
REAL AW_LONG_L(ROW_LENGTH_OUT+1,IDIM) HINTIAW1.98
!Left longitude of target grid-box HINTIAW1.99
! (in units of DELTA_LONG_SRCE) HINTIAW1.100
REAL WEIGHT_T_R(P_FIELD_OUT,IDIM) ! Weights for bilinear HINTIAW1.105
REAL WEIGHT_B_R(P_FIELD_OUT,IDIM) !\horizontal interpolatn HINTIAW1.106
REAL WEIGHT_T_L(P_FIELD_OUT,IDIM) !/ 1=P-pts; 2=U-pts; HINTIAW1.107
REAL WEIGHT_B_L(P_FIELD_OUT,IDIM) ! 3=V-pts;4=zonal mean HINTIAW1.108
HINTIAW1.109
UDG2F401.5
! INTEGER ErrorStatus ! Error flag (0 = OK) HINTIAW1.111
HINTIAW1.112
! Local parameters: HINTIAW1.113
HINTIAW1.114
! Local scalars: HINTIAW1.115
INTEGER I !\ HINTIAW1.118
INTEGER IJ ! \ Loop HINTIAW1.119
INTEGER J ! /variables HINTIAW1.120
INTEGER K !/ HINTIAW1.121
REAL DELTA_LAT_SOURCE !\ HINTIAW1.125
REAL DELTA_LAT_TARGET ! \Grid spacing HINTIAW1.126
REAL DELTA_LON_SOURCE ! / HINTIAW1.127
REAL DELTA_LON_TARGET !/ HINTIAW1.128
REAL NPOLE_LAT_SOURCE !\ HINTIAW1.137
REAL NPOLE_LAT_TARGET ! \North pole coordinatest HINTIAW1.138
REAL NPOLE_LON_SOURCE ! / HINTIAW1.139
REAL NPOLE_LON_TARGET !/ HINTIAW1.140
REAL START_LAT_SOURCE !\ HINTIAW1.141
REAL START_LAT_TARGET ! \Coordinates of first data point HINTIAW1.142
REAL START_LON_SOURCE ! / HINTIAW1.143
REAL START_LON_TARGET !/ HINTIAW1.144
LOGICAL CYCLIC !T= Data cyclic HINTIAW1.145
UDG2F401.6
! Local dynamic arrays: UDG2F401.7
INTEGER I_GRID_IN(ICOF) UDG2F401.8
INTEGER I_GRID_OUT(ICOF) UDG2F401.9
REAL D_LAT_IN(ICOF) UDG2F401.10
REAL D_LON_IN(ICOF) UDG2F401.11
REAL D_LAT_OUT(ICOF) UDG2F401.12
REAL D_LON_OUT(ICOF) UDG2F401.13
REAL LAMBDA_IN(ROW_LENGTH_IN) UDG2F401.14
! Latitude coords of source p-grid UDG2F401.15
REAL LAMBDA_OUT(P_FIELD_OUT) UDG2F401.16
! Latitude coords of target grid UDG2F401.17
REAL PHI_IN(P_ROWS_IN) UDG2F401.18
! Longitude coords of source p-grid UDG2F401.19
REAL PHI_OUT(P_FIELD_OUT) UDG2F401.20
! Longitude coords of target grid UDG2F401.21
! Function & Subroutine calls: HINTIAW1.173
External H_INT_CO,NEAR_PT,BOX_BND UDG2F401.22
HINTIAW1.175
!- End of header HINTIAW1.176
HINTIAW1.177
! 1: Test if requested horizontal interpolation is sensible HINTIAW1.178
HINTIAW1.179
! 1.1: Hemispheric or LAM -> global not allowed HINTIAW1.180
IF(FIXHD_OUT(ITYPE).EQ.0.AND.FIXHD_IN(ITYPE).GT.0)THEN HINTIAW1.181
WRITE(6,'('' *ERROR* Trying to interpolate from a hemispheric'' HINTIAW1.182
&, '' or LAM to a global domain'')') HINTIAW1.183
CALL ABORT HINTIAW1.184
END IF HINTIAW1.185
HINTIAW1.186
! 1.2: LAM -> hemispheric not allowed HINTIAW1.187
IF(FIXHD_OUT(ITYPE).LT.3.AND.FIXHD_IN(ITYPE).GT.2)THEN HINTIAW1.188
WRITE(6,'('' *ERROR* Trying to interpolate from a limited area'' HINTIAW1.189
&, '' domain to a global or hemispheric domain'')') HINTIAW1.190
CALL ABORT HINTIAW1.191
END IF HINTIAW1.192
HINTIAW1.193
! 2: Initialise local constants HINTIAW1.194
HINTIAW1.195
! 2.1: Grid spacing HINTIAW1.196
DELTA_LAT_SOURCE=REALHD_IN(IDLAT) HINTIAW1.197
DELTA_LAT_TARGET=REALHD_OUT(IDLAT) HINTIAW1.198
DELTA_LON_SOURCE=REALHD_IN(IDLON) HINTIAW1.199
DELTA_LON_TARGET=REALHD_OUT(IDLON) HINTIAW1.200
HINTIAW1.201
! 2.2: Coordinates of north pole on grid HINTIAW1.202
NPOLE_LAT_SOURCE=REALHD_IN(IPLAT) HINTIAW1.203
NPOLE_LAT_TARGET=REALHD_OUT(IPLAT) HINTIAW1.204
NPOLE_LON_SOURCE=REALHD_IN(IPLON) HINTIAW1.205
NPOLE_LON_TARGET=REALHD_OUT(IPLON) HINTIAW1.206
HINTIAW1.207
! 2.3: Coordinates of top left hand p-point on grid HINTIAW1.208
START_LAT_SOURCE=REALHD_IN(ISLAT) HINTIAW1.209
START_LAT_TARGET=REALHD_OUT(ISLAT) HINTIAW1.210
START_LON_SOURCE=REALHD_IN(ISLON) HINTIAW1.211
START_LON_TARGET=REALHD_OUT(ISLON) HINTIAW1.212
HINTIAW1.213
! 2.4: Logical to indicate if input data cyclic UDG2F401.23
CYCLIC=FIXHD_IN(ITYPE).LT.3 UDG2F401.24
UDG2F401.25
! 2.5: Initialise I_GRID_IN and IGRID_OUT to 1 ie p-grid UDG2F401.26
I_GRID_IN(1)=1 UDG2F401.27
I_GRID_IN(2)=1 UDG2F401.28
I_GRID_OUT(1)=1 UDG2F401.29
I_GRID_OUT(2)=1 UDG2F401.30
UDG2F401.31
! 3: Weights and indices for P points: UDG2F401.32
UDG2F401.33
! 3.1: If source or target grids have different poles UDG2F401.34
! abort with error message UDG2F401.35
HINTIAW1.255
IF(NPOLE_LAT_SOURCE.NE.NPOLE_LAT_TARGET.AND. HINTIAW1.256
& NPOLE_LON_SOURCE.NE.NPOLE_LON_TARGET)THEN HINTIAW1.257
HINTIAW1.258
WRITE(6,*) 'Source and target grids have different poles' HINTIAW1.259
WRITE(6,*) 'Reconfigure onto a grid with the same pole as' HINTIAW1.260
&, 'target grid' HINTIAW1.261
WRITE(6,*) 'before attempting area weighted interpolation' HINTIAW1.262
HINTIAW1.263
CALL ABORT HINTIAW1.264
ENDIF HINTIAW1.265
HINTIAW1.266
! 3.2: Calculate area weighted indices for UDG2F401.36
! interpolating from the source grid onto the target grid HINTIAW1.268
*IF DEF,TIMER HINTIAW1.269
CALL TIMER('BOXBND ',3) HINTIAW1.270
*ENDIF HINTIAW1.271
CALL BOX_BND(AW_INDEX_TARG_LHS(1,1),AW_LONG_L(1,1) HINTIAW1.272
&, AW_INDEX_TARG_TOP(1,1),AW_COLAT_T(1,1) HINTIAW1.273
&, AW_AREA_BOX(1) HINTIAW1.274
&, ROW_LENGTH_OUT,P_ROWS_OUT HINTIAW1.275
&, ROW_LENGTH_IN,P_ROWS_IN HINTIAW1.276
&, DELTA_LON_TARGET,DELTA_LAT_TARGET HINTIAW1.277
&, START_LON_TARGET,START_LAT_TARGET HINTIAW1.278
&, DELTA_LON_SOURCE,DELTA_LAT_SOURCE HINTIAW1.279
&, START_LON_SOURCE,START_LAT_SOURCE HINTIAW1.280
&, I_GRID_OUT(1),I_GRID_IN(1),GLOBAL) UDG2F401.37
HINTIAW1.282
*IF DEF,TIMER HINTIAW1.283
CALL TIMER('BOXBND ',4) HINTIAW1.284
*ENDIF HINTIAW1.285
HINTIAW1.286
! 4: Weights and indices for U and V points: UDG2F401.38
UDG2F401.39
! 4.1: Calculate offsets for source winds UDG2F401.40
IF(GRIB) THEN UDG2F401.41
UDG2F401.42
! 4.1.1: Source winds on A grid UDG2F401.43
D_LAT_IN(1)=0.0 UDG2F401.44
D_LON_IN(1)=0.0 UDG2F401.45
D_LAT_IN(2)=0.0 UDG2F401.46
D_LON_IN(2)=0.0 UDG2F401.47
UDG2F401.48
ELSEIF(FIXHD_IN(ISTAG).EQ.3)THEN UDG2F401.49
UDG2F401.50
! 4.1.2: Source winds on C grid UDG2F401.51
D_LON_IN(1)=0.5 UDG2F401.52
D_LAT_IN(1)=0.0 UDG2F401.53
D_LON_IN(2)=0.0 UDG2F401.54
D_LAT_IN(2)=0.5 UDG2F401.55
I_GRID_IN(1)=1 UDG2F401.56
I_GRID_IN(2)=2 UDG2F401.57
UDG2F401.58
ELSE UDG2F401.59
UDG2F401.60
! 4.1.3: Source winds on B grid UDG2F401.61
D_LAT_IN(1)=0.5 UDG2F401.62
D_LON_IN(1)=0.5 UDG2F401.63
D_LAT_IN(2)=0.5 UDG2F401.64
D_LON_IN(2)=0.5 UDG2F401.65
I_GRID_IN(1)=2 UDG2F401.66
I_GRID_IN(2)=2 UDG2F401.67
END IF UDG2F401.68
UDG2F401.69
! 4.2: Calculate offsets for target winds UDG2F401.70
UDG2F401.71
IF(FIXHD_OUT(ISTAG).EQ.3)THEN UDG2F401.72
UDG2F401.73
! 4.2.1: Target winds on C grid UDG2F401.74
D_LON_OUT(1)=0.5 UDG2F401.75
D_LAT_OUT(1)=0.0 UDG2F401.76
D_LON_OUT(2)=0.0 UDG2F401.77
D_LAT_OUT(2)=0.5 UDG2F401.78
I_GRID_OUT(1)=1 UDG2F401.79
I_GRID_OUT(2)=2 UDG2F401.80
UDG2F401.81
ELSE UDG2F401.82
UDG2F401.83
! 4.2.2: Target winds on B grid UDG2F401.84
D_LAT_OUT(1)=0.5 UDG2F401.85
D_LON_OUT(1)=0.5 UDG2F401.86
D_LAT_OUT(2)=0.5 UDG2F401.87
D_LON_OUT(2)=0.5 UDG2F401.88
I_GRID_OUT(1)=2 UDG2F401.89
I_GRID_OUT(2)=2 UDG2F401.90
UDG2F401.91
ENDIF UDG2F401.92
UDG2F401.93
! Loop over u, then v UDG2F401.94
DO K=1,2 UDG2F401.95
UDG2F401.96
! 4.3: Calculate area weighted indices for UDG2F401.97
UDG2F401.98
! interpolating from the source grid onto the target grid HINTIAW1.394
HINTIAW1.395
! One less row in v for C-grid UDG2F401.99
IF(K.EQ.2.AND.FIXHD_OUT(ISTAG).EQ.3)THEN UDG2F401.100
U_ROWS_OUT=U_ROWS_OUT-1 UDG2F401.101
ENDIF UDG2F401.102
UDG2F401.103
*IF DEF,TIMER HINTIAW1.396
CALL TIMER('BOXBND ',3) HINTIAW1.397
*ENDIF HINTIAW1.398
CALL BOX_BND(AW_INDEX_TARG_LHS(1,K+1),AW_LONG_L(1,K+1) HINTIAW1.399
&, AW_INDEX_TARG_TOP(1,K+1),AW_COLAT_T(1,K+1) HINTIAW1.400
&, AW_AREA_BOX(K+1) HINTIAW1.401
&, ROW_LENGTH_OUT,U_ROWS_OUT HINTIAW1.402
&, ROW_LENGTH_IN,U_ROWS_IN HINTIAW1.403
&, DELTA_LON_TARGET,DELTA_LAT_TARGET HINTIAW1.404
&, START_LON_TARGET+D_LON_OUT(K)*DELTA_LON_TARGET UDG2F401.104
&, START_LAT_TARGET-D_LAT_OUT(K)*DELTA_LAT_TARGET UDG2F401.105
&, DELTA_LON_SOURCE,DELTA_LAT_SOURCE HINTIAW1.406
&, START_LON_SOURCE+D_LON_IN(K)*DELTA_LON_SOURCE UDG2F401.106
&, START_LAT_SOURCE-D_LAT_IN(K)*DELTA_LAT_SOURCE UDG2F401.107
&, I_GRID_OUT(K),I_GRID_IN(K),GLOBAL) UDG2F401.108
HINTIAW1.409
*IF DEF,TIMER HINTIAW1.410
CALL TIMER('BOXBND ',4) HINTIAW1.411
*ENDIF HINTIAW1.412
HINTIAW1.413
! Reset U_ROWS_OUT UDG2F401.109
IF(K.EQ.2.AND.FIXHD_OUT(ISTAG).EQ.3)THEN UDG2F401.110
U_ROWS_OUT=U_ROWS_OUT+1 UDG2F401.111
ENDIF UDG2F401.112
UDG2F401.113
END DO HINTIAW1.414
HINTIAW1.415
! 5: Weights and indices for zonal mean P points: HINTIAW1.416
HINTIAW1.417
! 5.1: Reset I_GRID_IN and I_GRID_OUT for p grid UDG2F401.114
I_GRID_IN(1)=1 UDG2F401.115
I_GRID_OUT(1)=1 UDG2F401.116
! 5.2: Calculate area weighted indices for UDG2F401.117
! interpolating from the source grid onto the target grid HINTIAW1.432
*IF DEF,TIMER HINTIAW1.433
CALL TIMER('BOXBND ',3) HINTIAW1.434
*ENDIF HINTIAW1.435
CALL BOX_BND(AW_INDEX_TARG_LHS(1,4),AW_LONG_L(1,4) HINTIAW1.436
&, AW_INDEX_TARG_TOP(1,4),AW_COLAT_T(1,4) HINTIAW1.437
&, AW_AREA_BOX(4) HINTIAW1.438
&, 1,P_ROWS_OUT HINTIAW1.439
&, 1,P_ROWS_IN HINTIAW1.440
&, DELTA_LON_TARGET,DELTA_LAT_TARGET HINTIAW1.441
&, START_LON_TARGET,START_LAT_TARGET HINTIAW1.442
&, DELTA_LON_SOURCE,DELTA_LAT_SOURCE HINTIAW1.443
&, START_LON_SOURCE,START_LAT_SOURCE HINTIAW1.444
&, I_GRID_OUT(1),I_GRID_IN(1),GLOBAL) UDG2F401.118
HINTIAW1.446
*IF DEF,TIMER HINTIAW1.447
CALL TIMER('BOXBND ',4) HINTIAW1.448
*ENDIF HINTIAW1.449
HINTIAW1.450
! 6: Weights and indices for Coastal adjustment and Integer fields HINTIAW1.451
HINTIAW1.452
! 6.1: Lat and lon of target grid HINTIAW1.453
IJ=0 HINTIAW1.454
DO J=1,P_ROWS_OUT HINTIAW1.455
DO I=1,ROW_LENGTH_OUT HINTIAW1.456
IJ=IJ+1 HINTIAW1.457
LAMBDA_OUT(IJ)=START_LON_TARGET+DELTA_LON_TARGET*(I-1) HINTIAW1.458
PHI_OUT(IJ)=START_LAT_TARGET-DELTA_LAT_TARGET*(J-1) HINTIAW1.459
END DO HINTIAW1.460
END DO HINTIAW1.461
HINTIAW1.462
! 6.2: Lat and lon of source grid HINTIAW1.463
DO J=1,P_ROWS_IN HINTIAW1.464
PHI_IN(J)=START_LAT_SOURCE-DELTA_LAT_SOURCE*(J-1) HINTIAW1.465
END DO HINTIAW1.466
DO I=1,ROW_LENGTH_IN HINTIAW1.467
LAMBDA_IN(I)=START_LON_SOURCE+DELTA_LON_SOURCE*(I-1) HINTIAW1.468
END DO HINTIAW1.469
HINTIAW1.470
! 6.3: Initialise Indices and weights for Bi-linear interpolation UDG2F401.119
*IF DEF,TIMER HINTIAW1.509
CALL TIMER('HINTCO1 ',3) HINTIAW1.510
*ENDIF HINTIAW1.511
HINTIAW1.512
CALL H_INT_CO(BL_INDEX_B_L(1,1),BL_INDEX_B_R(1,1) HINTIAW1.513
&, WEIGHT_T_R(1,1),WEIGHT_B_R(1,1) HINTIAW1.514
&, WEIGHT_T_L(1,1),WEIGHT_B_L(1,1) HINTIAW1.515
&, LAMBDA_IN,PHI_IN,LAMBDA_OUT,PHI_OUT HINTIAW1.516
&, ROW_LENGTH_IN,P_ROWS_IN,P_FIELD_OUT,CYCLIC) HINTIAW1.517
HINTIAW1.518
*IF DEF,TIMER HINTIAW1.519
CALL TIMER('HINTCO1 ',4) HINTIAW1.520
*ENDIF HINTIAW1.521
HINTIAW1.522
! 6.8: Initialise index of nearest P-points on source grid HINTIAW1.523
CALL NEAR_PT(BL_INDEX_B_L(1,1),BL_INDEX_B_R(1,1) HINTIAW1.524
&, WEIGHT_T_R(1,1),WEIGHT_B_R(1,1) HINTIAW1.525
&, WEIGHT_T_L(1,1),WEIGHT_B_L(1,1) HINTIAW1.526
&, P_FIELD_OUT,ROW_LENGTH_IN,BL_INDEX_NEAREST) HINTIAW1.527
HINTIAW1.528
HINTIAW1.529
RETURN HINTIAW1.530
END HINTIAW1.531
*ENDIF HINTIAW1.532