copymg.f

Go to the documentation of this file.

C> @file
C> @brief Copy a BUFR message.
 
C> This subroutine copies a BUFR message from one Fortran logical unit
C> to another.
C>
C> <p>This subroutine is similar to subroutine cpymem(), except that
C> it copies a BUFR message from one Fortran logical unit to another,
C> whereas cpymem() copies a BUFR message from internal arrays in
C> memory to a specified Fortran logical unit.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] LUNIN   -- integer: Fortran logical unit number for
C>                       source BUFR file
C> @param[in] LUNOT   -- integer: Fortran logical unit number for
C>                       target BUFR file
C>
C> <p>Logical unit LUNIN should have already been opened for input
C> operations via a previous call to subroutine openbf(), and a BUFR
C> message should have already been read into internal arrays for
C> LUNIN via a previous call to one of the
C> [message-reading subroutines](@ref hierarchy).
C>
C> <p>Logical unit LUNOT should have already been opened for output
C> operations via a previous call to subroutine openbf(), but there
C> should not be any BUFR message already open for output within the
C> internal arrays for LUNOT via a previous call to one of the BUFRLIB
C> [message-writing subroutines](@ref hierarchy).
C>
C> <p>The [DX BUFR Table information](@ref dfbftab) associated with
C> each of the logical units LUNIN and LUNOT must contain identical
C> definitions for the type of BUFR message to be copied from LUNIN
C> to LUNOT.
C>
C> @remarks
C> - This subroutine uses subroutine msgwrt() to write to LUNOT;
C> therefore, it can be used to transform a copy of the
C> original BUFR message from LUNIN with any or all of the updates
C> described in the documentation for subroutine msgwrt().
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine "ABORT" with call to new internal routine bort() |
C> | 1999-11-18 | J. Woollen | The number of BUFR files which can be opened at one time increased from 10 to 32 (necessary in order to process multiple BUFR files under the MPI) |
C> | 2000-09-19 | J. Woollen | Maximum message length increased from 10,000 to 20,000 bytes |
C> | 2004-08-09 | J. Ator | Maximum message length increased from 20,000 to 50,000 bytes |
C> | 2005-11-29 | J. Ator | Use iupbs01() |
C> | 2009-06-26 | J. Ator | Use iok2cpy() |
C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
C>
      SUBROUTINE copymg(LUNIN,LUNOT)
 
      USE moda_msgcwd
      USE moda_bitbuf
      USE moda_tables
 
      CHARACTER*8  SUBSET
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK THE FILE STATUSES
C  -----------------------
 
      CALL status(lunin,lin,il,im)
      IF(il.EQ.0) GOTO 900
      IF(il.GT.0) GOTO 901
      IF(im.EQ.0) GOTO 902
 
      CALL status(lunot,lot,il,im)
      IF(il.EQ.0) GOTO 903
      IF(il.LT.0) GOTO 904
      IF(im.NE.0) GOTO 905
 
C  MAKE SURE BOTH FILES HAVE THE SAME TABLES
C  -----------------------------------------
 
      subset = tag(inode(lin))
c  .... Given SUBSET, returns MTYP,MSBT,INOD
      CALL nemtba(lot,subset,mtyp,msbt,inod)
      IF(inode(lin).NE.inod) THEN
        IF(iok2cpy(lin,lot).NE.1) GOTO 906
      ENDIF
 
C  EVERYTHING OKAY, COPY A MESSAGE
C  -------------------------------
 
      mbym = iupbs01(mbay(1,lin),'LENM')
      CALL msgwrt(lunot,mbay(1,lin),mbym)
 
C  SET THE MESSAGE CONTROL WORDS FOR PARTITION ASSOCIATED WITH LUNOT
C  -----------------------------------------------------------------
 
      nmsg(lot) = nmsg(lot) + 1
      nsub(lot) = msub(lin)
      msub(lot) = msub(lin)
      idate(lot) = idate(lin)
      inode(lot) = inod
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort('BUFRLIB: COPYMG - INPUT BUFR FILE IS CLOSED, IT MUST'//
     . ' BE OPEN FOR INPUT')
901   CALL bort('BUFRLIB: COPYMG - INPUT BUFR FILE IS OPEN FOR '//
     . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
902   CALL bort('BUFRLIB: COPYMG - A MESSAGE MUST BE OPEN IN INPUT '//
     . 'BUFR FILE, NONE ARE')
903   CALL bort('BUFRLIB: COPYMG - OUTPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR OUTPUT')
904   CALL bort('BUFRLIB: COPYMG - OUTPUT BUFR FILE IS OPEN FOR '//
     . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
905   CALL bort('BUFRLIB: COPYMG - ALL MESSAGES MUST BE CLOSED IN '//
     . 'OUTPUT BUFR FILE, A MESSAGE IS OPEN')
906   CALL bort('BUFRLIB: COPYMG - INPUT AND OUTPUT BUFR FILES MUST '//
     . 'HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
      END