C*GET_FORTRAN_UNIT_NUMBER
C=----------------------------------------------------------------------
C                                                                      -
C               G E T__F O R T R A N__U N I T__N U M B E R             -
C                                                                      -
C=----------------------------------------------------------------------
C+
C     GET_FORTRAN_UNIT_NUMBER(unit)
C     unit - integer variable containing the available unit number
C
C     Subroutine GET_FORTRAN_UNIT_NUMBER  returns the
C     smallest FORTRAN unit number not in use. Units 5 and 6 are
C     reserved for their default functions of READ and WRITE to
C     STANDART I/O respectively.
C
C
C--
	SUBROUTINE GET_FORTRAN_UNIT_NUMBER(UNIT)
	INTEGER UNIT
	LOGICAL OPEN
	UNIT=1
10    INQUIRE(UNIT,OPENED=OPEN)
	IF(OPEN)THEN
	  UNIT=UNIT+1
	  IF(UNIT.EQ.5)UNIT=7
	  GOTO 10
	ENDIF
	END
C
C*STR$CASE_BLIND_COMPARE
C=----------------------------------------------------------------------
C                                                                      -
C              S T R $ C A S E__B L I N D__C O M P A R E               -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C     STR$CASE_BLIND_COMPARE(stringin,set)
C       stringin - first character string for comparison
C       set      - second character string for comparison
C
C     integer function STR$CASE_BLIND_COMPARE compares 'stringin'
C       and 'set' character-for-character irrespective of upper or
C       lower case and returns a value of zero if the comparison is
C       exact or a non-zero value otherwise. the shorter length
C       string is padded on the right with blanks to equal the length
C       of the longer string. this function is set up for use with
C       the ASCII collating sequence.
C
C
C--
	INTEGER FUNCTION STR$CASE_BLIND_COMPARE(STRINGIN,SET)

	CHARACTER*(*) STRINGIN,SET,CH1*1,CH2*1,CH3*1
	LENGTH=MAX(LEN(STRINGIN),LEN(SET))
	STR$CASE_BLIND_COMPARE=0
	DO I=1,LENGTH
	  CH1=STRINGIN(I:I)
	  CH2=SET(I:I)
	  CH3=' '
	  K=ICHAR(CH2)
	  IF(K.GE.65.AND.K.LE.90)THEN
	    CH3=CHAR(K+32)
	  ELSEIF(K.GE.97.AND.K.LE.122)THEN
	    CH3=CHAR(K-32)
	  ENDIF
	  IF(CH3.NE.' ')THEN
	    IF(CH1.NE.CH2.AND.CH1.NE.CH3)THEN
	    STR$CASE_BLIND_COMPARE=I
		RETURN
	    ENDIF
	  ELSEIF(CH3.EQ.' ')THEN
	    IF(CH1.NE.CH2)THEN
	    STR$CASE_BLIND_COMPARE=I
		RETURN
	    ENDIF
	  ENDIF
	END DO
	END
C
C*STR$COLLAPSE
C=----------------------------------------------------------------------
C                                                                      -
C                       S T R $ C O L L A P S E                        -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C
C     STR$COLLAPSE(stringin,stringout)
C       stringin  - character string containing source string
C                   to be collapsed
C       stringout - character string containing the collapsed
C                   string
C
C       integer function STR$COLLAPSE extracts blanks and horizontal
C       tab characters from source string and writing the remaining
C       characters to destination string in sequential order with the
C       total number of characters returned. a length of zero will be
C       returned for null strings.
C
C
C--
	INTEGER FUNCTION STR$COLLAPSE(STRINGIN,STRINGOUT)

	CHARACTER STRINGIN*(*),STRINGOUT*(*),STRING*500,CHARC,HT
	
	HT=CHAR(9)
	STR$COLLAPSE=0
	K=0
	STRING=' '
	DO J=1,LEN(STRINGIN)
	  CHARC=STRINGIN(J:J)
	  IF(CHARC.NE.' '.AND.CHARC.NE.HT)THEN
	    K=K+1
	    STRING(K:K)=CHARC
	    STR$COLLAPSE=K
	  ENDIF
	END DO
	STRINGOUT=STRING
	RETURN
	END
C
C*STR$COMPRESS
C=----------------------------------------------------------------------
C                                                                      -
C                       S T R $ C O M P R E S S                        -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C
C     STR$COMPRESS(stringin,stringout)
C       stringin  - character string containing source string
C                   to be compressed
C       stringout - character string containing the compressed
C                   string
C
C       integer function STR$COMPRESS removes blank and horizontal
C       tab characters from beginning and end of source string as
C       well as multiple occurances of these characters within the
C       source string. Multiple occurances within the string are
C       replaced with a single blank character. The length of the
C       returned string is the number of characters from the first
C       nonblank character to the last nonblank character inclusive.
C       a length of zero will be returned for null strings.
C
C
C--
	INTEGER FUNCTION STR$COMPRESS(STRINGIN,STRINGOUT)

	CHARACTER STRINGIN*(*),STRINGOUT*(*),STRING*500,CHARC,HT
	
	HT=CHAR(9)
	STR$COMPRESS=0
	I=0
	K=0
	STRING=' '
	DO J=1,LEN(STRINGIN)
	  CHARC=STRINGIN(J:J)
	  IF((CHARC.EQ.' '.OR.CHARC.EQ.HT).AND.I.EQ.0)THEN
	    I=1
	    K=K+1
	    STRING(K:K)=' '
	    STR$COMPRESS=K
	  ELSEIF(CHARC.NE.' '.AND.CHARC.NE.HT)THEN
	    I=0
	    K=K+1
	    STRING(K:K)=CHARC
	    STR$COMPRESS=K
	  ENDIF
	END DO
	IF(STRING(1:1).EQ.' ')THEN
	  K=K-1
	  STRING=STRING(2:)
	ENDIF
	IF(STRING(K:K).EQ.' ')THEN
	  K=K-1
	  STRING=STRING(:K)
	ENDIF
	STR$COMPRESS=K
	STRINGOUT=STRING
	RETURN
	END
C
C*STR$FIND_FIRST_IN_SET
C=----------------------------------------------------------------------
C                                                                      -
C                S T R $ F I N D__F I R S T__I N__S E T                -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C     STR$FIND_FIRST_IN_SET(stringin,set)
C       stringin - character string to be searched
C       set      - character string containing characters
C                  searched for in stringin
C
C     integer function STR$FIND_FIRST_IN_SET searches for the first
C       occurance of any character in 'set' within 'stringin' and
C       returns the relative position of the character found. if no
C       character from 'set' is found in 'stringin' a value of zero
C       is returned.
C
C
C--
	INTEGER FUNCTION STR$FIND_FIRST_IN_SET(STRINGIN,SET)

	CHARACTER*(*) STRINGIN,SET
	STR$FIND_FIRST_IN_SET=0
	DO I=1,LEN(STRINGIN)
	  DO J=1,LEN(SET)
	    IF(STRINGIN(I:I).EQ.SET(J:J))THEN
	    STR$FIND_FIRST_IN_SET=I
		RETURN
	    ENDIF
	  END DO
	END DO
	END
C
C*STR$FIND_FIRST_NOT_IN_SET
C=----------------------------------------------------------------------
C                                                                      -
C              S T R $ F I N D__F I R S T__N O T__I N__S E T           -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C     STR$FIND_FIRST_NOT_IN_SET(stringin,set)
C       stringin - character string to be searched
C       set      - character string containing characters
C                  searched for in stringin
C
C     integer function STR$FIND_FIRST_NOT_IN_SET searches for the
C       first occurance of any character not in 'set' within
C       'stringin' and returns the relative position of the character
C       found. if no character from 'set' is found in 'stringin' a
C       value of zero is returned.
C
C
C--
	INTEGER FUNCTION STR$FIND_FIRST_NOT_IN_SET(STRINGIN,SET)

	CHARACTER*(*) STRINGIN,SET
	STR$FIND_FIRST_NOT_IN_SET=0
	DO 10 I=1,LEN(STRINGIN)
	  DO J=1,LEN(SET)
	    IF(STRINGIN(I:I).EQ.SET(J:J))GOTO 10
	  END DO
	STR$FIND_FIRST_NOT_IN_SET=I
	  RETURN
10    CONTINUE
	END
C
C*STR$FIND_FIRST_IN_SET_R
C=----------------------------------------------------------------------
C                                                                      -
C                S T R $ F I N D__F I R S T__I N__S E T__R             -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C     STR$FIND_FIRST_IN_SET_R(stringin,set)
C       stringin - character string to be searched
C       set      - character string containing characters
C                  searched for in stringin
C
C       integer function STR$FIND_FIRST_IN_SET_R searches for the first
C       occurance of any character in 'set' within 'stringin' and
C       returns the relative position of the character found with
C       respect to the string beginning. Works just like the function
C       STR$FIND_FIRST_IN_SET except that the search is started from
C       the end of the string. if no character from 'set' is found
C       in 'stringin' a value of zero is returned.
C
C
C--
	INTEGER FUNCTION STR$FIND_FIRST_IN_SET_R(STRINGIN,SET)

	CHARACTER*(*) STRINGIN,SET
	STR$FIND_FIRST_IN_SET_R=0
	DO I=LEN(STRINGIN),1,-1
	  DO J=1,LEN(SET)
	    IF(STRINGIN(I:I).EQ.SET(J:J))THEN
		STR$FIND_FIRST_IN_SET_R=I
		RETURN
	    ENDIF
	  END DO
	END DO
	END
