C SUBROUTINE VPENTA C C ROUTINE TO INVERT 3 PENTADIAGONALS SIMULTANEOUSLY C C 12/05/84 D H BAILEY MODIFIED FOR NAS KERNEL TEST C PARAMETER (NJA=129, 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