wrfv2_fire/var/external/bufr/sntbbe.inc

   1       SUBROUTINE SNTBBE (IFXYN, LINE, MXMTBB, NMTBB, IMFXYN, CMSCL,     &
   2       CMSREF, CMBW, CMUNIT, CMMNEM, CMDSC, CMELEM)
   3
   4 !$$$  SUBPROGRAM DOCUMENTATION BLOCK
   5 !
   6 ! SUBPROGRAM:    SNTBBE
   7 !   PRGMMR: ATOR            ORG: NP12       DATE: 2007-01-19
   8 !
   9 ! ABSTRACT:  THIS SUBROUTINE PARSES AN ENTRY THAT WAS PREVIOUSLY READ
  10 !   FROM AN ASCII MASTER TABLE B FILE AND THEN STORES THE OUTPUT INTO
  11 !   THE MERGED ARRAYS.
  12 !
  13 ! PROGRAM HISTORY LOG:
  14 ! 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
  15 !
  16 ! USAGE:    CALL SNTBBE ( IFXYN, LINE, MXMTBB,
  17 !                         NMTBB, IMFXYN, CMSCL, CMSREF, CMBW,
  18 !                         CMUNIT, CMMNEM, CMDSC, CMELEM )
  19 !   INPUT ARGUMENT LIST:
  20 !     IFXYN    - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER FOR
  21 !                TABLE ENTRY; THIS FXY NUMBER IS THE ELEMENT DESCRIPTOR
  22 !     LINE     - CHARACTER*(*): TABLE ENTRY
  23 !     MXMTBB   - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
  24 !                MERGED MASTER TABLE B ARRAYS; THIS SHOULD BE THE SAME
  25 !                NUMBER AS WAS USED TO DIMENSION THE OUTPUT ARRAYS IN
  26 !                THE CALLING PROGRAM, AND IT IS USED BY THIS SUBROUTINE
  27 !                TO ENSURE THAT IT DOESN'T OVERFLOW THESE ARRAYS
  28 !
  29 !   OUTPUT ARGUMENT LIST:
  30 !     NMTBB    - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE B
  31 !                ARRAYS
  32 !     IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
  33 !                REPRESENTATIONS OF FXY NUMBERS (I.E. ELEMENT
  34 !                DESCRIPTORS)
  35 !     CMSCL(*) - CHARACTER*4: MERGED ARRAY CONTAINING SCALE FACTORS
  36 !     CMSREF(*)- CHARACTER*12: MERGED ARRAY CONTAINING REFERENCE VALUES
  37 !     CMBW(*)  - CHARACTER*4: MERGED ARRAY CONTAINING BIT WIDTHS
  38 !     CMUNIT(*)- CHARACTER*14: MERGED ARRAY CONTAINING UNITS
  39 !     CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
  40 !     CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES
  41 !     CMELEM(*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES
  42 !
  43 ! REMARKS:
  44 !    THIS ROUTINE CALLS:        BORT     BORT2    JSTCHR   NEMOCK
  45 !                               PARSTR   RJUST
  46 !    THIS ROUTINE IS CALLED BY: RDMTBB
  47 !                               Normally not called by any application
  48 !                               programs.
  49 !
  50 ! ATTRIBUTES:
  51 !   LANGUAGE: FORTRAN 77
  52 !   MACHINE:  PORTABLE TO ALL PLATFORMS
  53 !
  54 !$$$
  55
  56       CHARACTER ( * ) LINE
  57       CHARACTER(200) TAGS (10), WKTAG
  58       CHARACTER(128) BORT_STR1, BORT_STR2
  59       CHARACTER(120) CMELEM ( * )
  60       CHARACTER(14) CMUNIT ( * )
  61       CHARACTER(12) CMSREF ( * )
  62       CHARACTER(8) CMMNEM ( * )
  63       CHARACTER(4) CMSCL ( * ), CMBW ( * ), CMDSC ( * )
  64
  65       INTEGER IMFXYN ( * )
  66
  67 !-----------------------------------------------------------------------
  68 !-----------------------------------------------------------------------
  69
  70       IF (NMTBB.GE.MXMTBB) GOTO 900
  71       NMTBB = NMTBB + 1
  72
  73 !       Store the FXY number.  This is the element descriptor.
  74
  75       IMFXYN (NMTBB) = IFXYN
  76
  77 !       Parse the table entry.
  78
  79       CALL PARSTR (LINE, TAGS, 10, NTAG, '|', .FALSE.)
  80       IF (NTAG.LT.4) THEN
  81       BORT_STR2 = '                  HAS TOO FEW FIELDS'
  82          GOTO 901
  83       ENDIF
  84
  85 !       Scale factor.
  86
  87       CALL JSTCHR (TAGS (2), IRET)
  88       IF (IRET.NE.0) THEN
  89       BORT_STR2 = '                  HAS MISSING SCALE FACTOR'
  90          GOTO 901
  91       ENDIF
  92       CMSCL (NMTBB) = TAGS (2) (1:4)
  93       RJ = RJUST (CMSCL (NMTBB) )
  94
  95 !       Reference value.
  96
  97       CALL JSTCHR (TAGS (3), IRET)
  98       IF (IRET.NE.0) THEN
  99       BORT_STR2 = '                  HAS MISSING REFERENCE VALUE'
 100          GOTO 901
 101       ENDIF
 102       CMSREF (NMTBB) = TAGS (3) (1:12)
 103       RJ = RJUST (CMSREF (NMTBB) )
 104
 105 !       Bit width.
 106
 107       CALL JSTCHR (TAGS (4), IRET)
 108       IF (IRET.NE.0) THEN
 109       BORT_STR2 = '                  HAS MISSING BIT WIDTH'
 110          GOTO 901
 111       ENDIF
 112       CMBW (NMTBB) = TAGS (4) (1:4)
 113       RJ = RJUST (CMBW (NMTBB) )
 114
 115 !       Units.  Note that this field is allowed to be blank.
 116
 117       IF (NTAG.GT.4) THEN
 118          CALL JSTCHR (TAGS (5), IRET)
 119          CMUNIT (NMTBB) = TAGS (5) (1:14)
 120       ELSE
 121          CMUNIT (NMTBB) = ' '
 122       ENDIF
 123
 124 !       Comment (additional) fields.  Any of these fields may be blank.
 125
 126       CMMNEM (NMTBB) = ' '
 127       CMDSC (NMTBB) = ' '
 128       CMELEM (NMTBB) = ' '
 129       IF (NTAG.GT.5) THEN
 130          WKTAG = TAGS (6)
 131          CALL PARSTR (WKTAG, TAGS, 10, NTAG, ';', .FALSE.)
 132          IF (NTAG.GT.0) THEN
 133 !               The first additional field contains the mnemonic.
 134             CALL JSTCHR (TAGS (1), IRET)
 135 !               If there is a mnemonic, then make sure it's legal.
 136             IF ( (IRET.EQ.0) .AND. (NEMOCK (TAGS (1) ) .NE.0) ) THEN
 137       BORT_STR2 = '                  HAS ILLEGAL MNEMONIC'
 138                GOTO 901
 139             ENDIF
 140             CMMNEM (NMTBB) = TAGS (1) (1:8)
 141          ENDIF
 142          IF (NTAG.GT.1) THEN
 143 !               The second additional field contains descriptor codes.
 144             CALL JSTCHR (TAGS (2), IRET)
 145             CMDSC (NMTBB) = TAGS (2) (1:4)
 146          ENDIF
 147          IF (NTAG.GT.2) THEN
 148 !               The third additional field contains the element name.
 149             CALL JSTCHR (TAGS (3), IRET)
 150             CMELEM (NMTBB) = TAGS (3) (1:120)
 151          ENDIF
 152       ENDIF
 153
 154       RETURN
 155   900 CALL BORT ('BUFRLIB: SNTBBE - OVERFLOW OF MERGED ARRAYS')
 156   901 BORT_STR1 = 'BUFRLIB: SNTBBE - CARD BEGINNING WITH: '//LINE (1:20)
 157       CALL BORT2 (BORT_STR1, BORT_STR2)
 158       END SUBROUTINE SNTBBE