subroutine dwmatg(xxxx,nrxxxx,ncxxxx,ksxxxx,ntxxxx,naxxxx)
*
*     print a matrix of arbitrary typ with g-format
*
*     xxxx   matrix to be printed
*     nrxxxx number of rows in xxxx
*     ncxxxx number of columns in xxxx
*     ksxxxx storage mode for xxxx
*     ksxxxx 0 general (allocated size is nrxxxx*ncxxxx)
*     ksxxxx 1 symmetric (allocated size is (nrxxxx+1)*nrxxxx/2)
*     ksxxxx 2 digonal (allocated size is nrxxxx)
*     ntxxxx type of number (word) in xxxx
*     ntxxxx permisseble type is defined as a string with 4 characters
*     ntxxxx must be one of the following:
*     ntxxxx 'i   ' for integer numbers
*     ntxxxx 'r   ' for real numbers
*     ntxxxx 'rd  ' for real numbers in double precision
*     naxxxx name of xxxx
*
      character ntxxxx*(*),naxxxx*(*)
      dimension xxxx(*),nrxxxx(*)
*
      if ( ntxxxx(:1) .eq. 'i' ) then
         call dwmii(xxxx,nrxxxx,ncxxxx,ksxxxx,naxxxx)
      else if ( ntxxxx(:2) .eq. 'rd' ) then
         call dwmrdg(xxxx,nrxxxx,ncxxxx,ksxxxx,naxxxx)
      else if ( ntxxxx(:1) .eq. 'r' ) then
         call dwmrg(xxxx,nrxxxx,ncxxxx,ksxxxx,naxxxx)
      end if
*
      return
      end
      subroutine dwmii(ia,n,m,msa,rub)
*
*     print integer matrix with i-format
*
*     ia     matrix to be printed
*     n      number of rows in ia
*     m      number of columns in ia
*     msa    storage mode for matrix ia
*     msa    0 if general storage
*     msa    1 if symmetric storage
*     msa    2 if diagonel storage
*     rub    text to be printed
*
      implicit integer (a-z)
      character rub*(*)
      dimension ia(*),irub(40),irad(80)
*
      iw=6
      b=abs(ia(1))
      do 1 i=1,n
      do 1 j=1,m
      call dwmloc(i,j,l,n,m,msa)
      if (l) 81,82,81
82    aa=0
      go to 83
81    aa=abs(ia(l))
83    if (aa-b) 1,1,2
2     b=aa
1     continue
      isiff=7
      if (b.le.999999) isiff=6
      if (b.le.99999 ) isiff=5
      if (b.le.9999  ) isiff=4
      if (b.le.999   ) isiff=3
      if (b.le.99    ) isiff=2
      if (b.le.9     ) isiff=1
      if (isiff-2) 30,31,32
32    if (isiff-3) 33,33,34
30    c=9
      nkol=24
      go to 35
31    c=99
      nkol=18
      go to 35
33    c=999
      nkol=14
      go to 35
34    if (isiff-4) 36,36,37
36    c=9999
      nkol=12
      go to 35
37    if (isiff-5) 38,38,39
38    c=99999
      nkol=10
      go to 35
39    if (isiff-6) 138,138,139
138   c=999999
      nkol=9
      go to 35
139   c=9999999
      nkol=8
35    continue
*
      nrad=99999
      nsk=0
10    nsk=nsk+1
      if (m-nsk*nkol) 11,11,10
11    nsr=0
12    nsr=nsr+1
      if (n-nsr*nrad) 13,13,12
13    ik1=0
      ik2=0
      ipage=0
      do 50 ik=1,nsk
      if (ik-nsk) 14,15,15
15    nkola=m-(nsk-1)*nkol
      go to 16
14    nkola=nkol
16    ik1=ik2
      ik2=ik2+nkola
      do 17 i=1,nkola
17    irub(i)=ik1+i
      ir1=0
      ir2=0
      do 50 k=1,nsr
      ipage =ipage+1
      if (ipage.eq.1) write (*,18) rub
18    format('0',a)
      if (ipage.ne.1) write(*,813)
813   format('0')
      go to (100,200,300,400,500,600,700),isiff
100   write (*,101)     (irub(i),i=1,nkola)
101   format('0',6x,24i3)
      go to 19
200   write (*,201)     (irub(i),i=1,nkola)
201   format('0',6x,18i4)
      go to 19
300   write (*,301)     (irub(i),i=1,nkola)
301   format('0',6x,14i5)
      go to 19
400   write (*,401)     (irub(i),i=1,nkola)
401   format('0',6x,12i6)
      go to 19
500   write (*,501)     (irub(i),i=1,nkola)
501   format('0',6x,10i7)
      go to 19
600   write (*,601)     (irub(i),i=1,nkola)
601   format('0',6x,9i8)
      go to 19
700   write (*,701)     (irub(i),i=1,nkola)
701   format(' ',6x,8i9)
19    continue
      write(*,812)
812   format(' ')
      if (k-nsr) 20,29,29
20    nrada=nrad
      go to 22
29    nrada=n-(nsr-1)*nrad
22    ir1=ir2
      ir2=ir2+nrada
      nkol1=nkola+1
      do 21 ja=1,nrada
      irad (1)=ir1+ja
      do 28 jb=2,nkol1
      call dwmloc(ir1+ja  ,ik1+jb-1,ir,n,m,msa)
      if (ir) 23,24,23
