ColorPlot.f90

Path: ColorPlot.f90
Last Update: Wed Apr 12 21:46:36 GMT+9:00 2006

ColorPlot

author :小松 研吾 (KOMATSU Kengo)
version :3.2
date :2006/04/12
copyright :Copyright (c) K.K & PGK, 2006. All rights reserved.

説明

このサブルーチンは PGPLOT を使用しています。 PGPLOT については PGPLOT のマニュアルなどを参照してください。

このサブルーチンを呼ぶ前に PGOPEN でグラフィック・デバイスを開いて おく必要があります。また、図を描き終わった後は PGCLOS でグラフィッ ク・デバイスを閉じなくてはなりません。図を複数並べたい場合は PGSUBP で表示面を複数のパネルに分割しておきます。

    istat = PGOPEN('? ')       ! グラフィック・デバイスを開く
    if (istat .le. 0 ) stop "An error has occured in PGOPEN! ... Stop."
    call PGSUBP(1,3)           ! 表示面を横 1 縦 3 に分割
       ...
    call ColorPlot( ... )
       ...
    call ColorPlot( ... )
       ...
       ...
    call PGCLOS

指定した x 軸の値の最小値(xmin)・最大値(xmax)、y 軸の値の最小値 (ymin)・最大値(ymax)の範囲で配列 value の値をカラーでプロットし ます。隣り合う位置間の幅を x 方向は xwidth 、 y 方向は ywidth で指 定します。x = (i-1) * xwidth + xmin, y = (i-1) * ywidth + ymin の値 を配列 value(i,j) に入れておきます。各次元の要素数 vi, vj はそれぞ れ (xmax-xmin)/xwidth + 1, (ymax-ymin)/ywidth + 1 で、これらは整数 でなくてはなりません。、添字の範囲はそれぞれ 1〜vi, 1〜vj です。ま た、 vi, vj は引数で与える必要があります。カラーの最大値・最小値は threshold を 1 に設定した場合には上側を threshold_low 、下側を threshold_up で指定できます。それらを上回る、もしくは下回る値はグレ ーになります。 threshold を 1 にした場合は自動的にvalue の最大値・ 最小値にします。この場合、 threshold_low, threshold_up は使用されま せんが省略できません(optionalに対応していないため)。

x 軸、y 軸、カラーの linear/logscale の指定はそれぞれ logscale_x, logscale_y, logscale_v で行います( 0:linear, 1:logscale, )。

図のタイトル、x 軸のタイトル、y 軸のタイトル、カラーバー(値)のタイ トルはそれぞれ、title_t, title_x, title_y, title_v で与えます。各タ イトルやカラーバーの位置は landscape に最適化されています。

このサブルーチンの中で使用されているサブルーチン setcolor はカラー パレットです。引数に 0 を与えるとカラー、 1 を与えるとグレーになり ます。

引数

下記参照。

Methods

Public Instance methods

Subroutine :
xmin :real(4), intent(in)
: x 軸の最小値・最大値
xmax :real(4), intent(in)
: x 軸の最小値・最大値
ymin :real(4), intent(in)
: y 軸の最小値・最大値
ymax :real(4), intent(in)
: y 軸の最小値・最大値
xwidth :real(4), intent(in)
: x 幅 ( i,i+1 間の x 幅 )
ywidth :real(4), intent(in)
: y 幅 ( j,j+1 間の y 幅 )
value(1:vi,1:vj) :real(4), intent(in)
: 座標 (x,y) での値
vi :integer, intent(in)
: 配列 value の要素数
vj :integer, intent(in)
: 配列 value の要素数
logscale_x :integer, intent(in)
: x 軸 ログスケール表示 (0:linear, 1:logscale)
logscale_y :integer, intent(in)
: y 軸 ログスケール表示 (0:linear, 1:logscale)
logscale_v :integer, intent(in)
: value ログスケール表示 (0:linear, 1:logscale)
threshold :integer, intent(in)
: 閾値 (0:off, 1:on)
threshold_low :real(4), intent(in)
: 閾値下側
threshold_up :real(4), intent(in)
: 閾値上側
title_t :character(len=*), intent(in)
: 図のタイトル
title_x :character(len=*), intent(in)
: x 軸のタイトル
title_y :character(len=*), intent(in)
: y 軸のタイトル
title_v :character(len=*), intent(in)
: カラーバーのタイトル

