cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c  Followinf subroutines are copied from Binbin Zhou's Grid2grid program
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc


	SUBROUTINE ST_RMBL  ( string, outstr, length, iret )
C************************************************************************
C* ST_RMBL								*
C*									*
C* This subroutine removes spaces and tabs from a string.  The input	*
C* and output strings may be the same variable.				*
C*									*
C* ST_RMBL  ( STRING, OUTSTR, LENGTH, IRET )				*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String				*
C*									*
C* Output parameters:							*
C*	OUTSTR		CHAR*		String without blanks		*
C*	LENGTH		INTEGER		Length of output string		*
C*	IRET		INTEGER		Return code			*
C*				   	 0 = normal return 		*
C**									*
C* Log:									*
C* M. desJardins/GSFC	 8/84						*
C* M. desJardins/GSFC	 6/88	Documentation				*
C* M. desJardins/NMC	 3/92	Add temporary variable ttt		*
C* L. Sager/NCEP         2/96   Increased size of sss and ttt           *
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    * 
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for the GEMPAK
C* software routines in the ST_ and PR_ libraries.
C*
C* CRAY version
C**
C* Log:  
C*	Kidwell/NCEP	07/96	Adapted a subset of gemprm.prm for Cray
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C!
C! 	Physical and mathematical constants
C!
	PARAMETER       ( PI = 3.14159265  )
C!                                              PI
	PARAMETER       ( DTR = PI / 180.  )
	PARAMETER       ( RTD = 180. / PI  )
C!                                              Degrees <--> Radians
	PARAMETER	( GRAVTY = 9.80616  )
C!						Acceleration of gravity
	PARAMETER	( RDGAS  = 287.04   )
	PARAMETER	( RKAP   = RDGAS / GRAVTY )
C!						Gas constant of dry air
	PARAMETER	( RKAPPA = 2. / 7. )
C!						Poisson constant
	PARAMETER	( GAMUSD = 6.5 )
C!						US std atmos lapse rate
	PARAMETER	( TMCK   = 273.15 )
C!						Centigrade -> Kelvin
C!
C!	ASCII character constants 
C!
C!	Since the Cray does not allow the use of a function (e.g.,
C!	CHAR) to define a parameter, nor does it allow a character
C!	to be defined directly as a hex (X) value, the convolutions
C!      below are necessary to define the character values for Cray.
C!
C
	CHARACTER * 1 chnull, chtab, chspac, chtlda
C
	CHARACTER * 8 c8null, c8tab, c8spac, c8tlda
C
	INTEGER       iigemc ( 4 )
C
	EQUIVALENCE ( chnull, c8null (8:8) ), ( chtab , c8tab  (8:8) ),
     +              ( chspac, c8spac (8:8) ), ( chtlda, c8tlda (8:8) ) 
C
	EQUIVALENCE ( iigemc ( 1), c8null ), ( iigemc ( 2), c8tab  ),
     +              ( iigemc ( 3), c8spac ), ( iigemc ( 4), c8tlda )
C
	DATA iigemc / X'00',    X'09',    X'20',    X'7E' /
C                     Null      Tab       Space     Tilda
C!
C*
	CHARACTER*(*)	string, outstr
C*
	CHARACTER	c*1, sss*160, ttt*160
C-----------------------------------------------------------------------
	iret   = 0
	length = 0
	sss    = string
	ttt    = ' '
C
C*	Get length of input string.
C
	CALL ST_LSTR  ( sss, lens, iret )
C
C*	Check each character to see if it is a blank.
C
	DO  i = 1, lens
	    c = sss (i:i)
	    IF  ( ( c .ne. CHSPAC ) .and. ( c .ne. CHTAB ) )  THEN
		length = length + 1
		ttt ( length : length ) = c
	    END IF
	END DO
C*
	outstr = ttt
C*
	RETURN
	END


	SUBROUTINE ST_NUMB  ( string, ival, iret )
