subroutine mat_print_id(id,argcnt)
! ident_21="@(#) M_matrix mat_print_id(3fp) print table of variable id names (up to) eight per line"
! ID Is array of GG_MAX_NAME_LENGTH character IDs to print
! ARGCNT is number of IDs to print
! If = -1, print one ID with an " =" suffix
!
integer :: id(GG_MAX_NAME_LENGTH,*)
integer :: argcnt
integer :: id_counter !
integer :: i, j, k
integer :: line_position ! pointer into output line being built
integer :: linebuf(8*GG_MAX_NAME_LENGTH+2*8+1) ! scratch buffer for building up line
character(len=(8*GG_MAX_NAME_LENGTH+2*8+1)) :: mline ! scratch space for building line to print
id_counter = 1 ! which ID to start the line with
INFINITE : do
linebuf(1)=blank ! put a space at beginning of line
line_position = 2
do j = id_counter,min(id_counter+7,iabs(argcnt)) ! copy up to eight names into buffer
do i = 1, GG_MAX_NAME_LENGTH ! copy one name into buffer
k = id(i,j) ! this is the kth letter of the set
linebuf(line_position) = k
if(linebuf(line_position).ne.blank)line_position = line_position+1 ! increment pointer into output
enddo
linebuf(line_position+0)=blank ! put two spaces between names
linebuf(line_position+1)=blank
line_position=line_position+2
enddo
if (argcnt .eq. -1) then ! special flag to print one word and =
linebuf(line_position) = equal ! put value for equal sign into buffer
else
line_position=line_position-3 ! was prepared for another ID with two blanks
endif
call mat_buf2str(mline,linebuf,line_position) ! write LINEBUF(1:line_position) line to a character variable
call journal(mline) ! print the line to stdout
id_counter = id_counter+8 ! prepare to get up to eight more IDs
if (id_counter .gt. iabs(argcnt)) exit INFINITE ! if not done do another line
enddo INFINITE
end subroutine mat_print_id