SUBROUTINE CPYUPD(LUNIT,LIN,LUN,IBYT) 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