NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
stntbia.f
Go to the documentation of this file.
1 C> @file
2 C> @author ATOR @date 2009-03-23
3 
4 C> THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR
5 C> TABLE A.
6 C>
7 C> PROGRAM HISTORY LOG:
8 C> 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
9 C> 2014-12-10 J. ATOR -- USE MODULES INSTEAD OF COMMON BLOCKS
10 C>
11 C> USAGE: CALL STNTBIA ( N, LUN, NUMB, NEMO, CELSQ )
12 C> INPUT ARGUMENT LIST:
13 C> N - INTEGER: STORAGE INDEX INTO INTERNAL TABLE A
14 C> LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL TABLE A
15 C> NUMB - CHARACTER*6: FXY NUMBER FOR NEW TABLE A ENTRY (IN
16 C> FORMAT FXXYYY)
17 C> NEMO - CHARACTER*8: MNEMONIC CORRESPONDING TO NUMB
18 C> CELSQ - CHARACTER*55: SEQUENCE DESCRIPTION CORRESPONDING
19 C> TO NUMB
20 C>
21 C> REMARKS:
22 C> THIS ROUTINE CALLS: BORT DIGIT
23 C> THIS ROUTINE IS CALLED BY: RDUSDX READS3 STBFDX
24 C> Not normally called by application
25 C> programs.
26 C>
27  SUBROUTINE stntbia ( N, LUN, NUMB, NEMO, CELSQ )
28 
29  USE moda_tababd
30 
31  CHARACTER*128 bort_str
32 
33  CHARACTER*(*) numb, nemo, celsq
34 
35  LOGICAL digit
36 
37 C-----------------------------------------------------------------------
38 C-----------------------------------------------------------------------
39 
40 C Confirm that neither NEMO nor NUMB has already been defined
41 C within the internal BUFR Table A (in COMMON /TABABD/) for
42 C the given LUN.
43 
44  DO n=1,ntba(lun)
45  IF(numb(4:6).EQ.taba(n,lun)(1: 3)) goto 900
46  IF(nemo(1:8).EQ.taba(n,lun)(4:11)) goto 901
47  ENDDO
48 
49 C Store the values within the internal BUFR Table A.
50 
51  taba(n,lun)( 1: 3) = numb(4:6)
52  taba(n,lun)( 4:11) = nemo(1:8)
53  taba(n,lun)(13:67) = celsq(1:55)
54 
55 C Decode and store the message type and subtype.
56 
57  IF ( digit( nemo(3:8) ) ) THEN
58 c .... Message type & subtype obtained directly from Table A mnemonic
59  READ ( nemo,'(2X,2I3)') mtyp, msbt
60  idna(n,lun,1) = mtyp
61  idna(n,lun,2) = msbt
62  ELSE
63 c .... Message type obtained from Y value of Table A seq. descriptor
64  READ ( numb(4:6),'(I3)') idna(n,lun,1)
65 c .... Message subtype hardwired to ZERO
66  idna(n,lun,2) = 0
67  ENDIF
68 
69 C Update the count of internal Table A entries.
70 
71  ntba(lun) = n
72 
73  RETURN
74 900 WRITE(bort_str,'("BUFRLIB: STNTBIA - TABLE A FXY VALUE (",A,") '
75  . //'HAS ALREADY BEEN DEFINED (DUPLICATE)")') numb
76  CALL bort(bort_str)
77 901 WRITE(bort_str,'("BUFRLIB: STNTBIA - TABLE A MNEMONIC (",A,") '
78  . //'HAS ALREADY BEEN DEFINED (DUPLICATE)")') nemo
79  CALL bort(bort_str)
80  END
This module contains array and variable declarations used to store DX BUFR tables internally for mult...
Definition: moda_tababd.F:10
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22
LOGICAL function digit(STR)
This logical function checks whether the characters in a string are all numeric.
Definition: digit.f:21
subroutine stntbia(N, LUN, NUMB, NEMO, CELSQ)
THIS SUBROUTINE STORES A NEW ENTRY WITHIN INTERNAL BUFR TABLE A.
Definition: stntbia.f:27