mat_print_id Subroutine

public subroutine mat_print_id(id, argcnt)

Arguments

Type IntentOptional Attributes Name
integer :: id(GG_MAX_NAME_LENGTH,*)
integer :: argcnt

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
integer, public :: i
integer, public :: id_counter
integer, public :: j
integer, public :: k
integer, public :: line_position
integer, public :: linebuf(8*GG_MAX_NAME_LENGTH+2*8+1)
character(len=len=(8*GG_MAX_NAME_LENGTH+2*8+1)), public :: mline

Source Code

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