SUBROUTINE GMADD(IA1,IA2,IB1,IB2,IR1,IR2,N,M) C MODIFIED FOR PCCPC C SUBROUTINE GMADD(A,B,R,N,M) INCLUDE 'VKLUGPRM.FTN' REAL*8 A,B,R DIMENSION A(1),B(1),R(1) C NM=N*M DO 10 I=1,N DO 10 J=1,M IJ=(I-1)*RRW+J IAB=(IA2-1)*RRW+IA1 IBB=(IB2-1)*RRW+IB1 IRB=(IR2-1)*RRW+IR1 CALL XVBLGT(IJ+IAB,1,A) CALL XVBLGT(IJ+IBB,1,B) R(1)=A(1)+B(1) CALL XVBLST(IJ+IRB,1,R) 10 CONTINUE C 10 R(IJ)=A(IJ)+B(IJ) RETURN END SUBROUTINE GMPRD(IA1,IA2,IB1,IB2,IR1,IR2,N,M,L) C SUBROUTINE GMPRD(A,B,R,N,M,L) INCLUDE 'VKLUGPRM.FTN' REAL*8 A,B,R DIMENSION A(1),B(1),R(1) C SPECIAL MATRIX MULTIPLY WITHIN SPREADSHEET MATRIX IAB=(IA2-1)*RRW+IA1 IBB=(IB2-1)*RRW+IB1 IRB=(IR2-1)*RRW+IR1 DO 10 K=1,L DO 10 J=1,M NL=(J-1)*RRW+K R(1)=0. CALL XVBLST(IRB+NL,1,R) DO 10 I=1,N NM=(J-1)*RRW+I ML=(I-1)*RRW+K CALL XVBLGT(IAB+NM,1,A) CALL XVBLGT(IBB+ML,1,B) A(1)=A(1)*B(1) CALL XVBLGT(IRB+NL,1,R) R(1)=R(1)+A(1) 10 CALL XVBLST(IRB+NL,1,R) C R(NL)=R(NL)+A(NM)*B(ML) C10 CONTINUE RETURN END SUBROUTINE GMSUB(IA1,IA2,IB1,IB2,IR1,IR2,N,M) C SUBROUTINE GMSUB(A,B,R,N,M) INCLUDE 'VKLUGPRM.FTN' REAL*8 A,B,R C DIMENSION A(1),B(1),R(1) IAB=(IA2-1)*RRW+IA1 IBB=(IB2-1)*RRW+IB1 IRB=(IR2-1)*RRW+IR1 C NM=N*M DO 10 I=1,N DO 10 J=1,M IJ=(I-1)*RRW+J CALL XVBLGT(IAB+IJ,1,A) CALL XVBLGT(IBB+IJ,1,B) A=A-B CALL XVBLST(IRB+IJ,1,A) 10 CONTINUE C 10 R(IJ)=A(IJ)-B(IJ) RETURN END C SUBROUTINE GMTRA(A,R,N,M) C INCLUDE 'VKLUGPRM.FTN' C REAL*8 A,R C DIMENSION A(1),R(1) C IR=0 C DO 10 I=1,N C IJ=I-N C DO 10 J=1,M C IJ=IJ+N C IR=IR+1 C 10 R(IR)=A(IJ) C RETURN C END SUBROUTINE GTPRD(IA1,IA2,IB1,IB2,IR1,IR2,N,M,L) C SUBROUTINE GTPRD(A,B,R,N,M,L) INCLUDE 'VKLUGPRM.FTN' REAL*8 A,B,R DIMENSION A(1),B(1),R(1) C SPECIAL MATRIX MULTIPLY WITHIN SPREADSHEET MATRIX IAB=(IA2-1)*RRW+IA1 IBB=(IB2-1)*RRW+IB1 IRB=(IR2-1)*RRW+IR1 DO 10 K=1,L DO 10 J=1,M NL=(J-1)*RRW+K R(1)=0. CALL XVBLST(NL+IRB,1,R) DO 10 I=1,N C INVERT ROW/COLUMN USE FOR MATRIX A NM=(I-1)*RRW+J ML=(I-1)*RRW+K CALL XVBLGT(IAB+NM,1,A) CALL XVBLGT(IBB+ML,1,B) A(1)=A(1)*B(1) CALL XVBLGT(IRB+NL,1,R) R(1)=R(1)+A(1) CALL XVBLST(IRB+NL,1,R) C R(NL)=R(NL)+A(NM)*B(ML) 10 CONTINUE RETURN END C SUBROUTINE MINV(A,N,D,L,M) C INCLUDE 'VKLUGPRM.FTN' C REAL*8 A,D,L,M C REAL*8 BIGA C DIMENSION A(1),L(1),M(1) C D=1.0 C NK=-N C DO 80 K=1,N C NK=NK+N C L(K)=K C M(K)=K C KK=NK+K C BIGA=A(KK) C DO 20 J=K,N C IZ=N*(J-1) C DO 20 I=K,N C IJ=IZ+I C 10 IF( ABS(BIGA)- ABS(A(IJ))) 15,20,20 C 15 BIGA=A(IJ) C L(K)=I C M(K)=J C 20 CONTINUE C J=L(K) C IF(J-K) 35,35,25 C 25 KI=K-N C DO 30 I=1,N C KI=KI+N C HOLD=-A(KI) C JI=KI-K+J C A(KI)=A(JI) C 30 A(JI) =HOLD C 35 I=M(K) C IF(I-K) 45,45,38 C 38 JP=N*(I-1) C DO 40 J=1,N C JK=NK+J C JI=JP+J C HOLD=-A(JK) C A(JK)=A(JI) C 40 A(JI) =HOLD C 45 IF(BIGA) 48,46,48 C 46 D=0.0 C RETURN C 48 DO 55 I=1,N C IF(I-K) 50,55,50 C 50 IK=NK+I C A(IK)=A(IK)/(-BIGA) C 55 CONTINUE C DO 65 I=1,N C IK=NK+I C HOLD=A(IK) C IJ=I-N C DO 65 J=1,N C IJ=IJ+N C IF(I-K) 60,65,60 C 60 IF(J-K) 62,65,62 C 62 KJ=IJ-I+K C A(IJ)=HOLD*A(KJ)+A(IJ) C 65 CONTINUE C KJ=K-N C DO 75 J=1,N C KJ=KJ+N C IF(J-K) 70,75,70 C 70 A(KJ)=A(KJ)/BIGA C 75 CONTINUE C D=D*BIGA C A(KK)=1.0/BIGA C 80 CONTINUE C K=N C 100 K=(K-1) C IF(K) 150,150,105 C 105 I=L(K) C IF(I-K) 120,120,108 C 108 JQ=N*(K-1) C JR=N*(I-1) C DO 110 J=1,N C JK=JQ+J C HOLD=A(JK) C JI=JR+J C A(JK)=-A(JI) C 110 A(JI) =HOLD C 120 J=M(K) C IF(J-K) 100,100,125 C 125 KI=K-N C DO 130 I=1,N C KI=KI+N C HOLD=A(KI) C JI=KI-K+J C A(KI)=-A(JI) C 130 A(JI) =HOLD C GO TO 100 C 150 RETURN C END