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 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 MSGINI MSGWRT C 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 C----------------------------------------------------------------------- C----------------------------------------------------------------------- C SEE IF THE NEW SUBSET FITS C -------------------------- IF(MBYT(LUN)+IBYT+8.GT.MAXBYT) THEN CALL MSGWRT(LUNIT,MBAY(1,LUN),MBYT(LUN)) CALL MSGINI(LUN) ENDIF IF(MBYT(LUN)+IBYT+8.GT.MAXBYT) GOTO 900 C TRANSFER SUBSET FROM ONE MESSAGE TO THE OTHER C --------------------------------------------- c .... DK: Why the -3 in "MBYT(LUN)-3" ?? 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 '// . '(",I6," EXCEEDS THE MAXIMUM MESSAGE LENGTH (",I6,")")') . MBYT(LUN)+IBYT+8,MAXBYT CALL BORT(BORT_STR) END