(C  LABUTIL:  NIMS LABEL PARSING ROUTINES>C  PART I. - LOW LEVEL ROUTINES WHICH PASS ASCII VALUE STRINGSLC   HIGHER LEVEL ROUTINES WILL PASS DIFFERENT VALUE TYPES, MULTIVALUES, ETC.KC  RMX 3/86   LKEY CORRECTION 4/15/86   MORE LKEY & LVAL CORRECTIONS 6/9/86AC  RMX 27MAY87  PDS LABEL PRELIMINARY VERSION: INILAB NOT NEEDED?KC  RMX 02JUL87  GTKVAL MODIFIED FOR PDS LABELS, ASSUMES NO (=)S IN STRINGS.GC  RMX 18AUG87  CRELAB & ADDKEY modified for PDS label, INILAB dropped.?C		CRELAB now adds RECORD_TYPE, RECORD_BYTES and LABEL_RECORDS.EC  RMX 20AUG87  CRELAB modified to add SFDU_LABEL for JPL/PDS level 0CC.      SUBROUTINE GTKVAL(LAB,KPOS,KEY,VAL,LVAL)CEC_TITLE:  GTKVAL:  Get value string and length from PDS label keywordCC_ARGS:C      CHARACTER*(*) LAB		! I  Character string containing PDS label5      INTEGER*4     KPOS	! I  Last-used byte of label1      CHARACTER*(*) KEY		! I  Keyword to be found3      CHARACTER*(*) VAL		! O  Returned value string?      INTEGER*4     LVAL	! O  Return code:  >0 length of string-				!     -1 key not found  -2 invalid stringCFC_DESCR:  Search for keyword in character string containing PDS label.8C	  Return value-string of keyword, or error indication.8C	  Label assumed to be in PDS form (Reference: ______).?C	  Search extends through last position currently used (KPOS).CPC_LIMITS: Assumes no "equal-signs" (=) within literal or text strings or vectorsCC_CALLS:  LENVALC(C_KEYS:  PDS, FILE_LABEL, STRING_PARSINGCNC_HIST:  86mar__  R. Mehlman (RMX) UCLA/IGPP  ORIGINAL VERSION (pre-PDS label) C	 86jun09  RMX  LVAL correction.C	 87may27  RMX  PDS label preliminary versionEC	 87jul02  RMX  PDS label level 0 version (assumes no =s in strings)C	 86oct26  RMX  DocumentationCC_ENDC-      LKEY=INDEX(KEY,' ')-1			! LENGTH OF KEY"      IF (LKEY.LE.0) LKEY=LEN(KEY)	      I=15 10   IEQ=INDEX(LAB(I:KPOS),'=')		! SEARCH FOR NEXT =6C... assumes no (=)s within strings, vectors, etc. ....      IF (IEQ.EQ.0) GO TO 51			! NO MORE, QUITG      IKEY=INDEX(LAB(I:I+IEQ),KEY(1:LKEY))	! SEARCH FOR KEY UP TO THE =+      IF (IKEY.GT.0) GO TO 20			! FOUND IT?'      I=I+IEQ					! NO, INCREMENT INDEX,C... should really skip over value first ...       GO TO 10					! GO FOR NEXT1 20   I=IEQ+I					! YES, FOUND KEY, SET NEXT CHAR; 22   IF (LAB(I:I).NE.' ') GO TO 25		! SEARCH FOR NON-BLANK*      I=I+1					! NOT YET, INCREMENT INDEX%      GO TO 22					! GO FOR NEXT CHAR= 25   LVAL=LENVAL(LAB(I:))			! COMPUTE LENGTH OF VALUE STRING4      IF (LVAL) 52,60,30			! EXAMINE RETURNED LENGTHC  NON-NULL STRING2 30   VAL=LAB(I:I+LVAL-1)			! EXTRACT VALUE STRING      RETURNC  ERROR, STRING NOT FOUND
 51   LVAL=-1      GO TO 60C  ERROR, INVALID STRING
 52   LVAL=-23C  ERROR, OR NULL VALUE STRING - OUTPUT NULL STRINGEC   IF NULL STRING FOUND - SUBSTITUTE SINGLE SPACE BUT LEAVE LENGTH 0
 60   VAL=' '      RETURN	      ENDCC-C  CRELAB:  CREATE NEW LABEL IN MEMORY BUFFER#C   FILL LABEL WITH SPACES, INSERT:?C     RECORD_TYPE=FIXED, RECORD_BYTES=512, LABEL_BYTES=llab/512IC   RETURN CURRENT POSITION (KPOS) OR -3 IF BUFFER TOO SMALL OR TOO LARGENC   LABEL SIZE MUST BE BETWEEN 512 BYTES (1 BLOCK) AND 10240 BYTES (20 BLOCKS)C    IN WHOLE BLOCKSIC...Should SFDU be gotten from file or common or argument so variable ???6C  CALLS ADDKEY, PLVALI		PDS label version	RMX 20AUG87&      SUBROUTINE CRELAB(LAB,LLAB,KPOS)      CHARACTER*(*) LAB1      DATA LBLK /512/ , LMIN /512/ , LMAX /10240/CC      IF (LLAB.LT.LMIN.OR.LLAB.GT.LMAX) GO TO 53 ! IS LENGTH VALID?      KPOS=0G      CALL ADDKEY(LAB,LLAB,KPOS,'NJPL1I00PDS000000000','SFDU_LABEL',IR)      IF (IR.LT.0) RETURN9      CALL ADDKEY(LAB,LLAB,KPOS,'RECORD_TYPE','FIXED',IR)      IF (IR.LT.0) RETURN7      CALL PLVALI(LAB,LLAB,KPOS,'RECORD_BYTES',LBLK,IR)      IF (IR.LT.0) RETURN      LABLKS=(LLAB+LBLK-1)/LBLK:      CALL PLVALI(LAB,LLAB,KPOS,'LABEL_RECORDS',LABLKS,IR)H      DO 30 I=KPOS+1,LLAB                        ! FILL REST WITH SPACES 30   LAB(I:I)=' '      RETURN'C  ERROR, BUFFER TOO SMALL OR TOO LARGE
 53   KPOS=-3      RETURN	      ENDC  C1C  ADDKEY:  ADD KEYWORD AND VALUE STRING TO LABELOC   IR:  >0 # CHARS ADDED (INCL SP)  -2 INVALID KEY OR VALUE STRING  -3 NO ROOM)C  LABEL STATEMENT FORM:  key=val<CR><LF>$C  Allow comment?  Another argument?.C  CALLS LENVAL		PDS label version	RMX 18AUG87C1      SUBROUTINE ADDKEY(LAB,LLAB,KPOS,KEY,VAL,IR)      CHARACTER*(*) LAB,KEY,VAL      CHARACTER*1 CR,LFC      CR=CHAR(13)      LF=CHAR(10)C>      LKEY=INDEX(KEY,' ')-1                    ! LENGTH OF KEY"      IF (LKEY.LE.0) LKEY=LEN(KEY)@      LVAL=LENVAL(VAL)                         ! LENGTH OF VALUE"      IF (LVAL.LE.0) LVAL=LEN(VAL)G      IF (LVAL.LE.0) GO TO 52                  ! ERROR IF INVALID VALUEM      KEND=KPOS+LKEY+LVAL+3                    ! COMPUTE POS OF TERMINAL <LF>I      IF (KEND.GT.LLAB) GO TO 53               ! ERROR IF NOT ENOUGH ROOMA      LAB(KPOS+1:KPOS+LKEY+1)=KEY(1:LKEY)//'=' ! INSERT KEY AND =K      LAB(KPOS+LKEY+2:KEND)=VAL(1:LVAL)//CR//LF ! INSERT VALUE AND <CR><LF>K      IR=KEND-KPOS                             ! RETURN TOTAL # CHARS ADDEDH      KPOS=KEND                                ! UPDATE CURRENT POSITION      RETURN%C  ERROR, INVALID KEY OR VALUE STRING 52   IR=-2      RETURNC  ERROR, NO ROOM 53   IR=-3      RETURN	      ENDCC2C  DELKEY:  DELETE KEY AND VALUE STRING FROM LABEL;C   IKEY:  POSITION OF START OF DELETED KEY, 0 IF NOT FOUND-C   IR:  >0 # CHARS DELETED  -1 KEY NOT FOUND+C  Need to allow blanks/tabs around (=) ???7C  Need to delete possible comment, as well as <CR><LF>.C  CALLS LENVAL		PDS label version	RMX 18aug87-      SUBROUTINE DELKEY(LAB,LLAB,KEY,IKEY,IR)      CHARACTER*(*) LAB,KEYC>      LKEY=INDEX(KEY,' ')-1                    ! LENGTH OF KEY"      IF (LKEY.LE.0) LKEY=LEN(KEY)@      IKEY=INDEX(LAB(1:LLAB),KEY(1:LKEY)//'=') ! SEARCH FOR KEY=:      IF (IKEY.EQ.0) GO TO 51                  ! NOT FOUNDP      IBEG=IKEY+LKEY+1                         ! FOUND, COMPUTE START POS OF VALO      LVAL=LENVAL(LAB(IBEG:))                  ! COMPUTE LENGTH OF VALUE STRING/C .. WHAT IF INVALID VALUE STRING (LVAL=-1) ???M      DO 10 I=IKEY,IKEY+LKEY+LVAL+2            ! BLANK OUT KEY=STRING<CR><LF> 10   LAB(I:I)=' 'O      IR=LKEY+LVAL+3                           ! RETURN LENGTH OF DELETED ENTRY      RETURNC  ERROR - KEY NOT FOUND 51   IR=-1      RETURN	      ENDCCIC  UPDKEY:  UPDATE KEY, REPLACING VALUE IF ROOM, ELSE FILLING WITH SPACES&C   AND ADDING NEW KEY AT END OF LABEL:C  IR:  0 DONE  -1 NOT FOUND  -2 INVALID VALUE  -3 NO ROOM7C  Need to consider possible comment, spaces around (=)>C  CALLS DELKEY, ADDKEY, LENVAL		PDS label version	RMX 18aug871      SUBROUTINE UPDKEY(LAB,LLAB,KPOS,KEY,VAL,IR)      CHARACTER*(*) LAB,KEY,VAL      CHARACTER*1 CR,LFC      CR=CHAR(13)      LF=CHAR(10)CG      CALL DELKEY(LAB,LLAB,KEY,IKEY,IR)        ! DELETE CURRENT KEY=VALE      IF (IR.EQ.-1) RETURN                     ! ERROR, KEY NOT FOUND>      LKEY=INDEX(KEY,' ')-1                    ! LENGTH OF KEY"      IF (LKEY.LE.0) LKEY=LEN(KEY)@      LVAL=LENVAL(VAL)                         ! LENGTH OF VALUEI      IF (LVAL.LE.0) GO TO 50                  ! INVALID VALUE, RETURN -2E      IF (LKEY+LVAL+1.GT.IR) GO TO 20          ! IS NEW ENTRY LARGER?B      LAB(IKEY:IKEY+LKEY)=KEY(1:LKEY)//'='     ! NO, REINSERT KEY=P      LAB(IKEY+LKEY+1:IKEY+LKEY+LVAL+2)=VAL(1:LVAL)//CR//LF ! INSERT VALUE,CR/LF
      IR=0      RETURN@ 20   CALL ADDKEY(LAB,LLAB,KPOS,KEY,VAL,IR)    ! YES, ADD AT END 50   RETURNC  ERROR, KEY NOT FOUND 51   IR=-1            RETURNC  ERROR, NO ROOM 53   IR=-3      RETURN	      ENDCC1C  CMPLAB:  COMPRESS LABEL, REMOVING EXTRA SPACESC  Do we need this?&      SUBROUTINE CMPLAB(LAB,LLAB,KPOS)      CHARACTER*(*) LABCMC  FIND ALL STRINGS OF MORE THAN 1 SPACE (THAT ARE NOT WITHIN SINGLE QUOTES?)AC  REMOVE THESE BY SHIFTING REST OF LABEL, RESET CURRENT POSITION      RETURN	      ENDCCGC  PART II - HIGHER LEVEL ROUTINES WHICH PROCESS PARTICULAR VALUE TYPESC'C  GLVALI:  GET LABEL VALUE - INTEGER*4?C  CALLS GTKVAL,INTCH    LVAL:  -1 NOT FOUND  -2 INVALID STRING/      SUBROUTINE GLVALI(LAB,KPOS,KEY,IVAL,LVAL)      CHARACTER*(*) LAB,KEY      CHARACTER*12 VALC(      CALL GTKVAL(LAB,KPOS,KEY,VAL,LVAL),      IF (LVAL.GE.0) IVAL=INTCH(VAL(1:LVAL))      RETURN	      ENDC'C  PLVALI:  PUT LABEL VALUE - INTEGER*4AC  CALLS GTKVAL,ADDKEY,CHINT4      SUBROUTINE PLVALI(LAB,LLAB,KPOS,KEY,IVAL,LVAL)      CHARACTER*(*) LAB,KEYI      CHARACTER*12 VAL,CHINTCL      VAL=CHINT(IVAL)3;      CALL ADDKEY(LAB,LLAB,KPOS,KEY,VAL,LVAL)        ! TEMP6NC      CALL UPDKEY(LAB,KPOS,KEY,VAL,IR)              ! CHANGE UPDATE FIRST ...      RETURN	      ENDECO$C  GLVALR:  GET LABEL VALUE - REAL*4@C  CALLS GTKVAL,REALCH    LVAL:  -1 NOT FOUND  -2 INVALID STRING/      SUBROUTINE GLVALR(LAB,KPOS,KEY,RVAL,LVAL)      CHARACTER*(*) LAB,KEY      CHARACTER*20 VALC(      CALL GTKVAL(LAB,KPOS,KEY,VAL,LVAL)-      IF (LVAL.GE.0) RVAL=REALCH(VAL(1:LVAL))      RETURN	      ENDC$C  PLVALR:  PUT LABEL VALUE - REAL*4C  CALLS GTKVAL,ADDKEY,CHREAL4      SUBROUTINE PLVALR(LAB,LLAB,KPOS,KEY,RVAL,LVAL)      CHARACTER*(*) LAB,KEY      CHARACTER*20 VAL,CHREALC      VAL=CHREAL(RVAL);      CALL ADDKEY(LAB,LLAB,KPOS,KEY,VAL,LVAL)        ! TEMPNC      CALL UPDKEY(LAB,KPOS,KEY,VAL,IR)              ! CHANGE UPDATE FIRST ...      RETURN	      END