C************************************************************************
C* ST_NUMB                                       			*
C*									*
C* This subroutine converts a string into an integer.			* 
C*									*
C* ST_NUMB  ( STRING, IVAL, IRET )					*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String				*
C*									*
C* Output parameters:							*
C*	IVAL		INTEGER		Integer value      		*
C*	IRET		INTEGER		Return code			*
C*				 	  0 = normal return		*
C*					 -2 = conversion error		*
C** 									*
C* Log:									*
C* M. desJardins/NMC	 3/92	Rewritten to avoid special cases	*
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    *
C* B. Zhou              08/2012 Adapted onto Zeus/wcoss Linux compiler version
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for the GEMPAK
C* software routines in the ST_ and PR_ libraries.
C*
C* CRAY version
C**
C* Log:  
C*	Kidwell/NCEP	07/96	Adapted a subset of gemprm.prm for Cray
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C!
C! 	Physical and mathematical constants
C!
	PARAMETER       ( PI = 3.14159265  )
C!                                              PI
	PARAMETER       ( DTR = PI / 180.  )
	PARAMETER       ( RTD = 180. / PI  )
C!                                              Degrees <--> Radians
	PARAMETER	( GRAVTY = 9.80616  )
C!						Acceleration of gravity
	PARAMETER	( RDGAS  = 287.04   )
	PARAMETER	( RKAP   = RDGAS / GRAVTY )
C!						Gas constant of dry air
	PARAMETER	( RKAPPA = 2. / 7. )
C!						Poisson constant
	PARAMETER	( GAMUSD = 6.5 )
C!						US std atmos lapse rate
	PARAMETER	( TMCK   = 273.15 )
C!						Centigrade -> Kelvin
C!
C!	ASCII character constants 
C!
C!	Since the Cray does not allow the use of a function (e.g.,
C!	CHAR) to define a parameter, nor does it allow a character
C!	to be defined directly as a hex (X) value, the convolutions
C!      below are necessary to define the character values for Cray.
C!
C
	CHARACTER * 1 chnull, chtab, chspac, chtlda
C
	CHARACTER * 8 c8null, c8tab, c8spac, c8tlda
C
	INTEGER       iigemc ( 4 )
C
	EQUIVALENCE ( chnull, c8null (8:8) ), ( chtab , c8tab  (8:8) ),
     +              ( chspac, c8spac (8:8) ), ( chtlda, c8tlda (8:8) ) 
C
	EQUIVALENCE ( iigemc ( 1), c8null ), ( iigemc ( 2), c8tab  ),
     +              ( iigemc ( 3), c8spac ), ( iigemc ( 4), c8tlda )
C
	DATA iigemc / X'00',    X'09',    X'20',    X'7E' /
C                     Null      Tab       Space     Tilda
C!
C*
	CHARACTER*(*) 	string
C*
	CHARACTER	sss*12, c*1
	LOGICAL		good, plus
C------------------------------------------------------------------------
	iret = -2
	ival = IMISSD
C
C*	Remove blanks from string.
C
czeus	CALL ST_RMBL  ( string, sss, lens, ier )
        lens=len_trim(string)
        sss=string(1:lens)
C
C*	Check for empty string.
C
	IF  ( lens .eq. 0 )  RETURN
C
C*	If last character is period, remove it.
C
	IF  ( sss (lens:lens) .eq. '.' )  THEN
	    sss (lens:lens) = ' '
	    lens = lens - 1
	END IF
	IF  ( lens .eq. 0 )  RETURN
C
C*	Check for + or - in first character.
C
	IF  ( sss (1:1) .eq. '+' )  THEN
	    ibeg = 2
	    plus = .true.
	  ELSE IF  ( sss (1:1) .eq. '-' )  THEN
	    ibeg = 2
	    plus = .false.
	  ELSE
	    ibeg = 1
	    plus = .true.
	END IF
	IF  ( ibeg .gt. lens )  RETURN
C
C*	Now loop through all characters and turn into integer.
C
	ival0 = ICHAR ( '0' )
	ival  = 0
	good  = .true.
	i     = ibeg
	DO  WHILE  ( good .and. ( i .le. lens ) )
	    c     = sss (i:i)
	    ivalc = ICHAR ( c ) - ival0
	    IF  ( ( ivalc .ge. 0 ) .and. ( ivalc .le. 9 ) )  THEN
		ival  = ival * 10 + ivalc
		i     = i + 1
	      ELSE
		good  = .false.
	    END IF
	END DO
