Class Dcl_Automatic
In: dcl_auto.f90

Dclf90 の描画を自動で行うモジュール

Methods

Included Modules

dcl

Public Instance methods

Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.

2 次元で 2 変数を等値線とカラーシェードで描画する.

[Source]

subroutine Dcl_2D_cont_shade( outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg )
  ! 2 次元で 2 変数を等値線とカラーシェードで描画する.
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS
  logical :: monoto

  nx=size(x)
  ny=size(y)

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( x(1), x(nx), y(1), y(ny) )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclScalingPoint( xg(:,i), yg(:,i) )
     end do
  end if

  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.true.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

  if(monoto.eqv..true.)then
     call DclShadeContour( shade )
  else
     call DclShadeContourEx( shade )
  end if

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclDrawLine( xg(:,i), yg(:,i) )
     end do
  end if

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
map_pro :integer, intent(in)
: DCL の地図変換関数番号
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標 [deg]
y(:) :real, intent(in)
: y 方向の格子点座標 [deg]
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.
mlitv :real, intent(in), optional
: メジャーライン, 目盛の表示間隔 [degree]. デフォルトは 1 degree.

2 次元で 2 変数を等値線とカラーシェードで描画する. 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える. 現在, xg, yg オプションは地図投影の関係上, 機能させていない.

[Source]

subroutine Dcl_2D_cont_shade_MapPro( map_pro, outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg, mlitv )
  ! 2 次元で 2 変数を等値線とカラーシェードで描画する.
  ! 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える.
  ! 現在, xg, yg オプションは地図投影の関係上, 機能させていない.
  use dcl
  implicit none
  integer, intent(in) :: map_pro  ! DCL の地図変換関数番号
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標 [deg]
  real, intent(in) :: y(:)  ! y 方向の格子点座標 [deg]
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  real, intent(in), optional :: mlitv  ! メジャーライン, 目盛の表示間隔 [degree]. デフォルトは 1 degree.
  real, parameter :: pi=3.14159265
  real, parameter :: radius=6.38e6
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: uratio
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS
  real :: map_lat_min, map_lat_max, map_lon_min, map_lon_max
  real :: mlat2dis_min, mlat2dis_max, mditv
  logical :: monoto

  nx=size(x)
  ny=size(y)

!-- 引数を rad 単位に変換
  map_lon_min=x(1)*pi/180.0
  map_lon_max=x(nx)*pi/180.0
  map_lat_min=y(1)*pi/180.0
  map_lat_max=y(ny)*pi/180.0

  mlat2dis_min=log(tan(0.25*pi+0.5*map_lat_min))
  mlat2dis_max=log(tan(0.25*pi+0.5*map_lat_max))

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

  if(present(mlitv))then
     mditv=mlitv
  else
     mditv=1.0
  end if

!-- 地図独自のオプション ---
!-- MapFit ルーチンを用いると, 地図の vp が強制的に変更されるので,
!-- その修正を行う.
!-- u 座標系でのアスペクト比をとり, 長さの長い方の vp を基準にして,
!-- 短い方の vp を修正する.
  uratio=(mlat2dis_max-mlat2dis_min)/(map_lon_max-map_lon_min)  ! u 座標系での ratio
  if( uratio>1.0 )then
  ! y 軸の方が長いので, vratio で vxmin, vxmax を 0.5 を基準に修正.
  ! 修正公式は以下のとおり : 
  ! vxmax+vxmin=1.0, vxmax-vxmin=(vymax-vymin)/uratio
  ! これをそれぞれ解くと, vymax, vymin は基準系なので引数のものを使用し,
  ! vxmax=0.5*(1.0+(vymax-vymin)/uratio)
  ! vxmin=0.5*(1.0-(vymax-vymin)/uratio)
     vx_max=0.5*(1.0+(vy_max-vy_min)/uratio)
     vx_min=0.5*(1.0-(vy_max-vy_min)/uratio)
  else
  ! x 軸の方が長いので, vratio で vymin, vymax を 0.5 を基準に修正.
  ! 修正公式は以下のとおり : 
  ! vymax+vymin=1.0, vymax-vymin=uratio*(vxmax-vxmin)
  ! これをそれぞれ解くと, vxmax, vxmin は基準系なので引数のものを使用し,
  ! vymax=0.5*(1.0+(uratio*(vxmax-vxmin))
  ! vymin=0.5*(1.0-(uratio*(vxmax-vxmin))
     vy_max=0.5*(1.0+uratio*(vx_max-vx_min))
     vy_min=0.5*(1.0-uratio*(vx_max-vx_min))
  end if

  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetParm( 'MAP:LGRIDMN', .false. )
  call DclSetParm( 'MAP:INDEXMJ', 1 )
!  call DclSetParm( 'MAP:INDEXOUT', 51 )  ! 海岸線の色設定, どうするかは再考
  call DclSetParm( 'MAP:dgridmj', mditv )

  call DclSetWindow( x(1), x(nx), y(1), y(ny) )
  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransNumber( map_pro )
  call DclFitMapParm
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  call DclSetParm( 'GRAPH:LCLIP', .true. )
!     call DclDrawViewPortFrame( 1 )
  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

  if(monoto.eqv..true.)then
     call DclShadeContour( shade )
  else
     call DclShadeContourEx( shade )
  end if

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )

  call DclDrawAxis( 'bt', mditv, 0.5*mditv )
  call DclDrawAxis( 'rl', mditv, 0.5*mditv )
!  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )
  call DclDrawMap( 'coast_world' )
  call DclDrawGlobe()

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
date :type(dcl_date), intent(in)
: 開始日付 [yyyy:mm:dd]
days :integer, intent(in)
: 描画日数 [day]
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.

2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応

[Source]

subroutine Dcl_2D_cont_shade_calendar( outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, date, days, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg )
  ! 2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  type(dcl_date), intent(in) :: date  ! 開始日付 [yyyy:mm:dd]
  integer, intent(in) :: days  ! 描画日数 [day]
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS
  logical :: monoto

  nx=size(x)
  ny=size(y)

!-- 日付が与えられているかを表示
  write(*,*) "start day is", date%year, date%month, date%day

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if
  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( 0.0, real(days), y(1), y(ny) )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclScalingPoint( xg(:,i), yg(:,i) )
     end do
  end if

  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

  if(monoto.eqv..true.)then
     call DclShadeContour( shade )
  else
     call DclShadeContourEx( shade )
  end if

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawAxisCalendar( 'bt', date, nd=days )
  call DclDrawScaledAxis( 'lr' )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclDrawLine( xg(:,i), yg(:,i) )
     end do
  end if

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
grid_point(size(x),size(y)) :real, intent(in)
: terrain following 座標
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.
trn_paint :logical, intent(in), optional
: 地形に色を塗るか. [def:.false.]
trn_col :integer, intent(in), optional
: 地形に塗る色のカラー番号
layer_line :logical, intent(in), optional
: 各層の格子線を表示する. [def:.false.]

2 次元で 2 変数を等値線とカラーシェードで描画する. terrain following 版

[Source]

subroutine Dcl_2D_cont_shade_terrain( outname, x, y, grid_point, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg, trn_paint, trn_col, layer_line )
  ! 2 次元で 2 変数を等値線とカラーシェードで描画する.
  ! terrain following 版
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(in) :: grid_point(size(x),size(y))  ! terrain following 座標
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  logical, intent(in), optional :: trn_paint  ! 地形に色を塗るか. [def:.false.]
  integer, intent(in), optional :: trn_col  ! 地形に塗る色のカラー番号
  logical, intent(in), optional :: layer_line  ! 各層の格子線を表示する. [def:.false.]
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS, interc
  logical :: monoto
  real :: cx(size(x),size(y)), cy(size(x),size(y))
  real :: trn(size(x)+2), trn_x(size(x)+2)
  real :: cxmax, cxmin, cymax, cymin
  character(10) :: val_c
  integer :: maxcy, maxcx, trn_color

  nx=size(x)
  ny=size(y)

!-- c 座標系への変換
  do j=1,ny
     do i=1,nx
        cx(i,j)=x(i)
        cy(i,j)=grid_point(i,j)
     end do
  end do

!-- c 座標系極値の計算

  cxmin=x(1)
  cxmax=x(nx)
  cymin=cy(1,1)
  cymax=cy(1,ny)
  do i=2,nx
     if(cymin>cy(i,1))then
        cymin=cy(i,1)
     end if
     if(cymax<cy(i,ny))then
        cymax=cy(i,ny)
     end if
  end do

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

