*IF DEF,C92_1A TINTC1A.2
C ******************************COPYRIGHT****************************** GTS2F400.10441
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10442
C GTS2F400.10443
C Use, duplication or disclosure of this code is subject to the GTS2F400.10444
C restrictions as set forth in the contract. GTS2F400.10445
C GTS2F400.10446
C Meteorological Office GTS2F400.10447
C London Road GTS2F400.10448
C BRACKNELL GTS2F400.10449
C Berkshire UK GTS2F400.10450
C RG12 2SZ GTS2F400.10451
C GTS2F400.10452
C If no contract has been raised with this copy of the code, the use, GTS2F400.10453
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10454
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10455
C Modelling at the above address. GTS2F400.10456
C ******************************COPYRIGHT****************************** GTS2F400.10457
C GTS2F400.10458
CLL SUBROUTINE T_INT_C------------------------------------------------- TINTC1A.3
CLL TINTC1A.4
CLL Purpose: TINTC1A.5
CLL Carries out linear interpolation in time between two fields at TINTC1A.6
CLL times T1 and T2. If the missing data indicator is present at one TINTC1A.7
CLL of the times, the value at the other time is used. The interpolat TINTC1A.8
CLL is controlled by a field ZI. A prescribed value is inserted where TINTC1A.9
CLL If ZI changes between 0 and non-zero in the period T1 - T2, then TINTC1A.10
CLL the field is linearly interpolated between its value at the time TINTC1A.11
CLL ZI is non-zero and the prescibed value at the time when ZI become TINTC1A.12
CLL The fractional time at which ZI changes between 0 and non-zero in TINTC1A.13
CLL period T1 - T2 must be provided as input. TINTC1A.14
CLL TINTC1A.15
CLL Written by A. Dickinson 30/03/90 TINTC1A.16
CLL TINTC1A.17
CLL Model Modification history from model version 3.0: TINTC1A.18
CLL version date TINTC1A.19
CLL 3.2 17/03/93 : Correct for rounding problem, ie case where alpha RS170393.1
CLL should be exactly equal to frac_time. RS170393.2
CLL Author: R.A Stratton RS170393.3
CLL TINTC1A.20
CLL Programming standard: Unified Model Documentation Paper No 3 TINTC1A.21
CLL Version No 1 15/1/90 TINTC1A.22
CLL TINTC1A.23
CLL System component:S191 TINTC1A.24
CLL TINTC1A.25
CLL System task: S1 TINTC1A.26
CLL TINTC1A.27
CLL Documentation: The interpolation formulae are described in TINTC1A.28
CLL unified model on-line documentation paper S1. TINTC1A.29
CLL TINTC1A.30
CLL ------------------------------------------------------------------- TINTC1A.31
C*L Arguments:--------------------------------------------------------- TINTC1A.32
TINTC1A.33
SUBROUTINE T_INT_C(DATA_T1,T1,DATA_T2,T2,DATA_T3,T3,POINTS 4,1TINTC1A.34
*,FRAC_TIME,ZI_T1,PRES_VALUE) TINTC1A.35
TINTC1A.36
IMPLICIT NONE TINTC1A.37
TINTC1A.38
INTEGER TINTC1A.39
* POINTS !IN No of points to be processed TINTC1A.40
TINTC1A.41
REAL TINTC1A.42
* DATA_T1(POINTS) !IN Data at T1 TINTC1A.43
*,DATA_T2(POINTS) !IN Data at T2 TINTC1A.44
*,DATA_T3(POINTS) !OUT D_ta at T3 TINTC1A.45
*,ZI_T1(POINTS) !IN Value of controlling fieled at T1 TINTC1A.46
*,PRES_VALUE(POINTS) !IN Prescribed value of Data when ZI=0 TINTC1A.47
*,FRAC_TIME(POINTS) !IN Fractional time at which ZI changes betwee TINTC1A.48
* !zero and non-zero in this time range TINTC1A.49
*,T1 !IN Time of first data field TINTC1A.50
*,T2 !In Time of second data field TINTC1A.51
*,T3 !IN Time at which new field is required T1<=T3<=T2 TINTC1A.52
TINTC1A.53
TINTC1A.54
C Local arrays:--------------------------------------------------------- TINTC1A.55
REAL INT_TIME(POINTS) TINTC1A.56
C ---------------------------------------------------------------------- TINTC1A.57
C*L External subroutines called:---------------------------------------- TINTC1A.58
EXTERNAL T_INT TINTC1A.59
C*---------------------------------------------------------------------- TINTC1A.60
C Local variables:------------------------------------------------------ TINTC1A.61
REAL TINTC1A.62
* ALPHA !Fractional time TINTC1A.63
*,EPSILON ! rounding error RS170393.4
*,ALPHA_PLUS ! add rounding error to alpha RS170393.5
*,ALPHA_MINUS ! alpha minus rounding error RS170393.6
TINTC1A.64
INTEGER TINTC1A.65
* I !Loop index TINTC1A.66
C ---------------------------------------------------------------------- TINTC1A.67
*CALL C_MDI 
TINTC1A.68
TINTC1A.69
C set rounding error RS170393.7
EPSILON=1.0E-6 RS170393.8
TINTC1A.70
CALL T_INT(DATA_T1,T1,DATA_T2,T2,DATA_T3,T3,POINTS) TINTC1A.71
TINTC1A.72
ALPHA=(T3-T1)/(T2-T1) TINTC1A.73
ALPHA_PLUS=ALPHA+EPSILON RS170393.9
ALPHA_MINUS=ALPHA-EPSILON RS170393.10
TINTC1A.74
DO 100 I=1,POINTS TINTC1A.75
TINTC1A.76
IF(FRAC_TIME(I).NE.RMDI)THEN TINTC1A.77
IF(ZI_T1(I).EQ.0.0)THEN TINTC1A.78
IF(ALPHA_MINUS.LT.FRAC_TIME(I))THEN RS170393.11
DATA_T3(I)=PRES_VALUE(I) TINTC1A.80
ELSE TINTC1A.81
INT_TIME(I)=(ALPHA-FRAC_TIME(I))/(1.-FRAC_TIME(I)) TINTC1A.82
DATA_T3(I)=PRES_VALUE(I)*(1.-INT_TIME(I)) TINTC1A.83
* +DATA_T2(I)*INT_TIME(I) TINTC1A.84
ENDIF TINTC1A.85
ELSE TINTC1A.86
IF(ALPHA_PLUS.GT.FRAC_TIME(I))THEN RS170393.12
DATA_T3(I)=PRES_VALUE(I) TINTC1A.88
ELSE TINTC1A.89
INT_TIME(I)=(FRAC_TIME(I)-ALPHA)/(FRAC_TIME(I)) TINTC1A.90
DATA_T3(I)=PRES_VALUE(I)*(1.-INT_TIME(I)) TINTC1A.91
* +DATA_T1(I)*INT_TIME(I) TINTC1A.92
ENDIF TINTC1A.93
ENDIF TINTC1A.94
ENDIF TINTC1A.95
TINTC1A.96
100 CONTINUE TINTC1A.97
TINTC1A.98
TINTC1A.99
TINTC1A.100
TINTC1A.101
RETURN TINTC1A.102
END TINTC1A.103
TINTC1A.104
*ENDIF TINTC1A.105