string.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a string is in the string cache.
C>
C> @author Woollen @date 1994-01-06
 
C> 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> @param[in] STR - character*(*): string of blank-separated mnemonics.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C> @param[out] I1 - integer: a number greater than or equal to the number
C> of blank-separated mnemonics in STR.
C> @param[in] IO - integer: status indicator for BUFR file associated
C> with LUN:
C> - 0 input file
C> - 1 output file
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE string(STR,LUN,I1,IO)
 
      USE modv_mxs
      USE moda_msgcwd
 
      parameter(jcons=52)
 
      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