!-- contour を axis の前に描くので, 下に contour interval が表示されない
!-- ようにするルーチン. contour interval は別途設定.
  call udlset('LMSG',.false.)

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( x(1), x(nx), y(1), y(ny) )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclScalingPoint( xg(:,i), yg(:,i) )
     end do
  end if

  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransNumber(51)
  call g2sctr(nx, ny, x, y, cx, cy )
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
!     call DclSetParm('ENABLE_SOFTFILL',.true.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  call uelset('ltone',.true.)

  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

!  if(monoto.eqv..true.)then
!     call DclShadeContour( shade )
!  else
     call DclShadeContour( shade )
!  end if

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  call g2qctm( cxmin, cxmax, cymin, cymax )
  call DclSetWindow( cxmin, cxmax, cymin, cymax )
  call DclSetTransNumber(1)
  call DclSetTransFunction

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

!-- 地形領域に色塗り
  if(present(trn_paint))then
     if(trn_paint.eqv..true.)then
        if(present(trn_col))then
           trn_color=trn_col
        else
           trn_color=1999
        end if
        do i=1,nx
           trn(i)=grid_point(i,1)
           trn_x(i)=x(i)
!        if(bot(i)==trn(i))then
!           call DclShadeRegion( )
!        end if
        end do
        trn(nx+1)=cymin
        trn(nx+2)=cymin
        trn_x(nx+1)=x(nx)
        trn_x(nx+2)=x(1)

        call DclShadeRegion( trn_x(1:nx+2), trn(1:nx+2), trn_color)
     end if
  end if

!  call DclSetContourLabelFormat(form_typec)
!  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
!  call DclDrawContour( contour )

  interc=DclGetContourInterval(1)
  write(*,*) interc
  write(val_c,'(E10.3)') interc

  call DclDrawTitle('b','_CONTOUR INTERVAL ='//val_c//'"',0.0,1)

  if(present(xg))then
     do i=1,size(xg,2)
        call DclDrawLine( xg(:,i), yg(:,i) )
     end do
  end if

  if(present(layer_line))then
     if(layer_line.eqv..true.)then
        do i=1,ny
           call DclDrawLine( x, grid_point(:,i) )
        end do
     end if
  end if

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
vecx(size(x),size(y)) :real, intent(inout)
: x 方向のベクトル
vecy(size(x),size(y)) :real, intent(inout)
: x 方向のベクトル
vnx :integer, intent(in)
: x 方向のベクトル格子点 (間引き使用)
vny :integer, intent(in)
: y 方向のベクトル格子点 (間引き使用)
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.
unitv :logical, intent(in), optional
: 単位ベクトルを描くかどうか. default = .true.
vfact(2) :real, intent(in), optional
: x,y 方向のスケーリングファクター この値を指定すると, 内部的に決められないので, ベクトルが格子以上に 伸びる可能性がある. 設定しない場合は, x, y の水平スケールと V 系のアスペクト比を考慮 して, vfact と一致させるようにする.
unit_fact_sign :logical, intent(in), optional
: unitv = .true. のとき, .true. = u, v の U 座標系での値を unit_fact に与えると, unit_fact はその値を単位ベクトルの単位として表示する. unit の V 座標系の値は u, v の大きい方を 0.1 として表示する.
unit_fact(2) :real, intent(in), optional
: x,y の単位ベクトルの v 座標系での長さ default = (0.1,0.1)
unit_title(2) :character(*), intent(in), optional
: x,y の単位ベクトルのタイトル default = 描かない.
unit_posi(2) :real, intent(in), optional
: 単位ベクトルを描き始める原点座標 (V 系) default = カラーバーの左端と同じで, 図の右下端から開始. カラーバーはこれにぶつからないように自動的に短くする.

2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.

[Source]

subroutine Dcl_2D_cont_shade_vec( outname, x, y, contour, shade, vecx, vecy, vnx, vny, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg, unitv, vfact, unit_fact_sign, unit_fact, unit_title, unit_posi )
  ! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する.
  ! 最大 4 変数同時描画が可能となる.
  ! 基本的に右にカラーバーがつくので, ユニットベクトルは
  ! コンターインターバルの下に文字で表示される.
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(inout) :: vecx(size(x),size(y))  ! x 方向のベクトル
  real, intent(inout) :: vecy(size(x),size(y))  ! x 方向のベクトル
  integer, intent(in) :: vnx  ! x 方向のベクトル格子点 (間引き使用)
  integer, intent(in) :: vny  ! y 方向のベクトル格子点 (間引き使用)
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  logical, intent(in), optional :: unitv  ! 単位ベクトルを描くかどうか. default = .true.
  real, intent(in), optional :: vfact(2)  ! x,y 方向のスケーリングファクター
                    ! この値を指定すると, 内部的に決められないので, ベクトルが格子以上に
                    ! 伸びる可能性がある. 
                    ! 設定しない場合は, x, y の水平スケールと V 系のアスペクト比を考慮
                    ! して, vfact と一致させるようにする.
  logical, intent(in), optional :: unit_fact_sign  ! unitv = .true. のとき,
                    ! .true. = u, v の U 座標系での値を unit_fact に与えると, 
                    ! unit_fact はその値を単位ベクトルの単位として表示する.
                    ! unit の V 座標系の値は u, v の大きい方を 0.1 として表示する.
  real, intent(in), optional :: unit_fact(2)  ! x,y の単位ベクトルの v 座標系での長さ
                                              ! default = (0.1,0.1)
  character(*), intent(in), optional :: unit_title(2)  ! x,y の単位ベクトルのタイトル
                    ! default = 描かない.
  real, intent(in), optional :: unit_posi(2)  ! 単位ベクトルを描き始める原点座標 (V 系)
                    ! default = カラーバーの左端と同じで, 図の右下端から開始.
                    ! カラーバーはこれにぶつからないように自動的に短くする.
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: factx, facty
  real, dimension(vnx,vny) :: um, vm  ! ベクトル間引き後の値を代入
  real :: vx_min, vx_max, vy_min, vy_max, vvx_min, vvx_max, vvy_min, vvy_max
  real :: unitvp(2), unitvl(2), unit_auto_fact(2)
  real :: undef, RMISS
  intrinsic :: nint
  logical :: monoto, unitvs

  nx=size(x)
  ny=size(y)

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

!-- エラー処理
  if(nx<vnx.or.ny<vny)then
     write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
     stop
  end if
  if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then
     write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2."
     stop
  end if

!-- 警告
  if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then
     write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny."
  else
     if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then
        if(mod((nx-1),(vnx-1))/=0)then
           write(*,*) "****WARNING**** : vnx is not the factor of nx."
        else
           write(*,*) "****WARNING**** : vny is not the factor of ny."
        end if
     end if
  end if

!-- ベクトル場の間引き
  factx=real(nx-1)/real(vnx-1)
  facty=real(ny-1)/real(vny-1)

!-- 起点を 1 から始める
  um(1,1)=vecx(1,1)
  vm(1,1)=vecy(1,1)

  do i=2,vnx
     um(i,1)=vecx(1+nint(factx*(i-1)),1)
     vm(i,1)=vecy(1+nint(factx*(i-1)),1)
  end do

  do j=2,vny
     um(1,j)=vecx(1,1+nint((j-1)*facty))
     vm(1,j)=vecy(1,1+nint((j-1)*facty))
  end do

  do j=2,vny
     do i=2,vnx
        um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
        vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
     end do
  end do

  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( x(1), x(nx), y(1), y(ny) )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclScalingPoint( xg(:,i), yg(:,i) )
     end do
  end if

!-- ベクトルスケールについての設定
  if(present(unit_fact_sign))then
     if(unit_fact_sign.eqv..true.)then
        if(present(unit_fact))then
           unit_auto_fact(1)=unit_fact(1)
           unit_auto_fact(2)=unit_fact(2)
        else
           write(*,*) "### ERROR ### : unit_fact_sign is .true. then,"
           write(*,*) "                unit_fact must configure."
           write(*,*) "STOP."
           stop
        end if
     else
        unit_auto_fact(1)=1.0
        unit_auto_fact(2)=1.0
     end if
  else
     unit_auto_fact(1)=1.0
     unit_auto_fact(2)=1.0
  end if

  if(present(vfact))then
     call DclSetParm( 'VECTOR:LNRMAL', .false. )
     call DclSetParm( 'VECTOR:XFACT1', vfact(1) )
     call DclSetParm( 'VECTOR:YFACT1', vfact(2) )
     unit_auto_fact(1)=unit_auto_fact(1)*vfact(1)
     unit_auto_fact(2)=unit_auto_fact(2)*vfact(2)
  else
     call DclSetParm( 'VECTOR:LNRMAL', .true.)
     call DclSetParm( 'VECTOR:XFACT1', unitvl(1) )
     call DclSetParm( 'VECTOR:YFACT1', unitvl(2) )
     unit_auto_fact(1)=unit_auto_fact(1)*unitvl(1)
     unit_auto_fact(2)=unit_auto_fact(2)*unitvl(2)
     unitvl=0.0
  end if

!-- ユニットベクトルについての設定
  if(present(unitv))then
     unitvs=unitv
  else
     unitvs=.true.
  end if

  if(unitvs.eqv..true.)then

     call DclSetParm( 'VECTOR:LUNIT', unitvs )

     !-- 単位ベクトルの長さ
     if(present(unit_fact))then
        if(present(unit_fact_sign))then
           if(unit_fact_sign.eqv..true.)then
              unitvl(:)=unit_auto_fact(:)
           else
              unitvl(:)=unit_fact(:)
           end if
        else
           unitvl(:)=unit_fact(:)
        end if
     else
        unitvl=(/0.1, 0.1/)
     end if

     !-- 単位ベクトルの書き始めの位置
     if(present(unit_posi))then
        vvx_min=unit_posi(1)
        vvy_min=unit_posi(2)
     else
        vvx_min=vx_max+0.05
        vvy_min=vy_min
     end if

     vvy_max=vvy_min+unitvl(2)+0.05

     call DclSetParm( 'VECTOR:VXUNIT', unitvl(1) )
     call DclSetParm( 'VECTOR:VYUNIT', unitvl(2) )
     call DclSetParm( 'VECTOR:VXULOC', vvx_min )
     call DclSetParm( 'VECTOR:VYULOC', vvy_min )

     !-- タイトルを書くかどうか
     if(present(unit_title))then
        call DclSetUnitVectorTitle( 'X', trim(unit_title(1)) )
        call DclSetUnitVectorTitle( 'Y', trim(unit_title(2)) )
        call DclSetParm( 'VECTOR:LUMSG', .false. )
     else  ! タイトルを書かないなら, グラフの下部にスケーリングファクターを明記
        call DclSetParm( 'VECTOR:LUMSG', .true. )
     end if

  else
     call DclSetParm( 'VECTOR:LUNIT', unitvs )
     vvx_min=0.0
     vvx_max=0.0
     vvy_min=0.0
     vvy_max=vy_min
  end if

  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

  if(monoto.eqv..true.)then
     call DclShadeContour( shade )
  else
     call DclShadeContourEx( shade )
  end if

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  call DclDrawVectors( um, vm )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclDrawLine( xg(:,i), yg(:,i) )
     end do
  end if

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vvy_max, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vvy_max, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
contour(size(x),size(y)) :real, intent(inout)
: 等値線に描く配列
shade(size(x),size(y)) :real, intent(inout)
: カラーシェードに描く配列
vecx(size(x),size(y)) :real, intent(inout)
: x 方向のベクトル
vecy(size(x),size(y)) :real, intent(inout)
: x 方向のベクトル
vnx :integer, intent(in)
: x 方向のベクトル格子点 (間引き使用)
vny :integer, intent(in)
: y 方向のベクトル格子点 (間引き使用)
cont_min :real, intent(in)
: 等値線を描く最小値
cont_max :real, intent(in)
: 等値線を描く最大値
shade_min :real, intent(in)
: シェードを描く最小値
shade_max :real, intent(in)
: シェードを描く最大値
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
date :type(dcl_date), intent(in)
: 開始日付 [yyyy:mm:dd]
days :integer, intent(in)
: 描画日数 [day]
form_typec :character(6), intent(in)
: contour 用のフォーマット
form_types :character(6), intent(in)
: shade 用のフォーマット
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
color_num :integer, intent(in), optional
: カラーの数
cont_num :integer, intent(in), optional
: 等値線の数
nongrid :character(2), intent(in), optional
: 不等間隔格子にするか. nongrid = ‘ox’ で判断. 1 文字目が横軸, 2 文字目が縦軸. o = 不等間隔, x = 等間隔. デフォルトでは ‘xx’.
xg(:,:) :real, intent(in), optional
: x 軸に入れるグリッド線の座標
yg(:,:) :real, intent(in), optional
: y 軸に入れるグリッド線の座標 第一要素が線の位置データで, 複数本描く場合は, 第二要素を 2 個以上にして描く. 配列に入れるデータ次第で直線ではなく, 曲線グリッドを 描くことも可能. 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の 線を表すように指定すること.
mono :logical, intent(in), optional
: モノトーンの階調にする [.true.] デフォルトは .false.
mono_val(:) :real, intent(in), optional
: 階調の境界値. mono=.true. のときに必ず設定しないとエラーを返す. 値は mono_lev + 1 成分存在しなければならない.
mono_lev(:) :integer, intent(in), optional
: トーンマップ番号. dcl の 3 桁 mono=.true. のときに設定しないとエラーを返す.
trigleg :character(1), intent(in), optional
: トーンバーの三角形オプション. オプションの値は, tone_bar ルーチンの trigle と同じ.

2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.

[Source]

subroutine Dcl_2D_cont_shade_vec_calendar( outname, x, y, contour, shade, vecx, vecy, vnx, vny, cont_min, cont_max, shade_min, shade_max, x_title, y_title, date, days, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg )
  ! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する.
  ! 最大 4 変数同時描画が可能となる.
  ! 基本的に右にカラーバーがつくので, ユニットベクトルは
  ! コンターインターバルの下に文字で表示される.
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(inout) :: contour(size(x),size(y))  ! 等値線に描く配列
  real, intent(inout) :: shade(size(x),size(y))  ! カラーシェードに描く配列
  real, intent(inout) :: vecx(size(x),size(y))  ! x 方向のベクトル
  real, intent(inout) :: vecy(size(x),size(y))  ! x 方向のベクトル
  integer, intent(in) :: vnx  ! x 方向のベクトル格子点 (間引き使用)
  integer, intent(in) :: vny  ! y 方向のベクトル格子点 (間引き使用)
  real, intent(in) :: cont_min  ! 等値線を描く最小値
  real, intent(in) :: cont_max  ! 等値線を描く最大値
  real, intent(in) :: shade_min  ! シェードを描く最小値
  real, intent(in) :: shade_max  ! シェードを描く最大値
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  type(dcl_date), intent(in) :: date  ! 開始日付 [yyyy:mm:dd]
  integer, intent(in) :: days  ! 描画日数 [day]
  character(6), intent(in) :: form_typec  ! contour 用のフォーマット
  character(6), intent(in) :: form_types  ! shade 用のフォーマット
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer, intent(in), optional :: color_num  ! カラーの数
  integer, intent(in), optional :: cont_num  ! 等値線の数
  character(2), intent(in), optional :: nongrid  ! 不等間隔格子にするか.
                                        ! nongrid = 'ox' で判断.
                                        ! 1 文字目が横軸, 2 文字目が縦軸.
                                        ! o = 不等間隔, x = 等間隔.
                                        ! デフォルトでは 'xx'.
  real, intent(in), optional :: xg(:,:)  ! x 軸に入れるグリッド線の座標
  real, intent(in), optional :: yg(:,:)  ! y 軸に入れるグリッド線の座標
                    ! 第一要素が線の位置データで, 複数本描く場合は,
                    ! 第二要素を 2 個以上にして描く.
                    ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
                    ! 描くことも可能.
                    ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
                    ! 線を表すように指定すること.
  logical, intent(in), optional :: mono  ! モノトーンの階調にする [.true.]
                                         ! デフォルトは .false.
  real, intent(in), optional :: mono_val(:)  ! 階調の境界値.
                    ! mono=.true. のときに必ず設定しないとエラーを返す.
                    ! 値は mono_lev + 1 成分存在しなければならない.
  integer, intent(in), optional :: mono_lev(:)  ! トーンマップ番号. dcl の 3 桁
                    ! mono=.true. のときに設定しないとエラーを返す.
  character(1), intent(in), optional :: trigleg  ! トーンバーの三角形オプション.
                ! オプションの値は, tone_bar ルーチンの trigle と同じ.
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny, s_num, c_num
  real :: factx, facty
  real, dimension(vnx,vny) :: um, vm  ! ベクトル間引き後の値を代入
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS
  logical :: monoto

  nx=size(x)
  ny=size(y)

 !-- 日付が与えられているかを表示
  write(*,*) "start day is", date%year, date%month, date%day

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

!-- エラー処理
  if(nx<vnx.or.ny<vny)then
     write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
     stop
  end if
  if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then
     write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2."
     stop
  end if

!-- 警告
  if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then
     write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny."
  else
     if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then
        if(mod((nx-1),(vnx-1))/=0)then
           write(*,*) "****WARNING**** : vnx is not the factor of nx."
        else
           write(*,*) "****WARNING**** : vny is not the factor of ny."
        end if
     end if
  end if

!-- ベクトル場の間引き
  factx=real(nx-1)/real(vnx-1)
  facty=real(ny-1)/real(vny-1)

!-- 起点を 1 から始める
  um(1,1)=vecx(1,1)
  vm(1,1)=vecy(1,1)

  do i=2,vnx
     um(i,1)=vecx(1+nint(factx*(i-1)),1)
     vm(i,1)=vecy(1+nint(factx*(i-1)),1)
  end do

  do j=2,vny
     um(1,j)=vecx(1,1+nint((j-1)*facty))
     vm(1,j)=vecy(1,1+nint((j-1)*facty))
  end do

  do j=2,vny
     do i=2,vnx
        um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
        vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
     end do
  end do

  if(present(color_num))then
     s_num=color_num
  else
     s_num=56
  end if

  if(present(cont_num))then
     c_num=cont_num
  else
     c_num=10
  end if

  if(present(mono))then
     if(present(mono_val).and.present(mono_lev))then
        if(size(mono_val)-1==size(mono_lev))then
           monoto=mono
        else
           write(*,*) "*** ERROR ***"
           write(*,*) "[array number] : mono_val = mono_lev + 1"
           write(*,*) "STOP"
           stop
        end if
     else
        write(*,*) "*** ERROR ***"
        write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified."
        write(*,*) "STOP"
        stop
     end if
  else
     monoto=.false.
  end if

!-- 処理ここまで ---

  call undef_CReSS2Dcl( nx, ny, 1, contour)
  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( 0.0, real(days), y(1), y(ny) )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclScalingPoint( xg(:,i), yg(:,i) )
     end do
  end if

  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
  call DclSetTransFunction

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclClearShadeLevel
     call DclSetShadeLevel( mono_val, mono_lev )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
!     call DclClearShadeLevel
!     call DclSetShadeLevel( shade_min, shade_max,   &
! &                          (shade_max-shade_min)/s_num )
  end if

  if(present(nongrid))then
     if(nongrid(1:1)=='o')then
        call DclSetXGrid( x )
     end if
     if(nongrid(2:2)=='o')then
        call DclSetYgrid( y )
     end if
  end if

  if(monoto.eqv..true.)then
     call DclShadeContour( shade )
  else
     call DclShadeContourEx( shade )
  end if

  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawAxisCalendar( 'bt', date, nd=days )
  call DclDrawScaledAxis( 'lr' )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

  call DclSetContourLabelFormat(form_typec)
  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num )
  call DclDrawContour( contour )

  call DclDrawVectors( um, vm )

  if(present(xg))then
     do i=1,size(xg,2)
        call DclDrawLine( xg(:,i), yg(:,i) )
     end do
  end if

  if(present(trigleg))then
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg )
  else
     call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto )
  end if