指定した x 軸の値の最小値・最大値、y 軸の値の最小値・最大値の範囲で 配列 value の値をカラーでプロットします。

[Source]

subroutine ColorPlot(xmin,xmax,ymin,ymax,xwidth,ywidth,value,vi,vj,                  logscale_x,logscale_y,logscale_v,                               threshold,threshold_low,threshold_up,                           title_t,title_x,title_y,title_v)
  !
  ! 指定した x 軸の値の最小値・最大値、y 軸の値の最小値・最大値の範囲で
  ! 配列 value の値をカラーでプロットします。
  !
  implicit none
  real(4), intent(in) :: xmin, xmax     ! x 軸の最小値・最大値
  real(4), intent(in) :: ymin, ymax     ! y 軸の最小値・最大値
  real(4), intent(in) :: xwidth         ! x 幅 ( i,i+1 間の x 幅 )
  real(4), intent(in) :: ywidth         ! y 幅 ( j,j+1 間の y 幅 )
  integer, intent(in) :: vi, vj         ! 配列 value の要素数
  real(4), intent(in) :: value(1:vi,1:vj)  ! 座標 (x,y) での値
  integer, intent(in) :: threshold      ! 閾値 (0:off, 1:on)
  real(4), intent(in) :: threshold_low  ! 閾値下側
  real(4), intent(in) :: threshold_up   ! 閾値上側
  integer, intent(in) :: logscale_x     ! x 軸  ログスケール表示
                                        ! (0:linear, 1:logscale)
  integer, intent(in) :: logscale_y     ! y 軸  ログスケール表示
                                        ! (0:linear, 1:logscale)
  integer, intent(in) :: logscale_v     ! value ログスケール表示
                                        ! (0:linear, 1:logscale)
  character(len=*), intent(in) :: title_t  ! 図のタイトル
  character(len=*), intent(in) :: title_x  ! x 軸のタイトル
  character(len=*), intent(in) :: title_y  ! y 軸のタイトル
  character(len=*), intent(in) :: title_v  ! カラーバーのタイトル
  real(4)             :: xmin_t, xmax_t, ymin_t, ymax_t
  real(4)             :: xwidth_t, ywidth_t
  real(4)             :: x1, x2, y1, y2
  real(4)             :: value_t(1:vi,1:vj)
  real(4)             :: threshold_low_t,threshold_up_t
  integer             :: min_sub(1:2), max_sub(1:2)
  real(4)             :: value_min, value_max
  integer             :: i, j
  integer             :: l
  integer :: pcf, pch, pci, plw,px1, px2, py1, py2
  external setcolor

  ! ---- PGPLOT 用の各値の保存 ----
  call PGQCF(pcf)
  call PGQCH(pch)
  call PGQCI(pci)
  call PGQLW(plw)
  call PGQVP(0,px1,px2,py1,py2)

  ! ---- 両端の調整 ----
  xwidth_t = xwidth
  ywidth_t = ywidth
  xmin_t = xmin - xwidth_t/2.0
  xmax_t = xmax + xwidth_t/2.0
  ymin_t = ymin - ywidth_t/2.0
  ymax_t = ymax + ywidth_t/2.0
  if (logscale_x==1) then
     xwidth_t = log10(xwidth_t)
     xmin_t   = log10(xmin) - xwidth_t/2.0
     xmax_t   = log10(xmax) + xwidth_t/2.0
  end if
  if (logscale_y==1) then
     ywidth_t = log10(ywidth_t)
     ymin_t   = log10(ymin) - ywidth_t/2.0
     ymax_t   = log10(ymax) + ywidth_t/2.0
  end if

  ! ---- 描画の準備 ----
  call PGSLW(3)                                 ! 線の太さ
  call PGSCF(2)                                 ! font 指定
  call PGSCH(1.6)                               ! 文字の大きさ
  call PGPAGE                                   ! ページを進める
  call PGSVP(0.11,0.89,0.10,0.90)               ! 枠の大きさ
  call PGSWIN(xmin_t,xmax_t,ymin_t,ymax_t)      ! 座標軸の設定
  call PGMTXT('T',0.5,0.5,0.5,title_t)          ! 図のタイトル
  call PGMTXT('B',2.5,0.5,0.5,title_x)          ! x 軸のタイトル
  call PGMTXT('L',4.0,0.5,0.5,title_y)          ! y 軸のタイトル
  call setcolor(0)                              ! カラーパレット
                                                ! (0=color,1=grey)

  ! ---- value の最大値・最小値 ----
  value_t(:,:) = value(:,:)
  threshold_low_t = threshold_low
  threshold_up_t  = threshold_up
  if (logscale_v==1) then
     do j=1,vj
        do i=1,vi
           if ( abs(value_t(i,j)) < tiny(value(i,j)) ) cycle
           value_t(i,j) = log10( value(i,j) )
        end do
     end do
     threshold_low_t = log10(threshold_low)
     threshold_up_t  = log10(threshold_up)
  end if
  if (threshold==1) then
     value_min = threshold_low_t
     value_max = threshold_up_t
  else
     min_sub(:) = minloc( value_t(:,:),abs(value_t(:,:))>tiny(value_t(:,:)) )
     max_sub(:) = maxloc( value_t(:,:) )
     value_min  = value_t(min_sub(1),min_sub(2))
     value_max  = value_t(max_sub(1),max_sub(2))
  end if

  ! ---- 塗り潰し ----
  do j=1,vj
     do i=1,vi
        l = int( 63*(value_t(i,j)-value_min)/(value_max-value_min) )+11
        if( l .gt. 74 ) l=75
        if( l .lt. 11 ) l=75
        call PGSCI(l)                     ! カラーインデックス
        x1 = (i-1) * xwidth_t + xmin_t
        x2 =  i    * xwidth_t + xmin_t
        y1 = (j-1) * ywidth_t + ymin_t
        y2 =  j    * ywidth_t + ymin_t
        call PGRECT(x1,x2,y1,y2)
     enddo
  end do

  ! ---- 軸の詳細 ----
  call PGSCI(1)
  call PGSLW(3)
  call PGSCH(1.6)
  if (logscale_x==1 .and. logscale_y==1) then
     call PGBOX('BCTSNL2',0.0,0,'BCTSNVL2',0.0,0)
  else if (logscale_x==1) then
     call PGBOX('BCTSNL2',0.0,0,'BCTSNV',0.0,0)
  else if (logscale_y==1) then
     call PGBOX('BCTSN',0.0,0,'BCTSNVL2',0.0,0)
  else
     call PGBOX('BCTSN',0.0,0,'BCTSNV',0.0,0)
  end if

  ! ---- カラーバー ----
  call PGSCH(1.0)                           ! 文字の大きさ
  call PGSVP(0.90,0.93,0.2,0.8)             ! 枠の大きさ
  call PGSWIN(0.0,0.5,value_min,value_max)  ! 座標軸の設定
  call PGMTXT('R',4.0,0.5,0.5,title_v)      ! タイトル
  do i=11,74
     y1 = value_min + real(i-11) * (value_max-value_min) / 63.0
     y2 = value_min + real(i-10) * (value_max-value_min) / 63.0
     call PGSCI(i)
     call PGRECT(0.0,0.5,y1,y2)
  enddo
  call PGSCI(1)
  if (logscale_v==1) then
     call PGBOX('BCI',0.0,0,'BCMTSVL2',0.0,0)
  else
     call PGBOX('BCI',0.0,0,'BCMTSV',0.0,0)
  end if

  ! ---- PGPLOT 用の各値を復元 ----
  call PGSCF(pcf)                               ! font 指定
  call PGSCH(pch)                               ! 文字の大きさ
  call PGSCI(pci)                               ! カラーインデックス
  call PGSLW(plw)                               ! 線の太さ
  call PGSVP(px1,px2,py1,py2)                   ! 枠の大きさ

  return
