NCEPLIBS-bufr  12.0.0
cpymem.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Copy a BUFR message.
3 C>
4 C> @author J. Woollen @date 1994-01-06
5 
6 C> Copy a BUFR message from internal arrays to a file.
7 C>
8 C> This subroutine is similar to subroutine copymg(), except that
9 C> it copies a BUFR message from internal arrays in memory to a
10 C> specified Fortran logical unit, whereas copymg() copies a BUFR
11 C> message from one Fortran logical unit to another.
12 C>
13 C> One or more files of BUFR messages should have already been
14 C> read into internal arrays in memory via one or more previous
15 C> calls to subroutine ufbmem(), and a BUFR message should already
16 C> be in scope for processing from these arrays via a previous call
17 C> to subroutine rdmemm() or readmm().
18 C>
19 C> Logical unit LUNOT should have already been opened for output
20 C> operations via a previous call to subroutine openbf(), but there
21 C> should not be any BUFR message already open for output within the
22 C> internal arrays for LUNOT via a previous call to one of the
23 C> [message-writing subroutines](@ref hierarchy).
24 C>
25 C> The [DX BUFR Table information](@ref dfbftab) associated with
26 C> the internal arrays in memory and with logical unit LUNOT must
27 C> contain identical definitions for the type of BUFR message to be
28 C> copied from the former to the latter.
29 C>
30 C> This subroutine uses subroutine msgwrt() to write to LUNOT;
31 C> therefore, it can be used to transform a copy of the
32 C> original BUFR message from memory with any or all of the updates
33 C> described in the documentation for subroutine msgwrt().
34 C>
35 C> @param[in] LUNOT - integer: Fortran logical unit number for
36 C> target BUFR file.
37 C>
38 C> @author J. Woollen @date 1994-01-06
39  RECURSIVE SUBROUTINE cpymem(LUNOT)
40 
41  USE moda_msgcwd
42  USE moda_bitbuf
43  USE moda_msgmem
44  USE moda_tables
45  USE modv_im8b
46 
47  CHARACTER*8 subset
48 
49 C-----------------------------------------------------------------------
50 C-----------------------------------------------------------------------
51 
52 C CHECK FOR I8 INTEGERS
53 C ---------------------
54 
55  IF(im8b) THEN
56  im8b=.false.
57 
58  CALL x84(lunot,my_lunot,1)
59  CALL cpymem(my_lunot)
60 
61  im8b=.true.
62  RETURN
63  ENDIF
64 
65 C CHECK THE FILE STATUSES
66 C -----------------------
67 
68  CALL status(munit,lin,il,im)
69  IF(il.EQ.0) GOTO 900
70  IF(il.GT.0) GOTO 901
71  IF(im.EQ.0) GOTO 902
72 
73  CALL status(lunot,lot,il,im)
74  IF(il.EQ.0) GOTO 903
75  IF(il.LT.0) GOTO 904
76  IF(im.NE.0) GOTO 905
77 
78 C MAKE SURE BOTH FILES HAVE THE SAME TABLES
79 C -----------------------------------------
80 
81  subset = tag(inode(lin))(1:8)
82 c .... Given SUBSET, returns MTYP,MSBT,INOD
83  CALL nemtba(lot,subset,mtyp,msbt,inod)
84  IF(inode(lin).NE.inod) THEN
85  IF(iok2cpy(lin,lot).NE.1) GOTO 906
86  ENDIF
87 
88 C EVERYTHING OKAY, COPY A MESSAGE
89 C -------------------------------
90 
91  mbym = iupbs01(mbay(1,lin),'LENM')
92  CALL msgwrt(lunot,mbay(1,lin),mbym)
93 
94 C SET THE MESSAGE CONTROL WORDS FOR PARTITION ASSOCIATED WITH LUNOT
95 C -----------------------------------------------------------------
96 
97  nmsg(lot) = nmsg(lot) + 1
98  nsub(lot) = msub(lin)
99  msub(lot) = msub(lin)
100  idate(lot) = idate(lin)
101  inode(lot) = inod
102 
103 C EXITS
104 C -----
105 
106  RETURN
107 900 CALL bort('BUFRLIB: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
108  . ' BUFR MESSAGES IN INTERNAL MEMORY IS CLOSED, IT MUST BE OPEN '//
109  . 'FOR INPUT')
110 901 CALL bort('BUFRLIB: CPYMEM - LOGICAL UNIT NO. ASSOC. WITH INPUT'//
111  . ' BUFR MESSAGES IN INTERNAL MEMORY OPEN FOR OUTPUT, MUST BE '//
112  . ' OPEN FOR INPUT')
113 902 CALL bort('BUFRLIB: CPYMEM - A MESSAGE MUST BE OPEN IN INPUT '//
114  . 'BUFR MESSAGES IN INTERNAL MEMORY, NONE ARE')
115 903 CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS CLOSED, IT '//
116  . 'MUST BE OPEN FOR OUTPUT')
117 904 CALL bort('BUFRLIB: CPYMEM - OUTPUT BUFR FILE IS OPEN FOR '//
118  . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
119 905 CALL bort('BUFRLIB: CPYMEM - ALL MESSAGES MUST BE CLOSED IN '//
120  . 'OUTPUT BUFR FILE, A MESSAGE IS OPEN')
121 906 CALL bort('BUFRLIB: CPYMEM - INPUT BUFR MESSAGES IN INTERNAL '//
122  . 'MEMORY AND OUTPUT BUFR FILE MUST HAVE SAME INTERNAL TABLES '//
123  . '(DIFFERENT HERE)')
124 
125  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
recursive subroutine cpymem(LUNOT)
Copy a BUFR message from internal arrays to a file.
Definition: cpymem.f:40
integer function iok2cpy(LUI, LUO)
This function determines whether a BUFR message, or a data subset from within a BUFR message,...
Definition: iok2cpy.f:28
recursive function iupbs01(MBAY, S01MNEM)
Read a data value from Section 0 or Section 1 of a BUFR message.
Definition: iupbs01.f:69
subroutine msgwrt(LUNIT, MESG, MGBYT)
Perform final checks and updates on a BUFR message before writing it to a specified Fortran logical u...
Definition: msgwrt.f:38
This module contains array and variable declarations used to store BUFR messages internally for multi...
integer, dimension(:,:), allocatable mbay
Current BUFR message for each internal I/O stream.
This module contains declarations for arrays used to store information about the current BUFR message...
integer, dimension(:), allocatable inode
Table A mnemonic for type of BUFR message.
integer, dimension(:), allocatable idate
Section 1 date-time of message.
integer, dimension(:), allocatable nmsg
Current message pointer within logical unit.
integer, dimension(:), allocatable msub
Total number of data subsets in message.
integer, dimension(:), allocatable nsub
Current subset pointer within message.
This module contains array and variable declarations used to store the contents of one or more BUFR f...
integer munit
Fortran logical unit number for use in accessing contents of BUFR files within internal memory.
This module contains array and variable declarations used to store the internal jump/link table.
character *10, dimension(:), allocatable tag
Mnemonics in the jump/link table.
This module declares and initializes the IM8B variable.
logical, public im8b
Status indicator to keep track of whether all future calls to BUFRLIB subroutines and functions from ...
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:25
recursive subroutine status(LUNIT, LUN, IL, IM)
Check whether a specified Fortran logical unit number is currently connected to the NCEPLIBS-bufr sof...
Definition: status.f:36
subroutine x84(IIN8, IOUT4, NVAL)
Encode one or more 8-byte integer values as 4-byte integer values.
Definition: x84.F:19