NCEPLIBS-bufr  11.7.0
 All Data Structures Files Functions Variables Pages
ufbcpy.f
Go to the documentation of this file.
1 C> @file
2 C> @author WOOLLEN @date 1994-01-06
3 
4 C> THIS SUBROUTINE COPIES A COMPLETE SUBSET BUFFER, UNPACKED
5 C> INTO INTERNAL MEMORY FROM LOGICAL UNIT LUBIN BY A PREVIOUS CALL
6 C> TO BUFR ARCHIVE LIBRARY SUBROUTINE READSB OR READNS, TO
7 C> LOGICAL UNIT LUBOT. BUFR ARCHIVE LIBRARY SUBROUTINE OPENMG OR
8 C> OPENMB MUST HAVE BEEN PREVIOUSLY CALLED TO OPEN AND INITIALIZE A
9 C> BUFR MESSAGE WITHIN MEMORY FOR LOGICAL UNIT LUBOT. BOTH FILES MUST
10 C> HAVE BEEN OPENED TO THE INTERFACE (VIA A CALL TO BUFR ARCHIVE
11 C> LIBRARY SUBROUTINE OPENBF) WITH IDENTICAL BUFR TABLES.
12 C>
13 C> PROGRAM HISTORY LOG:
14 C> 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
15 C> 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
16 C> "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
17 C> ROUTINE "BORT"
18 C> 1999-11-18 J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
19 C> OPENED AT ONE TIME INCREASED FROM 10 TO 32
20 C> (NECESSARY IN ORDER TO PROCESS MULTIPLE
21 C> BUFR FILES UNDER THE MPI)
22 C> 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
23 C> INTERDEPENDENCIES
24 C> 2003-11-04 D. KEYSER -- MAXJL (MAXIMUM NUMBER OF JUMP/LINK ENTRIES)
25 C> INCREASED FROM 15000 TO 16000 (WAS IN
26 C> VERIFICATION VERSION); UNIFIED/PORTABLE FOR
27 C> WRF; ADDED DOCUMENTATION (INCLUDING
28 C> HISTORY); OUTPUTS MORE COMPLETE DIAGNOSTIC
29 C> INFO WHEN ROUTINE TERMINATES ABNORMALLY
30 C> 2009-06-26 J. ATOR -- USE IOK2CPY
31 C> 2009-08-11 J. WOOLLEN -- ADD COMMON UFBCPL TO REMEMBER WHICH UNIT
32 C> IS COPIED TO WHAT SUBSET BUFFER IN ORDER TO
33 C> TRANSFER LONG STRINGS VIA UFBCPY AND WRTREE
34 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
35 C>
36 C> USAGE: CALL UFBCPY (LUBIN, LUBOT)
37 C> INPUT ARGUMENT LIST:
38 C> LUBIT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR INPUT BUFR
39 C> FILE
40 C> LUBOT - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR OUTPUT BUFR
41 C> FILE
42 C>
43 C> REMARKS:
44 C> THIS ROUTINE CALLS: BORT IOK2CPY STATUS
45 C> THIS ROUTINE IS CALLED BY: COPYSB
46 C> Also called by application programs.
47 C>
48  SUBROUTINE ufbcpy(LUBIN,LUBOT)
49 
50  USE moda_usrint
51  USE moda_msgcwd
52  USE moda_ufbcpl
53  USE moda_tables
54 
55 C----------------------------------------------------------------------
56 C----------------------------------------------------------------------
57 
58 C CHECK THE FILE STATUSES AND I-NODE
59 C ----------------------------------
60 
61  CALL status(lubin,lui,il,im)
62  IF(il.EQ.0) goto 900
63  IF(il.GT.0) goto 901
64  IF(im.EQ.0) goto 902
65  IF(inode(lui).NE.inv(1,lui)) goto 903
66 
67  CALL status(lubot,luo,il,im)
68  IF(il.EQ.0) goto 904
69  IF(il.LT.0) goto 905
70  IF(im.EQ.0) goto 906
71 
72  IF(inode(lui).NE.inode(luo)) THEN
73  IF( (tag(inode(lui)).NE.tag(inode(luo))) .OR.
74  . (iok2cpy(lui,luo).NE.1) ) goto 907
75  ENDIF
76 
77 C EVERYTHING OKAY COPY USER ARRAY FROM LUI TO LUO
78 C -----------------------------------------------
79 
80  nval(luo) = nval(lui)
81 
82  DO n=1,nval(lui)
83  inv(n,luo) = inv(n,lui)
84  nrfelm(n,luo) = nrfelm(n,lui)
85  val(n,luo) = val(n,lui)
86  ENDDO
87 
88  luncpy(luo)=lubin
89 
90 C EXITS
91 C -----
92 
93  RETURN
94 900 CALL bort('BUFRLIB: UFBCPY - INPUT BUFR FILE IS CLOSED, IT MUST'//
95  . ' BE OPEN FOR INPUT')
96 901 CALL bort('BUFRLIB: UFBCPY - INPUT BUFR FILE IS OPEN FOR '//
97  . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
98 902 CALL bort('BUFRLIB: UFBCPY - A MESSAGE MUST BE OPEN IN INPUT '//
99  . 'BUFR FILE, NONE ARE')
100 903 CALL bort('BUFRLIB: UFBCPY - LOCATION OF INTERNAL TABLE FOR '//
101  . 'INPUT BUFR FILE DOES NOT AGREE WITH EXPECTED LOCATION IN '//
102  . 'INTERNAL SUBSET ARRAY')
103 904 CALL bort('BUFRLIB: UFBCPY - OUTPUT BUFR FILE IS CLOSED, IT '//
104  . 'MUST BE OPEN FOR OUTPUT')
105 905 CALL bort('BUFRLIB: UFBCPY - OUTPUT BUFR FILE IS OPEN FOR '//
106  . 'INPUT, IT MUST BE OPEN FOR OUTPUT')
107 906 CALL bort('BUFRLIB: UFBCPY - A MESSAGE MUST BE OPEN IN OUTPUT '//
108  . 'BUFR FILE, NONE ARE')
109 907 CALL bort('BUFRLIB: UFBCPY - INPUT AND OUTPUT BUFR FILES MUST '//
110  . 'HAVE THE SAME INTERNAL TABLES, THEY ARE DIFFERENT HERE')
111  END
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 ufbcpy(LUBIN, LUBOT)
THIS SUBROUTINE COPIES A COMPLETE SUBSET BUFFER, UNPACKED INTO INTERNAL MEMORY FROM LOGICAL UNIT LUBI...
Definition: ufbcpy.f:48
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22