<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='CPYUPD'><A href='../../html_code/bufr/cpyupd.f.html#CPYUPD' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE CPYUPD(LUNIT,LIN,LUN,IBYT) 2,8
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: CPYUPD
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE COPIES A SUBSET FROM ONE MESSAGE BUFFER
C (ARRAY MBAY IN COMMON BLOCK /BITBUF/) TO ANOTHER AND/OR RESETS THE
C POINTERS.
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"
C 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
C OPENED AT ONE TIME INCREASED FROM 10 TO 32
C (NECESSARY IN ORDER TO PROCESS MULTIPLE
C BUFR FILES UNDER THE MPI)
C 2000-09-19 J. WOOLLEN -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 10,000 TO 20,000 BYTES
C 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- UNIFIED/PORTABLE FOR WRF; ADDED
C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C TERMINATES ABNORMALLY
C 2004-08-09 J. ATOR -- MAXIMUM MESSAGE LENGTH INCREASED FROM
C 20,000 TO 50,000 BYTES
C 2009-03-23 J. ATOR -- USE MSGFULL
C
C USAGE: CALL CPYUPD
(LUNIT, LIN, LUN, IBYT)
C INPUT ARGUMENT LIST:
C LUNIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
C LIN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C FOR INPUT MESSAGE LOCATION
C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C FOR OUTPUT MESSAGE LOCATION
C IBYT - INTEGER: NUMBER OF BYTES OCCUPIED BY THIS SUBSET
C
C REMARKS:
C THIS ROUTINE CALLS: BORT IUPB MSGFULL MSGINI
C MSGWRT MVB PKB
C THIS ROUTINE IS CALLED BY: COPYSB
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGPTR/ NBY0,NBY1,NBY2,NBY3,NBY4,NBY5
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
CHARACTER*128 BORT_STR
LOGICAL MSGFULL
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C SEE IF THE NEW SUBSET FITS
C --------------------------
IF(MSGFULL(MBYT(LUN),IBYT,MAXBYT)) THEN
CALL MSGWRT(LUNIT,MBAY(1,LUN),MBYT(LUN))
CALL MSGINI(LUN)
ENDIF
IF(MSGFULL(MBYT(LUN),IBYT,MAXBYT)) GOTO 900
C TRANSFER SUBSET FROM ONE MESSAGE TO THE OTHER
C ---------------------------------------------
C Note that we want to append the data for this subset to the end
C of Section 4, but the value in MBYT(LUN) already includes the
C length of Section 5 (i.e. 4 bytes). Therefore, we need to begin
C writing at the point 3 bytes prior to the byte currently pointed
C to by MBYT(LUN).
CALL MVB(MBAY(1,LIN),MBYT(LIN)+1,MBAY(1,LUN),MBYT(LUN)-3,IBYT)
C UPDATE THE SUBSET AND BYTE COUNTERS
C --------------------------------------
MBYT(LUN) = MBYT(LUN) + IBYT
NSUB(LUN) = NSUB(LUN) + 1
LBIT = (NBY0+NBY1+NBY2+4)*8
CALL PKB(NSUB(LUN),16,MBAY(1,LUN),LBIT)
LBYT = NBY0+NBY1+NBY2+NBY3
NBYT = IUPB(MBAY(1,LUN),LBYT+1,24)
LBIT = LBYT*8
CALL PKB(NBYT+IBYT,24,MBAY(1,LUN),LBIT)
C EXITS
C -----
RETURN
900 WRITE(BORT_STR,'("BUFRLIB: CPYUPD - THE LENGTH OF THIS SUBSET '//
. 'EXCEEDS THE MAXIMUM MESSAGE LENGTH (",I6,")")') MAXBYT
CALL BORT(BORT_STR)
END