var/external/bufr/status.f

   1       SUBROUTINE STATUS(LUNIT,LUN,IL,IM)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    STATUS
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE CHECKS WHETHER LOGICAL UNIT NUMBER LUNIT
   9 C   (AND ITS ASSOCIATED BUFR FILE) IS CURRENTLY CONNECTED TO THE
  10 C   BUFR ARCHIVE LIBRARY SOFTWARE.  IF SO, IT RETURNS THE I/O STREAM
  11 C   INDEX (LUN) ASSOCIATED WITH THE LOGICAL UNIT NUMBER, THE LOGICAL
  12 C   UNIT STATUS INDICATOR (IL), AND THE BUFR MESSAGE STATUS INDICATOR
  13 C   (IM) FOR THAT I/O STREAM INDEX.  OTHERWISE, IT CHECKS WHETHER THERE
  14 C   IS SPACE FOR A NEW I/O STREAM INDEX AND, IF SO, RETURNS THE NEXT
  15 C   AVAILABLE I/O STREAM INDEX IN LUN IN ORDER TO DEFINE LUNIT (IL AND
  16 C   IM ARE RETURNED AS ZERO, THEY ARE LATER DEFINED VIA CALLS TO BUFR
  17 C   ARCHIVE LIBRARY SUBROUTINE WTSTAT IN THIS CASE).  IF THERE IS NO
  18 C   SPACE FOR A NEW I/O STREAM INDEX, LUN IS RETURNED AS ZERO (AS WELL
  19 C   AS IL AND IM) MEANING LUNIT COULD NOT BE CONNECTED TO THE BUFR
  20 C   ARCHIVE LIBRARY SOFTWARE.  LUN IS USED TO IDENTIFY UP TO "NFILES"
  21 C   UNIQUE BUFR FILES IN THE VARIOUS INTERNAL ARRAYS.
  22 C
  23 C PROGRAM HISTORY LOG:
  24 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  25 C 1996-12-11  J. WOOLLEN -- FIXED A LONG STANDING BUG WHICH OCCURS IN
  26 C                           UNUSUAL SITUATIONS, VERY LOW IMPACT
  27 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  28 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  29 C                           ROUTINE "BORT"
  30 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  31 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  32 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  33 C                           BUFR FILES UNDER THE MPI)
  34 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  35 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  36 C                           INTERDEPENDENCIES
  37 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  38 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  39 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  40 C                           ABNORMALLY
  41 C
  42 C USAGE:    CALL STATUS ( LUNIT, LUN, IL, IM )
  43 C   INPUT ARGUMENT LIST:
  44 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  45 C
  46 C   OUTPUT ARGUMENT LIST:
  47 C     LUN      - INTEGER: I/O STREAM INDEX ASSOCIATED WITH LOGICAL UNIT
  48 C                LUNIT
  49 C                       0 = LUNIT is not currently connected to the
  50 C                           BUFR Archive Library software and there is
  51 C                           no space for a new I/O stream index
  52 C     IL       - INTEGER: LOGICAL UNIT STATUS INDICATOR:
  53 C                       0 = LUNIT is not currently connected to the
  54 C                           BUFR Archive Library software or it was
  55 C                           just connected in this call to STATUS
  56 C                       1 = LUNIT is connected to the BUFR Archive
  57 C                           Library software as an output file
  58 C                      -1 = LUNIT is connected to the BUFR Archive
  59 C                           Library software as an input file
  60 C     IM       - INTEGER: INDICATOR AS TO WHETHER THERE IS A BUFR
  61 C                MESSAGE CURRENTLY OPEN WITHIN MEMORY FOR THIS LUNIT:
  62 C                       0 = no or LUNIT was just connected to the
  63 C                           BUFR Archive Library software in this call
  64 C                           to STATUS
  65 C                       1 = yes
  66 C
  67 C REMARKS:
  68 C    THIS ROUTINE CALLS:        BORT
  69 C    THIS ROUTINE IS CALLED BY: CLOSBF   CLOSMG   COPYBF   COPYMG
  70 C                               COPYSB   CPYMEM   DATEBF   DRFINI
  71 C                               DUMPBF   DXDUMP   GETABDB  GETTAGPR
  72 C                               GETVALNB IFBGET   IGETSC   INVMRG
  73 C                               IUPVS01  LCMGDF   MESGBC   MINIMG
  74 C                               MSGWRT   NMSUB    OPENBF   OPENMB
  75 C                               OPENMG   POSAPX   RDMEMM   RDMEMS
  76 C                               RDMGSB   READDX   READERME READLC
  77 C                               READMG   READNS   READSB   REWNBF
  78 C                               RTRCPT   STNDRD   UFBCNT   UFBCPY
  79 C                               UFBCUP   UFBDMP   UFBEVN   UFBGET
  80 C                               UFBIN3   UFBINT   UFBINX   UFBMMS
  81 C                               UFBOVR   UFBPOS   UFBQCD   UFBQCP
  82 C                               UFBREP   UFBRMS   UFBSEQ   UFBSTP
  83 C                               UFBTAB   UFBTAM   UFDUMP   UPFTBV
  84 C                               WRCMPS   WRDXTB   WRITLC   WRITSA
  85 C                               WRITSB
  86 C                               Also called by application programs.
  87 C
  88 C ATTRIBUTES:
  89 C   LANGUAGE: FORTRAN 77
  90 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  91 C
  92 C$$$
  93
  94       INCLUDE 'bufrlib.prm'
  95
  96       COMMON /STBFR/ IOLUN(NFILES),IOMSG(NFILES)
  97
  98       CHARACTER*128 BORT_STR
  99
 100 C-----------------------------------------------------------------------
 101 C-----------------------------------------------------------------------
 102
 103       IF(LUNIT.LE.0 .OR. LUNIT.GT.99) GOTO 900
 104
 105 C  CLEAR THE STATUS INDICATORS
 106 C  ---------------------------
 107
 108       LUN = 0
 109       IL  = 0
 110       IM  = 0
 111
 112 C  SEE IF UNIT IS ALREADY CONNECTED TO BUFR ARCHIVE LIBRARY SOFTWARE
 113 C  -----------------------------------------------------------------
 114
 115       DO I=1,NFILES
 116       IF(ABS(IOLUN(I)).EQ.LUNIT) LUN = I
 117       ENDDO
 118
 119 C  IF NOT, TRY TO DEFINE IT SO AS TO CONNECT IT TO BUFR ARCHIVE LIBRARY
 120 C  SOFTWARE
 121 C  --------------------------------------------------------------------
 122
 123       IF(LUN.EQ.0) THEN
 124          DO I=1,NFILES
 125          IF(IOLUN(I).EQ.0) THEN
 126
 127 C  File space is available, return with LUN > 0, IL and IM remain 0
 128 C  ----------------------------------------------------------------
 129
 130             LUN = I
 131             GOTO 100
 132          ENDIF
 133          ENDDO
 134
 135 C  File space is NOT available, return with LUN, IL and IM all 0
 136 C  -------------------------------------------------------------
 137
 138          GOTO 100
 139       ENDIF
 140
 141 C  IF THE UNIT WAS ALREADY CONNECTED TO THE BUFR ARCHIVE LIBRARY
 142 C   SOFTWARE PRIOR TO THIS CALL, RETURN STATUSES
 143 C  -------------------------------------------------------------
 144
 145       IL = SIGN(1,IOLUN(LUN))
 146       IM = IOMSG(LUN)
 147
 148 C  EXITS
 149 C  ----
 150
 151 100   RETURN
 152 900   WRITE(BORT_STR,'("BUFRLIB: STATUS - INPUT UNIT NUMBER (",I3,") '//
 153      . 'OUTSIDE LEGAL RANGE OF 1-99")') LUNIT
 154       CALL BORT(BORT_STR)
 155       END