      SUBROUTINE STEPFX(JDIM,KDIM,Q,S,PRESS,SNDSP,XY,XYJ,DS,
     *                    COEF2,COEF4,UU,CC,WORK)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      COMMON/BASE/
     1  JMAX,       KMAX,     JM,          KM,          JBEGIN,   JEND,
     1  KBEGIN,     KEND,     JPLUS(999),  JMINU (999), JLOW,     JUP,
     1  KLOW,       KUP,      PERIDC  ,    NP,          DT,   CP2TIM,
     1  FSMACH,     ALPHA,    GAMMA,       GAMI,        PI,
     1  DIS2X,      DIS2Y,    DIS4X,       DIS4Y,       PHIDT,    
     1  THETAD ,    RESID,    JACDT,       IPRINT,      NPCP,
     1  JTAIL1,     JTAIL2,   NUMITE ,     ISTART,      NSTEPS
      LOGICAL PERIDC  
      COMMON/GRID/DYM,YMAX,XMIN,XMAX,THICK
C
      DIMENSION Q(JDIM,KDIM,4),PRESS(JDIM,KDIM),SNDSP(JDIM,KDIM)
      DIMENSION S(JDIM,KDIM,4),XY(JDIM,KDIM,4),XYJ(JDIM,KDIM)
      DIMENSION DS(JDIM,KDIM)
C
      DIMENSION COEF2(JDIM,KDIM),COEF4(JDIM,KDIM)
      DIMENSION UU(JDIM,KDIM),CC(JDIM,KDIM)
C
      DIMENSION WORK(JDIM,KDIM,10)
C
C  NOTE : D USED FOR VECTORIZATION
C
      DTD   = DT * THETAD /(1. + PHIDT)
      HD    = 0.5*DTD
C  
C  XI DIRECTION
C
C  FILL MATRIX FOR INVERSION FOR DIAGONAL IN XI
C
C  SET SWITCHES FOR EIGENVALUES
C
C  DO FIRST TWO AT THE SAME TIME SINCE THEY HAVE THE SAME COEFFICIENTS
C
         DO 300 N = 2,4
            IF ( N .EQ. 2) SN = 0.
            IF ( N .EQ. 3) SN = 1.
            IF ( N .EQ. 4) SN = -1.
C
         DO 210 J = JLOW,JUP
         JP1 = JPLUS(J)
         JM1 = JMINU (J)
         JP2 = JPLUS(JP1)
         JM2 = JMINU (JM1)
            DO 212 K = KLOW,KUP
            C2M = COEF2(JM1,K)*DTD
            C4M = COEF4(JM1,K)*DTD
              C2 = COEF2(J,K)*DTD
              C4 = COEF4(J,K)*DTD
            WORK(J,K,1) =  XYJ(JM2,K)*C4M
            WORK(J,K,2) = -(C2M + 3.*C4M + C4)*XYJ(JM1,K)
            WORK(J,K,3) = XYJ(J,K)*(C2M+3.*C4M+C2+3.*C4)
            WORK(J,K,4) = -(C2 + 3.*C4 + C4M)*XYJ(JP1,K)
            WORK(J,K,5) = XYJ(JP2,K)*C4
212         CONTINUE
210       CONTINUE
C
            IF(.NOT.PERIDC  )THEN
         J = JLOW
         JP1 = JPLUS(J)
         JM1 = JMINU (J)
         JP2 = JPLUS(JP1)
            DO 220 K = KLOW,KUP
            C2M = COEF2(JM1,K)*DTD
            C4M = COEF4(JM1,K)*DTD
              C2 = COEF2(J,K)*DTD
              C4 = COEF4(J,K)*DTD
            WORK(J,K,1) =  0.
            WORK(J,K,2) = -(C2M + C4M + C4)*XYJ(JM1,K)
            WORK(J,K,3) = XYJ(J,K)*(C2M+2.*C4M+C2+3.*C4)
            WORK(J,K,4) = -(C2 + 3.*C4 + C4M)*XYJ(JP1,K)
            WORK(J,K,5) = XYJ(JP2,K)*C4
