<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='IOK2CPY'><A href='../../html_code/bufr/iok2cpy.f.html#IOK2CPY' TARGET='top_target'><IMG SRC="../../gif/bar_green.gif" border=0></A>
INTEGER FUNCTION IOK2CPY(LUI,LUO),1
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: IOK2CPY
C PRGMMR: J. ATOR ORG: NP20 DATE: 2009-06-26
C
C ABSTRACT: THIS FUNCTION DETERMINES WHETHER A MESSAGE, OR A SUBSET
C FROM A MESSAGE, CAN BE COPIED FROM LOGICAL UNIT IOLUN(LUI) TO
C LOGICAL UNIT IOLUN(LUO). THE DECISION IS BASED ON WHETHER THE
C EXACT SAME DEFINITION FOR THE GIVEN MESSAGE TYPE APPEARS WITHIN
C THE DICTIONARY TABLE INFORMATION FOR BOTH LOGICAL UNITS. NOTE THAT
C IT IS POSSIBLE FOR A MESSAGE TYPE TO BE IDENTICALLY DEFINED FOR TWO
C DIFFERENT LOGICAL UNITS EVEN IF THE UNITS THEMSELVES DON'T SHARE
C THE EXACT SAME FULL SET OF DICTIONARY TABLES.
C
C PROGRAM HISTORY LOG:
C 2009-06-26 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: IOK2CPY (LUI, LUO)
C INPUT ARGUMENT LIST:
C LUI - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C FOR LOGICAL UNIT TO COPY FROM
C LUO - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C FOR LOGICAL UNIT TO COPY TO
C
C OUTPUT ARGUMENT LIST:
C IOK2CPY - INTEGER: RETURN CODE INDICATING WHETHER IT IS OKAY TO
C COPY FROM IOLUN(LUI) TO IOLUN(LUO)
C 0 - NO
C 1 - YES
C
C REMARKS:
C THIS ROUTINE CALLS: ICMPDX NEMTBAX
C THIS ROUTINE IS CALLED BY: COPYSB COPYMG CPYMEM UFBCPY
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
COMMON /BTABLES/ MAXTAB,NTAB,TAG(MAXJL),TYP(MAXJL),KNT(MAXJL),
. JUMP(MAXJL),LINK(MAXJL),JMPB(MAXJL),
. IBT(MAXJL),IRF(MAXJL),ISC(MAXJL),
. ITP(MAXJL),VALI(MAXJL),KNTI(MAXJL),
. ISEQ(MAXJL,2),JSEQ(MAXJL)
CHARACTER*10 TAG
CHARACTER*8 SUBSET
CHARACTER*3 TYP
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
IOK2CPY = 0
C Do both logical units have the same internal table information?
IF ( ICMPDX(LUI,LUO) .EQ. 1 ) THEN
IOK2CPY = 1
RETURN
ENDIF
C No, so get the Table A mnemonic from the message to be copied,
C then check whether that mnemonic is defined within the dictionary
C tables for the logical unit to be copied to.
SUBSET = TAG(INODE(LUI))
CALL NEMTBAX
(LUO,SUBSET,MTYP,MSBT,INOD)
IF ( INOD .EQ. 0 ) RETURN
C The Table A mnemonic is defined within the dictionary tables for
C both units, so now make sure the definitions are identical.
NTEI = ISC(INODE(LUI))-INODE(LUI)
NTEO = ISC(INOD)-INOD
IF ( NTEI .NE. NTEO ) RETURN
DO I = 1, NTEI
IF ( TAG(INODE(LUI)+I) .NE. TAG(INOD+I) ) RETURN
IF ( TYP(INODE(LUI)+I) .NE. TYP(INOD+I) ) RETURN
IF ( ISC(INODE(LUI)+I) .NE. ISC(INOD+I) ) RETURN
IF ( IRF(INODE(LUI)+I) .NE. IRF(INOD+I) ) RETURN
IF ( IBT(INODE(LUI)+I) .NE. IBT(INOD+I) ) RETURN
ENDDO
IOK2CPY = 1
RETURN
END