end subroutine
Subroutine :
judge :character(1), intent(in)
: グラフの種類 ‘p’ = ポイントのみ描画, ‘l’ = ラインのみ, ‘a’ = 両方描画. 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
outname :character(*), intent(in)
: グラフのタイトル
xline(:,:) :real, intent(in)
: 曲線群の x 座標
yline(size(xline,1),size(xline,2)) :real, intent(in)
: 曲線群の y 座標
xpoint(:,:) :real, intent(in)
: ポイント群の x 座標
ypoint(size(xpoint,1),size(xpoint,2)) :real, intent(in)
: ポイント群の y 座標
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
xmin :real, intent(in), optional
: x 方向のグラフ左端
xmax :real, intent(in), optional
: x 方向のグラフ右端
ymin :real, intent(in), optional
: y 方向のグラフ左端
ymax :real, intent(in), optional
: y 方向のグラフ右端

2 次元平面内において複数の曲線, ポイントで描画する. 与える曲線とポイントはそれぞれ別個の配列で定義されており, 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を 第二要素で曲線の本数を設定. ポイントについても同様. つまり, 例として以下のように配列を用意する. 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ポイントを 100 個描きたいとすると, xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) として引数に読み込ませればよい. このとき, 上の引数に対応する関係は以下のとおりである. lnum = 3, pnum = 5, lstep = 1000, pstep = 100

