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