FUNCTION LSTRPS(NODE,LUN) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: LSTRPS (docblock incomplete) C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06 C C ABSTRACT: THIS FUNCTION .... C C PROGRAM HISTORY LOG: C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB C ROUTINE "BORT" C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE C OPENED AT ONE TIME INCREASED FROM 10 TO 32 C (NECESSARY IN ORDER TO PROCESS MULTIPLE C BUFR FILES UNDER THE MPI) C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE C INTERDEPENDENCIES C 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES) C INCREASED FROM 15000 TO 16000 (WAS IN C VERIFICATION VERSION); UNIFIED/PORTABLE FOR C WRF; ADDED DOCUMENTATION (INCLUDING C HISTORY) (INCOMPLETE); OUTPUTS MORE C COMPLETE DIAGNOSTIC INFO WHEN ROUTINE C TERMINATES ABNORMALLY C C USAGE: LSTRPS (NODE, LUN) C INPUT ARGUMENT LIST: C NODE - INTEGER: .... C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS C C OUTPUT ARGUMENT LIST: C LSTRPS - INTEGER: .... C C REMARKS: C THIS ROUTINE CALLS: BORT C THIS ROUTINE IS CALLED BY: UFBRW C Normally not called by any application C programs. C C ATTRIBUTES: C LANGUAGE: FORTRAN 77 C MACHINE: PORTABLE TO ALL PLATFORMS C C$$$ INCLUDE 'bufrlib.prm' COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES), . INODE(NFILES),IDATE(NFILES) COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL), . JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL), . IBT(MAXJL),IRF(MAXJL),ISC(MAXJL), . ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL), . ISEQ(MAXJL,2),JSEQ(MAXJL) CHARACTER*128 BORT_STR CHARACTER*10 TAG CHARACTER*3 TYP C---------------------------------------------------------------------- C---------------------------------------------------------------------- IF(NODE.LT.INODE(LUN)) GOTO 900 IF(NODE.GT.ISC(INODE(LUN))) GOTO 901 NOD = NODE C FIND THIS OR THE PREVIOUS RPS NODE C ---------------------------------- 10 IF(TYP(NOD).NE.'RPS') THEN NOD = JMPB(NOD) IF(NOD.NE.0) GOTO 10 ENDIF LSTRPS = NOD C EXITS C ----- RETURN 900 WRITE(BORT_STR,'("BUFRLIB: LSTRPS - TABLE NODE (",I7,") IS OUT '// . 'OF BOUNDS, < LOWER BOUNDS (",I7,"); TAG IS ",A10)') . NODE,INODE(LUN),TAG(NODE) CALL BORT(BORT_STR) 901 WRITE(BORT_STR,'("BUFRLIB: LSTRPS - TABLE NODE (",I7,") IS OUT '// . 'OF BOUNDS, > UPPER BOUNDS (",I7,"); TAG IS ",A10)') . NODE,ISC(INODE(LUN)),TAG(NODE) CALL BORT(BORT_STR) END