*IF DEF,C92_1A HIBLSM1A.2
C ******************************COPYRIGHT****************************** HIBLSM1A.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. HIBLSM1A.4
C HIBLSM1A.5
C Use, duplication or disclosure of this code is subject to the HIBLSM1A.6
C restrictions as set forth in the contract. HIBLSM1A.7
C HIBLSM1A.8
C Meteorological Office HIBLSM1A.9
C London Road HIBLSM1A.10
C BRACKNELL HIBLSM1A.11
C Berkshire UK HIBLSM1A.12
C RG12 2SZ HIBLSM1A.13
C HIBLSM1A.14
C If no contract has been raised with this copy of the code, the use, HIBLSM1A.15
C duplication or disclosure of it is strictly prohibited. Permission HIBLSM1A.16
C to do so must first be obtained in writing from the Head of Numerical HIBLSM1A.17
C Modelling at the above address. HIBLSM1A.18
C ******************************COPYRIGHT****************************** HIBLSM1A.19
C HIBLSM1A.20
!+ Performs Bi-linear horizitontal interpolation HIBLSM1A.21
! HIBLSM1A.22
! Subroutine Interface: HIBLSM1A.23
SUBROUTINE H_INT_LSM(ROWS_IN,ROW_LENGTH_IN,LEN_FIELD_OUT 2HIBLSM1A.24
&, RMDI HIBLSM1A.25
&, INDEX_B_L,INDEX_B_R,DATA_IN HIBLSM1A.26
&, WEIGHT_B_L,WEIGHT_B_R,WEIGHT_T_L,WEIGHT_T_R HIBLSM1A.27
&, LSMO HIBLSM1A.28
&, DATA_OUT) HIBLSM1A.29
HIBLSM1A.30
HIBLSM1A.31
IMPLICIT NONE HIBLSM1A.32
! HIBLSM1A.33
! Description: HIBLSM1A.34
! Carries out bi-linear horizontal interpolation using coefficients HIBLSM1A.35
! and gather indices calculated in subroutine H_INT_CO HIBLSM1A.36
! HIBLSM1A.37
! Method: HIBLSM1A.38
! See UMDP S1 for full desciption HIBLSM1A.39
! HIBLSM1A.40
! Current Code Owner: D.M. Goddard HIBLSM1A.41
! HIBLSM1A.42
! History: HIBLSM1A.43
! Version Date Comment HIBLSM1A.44
! ------- ---- ------- HIBLSM1A.45
! 4.5 04/09/98 New routine: based on hint_bl. Checks input values HIBLSM1A.46
! for missing data indicator (RMDI). Output is HIBLSM1A.47
! RMDI at a point if any input point is RMDI HIBLSM1A.48
! Author D.M. Goddard HIBLSM1A.49
! HIBLSM1A.50
! Code Description: HIBLSM1A.51
! Language: FORTRAN 77 + common extensions. HIBLSM1A.52
! This code is written to UMDP3 v6 programming standards. HIBLSM1A.53
! HIBLSM1A.54
! Declarations: HIBLSM1A.55
! These are of the form:- HIBLSM1A.56
! INTEGER ExampleVariable !Description of variable HIBLSM1A.57
! HIBLSM1A.58
! Global variables (*CALLed COMDECKs etc...): HIBLSM1A.59
HIBLSM1A.60
! Subroutine arguments HIBLSM1A.61
! Scalar arguments with intent(in): HIBLSM1A.62
INTEGER ROWS_IN !No of P rows on source grid HIBLSM1A.63
INTEGER ROW_LENGTH_IN !No of pts per row on source grid HIBLSM1A.64
INTEGER LEN_FIELD_OUT !No of points on target grid HIBLSM1A.65
REAL RMDI !real missing data indicator HIBLSM1A.66
HIBLSM1A.67
! Array arguments with intent(in): HIBLSM1A.68
INTEGER INDEX_B_L(LEN_FIELD_OUT) HIBLSM1A.69
!Index of bottom lefthand corner HIBLSM1A.70
! of source gridbox HIBLSM1A.71
INTEGER INDEX_B_R(LEN_FIELD_OUT) HIBLSM1A.72
!Index of bottom righthand corner HIBLSM1A.73
! of source gridbox HIBLSM1A.74
REAL DATA_IN(ROWS_IN*ROW_LENGTH_IN) HIBLSM1A.75
!Data before interpolation HIBLSM1A.76
REAL WEIGHT_B_L(LEN_FIELD_OUT) HIBLSM1A.77
!Weight applied to value at bottom HIBLSM1A.78
!lefthand corner of source gridbox HIBLSM1A.79
REAL WEIGHT_B_R(LEN_FIELD_OUT) HIBLSM1A.80
!Weight applied to value at bottom HIBLSM1A.81
!righthand corner of source gridbox HIBLSM1A.82
REAL WEIGHT_T_L(LEN_FIELD_OUT) HIBLSM1A.83
!Weight applied to value at top HIBLSM1A.84
!lefthand corner of source gridbox HIBLSM1A.85
REAL WEIGHT_T_R(LEN_FIELD_OUT) HIBLSM1A.86
!Weight applied to value at top HIBLSM1A.87
!righthand corner of source gridbox HIBLSM1A.88
INTEGER LSMO(LEN_FIELD_OUT) HIBLSM1A.89
!Ocean land sea mask HIBLSM1A.90
HIBLSM1A.91
! Array arguments with intent(out): HIBLSM1A.92
REAL DATA_OUT(LEN_FIELD_OUT) !Data after interpolation HIBLSM1A.93
HIBLSM1A.94
! Local scalars: HIBLSM1A.95
INTEGER I HIBLSM1A.96
HIBLSM1A.97
! Function & Subroutine calls: HIBLSM1A.98
! External None HIBLSM1A.99
HIBLSM1A.100
!- End of header HIBLSM1A.101
HIBLSM1A.102
! 1. Carry out horizontal interpolation using equation (2.1) HIBLSM1A.103
HIBLSM1A.104
DO I=1,LEN_FIELD_OUT HIBLSM1A.105
HIBLSM1A.106
IF ( DATA_IN(INDEX_B_L(I)) .EQ. RMDI .OR. HIBLSM1A.107
& DATA_IN(INDEX_B_R(I)) .EQ. RMDI .OR. HIBLSM1A.108
& DATA_IN(INDEX_B_L(I)-ROW_LENGTH_IN) .EQ. RMDI .OR. HIBLSM1A.109
& DATA_IN(INDEX_B_R(I)-ROW_LENGTH_IN) .EQ. RMDI .OR. HIBLSM1A.110
& LSMO(I) .EQ. 1 ) THEN HIBLSM1A.111
HIBLSM1A.112
DATA_OUT(I)=RMDI HIBLSM1A.113
HIBLSM1A.114
ELSE HIBLSM1A.115
HIBLSM1A.116
DATA_OUT(I)=WEIGHT_B_L(I)*DATA_IN(INDEX_B_L(I)) HIBLSM1A.117
& +WEIGHT_B_R(I)*DATA_IN(INDEX_B_R(I)) HIBLSM1A.118
& +WEIGHT_T_L(I)*DATA_IN(INDEX_B_L(I)-ROW_LENGTH_IN) HIBLSM1A.119
& +WEIGHT_T_R(I)*DATA_IN(INDEX_B_R(I)-ROW_LENGTH_IN) HIBLSM1A.120
HIBLSM1A.121
END IF HIBLSM1A.122
HIBLSM1A.123
END DO HIBLSM1A.124
HIBLSM1A.125
RETURN HIBLSM1A.126
END HIBLSM1A.127
HIBLSM1A.128
*ENDIF HIBLSM1A.129