C$Procedure SPKLBL ( Generate an MGSO or PDS SPK label file ) SUBROUTINE SPKLBL ( LBLTYP, SPKFNM, . NNAFKW, NAIFKW, . VALUES, LBLFNM ) C$ Abstract C C Collect label information from a specified SPK file and generate C labels, writing them to a file. C C$ Copyright C C Copyright (1995), 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 CHARACTER*(*) LBLTYP CHARACTER*(*) SPKFNM INTEGER NNAFKW CHARACTER*(*) NAIFKW(*) CHARACTER*(*) VALUES(*) CHARACTER*(*) LBLFNM 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 SPKFNM I The name of the SPK file to use. C NNAFKW I The number of NAIF keywords. C NAIFKW I An array of the NAIF keywords. C VALUES I An array, possibly partially completed, of C keyword values. C LBLFNM I The name of the label file to create. 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 CKFNM The name of a binary SPK file to use when generating C values for keywords in the label file. This file must C already exist. C C NNAFKW The number of NAIF keywords. C C NAIFKW An array containing the NAIF keywords. C C VALUES An array, possibly partially completed, of keyword C values. C C LBLFNM The name of the label file to create. This must be the C name of a new file. C C$ Detailed_Output C C None. C C A label file containing an appropriate set of keywords for MGSO C or PDS archival storage of a SPICE SPK file is produced. 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 SPK file, the error C MAKLABEL(NOTACKFILE) will be signalled. C C 5) If the specified label file already exists, the error C MAKLABEL(LBLFILEEXISTS) 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 SPK 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 K.R. Gehringer (JPL) C C C$ Version C C- Beta Version 2.0.0, 22-NOV-1996 (WLT) C C Modified the portion of the code that writes out the C SPACECRAFT_NAME label. The Cassini project ground data C system, (following there usual professional practices) cannot C handle having the spacecraft name appear between a single C pair of braces, (even though the SFDU standard says you are C supposed to be able to do this). Since it is beyond the C capabilities of the SFDU lore masters to make their software C work according to its specifications, NAIF is once again C called upon to modify working software so that the SFDU empire C can be appeased. "Better, Faster, Cheaper ..." C C Another special Cassinism was added. If the name returned for C the spacecraft by ZZBODC2N is 'CAS' we change it to 'CASSINI'. C C- Beta Version 1.0.0, 25-JAN-1996 (KRG) C C-& C$ Index_Entries C C create a naif label file from an spk file C C-& C C SPICELIB functions C DOUBLE PRECISION DPMAX DOUBLE PRECISION DPMIN INTEGER CARDI INTEGER ISRCHC INTEGER RTRIM INTEGER CPOSR LOGICAL EXISTS LOGICAL FAILED C C Local parameters C C Template for the CDB data set ID value. C CHARACTER*(*) MGSODI PARAMETER ( MGSODI = 'SPICE_#_FILE' ) C C Lower bound index for SPICELIB "CELL" arrays. C INTEGER LBCELL PARAMETER ( LBCELL = -5 ) C C Length of a time vector as returned by CPUTIM. C INTEGER TVLEN PARAMETER ( TVLEN = 6 ) C C Maximum length of keyword-value labels. C INTEGER LBLLEN PARAMETER ( LBLLEN = 132 ) C C Position of the equal sign in a label. C INTEGER EQUPOS PARAMETER ( EQUPOS = 30 ) 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 Maximum length of a time string. C INTEGER TIMLEN PARAMETER ( TIMLEN = 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 SPK files. C INTEGER SPKND PARAMETER ( SPKND = 2 ) INTEGER SPKNI PARAMETER ( SPKNI = 6 ) INTEGER SPKNS PARAMETER ( SPKNS = SPKND + (SPKNI+1)/2 ) C C Mnemonics for the elements of the double precision summary array C of an SPK 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 SPK file. C INTEGER PBODY PARAMETER ( PBODY = 1 ) INTEGER PCENTR PARAMETER ( PCENTR = PBODY + 1 ) INTEGER PFRAME PARAMETER ( PFRAME = PCENTR + 1 ) INTEGER PTYPE PARAMETER ( PTYPE = PFRAME + 1 ) INTEGER PBADDR PARAMETER ( PBADDR = PTYPE + 1 ) INTEGER PEADDR PARAMETER ( PEADDR = PBADDR + 1 ) C C Local variables C CHARACTER*(ALEN) ARCH CHARACTER*(TIMLEN) BEGISO CHARACTER*(NAMLEN) BODY CHARACTER*(TIMLEN) CREATD CHARACTER*(LBLLEN) DSETID CHARACTER*(TIMLEN) ENDISO CHARACTER*(LBLLEN) LABEL CHARACTER*(TYPLEN) MYLBLT CHARACTER*(LBLLEN) NOTE CHARACTER*(LBLLEN) PRODID CHARACTER*(NAMLEN) SCNAME CHARACTER*(TYPLEN) TYPE DOUBLE PRECISION BEGET DOUBLE PRECISION DSUMRY(SPKND) DOUBLE PRECISION ENDET DOUBLE PRECISION SUMMRY(SPKNS) DOUBLE PRECISION TIMVEC(TVLEN) INTEGER BODIDS(LBCELL:MXBODS) INTEGER BODIDX INTEGER DAY INTEGER DIRLOC INTEGER DOTLOC INTEGER HANDLE INTEGER HOURS INTEGER I INTEGER ISUMRY(SPKNI) INTEGER KWDIDX INTEGER LBLLUN INTEGER MINUTS INTEGER MONTH INTEGER NBODYS INTEGER NSC INTEGER SCIDS(LBCELL:MXSCID) INTEGER SCIDX INTEGER SECS INTEGER YEAR LOGICAL DONE LOGICAL FOUND LOGICAL SEGFND C C Standard SPICE error handling. C CALL CHKIN ( 'SPKLBL' ) C C Initialize the "cell" arrays that we use. C CALL SSIZEI ( MXSCID, SCIDS ) CALL SSIZEI ( MXBODS, BODIDS ) IF ( FAILED() ) THEN CALL CHKOUT( 'SPKLBL' ) 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( 'SPKLBL' ) RETURN END IF C C Check to see that the file exists. C IF ( .NOT. EXISTS ( SPKFNM ) ) THEN CALL SETMSG ( 'The SPK file ''#'' does not exist.' ) CALL ERRCH ( '#', SPKFNM ) CALL SIGERR ( 'MAKLABEL(FILEDOESNOTEXIST)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C Get the file's architecture and type. C CALL GETFAT ( SPKFNM, ARCH, TYPE ) IF ( FAILED() ) THEN CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C Check to seee if we couldn't figure out either the architecture C or the type. C 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 ( '#', SPKFNM ) CALL SIGERR ( 'MAKLABEL(UNKNOWNFILETYPE)' ) CALL CHKOUT ( 'SPKLBL' ) RETURN END IF C C Verify that the type of the file is 'SPK'. SPK files are the C only ones this subroutine can generate labels for. C IF ( TYPE .NE. 'SPK' ) THEN CALL SETMSG ( 'The file ''#'' has a file type, ''#'',' . // ' and this subroutine only works with' . // ' SPK files.' ) CALL ERRCH ( '#', SPKFNM ) CALL ERRCH ( '#', TYPE ) CALL SIGERR ( 'MAKLABEL(NOTANSPKFILE)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C Check to be sure that the label file to be created does not exist. C IF ( EXISTS ( LBLFNM ) ) THEN CALL SETMSG ( 'The NAIF label file ''#'' already' . // ' exists. This program assumes that' . // ' the NAIF label file created is a' . // ' new file in order to avoid an' . // ' accidental loss of data. Please use' . // ' a filename that does not exist when' . // ' specifying the name of the NAIF label' . // ' file.' ) CALL ERRCH ( '#', LBLFNM ) CALL SIGERR ( 'MAKLABEL(LBLFILEEXISTS)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C At this point, we know that: C C 1) We have a SPICE SPK file available for generating labels. C C 2) We know that the label file that we are to produce does not C exist, so we can safely create it. C C So we now try to create the label file for the SPK file. C C C First, we open the SPK 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 the C start epoch and the stop epoch in the NAIF label file produced. C CALL DAFOPR ( SPKFNM, HANDLE ) CALL DAFBFS ( HANDLE ) IF ( FAILED() ) THEN CALL CHKOUT ( 'SPKLBL' ) RETURN END IF DONE = .FALSE. BEGET = DPMAX() ENDET = DPMIN() DO WHILE ( .NOT. DONE ) CALL DAFFNA ( SEGFND ) IF ( FAILED() ) THEN CALL CHKOUT ( 'SPKLBL' ) RETURN END IF IF ( SEGFND ) THEN CALL DAFGS ( SUMMRY ) CALL DAFUS ( SUMMRY, SPKND, SPKNI, DSUMRY, ISUMRY ) IF ( FAILED() ) THEN CALL CHKOUT ( 'SPKLBL' ) RETURN END IF BEGET = MIN ( BEGET, DSUMRY(PBEGTM) ) ENDET = MAX ( ENDET, DSUMRY(PENDTM) ) IF ( ISUMRY(PBODY) .LT. 0 ) THEN CALL INSRTI ( ISUMRY(PBODY), SCIDS ) END IF CALL INSRTI ( ISUMRY(PBODY), BODIDS ) IF ( FAILED() ) THEN CALL CHKOUT ( 'SPKLBL' ) RETURN END IF ELSE DONE = .TRUE. END IF END DO C C We're done with the SPK file, so let's close it. C CALL SPKCLS ( HANDLE ) IF ( FAILED() ) THEN CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C Convert the beginning epoch and ending epoch into the ISO time C format. C CALL ET2ISO_M ( BEGET, 'C', 0, BEGISO ) CALL ET2ISO_M ( ENDET, 'C', 0, ENDISO ) IF ( FAILED() ) THEN CALL CHKOUT( 'SPKLBL' ) RETURN 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 SPK file. C C Remove any leading path or directory elements. C DIRLOC = CPOSR ( SPKFNM, '/]', RTRIM(SPKFNM) ) IF ( DIRLOC .EQ. 0 ) THEN PRODID = SPKFNM ELSE PRODID = SPKFNM(DIRLOC+1:) END IF C C If it is an MGSO file, then, since we have a binary file, C we need to change the extension, if given, to be that of a C transfer SPK file. C IF ( MYLBLT .EQ. 'MGSO' ) THEN DOTLOC = CPOSR ( PRODID, '.', RTRIM(PRODID) ) IF ( DOTLOC .EQ. 0 ) THEN PRODID = PRODID(:RTRIM(PRODID)) // '.xsp' ELSE PRODID = PRODID(1:DOTLOC) // 'xsp' END IF END IF C C Get the current time and set up a time string. Ideally, this C should be a UTC based time rather than local time, but we don't C currently have a way to do this. C CALL CPUTIM ( TIMVEC ) IF ( FAILED() ) THEN CALL CHKOUT ( 'SPKLBL' ) RETURN END IF CREATD = '#-##-##T##:##:##' YEAR = INT ( TIMVEC(1) ) MONTH = INT ( TIMVEC(2) ) DAY = INT ( TIMVEC(3) ) HOURS = INT ( TIMVEC(4) ) MINUTS = INT ( TIMVEC(5) ) SECS = INT ( TIMVEC(6) ) CALL REPMI ( CREATD, '#', YEAR, CREATD ) IF ( MONTH .GE. 10 ) THEN CALL REPMI ( CREATD, '##', MONTH, CREATD ) ELSE CALL REPMI ( CREATD, '#', 0, CREATD ) CALL REPMI ( CREATD, '#', MONTH, CREATD ) END IF IF ( DAY .GE. 10 ) THEN CALL REPMI ( CREATD, '##', DAY, CREATD ) ELSE CALL REPMI ( CREATD, '#', 0, CREATD ) CALL REPMI ( CREATD, '#', DAY, CREATD ) END IF IF ( HOURS .GE. 10 ) THEN CALL REPMI ( CREATD, '##', HOURS, CREATD ) ELSE CALL REPMI ( CREATD, '#', 0, CREATD ) CALL REPMI ( CREATD, '#', HOURS, CREATD ) END IF IF ( MINUTS .GE. 10 ) THEN CALL REPMI ( CREATD, '##', MINUTS, CREATD ) ELSE CALL REPMI ( CREATD, '#', 0, CREATD ) CALL REPMI ( CREATD, '#', MINUTS, CREATD ) END IF IF ( SECS .GE. 10 ) THEN CALL REPMI ( CREATD, '##', SECS, CREATD ) ELSE CALL REPMI ( CREATD, '#', 0, CREATD ) CALL REPMI ( CREATD, '#', SECS, CREATD ) END IF C C OK. Now we open the label file, generate the keyword value pairs, C and write them out to the file. C CALL TXTOPN ( LBLFNM, LBLLUN ) IF ( FAILED() ) THEN CALL CHKOUT( 'SPKLBL' ) RETURN END IF C C If we are making a PDS label file, we need to put some stuff C before and after the labels that are common to both label files. C IF ( MYLBLT .EQ. 'PDS' ) THEN LABEL = '#' CALL REPMC ( LABEL, '#', 'PDS_VERSION_ID', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'PDS3', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'RECORD_TYPE', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'FIXED_LENGTH', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'RECORD_BYTES', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', '^SPICE_KERNEL', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', PRODID, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) END IF C C Loop through the keywords, placing them into the output label, C then place the equal sign and the appropriate value, and C finally write the label to the file. C DO I = 1, NNAFKW LABEL = '#' CALL REPMC ( LABEL, '#', NAIFKW(I), LABEL ) IF ( NAIFKW(I) .EQ. 'MISSION_NAME' ) THEN LABEL(EQUPOS:) = '= "#"' KWDIDX = ISRCHC('MISSION_NAME', NNAFKW, NAIFKW ) CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'SPACECRAFT_NAME' ) THEN NSC = CARDI(SCIDS) C C The IF-THEN block below was re-arranged as of C version 2.0.0 of SPKLBL. This was done to handle the C problem that the SFDU lore masters can not handle the C following C C spacecraft_name = { C "cassini" C } C C It must be C C spacecraft_name = "cassini" C IF ( NSC .EQ. 0 ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NSC .EQ. 1 ) THEN LABEL(EQUPOS:) = '= "#"' CALL ZZBODC2N( SCIDS(1), SCNAME, FOUND ) C C The IF-THEN block below is clearly a kludge. You'll see C the same block in several other places in this block for C setting the SPACECRAFT_NAME label. C C My apologies to future programmers. This was simply the C fastest way to get the 'CAS'/'CASSINI' problem resolved. C The correct thing to do would be fix ZZBODTRN so that C you could override the name CAS with CASSINI. However, C logistically this couldn't be done in the afternoon I C had to fix this pig. C C - Bill Taber C IF ( SCNAME .EQ. 'CAS' ) THEN SCNAME = 'CASSINI' END IF IF ( FOUND ) THEN CALL REPMC ( LABEL, '#', SCNAME, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE CALL SETMSG ( 'No name was available for the' . // ' body having the SPICE ID code' . // ' #. Please notify the NAIF group' . // ' at JPL if this ID code and an' . // ' associated name should be added' . // ' to those recognized.' ) CALL ERRINT ( '#', SCIDS(SCIDX) ) CALL SIGERR ( 'MAKLABEL(BODYNOTFOUND)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF ELSE IF ( NSC .GT. 1 ) THEN LABEL(EQUPOS:) = '= {' CALL WRITLN ( LABEL, LBLLUN ) DO SCIDX = 1, NSC-1 CALL ZZBODC2N( SCIDS(SCIDX), SCNAME, FOUND ) C C Same kludge as noted above. C IF ( SCNAME .EQ. 'CAS' ) THEN SCNAME = 'CASSINI' END IF IF ( FOUND ) THEN LABEL = ' ' LABEL(EQUPOS+4:) = '"#",' CALL REPMC ( LABEL, '#', SCNAME, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE CALL SETMSG ( 'No name was available for the' . // ' body having the SPICE ID code' . // ' #. Please notify the NAIF group' . // ' at JPL if this ID code and an' . // ' associated name should be added' . // ' to those recognized.' ) CALL ERRINT ( '#', SCIDS(SCIDX) ) CALL SIGERR ( 'MAKLABEL(BODYNOTFOUND)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF END DO CALL ZZBODC2N( SCIDS(NSC), SCNAME, FOUND ) C C Same kludge one last time. C IF ( SCNAME .EQ. 'CAS' ) THEN SCNAME = 'CASSINI' END IF IF ( FOUND ) THEN LABEL = ' ' LABEL(EQUPOS+4:) = '"#"' CALL REPMC ( LABEL, '#', SCNAME, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE CALL SETMSG ( 'No name was available for the' . // ' body having the SPICE ID code' . // ' #. Please notify the NAIF group' . // ' at JPL if this ID code and an' . // ' associated name should be added' . // ' to those recognized.' ) CALL ERRINT ( '#', SCIDS(NSC) ) CALL SIGERR ( 'MAKLABEL(BODYNOTFOUND)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF LABEL = ' ' LABEL(EQUPOS+2:) = '}' CALL WRITLN ( LABEL, LBLLUN ) END IF ELSE IF ( NAIFKW(I) .EQ. 'DATA_SET_ID' ) THEN LABEL(EQUPOS:) = '= "#"' KWDIDX = ISRCHC('DATA_SET_ID', NNAFKW, NAIFKW ) IF ( MYLBLT .EQ. 'PDS' ) THEN CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL REPMC ( LABEL, '#', TYPE, LABEL ) ELSE IF ( MYLBLT .EQ. 'MGSO' ) THEN IF ( VALUES(KWDIDX) .EQ. ' ' ) THEN CALL REPMC ( MGSODI, '#', TYPE, DSETID ) CALL REPMC ( LABEL, '#', DSETID, LABEL ) ELSE CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL REPMC ( LABEL, '#', TYPE, LABEL ) END IF END IF CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'KERNEL_TYPE_ID' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', TYPE, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'PRODUCT_ID' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', PRODID, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'PRODUCT_CREATION_TIME' ) THEN LABEL(EQUPOS:) = '= #' CALL REPMC ( LABEL, '#', CREATD, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'PRODUCER_ID' ) THEN LABEL(EQUPOS:) = '= "#"' KWDIDX = ISRCHC('PRODUCER_ID', NNAFKW, NAIFKW ) CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'MISSION_PHASE_NAME' ) THEN LABEL(EQUPOS:) = '= "#"' KWDIDX = ISRCHC('MISSION_PHASE_NAME', NNAFKW, NAIFKW ) CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'PRODUCT_VERSION_TYPE' ) THEN LABEL(EQUPOS:) = '= "#"' KWDIDX = ISRCHC('PRODUCT_VERSION_TYPE', NNAFKW, NAIFKW ) CALL REPMC ( LABEL, '#', VALUES(KWDIDX), LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'PLATFORM_OR_MOUNTING_NAME' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'START_TIME' ) THEN LABEL(EQUPOS:) = '= #' CALL REPMC ( LABEL, '#', BEGISO, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'STOP_TIME' ) THEN LABEL(EQUPOS:) = '= #' CALL REPMC ( LABEL, '#', ENDISO, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF . ( NAIFKW(I) .EQ. 'SPACECRAFT_CLOCK_START_COUNT' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF . ( NAIFKW(I) .EQ. 'SPACECRAFT_CLOCK_STOP_COUNT' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'TARGET_NAME' ) THEN C C This one will take a little bit of work. C NBODYS = CARDI(BODIDS) LABEL(EQUPOS:) = '= {' CALL WRITLN ( LABEL, LBLLUN ) DO BODIDX = 1, NBODYS-1 CALL ZZBODC2N( BODIDS(BODIDX), BODY, FOUND ) C C Same kludge as seen previously. C IF ( BODY .EQ. 'CAS' ) THEN BODY = 'CASSINI' END IF IF ( FOUND ) THEN LABEL = ' ' LABEL(EQUPOS+4:) = '"#",' CALL REPMC ( LABEL, '#', BODY, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE CALL SETMSG ( 'No name was available for the' . // ' body having the SPICE ID code' . // ' #. Please notify the NAIF group' . // ' at JPL if this ID code and an' . // ' associated name should be added' . // ' to those recognized.' ) CALL ERRINT ( '#', BODIDS(BODIDX) ) CALL SIGERR ( 'MAKLABEL(BODYNOTFOUND)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF END DO CALL ZZBODC2N( BODIDS(NBODYS), BODY, FOUND ) C C And yet one more copy of the kludge. C IF ( BODY .EQ. 'CAS' ) THEN BODY = 'CASSINI' END IF IF ( FOUND ) THEN LABEL = ' ' LABEL(EQUPOS+4:) = '"#"' CALL REPMC ( LABEL, '#', BODY, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE CALL SETMSG ( 'No name was available for the' . // ' body having the SPICE ID code' . // ' #. Please notify the NAIF group' . // ' at JPL if this ID code and an' . // ' associated name should be added' . // ' to those recognized.' ) CALL ERRINT ( '#', BODIDS(NBODYS) ) CALL SIGERR ( 'MAKLABEL(BODYNOTFOUND)' ) CALL CHKOUT( 'SPKLBL' ) RETURN END IF LABEL = ' ' LABEL(EQUPOS+2:) = '}' CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'INSTRUMENT_NAME' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'INSTRUMENT_ID' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'N/A', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'SOURCE_PRODUCT_ID' ) THEN LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'UNK', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) ELSE IF ( NAIFKW(I) .EQ. 'NOTE' ) THEN IF ( MYLBLT .EQ. 'PDS' ) THEN NOTE = 'SPICE binary SPK file.' ELSE IF ( MYLBLT .EQ. 'MGSO' ) THEN NOTE = 'SPICE transfer format SPK file.' END IF LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', NOTE, LABEL ) CALL WRITLN ( LABEL, LBLLUN ) END IF END DO C C Now we've got some more PDS stuff to write. C IF ( MYLBLT .EQ. 'PDS' ) THEN LABEL = '#' CALL REPMC ( LABEL, '#', 'OBJECT', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'SPICE_KERNEL', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'INTERCHANGE_FORMAT', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'BINARY', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'KERNEL_TYPE', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'EPHEMERIS', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'DESCRIPTION', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', ' ', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) LABEL = '#' CALL REPMC ( LABEL, '#', 'END_OBJECT', LABEL ) LABEL(EQUPOS:) = '= "#"' CALL REPMC ( LABEL, '#', 'SPICE_KERNEL', LABEL ) CALL WRITLN ( LABEL, LBLLUN ) CALL WRITLN ( 'END', LBLLUN ) END IF CLOSE ( LBLLUN ) CALL CHKOUT ( 'SPKLBL' ) RETURN END