cpymem.f

Go to the documentation of this file.

C> @file
C> @brief Copy a BUFR message.

C> This subroutine copies a BUFR message from internal arrays in
C> memory to a specified Fortran logical unit.
C>
C> <p>This subroutine is similar to subroutine copymg(), except that
C> it copies a BUFR message from internal arrays in memory to a
C> specified Fortran logical unit, whereas copymg() copies a BUFR
C> message from one Fortran logical unit to another.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] LUNOT    - integer: Fortran logical unit number for
C>                       target BUFR file
C>
C> <p>One or more files of BUFR messages should have already been
C> read into internal arrays in memory via one or more previous
C> calls to subroutine ufbmem(), and a BUFR message should already
C> be in scope for processing from these arrays via a previous call
C> to subroutine rdmemm() or readmm().
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> the internal arrays in memory and with logical unit LUNOT must
C> contain identical definitions for the type of BUFR message to be
C> copied from the former to the latter.
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 memory with any or all of the updates
C> described in the documentation for subroutine msgwrt().
C>
C> <b>Program history log:</b>
C> - 1994-01-06  J. Woollen -- Original author
C> - 1998-07-08  J. Woollen -- Replaced call to Cray library routine ABORT
C>                             with call to new internal 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
C>                             from 10,000 to 20,000 bytes
C> - 2001-08-15  D. Keyser  -- Increased MAXMEM from 8 Mb to 16 Mb
C> - 2004-08-09  J. Ator    -- Maximum message length increased
C>                             from 20,000 to 50,000 bytes
C> - 2004-11-15  D. Keyser  -- Increased MAXMEM from 16 Mb to 50 Mb
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 cpymem(LUNOT)

      USE moda_msgcwd
      USE moda_bitbuf
      USE moda_msgmem
      USE moda_tables

      CHARACTER*8  subset

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

C  CHECK THE FILE STATUSES
C  -----------------------

      CALL status(munit,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: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
     . ' BUFR MESSAGES IN INTERNAL MEMORY IS CLOSED, IT MUST BE OPEN '//
     . 'FOR INPUT')
901   CALL bort('BUFRLIB: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
     . ' BUFR MESSAGES IN INTERNAL MEMORY OPEN FOR OUTPUT, MUST BE '//
     . ' OPEN FOR INPUT')
902   CALL bort('BUFRLIB: CPYMEM - A MESSAGE MUST BE OPEN IN INPUT '//
     . 'BUFR MESSAGES IN INTERNAL MEMORY, NONE ARE')
903   CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR OUTPUT')
904   CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS OPEN FOR '//
     . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
905   CALL bort('BUFRLIB: CPYMEM - ALL MESSAGES MUST BE CLOSED IN '//
     . 'OUTPUT BUFR FILE, A MESSAGE IS OPEN')
906   CALL bort('BUFRLIB: CPYMEM - INPUT BUFR MESSAGES IN INTERNAL '//
     . 'MEMORY AND OUTPUT BUFR FILE MUST HAVE SAME INTERNAL TABLES '//
     . '(DIFFERENT HERE)')

      END