!------------------------------------------------- ! UHpack Module !------------------------------------------------- module uhpack use dcl_common contains !-------------------------------------------------------- ! エラーバーを描く. subroutine DclDrawXErrorBar(x1,x2,y,type,index,width) real, intent(in), dimension(:) :: x1, x2, y integer, intent(in), optional :: type, index real, intent(in), optional :: width if(present(type)) then itype0 = type else call uuqebt(itype0) end if if(present(index)) then index0 = index else call uuqebi(index0) end if if(present(width)) then width0 = width else call uuqebs(width0) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny .or. nx2.ne.ny) call msgdmp('M', 'DclDrawXErrorBar', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny) call uherbz(n,x1,x2,y,itype0,index0,width0) end subroutine !-------------------------------------------------------- ! 2本の折れ線の間をトーンパターンで塗る. subroutine DclHatchXGap(x1,x2,y,pattern1,pattern2) real, intent(in), dimension(:) :: x1, x2, y integer, intent(in), optional :: pattern1, pattern2 !トーンパターン番号. if(present(pattern1)) then itp1 = pattern1 else call uuqarp(itp1, idummy) end if if(present(pattern2)) then itp2 = pattern1 else call uuqarp(idummy, itp2) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny .or. nx2.ne.ny) call msgdmp('M', 'DclHatchXGap', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny) call uhdifz(n,x1,x2,y,itp1,itp2) end subroutine !-------------------------------------------------------- ! 棒グラフの枠を描く. subroutine DclDrawXBarFrame(x1,x2,y,type,index,width) real, intent(in), dimension(:) :: x1, x2, y integer, intent(in), optional :: type, index real, intent(in), optional :: width if(present(type)) then itype0 = type else call uuqfrt(itype0) end if if(present(index)) then index0 = index else call uuqfri(index0) end if if(present(width)) then width0 = width else call uuqbrs(width0) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny .or. nx2.ne.ny) call msgdmp('M', 'DclDrawXBarFrame', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny) call uhbrfz(n,x1,x2,y,itype0,index0,width0) end subroutine !-------------------------------------------------------- ! 棒グラフの内部領域を塗る subroutine DclHatchXBarArea(x1,x2,y,pattern1,pattern2,width) real, intent(in), dimension(:) :: x1, x2, y integer, intent(in), optional :: pattern1, pattern2 real, intent(in), optional :: width if(present(pattern1)) then itp1 = pattern1 else call uuqarp(itp1, idummy) end if if(present(pattern2)) then itp2 = pattern1 else call uuqarp(idummy, itp2) end if if(present(width)) then width0 = width else call uuqbrs(width0) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny .or. nx2.ne.ny) call msgdmp('M', 'DclHatchXBarArea', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny) call uhbraz(n,x1,x2,y,itp1,itp2,width0) end subroutine !-------------------------------------------------------- ! 棒グラフを線で結ぶ. subroutine DclDrawXBarLine(x,y,type,index,width) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index real, intent(in), optional :: width if(present(type)) then itype0 = type else call uuqfrt(itype0) end if if(present(index)) then index0 = index else call uuqfri(index0) end if if(present(width)) then width0 = width else call uuqbrs(width0) end if nx = size(x) ny = size(y) if(nx.ne.ny) call msgdmp('M', 'DclDrawXBarLine', & & 'Length of x and y don''t match.') n = min(nx, ny) call uhbrlz(n,x,y,itype0,index0,width0) end subroutine !-------------------------------------------------------- ! 箱グラフの枠を描く. subroutine DclDrawXBoxFrame(x1,x2,y,type,index) real, intent(in), dimension(:) ::x1, x2, y integer, intent(in), optional :: type, index if(present(type)) then itype0 = type else call uuqfrt(itype0) end if if(present(index)) then index0 = index else call uuqfri(index0) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny-1 .or. nx2.ne.ny-1) call msgdmp('M', 'DclDrawXBoxFrame', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny-1) call uhbxfz(n,x1,x2,y,itype0,index0) end subroutine !-------------------------------------------------------- ! 箱グラフの内部領域を塗る. subroutine DclHatchXBoxArea(x1,x2,y,pattern1,pattern2) real, intent(in), dimension(:) :: x1, x2, y integer, intent(in), optional :: pattern1, pattern2 if(present(pattern1)) then itp1 = pattern1 else call uuqarp(itp1, idummy) end if if(present(pattern2)) then itp2 = pattern1 else call uuqarp(idummy, itp2) end if nx1 = size(x1) nx2 = size(x2) ny = size(y) if(nx1.ne.ny-1 .or. nx2.ne.ny-1) call msgdmp('M', 'DclHatchXBoxArea', & & 'Length of x and y don''t match.') n = min(nx1, nx2, ny-1) call uhbxaz(n,x1,x2,y,itp1,itp2) end subroutine !-------------------------------------------------------- ! 階段状のグラフを描く. subroutine DclDrawXBoxLine(x,y,type,index) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index if(present(type)) then itype0 = type else call uuqfrt(itype0) end if if(present(index)) then index0 = index else call uuqfri(index0) end if nx = size(x) ny = size(y) if(nx.ne.ny-1) call msgdmp('M', 'DclDrawXBoxLine', & & 'Length of x and y don''t match.') n = min(nx, ny-1) call uhbxlz(n,xd,y,itype0,index0) end subroutine end module !uhpack library end ----