      SUBROUTINE VPENTA
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
C    ROUTINE TO INVERT 3 PENTADIAGONALS SIMULTANEOUSLY
C
C   12/05/84  D H BAILEY   MODIFIED FOR NAS KERNEL TEST
C
      PARAMETER (NJA=128, NJB=128, JL=1, JU=128, KL=1, KU=128)
      COMMON /ARRAYS/ A(NJA,NJB), B(NJA,NJB), C(NJA,NJB), D(NJA,NJB),
     $ E(NJA,NJB), F(NJA,NJB,3), X(NJA,NJB), Y(NJA,NJB), FX(NJA,NJB,3)
C
C	! START FORWARD GENERATION PROCESS AND SWEEP
C
      J = JL
      DO 1 K = KL,KU
        RLD = C(J,K)
        RLDI = 1./RLD
        F(J,K,1) = F(J,K,1)*RLDI
        F(J,K,2) = F(J,K,2)*RLDI
        F(J,K,3) = F(J,K,3)*RLDI
        X(J,K) = D(J,K)*RLDI
        Y(J,K) = E(J,K)*RLDI
1     CONTINUE
C
      J = JL+1
      DO 2 K = KL,KU
        RLD1 = B(J,K)
        RLD = C(J,K) - RLD1*X(J-1,K)
        RLDI = 1./RLD
        F(J,K,1) = (F(J,K,1) - RLD1*F(J-1,K,1))*RLDI
        F(J,K,2) = (F(J,K,2) - RLD1*F(J-1,K,2))*RLDI
        F(J,K,3) = (F(J,K,3) - RLD1*F(J-1,K,3))*RLDI
        X(J,K) = (D(J,K) - RLD1*Y(J-1,K))*RLDI
        Y(J,K) = E(J,K)*RLDI
2     CONTINUE
C
      DO 3 J = JL+2,JU-2
        DO 11 K = KL,KU
          RLD2 = A(J,K)
          RLD1 = B(J,K) - RLD2*X(J-2,K)
          RLD = C(J,K) - (RLD2*Y(J-2,K) + RLD1*X(J-1,K))
          RLDI = 1./RLD
          F(J,K,1) = (F(J,K,1) - RLD2*F(J-2,K,1) - RLD1*F(J-1,K,1))*RLDI
          F(J,K,2) = (F(J,K,2) - RLD2*F(J-2,K,2) - RLD1*F(J-1,K,2))*RLDI
          F(J,K,3) = (F(J,K,3) - RLD2*F(J-2,K,3) - RLD1*F(J-1,K,3))*RLDI
          X(J,K) = (D(J,K) - RLD1*Y(J-1,K))*RLDI
          Y(J,K) = E(J,K)*RLDI
11      CONTINUE
3     CONTINUE
C
      J = JU-1
      DO 12 K = KL,KU
        RLD2 = A(J,K)
        RLD1 = B(J,K) - RLD2*X(J-2,K)
        RLD = C(J,K) - (RLD2*Y(J-2,K) + RLD1*X(J-1,K))
        RLDI = 1./RLD
        F(J,K,1) = (F(J,K,1) - RLD2*F(J-2,K,1) - RLD1*F(J-1,K,1))*RLDI
        F(J,K,2) = (F(J,K,2) - RLD2*F(J-2,K,2) - RLD1*F(J-1,K,2))*RLDI
        F(J,K,3) = (F(J,K,3) - RLD2*F(J-2,K,3) - RLD1*F(J-1,K,3))*RLDI
        X(J,K) = (D(J,K) - RLD1*Y(J-1,K))*RLDI
12    CONTINUE
C
      J = JU
      DO 13 K = KL,KU
        RLD2 = A(J,K)
        RLD1 = B(J,K) - RLD2*X(J-2,K)
        RLD = C(J,K) - (RLD2*Y(J-2,K) + RLD1*X(J-1,K))
        RLDI = 1./RLD
        F(J,K,1) = (F(J,K,1) - RLD2*F(J-2,K,1) - RLD1*F(J-1,K,1))*RLDI
        F(J,K,2) = (F(J,K,2) - RLD2*F(J-2,K,2) - RLD1*F(J-1,K,2))*RLDI
        F(J,K,3) = (F(J,K,3) - RLD2*F(J-2,K,3) - RLD1*F(J-1,K,3))*RLDI
13    CONTINUE
C
C        !  BACK SWEEP SOLUTION
C
      DO 14 K = KL,KU
        F(JU,K,1) = F(JU,K,1)
        F(JU,K,2) = F(JU,K,2)
        F(JU,K,3) = F(JU,K,3)
        F(JU-1,K,1) = F(JU-1,K,1) - X(JU-1,K)*F(JU,K,1)
        F(JU-1,K,2) = F(JU-1,K,2) - X(JU-1,K)*F(JU,K,2)
        F(JU-1,K,3) = F(JU-1,K,3) - X(JU-1,K)*F(JU,K,3)
14    CONTINUE
C
      DO 4 J = 2,JU-JL
        JX = JU-J
        DO 15 K = KL,KU
          F(JX,K,1) = F(JX,K,1) - X(JX,K)*F(JX+1,K,1) -
     *                Y(JX,K)*F(JX+2,K,1)
          F(JX,K,2) = F(JX,K,2) - X(JX,K)*F(JX+1,K,2) -
     *                Y(JX,K)*F(JX+2,K,2)
          F(JX,K,3) = F(JX,K,3) - X(JX,K)*F(JX+1,K,3) -
     *                Y(JX,K)*F(JX+2,K,3)
15      CONTINUE
4     CONTINUE
C
      RETURN
      END
