*IF DEF,RECON GRIB_FC1.2
C ******************************COPYRIGHT****************************** GTS2F400.3457
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3458
C GTS2F400.3459
C Use, duplication or disclosure of this code is subject to the GTS2F400.3460
C restrictions as set forth in the contract. GTS2F400.3461
C GTS2F400.3462
C Meteorological Office GTS2F400.3463
C London Road GTS2F400.3464
C BRACKNELL GTS2F400.3465
C Berkshire UK GTS2F400.3466
C RG12 2SZ GTS2F400.3467
C GTS2F400.3468
C If no contract has been raised with this copy of the code, the use, GTS2F400.3469
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3470
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3471
C Modelling at the above address. GTS2F400.3472
C ******************************COPYRIGHT****************************** GTS2F400.3473
C GTS2F400.3474
CLL SUBROUTINE GRIB_FC_TIME GRIB_FC1.3
CLL GRIB_FC1.4
CLL Purpose: GRIB_FC1.5
CLL Calculates forecast time from expanded GRIB header. GRIB_FC1.6
CLL Code reworked from ECMWF MAGICS library routine. GRIB_FC1.7
CLL Note that this code will only work for forecast time GRIB_FC1.8
CLL units of hours or days. GRIB_FC1.9
CLL GRIB_FC1.10
CLL Written by A. Dickinson 20/06/91 GRIB_FC1.11
CLL GRIB_FC1.12
CLL Model Modification history from model version 3.0: GRIB_FC1.13
CLL version date GRIB_FC1.14
! 4.0 08/02/95 Alteration to use centrally maintained GRIB UDG3F400.176
! decoding routine DECODE. Replacing IB1PAR with UDG3F400.177
! BLOCK1 UDG3F400.178
! Author: D.M. Goddard Reviewer: D. Robinson UDG3F400.179
! 4.5 09/01/98 Correction for year 2K. GDG0F405.1
! Author D.M. Goddard GDG0F405.2
CLL GRIB_FC1.15
CLL Documentation: GRIB_FC1.16
CLL ECMWF MARS manual GRIB_FC1.17
CLL Unified Model Documentation Paper S1 GRIB_FC1.18
CLL GRIB_FC1.19
CLL------------------------------------------------------------- GRIB_FC1.20
C*L Arguments:-------------------------------------------------- GRIB_FC1.21
SUBROUTINE GRIB_FC_TIME(BLOCK1,IMN,IHR,IDD,IMM,IYY) 1,1UDG3F400.180
GRIB_FC1.23
implicit none GRIB_FC1.24
GRIB_FC1.25
*CALL TYPGRIB 
!IN BLOCK1 1st grib header converted to integers UDG3F400.181
UDG3F400.182
integer GRIB_FC1.26
& ib1par(18) !IN 1st grib header converted to integers GRIB_FC1.27
&,imn !OUT fc minute GRIB_FC1.28
&,ihr !OUT fc hour GRIB_FC1.29
&,idd !OUT fc day GRIB_FC1.30
&,imm !OUT fc month GRIB_FC1.31
&,iyy !OUT fc year GRIB_FC1.32
GRIB_FC1.33
integer GRIB_FC1.34
& istep ! step GRIB_FC1.35
&,itu ! time unit indicator (hrs=1,days=2) GRIB_FC1.36
&,kday ! step converted to days GRIB_FC1.37
&,lday ! no of 6hr periods in istep GRIB_FC1.38
&,isub ! no of days in month GRIB_FC1.39
&,ileap ! leap year indicator GRIB_FC1.40
&,ll ! excess no of 6hr periods in lday GRIB_FC1.41
GRIB_FC1.42
C--------------------------------------------------------------- GRIB_FC1.43
C Dynamic array workspace usage:-------------------------------- GRIB_FC1.44
C NONE GRIB_FC1.45
C--------------------------------------------------------------- GRIB_FC1.46
C--------------------------------------------------------------- GRIB_FC1.47
C External subroutines called:---------------------------------- GRIB_FC1.48
C NONE GRIB_FC1.49
C* ------------------------------------------------------------- GRIB_FC1.50
GRIB_FC1.51
C Initialise time variables GRIB_FC1.52
ISTEP=BLOCK1(15) UDG3F400.183
IYY=BLOCK1(9)+(BLOCK1(19)-1)*100 GDG0F405.3
IMM=BLOCK1(10) UDG3F400.185
IDD=BLOCK1(11) UDG3F400.186
IHR=BLOCK1(12) UDG3F400.187
IMN=BLOCK1(13) UDG3F400.188
ITU=BLOCK1(14) UDG3F400.189
GRIB_FC1.60
C Time units of hours or days handled only GRIB_FC1.61
if(itu.gt.2.or.itu.lt.1)then GRIB_FC1.62
write(6,*)'Value of time unit in GRIB header not handled',itu GRIB_FC1.63
call abort GRIB_FC1.64
endif GRIB_FC1.65
GRIB_FC1.66
C Forecast hour GRIB_FC1.67
if (itu .eq. 40) itu = 1 GRIB_FC1.68
if (itu .eq. 1) then GRIB_FC1.69
ihr = ihr + mod(istep,24) GRIB_FC1.70
if (ihr .ge. 24) ihr = ihr - 24 GRIB_FC1.71
end if GRIB_FC1.72
GRIB_FC1.73
c If forecast day > 0 then increase step counter GRIB_FC1.74
kday=istep GRIB_FC1.75
if (itu .eq. 1) then GRIB_FC1.76
if (istep .ge. 6) then GRIB_FC1.77
kday = istep / 24 GRIB_FC1.78
lday = istep / 6 GRIB_FC1.79
ll = mod(lday,4) GRIB_FC1.80
if (ihr .eq. 6) then GRIB_FC1.81
if (ll .eq. 3) kday = kday + 1 GRIB_FC1.82
else if (ihr .eq. 12) then GRIB_FC1.83
if ((ll .eq. 2) .or. (ll .eq. 3)) kday = kday + 1 GRIB_FC1.84
else if (ihr .eq. 18) then GRIB_FC1.85
if (ll .ne. 0) kday = kday + 1 GRIB_FC1.86
end if GRIB_FC1.87
end if GRIB_FC1.88
end if GRIB_FC1.89
GRIB_FC1.90
c Calculate forecast date: isub indicates no of days in month GRIB_FC1.91
isub = 31 GRIB_FC1.92
ileap = 0 GRIB_FC1.93
if (imm .eq. 2) then GRIB_FC1.94
isub = 28 GRIB_FC1.95
if (mod(iyy,4) .eq. 0) then GRIB_FC1.96
ileap = 1 GRIB_FC1.97
isub = 29 GRIB_FC1.98
end if GRIB_FC1.99
end if GRIB_FC1.100
if ((((imm .eq. 4) .or. (imm .eq. 6)) .or. (imm .eq. 9)) .or. (imm GRIB_FC1.101
& .eq. 11)) isub = 30 GRIB_FC1.102
idd = idd + kday GRIB_FC1.103
if (idd .gt. 31) then GRIB_FC1.104
idd = idd - isub GRIB_FC1.105
imm = imm + 1 GRIB_FC1.106
if (imm .eq. 13) then GRIB_FC1.107
imm = 1 GRIB_FC1.108
iyy = iyy + 1 GRIB_FC1.109
end if GRIB_FC1.110
else if ((idd .eq. 31) .and. ((((imm .eq. 4) .or. (imm .eq. 6)) GRIB_FC1.111
& .or. (imm .eq. 9)) .or. (imm .eq. 11))) then GRIB_FC1.112
idd = 1 GRIB_FC1.113
imm = imm + 1 GRIB_FC1.114
else if (((idd .gt. 28) .and. (imm .eq. 2)) .and. (ileap .eq. 0) GRIB_FC1.115
&) then GRIB_FC1.116
idd = idd - isub GRIB_FC1.117
imm = 3 GRIB_FC1.118
else if (((idd .gt. 29) .and. (imm .eq. 2)) .and. (ileap .eq. 1) GRIB_FC1.119
&) then GRIB_FC1.120
idd = idd - isub GRIB_FC1.121
imm = 3 GRIB_FC1.122
end if GRIB_FC1.123
GRIB_FC1.124
return GRIB_FC1.125
end GRIB_FC1.126
*ENDIF GRIB_FC1.127