[Source]

subroutine Dcl_PL( judge, outname, xline, yline, xpoint, ypoint, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax )
  ! 2 次元平面内において複数の曲線, ポイントで描画する.
  ! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
  ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
  ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
  ! 第二要素で曲線の本数を設定. ポイントについても同様.
  ! つまり, 例として以下のように配列を用意する.
  ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
  ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
  ! ポイントを 100 個描きたいとすると,
  ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
  ! として引数に読み込ませればよい.
  ! このとき, 上の引数に対応する関係は以下のとおりである.
  ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
  use dcl
  implicit none
  character(1), intent(in) :: judge  ! グラフの種類
                ! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画.
                ! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: xline(:,:)  ! 曲線群の x 座標
  real, intent(in) :: yline(size(xline,1),size(xline,2))  ! 曲線群の y 座標
  real, intent(in) :: xpoint(:,:)  ! ポイント群の x 座標
  real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2))  ! ポイント群の y 座標
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  real, intent(in), optional :: xmin  ! x 方向のグラフ左端
  real, intent(in), optional :: xmax  ! x 方向のグラフ右端
  real, intent(in), optional :: ymin  ! y 方向のグラフ左端
  real, intent(in), optional :: ymax  ! y 方向のグラフ右端
  integer :: i, j, k  ! 作業用添字
  integer, parameter :: lim=990  ! ラインインデックスの最大値
  integer :: nnum, lstep, pstep, lnum, pnum
  real :: vx_min, vx_max, vy_min, vy_max

  lstep=size(xline,1)
  pstep=size(xpoint,1)
  lnum=size(xline,2)
  pnum=size(xpoint,2)

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

!-- 処理ここまで ---

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  if(present(xmin))then
     call DclSetWindow( xmin, xmax, ymin, ymax )
  else
     if(judge=='p'.or.judge=='a')then
        do i=1,pnum
           call DclScalingPoint( xpoint(:,j), ypoint(:,j) )
        end do
     end if

     if(judge=='l'.or.judge=='a')then
        do j=1,lnum
           call DclScalingPoint( xline(:,j), yline(:,j) )
        end do
     end if
     call DclFitScalingParm
  end if
  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )

  call DclSetTransFunction

 ! call DclShadeContourEx( shade )
  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
  if(judge=='p'.or.judge=='a')then
     if(pnum==1)then
        call DclDrawMarker( xpoint(:,1), ypoint(:,1) )
     else
        do i=1,pnum
           call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j )
        end do
     end if
  end if

  if(judge=='l'.or.judge=='a')then
     if(lnum==1)then
        call DclDrawLine( xline(:,1), yline(:,1) )
     else
        nnum=lim/lnum
        do j=1,lnum
           call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) )
        end do
     end if
  end if

!  call DclSetContourLabelFormat(form_typec)
!  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
!  call DclDrawContour( contour )

!  call DclDrawVectors( um, vm )

end subroutine
Subroutine :
judge :character(1), intent(in)
: グラフの種類 ‘p’ = ポイントのみ描画, ‘l’ = ラインのみ, ‘a’ = 両方描画. 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
outname :character(*), intent(in)
: グラフのタイトル
xline(:,:) :real, intent(in)
: 曲線群の x 座標
yline(size(xline,1),size(xline,2)) :real, intent(in)
: 曲線群の y 座標
xpoint(:,:) :real, intent(in)
: ポイント群の x 座標
ypoint(size(xpoint,1),size(xpoint,2)) :real, intent(in)
: ポイント群の y 座標
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
date :type(dcl_date), intent(in)
: 開始日付 [yyyy:mm:dd]
days :integer, intent(in)
: 描画日数 [day]
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値
xmin :real, intent(in), optional
: x 方向のグラフ左端
xmax :real, intent(in), optional
: x 方向のグラフ右端
ymin :real, intent(in), optional
: y 方向のグラフ左端
ymax :real, intent(in), optional
: y 方向のグラフ右端

2 次元平面内において複数の曲線, ポイントで描画する. 与える曲線とポイントはそれぞれ別個の配列で定義されており, 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を 第二要素で曲線の本数を設定. ポイントについても同様. つまり, 例として以下のように配列を用意する. 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ポイントを 100 個描きたいとすると, xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) として引数に読み込ませればよい. このとき, 上の引数に対応する関係は以下のとおりである. lnum = 3, pnum = 5, lstep = 1000, pstep = 100

[Source]

subroutine Dcl_PL_calendar( judge, outname, xline, yline, xpoint, ypoint, x_title, y_title, date, days, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax )
  ! 2 次元平面内において複数の曲線, ポイントで描画する.
  ! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
  ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
  ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
  ! 第二要素で曲線の本数を設定. ポイントについても同様.
  ! つまり, 例として以下のように配列を用意する.
  ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
  ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
  ! ポイントを 100 個描きたいとすると,
  ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
  ! として引数に読み込ませればよい.
  ! このとき, 上の引数に対応する関係は以下のとおりである.
  ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
  use dcl
  implicit none
  character(1), intent(in) :: judge  ! グラフの種類
                ! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画.
                ! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: xline(:,:)  ! 曲線群の x 座標
  real, intent(in) :: yline(size(xline,1),size(xline,2))  ! 曲線群の y 座標
  real, intent(in) :: xpoint(:,:)  ! ポイント群の x 座標
  real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2))  ! ポイント群の y 座標
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  type(dcl_date), intent(in) :: date  ! 開始日付 [yyyy:mm:dd]
  integer, intent(in) :: days  ! 描画日数 [day]
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  real, intent(in), optional :: xmin  ! x 方向のグラフ左端
  real, intent(in), optional :: xmax  ! x 方向のグラフ右端
  real, intent(in), optional :: ymin  ! y 方向のグラフ左端
  real, intent(in), optional :: ymax  ! y 方向のグラフ右端
  integer :: i, j, k  ! 作業用添字
  integer, parameter :: lim=990  ! ラインインデックスの最大値
  integer :: nnum
  integer :: lstep, pstep, lnum, pnum
  real :: vx_min, vx_max, vy_min, vy_max

  lstep=size(xline,1)
  pstep=size(xpoint,1)
  lnum=size(xline,2)
  pnum=size(xpoint,2)

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

