<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='STRING'><A href='../../html_code/bufr/string.f.html#STRING' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE STRING(STR,LUN,I1,IO) 10,5
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: STRING
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER
C STRING IS IN THE STRING CACHE (ARRAYS IN COMMON BLOCKS /STCACH/ AND
C /STORDS/). IF IT IS NOT IN THE CACHE, IT MUST CALL THE BUFR
C ARCHIVE LIBRARY PARSING SUBROUTINE PARUSR TO PERFORM THE TASK OF
C SEPARATING AND CHECKING THE INDIVIDUAL "PIECES" (I.E., MNEMONICS)
C SO THAT IT CAN THEN BE ADDED TO THE CACHE. IF IT IS ALREADY IN THE
C CACHE, THEN THIS EXTRA WORK DOES NOT NEED TO BE PERFORMED. THE
C MNEMONIC STRING CACHE IS A PERFORMANCE ENHANCING DEVICE WHICH SAVES
C TIME WHEN THE SAME MNEMONIC STRINGS ARE ENCOUNTERED IN A USER
C PROGRAM, OVER AND OVER AGAIN (THE TYPICAL SCENARIO).
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-04-02 J. WOOLLEN -- MODIFIED TO ENLARGE THE CACHE FROM 50
C ELEMENTS TO 1000, MAXIMUM; OPTIMIZATION OF
C THE CACHE SEARCH ALGORITHM IN SUPPORT OF A
C BIGGER CACHE
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
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 -- UNIFIED/PORTABLE FOR WRF; ADDED
C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C TERMINATES ABNORMALLY; CHANGED CALL FROM
C BORT TO BORT2
C
C USAGE: CALL STRING (STR, LUN, I1, IO)
C INPUT ARGUMENT LIST:
C STR - CHARACTER*(*): STRING OF BLANK-SEPARATED MNEMONICS
C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C
C OUTPUT ARGUMENT LIST:
C I1 - INTEGER: A NUMBER GREATER THAN OR EQUAL TO THE NUMBER
C OF BLANK-SEPARATED MNEMONICS IN STR
C IO - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
C WITH LUN:
C 0 = input file
C 1 = output file
C
C REMARKS:
C THIS ROUTINE CALLS: BORT2 PARUSR
C THIS ROUTINE IS CALLED BY: UFBEVN UFBGET UFBIN3 UFBINT
C UFBOVR UFBREP UFBSTP UFBTAB
C UFBTAM
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'
PARAMETER (JCONS=52)
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /STCACH/ MSTR,NSTR,LSTR,LUX(MXS,2),USR(MXS),ICON(JCONS,MXS)
COMMON /USRSTR/ JCON(JCONS)
COMMON /STORDS/ IORD(MXS),IORX(MXS)
CHARACTER*(*) STR
CHARACTER*128 BORT_STR1,BORT_STR2
CHARACTER*80 USR,UST
C----------------------------------------------------------------------
C----------------------------------------------------------------------
NXT = 0
UST = STR
IND = INODE(LUN)
IF(LEN(STR).GT.80) GOTO 900
C Note that LSTR, MSTR and NSTR were initialized via a prior call to
C subroutine STRCLN, which itself was called by subroutine MAKESTAB.
C SEE IF STRING IS IN THE CACHE
C -----------------------------
DO N=1,NSTR
IF(LUX(IORD(N),2).EQ.IND) THEN
IORX(NXT+1) = IORD(N)
NXT = NXT+1
ENDIF
ENDDO
DO N=1,NXT
IF(UST.EQ.USR(IORX(N)))GOTO1
ENDDO
GOTO2
C IF IT IS IN THE CACHE, COPY PARAMETERS FROM THE CACHE
C -----------------------------------------------------
1 DO J=1,JCONS
JCON(J) = ICON(J,IORX(N))
ENDDO
GOTO 100
C IF IT IS NOT IN THE CACHE, PARSE IT AND PUT IT THERE
C ----------------------------------------------------
2 CALL PARUSR(STR,LUN,I1,IO)
LSTR = MAX(MOD(LSTR+1,MSTR+1),1)
NSTR = MIN(NSTR+1,MSTR)
c .... File
LUX(LSTR,1) = LUN
c .... Table A entry
LUX(LSTR,2) = IND
USR(LSTR) = STR
DO J=1,JCONS
ICON(J,LSTR) = JCON(J)
ENDDO
C REARRANGE THE CACHE ORDER AFTER AN UPDATE
C -----------------------------------------
DO N=NSTR,2,-1
IORD(N) = IORD(N-1)
ENDDO
IORD(1) = LSTR
100 IF(JCON(1).GT.I1) GOTO 901
C EXITS
C -----
RETURN
900 WRITE(BORT_STR1,'("BUFRLIB: STRING - INPUT STRING (",A,") HAS")')
. STR
WRITE(BORT_STR2,'(18X,"LENGTH (",I4,"), > LIMIT OF 80 CHAR.")')
. LEN(STR)
CALL BORT2(BORT_STR1,BORT_STR2)
901 WRITE(BORT_STR1,'("BUFRLIB: STRING - INPUT STRING (",A,")")') STR
WRITE(BORT_STR2,'(18X,"HAS",I5," STORE NODES (MNEMONICS) - THE '//
. 'LIMIT (THIRD INPUT ARGUMENT) IS",I5)') JCON(1),I1
CALL BORT2(BORT_STR1,BORT_STR2)
END