*IF DEF,C92_1A HINTINT1.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.15201
C GTS2F400.15202
C Use, duplication or disclosure of this code is subject to the GTS2F400.15203
C restrictions as set forth in the contract. GTS2F400.15204
C GTS2F400.15205
C Meteorological Office GTS2F400.15206
C London Road GTS2F400.15207
C BRACKNELL GTS2F400.15208
C Berkshire UK GTS2F400.15209
C RG12 2SZ GTS2F400.15210
C GTS2F400.15211
C If no contract has been raised with this copy of the code, the use, GTS2F400.15212
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15213
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15214
C Modelling at the above address. GTS2F400.15215
C ******************************COPYRIGHT****************************** GTS2F400.15216
C GTS2F400.15217
!+ Selects initialisation routine for horizontal interpolation. HINTINT1.3
SUBROUTINE H_INT_INIT(ICOF,IDIM,P_FIELD_OUT,P_ROWS_IN,P_ROWS_OUT 1,6HINTINT1.4
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTINT1.5
&, U_FIELD_IN,U_FIELD_OUT,U_ROWS_IN,U_ROWS_OUT HINTINT1.6
&, GLOBAL,GRIB,H_INT_TYPE,FIXHD_IN,FIXHD_OUT HINTINT1.7
&, REALHD_IN,REALHD_OUT,AW_AREA_BOX HINTINT1.8
&, AW_INDEX_TARG_LHS,AW_INDEX_TARG_TOP HINTINT1.9
&, BL_INDEX_B_L,BL_INDEX_B_R,BL_INDEX_NEAREST HINTINT1.10
&, AW_COLAT_T,AW_LONG_L HINTINT1.11
&, COEFF1,COEFF2,COEFF3,COEFF4 HINTINT1.12
&, WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L) HINTINT1.13
! HINTINT1.14
! Subroutine Interface: HINTINT1.15
HINTINT1.16
IMPLICIT NONE HINTINT1.17
! HINTINT1.18
! Description: HINTINT1.19
! Initialises index and weighting arrays for bi-linear HINTINT1.20
! interpolation and also area weighted indices if area HINTINT1.21
! weighting requested HINTINT1.22
! HINTINT1.23
! Method: HINTINT1.24
! Select subroutine according to logical flag H_INT_TYPE HINTINT1.25
! HINTINT1.26
! Current Code Owner: D.M. Goddard HINTINT1.27
! HINTINT1.28
! History: HINTINT1.29
! Version Date Comment HINTINT1.30
! ------- ---- ------- HINTINT1.31
! 4.0 12/04/95 Original code. D.M. Goddard HINTINT1.32
! 4.1 12/06/96 Removes rotation coefficients. Rotation not UDG2F401.1
! supported for area weighted horizontal interplation UDG2F401.2
! D.M. Goddard UDG2F401.3
! HINTINT1.33
! Code Description: HINTINT1.34
! Language: FORTRAN 77 + common extensions. HINTINT1.35
! This code is written to UMDP3 v7 programming standards. HINTINT1.36
! HINTINT1.37
! System component covered: S121 HINTINT1.38
! System Task: S1 HINTINT1.39
! HINTINT1.40
! Declarations: HINTINT1.41
! These are of the form:- HINTINT1.42
! INTEGER ExampleVariable !Description of variable HINTINT1.43
! HINTINT1.44
! Global variables (*CALLed COMDECKs etc...): HINTINT1.45
*CALL CPHINT 
HINTINT1.46
HINTINT1.47
! Subroutine arguments HINTINT1.48
! Scalar arguments with intent(in): HINTINT1.49
INTEGER ICOF !Second dimension of coefficents ary HINTINT1.50
INTEGER IDIM !Second dimension of index arrays HINTINT1.51
INTEGER P_FIELD_OUT !No of P pts on target grid HINTINT1.52
INTEGER P_ROWS_IN !No of P rows on source grid HINTINT1.53
INTEGER P_ROWS_OUT !No of P rows on target grid HINTINT1.54
INTEGER ROW_LENGTH_IN !No of pts per row on source grid HINTINT1.55
INTEGER ROW_LENGTH_OUT !No of pts per row on target grid HINTINT1.56
INTEGER U_FIELD_OUT !No of U pts on target grid HINTINT1.57
INTEGER U_FIELD_IN !No of U pts on source grid HINTINT1.58
INTEGER U_ROWS_IN !No of U rows on source grid HINTINT1.59
INTEGER U_ROWS_OUT !No of U rows on target grid HINTINT1.60
LOGICAL GRIB !=T if winds imported on A-grid HINTINT1.61
LOGICAL H_INT_TYPE !=T Area weighted interpolation; HINTINT1.62
!=F Bi-linear interpolation HINTINT1.63
! Array arguments with intent(in): HINTINT1.64
INTEGER FIXHD_IN(*) !Fixed length header for source grid HINTINT1.65
INTEGER FIXHD_OUT(*) !Fixed length header for target grid HINTINT1.66
REAL REALHD_IN(*) !Real constants from source grid HINTINT1.67
REAL REALHD_OUT(*) !Real constants from target grid HINTINT1.68
HINTINT1.69
! Integer with intent(out): HINTINT1.70
LOGICAL GLOBAL !T= Global; F= LAM. HINTINT1.71
HINTINT1.72
! Array arguments with intent(Out): HINTINT1.73
HINTINT1.74
INTEGER AW_INDEX_TARG_LHS(ROW_LENGTH_OUT+1,IDIM) HINTINT1.75
!Index of source box overlapping HINTINT1.76
!lhs of target grid-box HINTINT1.77
INTEGER AW_INDEX_TARG_TOP(P_ROWS_OUT+1,IDIM) HINTINT1.78
!Index of source box overlapping HINTINT1.79
!top of target grid-box HINTINT1.80
INTEGER BL_INDEX_B_L(P_FIELD_OUT,IDIM) HINTINT1.81
!Gather index for bottom l.h.c of HINTINT1.82
!source grid box. 1=P-pts; 2=UV-pts HINTINT1.83
INTEGER BL_INDEX_B_R(P_FIELD_OUT,IDIM) HINTINT1.84
!Gather index for bottom r.h.c of HINTINT1.85
!source grid box. 1=P-pts; 2=UV-pts HINTINT1.86
INTEGER BL_INDEX_NEAREST(P_FIELD_OUT) HINTINT1.87
!Gather index for nearest point on HINTINT1.88
!source grid for each target P-pt HINTINT1.89
REAL AW_AREA_BOX(IDIM) !area of grid box in sq units of HINTINT1.90
! source grid HINTINT1.91
REAL AW_COLAT_T(P_ROWS_OUT+1,IDIM) HINTINT1.92
!Colatitude of top of target grd-box HINTINT1.93
! (in units of DELTA_LAT_SRCE) HINTINT1.94
REAL AW_LONG_L(ROW_LENGTH_OUT+1,IDIM) HINTINT1.95
!Left longitude of target grid-box HINTINT1.96
! (in units of DELTA_LONG_SRCE) HINTINT1.97
REAL COEFF1(U_FIELD_OUT,ICOF)!Coefficient of rotation no 1 HINTINT1.98
REAL COEFF2(U_FIELD_OUT,ICOF)!Coefficient of rotation no 2 HINTINT1.99
REAL COEFF3(U_FIELD_IN,ICOF) !Coefficient of rotation no 1 HINTINT1.100
REAL COEFF4(U_FIELD_IN,ICOF) !Coefficient of rotation no 2 HINTINT1.101
REAL WEIGHT_T_R(P_FIELD_OUT,IDIM) ! Weights for bilinear HINTINT1.102
REAL WEIGHT_B_R(P_FIELD_OUT,IDIM) !\horizontal interpolatn HINTINT1.103
REAL WEIGHT_T_L(P_FIELD_OUT,IDIM) !/ 1=P-pts; 2=U-pts; HINTINT1.104
REAL WEIGHT_B_L(P_FIELD_OUT,IDIM) ! 3=V-pts;4=zonal mean HINTINT1.105
HINTINT1.106
! ErrorStatus <Delete if ErrorStatus not used> HINTINT1.107
! INTEGER ErrorStatus ! Error flag (0 = OK) HINTINT1.108
HINTINT1.109
! Local parameters: HINTINT1.110
HINTINT1.111
! Function & Subroutine calls: HINTINT1.112
External H_INT_INIT_AW,H_INT_INIT_BL HINTINT1.113
HINTINT1.114
!- End of header HINTINT1.115
HINTINT1.116
! 1: Set logical GLOBAL HINTINT1.117
IF(FIXHD_OUT(ITYPE).EQ.0)THEN HINTINT1.118
GLOBAL=.TRUE. HINTINT1.119
ELSE HINTINT1.120
GLOBAL=.FALSE. HINTINT1.121
END IF HINTINT1.122
HINTINT1.123
IF(H_INT_TYPE)THEN HINTINT1.124
HINTINT1.125
! 2: Initialise index arrays for area weighted interpolation HINTINT1.126
WRITE(6,*) 'Using area weighted horizontal interpolation' HINTINT1.127
*IF DEF,TIMER HINTINT1.128
CALL TIMER('HINTINAW',3) HINTINT1.129
*ENDIF HINTINT1.130
CALL H_INT_INIT_AW(ICOF,IDIM,P_FIELD_OUT,P_ROWS_IN,P_ROWS_OUT HINTINT1.131
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTINT1.132
&, U_FIELD_IN,U_FIELD_OUT,U_ROWS_IN,U_ROWS_OUT HINTINT1.133
&, GLOBAL,GRIB,FIXHD_IN,FIXHD_OUT HINTINT1.134
&, REALHD_IN,REALHD_OUT,AW_AREA_BOX HINTINT1.135
&, AW_INDEX_TARG_LHS,AW_INDEX_TARG_TOP HINTINT1.136
&, BL_INDEX_B_L,BL_INDEX_B_R,BL_INDEX_NEAREST HINTINT1.137
&, AW_COLAT_T,AW_LONG_L HINTINT1.138
&, WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L) HINTINT1.140
*IF DEF,TIMER HINTINT1.141
CALL TIMER('HINTINAW',4) HINTINT1.142
*ENDIF HINTINT1.143
HINTINT1.144
ELSE HINTINT1.145
HINTINT1.146
! 3: Initialise index arrays for bi-linear interpolation HINTINT1.147
WRITE(6,*) 'Using bi-linear horizontal interpolation' HINTINT1.148
*IF DEF,TIMER HINTINT1.149
CALL TIMER('HINTINBL',3) HINTINT1.150
*ENDIF HINTINT1.151
CALL H_INT_INIT_BL(ICOF,IDIM,P_FIELD_OUT,P_ROWS_IN,P_ROWS_OUT HINTINT1.152
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTINT1.153
&, U_FIELD_IN,U_FIELD_OUT HINTINT1.154
&, U_ROWS_IN,U_ROWS_OUT,GRIB HINTINT1.155
&, FIXHD_IN,FIXHD_OUT,REALHD_IN,REALHD_OUT HINTINT1.156
&, BL_INDEX_B_L,BL_INDEX_B_R,BL_INDEX_NEAREST HINTINT1.157
&, COEFF1,COEFF2,COEFF3,COEFF4 HINTINT1.158
&, WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L) HINTINT1.159
*IF DEF,TIMER HINTINT1.160
CALL TIMER('HINTINBL',4) HINTINT1.161
*ENDIF HINTINT1.162
HINTINT1.163
ENDIF HINTINT1.164
HINTINT1.165
RETURN HINTINT1.166
END HINTINT1.167
*ENDIF HINTINT1.168