!-- 処理ここまで ---

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  if(present(xmin))then
     call DclSetWindow( xmin, xmax, ymin, ymax )
  else
     if(judge=='p'.or.judge=='a')then
        do i=1,pnum
           call DclScalingPoint( xpoint(:,j), ypoint(:,j) )
        end do
     end if

     if(judge=='l'.or.judge=='a')then
        do j=1,lnum
           call DclScalingPoint( xline(:,j), yline(:,j) )
        end do
     end if
     call DclFitScalingParm
  end if
  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )

  call DclSetTransFunction

 ! call DclShadeContourEx( shade )
  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawAxisCalendar( 'bt', date, nd=days )
  call DclDrawScaledAxis( 'lr' )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
  if(judge=='p'.or.judge=='a')then
     if(pnum==1)then
        call DclDrawMarker( xpoint(:,1), ypoint(:,1) )
     else
        do i=1,pnum
           call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j )
        end do
     end if
  end if

  if(judge=='l'.or.judge=='a')then
     if(lnum==1)then
        call DclDrawLine( xline(:,1), yline(:,1) )
     else
        nnum=lim/lnum
        do j=1,lnum
           call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) )
        end do
     end if
  end if

!  call DclSetContourLabelFormat(form_typec)
!  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
!  call DclDrawContour( contour )

!  call DclDrawVectors( um, vm )

end subroutine
Subroutine :
outname :character(*), intent(in)
: グラフのタイトル
x(:) :real, intent(in)
: x 方向の格子点座標
y(:) :real, intent(in)
: y 方向の格子点座標
xline(:,:) :real, intent(in)
: 曲線群の x 座標
yline(size(xline,1),size(xline,2)) :real, intent(in)
: 曲線群の y 座標
xpoint(:,:) :real, intent(in)
: ポイント群の x 座標
ypoint(size(xpoint,1),size(xpoint,2)) :real, intent(in)
: ポイント群の y 座標
vecx(size(x),size(y)) :real, intent(in)
: x 方向のベクトル
vecy(size(x),size(y)) :real, intent(in)
: x 方向のベクトル
vnx :integer, intent(in)
: x 方向のベクトル格子点 (間引き使用)
vny :integer, intent(in)
: y 方向のベクトル格子点 (間引き使用)
x_title :character(*), intent(in)
: x 軸のタイトル
y_title :character(*), intent(in)
: y 軸のタイトル
viewx_min :real, intent(in), optional
: ビューポートの x 方向の最小値
viewx_max :real, intent(in), optional
: ビューポートの x 方向の最大値
viewy_min :real, intent(in), optional
: ビューポートの y 方向の最小値
viewy_max :real, intent(in), optional
: ビューポートの y 方向の最大値

2 次元平面内においてベクトルと複数の曲線, ポイントで描画する. 与える曲線とポイントはそれぞれ別個の配列で定義されており, 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を 第二要素で曲線の本数を設定. ポイントについても同様. つまり, 例として以下のように配列を用意する. 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ポイントを 100 個描きたいとすると, xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) として引数に読み込ませればよい. このとき, 上の引数に対応する関係は以下のとおりである. lnum = 3, pnum = 5, lstep = 1000, pstep = 100

[Source]

subroutine Dcl_PL_vec( outname, x, y, xline, yline, xpoint, ypoint, vecx, vecy, vnx, vny, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max )
  ! 2 次元平面内においてベクトルと複数の曲線, ポイントで描画する.
  ! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
  ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
  ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
  ! 第二要素で曲線の本数を設定. ポイントについても同様.
  ! つまり, 例として以下のように配列を用意する.
  ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
  ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
  ! ポイントを 100 個描きたいとすると,
  ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
  ! として引数に読み込ませればよい.
  ! このとき, 上の引数に対応する関係は以下のとおりである.
  ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
  use dcl
  implicit none
  character(*), intent(in) :: outname  ! グラフのタイトル
  real, intent(in) :: x(:)  ! x 方向の格子点座標
  real, intent(in) :: y(:)  ! y 方向の格子点座標
  real, intent(in) :: xline(:,:)  ! 曲線群の x 座標
  real, intent(in) :: yline(size(xline,1),size(xline,2))  ! 曲線群の y 座標
  real, intent(in) :: xpoint(:,:)  ! ポイント群の x 座標
  real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2))  ! ポイント群の y 座標
  real, intent(in) :: vecx(size(x),size(y))  ! x 方向のベクトル
  real, intent(in) :: vecy(size(x),size(y))  ! x 方向のベクトル
  integer, intent(in) :: vnx  ! x 方向のベクトル格子点 (間引き使用)
  integer, intent(in) :: vny  ! y 方向のベクトル格子点 (間引き使用)
  character(*), intent(in) :: x_title  ! x 軸のタイトル
  character(*), intent(in) :: y_title  ! y 軸のタイトル
  real, intent(in), optional :: viewx_min  ! ビューポートの x 方向の最小値
  real, intent(in), optional :: viewx_max  ! ビューポートの x 方向の最大値
  real, intent(in), optional :: viewy_min  ! ビューポートの y 方向の最小値
  real, intent(in), optional :: viewy_max  ! ビューポートの y 方向の最大値
  integer :: i, j, k  ! 作業用添字
  integer :: nx, ny
  integer :: lstep, pstep, lnum, pnum
  real :: factx, facty
  real, dimension(vnx,vny) :: um, vm  ! ベクトル間引き後の値を代入
  real :: vx_min, vx_max, vy_min, vy_max
  real :: undef, RMISS

  nx=size(x)
  ny=size(y)

  lstep=size(xline,1)
  pstep=size(xpoint,1)
  lnum=size(xline,2)
  pnum=size(xpoint,2)

!-- optional 引数の処理 ---
  if(present(viewx_min))then
     vx_min=viewx_min
  else
     vx_min=0.2
  end if

  if(present(viewx_max))then
     vx_max=viewx_max
  else
     vx_max=0.8
  end if

  if(present(viewy_min))then
     vy_min=viewy_min
  else
     vy_min=0.2
  end if

  if(present(viewy_max))then
     vy_max=viewy_max
  else
     vy_max=0.8
  end if

!-- エラー処理
  if(nx<vnx.or.ny<vny)then
     write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
     stop
  end if
!-- 警告
  if(mod(nx,(vnx-1))/=0.or.mod(ny,(vny-1))/=0)then
     write(*,*) "****WARNING**** : vnx or vny is not the factor of nx or ny."
  end if

!-- ベクトル場の間引き
  factx=real(nx)/real(vnx-1)
  facty=real(ny)/real(vny-1)

!-- 起点を 1 から始める
     um(1,1)=vecx(1,1)
     vm(1,1)=vecy(1,1)
  do i=2,vnx
     um(i,1)=vecx(int(factx*(i-1)),1)
     vm(i,1)=vecy(int(factx*(i-1)),1)
  end do
  do j=2,vny
     um(1,j)=vecx(1,int((j-1)*facty))
     vm(1,j)=vecy(1,int((j-1)*facty))
  end do

  do j=2,vny
     do i=2,vnx
        um(i,j)=vecx(int(factx*(i-1)),int(facty*(j-1)))
        vm(i,j)=vecy(int(factx*(i-1)),int(facty*(j-1)))
     end do
  end do

!-- 処理ここまで ---

!  call undef_CReSS2Dcl( nx, ny, 1, contour)
!  call undef_CReSS2Dcl( nx, ny, 1, shade)

  call UWSGXZ(.FALSE.)
  call UWSGYZ(.FALSE.)

  call DclNewFrame
  call DclSetWindow( x(1), x(nx), y(1), y(ny) )
  call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )

  call DclSetTransFunction

 ! call DclShadeContourEx( shade )
  CALL UZLSET( 'LABELYL', .TRUE. )
  CALL UZLSET( 'LABELYR', .FALSE. )
  call DclDrawScaledAxis
  call DclDrawTitle( 'b', x_title, 0.0 )
  call DclDrawTitle( 'l', y_title, 0.0 )
  call DclDrawTitle( 't', outname, 0.0, 2 )

!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
  if(pnum==1)then
     call DclDrawMarker( xpoint(:,1), yline(:,1) )
  else
     do i=1,pnum
        call DclDrawMarker( xpoint(:,j), yline(:,j), type=j )
     end do
  end if

  if(lnum==1)then
     call DclDrawLine( xline(:,1), yline(:,1) )
  else
     do j=1,lnum
        call DclDrawLine( xline(:,j), yline(:,j), index=(90+10*j+1) )
     end do
  end if

!  call DclSetContourLabelFormat(form_typec)
!  call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
!  call DclDrawContour( contour )

  call DclDrawVectors( um, vm )

