var/external/bufr/upc.f

   1       SUBROUTINE UPC(CHR,NCHR,IBAY,IBIT)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UPC
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE UNPACKS AND RETURNS A CHARACTER STRING OF
   9 C   LENGTH NCHR CONTAINED WITHIN NCHR BYTES OF IBAY, STARTING WITH BIT
  10 C   (IBIT+1).  ON OUTPUT, IBIT IS UPDATED TO POINT TO THE LAST BIT THAT
  11 C   WAS UNPACKED.  NOTE THAT THE STRING TO BE UNPACKED DOES NOT
  12 C   NECESSARILY NEED TO BE ALIGNED ON A BYTE BOUNDARY WITHIN IBAY.
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  16 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  17 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  18 C                           INTERDEPENDENCIES
  19 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  20 C                           DOCUMENTATION
  21 C 2009-03-23  J. ATOR    -- TREAT NULL CHARACTERS AS BLANKS;
  22 C                           PREVENT OVERFLOW OF CHR
  23 C
  24 C USAGE:    CALL UPC (CHR, NCHR, IBAY, IBIT)
  25 C   INPUT ARGUMENT LIST:
  26 C     NCHR     - INTEGER: NUMBER OF BYTES OF IBAY WITHIN WHICH TO
  27 C                UNPACK CHR (I,E, THE NUMBER OF CHARACTERS IN CHR)
  28 C     IBAY     - INTEGER: *-WORD PACKED BINARY ARRAY CONTAINING PACKED
  29 C                CHR
  30 C     IBIT     - INTEGER: BIT POINTER WITHIN IBAY INDICATING BIT AFTER
  31 C                WHICH TO START UNPACKING
  32 C
  33 C   OUTPUT ARGUMENT LIST:
  34 C     CHR      - CHARACTER*(*): UNPACKED CHARACTER STRING OF LENGTH
  35 C                NCHR
  36 C     IBIT     - INTEGER: BIT POINTER WITHIN IBAY INDICATING LAST BIT
  37 C                THAT WAS UNPACKED
  38 C
  39 C REMARKS:
  40 C    THIS SUBROUTINE IS THE INVERSE OF BUFR ARCHIVE LIBRARY ROUTINE
  41 C    PKC.
  42 C
  43 C    THIS ROUTINE CALLS:        IPKM     IUPM     UPB
  44 C    THIS ROUTINE IS CALLED BY: RDCMPS   RDTREE   READLC   STNDRD
  45 C                               UFBGET   UFBTAB   UFBTAM   WRCMPS
  46 C                               Normally not called by any application
  47 C                               programs.
  48 C
  49 C ATTRIBUTES:
  50 C   LANGUAGE: FORTRAN 77
  51 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  52 C
  53 C$$$
  54
  55       COMMON /CHARAC/ IASCII,IATOE(0:255),IETOA(0:255)
  56       COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
  57
  58       CHARACTER*(*) CHR
  59       CHARACTER*8   CVAL
  60       DIMENSION     IBAY(*),IVAL(2)
  61       EQUIVALENCE   (CVAL,IVAL)
  62
  63 C----------------------------------------------------------------------
  64 C----------------------------------------------------------------------
  65
  66       LB = IORD(NBYTW)
  67       CVAL = ' '
  68
  69       NUMCHR = MIN(NCHR,LEN(CHR))
  70       DO I=1,NUMCHR
  71         CALL UPB(IVAL(1),8,IBAY,IBIT)
  72         IF(IVAL(1).EQ.0) THEN
  73           CHR(I:I) = ' '
  74         ELSE
  75           CHR(I:I) = CVAL(LB:LB)
  76         ENDIF
  77         IF(IASCII.EQ.0) CALL IPKM(CHR(I:I),1,IATOE(IUPM(CHR(I:I),8)))
  78       ENDDO
  79
  80       RETURN
  81       END