24    irad(jb)=0
      go to 28
23    irad(jb)=ia(ir)
28    continue
      go to (102,202,302,402,502,602,702),isiff
102   write (*,103) (irad(i),i=1,nkol1)
103   format(' ',i4,'  ',24i3)
      go to 21
202   write (*,203) (irad(i),i=1,nkol1)
203   format(' ',i4,'  ',18i4)
      go to 21
302   write (*,303) (irad(i),i=1,nkol1)
303   format(' ',i4,'  ',14i5)
      go to 21
402   write (*,403) (irad(i),i=1,nkol1)
403   format(' ',i4,'  ',12i6)
      go to 21
502   write (*,503) (irad(i),i=1,nkol1)
503   format(' ',i4,'  ',10i7)
      go to 21
602   write (*,603) (irad(i),i=1,nkol1)
603   format(' ',i4,'  ',9i8)
      go to 21
702   write (*,703) (irad(i),i=1,nkol1)
703   format(' ',i4,'  ',8i9)
21    continue
50    continue
      return
      end
      subroutine dwmrg(a,n,m,msa,rub)
*
*     print real matrix with g-format
*
*     a      matrix to be printed
*     n      number of rows in a
*     m      number of columns in a
*     msa    storage mode for matrix a
*     msa    0 if general storage
*     msa    1 if symmetric storage
*     msa    2 if diagonal storage
*     rub    text to be printed
*
      dimension a(*),b(11)
      character rub*(*)
*
      iw=6
      isp=2
2     format(' ',2x,5i14)
3     format(' ')
4     format(' ',i4,2x,5g14.6)
5     format(' ',i4,2x,5g14.6)
7     format('0',a)
8     format('0')
      j=1
      nend=5
      lend=99999
      ipage=1
10    lstrt=1
20    continue
      jnt=j+nend-1
      ipage=ipage+1
31    if (jnt-m) 33,33,32
32    jnt=m
33    continue
      if (ipage.eq.2) write (*,7) rub
      if (ipage.gt.2) write (*,8)
      write (*,2) (jcur,jcur=j,jnt)
      write (*,3)
      if (isp-1) 35,35,40
35    write (*,3)
40    ltend=lstrt+lend-1
      do 80 l=lstrt,ltend
      do 55 k=1,nend
      kk=k
      jt=j+k-1
      call dwmloc(l,jt,ijnt,n,m,msa)
      b(k)=0.0
      if (ijnt) 50,50,45
45    b(k)=a(ijnt)
50    continue
      if (jt-m) 55,60,60
55    continue
60    if (isp-1) 65,65,70
65    write (*,4)l,(b(jw),jw=1,kk)
      go to 75
70    write (*,5)l,(b(jw),jw=1,kk)
75    if (n-l) 85,85,80
80    continue
      lstrt=lstrt+lend
      go to 20
85    if (jt-m) 90,95,95
90    j=jt+1
      go to 10
95    return
      end
      subroutine dwmrdg(a,n,m,msa,rub)
*
*     print double precision matrix with g-format
*
*     a      matrix to be printed
*     n      number of rows in a
*     m      number of columns in a
*     msa    storage mode for matrix a
*     msa    0 if general storage
*     msa    1 if symmetric storage
*     msa    2 if diagonal storage
*     rub    text to be printed
*
      implicit double precision(a-h,o-z)
      character rub*(*)
      dimension a(*),b(11)
*
      iw=6
      isp=2
      ipos=132
2     format('0',2x,5i14)
3     format(' ')
4     format(' ',i4,2x,5g14.6)
5     format(' ',i4,2x,5g14.6)
7     format('0',a)
8     format('0')
      j=1
      nend=5
      lend=99999
      ipage=1
10    lstrt=1
20    continue
      jnt=j+nend-1
      ipage=ipage+1
31    if (jnt-m) 33,33,32
32    jnt=m
33    continue
      if (ipage.eq.2) write (*,7) rub
      if (ipage.gt.2) write(*,8)
      write (*,2) (jcur,jcur=j,jnt)
      write (*,3)
      if (isp-1) 35,35,40
35    write (*,3)
40    ltend=lstrt+lend-1
      do 80 l=lstrt,ltend
      do 55 k=1,nend
      kk=k
      jt=j+k-1
      call dwmloc(l,jt,ijnt,n,m,msa)
      b(k)=0.0
      if (ijnt) 50,50,45
45    b(k)=a(ijnt)
50    continue
      if (jt-m) 55,60,60
55    continue
60    if (isp-1) 65,65,70
65    write (*,4)l,(b(jw),jw=1,kk)
      go to 75
70    write (*,5)l,(b(jw),jw=1,kk)
75    if (n-l) 85,85,80
80    continue
      lstrt=lstrt+lend
      go to 20
85    if (jt-m) 90,95,95
90    j=jt+1
      go to 10
95    return
      end
      subroutine dwmloc(i,j,ir,n,m,ms)
      ix=i
      jx=j
      if (ms-1) 10,20,30
10    irx=n*(jx-1)+ix
      go to 36
20    if (ix-jx) 22,24,24
22    irx=ix+(jx*jx-jx)/2
      go to 36
24    irx=jx+(ix*ix-ix)/2
      go to 36
30    irx=0
      if (ix-jx) 36,32,36
32    irx=ix
36    ir=irx
      return
      end