end subroutine
Subroutine :
head :character(*), intent(in)
: タイトルヘッダ
time :integer, intent(in)
: 時刻
title :character(*), intent(inout)
: 生成されるタイトル
forma :character(6), intent(in), optional
: オプションとしてフォーマット
factor :integer, intent(in), optional
: time factor
unite :character(*), intent(in), optional
: unit
 時間発展する場合, 自動的にグラフのタイトルを作成する

[Source]

subroutine auto_title( head, time, title, forma, factor, unite )
!  時間発展する場合, 自動的にグラフのタイトルを作成する
  implicit none
  character(*), intent(in) :: head  ! タイトルヘッダ
  integer, intent(in) :: time  ! 時刻
  character(*), intent(inout) :: title  ! 生成されるタイトル
  character(6), intent(in), optional :: forma  ! オプションとしてフォーマット
  integer, intent(in), optional :: factor  ! time factor
  character(*), intent(in), optional :: unite  ! unit
  character(6) :: formb
  character(8) :: tmpname
  integer :: facttime, len_num

  if(present(forma))then
     formb=forma
  else
     formb='(i8.8)'
  end if

  if(present(factor))then
     facttime=time/factor
  else
     facttime=time
  end if

  write(tmpname,formb) facttime

  len_num=len_trim(tmpname)

  if(present(unite))then
     title=trim(head)//'_(t='//tmpname(1:len_num)//trim(unite)//')"'
  else
     title=trim(head)//'_(t='//tmpname(1:len_num)//'[s])"'
  end if

end subroutine
Subroutine :
x_length :real, intent(in)
: 横方向の描画距離 [m]
y_length :real, intent(in)
: 縦方向の描画距離 [m]
vx_length :real, intent(in)
: 縦方向の V 系での描画範囲
vy_length :real, intent(in)
: 横方向の V 系での描画範囲
vx_scale :real, intent(in)
: x 方向のスケーリングファクター
vy_scale :real, intent(inout)
: y 方向のスケーリングファクター

風速ベクトルを描画アスペクト比に合わせるための V 座標系における単位ベクトル を計算するルーチン. x 方向の値を指定し, そのときの y 方向のスケールを決める. 計算方法は以下のとおり. U 座標系で (uu, uv) のベクトルを V 座標系で (vu,vv) にしたい. (vu, vv)=(vx_scale*uu, vy_scale*uv) という関係をもつ. 一方, グラフの描画領域の幅を U, V 座標系でそれぞれ ux, uy, vx, vy とすると, x 方向を基準に y 方向の伸縮を決めるとき, v 座標系では, vy/vx=v_asp 倍だけ y 方向ベクトルにかけ, u 座標系では, 1/(uy/ux)=1/u_asp 倍だけ y 方向ベクトルにかけるので, (vu, vv)=(vx_scale*uu, (v_asp/u_asp)*vy_scale*vy) という関係をもてばよい. これについての詳しい概念図は Tex ファイル参照. よって, vx_scale, vy_scale が同じ比率で変化するとき, (つまり, 風速ベクトルとして変化するとき) vy_scale=vx_scale*v_asp*u_asp となる.

[Source]

subroutine calc_vscale( x_length, y_length, vx_length, vy_length, vx_scale, vy_scale )
  ! 風速ベクトルを描画アスペクト比に合わせるための V 座標系における単位ベクトル
  ! を計算するルーチン. x 方向の値を指定し, そのときの y 方向のスケールを決める.
  ! 計算方法は以下のとおり.
  ! U 座標系で (uu, uv) のベクトルを V 座標系で (vu,vv) にしたい.
  ! (vu, vv)=(vx_scale*uu, vy_scale*uv) という関係をもつ.
  ! 一方, グラフの描画領域の幅を U, V 座標系でそれぞれ ux, uy, vx, vy とすると,
  ! x 方向を基準に y 方向の伸縮を決めるとき,
  ! v 座標系では, vy/vx=v_asp 倍だけ y 方向ベクトルにかけ,
  ! u 座標系では, 1/(uy/ux)=1/u_asp 倍だけ y 方向ベクトルにかけるので,
  ! (vu, vv)=(vx_scale*uu, (v_asp/u_asp)*vy_scale*vy) という関係をもてばよい.
  ! これについての詳しい概念図は Tex ファイル参照.
  ! よって, vx_scale, vy_scale が同じ比率で変化するとき,
  ! (つまり, 風速ベクトルとして変化するとき)
  ! vy_scale=vx_scale*v_asp*u_asp となる.
  implicit none
  real, intent(in) :: x_length  ! 横方向の描画距離 [m]
  real, intent(in) :: y_length  ! 縦方向の描画距離 [m]
  real, intent(in) :: vx_length  ! 縦方向の V 系での描画範囲
  real, intent(in) :: vy_length  ! 横方向の V 系での描画範囲
  real, intent(in) :: vx_scale  ! x 方向のスケーリングファクター
  real, intent(inout) :: vy_scale  ! y 方向のスケーリングファクター
  real :: u_asp, v_asp

  u_asp=y_length/x_length
  v_asp=vy_length/vx_length

  vy_scale=(v_asp/u_asp)*vx_scale

end subroutine
Subroutine :
color_num :integer, intent(in)
: 使用するカラーの種類
val_min :real, intent(in)
: 描くカラーの最小値
val_max :real, intent(in)
: 描くカラーの最大値
col_tab :integer, intent(in), optional
: dcl のカラーテーブル
col_max :integer, intent(in), optional
: 使用するカラー番号の最大値(上2桁)
col_min :integer, intent(in), optional
: 使用するカラー番号の最小値(上2桁)
col_bg :logical, intent(in), optional
: 背景色の入れ替え デフォルトなし.
reverse :logical, intent(in), optional
: カラー番号を反転させる.
min_tab :integer, intent(in), optional
: val_min 以下の値に対応するカラー番号, デフォルトは黒
max_tab :integer, intent(in), optional
: val_max 以上の値に対応するカラー番号, デフォルトは黒

カラーマップの色と数値を対応させる自動ルーチン

[Source]

subroutine color_setting( color_num, val_min, val_max, col_tab, col_max, col_min, col_bg, reverse, min_tab, max_tab )
  ! カラーマップの色と数値を対応させる自動ルーチン
  use dcl
  implicit none
  integer, intent(in) :: color_num  ! 使用するカラーの種類
  real, intent(in) :: val_min  ! 描くカラーの最小値
  real, intent(in) :: val_max  ! 描くカラーの最大値
  integer, intent(in), optional :: col_tab  ! dcl のカラーテーブル
  integer, intent(in), optional :: col_min  ! 使用するカラー番号の最小値(上2桁)
  integer, intent(in), optional :: col_max  ! 使用するカラー番号の最大値(上2桁)
  logical, intent(in), optional :: col_bg  ! 背景色の入れ替え デフォルトなし.
  integer :: map_num  ! カラーマップのマップ番号指定 (optional 属性をつけること)
  integer :: i, j, k  ! 作業用添字
  logical, intent(in), optional :: reverse  ! カラー番号を反転させる.
  integer, intent(in), optional :: min_tab  ! val_min 以下の値に対応するカラー番号, デフォルトは黒
  integer, intent(in), optional :: max_tab  ! val_max 以上の値に対応するカラー番号, デフォルトは黒
  integer :: ipat
  real :: dv  ! カラーマップに対応する値の幅
  integer :: cmap_min, cmap_max
  real :: tlev1, tlev2
  logical :: rev
  real :: white_min, black_max
  real :: RMISS
  integer :: white, black, ITON

!-- Dcl 側の undef 値セット
   CALL GLRGET( 'RMISS', RMISS )
   CALL GLLSET( 'LMISS', .TRUE. )

  if(present(col_tab))then
     map_num=col_tab
  else
     map_num=1
  end if

  if(present(col_min))then
     cmap_min=col_min
  else
     cmap_min=14
  end if

  if(present(col_max))then
     cmap_max=col_max
  else
     cmap_max=85
  end if

  if(present(col_bg))then
     call SWpSET( 'LFGBG', col_bg )     
  end if

  if(present(reverse))then
     rev=reverse
  else
     rev=.false.
  end if

  if(present(min_tab))then
     white=min_tab
  else
     white=999
  end if

  if(present(max_tab))then
     black=max_tab
  else
     black=1999
  end if

  call sgscmn(map_num)

  call UEITLV

!-- val_max 以上を black で塗る
  TLEV1=RMISS
  TLEV2=val_min
  IPAT=white
  CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT )
!  CALL UEQTLV( TLEV1, TLEV2, IPAT, color_num+2 )
!  write(*,*) TLEV1, TLEV2, IPAT

  dv=(val_max-val_min)/color_num

  if(rev.eqv..true.)then
     do k=1,color_num
        TLEV1=val_min+(k-1)*dv
        TLEV2=TLEV1+dv
        IPAT=(cmap_min+int((color_num-k)*(real(cmap_max-cmap_min)/real(color_num-1))))*1000+999
        CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT )
