hold4wlc.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2014-02-05
      
C> NORMALLY, A LONG CHARACTER STRING (I.E. LONGER THAN 8
C>   BYTES) IS STORED IN AN UNCOMPRESSED BUFR SUBSET FOR OUTPUT VIA A
C>   CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE WRITLC, AT A POINT AFTER THE
C>   CALL TO BUFR ARCHIVE LIBRARY SUBROUTINE WRITSB (OR WRITSA) HAS
C>   ALREADY BEEN MADE FOR THE SUBSET IN QUESTION.  THIS WORKS FINE FOR
C>   ALL CASES EXCEPT WHEN WRITSB (OR WRITSA) FLUSHES THE MESSAGE
C>   CONTAINING THE SUBSET IN QUESTION TO THE BUFR OUTPUT STREAM DURING
C>   THE SAME CALL TO WRITSB (OR WRITSA), SUCH AS WHEN A SUBSET HAS A
C>   BYTE COUNT > 65530 BYTES.  WHEN THIS HAPPENS, THERE IS NO LONGER ANY
C>   WAY FOR A SUBSEQUENT WRITLC CALL TO STORE A LONG CHARACTER STRING IN
C>   THE SUBSET, BECAUSE THE SUBSET HAS ALREADY BEEN FLUSHED FROM
C>   INTERNAL MEMORY TO THE OUTPUT STREAM.  THIS SUBROUTINE GETS AROUND
C>   THAT PROBLEM, BY ALLOWING A LONG CHARACTER STRING TO BE SPECIFIED
C>   AHEAD OF TIME (I.E. BEFORE CALLING WRITSB OR WRITSB), AND THE
C>   CORRESPONDING VALUE WILL BE HELD AND STORED AUTOMATICALLY (VIA AN
C>   INTERNAL CALL TO WRITLC) AT THE PROPER TIME DURING THE SUBSEQUENT
C>   CALL TO WRITSB (OR WRITSA).  IF MULTIPLE LONG CHARACTER STRINGS NEED
C>   TO BE STORED IN A SUBSET, THEN A SEPARATE CALL TO THIS SUBROUTINE
C>   SHOULD BE MADE FOR EACH SUCH STRING.
C>
C> PROGRAM HISTORY LOG:
C> 2014-02-05  J. ATOR    -- ORIGINAL AUTHOR
C>
C> USAGE:    CALL HOLD4WLC(LUNIT,CHR,STR)
C>   INPUT ARGUMENT LIST:
C>     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C>     CHR      - CHARACTER*(*): UNPACKED CHARACTER STRING (I.E.,
C>                CHARACTER DATA ELEMENT GREATER THAN EIGHT BYTES)
C>     STR      - CHARACTER*(*): MNEMONIC ASSOCIATED WITH STRING IN CHR
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        ERRWRT   STRSUC
C>    THIS ROUTINE IS CALLED BY: None
C>                               Normally called only by application
C>                               programs.
C>
      SUBROUTINE hold4wlc(LUNIT,CHR,STR)

      USE moda_h4wlc

      COMMON /quiet/ iprt

      CHARACTER*(*) chr,str

      CHARACTER*128 errstr
      CHARACTER*14  mystr

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      CALL strsuc( str, mystr, lens )
      IF ( lens .EQ. -1 ) RETURN

      lenc = min( len( chr ), 120 )

C     IF THIS SUBROUTINE HAS ALREADY BEEN CALLED WITH THIS MNEMONIC FOR
C     THIS PARTICULAR SUBSET, THEN OVERWRITE THE CORRESPONDING ENTRY IN
C     THE INTERNAL HOLDING AREA.

      IF ( nh4wlc .GT. 0 ) THEN
        DO i = 1, nh4wlc
          IF ( ( lunit .EQ. luh4wlc(i) ) .AND.
     .         ( mystr(1:lens) .EQ. sth4wlc(i)(1:lens) ) ) THEN
            chh4wlc(i) = ''
            chh4wlc(i)(1:lenc) = chr(1:lenc)
            RETURN
          ENDIF
        ENDDO
      ENDIF

C     OTHERWISE, USE THE NEXT AVAILABLE UNUSED ENTRY IN THE HOLDING AREA.

      IF ( nh4wlc .GE. mxh4wlc ) THEN
         IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      WRITE ( unit=errstr, fmt='(A,A,I3)' )
     . 'BUFRLIB: HOLD4WLC - THE MAXIMUM NUMBER OF LONG CHARACTER ',
     . 'STRINGS THAT CAN BE HELD INTERNALLY IS ', mxh4wlc
      CALL errwrt(errstr)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
         ENDIF
      ELSE
         nh4wlc = nh4wlc + 1
         luh4wlc(nh4wlc) = lunit
         sth4wlc(nh4wlc) = ''
         sth4wlc(nh4wlc)(1:lens) = mystr(1:lens)
         chh4wlc(nh4wlc) = ''
         chh4wlc(nh4wlc)(1:lenc) = chr(1:lenc)
      ENDIF

      RETURN
      END