var/external/bufr/chrtrna.f

   1       SUBROUTINE CHRTRNA(STR,CHR,N)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    CHRTRNA
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE COPIES A SPECIFIED NUMBER OF CHARACTERS
   9 C   FROM A CHARACTER ARRAY INTO A CHARACTER STRING.  THE DIFFERENCE
  10 C   BETWEEN THIS SUBROUTINE AND BUFR ARCHIVE LIBRARY SUBROUTINE CHRTRN
  11 C   IS THAT, IN THIS SUBROUTINE, THE INPUT CHARACTER ARRAY IS ASSUMED
  12 C   TO BE IN ASCII; THUS, FOR CASES WHERE THE NATIVE MACHINE IS EBCDIC,
  13 C   AN ASCII TO EBCDIC TRANSLATION IS DONE ON THE FINAL STRING BEFORE
  14 C   IT IS OUTPUT.
  15 C
  16 C PROGRAM HISTORY LOG:
  17 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  18 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  19 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  20 C                           INTERDEPENDENCIES
  21 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  22 C                           DOCUMENTATION
  23 C
  24 C USAGE:    CALL CHRTRNA (STR, CHR, N)
  25 C   INPUT ARGUMENT LIST:
  26 C     CHR      - CHARACTER*1: N-WORD CHARACTER ARRAY IN ASCII
  27 C     N        - INTEGER: NUMBER OF CHARACTERS TO COPY
  28 C
  29 C   OUTPUT ARGUMENT LIST:
  30 C     STR      - CHARACTER*(*): CHARACTER STRING IN ASCII OR EBCDIC,
  31 C                DEPENDING ON NATIVE MACHINE
  32 C
  33 C REMARKS:
  34 C    THIS ROUTINE CALLS:        IPKM     IUPM
  35 C    THIS ROUTINE IS CALLED BY: ICHKSTR  STBFDX
  36 C                               Normally not called by any application
  37 C                               programs.
  38 C
  39 C ATTRIBUTES:
  40 C   LANGUAGE: FORTRAN 77
  41 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  42 C
  43 C$$$
  44
  45       COMMON /CHARAC/ IASCII,IATOE(0:255),IETOA(0:255)
  46
  47       CHARACTER*(*) STR
  48       CHARACTER*1   CHR(N)
  49
  50 C----------------------------------------------------------------------
  51 C----------------------------------------------------------------------
  52
  53 C     Loop on N characters of CHR
  54
  55       DO I=1,N
  56       STR(I:I) = CHR(I)
  57
  58 C     If this is an EBCDIC machine, then translate the character
  59 C     from ASCII -> EBCDIC.
  60
  61       IF(IASCII.EQ.0) CALL IPKM(STR(I:I),1,IATOE(IUPM(STR(I:I),8)))
  62       ENDDO
  63       RETURN
  64       END