var/external/bufr/icmpdx.f

   1       INTEGER FUNCTION ICMPDX(LUD,LUN)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    ICMPDX
   6 C   PRGMMR: J. ATOR          ORG: NP20       DATE: 2009-06-18
   7 C
   8 C ABSTRACT: THIS FUNCTION DETERMINES WHETHER LOGICAL UNIT IOLUN(LUN)
   9 C   HAS THE SAME INTERNAL TABLE INFORMATION AS LOGICAL UNIT IOLUN(LUD).
  10 C   NOTE THAT THIS DOES NOT NECESSARILY MEAN THAT IOLUN(LUN) AND
  11 C   IOLUN(LUD) ARE SHARING TABLE INFORMATION, SINCE TWO LOGICAL UNITS
  12 C   CAN HAVE THE SAME INTERNAL TABLE INFORMATION WITHOUT SHARING IT.
  13 C
  14 C PROGRAM HISTORY LOG:
  15 C 2009-06-18  J. ATOR    -- ORIGINAL AUTHOR
  16 C
  17 C USAGE:    ICMPDX (LUD, LUN)
  18 C   INPUT ARGUMENT LIST:
  19 C     LUD      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  20 C                FOR FIRST LOGICAL UNIT
  21 C     LUN      - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
  22 C                FOR SECOND LOGICAL UNIT
  23 C
  24 C   OUTPUT ARGUMENT LIST:
  25 C     ICMPDX   - INTEGER: RETURN CODE INDICATING WHETHER IOLUN(LUN)
  26 C                HAS THE SAME INTERNAL TABLE INFORMATION AS IOLUN(LUD):
  27 C                  0 - NO
  28 C                  1 - YES
  29 C
  30 C REMARKS:
  31 C    THIS ROUTINE CALLS:        ISHRDX
  32 C    THIS ROUTINE IS CALLED BY: IOK2CPY  MAKESTAB
  33 C                               Normally not called by any application
  34 C                               programs.
  35 C
  36 C ATTRIBUTES:
  37 C   LANGUAGE: FORTRAN 77
  38 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  39 C
  40 C$$$
  41
  42       INCLUDE 'bufrlib.prm'
  43
  44       COMMON /TABABD/ NTBA(0:NFILES),NTBB(0:NFILES),NTBD(0:NFILES),
  45      .                MTAB(MAXTBA,NFILES),IDNA(MAXTBA,NFILES,2),
  46      .                IDNB(MAXTBB,NFILES),IDND(MAXTBD,NFILES),
  47      .                TABA(MAXTBA,NFILES),TABB(MAXTBB,NFILES),
  48      .                TABD(MAXTBD,NFILES)
  49
  50       CHARACTER*600 TABD
  51       CHARACTER*128 TABB
  52       CHARACTER*128 TABA
  53
  54 C-----------------------------------------------------------------------
  55 C-----------------------------------------------------------------------
  56
  57 C     First, check whether the two units are actually sharing tables.
  58 C     If so, then they obviously have the same table information.
  59
  60       ICMPDX = ISHRDX(LUD,LUN)
  61       IF ( ICMPDX .EQ. 1 ) RETURN
  62
  63 C     Otherwise, check whether the internal Table A, B and D entries are
  64 C     all identical between the two units.
  65
  66       IF ( ( NTBA(LUD) .EQ. 0 ) .OR.
  67      .          ( NTBA(LUN) .NE. NTBA(LUD) ) ) RETURN
  68       DO I = 1, NTBA(LUD)
  69         IF ( IDNA(I,LUN,1) .NE. IDNA(I,LUD,1) ) RETURN
  70         IF ( IDNA(I,LUN,2) .NE. IDNA(I,LUD,2) ) RETURN
  71         IF ( TABA(I,LUN) .NE. TABA(I,LUD) ) RETURN
  72       ENDDO
  73
  74         IF ( ( NTBB(LUD) .EQ. 0 ) .OR.
  75      .          ( NTBB(LUN) .NE. NTBB(LUD) ) ) RETURN
  76       DO I = 1, NTBB(LUD)
  77         IF ( IDNB(I,LUN) .NE. IDNB(I,LUD) ) RETURN
  78         IF ( TABB(I,LUN) .NE. TABB(I,LUD) ) RETURN
  79       ENDDO
  80
  81       IF ( ( NTBD(LUD) .EQ. 0 ) .OR.
  82      .          ( NTBD(LUN) .NE. NTBD(LUD) ) ) RETURN
  83       DO I = 1, NTBD(LUD)
  84         IF ( IDND(I,LUN) .NE. IDND(I,LUD) ) RETURN
  85         IF ( TABD(I,LUN) .NE. TABD(I,LUD) ) RETURN
  86       ENDDO
  87
  88       ICMPDX = 1
  89
  90       RETURN
  91       END