C
C*	Check for good value and add sign.
C
	IF  ( .not. good )  THEN
	    ival = IMISSD
	  ELSE IF  ( plus )  THEN
	    iret = 0
	  ELSE
	    iret = 0
	    ival = -ival
	END IF
C*
	RETURN
	END


	SUBROUTINE ST_CLST  ( string, sep, cdef, nexp, carr, num, iret )
C************************************************************************
C* ST_CLST								*
C*									*
C* This subroutine breaks a string containing a list of strings into	*
C* an array of strings.  The separator for the strings is input as SEP.	*
C* If the separator is a blank, multiple blanks will be changed to	*
C* single blanks before the string is processed.  If null strings	*
C* are encountered or fewer than NEXP strings are found in the		*
C* string, the appropriate CARR locations are set to CDEF.		*
C*									*
C* ST_CLST  ( STRING, SEP, CDEF, NEXP, CARR, NUM, IRET )		*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String 				*
C*	SEP		CHAR*1		Separator			*
C*	CDEF		CHAR*		Default string 			*
C*	NEXP		INTEGER 	Number of expected values 	*
C*									*
C* Output parameters:							*
C*	CARR  (NUM)	CHAR*		Array of strings 		*
C*	NUM		INTEGER 	Number of strings returned	*
C*	IRET		INTEGER 	Return code			*
C*				   	  1 = more than NEXP values	*
C*				   	  0 = normal return		*
C**									*
C* Log:									*
C* M. Goodman/RDS	10/84	Original source for STLIST		*
C* M. desJardins/GSFC	11/84						*
C* M. desJardins/GSFC	 2/85	Modified for ST_CLST			*
C* M. desJardins/GSFC	 6/88	Documentation				*
C* L. Sager/NCEP         2/96   Increased size of strbuf                *
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    *
C************************************************************************
	CHARACTER*(*) 	string, sep, carr (*), cdef
C*
	CHARACTER	strbuf*160, cchar*1
C------------------------------------------------------------------------
	iret = 0
	num  = 0
C
C*	Remove blanks from the input string if the separator is not
C*	a blank.
C
	IF  ( sep .ne. ' ' )  THEN
czeus	    CALL ST_RMBL  ( string, strbuf, isize, iret )
            isize=len_trim(string)
            strbuf=string(1:isize)
	  ELSE
czeus	    CALL ST_RXBL  ( string, strbuf, isize, iret )
            isize=len_trim(string)
            strbuf=string(1:isize)
	END IF
C
C*	Initialize output array.
C
	DO  i = 1, nexp
	    carr (i) = cdef
	END DO
C
C*	Check for zero length input string.
C
	IF  ( isize .eq. 0 )  THEN
	    num = 0
C
C*	    Check for separator and find list elements.
C
	  ELSE
	    cchar  = sep
	    iend   = 0
	    ibegin = 1
	    DO WHILE  ( ibegin .le. isize )
	        loc = INDEX  ( strbuf ( ibegin: ), cchar )
	        IF  ( loc .eq. 0 )  THEN
		    iend = isize + 1
	          ELSE
		    iend = ibegin + loc - 1
	        END IF
C
C*	        Add into output list.  Check that num <= nexp.
C
	        IF  ( num .ge. nexp )  THEN
		    iret = 1
		  ELSE
		    num = num + 1
	    	    IF  ( ibegin .ne. iend )  THEN
			carr ( num ) = strbuf ( ibegin : iend-1 )
	    	    END IF
		END IF

CZeus modify to skip space: by Binbin Zhoucccccccccccccccccccccccccc
            do while ( strbuf (iend+1:iend+1) .eq. ' ' )
             iend = iend + 1
            end do
cccccccccccccccccccccccccccccccccccccccccccccccccccccc

	    ibegin = iend + 1
	    END DO
	END IF
C*
	RETURN
	END


	SUBROUTINE ST_LDSP  ( string, outstr, ncout, iret )
