SUBROUTINE STRING(STR,LUN,I1,IO) 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