*IF DEF,FLUXPROC FPTIME1.2
C ******************************COPYRIGHT****************************** FPTIME1.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPTIME1.4
C FPTIME1.5
C Use, duplication or disclosure of this code is subject to the FPTIME1.6
C restrictions as set forth in the contract. FPTIME1.7
C FPTIME1.8
C Meteorological Office FPTIME1.9
C London Road FPTIME1.10
C BRACKNELL FPTIME1.11
C Berkshire UK FPTIME1.12
C RG12 2SZ FPTIME1.13
C FPTIME1.14
C If no contract has been raised with this copy of the code, the use, FPTIME1.15
C duplication or disclosure of it is strictly prohibited. Permission FPTIME1.16
C to do so must first be obtained in writing from the Head of Numerical FPTIME1.17
C Modelling at the above address. FPTIME1.18
C ******************************COPYRIGHT****************************** FPTIME1.19
C FPTIME1.20
C Programming standard: Unified Model Documentation Paper No 3 FPTIME1.21
C Version No 1 15/1/90 FPTIME1.22
C History: FPTIME1.23
C version date change FPTIME1.24
C 4.5 03/09/98 New code FPTIME1.25
C FPTIME1.26
! Author: M. J. Bell FPTIME1.27
!---------------------------------------------------------------------- FPTIME1.28
! contains routines: add_hours,amend_times FPTIME1.29
! FPTIME1.30
! Purpose: Flux processing routines. FPTIME1.31
! add_hours adds an input number of hours FPTIME1.32
! to an input date/time (called Clim1) FPTIME1.33
! to produce an output date/time (called Valid). FPTIME1.34
! amend_times amends date information in Int_Head. FPTIME1.35
!---------------------------------------------------------------------- FPTIME1.36
subroutine add_hours( 17,2FPTIME1.37
*CALL ACLM1TIM
FPTIME1.38
*CALL AVALTIM
FPTIME1.39
# IAddHrs ) FPTIME1.40
FPTIME1.41
implicit none FPTIME1.42
FPTIME1.43
! declaration of argument list FPTIME1.44
FPTIME1.45
! input time: intent IN FPTIME1.46
*CALL CCLM1TIM
FPTIME1.47
! output time: intent OUT FPTIME1.48
*CALL CVALTIM
FPTIME1.49
FPTIME1.50
integer IAddHrs ! number of hours to add to input time FPTIME1.51
FPTIME1.52
! no parameters, globals or local arrays used FPTIME1.53
FPTIME1.54
! declaration of local scalars FPTIME1.55
integer CDay ! century day (of input) FPTIME1.56
integer CHour ! century-hour FPTIME1.57
integer New_CHour ! new century-hour (after adding input hours) FPTIME1.58
integer New_CDay ! new century day FPTIME1.59
FPTIME1.60
external date31, date13 FPTIME1.61
FPTIME1.62
!---------------------------------------------------------------------- FPTIME1.63
FPTIME1.64
! 1. Convert the input date to century-day FPTIME1.65
call date31
(Clim1Day, Clim1Month, Clim1Year,CDay) FPTIME1.66
FPTIME1.67
! 2. Calculate century-hour FPTIME1.68
CHour = (CDay-1)*24 + Clim1Hour FPTIME1.69
FPTIME1.70
! 3. Calculate new century-hour FPTIME1.71
New_CHour = CHour + IAddHrs FPTIME1.72
FPTIME1.73
! 4. Calculate new century-day FPTIME1.74
New_CDay = 1 + New_Chour/24 FPTIME1.75
FPTIME1.76
! 5. Convert new century-day to new date FPTIME1.77
call date13
(New_CDay,ValidDay,ValidMonth,ValidYear) FPTIME1.78
FPTIME1.79
! 6. Convert rest of values FPTIME1.80
ValidHour = New_CHour - 24 * (New_CDay - 1) FPTIME1.81
ValidMin = Clim1Min FPTIME1.82
ValidSec = Clim1Sec FPTIME1.83
FPTIME1.84
return FPTIME1.85
end FPTIME1.86
!---------------------------------------------------------------------- FPTIME1.87
subroutine amend_times ( 9,1FPTIME1.88
*CALL AVALTIM
FPTIME1.89
# Int_head,Len_IntHd ) FPTIME1.90
FPTIME1.91
implicit none FPTIME1.92
FPTIME1.93
! declaration of parameters FPTIME1.94
*CALL CLOOKADD
FPTIME1.95
FPTIME1.96
! declaration of globals used FPTIME1.97
*CALL CVALTIM
FPTIME1.98
*CALL CVALOFF
FPTIME1.99
FPTIME1.100
! declaration of argument list FPTIME1.101
integer Len_IntHd FPTIME1.102
integer Int_Head(Len_IntHd) ! IN/OUT integer part of lookup table FPTIME1.103
FPTIME1.104
! declarations for validity time FPTIME1.105
FPTIME1.106
integer IAddHrs ! used to find validity time FPTIME1.107
integer Year1 ! First year in header FPTIME1.108
integer Month1 ! First Month in header FPTIME1.109
integer Day1 ! First Day in header FPTIME1.110
integer Hour1 ! First Hour in header FPTIME1.111
integer Min1 ! Always equal to zero FPTIME1.112
integer Sec1 ! Always equal to zero FPTIME1.113
FPTIME1.114
! no other variables used FPTIME1.115
FPTIME1.116
! declaration of externals FPTIME1.117
external add_hours FPTIME1.118
!---------------------------------------------------------------------- FPTIME1.119
FPTIME1.120
! 1. Set the second time in header FPTIME1.121
Int_Head(LBYRD) = ValidYear FPTIME1.122
Int_Head(LBMOND) = ValidMonth FPTIME1.123
Int_Head(LBDATD) = ValidDay FPTIME1.124
Int_Head(LBHRD) = ValidHour FPTIME1.125
FPTIME1.126
! 2. Set the first time in header FPTIME1.127
FPTIME1.128
IAddHrs = 0 - ValidityPeriod FPTIME1.129
FPTIME1.130
call add_hours
( FPTIME1.131
*CALL AVALTIM
FPTIME1.132
# Year1,Month1,Day1,Hour1,Min1,Sec1, FPTIME1.133
# IAddHrs ) FPTIME1.134
FPTIME1.135
Int_Head(LBYR) = Year1 FPTIME1.136
Int_Head(LBMON) = Month1 FPTIME1.137
Int_Head(LBDAT) = Day1 FPTIME1.138
Int_Head(LBHR) = Hour1 FPTIME1.139
FPTIME1.140
return FPTIME1.141
end FPTIME1.142
!---------------------------------------------------------------------- FPTIME1.143
*ENDIF FPTIME1.144