NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
cpymem.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Copy a BUFR message.
3 
4 C> This subroutine copies a BUFR message from internal arrays in
5 C> memory to a specified Fortran logical unit.
6 C>
7 C> <p>This subroutine is similar to subroutine copymg(), except that
8 C> it copies a BUFR message from internal arrays in memory to a
9 C> specified Fortran logical unit, whereas copymg() copies a BUFR
10 C> message from one Fortran logical unit to another.
11 C>
12 C> @author J. Woollen
13 C> @date 1994-01-06
14 C>
15 C> @param[in] LUNOT -- integer: Fortran logical unit number for
16 C> target BUFR file
17 C>
18 C> <p>One or more files of BUFR messages should have already been
19 C> read into internal arrays in memory via one or more previous
20 C> calls to subroutine ufbmem(), and a BUFR message should already
21 C> be in scope for processing from these arrays via a previous call
22 C> to subroutine rdmemm() or readmm().
23 C>
24 C> <p>Logical unit LUNOT should have already been opened for output
25 C> operations via a previous call to subroutine openbf(), but there
26 C> should not be any BUFR message already open for output within the
27 C> internal arrays for LUNOT via a previous call to one of the BUFRLIB
28 C> [message-writing subroutines](@ref hierarchy).
29 C>
30 C> <p>The [DX BUFR Table information](@ref dfbftab) associated with
31 C> the internal arrays in memory and with logical unit LUNOT must
32 C> contain identical definitions for the type of BUFR message to be
33 C> copied from the former to the latter.
34 C>
35 C> @remarks
36 C> - This subroutine uses subroutine msgwrt() to write to LUNOT;
37 C> therefore, it can be used to transform a copy of the
38 C> original BUFR message from memory with any or all of the updates
39 C> described in the documentation for subroutine msgwrt().
40 C>
41 C> <b>Program history log:</b>
42 C> | Date | Programmer | Comments |
43 C> | -----|------------|----------|
44 C> | 1994-01-06 | J. Woollen | Original author |
45 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
46 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) |
47 C> | 2000-09-19 | J. Woollen | Maximum message length increased from 10,000 to 20,000 bytes |
48 C> | 2001-08-15 | D. Keyser | Increased MAXMEM from 8 Mb to 16 Mb |
49 C> | 2004-08-09 | J. Ator | Maximum message length increased from 20,000 to 50,000 bytes |
50 C> | 2004-11-15 | D. Keyser | Increased MAXMEM from 16 Mb to 50 Mb |
51 C> | 2005-11-29 | J. Ator | Use iupbs01() |
52 C> | 2009-06-26 | J. Ator | Use iok2cpy() |
53 C> | 2014-12-10 | J. Ator | Use modules instead of COMMON blocks |
54 C>
55  SUBROUTINE cpymem(LUNOT)
56 
57  USE moda_msgcwd
58  USE moda_bitbuf
59  USE moda_msgmem
60  USE moda_tables
61 
62  CHARACTER*8 subset
63 
64 C-----------------------------------------------------------------------
65 C-----------------------------------------------------------------------
66 
67 C CHECK THE FILE STATUSES
68 C -----------------------
69 
70  CALL status(munit,lin,il,im)
71  IF(il.EQ.0) goto 900
72  IF(il.GT.0) goto 901
73  IF(im.EQ.0) goto 902
74 
75  CALL status(lunot,lot,il,im)
76  IF(il.EQ.0) goto 903
77  IF(il.LT.0) goto 904
78  IF(im.NE.0) goto 905
79 
80 C MAKE SURE BOTH FILES HAVE THE SAME TABLES
81 C -----------------------------------------
82 
83  subset = tag(inode(lin))
84 c .... Given SUBSET, returns MTYP,MSBT,INOD
85  CALL nemtba(lot,subset,mtyp,msbt,inod)
86  IF(inode(lin).NE.inod) THEN
87  IF(iok2cpy(lin,lot).NE.1) goto 906
88  ENDIF
89 
90 C EVERYTHING OKAY, COPY A MESSAGE
91 C -------------------------------
92 
93  mbym = iupbs01(mbay(1,lin),'LENM')
94  CALL msgwrt(lunot,mbay(1,lin),mbym)
95 
96 C SET THE MESSAGE CONTROL WORDS FOR PARTITION ASSOCIATED WITH LUNOT
97 C -----------------------------------------------------------------
98 
99  nmsg(lot) = nmsg(lot) + 1
100  nsub(lot) = msub(lin)
101  msub(lot) = msub(lin)
102  idate(lot) = idate(lin)
103  inode(lot) = inod
104 
105 C EXITS
106 C -----
107 
108  RETURN
109 900 CALL bort('BUFRLIB: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
110  . ' BUFR MESSAGES IN INTERNAL MEMORY IS CLOSED, IT MUST BE OPEN '//
111  . 'FOR INPUT')
112 901 CALL bort('BUFRLIB: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
113  . ' BUFR MESSAGES IN INTERNAL MEMORY OPEN FOR OUTPUT, MUST BE '//
114  . ' OPEN FOR INPUT')
115 902 CALL bort('BUFRLIB: CPYMEM - A MESSAGE MUST BE OPEN IN INPUT '//
116  . 'BUFR MESSAGES IN INTERNAL MEMORY, NONE ARE')
117 903 CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS CLOSED, IT '//
118  . 'MUST BE OPEN FOR OUTPUT')
119 904 CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS OPEN FOR '//
120  . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
121 905 CALL bort('BUFRLIB: CPYMEM - ALL MESSAGES MUST BE CLOSED IN '//
122  . 'OUTPUT BUFR FILE, A MESSAGE IS OPEN')
123 906 CALL bort('BUFRLIB: CPYMEM - INPUT BUFR MESSAGES IN INTERNAL '//
124  . 'MEMORY AND OUTPUT BUFR FILE MUST HAVE SAME INTERNAL TABLES '//
125  . '(DIFFERENT HERE)')
126 
127  END
subroutine msgwrt(LUNIT, MESG, MGBYT)
This subroutine performs final checks and updates on a BUFR message before writing it to a specified ...
Definition: msgwrt.f:54
subroutine cpymem(LUNOT)
This subroutine copies a BUFR message from internal arrays in memory to a specified Fortran logical u...
Definition: cpymem.f:55
This module contains array and variable declarations used to store the contents of one or more BUFR f...
Definition: moda_msgmem.F:14
This module contains array and variable declarations used to store the internal jump/link table...
Definition: moda_tables.F:13
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
Definition: status.f:55
INTEGER function iok2cpy(LUI, LUO)
This function determines whether a BUFR message, or a data subset from within a BUFR message...
Definition: iok2cpy.f:37
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
This module contains array and variable declarations used to store BUFR messages internally for multi...
Definition: moda_bitbuf.F:10
subroutine nemtba(LUN, NEMO, MTYP, MSBT, INOD)
This subroutine searches for a descriptor within Table A of the internal DX BUFR tables.
Definition: nemtba.f:35
function iupbs01(MBAY, S01MNEM)
This function returns a specified value from within Section 0 or Section 1 of a BUFR message...
Definition: iupbs01.f:73