NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
string.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER
5 C> STRING IS IN THE STRING CACHE (ARRAYS IN COMMON BLOCKS /STCACH/ AND
6 C> /STORDS/). IF IT IS NOT IN THE CACHE, IT MUST CALL THE BUFR
7 C> ARCHIVE LIBRARY PARSING SUBROUTINE PARUSR TO PERFORM THE TASK OF
8 C> SEPARATING AND CHECKING THE INDIVIDUAL "PIECES" (I.E., MNEMONICS)
9 C> SO THAT IT CAN THEN BE ADDED TO THE CACHE. IF IT IS ALREADY IN THE
10 C> CACHE, THEN THIS EXTRA WORK DOES NOT NEED TO BE PERFORMED. THE
11 C> MNEMONIC STRING CACHE IS A PERFORMANCE ENHANCING DEVICE WHICH SAVES
12 C> TIME WHEN THE SAME MNEMONIC STRINGS ARE ENCOUNTERED IN A USER
13 C> PROGRAM, OVER AND OVER AGAIN (THE TYPICAL SCENARIO).
14 C>
15 C> PROGRAM HISTORY LOG:
16 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
17 C> 1998-04-02 J. WOOLLEN -- MODIFIED TO ENLARGE THE CACHE FROM 50
18 C> ELEMENTS TO 1000, MAXIMUM; OPTIMIZATION OF
19 C> THE CACHE SEARCH ALGORITHM IN SUPPORT OF A
20 C> BIGGER CACHE
21 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
22 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
23 C> ROUTINE "BORT"; CORRECTED SOME MINOR ERRORS
24 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
25 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
26 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
27 C> BUFR FILES UNDER THE MPI)
28 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
29 C> INTERDEPENDENCIES
30 C> 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED
31 C> DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
32 C> MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
33 C> TERMINATES ABNORMALLY; CHANGED CALL FROM
34 C> BORT TO BORT2
35 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
36 C>
37 C> USAGE: CALL STRING (STR, LUN, I1, IO)
38 C> INPUT ARGUMENT LIST:
39 C> STR - CHARACTER*(*): STRING OF BLANK-SEPARATED MNEMONICS
40 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
41 C>
42 C> OUTPUT ARGUMENT LIST:
43 C> I1 - INTEGER: A NUMBER GREATER THAN OR EQUAL TO THE NUMBER
44 C> OF BLANK-SEPARATED MNEMONICS IN STR
45 C> IO - INTEGER: STATUS INDICATOR FOR BUFR FILE ASSOCIATED
46 C> WITH LUN:
47 C> 0 = input file
48 C> 1 = output file
49 C>
50 C> REMARKS:
51 C> THIS ROUTINE CALLS: BORT2 PARUSR
52 C> THIS ROUTINE IS CALLED BY: UFBEVN UFBGET UFBIN3 UFBINT
53 C> UFBOVR UFBREP UFBSTP UFBTAB
54 C> UFBTAM
55 C> Normally not called by any application
56 C> programs.
57 C>
58  SUBROUTINE string(STR,LUN,I1,IO)
59 
60  USE modv_mxs
61  USE moda_msgcwd
62 
63  parameter(jcons=52)
64 
65  COMMON /stcach/ mstr,nstr,lstr,lux(mxs,2),usr(mxs),icon(jcons,mxs)
66  COMMON /usrstr/ jcon(jcons)
67  COMMON /stords/ iord(mxs),iorx(mxs)
68 
69  CHARACTER*(*) str
70  CHARACTER*128 bort_str1,bort_str2
71  CHARACTER*80 usr,ust
72 
73 C----------------------------------------------------------------------
74 C----------------------------------------------------------------------
75 
76  nxt = 0
77  ust = str
78  ind = inode(lun)
79  IF(len(str).GT.80) goto 900
80 
81 C Note that LSTR, MSTR and NSTR were initialized via a prior call to
82 C subroutine STRCLN, which itself was called by subroutine MAKESTAB.
83 
84 C SEE IF STRING IS IN THE CACHE
85 C -----------------------------
86 
87  DO n=1,nstr
88  IF(lux(iord(n),2).EQ.ind) THEN
89  iorx(nxt+1) = iord(n)
90  nxt = nxt+1
91  ENDIF
92  ENDDO
93  DO n=1,nxt
94  IF(ust.EQ.usr(iorx(n)))goto1
95  ENDDO
96  goto2
97 
98 C IF IT IS IN THE CACHE, COPY PARAMETERS FROM THE CACHE
99 C -----------------------------------------------------
100 
101 1 DO j=1,jcons
102  jcon(j) = icon(j,iorx(n))
103  ENDDO
104  goto 100
105 
106 C IF IT IS NOT IN THE CACHE, PARSE IT AND PUT IT THERE
107 C ----------------------------------------------------
108 
109 2 CALL parusr(str,lun,i1,io)
110  lstr = max(mod(lstr+1,mstr+1),1)
111  nstr = min(nstr+1,mstr)
112 c .... File
113  lux(lstr,1) = lun
114 c .... Table A entry
115  lux(lstr,2) = ind
116  usr(lstr) = str
117  DO j=1,jcons
118  icon(j,lstr) = jcon(j)
119  ENDDO
120 
121 C REARRANGE THE CACHE ORDER AFTER AN UPDATE
122 C -----------------------------------------
123 
124  DO n=nstr,2,-1
125  iord(n) = iord(n-1)
126  ENDDO
127  iord(1) = lstr
128 
129 100 IF(jcon(1).GT.i1) goto 901
130 
131 C EXITS
132 C -----
133 
134  RETURN
135 900 WRITE(bort_str1,'("BUFRLIB: STRING - INPUT STRING (",A,") HAS")')
136  . str
137  WRITE(bort_str2,'(18X,"LENGTH (",I4,"), > LIMIT OF 80 CHAR.")')
138  . len(str)
139  CALL bort2(bort_str1,bort_str2)
140 901 WRITE(bort_str1,'("BUFRLIB: STRING - INPUT STRING (",A,")")') str
141  WRITE(bort_str2,'(18X,"HAS",I5," STORE NODES (MNEMONICS) - THE '//
142  . 'LIMIT (THIRD INPUT ARGUMENT) IS",I5)') jcon(1),i1
143  CALL bort2(bort_str1,bort_str2)
144  END
subroutine bort2(STR1, STR2)
This subroutine calls subroutine errwrt() to log two error messages, then calls subroutine bort_exit(...
Definition: bort2.f:22
subroutine parusr(STR, LUN, I1, IO)
THIS SUBROUTINE INITATES THE PROCESS TO PARSE OUT MNEMONICS (NODES) FROM A USER-SPECIFIED CHARACTER S...
Definition: parusr.f:49
This module declares and initializes the MXS variable.
Definition: modv_MXS.f90:9
subroutine string(STR, LUN, I1, IO)
THIS SUBROUTINE CHECKS TO SEE IF A USER-SPECIFIED CHARACTER STRING IS IN THE STRING CACHE (ARRAYS IN ...
Definition: string.f:58