C************************************************************************
C* ST_LDSP								*
C*									*
C* This subroutine deletes the leading spaces and tabs in a string.	*
C* The input and output strings may be the same variable.		*
C*									*
C* ST_LDSP  ( STRING, OUTSTR, NCOUT, IRET )				*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String				*
C*									*
C* Output parameters:							*
C*	OUTSTR		CHAR*		Output string			*
C*	NCOUT		INTEGER		Number of characters output	*
C*	IRET		INTEGER		Return code			*
C*					  0 = normal return		*
C**									*
C* Log:									*
C* I. Graffman/RDS	 2/84	Use new GEMPAK routines			*
C* M. desJardins/GSFC	11/84	Fixed					*
C* M. desJardins/GSFC	 6/88	Documentation				*
C* L. Sager/NCEP         2/96   Increased size of stbuf                 *
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    *
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for the GEMPAK
C* software routines in the ST_ and PR_ libraries.
C*
C* CRAY version
C**
C* Log:  
C*	Kidwell/NCEP	07/96	Adapted a subset of gemprm.prm for Cray
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C!
C! 	Physical and mathematical constants
C!
	PARAMETER       ( PI = 3.14159265  )
C!                                              PI
	PARAMETER       ( DTR = PI / 180.  )
	PARAMETER       ( RTD = 180. / PI  )
C!                                              Degrees <--> Radians
	PARAMETER	( GRAVTY = 9.80616  )
C!						Acceleration of gravity
	PARAMETER	( RDGAS  = 287.04   )
	PARAMETER	( RKAP   = RDGAS / GRAVTY )
C!						Gas constant of dry air
	PARAMETER	( RKAPPA = 2. / 7. )
C!						Poisson constant
	PARAMETER	( GAMUSD = 6.5 )
C!						US std atmos lapse rate
	PARAMETER	( TMCK   = 273.15 )
C!						Centigrade -> Kelvin
C!
C!	ASCII character constants 
C!
C!	Since the Cray does not allow the use of a function (e.g.,
C!	CHAR) to define a parameter, nor does it allow a character
C!	to be defined directly as a hex (X) value, the convolutions
C!      below are necessary to define the character values for Cray.
C!
C
	CHARACTER * 1 chnull, chtab, chspac, chtlda
C
	CHARACTER * 8 c8null, c8tab, c8spac, c8tlda
C
	INTEGER       iigemc ( 4 )
C
	EQUIVALENCE ( chnull, c8null (8:8) ), ( chtab , c8tab  (8:8) ),
     +              ( chspac, c8spac (8:8) ), ( chtlda, c8tlda (8:8) ) 
C
	EQUIVALENCE ( iigemc ( 1), c8null ), ( iigemc ( 2), c8tab  ),
     +              ( iigemc ( 3), c8spac ), ( iigemc ( 4), c8tlda )
C
	DATA iigemc / X'00',    X'09',    X'20',    X'7E' /
C                     Null      Tab       Space     Tilda
C!
C*
	CHARACTER*(*)	string, outstr
C*
	CHARACTER	stbuf*160, c*1
C*-------------------------------------------------------------------------
	stbuf = string
	iret  = 0
C
C*	Get length of string.
C
	CALL ST_LSTR  ( stbuf, lens, iret )
C
C*	If length is non-zero, find first non space.
C
	IF  ( lens .eq. 0 )  THEN
	    ncout  = 0
	    outstr = ' '
	  ELSE
	    jp = 1
	    c  = stbuf ( jp:jp )
C
	    DO WHILE  ( ( ( c .eq. CHSPAC ) .or. ( c .eq. CHTAB ) .or.
     +			  ( c .eq. CHNULL ) ) .and. ( jp .le. lens ) )
		jp = jp + 1
		IF  ( jp .le. lens )  c = stbuf ( jp:jp )
	    ENDDO
C
C*	    Compute length and fill output string.
C
	    ncout = lens - jp + 1
	    IF  ( ncout .gt. 0 )  THEN
		outstr = stbuf ( jp : lens )
	      ELSE
		outstr = ' '
	    END IF
	ENDIF
C*  
	RETURN
	END


	SUBROUTINE ST_LSTR  ( string, lens, iret )
