NCEPLIBS-prod_util  2.1.0
nhour.f
Go to the documentation of this file.
1 C> @file
2 C> COMPUTE FORECAST HOUR
3 C> @author IREDELL @date 1998-08-18
4 C>
5 C> PROGRAM TO COMPUTE FORECAST HOUR
6 C> GIVEN THE VERIFYING DATE AND THE INITIAL DATE.
7 C>
8 C> PROGRAM HISTORY LOG:
9 C> - 95-02-28 IREDELL
10 C> - 97-09-22 IREDELL 4-DIGIT YEAR ALLOWED; 2-DIGIT YEAR STANDARDIZED
11 C> - 98-03-25 IREDELL 4-DIGIT YEAR FOR ALL DATES. A 2-DIGIT YEAR WILL
12 C> BE INTERPRETED AS A YEAR IN THE FIRST CENTURY
13 C> WHICH SHOULD BE ALL RIGHT BEFORE THE YEAR 2000.
14 C> STANDARD ERROR WARNINGS WILL BE GIVEN FOR SUCH
15 C> DATES UNTIL 1 SEPT 1998 AFTER WHICH NHOUR ABORTS.
16 C> THE NEW Y2K-COMPLIANT W3LIB PACKAGE IS USED.
17 C> - 1998-08-17 IREDELL DROP-DEAD DATE RESET TO 1 SEPT 1999
18 C> - 1999-04-22 Gilbert Changed subroutine EXIT(N) to ERREXIT(N) so that
19 C> error return values are passed back to the shell
20 C> properly.
21 C> - 1999-09-02 IREDELL STANDARDIZED 4-DIGIT YEAR AS IN NDATE
22 C>
23 C> USAGE: nhour vdate [idate]
24 C> INPUT ARGUMENT LIST:
25 C> - VDATE - VERIFYING DATE IN YYYYMMDDHH FORMAT.
26 C> - IDATE - INITIAL DATE IN YYYYMMDDHH FORMAT.
27 C> IDATE DEFAULTS TO THE UTC DATE AND HOUR.
28 C> OUTPUT ARGUMENT LIST:
29 C> - NHOUR - FORECAST HOUR
30 C> LEADING ZEROES ADDED TO MAKE IT AT LEAST TWO DIGITS.
31 C> LEADING MINUS SIGN ADDED IF IDATE COMES AFTER VDATE.
32 C> EXIT STATES:
33 C> - 0 - SUCCESS
34 C> - 1 - FAILURE; INVALID ARGUMENT
35 C> - 2 - FAILURE; INCORRECT NUMBER OF ARGUMENTS
36 C>
37 C> SUBPROGRAMS CALLED:
38 C> - IARGC GET NUMBER OF ARGUMENTS
39 C> - GETARG GET ARGUMENT
40 C> - W3DIFDAT RETURN A TIME INTERVAL BETWEEN TWO DATES
41 C> - W3PRADAT FORMAT A DATE AND TIME INTO CHARACTERS
42 C> - W3UTCDAT RETURN THE UTC DATE AND TIME
43 C> - ERRMSG WRITE A MESSAGE TO STDERR
44 C> - ERREXIT EXIT PROGRAM
45 C>
46  PROGRAM nhour
47  CHARACTER*256 CARG,CFMT
48  INTEGER IDAT(8),JDAT(8)
49  REAL RINC(5)
50  LOGICAL W3VALDAT
51 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
52 C CHECK NUMBER OF ARGUMENTS
53  narg=iargc()
54  IF(narg.LT.1.OR.narg.GT.2) THEN
55  CALL errmsg('nhour: Incorrect number of arguments')
56  CALL eusage
57  CALL errexit(2)
58  ENDIF
59 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60 C GET AND CHECK FIRST ARGUMENT (VERIFYING DATE)
61  CALL getarg(1,carg)
62  ncarg=len_trim(carg)
63  WRITE(cfmt,'("(I",I2,",3I2)")') ncarg-6
64  jdat=0
65  READ(carg,cfmt,iostat=iret) jdat(1),jdat(2),jdat(3),jdat(5)
66  IF(iret.NE.0.OR..NOT.w3valdat(jdat)) THEN
67  CALL errmsg('nhour: Invalid date '//carg(1:ncarg))
68  CALL eusage
69  CALL errexit(1)
70  ENDIF
71 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72 C GET AND CHECK SECOND ARGUMENT (INITIAL DATE)
73  IF(narg.GE.2) THEN
74  CALL getarg(2,carg)
75  ncarg=len_trim(carg)
76  WRITE(cfmt,'("(I",I2,",3I2)")') ncarg-6
77  idat=0
78  READ(carg,cfmt,iostat=iret) idat(1),idat(2),idat(3),idat(5)
79  IF(iret.NE.0.OR..NOT.w3valdat(idat)) THEN
80  CALL errmsg('nhour: Invalid date '//carg(1:ncarg))
81  CALL eusage
82  CALL errexit(1)
83  ENDIF
84  ELSE
85  CALL w3utcdat(idat)
86  ENDIF
87 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
88 C COMPUTE AND PRINT HOUR DIFFERENCE
89  CALL w3difdat(jdat,idat,2,rinc)
90  ihour=nint(rinc(2))
91  ndig=log10(abs(ihour)+0.5)+1
92  ndig=max(ndig,2)
93  IF(ihour.LT.0) ndig=ndig+1
94  WRITE(cfmt,'("(I",I2,".2)")') ndig
95  print cfmt,ihour
96 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
97  CONTAINS
98 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99 C WRITE USAGE
100  SUBROUTINE eusage
101  CALL errmsg('Usage: nhour vdate [idate]')
102  ENDSUBROUTINE
103 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
104  ENDPROGRAM