!        CALL UEQTLV( TLEV1, TLEV2, IPAT, k )
!        write(*,*) TLEV1, TLEV2, IPAT
     end do
  else
     do k=1,color_num
        TLEV1=val_min+(k-1)*dv
        TLEV2=TLEV1+dv
        IPAT=(cmap_min+int((k-1)*(real(cmap_max-cmap_min)/real(color_num-1))))*1000+999
        CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT )
!        CALL UEQTLV( TLEV1, TLEV2, IPAT, k )
!        write(*,*) TLEV1, TLEV2, IPAT
     end do
  end if

  TLEV1=val_max
  TLEV2=RMISS
  IPAT=black
  CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT )
!  CALL UEQTLV( TLEV1, TLEV2, IPAT, color_num+1 )
  write(*,*) TLEV1, TLEV2, IPAT

end subroutine
Subroutine :
val_type :character(1), intent(in)
: ラベル化する変数の型 : f = 実数(オプションも指定する), i = 整数
order_num :character(1), intent(in)
: 表示する桁数
form_name :character(*), intent(out)
frac_num :character(1), intent(in), optional
: 実数指定のときのみ, 小数桁

数値ラベル用フォーマット作成ルーチン

[Source]

subroutine format_make( val_type, order_num, form_name, frac_num )  ! 数値ラベル用フォーマット作成ルーチン
  implicit none
  character(1), intent(in) :: val_type  ! ラベル化する変数の型 : f = 実数(オプションも指定する), i = 整数
  character(1), intent(in) :: order_num  ! 表示する桁数
  character(1), intent(in), optional :: frac_num  ! 実数指定のときのみ, 小数桁
  character(*), intent(out) :: form_name

  select case(val_type)
  case('f')
     form_name='('//val_type//order_num//'.'//frac_num//')'
     form_name=trim(form_name)
  case('F')
     form_name='('//val_type//order_num//'.'//frac_num//')'
     form_name=trim(form_name)
  case('i')
     form_name='('//val_type//order_num//')'
     form_name=trim(form_name)
  case('I')
     form_name='('//val_type//order_num//')'
     form_name=trim(form_name)
  end select

end subroutine format_make
Subroutine :
ton_tab :integer, intent(in), optional
: dcl のトーンテーブル
val_min :real, intent(in)
: 描くカラーの最小値
val_max :real, intent(in)
: 描くカラーの最大値
nega_ton_tab :integer, intent(in), optional
: トーンテーブルを 2 枚使うとき, 値の小さい領域に向かって濃くしていく場合に指定. このトーンを 0 から負方向に濃くしていく.
full_tone :logical, intent(in), optional
: 白を合わせると, 各トーンで 6 段階あるので, val_min, val_max の差を強制的に 6 分割してトーンを割り当てる. ただし, これをすると, トーンの境界値が切りのよい数値にならない時がある. 値は .true. で有効となる.

color_setting のモノトーンバージョン トーンテーブルは白を抜いて 5 種類しかないので, val_min, val_max を強制的に 5 分割し, トーンを当てはめる. また, nega_ton_tab が指定されていれば, 10 分割する.

[Source]

subroutine monotone_setting( ton_tab, val_min, val_max, nega_ton_tab, full_tone )
! color_setting のモノトーンバージョン
! トーンテーブルは白を抜いて 5 種類しかないので, val_min, val_max を強制的に 5 分割し, トーンを当てはめる.
! また, nega_ton_tab が指定されていれば, 10 分割する.
  use dcl
  implicit none
  integer, intent(in), optional :: ton_tab  ! dcl のトーンテーブル
  real, intent(in) :: val_min  ! 描くカラーの最小値
  real, intent(in) :: val_max  ! 描くカラーの最大値
  integer, intent(in), optional :: nega_ton_tab  ! トーンテーブルを 2 枚使うとき, 値の小さい領域に向かって濃くしていく場合に指定. このトーンを 0 から負方向に濃くしていく.
  logical, intent(in), optional :: full_tone  ! 白を合わせると, 各トーンで 6 段階あるので, val_min, val_max の差を強制的に 6 分割してトーンを割り当てる. ただし, これをすると, トーンの境界値が切りのよい数値にならない時がある. 値は .true. で有効となる.
  integer :: map_num  ! カラーマップのマップ番号指定 (optional 属性をつけること)
  integer :: i, j, k  ! 作業用添字
  integer :: ipat, itvtone, tone_mapping
  real :: dv  ! カラーマップに対応する値の幅
  integer :: cmap_min, cmap_max
  real :: tlev1, tlev2

  call UEITLV

  if(present(nega_ton_tab))then
     if(present(full_tone))then
        if(full_tone.eqv..true.)then
           itvtone=12
        else
           itvtone=10
        end if
     else
        itvtone=10
     end if
  else
     if(present(full_tone))then
        if(full_tone.eqv..true.)then
           itvtone=6
        else
           itvtone=5
        end if
     else
        itvtone=5
     end if
  end if

  dv=(val_max-val_min)/real(itvtone)

  if(itvtone==10.or.itvtone==12)then
     tone_mapping=itvtone/2
  else
     tone_mapping=itvtone
  end if

  if(itvtone==tone_mapping)then
     do k=1,tone_mapping
        TLEV1=val_min+(k-1)*dv
        TLEV2=TLEV1+dv
        IPAT=100*ton_tab+k
        CALL UESTLV( TLEV1, TLEV2, IPAT )
     end do
  else
     do k=1,tone_mapping
        TLEV1=0.5*(val_max+val_min)+(k-1)*dv
        TLEV2=TLEV1+dv
        IPAT=100*ton_tab+k
        CALL UESTLV( TLEV1, TLEV2, IPAT )
write(*,*) "tlev", tlev1, tlev2
     end do
     do k=1,tone_mapping
        TLEV1=0.5*(val_max+val_min)-k*dv
        TLEV2=TLEV1+dv
        IPAT=100*nega_ton_tab+k
        CALL UESTLV( TLEV1, TLEV2, IPAT )
write(*,*) "bgtlev", tlev1, tlev2
     end do
  end if


end subroutine
Subroutine :
color_num :integer, intent(in)
: 使用する色の数
shade_min :real, intent(in)
: 最小値
shade_max :real, intent(in)
: 最大値
vx_min :real, intent(in)
: ビューポートの x 方向の最小値
vx_max :real, intent(in)
: ビューポートの x 方向の最大値
vy_min :real, intent(in)
: ビューポートの y 方向の最小値
vy_max :real, intent(in)
: ビューポートの y 方向の最大値
form_types :character(6), intent(in)
: ラベルフォーマット
mono_log :logical, intent(in), optional
trigle :character(1), intent(in), optional
: grads 風な三角形を出すかどうか
u
= 上だけ, [d] = 下だけ, [a] = 両方, デフォルトでは描かない
tricmin :integer, intent(in), optional
: 下端三角に描くカラーマップ番号 5 桁
tricmax :integer, intent(in), optional
: 上端三角に描くカラーマップ番号 5 桁 これらの色は設定されていなければ, color_setting でセットされている色を使うようにする.
trifact :real, intent(in), optional
: 三角形の高さ (横辺と同じ長さを 1 としてその factor 倍する比率. デフォルトは 1.) !!!!!!!!!!!!!!!!!!!!!!!!!!! 以下2つは改めて復活
 integer, intent(in), optional :: col_mem_num  ! バーの目盛の数. デフォは 10本.
 real, intent(in), optional :: col_mem_int(col_mem_num)  ! 目盛の値を指定する. 配列数は col_mem_num に一致.

 &                  tricmin, tricmax, trifact, col_mem_num, col_mem_int )

右にトーンバーを自動生成する

[Source]

subroutine tone_bar( color_num, shade_min, shade_max, vx_min, vx_max, vy_min, vy_max, form_types, mono_log, trigle, tricmin, tricmax, trifact )
!  &                  tricmin, tricmax, trifact, col_mem_num, col_mem_int )
  ! 右にトーンバーを自動生成する
  use dcl
  implicit none
  integer, intent(in) :: color_num  ! 使用する色の数
  real, intent(in) :: shade_min  ! 最小値
  real, intent(in) :: shade_max  ! 最大値
  real, intent(in) :: vx_min  ! ビューポートの x 方向の最小値
  real, intent(in) :: vx_max  ! ビューポートの x 方向の最大値
  real, intent(in) :: vy_min  ! ビューポートの y 方向の最小値
  real, intent(in) :: vy_max  ! ビューポートの y 方向の最大値
  character(6), intent(in) :: form_types  ! ラベルフォーマット
  logical, intent(in), optional :: mono_log
  character(1), intent(in), optional :: trigle  ! grads 風な三角形を出すかどうか
                ! [u] = 上だけ, [d] = 下だけ, [a] = 両方, デフォルトでは描かない
  integer, intent(in), optional :: tricmin  ! 下端三角に描くカラーマップ番号 5 桁
  integer, intent(in), optional :: tricmax  ! 上端三角に描くカラーマップ番号 5 桁
                ! これらの色は設定されていなければ, color_setting でセットされている色を使うようにする.
  real, intent(in), optional :: trifact  ! 三角形の高さ (横辺と同じ長さを 1 としてその factor 倍する比率. デフォルトは 1.)
