NCEPLIBS-bufr  12.0.0
copymg.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Copy a BUFR message from one file to another.
3 C>
4 C> @author J. Woollen @date 1994-01-06
5 
6 C> Copy a BUFR message from one file to another.
7 C>
8 C> This subroutine is similar to subroutine cpymem(), except that
9 C> it copies a BUFR message from one Fortran logical unit to another,
10 C> whereas cpymem() copies a BUFR message from internal arrays in
11 C> memory to a specified Fortran logical unit.
12 C>
13 C> Logical unit LUNIN should have already been opened for input
14 C> operations via a previous call to subroutine openbf(). A BUFR
15 C> message should have already been read into internal arrays for
16 C> LUNIN via a previous call to one of the
17 C> [message-reading subroutines](@ref hierarchy).
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> each of the logical units LUNIN and LUNOT must contain identical
27 C> definitions for the type of BUFR message to be copied from LUNIN
28 C> to LUNOT.
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 LUNIN with any or all of the updates
33 C> described in the documentation for subroutine msgwrt().
34 C>
35 C> @param[in] LUNIN - integer: Fortran logical unit number for
36 C> source BUFR file.
37 C> @param[in] LUNOT - integer: Fortran logical unit number for
38 C> target BUFR file.
39 C>
40 C> @author J. Woollen @date 1994-01-06
41  RECURSIVE SUBROUTINE copymg(LUNIN,LUNOT)
42 
43  USE moda_msgcwd
44  USE moda_bitbuf
45  USE moda_tables
46  USE modv_im8b
47 
48  CHARACTER*8 subset
49 
50 C-----------------------------------------------------------------------
51 C-----------------------------------------------------------------------
52 
53 C CHECK FOR I8 INTEGERS
54 C ---------------------
55 
56  IF(im8b) THEN
57  im8b=.false.
58 
59  CALL x84(lunin,my_lunin,1)
60  CALL x84(lunot,my_lunot,1)
61  CALL copymg(my_lunin,my_lunot)
62 
63  im8b=.true.
64  RETURN
65  ENDIF
66 
67 C CHECK THE FILE STATUSES
68 C -----------------------
69 
70  CALL status(lunin,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))(1:8)
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: COPYMG - INPUT BUFR FILE IS CLOSED, IT MUST'//
110  . ' BE OPEN FOR INPUT')
111 901 CALL bort('BUFRLIB: COPYMG - INPUT BUFR FILE IS OPEN FOR '//
112  . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
113 902 CALL bort('BUFRLIB: COPYMG - A MESSAGE MUST BE OPEN IN INPUT '//
114  . 'BUFR FILE, NONE ARE')
115 903 CALL bort('BUFRLIB: COPYMG - OUTPUT BUFR FILE IS CLOSED, IT '//
116  . 'MUST BE OPEN FOR OUTPUT')
117 904 CALL bort('BUFRLIB: COPYMG - OUTPUT BUFR FILE IS OPEN FOR '//
118  . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
119 905 CALL bort('BUFRLIB: COPYMG - ALL MESSAGES MUST BE CLOSED IN '//
120  . 'OUTPUT BUFR FILE, A MESSAGE IS OPEN')
121 906 CALL bort('BUFRLIB: COPYMG - INPUT AND OUTPUT BUFR FILES MUST '//
122  . 'HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
123  END
subroutine bort(STR)
Log one error message and abort application program.
Definition: bort.f:18
recursive subroutine copymg(LUNIN, LUNOT)
Copy a BUFR message from one file to another.
Definition: copymg.f:42
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 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