C************************************************************************
C* ST_LSTR								*
C*									*
C* This subroutine returns the number of characters in a string 	*
C* disregarding trailing null characters, tabs and spaces.		*
C*									*
C* ST_LSTR  ( STRING, LENS, IRET )						*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String 				*
C*									*
C* Output parameters:							*
C*	LENS		INTEGER 	Length of string		*
C*	IRET		INTEGER		Return code			*
C*				 	 0 = normal return 		*
C**									*
C* Log:									*
C* J. Woytek/GSFC	 6/82 	STR_LNSTR				*
C* I. Graffman/RDS	 2/84 	Fix zero length string handling		*
C* M. desJardins/GSFC	 6/88	Rewritten				*
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    *
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for the GEMPAK
C* software routines in the ST_ and PR_ libraries.
C*
C* CRAY version
C**
C* Log:  
C*	Kidwell/NCEP	07/96	Adapted a subset of gemprm.prm for Cray
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C!
C! 	Physical and mathematical constants
C!
	PARAMETER       ( PI = 3.14159265  )
C!                                              PI
	PARAMETER       ( DTR = PI / 180.  )
	PARAMETER       ( RTD = 180. / PI  )
C!                                              Degrees <--> Radians
	PARAMETER	( GRAVTY = 9.80616  )
C!						Acceleration of gravity
	PARAMETER	( RDGAS  = 287.04   )
	PARAMETER	( RKAP   = RDGAS / GRAVTY )
C!						Gas constant of dry air
	PARAMETER	( RKAPPA = 2. / 7. )
C!						Poisson constant
	PARAMETER	( GAMUSD = 6.5 )
C!						US std atmos lapse rate
	PARAMETER	( TMCK   = 273.15 )
C!						Centigrade -> Kelvin
C!
C!	ASCII character constants 
C!
C!	Since the Cray does not allow the use of a function (e.g.,
C!	CHAR) to define a parameter, nor does it allow a character
C!	to be defined directly as a hex (X) value, the convolutions
C!      below are necessary to define the character values for Cray.
C!
C
	CHARACTER * 1 chnull, chtab, chspac, chtlda
C
	CHARACTER * 8 c8null, c8tab, c8spac, c8tlda
C
	INTEGER       iigemc ( 4 )
C
	EQUIVALENCE ( chnull, c8null (8:8) ), ( chtab , c8tab  (8:8) ),
     +              ( chspac, c8spac (8:8) ), ( chtlda, c8tlda (8:8) ) 
C
	EQUIVALENCE ( iigemc ( 1), c8null ), ( iigemc ( 2), c8tab  ),
     +              ( iigemc ( 3), c8spac ), ( iigemc ( 4), c8tlda )
C
	DATA iigemc / X'00',    X'09',    X'20',    X'7E' /
C                     Null      Tab       Space     Tilda
C!
C*
	CHARACTER*(*)	string
C*
	CHARACTER*1	c
C*------------------------------------------------------------------------
	lens = 0
	iret = 0
C
C*	Get the actual length of the string.
C
	lens = LEN  ( string )
	IF  ( lens .eq. 0 )  RETURN
C
C*	Start at last character and loop backwards.
C
	ip = lens
	DO WHILE  ( ip .gt. 0 )
C
C*	    Get current value of string and check for space, null, tab.
c
	    c = string ( ip : ip )
	    IF  ( ( c .eq. CHSPAC ) .or. ( c .eq. CHNULL ) .or.
     +		  ( c .eq. CHTAB  ) )  THEN
		lens = lens - 1
		ip   = ip - 1
	      ELSE
		ip   = 0
	    END IF
	END DO
C*
	RETURN
	END


	SUBROUTINE ST_RXBL  ( string, outstr, length, iret )
