!------------------------------------------------- ! UVpack Module !------------------------------------------------- module uvpack use dcl_common contains !-------------------------------------------------------- ! エラーバーを描く. subroutine DclDrawYErrorBar(x,y1,y2,type,index,width) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: type, index real, intent(in), optional :: width call sgoopn('DclDrawYErrorBar', ' ') 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 nx = size(x) ny1 = size(y1) ny2 = size(y2) if(nx.ne.ny1 .or. nx.ne.ny2) call msgdmp('M', 'DclDrawYErrorBar', & & 'Length of x and y don''t match.') n = min(nx, ny1, ny2) call uverbz(n,x,y1,y2,itype0,index0,width0) call sgocls('DclDrawYErrorBar') end subroutine !-------------------------------------------------------- ! 2本の折れ線の間をトーンパターンで塗る. subroutine DclShadeYGap(x,y1,y2,pattern1,pattern2) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: pattern1, pattern2 call sgoopn('DclShadeYGap', ' ') 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 nx = size(x) ny1 = size(y1) ny2 = size(y2) if(nx.ne.ny1 .or. nx.ne.ny2) call msgdmp('M', 'DclShadeYGap', & & 'Length of x and y don''t match.') n = min(nx, ny1, ny2) call uvdifz(n,x,y1,y2,itp1,itp2) call sgocls('DclShadeYGap') end subroutine !-------------------------------------------------------- ! 棒グラフの枠を描く. subroutine DclDrawYBarFrame(x,y1,y2,type,index,width) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: type, index real, intent(in), optional :: width call sgoopn('DclDrawYBarFrame', ' ') 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) ny1 = size(y1) ny2 = size(y2) if(nx.ne.ny1 .or. nx.ne.ny2) call msgdmp('M', 'DclDrawYBarFrame', & & 'Length of x and y don''t match.') n = min(nx, ny1, ny2) call uvbrfz(n,x,y1,y2,itype0,index0,width0) call sgocls('DclDrawYBarFrame') end subroutine !-------------------------------------------------------- ! 棒グラフの内部領域を塗る. subroutine DclShadeYBarArea(x,y1,y2,pattern1,pattern2,width) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: pattern1, pattern2 real, intent(in), optional :: width call sgoopn('DclShadeYBarArea', ' ') 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 nx = size(x) ny1 = size(y1) ny2 = size(y2) if(nx.ne.ny1 .or. nx.ne.ny2) call msgdmp('M', 'DclShadeYBarArea', & & 'Length of x and y don''t match.') n = min(nx, ny1, ny2) call uvbraz(n,x,y1,y2,itp1,itp2,width0) call sgocls('DclShadeYBarArea') end subroutine !-------------------------------------------------------- ! 棒グラフを線で結ぶ. subroutine DclDrawYBarLine(x,y,type,index,width) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index real, intent(in), optional :: width call sgoopn('DclDrawYBarLine', ' ') 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', 'DclDrawYBarLine', & & 'Length of x and y don''t match.') n = min(nx, ny) call uvbrlz(n,x,y,itype0,index0,width0) call sgocls('DclDrawYBarLine') end subroutine !-------------------------------------------------------- ! 箱グラフの枠を描く. subroutine DclDrawYBoxFrame(x,y1,y2,type,index) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: type, index call sgoopn('DclDrawYBoxFrame', ' ') 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) ny1 = size(y1) ny2 = size(y2) if(nx-1.ne.ny1 .or. nx-1.ne.ny2) call msgdmp('M', 'DclDrawYBoxFrame', & & 'Length of x and y don''t match.') n = min(nx-1, ny1, ny2) call uvbxfz(n,x,y1,y2,itype0,index0) call sgocls('DclDrawYBoxFrame') end subroutine !-------------------------------------------------------- ! 箱グラフの内部領域を塗る. subroutine DclShadeYBoxArea(x,y1,y2,pattern1,pattern2) real, intent(in), dimension(:) :: x, y1, y2 integer, intent(in), optional :: pattern1, pattern2 call sgoopn('DclShadeYBoxArea', ' ') 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 nx = size(x) ny1 = size(y1) ny2 = size(y2) if(nx-1.ne.ny1 .or. nx-1.ne.ny2) call msgdmp('M', 'DclShadeYBoxArea', & & 'Length of x and y don''t match.') n = min(nx-1, ny1, ny2) call uvbxaz(n,x,y1,y2,itp1,itp2) call sgocls('DclShadeYBoxArea') end subroutine !-------------------------------------------------------- ! 階段状のグラフを描く. subroutine DclDrawYBoxLine(x,y,type,index) real, intent(in), dimension(:) :: x, y integer, intent(in), optional :: type, index call sgoopn('DclDrawYBoxLine', ' ') 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-1.ne.ny) call msgdmp('M', 'DclDrawYBoxLine', & & 'Length of x and y don''t match.') n = min(nx-1, ny) call uvbxlz(n,x,y,itype0,index0) call sgocls('DclDrawYBoxLine') end subroutine end module