C
C*STR$FIND_FIRST_NOT_IN_SET_R
C=----------------------------------------------------------------------
C                                                                      -
C            S T R $ F I N D__F I R S T__N O T__I N__S E T__R          -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C     STR$FIND_FIRST_NOT_IN_SET_R(stringin,set)
C       stringin - character string to be searched
C       set      - character string containing characters
C                  searched for in stringin
C
C       integer function STR$FIND_FIRST_NOT_IN_SET_R searches for the
C       first occurance of any character not in 'set' within
C       'stringin' and returns the relative position of the character
C       found with respect to the string start. Works just like the
C       function STR$FIND_FIRST_NOT_IN_SET, except that the search is
C       started from the end of the string. if no character from 'set'
C       is found in 'stringin' a value of zero is returned.
C
C
C--
	INTEGER FUNCTION STR$FIND_FIRST_NOT_IN_SET_R(STRINGIN,SET)

	CHARACTER*(*) STRINGIN,SET
	STR$FIND_FIRST_NOT_IN_SET_R=0
	DO 10 I=LEN(STRINGIN),1,-1
	  DO J=1,LEN(SET)
	    IF(STRINGIN(I:I).EQ.SET(J:J))GOTO 10
	  END DO
	  STR$FIND_FIRST_NOT_IN_SET_R=I
	  RETURN
10    CONTINUE
	END
C
C*STR$LENGTH
C=----------------------------------------------------------------------
C                                                                      _
C                        S T R $ L E N G T H                           -
C                                                                      -
C=----------------------------------------------------------------------
C+
C
C
C     STR$LENGTH(stringin)
C       stringin - character string whose length is to be
C                  determined
C
C       integer function STR$LENGTH determines the length of the
C       source string from position one to the position of the last
C       non-blank character in the source string. if the source
C       string contains only blank characters, a value of zero is
C       returned.
C
C
C--
	INTEGER FUNCTION STR$LENGTH(STRINGIN)

	CHARACTER*(*) STRINGIN,HT*1
	
	HT=CHAR(9)
	STR$LENGTH=0
	DO K=LEN(STRINGIN),1,-1
	  IF(STRINGIN(K:K).NE.' '.AND.STRINGIN(K:K).NE.HT)THEN
	    STR$LENGTH=K
	    RETURN
	  ENDIF
	END DO
	END
C
C*STR$UPCASE
C=**********************************************************************
C                                                                      *
C                          S T R $ U P C A S E                         *
C                                                                      *
C=**********************************************************************
C+
C
C     STR$UPCASE(stringin,stringout)
C       stringin  - source character string
C       stringout - destination character string containing
C                   all upper case characters
C
C     subroutine STR$UPCASE converts any lower case characters
C       found in 'stringin' to upper case and write the new string
C       to 'stringout'.  this subroutine is set up for use with the
C       ASCII collating sequence.
C
C
C--
	SUBROUTINE STR$UPCASE(STRINGIN,STRINGOUT)

	CHARACTER*(*) STRINGIN,STRINGOUT,CH1*1,STRING*500
	STRING=' '
	DO I=1,LEN(STRINGIN)
	  CH1=STRINGIN(I:I)
	  K=ICHAR(CH1)
	  IF(K.GE.97.AND.K.LE.122)CH1=CHAR(K-32)
	  STRING(I:I)=CH1
	END DO
	STRINGOUT=STRING
	RETURN
	END
C
C*MATX_INIT_NXN
C=**********************************************************************
C                                                                      *
C                      M A T X__I N I T__N X N                         *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_INIT_NXN(mat,n,diag)
C         subroutine to initialize an N X N matrix to the idenity matrix
C
C         mat - an  N X N floating point array to be set equal to the
C               idenity matrix.
C         n   - integer value that defines the order of the matrix,"mat".
C         diag - floating value that will be assigned to the diagonal
C                terms of "mat". If 0 "mat" will be initialized to the
C                zero matrix. If 1 "mat" will be initialized to the
C                identity matrix.
C
C
C--

	  SUBROUTINE MATX_INIT_NXN(MAT,N,DIAG)

	  REAL*4 MAT(N,N)

	  DO I=1,N
	    DO J=1,N
		MAT(I,J)=0.0
		IF(I.EQ.J)MAT(I,J)=DIAG
	    END DO
	  END DO
	  RETURN
	  END
C
C*MATX_COPY_MXN
C=**********************************************************************
C                                                                      *
C                      M A T X__C O P Y__M X N                         *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_COPY_MXN(mat1,mat2,m,n)
C         subroutine to copy a M X N matrix into another M X N matrix
C
C         mat1 - an  M X N floating point array to be copied
C         mat2 - an  M X N floating point array containing the copied values
C         m   - integer value that defines the number of rows in matrices.
C         n   - integer value that defines the number of columns in matrices.
C
C
C--

	  SUBROUTINE MATX_COPY_MXN(MAT1,MAT2,M,N)

	  REAL*4 MAT1(M,N),MAT2(M,N)

	  DO I=1,M
	    DO J=1,N
		MAT2(I,J)=MAT1(I,J)
	    END DO
	  END DO
	  RETURN
	  END
C
C*MATX_INVERSE_NXN
C=**********************************************************************
C                                                                      *
C                      M A T X__I N V E R S E__N X N                   *
C                                                                      *
C=**********************************************************************
C+
C
C     MATX_INVERSE_NXN(lu,inverse,pivot,n)
C
C       subroutine to find the inverse of an N X N matrix using
C       LU decomposition.
C
C       lu      - an N X N array of floating point values. On call to
C                 subroutine contains the LU values  generated during
C                 a call to subroutine MATX_LU_DECOMPOSITION_NXN or
C                 subroutine MATXS_LU_DECOMPOSITION_NXN.
C
C       inverse - an N X N array of floating point values that
C                 contains the inverse of the LU decomposed matrix.
C
C       pivot   - an N length vector of integer values containing
C                 pivoting information generated during a previous call
C                 to subroutine MATX_LU_DECOMPOSITION_NXN or subroutine
C                 MATXS_LU_DECOMPOSITION_NXN for use in finding the
C                 inverse matrix.
C
C       n       - an integer value representing the maximum dimension
C                 of "matrix" and "pivot".
C
C       note:   subroutine MATX_LU_DECOMPOSITION_NXN or subroutine
C               MATXS_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.  The matricies "lu" and
C               "inverse" may not be the same.
C
C--

	SUBROUTINE MATX_INVERSE_NXN(LU,INVERSE,PIVOT,N)

	REAL*4       LU(N,N),INVERSE(N,N)

	INTEGER      PIVOT(N),ROW

	CALL MATX_INIT_NXN(INVERSE,N,1.0)

C     Solve for column 'J' of matrix "INVERSE".

	DO J=1,N

C       Solve the system "Lz=b".

	  DO I=1,N

C         Reorder vector "b" based on row interchanges made
C         during LU decomposition.

	    ROW=PIVOT(I)
	    IF(ROW.NE.I)THEN
		TMP1=INVERSE(I,J)
		INVERSE(I,J)=INVERSE(ROW,J)
		INVERSE(ROW,J)=TMP1
	    END IF

C         Solve for "z(I)".

	    SUM=0.0
	    DO K=1,I-1
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=INVERSE(I,J)-SUM
	  END DO

C       Solve the system "Ux=z".

	  DO I=N,1,-1

C         Solve for "x(I)".

	    SUM=0.0
	    DO K=I+1,N
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=(INVERSE(I,J)-SUM)/LU(I,I)
	  END DO
	END DO
	RETURN
	END
C
C*MATXT_INVERSE_NXN
C=**********************************************************************
C                                                                      *
C                      M A T X T__I N V E R S E__N X N                 *
C                                                                      *
C=**********************************************************************
C+
C
C     MATXT_INVERSE_NXN(lu,inverse,pivot,n)
C
C       subroutine to find the inverse of an N X N matrix using
C       LU decomposition.(for use with total pivoting)
C
C       lu      - an N X N array of floating point values. On call to
C                 subroutine contains the LU values  generated during
C                 a call to subroutine MATXT_LU_DECOMPOSITION_NXN.
C
C       inverse - an N X N array of floating point values that
C                 contains the inverse of the LU decomposed matrix.
C
C       pivot   - a 3 X N array of integer values containing pivoting
C                 information generated during a previous call
C                 to subroutine MATXT_LU_DECOMPOSITION_NXN for use in
C                 finding the inverse matrix.
C
C       n       - an integer value representing the maximum dimension
C                 of "matrix","inverse", and "pivot".
C
C       note:   subroutine MATXT_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.  The matricies "lu" and
C               "inverse" may not be the same.
C
C--

	SUBROUTINE MATXT_INVERSE_NXN(LU,INVERSE,PIVOT,N)

	REAL*4       LU(N,N),INVERSE(N,N)

	INTEGER      PIVOT(3,N),ROW,ROW1

	CALL MATX_INIT_NXN(INVERSE,N,1.0)

C     Solve for column 'J' of matrix "INVERSE".

	DO J=1,N

C       Solve the system "Lz=b".

	  DO I=1,N

C         Reorder vector "b" based on row interchanges made during
C         LU decomposition.

	    ROW=PIVOT(1,I)
	    IF(ROW.NE.I)THEN
		TMP1=INVERSE(I,J)
		INVERSE(I,J)=INVERSE(ROW,J)
		INVERSE(ROW,J)=TMP1
	    END IF

C         Solve for "z(I)".

	    SUM=0.0
	    DO K=1,I-1
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=INVERSE(I,J)-SUM
	  END DO

C       Solve the system "Ux=z".

	  DO I=N,1,-1

