C This is a test program to test the OAL and L3 Fortran wrappers.
C It reads the label file SGC_0031.LBL, calls various OAL and L3 wrapper
C functions, and writes output so that a cognizant user can determine whether
C the calls succeeded or not.
C
C Platforms this has been tested on are:
C   1) SGI/Irix          (miranda)
C   2) Sun Sparc/Solaris (atika)
C   3) VAX/VMS           (aries)
C   4) Dec 3100/Ultrix   (syrtis)
C   5) Dec Alpha/OpenVMS (ringside)
C
C OAL wrapper functions called:
C   OaFortAddLineTerminatorstoTable
C   OaFortCloseOutputFile
C   OaFortConvertObject
C   OaFortDeleteObject
C   OaFortGetObjectInfo
C   OaFortGetProfileValues
C   OaFortGetSubTable
C   OaFortKwdValuetoLong
C   OaFortOpenOutputFile
C   OaFortParseLabelFile
C   OaFortReadSubTable
C   OaFortReadTable
C   OaFortReportError
C   OaFortWriteObject
C
C L3 wrapper functions called:
C   OdlFortFindObjDes
C   OdlFortGetObjDescClassName
C   OdlFortLeftmostChild
C   OdlFortRightSibling
C
C This version has been tested successfully on the following platforms:
C

        implicit none

        INCLUDE 'OAL_FORTRAN.INC'
        INCLUDE 'L3_FORTRAN.INC'

C These variables must be the same size as C long's or pointers.
C On a Dec Alpha they should be integer*8;  on all other platforms they
C should be integer*4.

        integer*4      ODLTREE, DATA_PTR, DATA_PTR2, SIZE
        integer*4      ROOT_NODE, ODLTREENODE, TABLE_NODE
        integer*4      COLUMN_NODE, COLUMN_NODES(10)
        integer*4      TABLE_OBJECT1, TABLE_OBJECT2, FILE_OBJECT
        integer*4      START_ROW, STOP_ROW, ROW_BYTES

C These variables must be the same size as C int's.

        integer*4      OBJECT_POSITION, ERR
        integer*4      N_COLUMN_NODES, RECORD_TYPE

C These variables must be the same size as C short's.

        integer*2      EXPAND, NOMSGS, SEARCH_SCOPE

        byte           IS_IN_MEMORY, CHECK_ASCII_WRITES
        byte           DST_FORMAT_FOR_ASCII_SRC
        byte           DST_FORMAT_FOR_BINARY_SRC
        byte           DST_ALIGNMENT_TYPE, DATA_TRANSLATION_PROFILE

        character*80   LABEL_FILENAME, ERRFILESPEC
        character*50   KEYWORD_NAME, KEYWORD_VALUE, OBJECT_CLASS

C Local function declarations:

        integer*4         DIFF_TABLES


C Read in the label from SGC_0031.LBL.  This contains two binary TABLES
C with VAX data types - orbit/pointing info for OUVS orbit #31.

        type *,'OaFortParseLabelFile reading SGC_0031.LBL...'
        LABEL_FILENAME = 'SGC_0031.LBL'
        ERRFILESPEC = ' '
        EXPAND = 0
        NOMSGS = .FALSE.
        ROOT_NODE = OaFortParseLabelFile( LABEL_FILENAME, ERRFILESPEC,
	1                                 EXPAND, NOMSGS)
        if (ROOT_NODE .eq. NULL) then
          call OaFortReportError( 'Error: OaFortParseLabelFile ' //
	1                         'returned 0!')
          go to 999
        end if

