NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
igettdi.f
Go to the documentation of this file.
1 C> @file
2 C> @author ATOR @date 2009-03-23
3 
4 C> DEPENDING ON THE VALUE OF THE INPUT FLAG, THIS FUNCTION
5 C> EITHER RETURNS THE NEXT USABLE SCRATCH TABLE D INDEX FOR THE
6 C> CURRENT MASTER TABLE OR ELSE RESETS THE INDEX BACK TO ITS
7 C> MINIMUM VALUE.
8 C>
9 C> PROGRAM HISTORY LOG:
10 C> 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
11 C>
12 C> USAGE: IGETTDI ( IFLAG )
13 C> INPUT ARGUMENT LIST:
14 C> IFLAG - INTEGER: FLAG: IF SET TO 0, THEN THE FUNCTION WILL
15 C> RESET THE SCRATCH TABLE D INDEX BACK TO ITS MINIMUM
16 C> VALUE; OTHERWISE, IT WILL RETURN THE NEXT USABLE
17 C> SCRATCH TABLE D INDEX FOR THE CURRENT MASTER TABLE
18 C>
19 C> OUTPUT ARGUMENT LIST:
20 C> IGETTDI - INTEGER: NEXT USABLE SCRATCH TABLE D INDEX FOR THE
21 C> CURRENT MASTER TABLE
22 C> -1 = FUNCTION WAS CALLED WITH IFLAG=0
23 C>
24 C> REMARKS:
25 C> THIS ROUTINE CALLS: BORT
26 C> THIS ROUTINE IS CALLED BY: READS3 STSEQ
27 C> Not normally called by application
28 C> programs.
29 C>
30  FUNCTION igettdi ( IFLAG )
31 
32 
33 
34  parameter( idxmin = 62976 )
35 C* = IFXY('354000')
36 
37  parameter( idxmax = 63231 )
38 C* = IFXY('354255')
39 
40  character*128 bort_str
41 
42  SAVE idx
43 
44 C-----------------------------------------------------------------------
45 C-----------------------------------------------------------------------
46 
47  IF ( iflag .EQ. 0 ) THEN
48 
49 C* Initialize the index to one less than the actual minimum
50 C* value. That way, the next normal call will return the
51 C* minimum value.
52 
53  idx = idxmin - 1
54  igettdi = -1
55  ELSE
56  idx = idx + 1
57  IF ( idx .GT. idxmax ) goto 900
58  igettdi = idx
59  ENDIF
60 
61  RETURN
62  900 CALL bort('BUFRLIB: IGETTDI - IDXMAX OVERFLOW')
63  END
function igettdi(IFLAG)
DEPENDING ON THE VALUE OF THE INPUT FLAG, THIS FUNCTION EITHER RETURNS THE NEXT USABLE SCRATCH TABLE ...
Definition: igettdi.f:30
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23