SUBROUTINE H_INT_CTL(IDIM,LEN_FIELD_OUT 14,6HINTCTL1.6
&, ROW_LENGTH_IN,ROW_LENGTH_OUT HINTCTL1.7
&, ROWS_IN,ROWS_OUT,AW_AREA_BOX HINTCTL1.8
&, GLOBAL,H_INT_TYPE HINTCTL1.9
&, AW_INDEX_TARG_LHS,AW_INDEX_TARG_TOP HINTCTL1.10
&, BL_INDEX_B_L,BL_INDEX_B_R HINTCTL1.11
&, AW_COLAT_T,AW_LONG_L,DATA_IN HINTCTL1.12
&, WEIGHT_T_R,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_B_L HINTCTL1.13
&, DATA_OUT) HINTCTL1.14
HINTCTL1.15
IMPLICIT NONE HINTCTL1.16
! HINTCTL1.17
! Description: HINTCTL1.18
! <Say what this routine does> HINTCTL1.19
! HINTCTL1.20
! Method: HINTCTL1.21
! <Say how it does it: include references to external documentation> HINTCTL1.22
! <If this routine is very complex, then include a "pseudo code" HINTCTL1.23
! description of it to make its structure and method clear> HINTCTL1.24
! HINTCTL1.25
! Current Code Owner: D.M. Goddard HINTCTL1.26
! HINTCTL1.27
! History: HINTCTL1.28
! Version Date Comment HINTCTL1.29
! ------- ---- ------- HINTCTL1.30
! 4.0 160395 Original code. D.M. Goddard HINTCTL1.31
! HINTCTL1.32
! Code Description: HINTCTL1.33
! Language: FORTRAN 77 + common extensions. HINTCTL1.34
! This code is written to UMDP3 v6 programming standards. HINTCTL1.35
! HINTCTL1.36
! System component covered: S121 HINTCTL1.37
! System Task: S1 HINTCTL1.38
! HINTCTL1.39
! Declarations: HINTCTL1.40
! These are of the form:- HINTCTL1.41
! INTEGER ExampleVariable !Description of variable HINTCTL1.42
! HINTCTL1.43
! Global variables (*CALLed COMDECKs etc...): HINTCTL1.44
HINTCTL1.45
! Subroutine arguments HINTCTL1.46
! Scalar arguments with intent(in): HINTCTL1.47
INTEGER IDIM !Second dimension of index arrays HINTCTL1.48
INTEGER LEN_FIELD_OUT !No of points on target grid HINTCTL1.49
INTEGER ROWS_IN !No of rows on source grid HINTCTL1.50
INTEGER ROWS_OUT !No of rows on target grid HINTCTL1.51
INTEGER ROW_LENGTH_IN !No of pts per row on source grid HINTCTL1.52
INTEGER ROW_LENGTH_OUT !No of pts per row on target grid HINTCTL1.53
LOGICAL GLOBAL !True if global area required HINTCTL1.54
LOGICAL H_INT_TYPE !=T Area weighted interpolation; HINTCTL1.55
!=F Bi-linear interpolation HINTCTL1.56
HINTCTL1.57
! Array arguments with intent(in): HINTCTL1.58
REAL AW_AREA_BOX !area of grid box in sq units of HINTCTL1.59
! source grid HINTCTL1.60
INTEGER AW_INDEX_TARG_LHS(ROW_LENGTH_OUT+1) HINTCTL1.61
!Index of source box overlapping HINTCTL1.62
!lhs of target grid-box HINTCTL1.63
INTEGER AW_INDEX_TARG_TOP(ROWS_OUT+1) HINTCTL1.64
!Index of source box overlapping HINTCTL1.65
!top of target grid-box HINTCTL1.66
INTEGER BL_INDEX_B_L(LEN_FIELD_OUT) HINTCTL1.67
!Gather index for bottom l.h.c of HINTCTL1.68
!source grid box. 1=P-pts; 2=UV-pts HINTCTL1.69
INTEGER BL_INDEX_B_R(LEN_FIELD_OUT) HINTCTL1.70
!Gather index for bottom r.h.c of HINTCTL1.71
!source grid box. 1=P-pts; 2=UV-pts HINTCTL1.72
REAL AW_COLAT_T(ROWS_OUT+1) HINTCTL1.73
!Colatitude of top of target grd-box HINTCTL1.74
! (in units of DELTA_LAT_SRCE) HINTCTL1.75
REAL AW_LONG_L(ROW_LENGTH_OUT+1) HINTCTL1.76
!Left longitude of target grid-box HINTCTL1.77
! (in units of DELTA_LONG_SRCE) HINTCTL1.78
REAL DATA_IN(ROW_LENGTH_IN*ROWS_IN) HINTCTL1.79
!Data before interpolation HINTCTL1.80
REAL WEIGHT_T_R(LEN_FIELD_OUT) !\ Weights used in HINTCTL1.81
REAL WEIGHT_B_R(LEN_FIELD_OUT) ! \bilinear horizontal HINTCTL1.82
REAL WEIGHT_T_L(LEN_FIELD_OUT) ! /interpolation HINTCTL1.83
REAL WEIGHT_B_L(LEN_FIELD_OUT) !/ 1=P-pts; 2=U-pts HINTCTL1.84
! 3=V-pts; 4=zonal HINTCTL1.85
! means HINTCTL1.86
! Array arguments with intent(out): HINTCTL1.87
REAL DATA_OUT(ROW_LENGTH_OUT*ROWS_OUT) HINTCTL1.88
!Data after interpolation HINTCTL1.89
HINTCTL1.90
! ErrorStatus <Delete if ErrorStatus not used> HINTCTL1.91
! INTEGER ErrorStatus ! Error flag (0 = OK) HINTCTL1.92
HINTCTL1.93
HINTCTL1.94
! Function & Subroutine calls: HINTCTL1.95
External H_INT_BL,H_INT_AW HINTCTL1.96
HINTCTL1.97
!- End of header HINTCTL1.98
HINTCTL1.99
HINTCTL1.100
IF(.NOT.H_INT_TYPE)THEN HINTCTL1.101
HINTCTL1.102
! 1: Bi-linear interpolation requested HINTCTL1.103
*IF DEF,TIMER HINTCTL1.104
CALL TIMER
('H_INT_BL',3) HINTCTL1.105
*ENDIF HINTCTL1.106
HINTCTL1.107
CALL H_INT_BL(ROWS_IN,ROW_LENGTH_IN,LEN_FIELD_OUT HINTCTL1.108
&, BL_INDEX_B_L,BL_INDEX_B_R,DATA_IN HINTCTL1.109
&, WEIGHT_B_L,WEIGHT_B_R HINTCTL1.110
&, WEIGHT_T_L,WEIGHT_T_R HINTCTL1.111
&, DATA_OUT) HINTCTL1.112
HINTCTL1.113
*IF DEF,TIMER HINTCTL1.114
CALL TIMER('H_INT_BL',4) HINTCTL1.115
*ENDIF HINTCTL1.116
ELSE HINTCTL1.117
HINTCTL1.118
! 2: Area weighted interpolation HINTCTL1.119
*IF DEF,TIMER HINTCTL1.120
CALL TIMER('H_INT_AW',3) HINTCTL1.121
*ENDIF HINTCTL1.122
HINTCTL1.123
CALL H_INT_AW(ROWS_IN,ROWS_OUT HINTCTL1.124
&, ROW_LENGTH_IN,ROW_LENGTH_OUT,GLOBAL HINTCTL1.125
&, AW_INDEX_TARG_LHS,AW_INDEX_TARG_TOP HINTCTL1.126
&, AW_COLAT_T,AW_LONG_L,DATA_IN,DATA_OUT) HINTCTL1.127
HINTCTL1.128
*IF DEF,TIMER HINTCTL1.129
CALL TIMER('H_INT_AW',4) HINTCTL1.130
*ENDIF HINTCTL1.131
HINTCTL1.132
ENDIF ! HINTCTL1.133
HINTCTL1.134
RETURN HINTCTL1.135
END HINTCTL1.136
*ENDIF HINTCTL1.137