C$Procedure PCKLBL ( Generate an MGSO or PDS PCK label file ) SUBROUTINE PCKLBL ( LBLTYP, PCKFNM, KWTBLE, KWPTR, KWVALS ) C$ Abstract C C Collect label information from a specified PCK file and generate C labels values for creating an PCK label. C C$ Copyright C C Copyright (1996), California Institute of Technology. C U.S. Government sponsorship acknowledged. C C$ Required_Reading C C None C C$ Keywords C C None. C C$ Declarations IMPLICIT NONE INTEGER LBCELL PARAMETER ( LBCELL = -5 ) CHARACTER*(*) LBLTYP CHARACTER*(*) PCKFNM CHARACTER*(*) KWTBLE( LBCELL:*) INTEGER KWPTR ( LBCELL:*) CHARACTER*(*) KWVALS( LBCELL:*) C$ Brief_I/O C C Variable I/O Description C -------- --- -------------------------------------------------- C LBLTYP I The type of label file to produce: MGSO or PDS. C PCKFNM I The name of the PCK file to use. C KWTBLE I/O The names portion of a symbol table C KWPTR I/O The pointers portion of a symbol table C KWVALS I/O The values portion of a symbol table C C$ Detailed_Input C C LBLTYP The type of label file to be produced. The allowed C types are: 'MGSO' or 'PDS'. C C PCKFNM The name of a binary PCK file to use when generating C values for keywords in the label file. This file must C already exist. C C KWTBLE The symbol table of keyword value lists that will C KWPTR later be converted into an label file for the C KWVALS input PCK file. On input, this symbol table contains C the values that were supplied in the MAKLABEL C template file. C C C$ Detailed_Output C C KWTBLE The symbol table of keyword value lists that will C KWPTR later be converted into an label file for the C KWVALS input PCK file. On output, this symbol table contains C the values that were supplied in the MAKLABEL C template file as well as all values that are C appropriate for an PCK label. C C$ Parameters C C None. C C$ Exceptions C C 1) If the label type is not one of 'MGSO' or 'PDS' then the error C MAKLABEL(BADLABELTYPE) will be signalled. C C 2) If the binary SPICE kernel file does not exist, the error C MAKLABEL(FILEDOESNOTEXIST) will be signalled. C C 3) If the type of the SPICE binary kernel file cannot be C determined, the error MAKLABEL(UNKNOWNFILETYPE) will be C signalled. C C 4) If the SPICE binary kernel file is not an PCK file, the error C MAKLABEL(NOTAPCKFILE) will be signalled. C C 6) If the name for a body ID code cannot be found, the error C MAKLABEL(BODYNOTFOUND) will be signalled. C C$ Files C C None. C C$ Particulars C C This subroutine scans a binary SPICE PCK file collecting C information used to generate a set of labels. It then C generates a label file. C C$ Examples C C None. C C$ Restrictions C C This subroutine is to be used only with the MAKLABEL program. C C$ Literature_References C C None. C C$ Author_and_Institution C C B.V. Semenov (JPL) C W.L. Taber (JPL) C K.R. Gehringer (JPL) C C$ Version C C- Beta Version 2.1.0, 9-JUL-1998 (BVS) C C Keyword INSTRUMENT_ID was changed to NAIF_INSTRUMENT_ID. C C- Beta Version 2.0.0, 5-DEC-1996 (WLT) C C Really and truly this routine should have a new name, C the calling sequence and functionality are totally C different from the last edition of this routine. C C- Beta Version 1.0.0, 25-JAN-1996 (KRG) C C-& C$ Index_Entries C C create a NAIF label file from a pck file C C-& C C SPICELIB functions C DOUBLE PRECISION DPMAX DOUBLE PRECISION DPMIN INTEGER CARDI INTEGER RTRIM INTEGER CPOSR LOGICAL ELEMC LOGICAL EXISTS LOGICAL FAILED C C Local parameters C C Template for the CDB data set ID value. C CHARACTER*(*) MGSODI PARAMETER ( MGSODI = 'SPICE_PCK_FILE' ) C C Maximum length of keyword-value labels. C INTEGER LBLLEN PARAMETER ( LBLLEN = 132 ) C C Maximum number of body IDs that can be stored for a particular C file. C INTEGER MXBODS PARAMETER ( MXBODS = 100 ) C C Maximum number of spacecraft IDs that can be stored for a C particular file. C INTEGER MXSCID PARAMETER ( MXSCID = 100 ) C C Maximum length of body name. C INTEGER NAMLEN PARAMETER ( NAMLEN = 80 ) C C Length of a file architecture. C INTEGER ALEN PARAMETER ( ALEN = 3 ) C C Length of a file type. C INTEGER TYPLEN PARAMETER ( TYPLEN = 4 ) C C Values of ND, NI and NS for PCK files. C INTEGER PCKND PARAMETER ( PCKND = 2 ) INTEGER PCKNI PARAMETER ( PCKNI = 5 ) INTEGER PCKNS PARAMETER ( PCKNS = PCKND + (PCKNI+1)/2 ) C C Mnemonics for the elements of the double precision summary array C of an PCK file. C INTEGER PBEGTM PARAMETER ( PBEGTM = 1 ) INTEGER PENDTM PARAMETER ( PENDTM = PBEGTM + 1 ) C C Mnemonics for the elements of the integer summary array C of an PCK file. C INTEGER PBODY PARAMETER ( PBODY = 1 ) INTEGER PFRAME PARAMETER ( PFRAME = PBODY + 1 ) INTEGER PTYPE PARAMETER ( PTYPE = PFRAME + 1 ) INTEGER PBADDR PARAMETER ( PBADDR = PTYPE + 1 ) INTEGER PEADDR PARAMETER ( PEADDR = PBADDR + 1 ) C C Room allotted for time strings. C INTEGER TIMLEN PARAMETER ( TIMLEN = 80 ) C C Local variables C CHARACTER*(ALEN) ARCH CHARACTER*(LBLLEN) ERRMSG CHARACTER*(LBLLEN) LINE CHARACTER*(LBLLEN) NOTE CHARACTER*(LBLLEN) PRODID CHARACTER*(LBLLEN) VALUE CHARACTER*(NAMLEN) BODY CHARACTER*(NAMLEN) SCNAME CHARACTER*(TIMLEN) BEGISO CHARACTER*(TIMLEN) ENDISO CHARACTER*(TYPLEN) MYLBLT CHARACTER*(TYPLEN) TYPE DOUBLE PRECISION BEGET DOUBLE PRECISION DSUMRY(PCKND) DOUBLE PRECISION ENDET DOUBLE PRECISION SUMMRY(PCKNS) INTEGER BODID INTEGER BODIDS(LBCELL:MXBODS) INTEGER DIRLOC INTEGER DOTLOC INTEGER ERRPOS INTEGER F INTEGER HANDLE INTEGER I INTEGER ISUMRY(PCKNI) INTEGER L INTEGER N INTEGER NBODS INTEGER NSC INTEGER SCIDS(LBCELL:MXSCID) LOGICAL EOF LOGICAL FOUND LOGICAL SEGFND C C Standard SPICE error handling. C CALL CHKIN ( 'PCKLBL' ) C C Initialize the "cell" arrays that we use. C CALL SSIZEI ( MXSCID, SCIDS ) CALL SSIZEI ( MXBODS, BODIDS ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C Check to see if the label type we were given is one we recognize. C We only recognize 'PDS' and 'MGSO'. C CALL LJUST ( LBLTYP, MYLBLT ) CALL LJUST ( MYLBLT, MYLBLT ) IF ( ( MYLBLT .NE. 'PDS' ) .AND. ( MYLBLT .NE. 'MGSO' ) ) THEN CALL SETMSG ( 'The label type ''#'' was not recognized.' . // ' Only label types ''PDS'' and ''MGSO''' . // ' are recognized.' ) CALL ERRCH ( '#', MYLBLT ) CALL SIGERR ( 'MAKLABEL(BADLABELTYPE)' ) CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C Check to see that the file exists, and that it is a SPICE file, C and hence one we know how to process. C IF ( .NOT. EXISTS ( PCKFNM ) ) THEN CALL SETMSG ( 'The PCK file ''#'' does not exist.' ) CALL ERRCH ( '#', PCKFNM ) CALL SIGERR ( 'MAKLABEL(FILEDOESNOTEXIST)' ) CALL CHKOUT( 'PCKLBL' ) RETURN END IF CALL GETFAT ( PCKFNM, ARCH, TYPE ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF IF ( ( ARCH .EQ. '?' ) .OR. ( TYPE .EQ. '?' ) ) THEN C C We didn't have a file that we know how to deal with. So, C we toss our hands in the air and signal an error. C CALL SETMSG ( 'The architecture or type of the file' . // ' ''#'' was not recognized.' ) CALL ERRCH ( '#', PCKFNM ) CALL SIGERR ( 'MAKLABEL(UNKNOWNFILETYPE)' ) CALL CHKOUT ( 'PCKLBL' ) RETURN END IF IF ( ( ARCH .NE. 'DAF' ) .AND. ( ARCH .NE. 'KPL' ) ) THEN C C We didn't have a file that we know how to deal with. So, C we toss our hands in the air and signal an error. C CALL SETMSG ( 'The architecture of the file ''#''' . // ' was not appropriate. Only architectures' . // ' ''DAF'' and ''KPL'' are allowed.' ) CALL ERRCH ( '#', PCKFNM ) CALL SIGERR ( 'MAKLABEL(UNKNOWNFILETYPE)' ) CALL CHKOUT ( 'PCKLBL' ) RETURN END IF IF ( TYPE .NE. 'PCK' ) THEN CALL SETMSG ( 'The file ''#'' has a file type, ''#'',' . // ' and this subroutine only works with' . // ' PCK files.' ) CALL ERRCH ( '#', PCKFNM ) CALL ERRCH ( '#', TYPE ) CALL SIGERR ( 'MAKLABEL(NOTAPCKFILE)' ) CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C At this point, we know that we have a SPICE file available C for generating labels. C IF ( ARCH .EQ. 'DAF' ) THEN IF ( MYLBLT .EQ. 'PDS' ) THEN NOTE = 'SPICE binary PCK file.' ELSE IF ( MYLBLT .EQ. 'MGSO' ) THEN NOTE = 'SPICE transfer format PCK file.' END IF C C Next, we open the PCK file and loop through all of the C segments collecting the body names and the earliest starting C epoch and the latest ending epoch. These epochs will become C the start epoch and the stop epoch in the NAIF label file C produced. C CALL DAFOPR ( PCKFNM, HANDLE ) CALL DAFBFS ( HANDLE ) BEGET = DPMAX() ENDET = DPMIN() CALL DAFFNA ( SEGFND ) IF ( FAILED() ) THEN CALL CHKOUT ( 'PCKLBL' ) RETURN END IF DO WHILE ( SEGFND ) CALL DAFGS ( SUMMRY ) CALL DAFUS ( SUMMRY, PCKND, PCKNI, DSUMRY, ISUMRY ) IF ( FAILED() ) THEN CALL CHKOUT ( 'PCKLBL' ) RETURN END IF BEGET = MIN ( BEGET, DSUMRY(PBEGTM) ) ENDET = MAX ( ENDET, DSUMRY(PENDTM) ) CALL INSRTI ( ISUMRY(PBODY), BODIDS ) IF ( FAILED() ) THEN CALL CHKOUT ( 'PCKLBL' ) RETURN END IF CALL DAFFNA ( SEGFND ) IF ( FAILED() ) THEN CALL CHKOUT ( 'PCKLBL' ) RETURN END IF END DO C C We're done with the PCK file, so let's close it. C CALL PCKCLS ( HANDLE ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C Convert the beginning epoch and ending epoch into the ISO time C format. C CALL ET2ISO_M ( BEGET, 'C', 3, BEGISO ) CALL ET2ISO_M ( ENDET, 'C', 3, ENDISO ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF ELSE IF ( ARCH .EQ. 'KPL' ) THEN C C We have a text kernel. First make sure it can C be loaded into the kernel pool. C NOTE = 'SPICE text PCK file.' BEGISO = 'N/A' ENDISO = 'N/A' CALL LDPOOL ( PCKFNM ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C Now we scan through the variables looking for variables C of the form 'BODYnnnnxxxx' where we desire to C obtain the value of 'nnnn' as an integer. C C Open the PCK file. C CALL RDKNEW ( PCKFNM ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF C C We read in lines and process them. C EOF = .FALSE. C C Get the first data line from the PCK file. C CALL RDKDAT ( LINE, EOF ) DO WHILE ( .NOT. EOF ) C C Left justify the data line and see if it begins with C the letters 'BODY' C CALL LJUST ( LINE, LINE ) IF ( LINE(1:4) .EQ. 'BODY' ) THEN C C If an unsigned integer follows the 'BODY' part of the C line, we assume that this is in fact a bit of PCK data C and add the idcode to the set of id-codes we've C collected up to this point. C F = 5 CALL LX4UNS ( LINE, F, L, N ) IF ( N .GT. 0 ) THEN CALL NPARSI ( LINE(F:L), BODID, ERRMSG, ERRPOS ) CALL INSRTI ( BODID, BODIDS ) END IF END IF C C Fetch the next line of data from the text kernel. C CALL RDKDAT ( LINE, EOF ) IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL' ) RETURN END IF END DO END IF C C Set the product ID. This is the filename with all leading C directory stuff removed. Also, for MGSO labels, this is the name C of a transfer file, and for PDS files, this is the name of the C binary PCK file. C C Remove any leading path or directory elements. C DIRLOC = CPOSR ( PCKFNM, '/]', RTRIM(PCKFNM) ) IF ( DIRLOC .EQ. 0 ) THEN PRODID = PCKFNM ELSE PRODID = PCKFNM(DIRLOC+1:) END IF C C If is an MGSO file, then, if we have a binary file, C we need to change the extension, if given, to be that of a C transfer PCK file. C IF ( MYLBLT .EQ. 'MGSO' .AND. ARCH .EQ. 'DAF' ) THEN DOTLOC = CPOSR ( PRODID, '.', RTRIM(PRODID) ) IF ( DOTLOC .EQ. 0 ) THEN CALL SUFFIX ( '.xpc', 0, PRODID ) ELSE PRODID(DOTLOC:) = '.xpc' END IF END IF C C For those items that do not require further processing, we C fill in the keyword table now. C CALL SYIFSC( 'KERNEL_TYPE_ID', TYPE, KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'PRODUCT_ID', PRODID, KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'INSTRUMENT_NAME', 'N/A', KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'NAIF_INSTRUMENT_ID','N/A', KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'SOURCE_PRODUCT_ID', 'UNK', KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'NOTE', NOTE, KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'START_TIME', BEGISO, KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'STOP_TIME', ENDISO, KWTBLE, KWPTR, KWVALS ) CALL SYIFSC( 'PLATFORM_OR_MOUNTING_NAME', 'N/A', KWTBLE, . KWPTR, . KWVALS ) CALL SYIFSC( 'SPACECRAFT_CLOCK_START_COUNT', 'N/A', KWTBLE, . KWPTR, . KWVALS ) CALL SYIFSC( 'SPACECRAFT_CLOCK_STOP_COUNT', 'N/A', KWTBLE, . KWPTR, . KWVALS ) C C Keywords: 'SPACECRAFT_NAME' C =========================== C C Collect the names of all spacecraft (it is pretty unlikely C that there are any spacecraft ids. After all this is a PCK file. C NSC = CARDI ( SCIDS ) IF ( NSC .EQ. 0 ) THEN C C If we don't already have a SPACECRAFT_NAME value set it C to 'N/A'. C CALL SYIFSC ( 'SPACECRAFT_NAME', 'N/A', KWTBLE, . KWPTR, . KWVALS ) ELSE IF ( .NOT. ELEMC( 'SPACECRAFT_NAME', KWTBLE ) ) THEN C C Now fill in the values we have in hand. C DO I = 1, NSC CALL MYBD2N( SCIDS(I), SCNAME ) CALL SYPSHC( 'SPACECRAFT_NAME', SCNAME, KWTBLE, . KWPTR, . KWVALS ) C C Make sure nothing bad happened. C IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL') RETURN END IF END DO END IF C C Keywords: 'DATA_SET_ID' C ====================== C C Create the DATA_SET_ID label value. Note that VALUE will be C overwritten by SYPOPC only if there is a value present in the C Keyword symbol table. C VALUE = MGSODI CALL SYPOPC( 'DATA_SET_ID', KWTBLE, KWPTR, KWVALS, VALUE, FOUND ) IF ( MYLBLT .EQ. 'PDS' .AND. .NOT. FOUND ) THEN C C If we didn't get a value back from the call above C we are totally out of luck. C CALL SETMSG ( 'There was no template value supplied ' . // 'for the DATA_SET_ID in the TEMPLATE ' . // 'file. Until that information is ' . // 'supplied the label file can not be ' . // 'created. ' ) CALL SIGERR ( 'MAKLABEL(NODATASETID)' ) CALL CHKOUT ( 'PCKLBL' ) RETURN END IF IF ( VALUE .EQ. ' ' ) THEN VALUE = MGSODI END IF C C If the current value is just a template, fill in the marker C (this has no effect if there isn't a marker present). C CALL REPMC ( VALUE, '#', TYPE, VALUE ) CALL SYSETC ( 'DATA_SET_ID', VALUE, KWTBLE, KWPTR, KWVALS ) C C Keywords: 'TARGET_NAME' C ======================= C C Repeat the steps above for the other objects in the file. C NBODS = CARDI ( BODIDS ) IF ( NBODS .EQ. 0 ) THEN C C If we don't already have a TARGET_NAME value set it C to 'N/A'. C CALL SYIFSC ( 'TARGET_NAME', 'N/A', KWTBLE, . KWPTR, . KWVALS ) ELSE IF ( .NOT. ELEMC( 'TARGET_NAME', KWTBLE ) ) THEN C C Now fill in the values we have in hand. C DO I = 1, NBODS CALL MYBD2N( BODIDS(I), BODY ) CALL SYPSHC( 'TARGET_NAME', BODY, KWTBLE, . KWPTR, . KWVALS ) C C Make sure nothing bad happened. C IF ( FAILED() ) THEN CALL CHKOUT( 'PCKLBL') RETURN END IF END DO END IF C C Keywords: 'PRODUCER_ID', C 'MISSION_PHASE_NAME', C 'PRODUCT_VERSION_TYPE' C ================================== C C If the type of input file is KPL we need to make some final C special alterations to the keyword table. C IF ( ARCH .EQ. 'KPL' ) THEN CALL SYIFSC( 'PRODUCER_ID', 'The NAIF Group, JPL', KWTBLE, . KWPTR, . KWVALS ) CALL SYIFSC( 'MISSION_PHASE_NAME', 'N/A', KWTBLE, . KWPTR, . KWVALS ) CALL SYIFSC( 'PRODUCT_VERSION_TYPE', 'N/A', KWTBLE, . KWPTR, . KWVALS ) CALL SYIFSC( 'SOURCE_PRODUCT_ID', 'N/A', KWTBLE, . KWPTR, . KWVALS ) END IF CALL CHKOUT ( 'PCKLBL' ) RETURN END