var/external/bufr/wtstat.f

   1       SUBROUTINE WTSTAT(LUNIT,LUN,IL,IM)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    WTSTAT
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE EITHER DISCONNECTS THE INPUT LOGICAL UNIT
   9 C   NUMBER LUNIT (AND ITS ASSOCIATED BUFR FILE) FROM THE BUFR ARCHIVE
  10 C   LIBRARY SOFTWARE OR IT CONNECTS IT AS EITHER AN INPUT OR OUPUT FILE
  11 C   AND DEFINES A BUFR MESSAGE AS BEING EITHER OPENED OR CLOSED IN
  12 C   MEMORY FOR THE BUFR FILE IN LUNIT.  THIS INFORMATION IS STORED IN
  13 C   THE INTERNAL ARRAYS IOLUN AND IOMSG IN COMMON BLOCK /STBFR/.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  17 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  18 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  19 C                           ROUTINE "BORT"
  20 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  21 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  22 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  23 C                           BUFR FILES UNDER THE MPI)
  24 C 2003-11-04  J. ATOR    -- CORRECTED A "TYPO" IN TEST FOR VALID VALUE
  25 C                           FOR "IM"; ADDED DOCUMENTATION
  26 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  27 C                           INTERDEPENDENCIES
  28 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  29 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  30 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  31 C                           ABNORMALLY
  32 C
  33 C USAGE:    CALL WTSTAT (LUNIT, LUN, IL, IM)
  34 C   INPUT ARGUMENT LIST:
  35 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  36 C     LUN      - INTEGER: I/O STREAM INDEX ASSOCIATED WITH LOGICAL UNIT
  37 C                LUNIT
  38 C     IL       - INTEGER: LOGICAL UNIT STATUS INDICATOR:
  39 C                       0 = disconnect LUNIT w.r.t. BUFR Archive
  40 C                           Library software (all information
  41 C                           associated with LUNIT is deleted from
  42 C                           within internal arrays)
  43 C                       1 = connect LUNIT as an output file w.r.t. to
  44 C                           BUFR Archive Library software
  45 C                      -1 = connect LUNIT as an input file w.r.t. to
  46 C                           BUFR Archive Library software
  47 C     IM       - INTEGER: DEFINES WHETHER THERE IS A BUFR MESSAGE
  48 C                CURRENTLY OPEN WITHIN MEMORY FOR THIS LUNIT (IF IT IS
  49 C                CONNECTED, I.E., IL .NE. ZERO):
  50 C                       0 = no
  51 C                       1 = yes
  52 C
  53 C REMARKS:
  54 C    THIS ROUTINE CALLS:        BORT
  55 C    THIS ROUTINE IS CALLED BY: CLOSBF   CLOSMG   OPENBF   OPENMB
  56 C                               OPENMG   RDMEMM   READERME REWNBF
  57 C                               READMG
  58 C                               Normally not called by any application
  59 C                               programs.
  60 C
  61 C ATTRIBUTES:
  62 C   LANGUAGE: FORTRAN 77
  63 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  64 C
  65 C$$$
  66
  67       INCLUDE 'bufrlib.prm'
  68
  69       COMMON /STBFR/ IOLUN(NFILES),IOMSG(NFILES)
  70
  71       CHARACTER*128 BORT_STR
  72
  73 C-----------------------------------------------------------------------
  74 C-----------------------------------------------------------------------
  75
  76 C  CHECK ON THE ARGUMENTS
  77 C  ----------------------
  78
  79       IF(LUNIT.LE.0)            GOTO 900
  80       IF(LUN  .LE.0)            GOTO 901
  81       IF(IL.LT.-1 .OR. IL.GT.1) GOTO 902
  82       IF(IM.LT. 0 .OR. IM.GT.1) GOTO 903
  83
  84 C  CHECK ON LUNIT-LUN COMBINATION
  85 C  ------------------------------
  86
  87       IF(ABS(IOLUN(LUN)).NE.LUNIT) THEN
  88          IF(IOLUN(LUN).NE.0) GOTO 905
  89       ENDIF
  90
  91 C  RESET THE FILE STATUSES
  92 C  -----------------------
  93
  94       IF(IL.NE.0) THEN
  95          IOLUN(LUN) = SIGN(LUNIT,IL)
  96          IOMSG(LUN) = IM
  97       ELSE
  98          IOLUN(LUN) = 0
  99          IOMSG(LUN) = 0
 100       ENDIF
 101
 102 C  EXITS
 103 C  -----
 104
 105       RETURN
 106 900   WRITE(BORT_STR,'("BUFRLIB: WTSTAT - INVALID UNIT NUMBER PASSED '//
 107      . ' INTO FIRST ARGUMENT (INPUT) (=",I3,")")') LUNIT
 108       CALL BORT(BORT_STR)
 109 901   WRITE(BORT_STR,'("BUFRLIB: WTSTAT - INVALID I/O STREAM INDEX '//
 110      . 'PASSED INTO SECOND ARGUMENT (INPUT) (=",I3,")")') LUN
 111       CALL BORT(BORT_STR)
 112 902   WRITE(BORT_STR,'("BUFRLIB: WTSTAT - INVALID LOGICAL UNIT STATUS'//
 113      . ' INDICATOR PASSED INTO THIRD ARGUMENT (INPUT) (=",I4,")")') IL
 114       CALL BORT(BORT_STR)
 115 903   WRITE(BORT_STR,'("BUFRLIB: WTSTAT - INVALID BUFR MESSAGE STATUS'//
 116      . ' INDICATOR PASSED INTO FOURTH ARGUMENT (INPUT) (=",I4,")")') IM
 117       CALL BORT(BORT_STR)
 118 905   WRITE(BORT_STR,'("BUFRLIB: WTSTAT - ATTEMPTING TO REDEFINE '//
 119      . 'EXISTING FILE UNIT (LOGICAL UNIT NUMBER ",I3,")")') IOLUN(LUN)
 120       CALL BORT(BORT_STR)
 121       END