C         Solve for "x(I)".

	    SUM=0.0
	    DO K=I+1,N
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=(INVERSE(I,J)-SUM)/LU(I,I)
	  END DO
	END DO

C     Reorder inverse matirx "inverse" based on column interchanges
C     made during LU decomposition.

	DO I=1,N
	  ROW=PIVOT(2,I)
	  IF(ROW.NE.I)THEN
	    DO J=I,N
		IF(PIVOT(2,J).EQ.I)ROW1=J
	    END DO
	    DO J=1,N
		IF(ROW.EQ.ROW1)THEN
		  TMP=INVERSE(ROW,J)
		  INVERSE(ROW,J)=INVERSE(I,J)
		  INVERSE(I,J)=TMP
		ELSE
		  TMP=INVERSE(ROW,J)
		  INVERSE(ROW,J)=INVERSE(I,J)
		  TMP1=INVERSE(ROW1,J)
		  INVERSE(ROW1,J)=TMP
		  INVERSE(I,J)=TMP1
		ENDIF
	    END DO
	    ITMP=PIVOT(2,ROW1)
	    PIVOT(2,ROW1)=PIVOT(2,ROW)
	    PIVOT(2,ROW)=ROW
	    PIVOT(2,I)=ITMP
	  ENDIF
	END DO
	DO I=1,N
	  PIVOT(2,I)=PIVOT(3,I)
	END DO
	RETURN
	END
C
C*MATX_LINEAR_SOLVE
C=**********************************************************************
C                                                                      *
C                   M A T X__L I N E A R__S O L V E                    *
C                                                                      *
C=**********************************************************************
C+
C
C     MATX_LINEAR_SOLVE(lu,b,pivot,n)
C
C       subroutine to solve a linear system of the form "Ax=b" using
C       LU decomposition.
C
C       lu    - an N X N array of floating point values that contains
C               the LU values for matrix "A" generated during a call
C               to subroutine MATX_LU_DECOMPOSITION_NXN or subroutine
C               MATXS_LU_DECOMPOSITION_NXN.
C
C       b     - an N length vector of floating point values. On call
C               to subroutine contains values of vector "b" above. On
C               return contains the values of vector "x".
C
C       pivot - an N length vector of integer values containing
C               pivoting information generated during a previous call
C               to subroutine MATX_LU_DECOMPOSITON_NXN or subroutine
C               MATXS_LU_DECOMPOSITION_NXN for use in solving the
C               linear system "Ax=b", or the inverse of "matrix".
C
C       n     - an integer value representing the maximum dimension
C               of "matrix","b", and "pivot".
C
C       note:   subroutine MATX_LU_DECOMPOSITION_NXN or subroutine
C               MATXS_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.
C
C--

	SUBROUTINE MATX_LINEAR_SOLVE(LU,B,PIVOT,N)

	REAL*4       LU(N,N),B(N)

	INTEGER      PIVOT(N),ROW

C     Solve the system "Lz=b".

	DO I=1,N

C       Reorder the vector "b" based on the row interchanges made
C       during LU decomposition.

	  ROW=PIVOT(I)
	  IF(ROW.NE.I)THEN
	    TMP=B(I)
	    B(I)=B(ROW)
	    B(ROW)=TMP
	  END IF

C       Solve for "z(I)".

	  SUM=0.0
	  DO J=1,I-1
	   SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=B(I)-SUM
	END DO

C     Solve the system "Ux=z".

	DO I=N,1,-1

C       Solve for "x(I)".

	  SUM=0.0
	  DO J=I+1,N
	    SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=(B(I)-SUM)/LU(I,I)
	END DO
	RETURN
	END
C
C*MATXT_LINEAR_SOLVE
C=**********************************************************************
C                                                                      *
C                   M A T X T__L I N E A R__S O L V E                  *
C                                                                      *
C=**********************************************************************
C+
C
C     MATXT_LINEAR_SOLVE(lu,b,pivot,n)
C
C       subroutine to solve a linear system of the form "Ax=b" using
C       LU decomposition.(for use with total pivoting)
C
C       lu    - an N X N array of floating point values that contains
C               the LU values for matrix "A" generated during a call
C               to subroutine MATXT_LU_DECOMPOSITION_NXN.
C
C       b     - an N length vector of floating point values. On call
C               to subroutine contains values of vector "b" above. On
C               return contains the values of vector "x".
C
C       pivot - a 3 X N array of integer values containing
C               pivoting information generated during a previous call
C               to subroutine MATXT_LU_DECOMPOSITON_NXN for use in
C               solving the linear system "Ax=b", or the inverse
C               of "matrix".
C
C       n     - an integer value representing the maximum dimension
C               of "matrix","b", and "pivot".
C
C       note:   subroutine MATXT_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.
C
C--

	SUBROUTINE MATXT_LINEAR_SOLVE(LU,B,PIVOT,N)

	REAL*4       LU(N,N),B(N)

	INTEGER      PIVOT(3,N),ROW,ROW1

C     Solve the system "Lz=b".

	DO I=1,N

C       Reorder vector "b" based on row interchanges made during
C       LU decomposition.

	  ROW=PIVOT(1,I)
	  IF(ROW.NE.I)THEN
	    TMP=B(I)
	    B(I)=B(ROW)
	    B(ROW)=TMP
	  END IF

C       Solve for "z(I)".

	  SUM=0.0
	  DO J=1,I-1
	   SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=B(I)-SUM
	END DO

C     Solve the system "Ux=z".

	DO I=N,1,-1

C       Solve for "x(I)".

	  SUM=0.0
	  DO J=I+1,N
	    SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=(B(I)-SUM)/LU(I,I)
	END DO

C     Reorder the solution vector "x" based on column interchanges
C     made during LU decomposition.

	DO I=1,N
	  ROW=PIVOT(2,I)
	  IF(ROW.NE.I)THEN
	    DO J=I,N
		IF(PIVOT(2,J).EQ.I)ROW1=J
	    END DO
	    IF(ROW.EQ.ROW1)THEN
		TMP=B(ROW)
		B(ROW)=B(I)
		B(I)=TMP
	    ELSE
		TMP=B(ROW)
		B(ROW)=B(I)
		TMP1=B(ROW1)
		B(I)=TMP1
		B(ROW1)=TMP
	    ENDIF
	    ITMP=PIVOT(2,ROW1)
	    PIVOT(2,ROW1)=PIVOT(2,ROW)
	    PIVOT(2,ROW)=ROW
	    PIVOT(2,I)=ITMP
	  ENDIF
	END DO
	DO I=1,N
	  PIVOT(2,I)=PIVOT(3,I)
	END DO
	RETURN
	END
C
C*MATX_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C            M A T X__L U__D E C O M P O S I T I O N__N X N            *
C                                                                      *
C=**********************************************************************
C+
C
C     MATX_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok)
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses maximal column pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - an N length vector of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE MATX_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	PARAMETER   (APPROX_ZERO=1.0E-20)

	REAL*4      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(N),ROW

	LOGICAL     OK

	OK=.FALSE.

C     Find largest value in column 1 of "MATRIX".

	MAXVALUE=0.0
	DO I=1,N

C       Initialize "PIVOT" vector.

	  PIVOT(I)=I

C       Find largest value in row 'I' of "MATRIX" .

	  IF(ABS(MATRIX(I,1)).GT.MAXVALUE)THEN
	    MAXVALUE=ABS(MATRIX(I,1))
	    ROW=I
	  ENDIF
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	PIVOT(1)=ROW

C     Interchange row 1 with row that contains largest value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO

C     Find largest value in "MATRIX" in column 'I' from
C     row 'I' to 'N'.

	DO I=2,N-1
	  MAXVALUE=0.0
	  DO J=I,N

C         Find largest value in row 'I' of "MATRIX" .

	    SUM1=0.0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=(MATRIX(J,I)-SUM1)
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  PIVOT(I)=ROW

C       Interchange contents of row 'I' and row with max value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0
	    SUMU=0.0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	OK=.TRUE.
	RETURN
	END
C
C*MATXS_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C            M A T X S__L U__D E C O M P O S I T I O N__N X N          *
C                                                                      *
C=**********************************************************************
C+
C
C     MATXS_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok)
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses scaled column pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - an N length vector of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE MATXS_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	PARAMETER   (APPROX_ZERO=1.0E-20)

	REAL*4      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(N),ROW

	LOGICAL     OK

	OK=.FALSE.

C     Find largest scaled value in column 1 of "MATRIX".

	MAXVALUE=0.0
	DO I=1,N

C       Initialize "PIVOT" vector.

	  PIVOT(I)=I

C       Find largest value in row 'I' of "MATRIX" to be used as a
C       scale factor in subsequent operations.

	  SCALE=1.0
	  DO J=1,N
	    IF(ABS(MATRIX(I,J)).GT.SCALE)SCALE=ABS(MATRIX(I,J))
	  END DO
	  IF(SCALE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  IF((ABS(MATRIX(I,1))/SCALE).GT.MAXVALUE)THEN
	    MAXVALUE=ABS(MATRIX(I,1))/SCALE
	    ROW=I
	  ENDIF
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	PIVOT(1)=ROW

C     Interchange row 1 with row that contains largest scaled value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO

C     Find largest scaled value in "MATRIX" in column 'I' from
C     row 'I' to 'N'.

	DO I=2,N-1
	  MAXVALUE=0.0
	  DO J=I,N

C         Find largest value in row 'I' of "MATRIX" to be used as a
C         scale factor in subsequent operations.

	    SCALE=1.0
	    DO JJ=I,N
		IF(ABS(MATRIX(J,JJ)).GT.SCALE)SCALE=ABS(MATRIX(J,JJ))
	    END DO
	    IF(SCALE.LT.APPROX_ZERO)THEN
		WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
		RETURN
	    ENDIF
	    SUM1=0.0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=(MATRIX(J,I)-SUM1)/SCALE
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  PIVOT(I)=ROW

C       Interchange contents of row 'I' and row with max scaled value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0
	    SUMU=0.0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	OK=.TRUE.
	RETURN
	END
C
C*MATXT_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C            M A T X T__L U__D E C O M P O S I T I O N__N X N          *
C                                                                      *
C=**********************************************************************
C+
C
C     MATXT_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok)
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses total pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - a 3 X N array of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE MATXT_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	PARAMETER   (APPROX_ZERO=1.0E-20)

	REAL*4      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(3,N),ROW,COL

	LOGICAL     OK

	OK=.FALSE.
	MAXVALUE=0.0
	DO I=1,N

