*IF DEF,FLUXPROC FPINTPT1.2
C ******************************COPYRIGHT****************************** FPINTPT1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPINTPT1.4
C FPINTPT1.5
C Use, duplication or disclosure of this code is subject to the FPINTPT1.6
C restrictions as set forth in the contract. FPINTPT1.7
C FPINTPT1.8
C Meteorological Office FPINTPT1.9
C London Road FPINTPT1.10
C BRACKNELL FPINTPT1.11
C Berkshire UK FPINTPT1.12
C RG12 2SZ FPINTPT1.13
C FPINTPT1.14
C If no contract has been raised with this copy of the code, the use, FPINTPT1.15
C duplication or disclosure of it is strictly prohibited. Permission FPINTPT1.16
C to do so must first be obtained in writing from the Head of Numerical FPINTPT1.17
C Modelling at the above address. FPINTPT1.18
C ******************************COPYRIGHT****************************** FPINTPT1.19
C FPINTPT1.20
C Programming standard: Unified Model Documentation Paper No 3 FPINTPT1.21
C Version No 1 15/1/90 FPINTPT1.22
C History: FPINTPT1.23
C version date change FPINTPT1.24
C 4.5 03/09/98 New code FPINTPT1.25
C FPINTPT1.26
! Author: M. J. Bell FPINTPT1.27
!---------------------------------------------------------------------- FPINTPT1.28
! contains routines: interp_time FPINTPT1.29
! FPINTPT1.30
! Purpose: Flux processing routine. FPINTPT1.31
! Sets fieldout = field1 * weight1 + field2 * weight2 FPINTPT1.32
! and changes date in lookup table to that of FPINTPT1.33
! validity time input FPINTPT1.34
!---------------------------------------------------------------------- FPINTPT1.35
subroutine interp_time(Int_Head, ncols, nrows, rmdi, 1FPINTPT1.36
*CALL AVALTIM 
FPINTPT1.37
# weight1, weight2, Field1, Field2, FieldOut) FPINTPT1.38
FPINTPT1.39
implicit none FPINTPT1.40
FPINTPT1.41
! declaration of parameters FPINTPT1.42
*CALL CLOOKADD FPINTPT1.43
*CALL PLOOKUPS FPINTPT1.44
FPINTPT1.45
! declaration of argument list FPINTPT1.46
integer Int_Head(Len_IntHd) ! IN/OUT date is changed FPINTPT1.47
integer ncols ! IN number of columns FPINTPT1.48
integer nrows ! IN number of rows FPINTPT1.49
real rmdi ! IN real missing data indicator FPINTPT1.50
! validity time to insert in Lookup table: intent IN FPINTPT1.51
*CALL CVALTIM FPINTPT1.52
real weight1 ! IN weight to give to 1st climate field FPINTPT1.53
real weight2 ! IN weight to give to 2nd climate field FPINTPT1.54
real Field1(ncols,nrows) ! IN 1st field FPINTPT1.55
real Field2(ncols,nrows) ! IN 2nd field FPINTPT1.56
real FieldOut(ncols,nrows) ! OUT interpolated field FPINTPT1.57
FPINTPT1.58
! declaration of local scalars FPINTPT1.59
integer jrow ! row number FPINTPT1.60
integer icol ! column number FPINTPT1.61
!---------------------------------------------------------------------- FPINTPT1.62
FPINTPT1.63
! 1. do time interpolation FPINTPT1.64
FPINTPT1.65
do jrow = 1, nrows FPINTPT1.66
do icol = 1, ncols FPINTPT1.67
if ( Field1 (icol, jrow) .ne. rmdi .and. FPINTPT1.68
# Field2 (icol, jrow) .ne. rmdi ) then FPINTPT1.69
FPINTPT1.70
FieldOut (icol, jrow) = weight1 * Field1 (icol, jrow) FPINTPT1.71
# + weight2 * Field2 (icol, jrow) FPINTPT1.72
FPINTPT1.73
else FPINTPT1.74
FieldOut (icol, jrow) = rmdi FPINTPT1.75
FPINTPT1.76
end if FPINTPT1.77
end do ! icol FPINTPT1.78
end do ! jrow FPINTPT1.79
FPINTPT1.80
! 2. set validity time in integer lookup table FPINTPT1.81
FPINTPT1.82
Int_Head(LBYR) = ValidYear FPINTPT1.83
Int_Head(LBMON) = ValidMonth FPINTPT1.84
Int_Head(LBDAT) = ValidDay FPINTPT1.85
Int_Head(LBHR) = ValidHour FPINTPT1.86
Int_Head(LBMIN) = ValidMin FPINTPT1.87
FPINTPT1.88
return FPINTPT1.89
end FPINTPT1.90
!---------------------------------------------------------------------- FPINTPT1.91
*ENDIF FPINTPT1.92