end subroutine ColorPlot
Subroutine :

カラーパレット

author :渡部 重十 (WATANABE Shigeto)

[Source]

subroutine setcolor(icg)
  !
  ! カラーパレット
  ! author :: 渡部 重十 (WATANABE Shigeto)
  !
  real*4 cr(64), cg(64), cb(64)
  real*4 gr(64), gg(64), gb(64)
  data   cr/ 0.00,0.00,0.00,0.00,0.00,0.10,0.10,0.10,0.20,0.20,              0.20,0.20,0.10,0.10,0.10,0.00,0.00,0.00,0.00,0.00,              0.00,0.00,0.00,0.00,0.10,0.20,0.30,0.40,0.50,0.60,              0.70,0.80,0.90,1.00,1.00,1.00,1.00,1.00,1.00,1.00,              1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,              1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,              1.00,1.00,1.00,1.00/
  data   cg/ 0.00,0.00,0.10,0.20,0.30,0.40,0.50,0.55,0.60,0.65,              0.70,0.90,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,              1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,1.00,              1.00,1.00,1.00,1.00,0.99,0.98,0.97,0.96,0.95,0.94,              0.93,0.92,0.91,0.90,0.88,0.86,0.83,0.80,0.75,0.70,              0.65,0.60,0.55,0.50,0.45,0.40,0.30,0.20,0.10,0.00,              0.00,0.00,0.00,0.00/
  data   cb/ 1.00,0.98,0.97,0.96,0.95,0.94,0.93,0.92,0.91,0.90,              0.88,0.86,0.84,0.82,0.80,0.75,0.70,0.60,0.50,0.40,              0.30,0.20,0.10,0.00,0.00,0.00,0.00,0.00,0.00,0.00,              0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,              0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,              0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,              0.00,0.00,0.00,0.00/
  data   gr/ 0.00,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,              0.10,0.11,0.12,0.13,0.14,0.15,0.16,0.17,0.18,0.19,              0.20,0.22,0.24,0.26,0.28,0.30,0.32,0.34,0.36,0.38,              0.40,0.42,0.44,0.46,0.48,0.50,0.52,0.54,0.56,0.58,              0.60,0.62,0.64,0.66,0.68,0.70,0.72,0.74,0.76,0.78,              0.80,0.82,0.84,0.86,0.88,0.90,0.92,0.94,0.95,0.96,              0.97,0.98,0.99,1.00/
  data   gg/ 0.00,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,              0.10,0.11,0.12,0.13,0.14,0.15,0.16,0.17,0.18,0.19,              0.20,0.22,0.24,0.26,0.28,0.30,0.32,0.34,0.36,0.38,              0.40,0.42,0.44,0.46,0.48,0.50,0.52,0.54,0.56,0.58,              0.60,0.62,0.64,0.66,0.68,0.70,0.72,0.74,0.76,0.78,              0.80,0.82,0.84,0.86,0.88,0.90,0.92,0.94,0.95,0.96,              0.97,0.98,0.99,1.00/
  data   gb/ 0.00,0.01,0.02,0.03,0.04,0.05,0.06,0.07,0.08,0.09,              0.10,0.11,0.12,0.13,0.14,0.15,0.16,0.17,0.18,0.19,              0.20,0.22,0.24,0.26,0.28,0.30,0.32,0.34,0.36,0.38,              0.40,0.42,0.44,0.46,0.48,0.50,0.52,0.54,0.56,0.58,              0.60,0.62,0.64,0.66,0.68,0.70,0.72,0.74,0.76,0.78,              0.80,0.82,0.84,0.86,0.88,0.90,0.92,0.94,0.95,0.96,              0.97,0.98,0.99,1.00/
  if( icg .eq. 0 ) then
     do i=11,74
        call pgscr(i,cr(i-10),cg(i-10),cb(i-10))
     end do
  endif
  if( icg .eq. 1 ) then
     do i=11,74
        call pgscr(i,gr(75-i),gg(75-i),gb(75-i))
     end do
  endif
  return
end subroutine setcolor

[Validate]