upc.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE UNPACKS AND RETURNS A CHARACTER STRING OF
C>   LENGTH NCHR CONTAINED WITHIN NCHR BYTES OF IBAY, STARTING WITH BIT
C>   (IBIT+1).  ON OUTPUT, IBIT IS UPDATED TO POINT TO THE LAST BIT THAT
C>   WAS UNPACKED.  NOTE THAT THE STRING TO BE UNPACKED DOES NOT
C>   NECESSARILY NEED TO BE ALIGNED ON A BYTE BOUNDARY WITHIN IBAY.
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C>                           DOCUMENTATION
C> 2009-03-23  J. ATOR    -- TREAT NULL CHARACTERS AS BLANKS;
C>                           PREVENT OVERFLOW OF CHR
C> 2014-11-19  J. ATOR    -- ADD CNVNULL ARGUMENT
C>
C> USAGE:    CALL UPC (CHR, NCHR, IBAY, IBIT, CNVNULL)
C>   INPUT ARGUMENT LIST:
C>     NCHR     - INTEGER: NUMBER OF BYTES OF IBAY WITHIN WHICH TO
C>                UNPACK CHR (I,E, THE NUMBER OF CHARACTERS IN CHR)
C>     IBAY     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING PACKED
C>                CHR
C>     IBIT     - INTEGER: BIT POINTER WITHIN IBAY INDICATING BIT AFTER
C>                WHICH TO START UNPACKING
C>     CNVNULL  - LOGICAL: .TRUE. IF NULL CHARACTERS SHOULD BE
C>                CONVERTED TO BLANKS
C>
C>   OUTPUT ARGUMENT LIST:
C>     CHR      - CHARACTER*(*): UNPACKED CHARACTER STRING OF LENGTH
C>                NCHR
C>     IBIT     - INTEGER: BIT POINTER WITHIN IBAY INDICATING LAST BIT
C>                THAT WAS UNPACKED
C>
C> REMARKS:
C>    THIS SUBROUTINE IS THE INVERSE OF BUFR ARCHIVE LIBRARY ROUTINE
C>    PKC.
C>
C>    THIS ROUTINE CALLS:        IPKM     IUPM     UPB
C>    THIS ROUTINE IS CALLED BY: RDCMPS   RDTREE   READLC   STBFDX
C>                               STNDRD   UFBGET   UFBTAB   UFBTAM
C>                               WRCMPS   
C>                               Normally not called by any application
C>                               programs.
C>
      SUBROUTINE upc(CHR,NCHR,IBAY,IBIT,CNVNULL)
 
 
 
      COMMON /charac/ iascii,iatoe(0:255),ietoa(0:255)
      COMMON /hrdwrd/ nbytw,nbitw,iord(8)
 
      CHARACTER*(*) CHR
      CHARACTER*8   CVAL
      dimension     ibay(*),ival(2)
      equivalence(cval,ival)
 
      LOGICAL CNVNULL
 
C----------------------------------------------------------------------
C----------------------------------------------------------------------
 
      lb = iord(nbytw)
      cval = ' '
 
      numchr = min(nchr,len(chr))
      DO i=1,numchr
        CALL upb(ival(1),8,ibay,ibit)
        IF((ival(1).EQ.0).AND.(cnvnull)) THEN
          chr(i:i) = ' '
        ELSE 
          chr(i:i) = cval(lb:lb)
        ENDIF
        IF(iascii.EQ.0) CALL ipkm(chr(i:i),1,iatoe(iupm(chr(i:i),8)))
      ENDDO
 
      RETURN
      END