NCEPLIBS-bufr  11.5.0
 All Data Structures Files Functions Variables Pages
lstjpb.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS FUNCTION SEARCHES BACKWARDS, BEGINNING FROM A GIVEN
5 C> NODE WITHIN THE JUMP/LINK TABLE, UNTIL IT FINDS THE MOST RECENT
6 C> NODE OF TYPE JBTYP. THE INTERNAL JMPB ARRAY IS USED TO JUMP
7 C> BACKWARDS WITHIN THE JUMP/LINK TABLE, AND THE FUNCTION RETURNS
8 C> THE TABLE INDEX OF THE FOUND NODE. IF THE INPUT NODE ITSELF IS
9 C> OF TYPE JBTYP, THEN THE FUNCTION SIMPLY RETURNS THE INDEX OF THAT
10 C> SAME NODE.
11 C>
12 C> PROGRAM HISTORY LOG:
13 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
14 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
15 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
16 C> ROUTINE "BORT"
17 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
18 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
19 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
20 C> BUFR FILES UNDER THE MPI)
21 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
22 C> INTERDEPENDENCIES
23 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
24 C> INCREASED FROM 15000 TO 16000 (WAS IN
25 C> VERIFICATION VERSION); UNIFIED/PORTABLE FOR
26 C> WRF; ADDED DOCUMENTATION (INCLUDING
27 C> HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
28 C> INFO WHEN ROUTINE TERMINATES ABNORMALLY
29 C> 2009-03-31 J. WOOLLEN -- ADDED ADDITIONAL DOCUMENTATION
30 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
31 C>
32 C> USAGE: LSTJPB (NODE, LUN, JBTYP)
33 C> INPUT ARGUMENT LIST:
34 C> NODE - INTEGER: JUMP/LINK TABLE INDEX OF ENTRY TO BEGIN
35 C> SEARCHING BACKWARDS FROM
36 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
37 C> JBTYP - CHARACTER*(*): TYPE OF NODE FOR WHICH TO SEARCH
38 C>
39 C> OUTPUT ARGUMENT LIST:
40 C> LSTJPB - INTEGER: INDEX OF FIRST NODE OF TYPE JBTYP FOUND BY
41 C> JUMPING BACKWARDS FROM INPUT NODE
42 C> 0 = NO SUCH NODE FOUND
43 C>
44 C> REMARKS:
45 C>
46 C> SEE THE DOCBLOCK IN BUFR ARCHIVE LIBRARY SUBROUTINE TABSUB FOR AN
47 C> EXPLANATION OF THE VARIOUS NODE TYPES PRESENT WITHIN AN INTERNAL
48 C> JUMP/LINK TABLE
49 C>
50 C> THIS ROUTINE CALLS: BORT
51 C> THIS ROUTINE IS CALLED BY: GETWIN IGETRFEL NEVN NEWWIN
52 C> NXTWIN PARUSR STRBTM TRYBUMP
53 C> UFBRW
54 C> Normally not called by any application
55 C> programs.
56 C>
57  FUNCTION lstjpb(NODE,LUN,JBTYP)
58 
59  USE moda_msgcwd
60  USE moda_tables
61 
62  CHARACTER*(*) jbtyp
63  CHARACTER*128 bort_str
64 
65 C----------------------------------------------------------------------
66 C----------------------------------------------------------------------
67 
68  IF(node.LT.inode(lun)) goto 900
69  IF(node.GT.isc(inode(lun))) goto 901
70 
71  nod = node
72 
73 C FIND THIS OR THE PREVIOUS "JBTYP" NODE
74 C --------------------------------------
75 
76 10 IF(typ(nod).NE.jbtyp) THEN
77  nod = jmpb(nod)
78  IF(nod.NE.0) goto 10
79  ENDIF
80 
81  lstjpb = nod
82 
83 C EXITS
84 C -----
85 
86  RETURN
87 900 WRITE(bort_str,'("BUFRLIB: LSTJPB - TABLE NODE (",I7,") IS OUT '//
88  . 'OF BOUNDS, < LOWER BOUNDS (",I7,"); TAG IS ",A10)')
89  . node,inode(lun),tag(node)
90  CALL bort(bort_str)
91 901 WRITE(bort_str,'("BUFRLIB: LSTJPB - TABLE NODE (",I7,") IS OUT '//
92  . 'OF BOUNDS, > UPPER BOUNDS (",I7,"); TAG IS ",A10)')
93  . node,isc(inode(lun)),tag(node)
94  CALL bort(bort_str)
95  END
function lstjpb(NODE, LUN, JBTYP)
THIS FUNCTION SEARCHES BACKWARDS, BEGINNING FROM A GIVEN NODE WITHIN THE JUMP/LINK TABLE...
Definition: lstjpb.f:57
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:23