<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='CHRTRNA'><A href='../../html_code/bufr/chrtrna.f.html#CHRTRNA' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CHRTRNA(STR,CHR,N) 7
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: CHRTRNA
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE COPIES A SPECIFIED NUMBER OF CHARACTERS
C FROM A CHARACTER ARRAY INTO A CHARACTER STRING. THE DIFFERENCE
<A NAME='CHRTRN'><A href='../../html_code/bufr/chrtrna.f.html#CHRTRN' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
C BETWEEN THIS SUBROUTINE AND BUFR ARCHIVE LIBRARY SUBROUTINE CHRTRN
C IS THAT, IN THIS SUBROUTINE, THE INPUT CHARACTER ARRAY IS ASSUMED
C TO BE IN ASCII; THUS, FOR CASES WHERE THE NATIVE MACHINE IS EBCDIC,
C AN ASCII TO EBCDIC TRANSLATION IS DONE ON THE FINAL STRING BEFORE
C IT IS OUTPUT.
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
C USAGE: CALL CHRTRNA
(STR, CHR, N)
C INPUT ARGUMENT LIST:
C CHR - CHARACTER*1: N-WORD CHARACTER ARRAY IN ASCII
C N - INTEGER: NUMBER OF CHARACTERS TO COPY
C
C OUTPUT ARGUMENT LIST:
C STR - CHARACTER*(*): CHARACTER STRING IN ASCII OR EBCDIC,
C DEPENDING ON NATIVE MACHINE
C
C REMARKS:
C THIS ROUTINE CALLS: IPKM IUPM
C THIS ROUTINE IS CALLED BY: ICHKSTR STBFDX
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
COMMON /CHARAC/ IASCII,IATOE(0:255),IETOA(0:255)
CHARACTER*(*) STR
CHARACTER*1 CHR(N)
C----------------------------------------------------------------------
C----------------------------------------------------------------------
C Loop on N characters of CHR
DO I=1,N
STR(I:I) = CHR(I)
C If this is an EBCDIC machine, then translate the character
C from ASCII -> EBCDIC.
IF(IASCII.EQ.0) CALL IPKM(STR(I:I),1,IATOE(IUPM(STR(I:I),8)))
ENDDO
RETURN
END