CHARACTER*(*) FUNCTION PREPARSE(STRING)   
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Function   PREPARSE     
C.LIBRARY:        GENERAL
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       1.0 - 23 May 92 - Original version
C                                   based on EXPAND  V1 (Aug 87)
C.VERSIONS:       1.0 - 29 Oct 92 - New error handling codes
C.PURPOSE:        parse a sequence of blank or comma separated
C                 strings so that a Fortran free-format read can
C                 read them in a character array
C.METHOD:         enclose each string in double quotes     
C.SYNTAX:         CALL PREPARSE(string)
C.PARAMETERS:     CHARACTER*(*) string        a string (in and out)
C                 the returned value is also a function 
C.RESTRICTIONS:   there must be enough space in STRING for the
C                 expansion 
C.NOTES:          error code returned in VOSCOMMON
C                 if an error occurs the original string is returned
C                 unparsed
C.FILES:          none
C.REFERENCES:     noen
C
C Subroutine EXPAND expands a STRING of characters in the following way
C the string is parsed in fields separated by commas, and each field is
C enclosed within primes (this is to enable reading with list-directed i
C that is, free-format). There shall be enough spare space in the string
C (i.e. 2 char for each field), since replacement is done in place.
C Fields may also be separated by A SINGLE blank
C A non-zero error code is returned as value of EXPAND if no spare space
C is available.
C
C----------------------------------------------------------------------
C
C      INCLUDE 'implicit_none.inc'
       CHARACTER*(*) STRING
       INTEGER TRUE_LENGTH,LL,LK,IOFF,I,K
       CHARACTER PRIME*1
       PARAMETER (PRIME='''')
       INCLUDE 'voscommon.inc'
       INCLUDE 'errors.inc'
       VOSCOMMON_SYSTEMERROR=0
       VOSCOMMON_ERROR=0
       PREPARSE=STRING
C      Note difference between LK (inherited length of string) and LL
C      (true length excluding trailing blanks)
       LL=TRUE_LENGTH(PREPARSE)
       LK=LEN   (PREPARSE)
C      ignore/preserve blank-slash at the end (generated by X_READ)
C      do not parse it, and reserve space for it in output string
       IF(PREPARSE(LL-1:LL).EQ.' /')THEN
         LL=LL-2
         LK=LK-2
       ENDIF
       IF(PREPARSE(LL:LL).EQ.'/')THEN
         LL=LL-1
         LK=LK-1
       ENDIF
       IF(LL.EQ.0)RETURN
       PREPARSE(1:)=PRIME//PREPARSE(1:LL)
       IOFF=1
       DO 1 I=1,LL
       K=I+IOFF
       IF(PREPARSE(K:K).EQ.','.OR.PREPARSE(K:K).EQ.' ')THEN
         IF(K+2.GT.LK)THEN
C          there is no space : error code
           VOSCOMMON_ERROR=XE_TRSTRING
C          anyhow force a blank-slash at the end
C          not only, also close the quotes
C          use LK-1, if slash is lost past end of string does not matter
           PREPARSE(LK-1:)=PRIME//' /'
           RETURN
         ENDIF
         PREPARSE(1:)=PREPARSE(1:K-1)//PRIME//','//PRIME//PREPARSE(K+1:)
         IOFF=IOFF+2
C        if a separator is found and the next value is a separator
C        one shall not insert quotes ! But this is not an easy check
C        therefore we do it a posteriori, if the previous field was
C        like STRING,,.... it will be preparsed into
C        the form 'STRING','',... we reset it to 'STRING',,...
C        i.e. we drop the null string resetting the pointers
         IF(PREPARSE(K-1:K).EQ.PRIME//PRIME)THEN
            PREPARSE(K-1:)=PREPARSE(K+1:)
            IOFF=IOFF-2
         ENDIF
       ENDIF
1      CONTINUE
       LL=LL+IOFF+1
       IF(LL.GT.LK)THEN
C         there is no space : error code
          VOSCOMMON_ERROR=XE_TRSTRING
C         anyhow force a blank-slash at the end
C         not only, also close the quotes
          PREPARSE(LK-1:)=PRIME//' /'
          RETURN
       ENDIF
       PREPARSE(LL:LL)=PRIME
C      again as above
C      protect for the case of null strings ...
       IF(PREPARSE(LL-1:LL).EQ.PRIME//PRIME)LL=LL-2
C      and add blank-slash at the end
       PREPARSE(LL+1:)=' /'
       RETURN
       END