C       Initialize "PIVOT" array.

	  PIVOT(1,I)=I
	  PIVOT(2,I)=I

C       Find largest value in row 'I',col 'J' of "MATRIX" .

	  DO J=1,N
	    IF(ABS(MATRIX(I,J)).GT.MAXVALUE)THEN
		MAXVALUE=ABS(MATRIX(I,J))
		ROW=I
		COL=J
	    ENDIF
	  END DO
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF

C     Interchange row 1 with row that contains largest value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	  PIVOT(1,1)=ROW
	ENDIF

C     Interchange column 1 with column that contains largest value
C     in "MATRIX" .

	IF(COL.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(I,1)
	    MATRIX(I,1)=MATRIX(I,COL)
	    MATRIX(I,COL)=TMP
	  END DO
	  PIVOT(2,1)=COL
	  PIVOT(2,COL)=1
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO
	DO I=2,N-1

C       Find largest value in column 'L' of "MATRIX" .

	  MAXVALUE=0.0
	  DO J=I,N
	    DO L=I,N
		IF(ABS(MATRIX(J,L)).GT.MAXVALUE)THEN
		  MAXVALUE=ABS(MATRIX(J,L))
		  COL=L
		ENDIF
	    END DO
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF

C       Interchange contents of column 'I' and column with max value
C       in "MATRIX" .

	  IF(COL.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(K,I)
		MATRIX(K,I)=MATRIX(K,COL)
		MATRIX(K,COL)=TMP
	    END DO
	    ITMP=PIVOT(2,I)
	    PIVOT(2,I)=PIVOT(2,COL)
	    PIVOT(2,COL)=ITMP
	  END IF

C       Find largest value in row 'J' of "MATRIX" .

	  MAXVALUE=0.0
	  DO J=I,N
	    SUM1=0.0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=MATRIX(J,I)-SUM1
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF

C       Interchange contents of row 'I' and row with max value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	    PIVOT(1,I)=ROW
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0
	    SUMU=0.0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	DO I=1,N
	  PIVOT(3,I)=PIVOT(2,I)
	END DO
	OK=.TRUE.
	RETURN
	END
C
C*MATX_1X4_4X4
C=**********************************************************************
C                                                                      *
C                         M A T X__1 X 4__4 X 4                        *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_1X4_4X4(invec,mat,outvec)
C         subroutine to multiply a 1 X 4 matrix(vector) by a 4 X 4 matrix
C         and return the result in a 1 X 4 matrix.
C
C         invec  - a four element array of floating point values.
C         mat    - a 4 X 4 matrix of floating point values.
C         outvec - a four element array of floating point values that
C                  are assigned as a result of the matrix multiplication.
C
C         note   : the array "outvec" may be the same as "invec".
C
C
C--

	  SUBROUTINE MATX_1X4_4X4(INVEC,MAT,OUTVEC)

	  REAL*4 INVEC(4),OUTVEC(4),MAT(4,4),TMP(4)

	  DO I=1,4
	    TMP(I)=0.0
	    DO J=1,4
		TMP(I)=TMP(I)+INVEC(J)*MAT(J,I)
	    END DO
	  END DO
	  DO I=1,4
	    OUTVEC(I)=TMP(I)
	  END DO
	  RETURN
	  END
C
C*MATX_4X4_4X1
C=**********************************************************************
C                                                                      *
C                         M A T X__4 X 4__4 X 1                        *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_4X4_4X1(mat,invec,outvec)
C         subroutine to multiply a 4 X 4 matrix by a 4 X 1 matrix(vector)
C         and return the result in a 4 X 1 matrix.
C
C         invec  - a four element array of floating point values.
C         mat    - a 4 X 4 matrix of floating point values.
C         outvec - a four element array of floating point values that
C                  are assigned as a result of the matrix multiplication.
C
C         note   : the array "outvec" may be the same as "invec".
C
C
C--

	  SUBROUTINE MATX_4X4_4X1(MAT,INVEC,OUTVEC)

	  REAL*4 INVEC(4),OUTVEC(4),MAT(4,4),TMP(4)

	  DO I=1,4
	    TMP(I)=0.0
	    DO J=1,4
		TMP(I)=TMP(I)+MAT(I,J)*INVEC(J)
	    END DO
	  END DO
	  DO I=1,4
	    OUTVEC(I)=TMP(I)
	  END DO
	  RETURN
	  END
C
C*MATX_4X4_4X4
C=**********************************************************************
C                                                                      *
C                        M A T X__4 X 4__4 X 4                         *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_4X4_4X4(mat1,mat2,outmat)
C         subroutine to multiply a 4 X 4 matrix by a 4 X 4 matrix.
C
C         mat1   - a 4 X 4 matrix of floating point values. it is the
C                  "left" of the two matrices to be multiplied.
C         mat2   - a 4 X 4 matrix of floating point values. it is the
C                  "right" of the two matrices to be multiplied.
C         outmat - a 4 X 4 matrix of floating point values that results
C                  from the matrix multiplication of "mat1" and "mat2".
C         note   : "outmat" may be the same as "mat1" or "mat2".
C
C
C--

	  SUBROUTINE MATX_4X4_4X4(MAT1,MAT2,OUTMAT)

	  REAL*4 MAT1(4,4),MAT2(4,4),OUTMAT(4,4),TMP(4,4)

	  DO I=1,4
	    DO J=1,4
		TMP(I,J)=0.0
		DO K=1,4
		  TMP(I,J)=TMP(I,J)+MAT1(I,K)*MAT2(K,J)
		END DO
	    END DO
	  END DO
	  DO I=1,4
	    DO J=1,4
		OUTMAT(I,J)=TMP(I,J)
	    END DO
	  END DO
	  RETURN
	  END
C
C*MATX_MXN_NXP
C=**********************************************************************
C                                                                      *
C                        M A T X__M X N__N X P                         *
C                                                                      *
C=**********************************************************************
C+
C
C       MATX_MXN_NXP(mat1,mat2,outmat,m,n,p)
C         subroutine to multiply a M X N matrix by a N X P matrix and
C         obtain an M X P matrix.
C
C         mat1   - a M X N matrix of floating point values. it is the
C                  "left" of the two matrices to be multiplied.
C         mat2   - a N X P matrix of floating point values. it is the
C                  "right" of the two matrices to be multiplied.
C         outmat - a M X P matrix of floating point values that results
C                  from the matrix multiplication of "mat1" and "mat2".
C         m      - an integer value representing the number of rows in
C                  "mat1" and "outmat".
C         n      - an integer value representing the number of columns
C                  in "mat1" and the number of rows in "mat2".
C         p      - an integer value representing the number of columns
C                  in "mat2" and "outmat".
C         note   : "outmat" may not be the same as "mat1" or "mat2".
C
C
C--

	  SUBROUTINE MATX_MXN_NXP(MAT1,MAT2,OUTMAT,M,N,P)

	  INTEGER P

	  REAL*4 MAT1(M,N),MAT2(N,P),OUTMAT(M,P)

	  DO I=1,M
	    DO J=1,P
		OUTMAT(I,J)=0.0
		DO K=1,N
		  OUTMAT(I,J)=OUTMAT(I,J)+MAT1(I,K)*MAT2(K,J)
		END DO
	    END DO
	  END DO
	  RETURN
	  END
C
C*matrix_inverse  Compute matrix inverse using LU Decomposition [REAL*4]
C=**********************************************************************
C                                                                      *
C                        M A T R I X__I N V E R S E                    *
C                                                                      *
C=**********************************************************************
C+
C
C       MATRIX_INVERSE(mat1,mat2,mat3,pivot,pivott,n,ptype,ok)
C         subroutine to compute the inverse of a square matrix using
C         LU decomposition.  [REAL*4]
C
C         mat1   - a N X N matrix of floating point values whose inverse
C                  is to be determined.
C         mat2   - a N X N matrix of floating point values containing
C                  the inverse of "mat1".
C         mat3   - a N X N matrix of floating point values used for
C                  internal computations.
C         pivot  - a 1 X N matrix of integer values used for internal
C                  computations.
C         pivott - a 3 X N matrix of integer values used for internal
C                  computations.
C         n      - an integer value representing the number of rows and
C                  columns in matrix.
C         ptype  - a character value representing the type of pivoting
C                  to use in the LU decomposition:
C                  maximal -> pivoting based on maximal column pivoting
C                  scaled  -> pivoting based on scaled column pivoting
C                  total   -> pivoting based on maximal column & row
C                             pivoting
C                       note: only the first letter of these keywords
C                             is considered significant.
C         ok     - logical variable representing the success of the
C                  inversion:
C                      true  -> successful inversion
C                      false -> unsuccessful inversion
C         note   : "mat1" and "mat2" may be the same. the default
C                   pivoting used is 'maximal' if incorrectly
C                   specified.
C
C
C--
	SUBROUTINE MATRIX_INVERSE(MAT1,MAT2,MAT3,PIVOT,PIVOTT,N,PTYPE,OK)

	INTEGER PIVOT(N),PIVOTT(3,N),STR$COLLAPSE

	REAL*4 MAT1(N,N),MAT2(N,N),MAT3(N,N)

	CHARACTER PTYPE*(*),PIVOT_TYPE

	LOGICAL OK

C
	ILEN=STR$COLLAPSE(PTYPE,PTYPE)
	CALL STR$UPCASE(PTYPE(:ILEN),PTYPE)
	PIVOT_TYPE=PTYPE(1:1)
	CALL MATX_COPY_MXN(MAT1,MAT3,N,N)
	IF(PIVOT_TYPE.EQ.'S')THEN
	  CALL MATXS_LU_DECOMPOSITION_NXN(MAT3,PIVOT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL MATX_INVERSE_NXN(MAT3,MAT2,PIVOT,N)
	  RETURN
	ELSEIF(PIVOT_TYPE.EQ.'T')THEN
	  CALL MATXT_LU_DECOMPOSITION_NXN(MAT3,PIVOTT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL MATXT_INVERSE_NXN(MAT3,MAT2,PIVOTT,N)
	  RETURN
	ELSE
	  CALL MATX_LU_DECOMPOSITION_NXN(MAT3,PIVOT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL MATX_INVERSE_NXN(MAT3,MAT2,PIVOT,N)
	  RETURN
	ENDIF
C
	END
C
C*DMATX_INIT_NXN
C=**********************************************************************
C                                                                      *
C                      D M A T X__I N I T__N X N                       *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_INIT_NXN(mat,n,diag) [REAL*8]
C         subroutine to initialize an N X N matrix to the idenity matrix
C
C         mat - an  N X N floating point array to be set equal to the
C               idenity matrix.
C         n   - integer value that defines the order of the matrix,"mat".
C         diag - floating value that will be assigned to the diagonal
C                terms of "mat". If 0 "mat" will be initialized to the
C                zero matrix. If 1 "mat" will be initialized to the
C                identity matrix.
C
C
C--

	  SUBROUTINE DMATX_INIT_NXN(MAT,N,DIAG)

	  IMPLICIT REAL*8(A-H,O-Z)

	  REAL*8 MAT(N,N)

	  DO I=1,N
	    DO J=1,N
		MAT(I,J)=0.0D0
		IF(I.EQ.J)MAT(I,J)=DIAG
	    END DO
	  END DO
	  RETURN
	  END
C
C*DMATX_COPY_MXN
C=**********************************************************************
C                                                                      *
C                    D M A T X__C O P Y__M X N                         *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_COPY_MXN(mat1,mat2,m,n)
C         subroutine to copy a M X N matrix into another M X N matrix
C
C         mat1 - an  M X N floating point array to be copied
C         mat2 - an  M X N floating point array containing the copied values
C         m   - integer value that defines the number of rows in matrices.
C         n   - integer value that defines the number of columns in matrices.
C
C
C--

	  SUBROUTINE DMATX_COPY_MXN(MAT1,MAT2,M,N)
	  IMPLICIT REAL*8(A-H,O-Z)

	  REAL*8 MAT1(M,N),MAT2(M,N)

	  DO I=1,M
	    DO J=1,N
		MAT2(I,J)=MAT1(I,J)
	    END DO
	  END DO
	  RETURN
	  END
C
C*DMATX_INVERSE_NXN
C=**********************************************************************
C                                                                      *
C                    D M A T X__I N V E R S E__N X N                   *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATX_INVERSE_NXN(lu,inverse,pivot,n) [REAL*8]
C
C       subroutine to find the inverse of an N X N matrix using
C       LU decomposition.
C
C       lu      - an N X N array of floating point values. On call to
C                 subroutine contains the LU values  generated during
C                 a call to subroutine DMATX_LU_DECOMPOSITION_NXN or
C                 subroutine DMATXS_LU_DECOMPOSITION_NXN.
C
C       inverse - an N X N array of floating point values that
C                 contains the inverse of the LU decomposed matrix.
C
C       pivot   - an N length vector of integer values containing
C                 pivoting information generated during a previous call
C                 to subroutine DMATX_LU_DECOMPOSITION_NXN or subroutine
C                 DMATXS_LU_DECOMPOSITION_NXN for use in finding the
C                 inverse matrix.
C
C       n       - an integer value representing the maximum dimension
C                 of "matrix" and "pivot".
C
C       note:   subroutine DMATX_LU_DECOMPOSITION_NXN or subroutine
C               DMATXS_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.  The matricies "lu" and
C               "inverse" may not be the same.
C
C--

	SUBROUTINE DMATX_INVERSE_NXN(LU,INVERSE,PIVOT,N)

	IMPLICIT     REAL*8(A-H,O-Z)

	REAL*8       LU(N,N),INVERSE(N,N)

	INTEGER      PIVOT(N),ROW

	CALL DMATX_INIT_NXN(INVERSE,N,1.0D0)

C     Solve for column 'J' of matrix "INVERSE".

	DO J=1,N

C       Solve the system "Lz=b".

	  DO I=1,N

C         Reorder vector "b" based on row interchanges made
C         during LU decomposition.

	    ROW=PIVOT(I)
	    IF(ROW.NE.I)THEN
		TMP1=INVERSE(I,J)
		INVERSE(I,J)=INVERSE(ROW,J)
		INVERSE(ROW,J)=TMP1
	    END IF

C         Solve for "z(I)".

	    SUM=0.0D0
	    DO K=1,I-1
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=INVERSE(I,J)-SUM
	  END DO

C       Solve the system "Ux=z".

	  DO I=N,1,-1

C         Solve for "x(I)".

	    SUM=0.0D0
	    DO K=I+1,N
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=(INVERSE(I,J)-SUM)/LU(I,I)
	  END DO
	END DO
	RETURN
	END
C
C*DMATXT_INVERSE_NXN
C=**********************************************************************
C                                                                      *
C                    D M A T X T__I N V E R S E__N X N                 *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATXT_INVERSE_NXN(lu,inverse,pivot,n) [REAL*8]
C
C       subroutine to find the inverse of an N X N matrix using
C       LU decomposition.(for use with total pivoting)
C
C       lu      - an N X N array of floating point values. On call to
C                 subroutine contains the LU values  generated during
C                 a call to subroutine DMATXT_LU_DECOMPOSITION_NXN.
C
C       inverse - an N X N array of floating point values that
C                 contains the inverse of the LU decomposed matrix.
C
C       pivot   - a 3 X N array of integer values containing pivoting
C                 information generated during a previous call
C                 to subroutine DMATXT_LU_DECOMPOSITION_NXN for use in
C                 finding the inverse matrix.
C
C       n       - an integer value representing the maximum dimension
C                 of "matrix","inverse", and "pivot".
C
C       note:   subroutine DMATXT_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.  The matricies "lu" and
C               "inverse" may not be the same.
C
C--

	SUBROUTINE DMATXT_INVERSE_NXN(LU,INVERSE,PIVOT,N)

	IMPLICIT     REAL*8(A-H,O-Z)

	REAL*8       LU(N,N),INVERSE(N,N)

	INTEGER      PIVOT(3,N),ROW,ROW1

	CALL DMATX_INIT_NXN(INVERSE,N,1.0D0)

C     Solve for column 'J' of matrix "INVERSE".

	DO J=1,N

C       Solve the system "Lz=b".

	  DO I=1,N

C         Reorder vector "b" based on row interchanges made during
C         LU decomposition.

	    ROW=PIVOT(1,I)
	    IF(ROW.NE.I)THEN
		TMP1=INVERSE(I,J)
		INVERSE(I,J)=INVERSE(ROW,J)
		INVERSE(ROW,J)=TMP1
	    END IF

C         Solve for "z(I)".

	    SUM=0.0D0
	    DO K=1,I-1
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=INVERSE(I,J)-SUM
	  END DO

C       Solve the system "Ux=z".

	  DO I=N,1,-1

C         Solve for "x(I)".

	    SUM=0.0D0
	    DO K=I+1,N
		SUM=SUM+LU(I,K)*INVERSE(K,J)
	    END DO
	    INVERSE(I,J)=(INVERSE(I,J)-SUM)/LU(I,I)
	  END DO
	END DO

C     Reorder inverse matirx "inverse" based on column interchanges
C     made during LU decomposition.

	DO I=1,N
	  ROW=PIVOT(2,I)
	  IF(ROW.NE.I)THEN
	    DO J=I,N
		IF(PIVOT(2,J).EQ.I)ROW1=J
	    END DO
	    DO J=1,N
		IF(ROW.EQ.ROW1)THEN
		  TMP=INVERSE(ROW,J)
		  INVERSE(ROW,J)=INVERSE(I,J)
		  INVERSE(I,J)=TMP
		ELSE
		  TMP=INVERSE(ROW,J)
		  INVERSE(ROW,J)=INVERSE(I,J)
		  TMP1=INVERSE(ROW1,J)
		  INVERSE(ROW1,J)=TMP
		  INVERSE(I,J)=TMP1
		ENDIF
	    END DO
	    ITMP=PIVOT(2,ROW1)
	    PIVOT(2,ROW1)=PIVOT(2,ROW)
	    PIVOT(2,ROW)=ROW
	    PIVOT(2,I)=ITMP
	  ENDIF
	END DO
	DO I=1,N
	  PIVOT(2,I)=PIVOT(3,I)
	END DO
	RETURN
	END
C
C*DMATX_LINEAR_SOLVE
C=**********************************************************************
C                                                                      *
C                 D M A T X__L I N E A R__S O L V E                    *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATX_LINEAR_SOLVE(lu,b,pivot,n) [REAL*8]
C
C       subroutine to solve a linear system of the form "Ax=b" using
C       LU decomposition.
C
C       lu    - an N X N array of floating point values that contains
C               the LU values for matrix "A" generated during a call
C               to subroutine DMATX_LU_DECOMPOSITION_NXN or subroutine
C               DMATXS_LU_DECOMPOSITION_NXN.
C
C       b     - an N length vector of floating point values. On call
C               to subroutine contains values of vector "b" above. On
C               return contains the values of vector "x".
C
C       pivot - an N length vector of integer values containing
C               pivoting information generated during a previous call
C               to subroutine DMATX_LU_DECOMPOSITON_NXN or subroutine
C               DMATXS_LU_DECOMPOSITION_NXN for use in solving the
C               linear system "Ax=b", or the inverse of "matrix".
C
C       n     - an integer value representing the maximum dimension
C               of "matrix","b", and "pivot".
C
C       note:   subroutine DMATX_LU_DECOMPOSITION_NXN or subroutine
C               DMATXS_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.
C
C--

	SUBROUTINE DMATX_LINEAR_SOLVE(LU,B,PIVOT,N)

	IMPLICIT     REAL*8(A-H,O-Z)

	REAL*8       LU(N,N),B(N)

	INTEGER      PIVOT(N),ROW

C     Solve the system "Lz=b".

	DO I=1,N

C       Reorder the vector "b" based on the row interchanges made
C       during LU decomposition.

	  ROW=PIVOT(I)
	  IF(ROW.NE.I)THEN
	    TMP=B(I)
	    B(I)=B(ROW)
	    B(ROW)=TMP
	  END IF

C       Solve for "z(I)".

	  SUM=0.0D0
	  DO J=1,I-1
	   SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=B(I)-SUM
	END DO

C     Solve the system "Ux=z".

	DO I=N,1,-1

C       Solve for "x(I)".

	  SUM=0.0D0
	  DO J=I+1,N
	    SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=(B(I)-SUM)/LU(I,I)
	END DO
	RETURN
	END
C
C*DMATXT_LINEAR_SOLVE
C=**********************************************************************
C                                                                      *
C                 D M A T X T__L I N E A R__S O L V E                  *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATXT_LINEAR_SOLVE(lu,b,pivot,n) [REAL*8]
C
C       subroutine to solve a linear system of the form "Ax=b" using
C       LU decomposition.(for use with total pivoting)
C
C       lu    - an N X N array of floating point values that contains
C               the LU values for matrix "A" generated during a call
C               to subroutine DMATXT_LU_DECOMPOSITION_NXN.
C
C       b     - an N length vector of floating point values. On call
C               to subroutine contains values of vector "b" above. On
C               return contains the values of vector "x".
C
C       pivot - a 3 X N array of integer values containing
C               pivoting information generated during a previous call
C               to subroutine DMATXT_LU_DECOMPOSITON_NXN for use in
C               solving the linear system "Ax=b", or the inverse
C               of "matrix".
C
C       n     - an integer value representing the maximum dimension
C               of "matrix","b", and "pivot".
C
C       note:   subroutine DMATXT_LU_DECOMPOSITION_NXN must be called
C               prior to using this routine.
C
C--

	SUBROUTINE DMATXT_LINEAR_SOLVE(LU,B,PIVOT,N)

	IMPLICIT     REAL*8(A-H,O-Z)

	REAL*8       LU(N,N),B(N)

	INTEGER      PIVOT(3,N),ROW,ROW1

C     Solve the system "Lz=b".

	DO I=1,N

C       Reorder vector "b" based on row interchanges made during
C       LU decomposition.

	  ROW=PIVOT(1,I)
	  IF(ROW.NE.I)THEN
	    TMP=B(I)
	    B(I)=B(ROW)
	    B(ROW)=TMP
	  END IF

C       Solve for "z(I)".

	  SUM=0.0D0
	  DO J=1,I-1
	   SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=B(I)-SUM
	END DO

C     Solve the system "Ux=z".

	DO I=N,1,-1

C       Solve for "x(I)".

	  SUM=0.0D0
	  DO J=I+1,N
	    SUM=SUM+LU(I,J)*B(J)
	  END DO
	  B(I)=(B(I)-SUM)/LU(I,I)
	END DO

C     Reorder the solution vector "x" based on column interchanges
C     made during LU decomposition.

	DO I=1,N
	  ROW=PIVOT(2,I)
	  IF(ROW.NE.I)THEN
	    DO J=I,N
		IF(PIVOT(2,J).EQ.I)ROW1=J
	    END DO
	    IF(ROW.EQ.ROW1)THEN
		TMP=B(ROW)
		B(ROW)=B(I)
		B(I)=TMP
	    ELSE
		TMP=B(ROW)
		B(ROW)=B(I)
		TMP1=B(ROW1)
		B(I)=TMP1
		B(ROW1)=TMP
	    ENDIF
	    ITMP=PIVOT(2,ROW1)
	    PIVOT(2,ROW1)=PIVOT(2,ROW)
	    PIVOT(2,ROW)=ROW
	    PIVOT(2,I)=ITMP
	  ENDIF
	END DO
	DO I=1,N
	  PIVOT(2,I)=PIVOT(3,I)
	END DO
	RETURN
	END
C
C*DMATX_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C          D M A T X__L U__D E C O M P O S I T I O N__N X N            *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATX_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok) [REAL*8]
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses maximal column pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - an N length vector of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE DMATX_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	IMPLICIT    REAL*8(A-H,O-Z)

	PARAMETER   (APPROX_ZERO=1.0D-20)

	REAL*8      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(N),ROW

	LOGICAL     OK

	OK=.FALSE.

C     Find largest value in column 1 of "MATRIX".

	MAXVALUE=0.0D0
	DO I=1,N

C       Initialize "PIVOT" vector.

	  PIVOT(I)=I

C       Find largest value in row 'I' of "MATRIX" .

	  IF(ABS(MATRIX(I,1)).GT.MAXVALUE)THEN
	    MAXVALUE=ABS(MATRIX(I,1))
	    ROW=I
	  ENDIF
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	PIVOT(1)=ROW

C     Interchange row 1 with row that contains largest value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO

C     Find largest value in "MATRIX" in column 'I' from
C     row 'I' to 'N'.

	DO I=2,N-1
	  MAXVALUE=0.0D0
	  DO J=I,N

C         Find largest value in row 'I' of "MATRIX" .

	    SUM1=0.0D0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=(MATRIX(J,I)-SUM1)
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  PIVOT(I)=ROW

C       Interchange contents of row 'I' and row with max value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0D0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0D0
	    SUMU=0.0D0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0D0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	OK=.TRUE.
	RETURN
	END
C
C*DMATXS_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C          D M A T X S__L U__D E C O M P O S I T I O N__N X N          *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATXS_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok) [REAL*8]
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses scaled column pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - an N length vector of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE DMATXS_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	IMPLICIT    REAL*8(A-H,O-Z)

	PARAMETER   (APPROX_ZERO=1.0D-20)

	REAL*8      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(N),ROW

	LOGICAL     OK

	OK=.FALSE.

C     Find largest scaled value in column 1 of "MATRIX".

	MAXVALUE=0.0D0
	DO I=1,N

C       Initialize "PIVOT" vector.

	  PIVOT(I)=I

C       Find largest value in row 'I' of "MATRIX" to be used as a
C       scale factor in subsequent operations.

	  SCALE=1.0D0
	  DO J=1,N
	    IF(ABS(MATRIX(I,J)).GT.SCALE)SCALE=ABS(MATRIX(I,J))
	  END DO
	  IF(SCALE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  IF((ABS(MATRIX(I,1))/SCALE).GT.MAXVALUE)THEN
	    MAXVALUE=ABS(MATRIX(I,1))/SCALE
	    ROW=I
	  ENDIF
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	PIVOT(1)=ROW

C     Interchange row 1 with row that contains largest scaled value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO

C     Find largest scaled value in "MATRIX" in column 'I' from
C     row 'I' to 'N'.

	DO I=2,N-1
	  MAXVALUE=0.0D0
	  DO J=I,N

C         Find largest value in row 'I' of "MATRIX" to be used as a
C         scale factor in subsequent operations.

	    SCALE=1.0D0
	    DO JJ=I,N
		IF(ABS(MATRIX(J,JJ)).GT.SCALE)SCALE=ABS(MATRIX(J,JJ))
	    END DO
	    IF(SCALE.LT.APPROX_ZERO)THEN
		WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
		RETURN
	    ENDIF
	    SUM1=0.0D0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=(MATRIX(J,I)-SUM1)/SCALE
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF
	  PIVOT(I)=ROW

C       Interchange contents of row 'I' and row with max scaled value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0D0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0D0
	    SUMU=0.0D0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0D0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	OK=.TRUE.
	RETURN
	END
C
C*DMATXT_LU_DECOMPOSITION_NXN
C=**********************************************************************
C                                                                      *
C          D M A T X T__L U__D E C O M P O S I T I O N__N X N          *
C                                                                      *
C=**********************************************************************
C+
C
C     DMATXT_LU_DECOMPOSITION_NXN(matrix,pivot,n,ok) [REAL*8]
C
C       subroutine to decompose an N X N matrix into the product of
C       a lower triangular matrix,L and an upper triangular matrix,U
C       (i.e. matrix=LU).  The diagonal terms of L are set to unity.
C       The decomposition uses total pivoting.
C
C       matrix - an N X N array of floating point values. On call to
C                subroutine, contains values of matrix to be decomposed.
C                On return contains the LU values of "matrix".
C
C       pivot  - a 3 X N array of integer values containing
C                pivoting information for use in solving the linear
C                system "Ax=b", or the inverse of "matrix".
C
C       n      - an integer value representing the maximum dimension
C                of "matrix" and "pivot".
C
C       ok     - logical value that returns true if decomposition was
C                successful.
C
C
C--

	SUBROUTINE DMATXT_LU_DECOMPOSITION_NXN(MATRIX,PIVOT,N,OK)

	IMPLICIT    REAL*8(A-H,O-Z)

	PARAMETER   (APPROX_ZERO=1.0D-20)

	REAL*8      MATRIX(N,N),MAXVALUE

	INTEGER     PIVOT(3,N),ROW,COL

	LOGICAL     OK

	OK=.FALSE.
	MAXVALUE=0.0D0
	DO I=1,N

C       Initialize "PIVOT" array.

	  PIVOT(1,I)=I
	  PIVOT(2,I)=I

C       Find largest value in row 'I',col 'J' of "MATRIX" .

	  DO J=1,N
	    IF(ABS(MATRIX(I,J)).GT.MAXVALUE)THEN
		MAXVALUE=ABS(MATRIX(I,J))
		ROW=I
		COL=J
	    ENDIF
	  END DO
	END DO
	IF(MAXVALUE.LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF

C     Interchange row 1 with row that contains largest value
C     in "MATRIX" .

	IF(ROW.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(1,I)
	    MATRIX(1,I)=MATRIX(ROW,I)
	    MATRIX(ROW,I)=TMP
	  END DO
	  PIVOT(1,1)=ROW
	ENDIF

C     Interchange column 1 with column that contains largest value
C     in "MATRIX" .

	IF(COL.NE.1)THEN
	  DO I=1,N
	    TMP=MATRIX(I,1)
	    MATRIX(I,1)=MATRIX(I,COL)
	    MATRIX(I,COL)=TMP
	  END DO
	  PIVOT(2,1)=COL
	  PIVOT(2,COL)=1
	ENDIF

C     Obtain column 1 for L matrix and row 1 for U matrix. note rather
C     than having two seperate matricies for L and U, values are stored
C     in a singe matrix "MATRIX", overwriting previously used values.

	DO I=2,N
	  MATRIX(1,I)=MATRIX(1,I)
	  MATRIX(I,1)=MATRIX(I,1)/MATRIX(1,1)
	END DO
	DO I=2,N-1

C       Find largest value in column 'L' of "MATRIX" .

	  MAXVALUE=0.0D0
	  DO J=I,N
	    DO L=I,N
		IF(ABS(MATRIX(J,L)).GT.MAXVALUE)THEN
		  MAXVALUE=ABS(MATRIX(J,L))
		  COL=L
		ENDIF
	    END DO
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF

C       Interchange contents of column 'I' and column with max value
C       in "MATRIX" .

	  IF(COL.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(K,I)
		MATRIX(K,I)=MATRIX(K,COL)
		MATRIX(K,COL)=TMP
	    END DO
	    ITMP=PIVOT(2,I)
	    PIVOT(2,I)=PIVOT(2,COL)
	    PIVOT(2,COL)=ITMP
	  END IF

C       Find largest value in row 'J' of "MATRIX" .

	  MAXVALUE=0.0D0
	  DO J=I,N
	    SUM1=0.0D0
	    DO K=1,I-1
		SUM1=SUM1+MATRIX(J,K)*MATRIX(K,I)
	    END DO
	    SUM1=MATRIX(J,I)-SUM1
	    IF(ABS(SUM1).GT.MAXVALUE)THEN
		MAXVALUE=ABS(SUM1)
		ROW=J
	    ENDIF
	  END DO
	  IF(MAXVALUE.LT.APPROX_ZERO)THEN
	    WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	    RETURN
	  ENDIF

C       Interchange contents of row 'I' and row with max value
C       in "MATRIX" .

	  IF(ROW.NE.I)THEN
	    DO K=1,N
		TMP=MATRIX(I,K)
		MATRIX(I,K)=MATRIX(ROW,K)
		MATRIX(ROW,K)=TMP
	    END DO
	    PIVOT(1,I)=ROW
	  END IF

C       Obtain column 'I' of L matrix and row 'I' of U matrix.

	  SUM1=0.0D0
	  DO K=1,I-1
	    SUM1=SUM1+MATRIX(I,K)*MATRIX(K,I)
	  END DO
	  MATRIX(I,I)=MATRIX(I,I)-SUM1
	  DO J=I+1,N
	    SUML=0.0D0
	    SUMU=0.0D0
	    DO K=1,I-1
		SUML=SUML+MATRIX(J,K)*MATRIX(K,I)
		SUMU=SUMU+MATRIX(I,K)*MATRIX(K,J)
	    END DO
	    MATRIX(I,J)=MATRIX(I,J)-SUMU
	    MATRIX(J,I)=(MATRIX(J,I)-SUML)/MATRIX(I,I)
	  END DO
	END DO

C     Obtain value at column 'N', row 'N' of L and U matricies.

	SUM=0.0D0
	DO I=1,N-1
	  SUM=SUM+MATRIX(N,I)*MATRIX(I,N)
	END DO
	SUM=MATRIX(N,N)-SUM
	IF(ABS(SUM).LT.APPROX_ZERO)THEN
	  WRITE(*,'(//1X,2A1,A/1X,A)')7,7,
     .      '     ********** Error during LU decomposition **********',
     .      '                      matrix is singular'
	  RETURN
	ENDIF
	MATRIX(N,N)=SUM
	DO I=1,N
	  PIVOT(3,I)=PIVOT(2,I)
	END DO
	OK=.TRUE.
	RETURN
	END
C
C*DMATX_1X4_4X4
C=**********************************************************************
C                                                                      *
C                       D M A T X__1 X 4__4 X 4                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_1X4_4X4(invec,mat,outvec) [REAL*8]
C         subroutine to multiply a 1 X 4 matrix(vector) by a 4 X 4 matrix
C         and return the result in a 1 X 4 matrix.
C
C         invec  - a four element array of floating point values.
C         mat    - a 4 X 4 matrix of floating point values.
C         outvec - a four element array of floating point values that
C                  are assigned as a result of the matrix multiplication.
C
C         note   : the array "outvec" may be the same as "invec".
C
C
C--

	  SUBROUTINE DMATX_1X4_4X4(INVEC,MAT,OUTVEC)

	  IMPLICIT REAL*8(A-H,O-Z)

	  REAL*8 INVEC(4),OUTVEC(4),MAT(4,4),TMP(4)

	  DO I=1,4
	    TMP(I)=0.0D0
	    DO J=1,4
		TMP(I)=TMP(I)+INVEC(J)*MAT(J,I)
	    END DO
	  END DO
	  DO I=1,4
	    OUTVEC(I)=TMP(I)
	  END DO
	  RETURN
	  END
C
C*DMATX_4X4_4X1
C=**********************************************************************
C                                                                      *
C                       D M A T X__4 X 4__4 X 1                        *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_4X4_4X1(mat,invec,outvec) [REAL*8]
C         subroutine to multiply a 4 X 4 matrix by a 4 X 1 matrix(vector)
C         and return the result in a 4 X 1 matrix.
C
C         invec  - a four element array of floating point values.
C         mat    - a 4 X 4 matrix of floating point values.
C         outvec - a four element array of floating point values that
C                  are assigned as a result of the matrix multiplication.
C
C         note   : the array "outvec" may be the same as "invec".
C
C
C--

	  SUBROUTINE DMATX_4X4_4X1(MAT,INVEC,OUTVEC)

	  IMPLICIT REAL*8(A-H,O-Z)

	  REAL*8 INVEC(4),OUTVEC(4),MAT(4,4),TMP(4)

	  DO I=1,4
	    TMP(I)=0.0D0
	    DO J=1,4
		TMP(I)=TMP(I)+MAT(I,J)*INVEC(J)
	    END DO
	  END DO
	  DO I=1,4
	    OUTVEC(I)=TMP(I)
	  END DO
	  RETURN
	  END
C
C*DMATX_4X4_4X4
C=**********************************************************************
C                                                                      *
C                      D M A T X__4 X 4__4 X 4                         *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_4X4_4X4(mat1,mat2,outmat) [REAL*8]
C         subroutine to multiply a 4 X 4 matrix by a 4 X 4 matrix.
C
C         mat1   - a 4 X 4 matrix of floating point values. it is the
C                  "left" of the two matrices to be multiplied.
C         mat2   - a 4 X 4 matrix of floating point values. it is the
C                  "right" of the two matrices to be multiplied.
C         outmat - a 4 X 4 matrix of floating point values that results
C                  from the matrix multiplication of "mat1" and "mat2".
C         note   : "outmat" may be the same as "mat1" or "mat2".
C
C
C--

	  SUBROUTINE DMATX_4X4_4X4(MAT1,MAT2,OUTMAT)

	  IMPLICIT REAL*8(A-H,O-Z)

	  REAL*8 MAT1(4,4),MAT2(4,4),OUTMAT(4,4),TMP(4,4)

	  DO I=1,4
	    DO J=1,4
		TMP(I,J)=0.0D0
		DO K=1,4
		  TMP(I,J)=TMP(I,J)+MAT1(I,K)*MAT2(K,J)
		END DO
	    END DO
	  END DO
	  DO I=1,4
	    DO J=1,4
		OUTMAT(I,J)=TMP(I,J)
	    END DO
	  END DO
	  RETURN
	  END
C
C*DMATX_MXN_NXP
C=**********************************************************************
C                                                                      *
C                      D M A T X__M X N__N X P                         *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATX_MXN_NXP(mat1,mat2,outmat,m,n,p) [REAL*8]
C         subroutine to multiply a M X N matrix by a N X P matrix and
C         obtain an M X P matrix.
C
C         mat1   - a M X N matrix of floating point values. it is the
C                  "left" of the two matrices to be multiplied.
C         mat2   - a N X P matrix of floating point values. it is the
C                  "right" of the two matrices to be multiplied.
C         outmat - a M X P matrix of floating point values that results
C                  from the matrix multiplication of "mat1" and "mat2".
C         m      - an integer value representing the number of rows in
C                  "mat1" and "outmat".
C         n      - an integer value representing the number of columns
C                  in "mat1" and the number of rows in "mat2".
C         p      - an integer value representing the number of columns
C                  in "mat2" and "outmat".
C         note   : "outmat" may not be the same as "mat1" or "mat2".
C
C
C--

	  SUBROUTINE DMATX_MXN_NXP(MAT1,MAT2,OUTMAT,M,N,P)

	  IMPLICIT REAL*8(A-H,O-Z)

	  INTEGER  P

	  REAL*8 MAT1(M,N),MAT2(N,P),OUTMAT(M,P)

	  DO I=1,M
	    DO J=1,P
		OUTMAT(I,J)=0.0D0
		DO K=1,N
		  OUTMAT(I,J)=OUTMAT(I,J)+MAT1(I,K)*MAT2(K,J)
		END DO
	    END DO
	  END DO
	  RETURN
	  END
C
C*Dmatrix_inverse  Compute matrix inverse using LU Decomposition [REAL*8]
C=**********************************************************************
C                                                                      *
C                      D M A T R I X__I N V E R S E                    *
C                                                                      *
C=**********************************************************************
C+
C
C       DMATRIX_INVERSE(mat1,mat2,mat3,pivot,pivott,n,ptype,ok)
C         subroutine to compute the inverse of a square matrix using
C         LU decomposition.  [REAL*8]
C
C         mat1   - a N X N matrix of floating point values whose inverse
C                  is to be determined.
C         mat2   - a N X N matrix of floating point values containing
C                  the inverse of "mat1".
C         mat3   - a N X N matrix of floating point values used for
C                  internal computations.
C         pivot  - a 1 X N matrix of integer values used for internal
C                  computations.
C         pivott - a 3 X N matrix of integer values used for internal
C                  computations.
C         n      - an integer value representing the number of rows and
C                  columns in matrix.
C         ptype  - a character value representing the type of pivoting
C                  to use in the LU decomposition:
C                  maximal -> pivoting based on maximal column pivoting
C                  scaled  -> pivoting based on scaled column pivoting
C                  total   -> pivoting based on maximal column & row
C                             pivoting
C                       note: only the first letter of these keywords
C                             is considered significant.
C         ok     - logical variable representing the success of the
C                  inversion:
C                      true  -> successful inversion
C                      false -> unsuccessful inversion
C         note   : "mat1" and "mat2" may be the same. the default
C                   pivoting used is 'maximal' if incorrectly
C                   specified.
C
C
C--
	SUBROUTINE DMATRIX_INVERSE(MAT1,MAT2,MAT3,PIVOT,PIVOTT,N,PTYPE,OK)

	IMPLICIT REAL*8(A-H,O-Z)

	INTEGER  PIVOT(N),PIVOTT(3,N),STR$COLLAPSE

	REAL*8 MAT1(N,N),MAT2(N,N),MAT3(N,N)

	CHARACTER PTYPE*(*),PIVOT_TYPE

	LOGICAL OK

C
	ILEN=STR$COLLAPSE(PTYPE,PTYPE)
	CALL STR$UPCASE(PTYPE(:ILEN),PTYPE)
	PIVOT_TYPE=PTYPE(1:1)
	CALL DMATX_COPY_MXN(MAT1,MAT3,N,N)
	IF(PIVOT_TYPE.EQ.'S')THEN
	  CALL DMATXS_LU_DECOMPOSITION_NXN(MAT3,PIVOT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL DMATX_INVERSE_NXN(MAT3,MAT2,PIVOT,N)
	  RETURN
	ELSEIF(PIVOT_TYPE.EQ.'T')THEN
	  CALL DMATXT_LU_DECOMPOSITION_NXN(MAT3,PIVOTT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL DMATXT_INVERSE_NXN(MAT3,MAT2,PIVOTT,N)
	  RETURN
	ELSE
	  CALL DMATX_LU_DECOMPOSITION_NXN(MAT3,PIVOT,N,OK)
	  IF(.NOT.OK)RETURN
	  CALL DMATX_INVERSE_NXN(MAT3,MAT2,PIVOT,N)
	  RETURN
	ENDIF
C
	END
C
C*READILD
C=**********************************************************************
C                                                                      *
C                   S U B R O U T I N E    R E A D I L D               *
C                                                                      *
C=**********************************************************************
C+
C    SUBROUTINE READILD(stringin,formatstr,var_type)
C          subroutine to formatstr a string variable such that it can
C          be used as an internal file for pseudo list-directed
C          input.
C          stringin - assumed size character variable containing the
C                     string to be formated on input and the formatted
C                     string on output.
C          formatstr- assumed size character variable containing the
C                     format statement to be used in reading the
C                     formatted string. the format statement will
C                     contain all 'g' or all 'i' specifications
C                     depending on the value of var_type argument.
C          var_type - assumed size character variable containing type
C                     of variable to be read using the formatstr. Values
C                     are 'real' for real variables or 'integer' for
C                     integer variables. If a mix of real and integer
C                     variables have to be read in, specify var_type
C                     as 'real' and obtain the integer values using
C                     the "int" intrinsic function.
C          NOTE: This subroutine requires that the 'IOSTAT=' argument
C                be placed in the read statement,in order to prevent a
C                run-time error.Additionally a CTRL_Z is placed at the
C                end of the string containing the data values. this
C                forces all iolist variables remaining upon reading the
C                CTRL_Z  character to retain their previous definition.
C                Warning if the 'END=' and/or 'ERR=' arguments are
C                not specified, the previous statement still applies
C                in the case of any type of error, but the user
C                will not be notified.
C
C                after calling this subroutine you can then perform
C                an internal file read with the following statement
C                  read(stringin,formatstr,IOSTAT=IOSTAT__)var1,var2,var3,...
C
C--

	  SUBROUTINE READILD(STRINGIN,FORMATSTR,VAR_TYPE)
	  INTEGER STR$COLLAPSE,STR$COMPRESS,STR$LENGTH
	  INTEGER STR$FIND_FIRST_NOT_IN_SET,STR$FIND_FIRST_IN_SET
	  CHARACTER*(*) STRINGIN,FORMATSTR,VAR_TYPE
	  CHARACTER FIELD*20,TMPSTR*10,STRINGOUT*500,CTRL_Z
	  LOGICAL REAL_VAR
	  
	  CTRL_Z=CHAR(26)
C
	  NUMFIELDS=0
	  CALL STR$UPCASE(VAR_TYPE,VAR_TYPE)
	  REAL_VAR=INDEX(VAR_TYPE,'RE') .NE. 0
	  ILEN=STR$COMPRESS(STRINGIN,STRINGIN)
	  ISTART=1
	  ISTARTO=1
	  IF(REAL_VAR) THEN
	    FORMATSTR='(G'
	  ELSE
	    FORMATSTR='(I'
	  ENDIF
	  STRINGOUT=' '
10      IEND=STR$FIND_FIRST_IN_SET(STRINGIN(ISTART:),' ')
	  ICHECK=STR$FIND_FIRST_NOT_IN_SET(STRINGIN(ISTART:),' ')
	  IF(ICHECK.EQ.0)GOTO 20
	  NUMFIELDS=NUMFIELDS+1
	  IEND=ISTART+IEND-1
	  FIELD=STRINGIN(ISTART:IEND)
	  ILENGTH=STR$COLLAPSE(FIELD,FIELD)
	  WRITE(TMPSTR,'(I10)')ILENGTH
	  IFLEN=STR$COLLAPSE(TMPSTR,TMPSTR)
	  IFMT=STR$LENGTH(FORMATSTR)
	  IF(NUMFIELDS.EQ.1)THEN
	    IF(REAL_VAR)THEN
		FORMATSTR=FORMATSTR(:IFMT)//TMPSTR(:IFLEN)//'.0'
	    ELSE
		FORMATSTR=FORMATSTR(:IFMT)//TMPSTR(:IFLEN)
	    ENDIF
	  ELSE
	    IF(REAL_VAR)THEN
		FORMATSTR=FORMATSTR(:IFMT)//',G'//TMPSTR(:IFLEN)//'.0'
	    ELSE
		FORMATSTR=FORMATSTR(:IFMT)//',I'//TMPSTR(:IFLEN)
	    ENDIF
	  ENDIF
	  IENDO=ISTARTO+ILENGTH-1
	  STRINGOUT(ISTARTO:IENDO)=FIELD(:ILENGTH)
	  ISTARTO=IENDO+1
	  ISTART=IEND+1
	  GOTO 10
20      IFMT=STR$LENGTH(FORMATSTR)
	  FORMATSTR=FORMATSTR(:IFMT)//')'
	  ICOL=STR$COLLAPSE(STRINGOUT,STRINGIN)
	  STRINGIN(ICOL+1:)=','//CTRL_Z
C
	  END
