var/external/bufr/sntbde.f

   1         SUBROUTINE SNTBDE ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
   2      .                      NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ,
   3      .                      NMELEM, IEFXYN, CEELEM )
   4
   5 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   6 C
   7 C SUBPROGRAM:    SNTBDE
   8 C   PRGMMR: ATOR            ORG: NP12       DATE: 2007-01-19
   9 C
  10 C ABSTRACT:  THIS SUBROUTINE PARSES THE FIRST LINE OF AN ENTRY THAT WAS
  11 C   PREVIOUSLY READ FROM AN ASCII MASTER TABLE D FILE AND STORES THE
  12 C   OUTPUT INTO THE MERGED ARRAYS.  IT THEN READS AND PARSES ALL
  13 C   REMAINING LINES FOR THAT SAME ENTRY AND THEN LIKEWISE STORES THAT
  14 C   OUTPUT INTO THE MERGED ARRAYS.  THE RESULT IS THAT, UPON OUTPUT,
  15 C   THE MERGED ARRAYS NOW CONTAIN ALL OF THE INFORMATION FOR THE
  16 C   CURRENT TABLE ENTRY.
  17 C
  18 C PROGRAM HISTORY LOG:
  19 C 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
  20 C
  21 C USAGE:    CALL SNTBDE ( LUNT, IFXYN, LINE, MXMTBD, MXELEM,
  22 C                         NMTBD, IMFXYN, CMMNEM, CMDSC, CMSEQ,
  23 C                         NMELEM, IEFXYN, CEELEM )
  24 C   INPUT ARGUMENT LIST:
  25 C     LUNT     - INTEGER: FORTRAN LOGICAL UNIT NUMBER OF ASCII FILE
  26 C                CONTAINING MASTER TABLE D INFORMATION
  27 C     IFXYN    - INTEGER: BIT-WISE REPRESENTATION OF FXY NUMBER FOR
  28 C                TABLE ENTRY; THIS FXY NUMBER IS THE SEQUENCE DESCRIPTOR
  29 C     LINE     - CHARACTER*(*): FIRST LINE OF TABLE ENTRY
  30 C     MXMTBD   - INTEGER: MAXIMUM NUMBER OF ENTRIES TO BE STORED IN
  31 C                MERGED MASTER TABLE D ARRAYS; THIS SHOULD BE THE SAME
  32 C                NUMBER AS WAS USED TO DIMENSION THE OUTPUT ARRAYS IN
  33 C                THE CALLING PROGRAM, AND IT IS USED BY THIS SUBROUTINE
  34 C                TO ENSURE THAT IT DOESN'T OVERFLOW THESE ARRAYS
  35 C     MXELEM   - INTEGER: MAXIMUM NUMBER OF ELEMENTS TO BE STORED PER
  36 C                ENTRY WITHIN THE MERGED MASTER TABLE D ARRAYS; THIS
  37 C                SHOULD BE THE SAME NUMBER AS WAS USED TO DIMENSION THE
  38 C                OUTPUT ARRAYS IN THE CALLING PROGRAM, AND IT IS USED
  39 C                BY THIS SUBROUTINE TO ENSURE THAT IT DOESN'T OVERFLOW
  40 C                THESE ARRAYS
  41 C
  42 C   OUTPUT ARGUMENT LIST:
  43 C     NMTBD    - INTEGER: NUMBER OF ENTRIES IN MERGED MASTER TABLE D
  44 C                ARRAYS
  45 C     IMFXYN(*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
  46 C                REPRESENTATIONS OF FXY NUMBERS (I.E. SEQUENCE
  47 C                DESCRIPTORS)
  48 C     CMMNEM(*)- CHARACTER*8: MERGED ARRAY CONTAINING MNEMONICS
  49 C     CMDSC(*) - CHARACTER*4: MERGED ARRAY CONTAINING DESCRIPTOR CODES
  50 C     CMSEQ(*) - CHARACTER*120: MERGED ARRAY CONTAINING SEQUENCE NAMES
  51 C     NMELEM(*)- INTEGER: MERGED ARRAY CONTAINING NUMBER OF ELEMENTS
  52 C                STORED FOR EACH ENTRY
  53 C   IEFXYN(*,*)- INTEGER: MERGED ARRAY CONTAINING BIT-WISE
  54 C                REPRESENTATIONS OF ELEMENT FXY NUMBERS
  55 C   CEELEM(*,*)- CHARACTER*120: MERGED ARRAY CONTAINING ELEMENT NAMES
  56 C
  57 C REMARKS:
  58 C    THIS ROUTINE CALLS:        ADN30    BORT     BORT2    IFXY
  59 C                               IGETFXY  IGETNTBL JSTCHR   NEMOCK
  60 C                               PARSTR
  61 C    THIS ROUTINE IS CALLED BY: RDMTBD
  62 C                               Normally not called by any application
  63 C                               programs.
  64 C
  65 C ATTRIBUTES:
  66 C   LANGUAGE: FORTRAN 77
  67 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  68 C
  69 C$$$
  70
  71         CHARACTER*(*)   LINE
  72         CHARACTER*200   TAGS(10), CLINE
  73         CHARACTER*128   BORT_STR1, BORT_STR2
  74         CHARACTER*120   CMSEQ(*), CEELEM(MXMTBD,MXELEM)
  75         CHARACTER*8     CMMNEM(*)
  76         CHARACTER*6     ADN30, ADSC, CLEMON
  77         CHARACTER*4     CMDSC(*)
  78
  79         INTEGER         IMFXYN(*), NMELEM(*),
  80      .                  IEFXYN(MXMTBD,MXELEM)
  81
  82         LOGICAL DONE
  83
  84 C-----------------------------------------------------------------------
  85 C-----------------------------------------------------------------------
  86
  87         IF ( NMTBD .GE. MXMTBD ) GOTO 900
  88         NMTBD = NMTBD + 1
  89
  90 C       Store the FXY number.  This is the sequence descriptor.
  91
  92         IMFXYN ( NMTBD ) = IFXYN
  93
  94 C       Is there any other information within the first line of the
  95 C       table entry?  If so, it follows a "|" separator.
  96
  97         CMMNEM ( NMTBD ) = ' '
  98         CMDSC ( NMTBD ) = ' '
  99         CMSEQ ( NMTBD ) = ' '
 100         IPT = INDEX ( LINE, '|' )
 101         IF ( IPT .NE. 0 ) THEN
 102
 103 C           Parse the rest of the line.  Any of the fields may be blank.
 104
 105             CALL PARSTR ( LINE(IPT+1:), TAGS, 10, NTAG, ';', .FALSE. )
 106             IF ( NTAG .GT. 0 ) THEN
 107 C               The first additional field contains the mnemonic.
 108                 CALL JSTCHR ( TAGS(1), IRET )
 109 C               If there is a mnemonic, then make sure it's legal.
 110                 IF ( ( IRET .EQ. 0 ) .AND.
 111      .              ( NEMOCK ( TAGS(1) ) .NE. 0 ) ) THEN
 112                     BORT_STR2 = '                  HAS ILLEGAL MNEMONIC'
 113                     GOTO 901
 114                 ENDIF
 115                 CMMNEM ( NMTBD ) = TAGS(1)(1:8)
 116             ENDIF
 117             IF ( NTAG .GT. 1 ) THEN
 118 C               The second additional field contains descriptor codes.
 119                 CALL JSTCHR ( TAGS(2), IRET )
 120                 CMDSC ( NMTBD ) = TAGS(2)(1:4)
 121             ENDIF
 122             IF ( NTAG .GT. 2 ) THEN
 123 C               The third additional field contains the sequence name.
 124                 CALL JSTCHR ( TAGS(3), IRET )
 125                 CMSEQ ( NMTBD ) = TAGS(3)(1:120)
 126             ENDIF
 127         ENDIF
 128
 129 C       Now, read and parse all remaining lines from this table entry.
 130 C       Each line should contain an element descriptor for the sequence
 131 C       represented by the current sequence descriptor.
 132
 133         NELEM = 0
 134         DONE = .FALSE.
 135         DO WHILE ( .NOT. DONE )
 136             IF ( IGETNTBL ( LUNT, CLINE ) .NE. 0 ) THEN
 137                 BORT_STR2 = '                  IS INCOMPLETE'
 138                 GOTO 901
 139             ENDIF
 140             CALL PARSTR ( CLINE, TAGS, 10, NTAG, '|', .FALSE. )
 141             IF ( NTAG .LT. 2 ) THEN
 142                 BORT_STR2 = '                  HAS BAD ELEMENT CARD'
 143                 GOTO 901
 144             ENDIF
 145
 146 C           The second field contains the FXY number for this element.
 147
 148             IF ( IGETFXY ( TAGS(2), ADSC ) .NE. 0 ) THEN
 149                 BORT_STR2 = '                  HAS BAD OR MISSING' //
 150      .                      ' ELEMENT FXY NUMBER'
 151                 GOTO 901
 152             ENDIF
 153             IF ( NELEM .GE. MXELEM ) GOTO 900
 154             NELEM = NELEM + 1
 155             IEFXYN ( NMTBD, NELEM ) = IFXY ( ADSC )
 156
 157 C           The third field (if it exists) contains the element name.
 158
 159             IF ( NTAG .GT. 2 ) THEN
 160                 CALL JSTCHR ( TAGS(3), IRET )
 161                 CEELEM ( NMTBD, NELEM ) = TAGS(3)(1:120)
 162             ELSE
 163                 CEELEM ( NMTBD, NELEM ) = ' '
 164             ENDIF
 165
 166 C           Is this the last line for this table entry?
 167
 168             IF ( INDEX ( TAGS(2), ' >' ) .EQ. 0 ) DONE = .TRUE.
 169         ENDDO
 170         NMELEM ( NMTBD ) = NELEM
 171
 172         RETURN
 173
 174  900    CALL BORT('BUFRLIB: SNTBDE - OVERFLOW OF MERGED ARRAYS')
 175  901    CLEMON = ADN30 ( IFXYN, 6 )
 176         WRITE(BORT_STR1,'("BUFRLIB: SNTBDE - TABLE D ENTRY FOR' //
 177      .     ' SEQUENCE DESCRIPTOR: ",5A)')
 178      .     CLEMON(1:1), '-', CLEMON(2:3), '-', CLEMON(4:6)
 179         CALL BORT2(BORT_STR1,BORT_STR2)
 180         END