!!!!!!!!!!!!!!!!!!!!!!!!!!!! 以下2つは改めて復活
!  integer, intent(in), optional :: col_mem_num  ! バーの目盛の数. デフォは 10本.
!  real, intent(in), optional :: col_mem_int(col_mem_num)  ! 目盛の値を指定する. 配列数は col_mem_num に一致.
  real, parameter :: RMISS=999.0
  integer :: k
  real :: pi(2,color_num+1)
  real :: dp
  real, allocatable :: coldim1(:), coldim2(:)
!  real :: coldim1(color_num+1), coldim2(color_num/2+1)
  logical :: monoto  ! モノトーンの処理
  real, dimension(3) :: triux, triuy, tridx, tridy
  real :: factoru, clev1, clev2
  integer :: tricmin_num, tricmax_num
          ! 多角形領域の指定では, 三角形の頂点位置座標がわかればよいので,
          ! 各座標配列は 3 つ必要
  real :: vpx_min, vpx_max, vpy_min, vpy_max  ! 実際にとる viewport, trigle 用バッファ.
  integer :: memori_num

!-- オプションの処理
  if(present(mono_log))then
     monoto=mono_log
  else
     monoto=.false.
  end if

  if(present(trigle))then
     if(present(trifact))then
        factoru=trifact
     else
        factoru=1.0
     end if

     if(present(tricmin))then
        tricmin_num=tricmin
     else
        CALL DclGetShadeLevel( 1, clev1, clev2, tricmin_num )
        write(*,*) "### downer color is", tricmin_num
     end if

     if(present(tricmax))then
        tricmax_num=tricmax
     else
        CALL DclGetShadeLevel( color_num+2, clev1, clev2, tricmax_num )
        write(*,*) "### upper color is", tricmax_num
     end if

     select case(trigle)
     case('a')
        triux(1)=vx_min
        triux(2)=(vx_max+vx_min)*0.5
        triux(3)=vx_max
        triuy(1)=vy_max-factoru*(vx_max-vx_min)
        triuy(2)=vy_max
        triuy(3)=triuy(1)
        tridx=triux
        tridy(1)=vy_min+factoru*(vx_max-vx_min)
        tridy(2)=vy_min
        tridy(3)=tridy(1)
        vpy_min=tridy(1)
        vpy_max=triuy(1)
     case('u')
        triux(1)=vx_min
        triux(2)=(vx_max+vx_min)*0.5
        triux(3)=vx_max
        triuy(1)=vy_max
        triuy(2)=vy_max+factoru*(vx_max-vx_min)
        triuy(3)=triuy(1)
        vpy_min=vy_min
        vpy_max=triuy(1)
     case('d')
        tridx(1)=vx_min
        tridx(2)=(vx_max+vx_min)*0.5
        tridx(3)=vx_max
        tridy(1)=vy_min
        tridy(2)=vy_min-factoru*(vx_max-vx_min)
        tridy(3)=tridy(1)
        vpy_min=tridy(1)
        vpy_max=vy_max
     end select

     vpx_min=vx_min
     vpx_max=vx_max

  else

     vpx_min=vx_min
     vpx_max=vx_max
     vpy_min=vy_min
     vpy_max=vy_max

  end if

!-- 処理ここまで

  call GRFIG
  call DclSetWindow( 0.0, 1.0, shade_min, shade_max )
  call DclSetViewPort( vpx_min, vpx_max, vpy_min, vpy_max )
  call GRSTRN(1)
  call DclSetTransFunction

  dp = (shade_max-shade_min)/color_num

  do k=1,color_num+1
     PI(1,K) = shade_min + (K-1)*DP
     PI(2,K) = shade_min + (K-1)*DP
  end do

!-- トーンの目盛を描くための配列を調整.
!-- デフォルトは 10 本
!-- ここの if 文はよく再考

 ! if(present(col_mem_num))then
 !    if(present(col_mem_int))then
 !       allocate(coldim1(col_mem_num))
 !       allocate(coldim2(col_mem_num/2))
 !       do k=1,col_mem_num
 !          coldim1(k)=col_mem_num(k)
 !       end do
 !       do k=1,col_mem_num/2
 !          coldim1(k)=col_mem_num(2*k-1)
 !       end do
 !       do k=1,col_mem_num+1
 !          coldim1(k)=PI(1,k)
 !       end do
 !       do k=1,col_mem_num/2+1
 !          coldim2(k)=PI(1,2*k-1)
 !       end do
 !    else
 !       do k=1,col_mem_num+1
 !          coldim1(k)=PI(1,k)
 !       end do
 !       do k=1,col_mem_num/2+1
 !          coldim2(k)=PI(1,2*k-1)
 !       end do
 !    end if
 ! else
     do k=1,color_num+1
        coldim1(k)=PI(1,k)
     end do
     do k=1,color_num/2+1
        coldim2(k)=PI(1,2*k-1)
     end do
 ! end if


  call DclSetXGrid( (/0.0,1.0/) )
  call DclSetYGrid( PI(1,:) )

  if(monoto.eqv..true.)then
     call DclSetParm('ENABLE_SOFTFILL',.true.)
     call DclShadeContour( PI )
  else
     call DclSetParm('ENABLE_SOFTFILL',.false.)
     call DclShadeContourEx( PI )
  end if

  CALL SLPVPR( 3 )
  CALL UZLSET( 'LABELYR', .TRUE. )
  CALL UZLSET( 'LABELYL', .FALSE. )
  CALL UYSFMT( form_types )
  CALL UYAXNM( 'R', coldim1, color_num+1, coldim2, color_num/2+1 )
  CALL UYAXNM( 'L', coldim1, color_num+1, coldim2, color_num/2+1 )

!-- 実際に三角形領域を描く
  if(present(trigle))then
     select case(trigle)
     case('a')
        call DclShadeRegionNormalized( triux, triuy, tricmax_num )
        call DclShadeRegionNormalized( tridx, tridy, tricmin_num )
        call DclDrawLineNormalized( triux, triuy, index=13 )
        call DclDrawLineNormalized( tridx, tridy, index=13 )
     case('u')
        call DclShadeRegionNormalized( triux, triuy, tricmax_num )
        call DclDrawLineNormalized( triux, triuy, index=13 )
     case('d')
        call DclShadeRegionNormalized( tridx, tridy, tricmin_num )
        call DclDrawLineNormalized( tridx, tridy, index=13 )
     end select
  end if

  deallocate(coldim1)
  deallocate(coldim2)

!  CALL UYAXDV( 'R', (shade_max-shade_min)/real(color_num), (shade_max-shade_min)/real(0.5*color_num) )
!  CALL UYAXDV( 'L', (shade_max-shade_min)/real(color_num), (shade_max-shade_min)/real(0.5*color_num) )

end subroutine
Subroutine :
nx :integer, intent(in)
: 第 1 要素の要素数
ny :integer, intent(in)
: 第 2 要素の要素数
nz :integer, intent(in)
: 第 3 要素の要素数
val(nx,ny,nz) :real, intent(inout)
: 変換する配列

CReSS の未定義値を Dcl の未定義値に変換するルーチン 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで, 1, 2 次元の配列に対しても変換可能.

[Source]

subroutine undef_CReSS2Dcl( nx, ny, nz, val )  ! CReSS の未定義値を Dcl の未定義値に変換するルーチン
  ! 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで,
  ! 1, 2 次元の配列に対しても変換可能.
  use dcl
  implicit none
  integer, intent(in) :: nx  ! 第 1 要素の要素数
  integer, intent(in) :: ny  ! 第 2 要素の要素数
  integer, intent(in) :: nz  ! 第 3 要素の要素数
  real, intent(inout) :: val(nx,ny,nz)  ! 変換する配列
  integer :: i, j, k  ! 作業用配列
  real :: RMISS, undef  ! 各未定義値

!-- 欠損値処理 ---
!-- Dcl 側の undef 値セット
      CALL GLRGET( 'RMISS', RMISS )
      CALL GLLSET( 'LMISS', .TRUE. )

!-- CReSS 側の undef 値セット
      call undef_get( undef )
!write(*,*) "undef=", undef

  do k=1,nz
  do j=1,ny
     do i=1,nx
        if(val(i,j,k)==undef)then
           val(i,j,k)=RMISS
        end if
     end do
  end do
  end do
    

end subroutine
Subroutine :
undef :real, intent(inout)
: 未定義値

CReSS のデフォルトの未定義値を取得するルーチン

[Source]

subroutine undef_get( undef )  ! CReSS のデフォルトの未定義値を取得するルーチン
  implicit none
  real, intent(inout) :: undef  ! 未定義値

  undef = -1.0e+35

end subroutine