var/external/bufr/string.f

   1       SUBROUTINE STRING(STR,LUN,I1,IO)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    STRING
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER
   9 C   STRING IS IN THE STRING CACHE (ARRAYS IN COMMON BLOCKS /STCACH/ AND
  10 C   /STORDS/).  IF IT IS NOT IN THE CACHE, IT MUST CALL THE BUFR
  11 C   ARCHIVE LIBRARY PARSING SUBROUTINE PARUSR TO PERFORM THE TASK OF
  12 C   SEPARATING AND CHECKING THE INDIVIDUAL "PIECES" (I.E., MNEMONICS)
  13 C   SO THAT IT CAN THEN BE ADDED TO THE CACHE.  IF IT IS ALREADY IN THE
  14 C   CACHE, THEN THIS EXTRA WORK DOES NOT NEED TO BE PERFORMED.  THE
  15 C   MNEMONIC STRING CACHE IS A PERFORMANCE ENHANCING DEVICE WHICH SAVES
  16 C   TIME WHEN THE SAME MNEMONIC STRINGS ARE ENCOUNTERED IN A USER
  17 C   PROGRAM, OVER AND OVER AGAIN (THE TYPICAL SCENARIO).
  18 C
  19 C PROGRAM HISTORY LOG:
  20 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  21 C 1998-04-02  J. WOOLLEN -- MODIFIED TO ENLARGE THE CACHE FROM 50
  22 C                           ELEMENTS TO 1000, MAXIMUM; OPTIMIZATION OF
  23 C                           THE CACHE SEARCH ALGORITHM IN SUPPORT OF A
  24 C                           BIGGER CACHE
  25 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  26 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  27 C                           ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
  28 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  29 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  30 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  31 C                           BUFR FILES UNDER THE MPI)
  32 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  33 C                           INTERDEPENDENCIES
  34 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  35 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  36 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  37 C                           TERMINATES ABNORMALLY; CHANGED CALL FROM
  38 C                           BORT TO BORT2
  39 C
  40 C USAGE:    CALL STRING (STR, LUN, I1, IO)
  41 C   INPUT ARGUMENT LIST:
  42 C     STR      - CHARACTER*(*): STRING OF BLANK-SEPARATED MNEMONICS
  43 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  44 C
  45 C   OUTPUT ARGUMENT LIST:
  46 C     I1       - INTEGER: A NUMBER GREATER THAN OR EQUAL TO THE NUMBER
  47 C                OF BLANK-SEPARATED MNEMONICS IN STR
  48 C     IO       - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
  49 C                WITH LUN:
  50 C                       0 = input file
  51 C                       1 = output file
  52 C
  53 C REMARKS:
  54 C    THIS ROUTINE CALLS:        BORT2    PARUSR
  55 C    THIS ROUTINE IS CALLED BY: UFBEVN   UFBGET   UFBIN3   UFBINT
  56 C                               UFBOVR   UFBREP   UFBSTP   UFBTAB
  57 C                               UFBTAM
  58 C                               Normally not called by any application
  59 C                               programs.
  60 C
  61 C ATTRIBUTES:
  62 C   LANGUAGE: FORTRAN 77
  63 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  64 C
  65 C$$$
  66
  67       INCLUDE 'bufrlib.prm'
  68
  69       PARAMETER (JCONS=52)
  70
  71       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  72      .                INODE(NFILES),IDATE(NFILES)
  73       COMMON /STCACH/ MSTR,NSTR,LSTR,LUX(MXS,2),USR(MXS),ICON(JCONS,MXS)
  74       COMMON /USRSTR/ JCON(JCONS)
  75       COMMON /STORDS/ IORD(MXS),IORX(MXS)
  76
  77       CHARACTER*(*) STR
  78       CHARACTER*128 BORT_STR1,BORT_STR2
  79       CHARACTER*80  USR,UST
  80
  81 C----------------------------------------------------------------------
  82 C----------------------------------------------------------------------
  83
  84       NXT = 0
  85       UST = STR
  86       IND = INODE(LUN)
  87       IF(LEN(STR).GT.80) GOTO 900
  88
  89 C     Note that LSTR, MSTR and NSTR were initialized via a prior call to
  90 C     subroutine STRCLN, which itself was called by subroutine MAKESTAB.
  91
  92 C  SEE IF STRING IS IN THE CACHE
  93 C  -----------------------------
  94
  95       DO N=1,NSTR
  96       IF(LUX(IORD(N),2).EQ.IND) THEN
  97          IORX(NXT+1) = IORD(N)
  98          NXT = NXT+1
  99       ENDIF
 100       ENDDO
 101       DO N=1,NXT
 102       IF(UST.EQ.USR(IORX(N)))GOTO1
 103       ENDDO
 104       GOTO2
 105
 106 C  IF IT IS IN THE CACHE, COPY PARAMETERS FROM THE CACHE
 107 C  -----------------------------------------------------
 108
 109 1     DO J=1,JCONS
 110       JCON(J) = ICON(J,IORX(N))
 111       ENDDO
 112       GOTO 100
 113
 114 C  IF IT IS NOT IN THE CACHE, PARSE IT AND PUT IT THERE
 115 C  ----------------------------------------------------
 116
 117 2     CALL PARUSR(STR,LUN,I1,IO)
 118       LSTR = MAX(MOD(LSTR+1,MSTR+1),1)
 119       NSTR = MIN(NSTR+1,MSTR)
 120 c  .... File
 121       LUX(LSTR,1) = LUN
 122 c  .... Table A entry
 123       LUX(LSTR,2) = IND
 124       USR(LSTR) = STR
 125       DO J=1,JCONS
 126       ICON(J,LSTR) = JCON(J)
 127       ENDDO
 128
 129 C  REARRANGE THE CACHE ORDER AFTER AN UPDATE
 130 C  -----------------------------------------
 131
 132       DO N=NSTR,2,-1
 133       IORD(N) = IORD(N-1)
 134       ENDDO
 135       IORD(1) = LSTR
 136
 137 100   IF(JCON(1).GT.I1) GOTO 901
 138
 139 C  EXITS
 140 C  -----
 141
 142       RETURN
 143 900   WRITE(BORT_STR1,'("BUFRLIB: STRING - INPUT STRING (",A,") HAS")')
 144      . STR
 145       WRITE(BORT_STR2,'(18X,"LENGTH (",I4,"), > LIMIT OF 80 CHAR.")')
 146      .  LEN(STR)
 147       CALL BORT2(BORT_STR1,BORT_STR2)
 148 901   WRITE(BORT_STR1,'("BUFRLIB: STRING - INPUT STRING (",A,")")') STR
 149       WRITE(BORT_STR2,'(18X,"HAS",I5," STORE NODES (MNEMONICS) - THE '//
 150      . 'LIMIT (THIRD INPUT ARGUMENT) IS",I5)') JCON(1),I1
 151       CALL BORT2(BORT_STR1,BORT_STR2)
 152       END