*DECK JGROUP SUBROUTINE JGROUP (N,IA,JA,MAXG,NGRP,IGP,JGP,INCL,JDONE,IER) INTEGER N, IA, JA, MAXG, NGRP, IGP, JGP, INCL, JDONE, IER DIMENSION IA(*), JA(*), IGP(*), JGP(*), INCL(*), JDONE(*) C----------------------------------------------------------------------- C This subroutine constructs groupings of the column indices of C the Jacobian matrix, used in the numerical evaluation of the C Jacobian by finite differences. C C Input: C N = the order of the matrix. C IA,JA = sparse structure descriptors of the matrix by rows. C MAXG = length of available storage in the IGP array. C C Output: C NGRP = number of groups. C JGP = array of length N containing the column indices by groups. C IGP = pointer array of length NGRP + 1 to the locations in JGP C of the beginning of each group. C IER = error indicator. IER = 0 if no error occurred, or 1 if C MAXG was insufficient. C C INCL and JDONE are working arrays of length N. C----------------------------------------------------------------------- INTEGER I, J, K, KMIN, KMAX, NCOL, NG C IER = 0 DO 10 J = 1,N 10 JDONE(J) = 0 NCOL = 1 DO 60 NG = 1,MAXG IGP(NG) = NCOL DO 20 I = 1,N 20 INCL(I) = 0 DO 50 J = 1,N C Reject column J if it is already in a group.-------------------------- IF (JDONE(J) .EQ. 1) GO TO 50 KMIN = IA(J) KMAX = IA(J+1) - 1 DO 30 K = KMIN,KMAX C Reject column J if it overlaps any column already in this group.------ I = JA(K) IF (INCL(I) .EQ. 1) GO TO 50 30 CONTINUE C Accept column J into group NG.---------------------------------------- JGP(NCOL) = J NCOL = NCOL + 1 JDONE(J) = 1 DO 40 K = KMIN,KMAX I = JA(K) 40 INCL(I) = 1 50 CONTINUE C Stop if this group is empty (grouping is complete).------------------- IF (NCOL .EQ. IGP(NG)) GO TO 70 60 CONTINUE C Error return if not all columns were chosen (MAXG too small).--------- IF (NCOL .LE. N) GO TO 80 NG = MAXG 70 NGRP = NG - 1 RETURN 80 IER = 1 RETURN C----------------------- End of Subroutine JGROUP ---------------------- END