<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='INVMRG'><A href='../../html_code/bufr/invmrg.f.html#INVMRG' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
SUBROUTINE INVMRG(LUBFI,LUBFJ) 1
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: INVMRG
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1996-10-09
C
<A NAME='MERGES'><A href='../../html_code/bufr/invmrg.f.html#MERGES' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
C ABSTRACT: THIS SUBROUTINE MERGES "PARTS" OF SUBSETS WHICH HAVE,8
C DUPLICATE SPACE AND TIME COORDINATES BUT DIFFERENT OR UNIQUE
C OBSERVATIONAL DATA. IT CANNOT MERGE REPLICATED DATA.
C
C PROGRAM HISTORY LOG:
C 1996-10-09 J. WOOLLEN -- ORIGINAL AUTHOR
C 1996-11-25 J. WOOLLEN -- MODIFIED FOR RADIOSONDE CALL SIGNS
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 2002-05-14 J. WOOLLEN -- REMOVED OLD CRAY COMPILER DIRECTIVES;
C REMOVED ENTRY POINT MRGINV (IT BECAME A
C SEPARATE ROUTINE IN THE BUFRLIB TO
C INCREASE PORTABILITY TO OTHER PLATFORMS)
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
C INCREASED FROM 15000 TO 16000 (WAS IN
C VERIFICATION VERSION); UNIFIED/PORTABLE FOR
C WRF; ADDED DOCUMENTATION (INCLUDING
C HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
C INFO WHEN ROUTINE TERMINATES ABNORMALLY
C 2007-01-19 J. ATOR -- USE FUNCTION IBFMS AND SIMPLIFY LOGIC
C
C USAGE: CALL INVMRG
(LUBFI, LUBFJ)
C INPUT ARGUMENT LIST:
C LUBFI - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR INPUT BUFR
C FILE
C LUBFJ - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR OUTPUT BUFR
C FILE
C
C REMARKS:
C THIS ROUTINE CALLS: BORT IBFMS NWORDS STATUS
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MRGCOM/ NRPL,NMRG,NAMB,NTOT
COMMON /USRINT/ NVAL(NFILES),INV(MAXSS,NFILES),VAL(MAXSS,NFILES)
COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
. JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
. IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
. ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
. ISEQ(MAXJL,2),JSEQ(MAXJL)
CHARACTER*128 BORT_STR
CHARACTER*10 TAG
CHARACTER*3 TYP
LOGICAL HEREI,HEREJ,MISSI,MISSJ,SAMEI
REAL*8 VAL
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
IS = 1
JS = 1
C GET THE UNIT POINTERS
C ---------------------
CALL STATUS(LUBFI,LUNI,IL,IM)
CALL STATUS(LUBFJ,LUNJ,JL,JM)
C STEP THROUGH THE BUFFERS COMPARING THE INVENTORY AND MERGING DATA
C -----------------------------------------------------------------
DO WHILE(IS.LE.NVAL(LUNI))
C CHECK TO SEE WE ARE AT THE SAME NODE IN EACH BUFFER
C ---------------------------------------------------
NODE = INV(IS,LUNI)
NODJ = INV(JS,LUNJ)
IF(NODE.NE.NODJ) GOTO 900
ITYP = ITP(NODE)
C FOR TYPE 1 NODES DO AN ENTIRE SEQUENCE REPLACEMENT
C --------------------------------------------------
IF(ITYP.EQ.1) THEN
IF(TYP(NODE).EQ.'DRB') IOFF = 0
IF(TYP(NODE).NE.'DRB') IOFF = 1
IWRDS = NWORDS(IS,LUNI)+IOFF
JWRDS = NWORDS(JS,LUNJ)+IOFF
IF(IWRDS.GT.IOFF .AND. JWRDS.EQ.IOFF) THEN
DO N=NVAL(LUNJ),JS+1,-1
INV(N+IWRDS-JWRDS,LUNJ) = INV(N,LUNJ)
VAL(N+IWRDS-JWRDS,LUNJ) = VAL(N,LUNJ)
ENDDO
DO N=0,IWRDS
INV(JS+N,LUNJ) = INV(IS+N,LUNI)
VAL(JS+N,LUNJ) = VAL(IS+N,LUNI)
ENDDO
NVAL(LUNJ) = NVAL(LUNJ)+IWRDS-JWRDS
JWRDS = IWRDS
NRPL = NRPL+1
ENDIF
IS = IS+IWRDS
JS = JS+JWRDS
ENDIF
C FOR TYPES 2 AND 3 FILL MISSINGS
C -------------------------------
IF((ITYP.EQ.2).OR.(ITYP.EQ.3)) THEN
HEREI = IBFMS(VAL(IS,LUNI)).EQ.0
HEREJ = IBFMS(VAL(JS,LUNJ)).EQ.0
MISSI = .NOT.(HEREI)
MISSJ = .NOT.(HEREJ)
SAMEI = VAL(IS,LUNI).EQ.VAL(JS,LUNJ)
IF(HEREI.AND.MISSJ) THEN
VAL(JS,LUNJ) = VAL(IS,LUNI)
NMRG = NMRG+1
ELSEIF(HEREI.AND.HEREJ.AND..NOT.SAMEI) THEN
NAMB = NAMB+1
ENDIF
ENDIF
C BUMP THE COUNTERS AND GO CHECK THE NEXT PAIR
C --------------------------------------------
IS = IS + 1
JS = JS + 1
ENDDO
NTOT = NTOT+1
C EXITS
C -----
RETURN
900 WRITE(BORT_STR,'("BUFRLIB: INVMRG - NODE FROM INPUT BUFR FILE '//
. '(",I7,") DOES NOT EQUAL NODE FROM OUTPUT BUFR FILE (",I7,"), '//
. 'TABULAR MISMATCH")') NODE,NODJ
CALL BORT(BORT_STR)
END