C************************************************************************
C* ST_RXBL								*
C*									*
C* This subroutine removes extra spaces and tabs from a string.  Only	*
C* single blanks will separate substrings.  The input and output 	*
C* strings may be the same variable.					*
C*									*
C* ST_RXBL  ( STRING, OUTSTR, LENGTH, IRET )				*
C*									*
C* Input parameters:							*
C*	STRING		CHAR*		String				*
C*									*
C* Output parameters:							*
C*	OUTSTR		CHAR*		String without blanks		*
C*	LENGTH		INTEGER		Length of output string		*
C*	IRET		INTEGER		Return code			*
C*				   	 0 = normal return 		*
C**									*
C* Log:									*
C* M. desJardins/GSFC	 9/88						*
C* D. Kidwell/NCEP      10/96   Ported to Cray                          *
C* B. Zhou              05/2005 Adapted to Grid2Grid                    *
C************************************************************************
C* GEMPRM.PRM
C*
C* This include file contains parameter definitions for the GEMPAK
C* software routines in the ST_ and PR_ libraries.
C*
C* CRAY version
C**
C* Log:  
C*	Kidwell/NCEP	07/96	Adapted a subset of gemprm.prm for Cray
C************************************************************************
C!
C!	Missing data definitions
C!
 	PARAMETER	( RMISSD = -9999.0 )
C!						Missing data value
	PARAMETER	( RDIFFD =  0.1    )
C!						Missing value fuzziness
	PARAMETER	( IMISSD = -9999   )
C!						Missing integer value
	LOGICAL		  ERMISS
C!						Declare for stmt func
C!
C! 	Physical and mathematical constants
C!
	PARAMETER       ( PI = 3.14159265  )
C!                                              PI
	PARAMETER       ( DTR = PI / 180.  )
	PARAMETER       ( RTD = 180. / PI  )
C!                                              Degrees <--> Radians
	PARAMETER	( GRAVTY = 9.80616  )
C!						Acceleration of gravity
	PARAMETER	( RDGAS  = 287.04   )
	PARAMETER	( RKAP   = RDGAS / GRAVTY )
C!						Gas constant of dry air
	PARAMETER	( RKAPPA = 2. / 7. )
C!						Poisson constant
	PARAMETER	( GAMUSD = 6.5 )
C!						US std atmos lapse rate
	PARAMETER	( TMCK   = 273.15 )
C!						Centigrade -> Kelvin
C!
C!	ASCII character constants 
C!
C!	Since the Cray does not allow the use of a function (e.g.,
C!	CHAR) to define a parameter, nor does it allow a character
C!	to be defined directly as a hex (X) value, the convolutions
C!      below are necessary to define the character values for Cray.
C!
C
	CHARACTER * 1 chnull, chtab, chspac, chtlda
C
	CHARACTER * 8 c8null, c8tab, c8spac, c8tlda
C
	INTEGER       iigemc ( 4 )
C
	EQUIVALENCE ( chnull, c8null (8:8) ), ( chtab , c8tab  (8:8) ),
     +              ( chspac, c8spac (8:8) ), ( chtlda, c8tlda (8:8) ) 
C
	EQUIVALENCE ( iigemc ( 1), c8null ), ( iigemc ( 2), c8tab  ),
     +              ( iigemc ( 3), c8spac ), ( iigemc ( 4), c8tlda )
C
	DATA iigemc / X'00',    X'09',    X'20',    X'7E' /
C                     Null      Tab       Space     Tilda
C!
C*
	CHARACTER*(*)	string, outstr
C-----------------------------------------------------------------------
	length = 0
	iret   = 0
C
C*	Remove leading spaces and tabs.
C
	CALL ST_LDSP  ( string, outstr, isiz, iret )
	IF  ( isiz .le. 0 )  RETURN
C
C*	Remove extra spaces.
C
	ispac  = 0
	length = 0
	DO  j = 1, isiz
	    IF  ( ( outstr (j:j) .ne. CHSPAC )  .and. 
     +		  ( outstr (j:j) .ne. CHTAB  ) )  THEN
	        length = length + 1
	        outstr (length:length) = outstr (j:j)
	        ispac = 0
	      ELSE
	        IF  ( ispac .eq. 0 )  THEN
	            length = length + 1
	            outstr (length:length) = ' '
	            ispac = 1
	        END IF
	    END IF
	END DO
C
C*	Make sure the end of the string is blank.
C
	lens = LEN ( outstr )
	IF  ( lens .gt. length )  outstr ( length+1 : ) = ' '
C*
	RETURN
	END