220         CONTINUE
C
         J = JUP
         JP1 = JPLUS(J)
         JM1 = JMINU (J)
         JM2 = JMINU (JM1)
            DO 222 K = KLOW,KUP
            C2M = COEF2(JM1,K)*DTD
            C4M = COEF4(JM1,K)*DTD
              C2 = COEF2(J,K)*DTD
              C4 = COEF4(J,K)*DTD
            WORK(J,K,1) =  XYJ(JM2,K)*C4M
            WORK(J,K,2) = -(C2M + 3.*C4M + C4)*XYJ(JM1,K)
            WORK(J,K,3) = XYJ(J,K)*(C2M+3.*C4M+C2+2.*C4)
            WORK(J,K,4) = -(C2 + C4 + C4M)*XYJ(JP1,K)
            WORK(J,K,5) = 0.
222         CONTINUE
C
            ENDIF
C
C   ADD IN FLUX JACOBIANS AND VARIABLE DT AND IDENTITY
C
         DO 230 J = JLOW,JUP
         JP1 = JPLUS(J)
         JM1 = JMINU (J)
            DO 232 K = KLOW,KUP
            WORK(J,K,2) = WORK(J,K,2) - (UU(JM1,K)+SN*CC(JM1,K))*HD
            WORK(J,K,4) = WORK(J,K,4) + (UU(JP1,K)+SN*CC(JP1,K))*HD
            WORK(J,K,1) = WORK(J,K,1)*DS(J,K)
            WORK(J,K,2) = WORK(J,K,2)*DS(J,K)
            WORK(J,K,3) = WORK(J,K,3)*DS(J,K)
            WORK(J,K,4) = WORK(J,K,4)*DS(J,K)
            WORK(J,K,5) = WORK(J,K,5)*DS(J,K)
            WORK(J,K,3) = WORK(J,K,3) + 1.
232         CONTINUE
230       CONTINUE
C
C  FOR N = 1 AND 2 DO BOTH TOGETHER
C   INVERT ON FIRST TWO S ELEMENTS
C
          IF(N.EQ.2)THEN
C
        IF(.NOT.PERIDC  )THEN
        CALL XPENT2(JDIM,KDIM,WORK(1,1,1),WORK(1,1,2),WORK(1,1,3),
     *       WORK(1,1,4),WORK(1,1,5),WORK(1,1,7),WORK(1,1,8),
     *       S(1,1,1),JLOW,JUP,KLOW,KUP)
C
               ELSE
C              PERIDC  
        CALL XPENP2(JDIM,KDIM,WORK(1,1,1),WORK(1,1,2),WORK(1,1,3),
     *       WORK(1,1,4),WORK(1,1,5),WORK(1,1,7),WORK(1,1,8),
     *       WORK(1,1,9),WORK(1,1,10),S(1,1,1),JLOW,JUP,KLOW,KUP)
               ENDIF
C
            ELSE
C
C  N = 3 OR 4
C
               IF(.NOT.PERIDC  )THEN
        CALL XPENTA(JDIM,KDIM,WORK(1,1,1),WORK(1,1,2),WORK(1,1,3),
     *       WORK(1,1,4),WORK(1,1,5),WORK(1,1,7),WORK(1,1,8),
     *       S(1,1,N),JLOW,JUP,KLOW,KUP)
               ELSE
C              PERIDC  
        CALL XPENTP(JDIM,KDIM,WORK(1,1,1),WORK(1,1,2),WORK(1,1,3),
     *       WORK(1,1,4),WORK(1,1,5),WORK(1,1,7),WORK(1,1,8),
     *       WORK(1,1,9),WORK(1,1,10),S(1,1,N),JLOW,JUP,KLOW,KUP)
               ENDIF
C
        ENDIF
C
300       CONTINUE
C
C  END XI DIRECTION
C
        RETURN
        END