C Print out the class names of all the root node's children.

        ODLTREENODE = OdlFortLeftmostChild( ROOT_NODE)
        call OaFortReportError( 'Children of root node are:')
        do while (ODLTREENODE .ne. NULL)
          ERR = OdlFortGetObjDescClassName( ODLTREENODE, OBJECT_CLASS)
          call OaFortReportError( 'OBJECT_CLASS = ' // OBJECT_CLASS)
          ODLTREENODE = OdlFortRightSibling( ODLTREENODE)
        end do
        type *,' '

C Get the SGC_TABLE node.

        OBJECT_CLASS = 'SGC_TABLE'
        KEYWORD_NAME = ' '
        KEYWORD_VALUE = ' '
        OBJECT_POSITION = 0
        SEARCH_SCOPE = ODL_RECURSIVE_DOWN
        TABLE_NODE = OdlFortFindObjDesc( ROOT_NODE, OBJECT_CLASS,
	1                                KEYWORD_NAME, KEYWORD_VALUE,
	2                                OBJECT_POSITION, SEARCH_SCOPE)
        if (TABLE_NODE .eq. NULL) then
          call OaFortReportError( 'Error: OdlFortFindObjDesc ' //
	1                         'could not find SGC_TABLE node!')
          go to 999
        end if


C Get the VENUS_SC_VECTOR column of the TABLE into memory two different ways.
C #1: Read in the entire table, then extract the VENUS_SC_VECTOR column.

        N_COLUMN_NODES  = 1
        START_ROW       = 1
        STOP_ROW        = 256

        type *,'OaFortReadTable reading in SGC_TABLE...'
        TABLE_OBJECT1 = OaFortReadTable( TABLE_NODE)
        if (TABLE_OBJECT1 .eq. NULL) then
          call OaFortReportError( 'Error: OaFortReadTable failed!')
          go to 999
        end if

C Find the VENUS_SC_VECTOR column node (in the ODL tree of the in-memory
C table).

        call OaFortGetObjectInfo( TABLE_OBJECT1, ODLTREE, DATA_PTR,
	1                         SIZE, IS_IN_MEMORY)

        OBJECT_CLASS = 'COLUMN'
        KEYWORD_NAME = 'NAME'
        KEYWORD_VALUE = 'VENUS_SC_VECTOR'
        COLUMN_NODE = OdlFortFindObjDesc( ODLTREE,
	1                                 OBJECT_CLASS, KEYWORD_NAME,
	2                                 KEYWORD_VALUE,
	3                                 OBJECT_POSITION, SEARCH_SCOPE)
        if (COLUMN_NODE .eq. NULL) then
          call OaFortReportError( 'Error: OdlFortFindObjDesc ' //
	1                        'could not find VENUS_SC_VECTOR node!')
          go to 999
        end if
        COLUMN_NODES(1) = COLUMN_NODE

        type *,'OaFortGetSubTable extracting VENUS_SC_VECTOR column...'
        TABLE_OBJECT2 = OaFortGetSubTable( TABLE_OBJECT1,
	1                                  START_ROW,
	2                                  STOP_ROW,
	3                                  COLUMN_NODES,
	4                                  N_COLUMN_NODES)
        if (TABLE_OBJECT2 .eq. NULL) then
          call OaFortReportError( 'Error: OaFortGetSubTable ' //
	1                         'failed!')
          go to 999
        end if

C Free TABLE_OBJECT1

        call OaFortDeleteObject( TABLE_OBJECT1)

C #2: Read only the VENUS_SC_VECTOR column.

C Get the VENUS_SC_VECTOR column node (in the ODL tree from the label file).

        OBJECT_CLASS = 'COLUMN'
        KEYWORD_NAME = 'NAME'
        KEYWORD_VALUE = 'VENUS_SC_VECTOR'
        COLUMN_NODE = OdlFortFindObjDesc( ROOT_NODE, OBJECT_CLASS,
	1                                 KEYWORD_NAME, KEYWORD_VALUE,
	2                                 OBJECT_POSITION, SEARCH_SCOPE)
        if (COLUMN_NODE .eq. NULL) then
          call OaFortReportError( 'Error: OdlFortFindObjDesc ' //
	1                        'could not find VENUS_SC_VECTOR node!')
          go to 999
        end if
        COLUMN_NODES(1) = COLUMN_NODE

        type *,'OaFortReadSubTable reading in VENUS_SC_VECTOR ' //
	1      'column of SGC_TABLE...'
        TABLE_OBJECT1 = OaFortReadSubTable( TABLE_NODE,
	1                                   START_ROW,
	2                                   STOP_ROW,
	3                                   COLUMN_NODES,
	4                                   N_COLUMN_NODES)
        if (TABLE_OBJECT1 .eq. NULL) then
          call OaFortReportError( 'Error: OaFortReadSubTable ' //
	1                         'failed!')
          go to 999
        end if

C Get the data_ptr from TABLE_OBJECT1, then pass data_ptr to a subroutine
C which prints out a few values to see if it worked.

        call OaFortGetObjectInfo( TABLE_OBJECT1, ODLTREE, DATA_PTR,
	1                         SIZE, IS_IN_MEMORY)
        call PRINT_COLUMN_VALUES( %val( DATA_PTR))

C Compare every byte of the two tables.

        call OaFortGetObjectInfo( TABLE_OBJECT2, ODLTREE, DATA_PTR2,
	1                         SIZE, IS_IN_MEMORY)
        ERR = DIFF_TABLES( %val( DATA_PTR), %val( DATA_PTR2))
        if (ERR .ne. 0) then
          go to 999 !Error message already printed
        end if       

        call OaFortDeleteObject( TABLE_OBJECT2)

C       Convert TABLE_OBJECT1's object data to ASCII.

        call OaFortGetProfileValues( DST_FORMAT_FOR_ASCII_SRC,
	1                            DST_FORMAT_FOR_BINARY_SRC,
	2                            DST_ALIGNMENT_TYPE,
	3                            DATA_TRANSLATION_PROFILE,
	4                            CHECK_ASCII_WRITES)

        DST_FORMAT_FOR_BINARY_SRC = OA_ASCII_INTERCHANGE_FORMAT

        call OaFortSetProfileValues( DST_FORMAT_FOR_ASCII_SRC,
	1                            DST_FORMAT_FOR_BINARY_SRC,
	2                            DST_ALIGNMENT_TYPE,
	3                            DATA_TRANSLATION_PROFILE,
	4                            CHECK_ASCII_WRITES)
        
        type *,'Converting data to ASCII...'
        TABLE_OBJECT2 = OaFortConvertObject( TABLE_OBJECT1)
        if (TABLE_OBJECT2 .eq. NULL) then
          call OaFortReportError( 'Error: OaFortConvertObject ' //
	1                         'failed!')
          go to 999
        end if

C Print out the first 40 chars of the ASCII data.

        call OaFortGetObjectInfo( TABLE_OBJECT2, ODLTREE, DATA_PTR2,
	1                         SIZE, IS_IN_MEMORY)
        call PRINT_ASCII_VALS( %val( DATA_PTR2))

C Append CR/LF to each row of the ASCII table.

        TABLE_OBJECT2 = OaFortAddLineTerminatorstoTable(
	1                 TABLE_OBJECT2)
        if (TABLE_OBJECT2 .eq. NULL) then
          call OaFortReportError( 'Error: ' //
	1                         'OaFortAddLineTerminatorstoTable ' //
	2                         'failed!')
          go to 999
        end if

C Get the ROW_BYTES keyword value.

        ERR = OaFortKwdValuetoLong( 'ROW_BYTES', ODLTREE, ROW_BYTES)
        if (ERR .ne. 0) then
          call OaFortReportError( 'Error: OaFortKwdValuetoLong ' //
	1                         'failed to find ROW_BYTES keyword')
          go to 999
        end if
        type *,'ROW_BYTES = ', ROW_BYTES

C Open an output file.

        type *,'Opening output file...'
        RECORD_TYPE = OA_FIXED_LENGTH
        FILE_OBJECT = OaFortOpenOutputFile( 'TMP.DAT', RECORD_TYPE,
	1                                    ROW_BYTES)
        if (FILE_OBJECT .eq. NULL) then
          call OaFortReportError( 'Error: OaFortOpenOutputFile ' //
	1                         'failed!')
          go to 999
        end if

C Write the ASCII table to the output file.

        ERR = OaFortWriteObject( FILE_OBJECT, TABLE_OBJECT2)
        if (ERR .ne. 0) then
          call OaFortReportError( 'Error: OaFortWriteObject ' //
	1                         'failed!')
          go to 999
        end if

C Close the output file and write the label.

        ERR = OaFortCloseOutputFile( FILE_OBJECT, 'TMP.LBL')
        if (ERR .ne. 0) then
          call OaFortReportError( 'Error: OaFortCloseOutputFile ' //
	1                         'failed!')
          go to 999
        end if

        type *,'All tests worked!'
999     end


        subroutine PRINT_COLUMN_VALUES( COLUMN)
        real*4 COLUMN(3,256)

        character*80 STR, TMP_STR
        integer*4    I

        call OaFortReportError( 'First 3 values should be:     ' //
	1                       '5940.21    -729.04   10895.34')
        STR = 'First 3 column values are:  '
        do I = 1,3
          write( TMP_STR, '(F10.2)') COLUMN(I,1)
          STR = STR(1:index( STR, '        ')) // TMP_STR
        end do
        call OaFortReportError( STR)
        end


        integer*4 function DIFF_TABLES( TABLE1, TABLE2)
        real*4 TABLE1(3,256), TABLE2(3,256)

        integer*4  I,J

        do I = 1,3
          do J = 1,256
            if (TABLE1(I,J) .ne. TABLE2(I,J)) then
              type *,'Error: tables do not match; I=', I, ' J=', J
              DIFF_TABLES = 1
              return
            end if
          end do
        end do
        type *,'table data matches'
        DIFF_TABLES = 0
        return
        end


        subroutine PRINT_ASCII_VALS( ASCII_TABLE)
        byte ASCII_TABLE(40)

        character     STR(40)
        integer*4     I
        
        do I = 1,40
          STR(I) = char( ASCII_TABLE(I))
        end do
        type *, 'First 40 chars of ASCII table are: ', STR
        end
