cpbfdx.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS SUBROUTINE COPIES BUFR TABLE (DICTIONARY) MESSAGES
C>   FROM ONE LOCATION TO ANOTHER WITHIN INTERNAL MEMORY (ARRAYS IN
C>   MODULE MSGCWD AND TABABD).
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1995-06-28  J. WOOLLEN -- INCREASED THE SIZE OF INTERNAL BUFR TABLE
C>                           ARRAYS IN ORDER TO HANDLE BIGGER FILES
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> 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)
C> 2014-12-10  J. ATOR    -- USE MODULES INSTEAD OF COMMON BLOCKS
C>
C> USAGE:    CALL CPBFDX (LUD, LUN)
C>   INPUT ARGUMENT LIST:
C>     LUD      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>                FOR INPUT TABLE LOCATION
C>     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C>                FOR OUTPUT TABLE LOCATION
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        DXINIT
C>    THIS ROUTINE IS CALLED BY: MAKESTAB READDX   WRDXTB
C>                               Normally not called by any application
C>                               programs.
C>
      SUBROUTINE cpbfdx(LUD,LUN)
 
      USE moda_msgcwd
      USE moda_tababd
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  INITIALIZE THE DICTIONARY TABLE PARTITION
C  -----------------------------------------
 
      CALL dxinit(lun,0)
 
C  COPY ONE TABLE PARTITION TO ANOTHER
C  -----------------------------------
 
c  .... Positional index for Table A mnem.
      inode(lun) = inode(lud)
 
c  .... Set the number of Table A entries
      ntba(lun) = ntba(lud)
c  .... Set the number of Table B entries
      ntbb(lun) = ntbb(lud)
c  .... Set the number of Table D entries
      ntbd(lun) = ntbd(lud)
 
c  .... Copy Table A entries
      DO i=1,ntba(lud)
c  .... Message type
      idna(i,lun,1) = idna(i,lud,1)
c  .... Message subtype
      idna(i,lun,2) = idna(i,lud,2)
c  .... Table A entries
      taba(i,lun) = taba(i,lud)
c  .... Pointer indices into internal tbl
      mtab(i,lun) = mtab(i,lud)
      ENDDO
 
c  .... Copy Table B entries
      DO i=1,ntbb(lud)
c  .... Integer repr. of FXY descr.
      idnb(i,lun) = idnb(i,lud)
c  .... Table B entries
      tabb(i,lun) = tabb(i,lud)
      ENDDO
 
c  .... Copy Table D entries
      DO i=1,ntbd(lud)
c  .... Integer repr. of FXY descr.
      idnd(i,lun) = idnd(i,lud)
c  .... Table B entries
      tabd(i,lun) = tabd(i,lud)
      ENDDO
 
      RETURN
      END