| Class | Dcl_Automatic |
| In: |
dcl_auto.f90
|
Dclf90 の描画を自動で行うモジュール
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する.
subroutine Dcl_2D_cont_shade( outname, x, y, contour, shade, cont_int, shade_int, axis_title, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, no_tone, no_frame, l_idx )
! 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_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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 :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: undef, RMISS
logical :: monoto, no_tone_flag, no_frame_flag
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
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) )
write(*,*) "grid point"
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 DclDrawScaledAxis
call DclDrawTitle( 'b', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
call DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| map_pro : | integer, intent(in)
| ||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| mlitv : | real, intent(in), optional
| ||
| coast : | character(5), intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する. 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える.
subroutine Dcl_2D_cont_shade_MapPro( map_pro, outname, x, y, contour, shade, cont_int, shade_int, axis_title, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, mlitv, coast, no_tone, no_frame, l_idx )
! 2 次元で 2 変数を等値線とカラーシェードで描画する.
! 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える.
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_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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.
character(5), intent(in), optional :: coast ! 海岸線選択引数
! ['japan'] = 日本域詳細版
! ['world'] = 全球版
! default = 'world'
logical, intent(in), optional :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
real, parameter :: pi=3.14159265
real, parameter :: radius=6.38e6
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: uratio
real :: undef, RMISS
real :: map_lat_min, map_lat_max, map_lon_min, map_lon_max
real :: mlat2dis_min, mlat2dis_max, mditv
logical :: monoto, no_tone_flag, no_frame_flag
character(20) :: coast_sel
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_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
!-- 地図独自のオプション ---
!-- 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(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
if(present(mlitv))then
mditv=mlitv
else
mditv=1.0
end if
if(present(coast))then
coast_sel='coast_'//coast
else
coast_sel='coast_world'
end if
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
call DclSetParm( 'MAP:LGRIDMN', .false. )
call DclSetParm( 'MAP:INDEXMJ', 1 )
call DclSetParm( 'MAP:dgridmj', mditv )
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( 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', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
call DclDrawMap( trim(coast_sel) )
call DclDrawGlobe()
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
call DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応
subroutine Dcl_2D_cont_shade_calendar( outname, x, y, contour, shade, cont_int, shade_int, axis_title, date, days, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, no_tone, no_frame, l_idx )
! 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_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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 :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: undef, RMISS
logical :: monoto, no_tone_flag, no_frame_flag
nx=size(x)
ny=size(y)
!-- 日付が与えられているかを表示
write(*,*) "start day is", date%year, date%month, date%day
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
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', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
call DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| rg(:,:) : | real, intent(in), optional
| ||
| tg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
| ||
| r_idx(size(rg,2)) : | integer, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する.
subroutine Dcl_2D_cont_shade_polar( outname, x, y, contour, shade, cont_int, shade_int, axis_title, form_type, viewx_int, viewy_int, c_num, xg, yg, rg, tg, mono, mono_val, mono_lev, trigleg, no_tone, no_frame, l_idx, r_idx )
! 2 次元で 2 変数を等値線とカラーシェードで描画する.
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! 動径方向の格子点座標
real, intent(in) :: y(:) ! 同位角方向の格子点座標 [degree]
real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列
real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列
real, intent(in) :: cont_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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 本の
! 線を表すように指定すること.
real, intent(in), optional :: rg(:,:) ! 極座標系における r 軸に入れるグリッド線の座標
real, intent(in), optional :: tg(:,:) ! 極座標系における theta 軸に入れるグリッド線の座標
! これらのデータの与え方は xg, yg と同様.
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 :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
integer, intent(in), optional :: r_idx(size(rg,2)) ! rg, tg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: undef, RMISS
logical :: monoto, no_tone_flag, no_frame_flag
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
if(present(rg))then
do i=1,size(rg,2)
call DclScalingPoint( rg(:,i), tg(:,i) )
end do
end if
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call SGSSIM( 0.5*(vx_max-vx_min)/x(nx), 0.0, 0.0 )
call DclSetTransNumber(5) ! 極座標変換
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 DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
if(present(rg))then
do i=1,size(rg,2)
if(present(r_idx))then
call DclDrawLine( rg(:,i), tg(:,i), index=r_idx(i) )
else
call DclDrawLine( rg(:,i), tg(:,i), index=1 )
end if
end do
end if
!-- 以上で極座標描画終了
!-- 以下, デカルト系で再変換
CALL GRFIG
call DclSetWindow( -x(nx), x(nx), -x(nx), x(nx) )
if(present(xg))then
do i=1,size(xg,2)
call DclScalingPoint( xg(:,i), yg(:,i) )
write(*,*) "grid point"
end do
end if
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransNumber(1) ! デカルト座標変換
call DclSetTransFunction
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| grid_point(size(x),size(y)) : | real, intent(inout)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| trn_paint : | logical, intent(in), optional
| ||
| trn_col : | integer, intent(in), optional
| ||
| layer_line : | logical, intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する. terrain following 版
subroutine Dcl_2D_cont_shade_terrain( outname, x, y, grid_point, contour, shade, cont_int, shade_int, axis_title, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, trn_paint, trn_col, layer_line, no_tone, no_frame, l_idx )
! 2 次元で 2 変数を等値線とカラーシェードで描画する.
! terrain following 版
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
real, intent(inout) :: 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_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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.]
logical, intent(in), optional :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: undef, RMISS, interc
logical :: monoto, no_tone_flag, no_frame_flag
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_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
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(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_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', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(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)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
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(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| vecx(size(x),size(y)) : | real, intent(inout)
| ||
| vecy(size(x),size(y)) : | real, intent(inout)
| ||
| vn(2) : | integer, intent(in)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| unitv : | logical, intent(in), optional
| ||
| vfact(2) : | real, intent(in), optional
| ||
| unit_fact_sign : | logical, intent(in), optional
| ||
| unit_fact(2) : | real, intent(in), optional
| ||
| unit_title(2) : | character(*), intent(in), optional
| ||
| unit_posi(2) : | real, intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.
subroutine Dcl_2D_cont_shade_vec( outname, x, y, contour, shade, vecx, vecy, vn, cont_int, shade_int, axis_title, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, unitv, vfact, unit_fact_sign, unit_fact, unit_title, unit_posi, no_tone, no_frame, l_idx )
! 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) :: vn(2) ! ベクトル格子点 (間引き使用)
! vn(1)=vnx, vn(2)=vny
real, intent(in) :: cont_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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 = カラーバーの左端と同じで, 図の右下端から開始.
! カラーバーはこれにぶつからないように自動的に短くする.
logical, intent(in), optional :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
integer :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer :: vny ! y 方向のベクトル格子点 (間引き使用)
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: factx, facty
real, dimension(size(x),size(y)) :: um, vm ! ベクトル間引き後の値を代入
real :: 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, no_tone_flag, no_frame_flag
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
vnx=vn(1)
vny=vn(2)
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
!-- エラー処理
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)
um=0.0
vm=0.0
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(1+nint(factx*(i-1)),1)=vecx(1+nint(factx*(i-1)),1)
vm(1+nint(factx*(i-1)),1)=vecy(1+nint(factx*(i-1)),1)
end do
do j=2,vny
um(1,1+nint((j-1)*facty))=vecx(1,1+nint((j-1)*facty))
vm(1,1+nint((j-1)*facty))=vecy(1,1+nint((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
vm(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
end do
end do
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
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', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
call DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
call DclDrawVectors( um, vm )
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
!-- 単位ベクトルの表記を考え, vvy_max がトーンバーの下端
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vvy_max, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vvy_max, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| contour(size(x),size(y)) : | real, intent(inout)
| ||
| shade(size(x),size(y)) : | real, intent(inout)
| ||
| vecx(size(x),size(y)) : | real, intent(inout)
| ||
| vecy(size(x),size(y)) : | real, intent(inout)
| ||
| vn(2) : | integer, intent(in)
| ||
| cont_int(2) : | real, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| form_type(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| c_num(2) : | integer, intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
| ||
| mono : | logical, intent(in), optional
| ||
| mono_val(:) : | real, intent(in), optional
| ||
| mono_lev(:) : | integer, intent(in), optional
| ||
| trigleg : | character(1), intent(in), optional
| ||
| unitv : | logical, intent(in), optional
| ||
| vfact(2) : | real, intent(in), optional
| ||
| unit_fact_sign : | logical, intent(in), optional
| ||
| unit_fact(2) : | real, intent(in), optional
| ||
| unit_title(2) : | character(*), intent(in), optional
| ||
| unit_posi(2) : | real, intent(in), optional
| ||
| no_tone : | logical, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| l_idx(size(xg,2)) : | integer, intent(in), optional
|
2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.
subroutine Dcl_2D_cont_shade_vec_calendar( outname, x, y, contour, shade, vecx, vecy, vn, cont_int, shade_int, axis_title, date, days, form_type, viewx_int, viewy_int, c_num, xg, yg, mono, mono_val, mono_lev, trigleg, unitv, vfact, unit_fact_sign, unit_fact, unit_title, unit_posi, no_tone, no_frame, l_idx )
! 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) :: vn(2) ! ベクトル格子点 (間引き使用)
! vn(1)=vnx, vn(2)=vny
real, intent(in) :: cont_int(2) ! 等値線の上下端
! [cont_int(1)=cont_min, cont_int(2)=cont_max]
real, intent(in) :: shade_int(2) ! 等値線の上下端 [shade_int(1)=shade_min,
! shade_int(2)=shade_max]
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title, axis_title(2)=y_title
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
character(*), intent(in) :: form_type(2) ! フォーマット
! form_type(1)=form_typec, form_type(2)=form_types
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
integer, intent(in), optional :: c_num(2) ! コンター・シェードの数
! c_num(1)=cont_num, c_num(2)=color_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 = カラーバーの左端と同じで, 図の右下端から開始.
! カラーバーはこれにぶつからないように自動的に短くする.
logical, intent(in), optional :: no_tone ! トーンバーを作成しないオプション
! .false. = 作成する. .true. = 作成しない.
! デフォルトは .false.
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
integer, intent(in), optional :: l_idx(size(xg,2)) ! xg, yg で描く線のインデックス
! デフォルトは 1.
!-- 以上, 引数
integer :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer :: vny ! y 方向のベクトル格子点 (間引き使用)
real :: cont_min ! 等値線を描く最小値
real :: cont_max ! 等値線を描く最大値
real :: shade_min ! シェードを描く最小値
real :: shade_max ! シェードを描く最大値
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
character(10) :: form_typec ! contour 用のフォーマット
character(10) :: form_types ! shade 用のフォーマット
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
integer :: cont_num ! 等値線の数
integer :: color_num ! カラーの数
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: factx, facty
real, dimension(size(x),size(y)) :: um, vm ! ベクトル間引き後の値を代入
real :: 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, no_tone_flag, no_frame_flag
nx=size(x)
ny=size(y)
!-- 日付が与えられているかを表示
write(*,*) "start day is", date%year, date%month, date%day
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(c_num))then
cont_num=c_num(1)
color_num=c_num(2)
else
cont_num=10
color_num=56
end if
if(present(no_tone))then
no_tone_flag=no_tone
else
no_tone_flag=.false.
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
vnx=vn(1)
vny=vn(2)
cont_min=cont_int(1)
cont_max=cont_int(2)
shade_min=shade_int(1)
shade_max=shade_int(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
form_typec=trim(form_type(1))
form_types=trim(form_type(2))
!-- エラー処理
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)
um=0.0
vm=0.0
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(1+nint(factx*(i-1)),1)=vecx(1+nint(factx*(i-1)),1)
vm(1+nint(factx*(i-1)),1)=vecy(1+nint(factx*(i-1)),1)
end do
do j=2,vny
um(1,1+nint((j-1)*facty))=vecx(1,1+nint((j-1)*facty))
vm(1,1+nint((j-1)*facty))=vecy(1,1+nint((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
vm(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
end do
end do
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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
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
!-- ベクトルスケールについての設定
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:VYUNIT', 0.0 ) ! y 方向には書かない
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 DclDrawAxisCalendar( 'bt', date, nd=days )
call DclDrawScaledAxis( 'lr' )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(outname), 0.0, 2 )
call DclSetContourLabelFormat(trim(form_typec))
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
call DclDrawContour( contour )
call DclDrawVectors( um, vm )
if(present(xg))then
do i=1,size(xg,2)
if(present(l_idx))then
call DclDrawLine( xg(:,i), yg(:,i), index=l_idx(i) )
else
call DclDrawLine( xg(:,i), yg(:,i), index=1 )
end if
end do
end if
if(no_tone_flag.eqv..false.)then
if(present(trigleg))then
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min+0.05, vy_max/), trim(form_types), mono_log=monoto, trigle=trigleg )
else
call tone_bar( color_num, (/shade_min, shade_max/), (/vx_max+0.05, vx_max+0.075/), (/vy_min+0.05, vy_max/), trim(form_types), mono_log=monoto )
end if
end if
end subroutine
| Subroutine : | |||
| judge : | character(1), intent(in)
| ||
| outname : | character(*), intent(in)
| ||
| xline(:,:) : | real, intent(in)
| ||
| yline(size(xline,1),size(xline,2)) : | real, intent(in)
| ||
| xpoint(:,:) : | real, intent(in)
| ||
| ypoint(size(xpoint,1),size(xpoint,2)) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| x_int(2) : | real, intent(in), optional
| ||
| y_int(2) : | real, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| xylog(2) : | logical, intent(in), optional
|
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
subroutine Dcl_PL( judge, outname, xline, yline, xpoint, ypoint, axis_title, viewx_int, viewy_int, x_int, y_int, no_frame, xylog )
! 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) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title,axis_title(2)=y_title
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
real, intent(in), optional :: x_int(2) ! x 方向のグラフ両端
! x_int(1)=xmin, x_int(2)=xmax
real, intent(in), optional :: y_int(2) ! y 方向のグラフ両端
! y_int(1)=ymin, y_int(2)=ymax
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
logical, intent(in), optional :: xylog(2) ! 対数スケールで軸を書くフラグ.
! .true. で描く, default はどちらも .false.
!-- 以上, 引数
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer, parameter :: lim=890 ! ラインインデックスの最大値
integer :: nnum, lstep, pstep, lnum, pnum
integer :: trans_num
logical :: no_frame_flag
logical :: xlogf, ylogf
lstep=size(xline,1)
pstep=size(xpoint,1)
lnum=size(xline,2)
pnum=size(xpoint,2)
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
if(present(xylog))then
xlogf=xylog(1)
ylogf=xylog(2)
else
xlogf=.false.
ylogf=.false.
end if
!-- 引数の置き換え用変数に置き換え
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
!-- 処理ここまで ---
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
if(present(x_int).and.present(y_int))then
call DclSetWindow( x_int(1), x_int(2), y_int(1), y_int(2) )
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 )
if(xlogf.eqv..true.)then
if(ylogf.eqv..true.)then
trans_num=4
else
trans_num=3
end if
else
if(ylogf.eqv..true.)then
trans_num=2
else
trans_num=1
end if
end if
call DclSetTransNumber(trans_num)
call DclSetTransFunction
! call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(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 j=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)
| ||
| outname : | character(*), intent(in)
| ||
| xline(:,:) : | real, intent(in)
| ||
| yline(size(xline,1),size(xline,2)) : | real, intent(in)
| ||
| xpoint(:,:) : | real, intent(in)
| ||
| ypoint(size(xpoint,1),size(xpoint,2)) : | real, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| x_int(2) : | real, intent(in), optional
| ||
| y_int(2) : | real, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
|
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
subroutine Dcl_PL_calendar( judge, outname, xline, yline, xpoint, ypoint, axis_title, date, days, viewx_int, viewy_int, x_int, y_int, no_frame )
! 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) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title,axis_title(2)=y_title
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
real, intent(in), optional :: x_int(2) ! x 方向のグラフ両端
! x_int(1)=xmin, x_int(2)=xmax
real, intent(in), optional :: y_int(2) ! y 方向のグラフ両端
! y_int(1)=ymin, y_int(2)=ymax
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
!-- 以上, 引数
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer, parameter :: lim=890 ! ラインインデックスの最大値
integer :: nnum
integer :: lstep, pstep, lnum, pnum
logical :: no_frame_flag
lstep=size(xline,1)
pstep=size(xpoint,1)
lnum=size(xline,2)
pnum=size(xpoint,2)
!-- optional 引数の処理 ---
if(present(viewx_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
!-- 引数の置き換え用変数に置き換え
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
!-- 処理ここまで ---
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
if(present(x_int).and.present(y_int))then
call DclSetWindow( x_int(1), x_int(2), y_int(1), y_int(2) )
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', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(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)
| ||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| xline(:,:) : | real, intent(in)
| ||
| yline(size(xline,1),size(xline,2)) : | real, intent(in)
| ||
| xpoint(:,:) : | real, intent(in)
| ||
| ypoint(size(xpoint,1),size(xpoint,2)) : | real, intent(in)
| ||
| vecx(size(x),size(y)) : | real, intent(in)
| ||
| vecy(size(x),size(y)) : | real, intent(in)
| ||
| vn(2) : | integer, intent(in)
| ||
| axis_title(2) : | character(*), intent(in)
| ||
| viewx_int(2) : | real, intent(in), optional
| ||
| viewy_int(2) : | real, intent(in), optional
| ||
| no_frame : | logical, intent(in), optional
| ||
| xylog(2) : | logical, intent(in), optional
|
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
subroutine Dcl_PL_vec( judge, outname, x, y, xline, yline, xpoint, ypoint, vecx, vecy, vn, axis_title, viewx_int, viewy_int, no_frame, xylog )
! 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) :: 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) :: vn(2) ! ベクトル格子点 (間引き使用)
! vn(1)=vnx, vn(2)=vny
character(*), intent(in) :: axis_title(2) ! 座標軸のタイトル
! axis_title(1)=x_title,axis_title(2)=y_title
real, intent(in), optional :: viewx_int(2) ! ビューポートの x 方向の両端
! viewx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in), optional :: viewy_int(2) ! ビューポートの y 方向の両端
! viewy_int(1)=vy_min, vy_int(2)=vy_max
logical, intent(in), optional :: no_frame ! NewFrame を呼ばない
! .false. = 呼ぶ. .true. = 呼ばずに NewFig.
! デフォルトは .false.
logical, intent(in), optional :: xylog(2) ! 対数スケールで軸を書くフラグ.
! .true. で描く, default はどちらも .false.
!-- 以上, 引数
integer :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer :: vny ! y 方向のベクトル格子点 (間引き使用)
character(100) :: x_title ! x 軸のタイトル
character(100) :: y_title ! y 軸のタイトル
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
!-- 以上, 引数の置き換え用変数
integer :: i, j, k ! 作業用添字
integer :: nx, ny
integer, parameter :: lim=890
integer :: lstep, pstep, lnum, pnum, nnum
integer :: trans_num
real :: factx, facty
real, dimension(size(x),size(y)) :: um, vm ! ベクトル間引き後の値を代入
real :: undef, RMISS
logical :: no_frame_flag
logical :: xlogf, ylogf
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_int))then
vx_min=viewx_int(1)
vx_max=viewx_int(2)
else
vx_min=0.2
vx_max=0.8
end if
if(present(viewy_int))then
vy_min=viewy_int(1)
vy_max=viewy_int(2)
else
vy_min=0.2
vy_max=0.8
end if
if(present(no_frame))then
no_frame_flag=no_frame
else
no_frame_flag=.false.
end if
if(present(xylog))then
xlogf=xylog(1)
ylogf=xylog(2)
else
xlogf=.false.
ylogf=.false.
end if
!-- 引数の置き換え用変数に置き換え
vnx=vn(1)
vny=vn(2)
x_title=trim(axis_title(1))
y_title=trim(axis_title(2))
!-- エラー処理
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)
um=0.0
vm=0.0
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(1+nint(factx*(i-1)),1)=vecx(1+nint(factx*(i-1)),1)
vm(1+nint(factx*(i-1)),1)=vecy(1+nint(factx*(i-1)),1)
end do
do j=2,vny
um(1,1+nint((j-1)*facty))=vecx(1,1+nint((j-1)*facty))
vm(1,1+nint((j-1)*facty))=vecy(1,1+nint((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
vm(1+nint(factx*(i-1)),1+nint(facty*(j-1))) =vecy(1+nint(factx*(i-1)),1+nint(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.)
if(no_frame_flag.eqv..true.)then
call DclNewFig
else
call DclNewFrame
end if
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
if(xlogf.eqv..true.)then
if(ylogf.eqv..true.)then
trans_num=4
else
trans_num=3
end if
else
if(ylogf.eqv..true.)then
trans_num=2
else
trans_num=1
end if
end if
call DclSetTransNumber(trans_num)
call DclSetTransFunction
! call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', trim(x_title), 0.0 )
call DclDrawTitle( 'l', trim(y_title), 0.0 )
call DclDrawTitle( 't', trim(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 : | |||
| viewx_int(2) : | real, intent(in)
| ||
| viewy_int(2) : | real, intent(in)
| ||
| line : | integer, intent(in)
| ||
| color : | integer, intent(in)
|
正規化座標系において, 四角領域を作成し, 任意の色と線で塗りつぶす.
subroutine Dcl_Square_Normal( viewx_int, viewy_int, line, color ) ! 正規化座標系において, 四角領域を作成し, 任意の色と線で塗りつぶす. use dcl implicit none real, intent(in) :: viewx_int(2) ! x 方向の正規座標 real, intent(in) :: viewy_int(2) ! x 方向の正規座標 integer, intent(in) :: line ! 枠線の色と太さ(DCL の index, type に従う) integer, intent(in) :: color ! 四角を塗りつぶす色(DCL のカラーマップに従う) real :: vx(5), vy(5) vx(:)=(/viewx_int(1), viewx_int(2), viewx_int(2), viewx_int(1), viewx_int(1)/) vy(:)=(/viewy_int(1), viewy_int(1), viewy_int(2), viewy_int(2), viewy_int(1)/) call DclShadeRegionNormalized( vx, vy, color ) call DclDrawLineNormalized( vx, vy, index=line ) 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
| ||
| unite : | character(*), intent(in), optional
|
時間発展する場合, 自動的にグラフのタイトルを作成する
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
real :: facttime_f
if(present(forma))then
formb=forma
else
formb='(i8.8)'
end if
if(present(factor))then
if(mod(time,factor)/=0)then
facttime_f=real(time)/real(factor)
write(tmpname,formb) facttime_f
write(*,*) "######## facttime", tmpname, facttime_f
else
if(formb(2:2)=='f')then ! フォーマットが実数で与えられている
facttime=time/factor
write(tmpname,formb) real(facttime)
else
facttime=time/factor
write(tmpname,formb) facttime
end if
end if
else
facttime=time
write(*,*) "facttiem", facttime, time, formb
write(tmpname,formb) time
end if
write(*,*) "auto_titleroutine"
len_num=len_trim(tmpname)
write(*,*) "auto_titleroutine"
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
write(*,*) "auto_titleroutine"
end subroutine
| Subroutine : | |||
| length(2) : | real, intent(in)
| ||
| v_length(2) : | real, intent(in)
| ||
| vx_scale : | real, intent(in)
| ||
| vy_scale : | real, intent(inout)
|
風速ベクトルを描画アスペクト比に合わせるための 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 となる.
subroutine calc_vscale( length, v_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) :: length(2) ! 描画距離 [m] real, intent(in) :: v_length(2) ! V 系での描画範囲 real, intent(in) :: vx_scale ! x 方向のスケーリングファクター real, intent(inout) :: vy_scale ! y 方向のスケーリングファクター !-- 以上, 引数 real :: x_length ! 横方向の描画距離 [m] real :: y_length ! 縦方向の描画距離 [m] real :: vx_length ! 縦方向の V 系での描画範囲 real :: vy_length ! 横方向の V 系での描画範囲 !-- 以上, 引数の置き換え用変数 real :: u_asp, v_asp !-- 引数の置き換え用変数に置き換え x_length=length(1) y_length=length(2) vx_length=v_length(1) vy_length=v_length(2) 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_int(2) : | real, intent(in)
| ||
| col_tab : | integer, intent(in), optional
| ||
| col_max : | integer, intent(in), optional
| ||
| col_min : | integer, intent(in), optional
| ||
| col_bg : | logical, intent(in), optional
| ||
| reverse : | logical, intent(in), optional
| ||
| min_tab : | integer, intent(in), optional
| ||
| max_tab : | integer, intent(in), optional
| ||
| log_flag : | logical, intent(in), optional
|
カラーマップの色と数値を対応させる自動ルーチン
subroutine color_setting( color_num, val_int, col_tab, col_max, col_min, col_bg, reverse, min_tab, max_tab, log_flag )
! カラーマップの色と数値を対応させる自動ルーチン
use dcl
implicit none
integer, intent(in) :: color_num ! 使用するカラーの種類
real, intent(in) :: val_int(2) ! 描くカラーの上下端
! val_int(1)=val_min, val_int(2)=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 以上の値に対応するカラー番号, デフォルトは黒
logical, intent(in), optional :: log_flag ! スケールを対数化するか. デフォルトは .false.
!-- 以上, 引数
real :: val_min ! 描くカラーの最小値
real :: val_max ! 描くカラーの最大値
!-- 以上, 引数の置き換え用変数
integer :: ipat
real :: dv ! カラーマップに対応する値の幅
integer :: cmap_min, cmap_max
real :: tlev1, tlev2
logical :: rev, log_f
real :: white_min, black_max
real :: RMISS
integer :: white, black, ITON
!-- 引数の置き換え用変数に置き換え
val_min=val_int(1)
val_max=val_int(2)
!-- Dcl 側の undef 値セット
CALL GLRGET( 'RMISS', RMISS )
CALL GLLSET( 'LMISS', .TRUE. )
!-- カラーマップチェンジのフラグ
CALL SWLSET( 'LCMCH', .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
!-- back color is white flag. Ver.5.4.2
! if(black==999.or.white==999)then
! call DclSetParm( 'LCLCNV' , .FALSE. )
! end if
if(black==999)then
call SGIGET( 'IBGCLI', black )
black=black*1000+999
end if
if(white==999)then
call SGIGET( 'IBGCLI', white )
white=white*1000+999
end if
call sgscmn(map_num)
call UEITLV
!-- 対数化するかのフラグ
if(present(log_flag))then
log_f=log_flag
else
log_f=.false.
end if
if(log_f.eqv..true.)then
if(val_min<0.0.or.val_max<0.0)then
write(*,*) "### ERROR ### (color_setting)"
write(*,*) "val_min and val_max must be more than zero."
write(*,*) "STOP"
stop
end if
end if
!-- 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
if(log_f.eqv..true.)then
dv=(log10(val_max)-log10(val_min))/color_num
else
dv=(val_max-val_min)/color_num
end if
if(rev.eqv..true.)then
do k=1,color_num
if(log_f.eqv..true.)then
TLEV1=val_min*(dv**(k-1))
TLEV2=TLEV1*dv
else
TLEV1=val_min+(k-1)*dv
TLEV2=TLEV1+dv
end if
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
if(log_f.eqv..true.)then
TLEV1=val_min*(dv**(k-1))
TLEV2=TLEV1*dv
else
TLEV1=val_min+(k-1)*dv
TLEV2=TLEV1+dv
end if
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)
| ||
| order_num : | character(1), intent(in)
| ||
| form_name : | character(*), intent(out) | ||
| frac_num : | character(1), intent(in), optional
|
数値ラベル用フォーマット作成ルーチン
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
| ||
| val_int(2) : | real, intent(in)
| ||
| nega_ton_tab : | integer, intent(in), optional
| ||
| full_tone : | logical, intent(in), optional
|
color_setting のモノトーンバージョン トーンテーブルは白を抜いて 5 種類しかないので, val_min, val_max を強制的に 5 分割し, トーンを当てはめる. また, nega_ton_tab が指定されていれば, 10 分割する.
subroutine monotone_setting( ton_tab, val_int, 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_int(2) ! 描くカラーの上下端
! val_int(1)=val_min, val_int(2)=val_max
integer, intent(in), optional :: nega_ton_tab ! トーンテーブルを 2 枚使うとき, 値の小さい領域に向かって濃くしていく場合に指定. このトーンを 0 から負方向に濃くしていく.
logical, intent(in), optional :: full_tone ! 白を合わせると, 各トーンで 6 段階あるので, val_min, val_max の差を強制的に 6 分割してトーンを割り当てる. ただし, これをすると, トーンの境界値が切りのよい数値にならない時がある. 値は .true. で有効となる.
!-- 以上, 引数
real :: val_min ! 描くカラーの最小値
real :: val_max ! 描くカラーの最大値
!-- 以上, 引数の置き換え用変数
integer :: map_num ! カラーマップのマップ番号指定 (optional 属性をつけること)
integer :: i, j, k ! 作業用添字
integer :: ipat, itvtone, tone_mapping
real :: dv ! カラーマップに対応する値の幅
integer :: cmap_min, cmap_max
real :: tlev1, tlev2
!-- 引数の置き換え用変数に置き換え
val_min=val_int(1)
val_max=val_int(2)
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 : | |||
| nx : | integer, intent(in)
| ||
| ny : | integer, intent(in)
| ||
| nz : | integer, intent(in)
| ||
| undef : | real, intent(in)
| ||
| val(nx,ny,nz) : | real, intent(inout)
|
val の中の nan 値を undef に入れ替える. 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで, 1, 2 次元の配列に対しても変換可能.
subroutine nan_val( nx, ny, nz, undef, val ) ! val の中の nan 値を undef に入れ替える.
! 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで,
! 1, 2 次元の配列に対しても変換可能.
implicit none
integer, intent(in) :: nx ! 第 1 要素の要素数
integer, intent(in) :: ny ! 第 2 要素の要素数
integer, intent(in) :: nz ! 第 3 要素の要素数
real, intent(in) :: undef ! 代入する未定義値
real, intent(inout) :: val(nx,ny,nz) ! 変換する配列
integer :: i, j, k ! 作業用配列
do k=1,nz
do j=1,ny
do i=1,nx
if(isnan(val(i,j,k)))then
val(i,j,k)=undef
end if
end do
end do
end do
end subroutine
| Subroutine : | |||
| color_num : | integer, intent(in)
| ||
| shade_int(2) : | real, intent(in)
| ||
| vx_int(2) : | real, intent(in)
| ||
| vy_int(2) : | real, intent(in)
| ||
| form_types : | character(6), intent(in)
| ||
| mono_log : | logical, intent(in), optional | ||
| trigle : | character(1), intent(in), optional
| ||
| tricmin : | integer, intent(in), optional
| ||
| tricmax : | integer, intent(in), optional
| ||
| trifact : | real, intent(in), optional
| ||
| col_mem_num : | integer, intent(in), optional
| ||
| log_flag : | logical, intent(in), optional
|
右にトーンバーを自動生成する
subroutine tone_bar( color_num, shade_int, vx_int, vy_int, form_types, mono_log, trigle, tricmin, tricmax, trifact, col_mem_num, log_flag )
! 右にトーンバーを自動生成する
use dcl
implicit none
integer, intent(in) :: color_num ! 使用する色の数
real, intent(in) :: shade_int(2) ! カラーの上下端
! shade_int(1)=shade_min, shade_int(2)=shade_max
real, intent(in) :: vx_int(2) ! ビューポートの x 方向の両端
! vx_int(1)=vx_min, vx_int(2)=vx_max
real, intent(in) :: vy_int(2) ! ビューポートの y 方向の両端
! vy_int(1)=vy_min, vy_int(2)=vy_max
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.)
integer, intent(in), optional :: col_mem_num ! トーンバーの目盛の数
logical, intent(in), optional :: log_flag ! スケールを対数化するか. デフォルトは .false.
!-- 以上, 引数
real :: shade_min ! 最小値
real :: shade_max ! 最大値
real :: vx_min ! ビューポートの x 方向の最小値
real :: vx_max ! ビューポートの x 方向の最大値
real :: vy_min ! ビューポートの y 方向の最小値
real :: vy_max ! ビューポートの y 方向の最大値
!-- 以上, 引数の置き換え用変数
real, parameter :: RMISS=999.0
integer :: k
real :: pi(2,color_num+1)
real :: dp, dp_mem
real :: coldim1(color_num+1), coldim2(color_num/2+1)
real, allocatable :: col_mem_dim1(:), col_mem_dim2(:)
logical :: monoto ! モノトーンの処理
real, dimension(4) :: 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 用バッファ.
logical :: log_f
!-- 引数の置き換え用変数に置き換え
shade_min=shade_int(1)
shade_max=shade_int(2)
vx_min=vx_int(1)
vx_max=vx_int(2)
vy_min=vy_int(1)
vy_max=vy_int(2)
!-- オプションの処理
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
triux(4)=triux(1)
triuy(1)=vy_max-factoru*(vx_max-vx_min)
triuy(2)=vy_max
triuy(3)=triuy(1)
triuy(4)=triuy(1)
tridx=triux
tridy(1)=vy_min+factoru*(vx_max-vx_min)
tridy(2)=vy_min
tridy(3)=tridy(1)
tridy(4)=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
triux(4)=triux(1)
triuy(1)=vy_max-factoru*(vx_max-vx_min)
triuy(2)=vy_max
triuy(3)=triuy(1)
triuy(4)=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
tridx(4)=tridx(1)
tridy(1)=vy_min+factoru*(vx_max-vx_min)
tridy(2)=vy_min
tridy(3)=tridy(1)
tridy(4)=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
if(present(log_flag))then
log_f=log_flag
else
log_f=.false.
end if
!-- 処理ここまで
call DclNewFig
call DclSetWindow( 0.0, 1.0, shade_min, shade_max )
call DclSetViewPort( vpx_min, vpx_max, vpy_min, vpy_max )
if(log_f.eqv..true.)then
call GRSTRN(2)
!-- 配色の設定
dp = (log10(shade_max)-log10(shade_min))/color_num
do k=1,color_num+1
PI(1,K) = shade_min * (DP**(K-1))
PI(2,K) = PI(1,K)
end do
else
call GRSTRN(1)
!-- 配色の設定
dp = (shade_max-shade_min)/color_num
do k=1,color_num+1
PI(1,K) = shade_min + DP * (K-1)
PI(2,K) = PI(1,K)
end do
end if
call DclSetTransFunction
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 )
!-- トーンの目盛を描くための配列を調整.
if(present(col_mem_num))then
allocate(col_mem_dim1(col_mem_num+1))
allocate(col_mem_dim2(col_mem_num/2+1))
if(log_f.eqv..true.)then
dp_mem=(log10(shade_max)-log10(shade_min))/col_mem_num
do k=1,col_mem_num+1
col_mem_dim1(k)=shade_min*(dp_mem**(k-1))
end do
do k=1,col_mem_num/2+1
col_mem_dim2(k)=shade_min*(dp_mem**(2*(k-1)))
end do
else
dp_mem=(shade_max-shade_min)/col_mem_num
do k=1,col_mem_num+1
col_mem_dim1(k)=shade_min+(k-1)*dp_mem
end do
do k=1,col_mem_num/2+1
col_mem_dim2(k)=shade_min+2*(k-1)*dp_mem
end do
end if
CALL UYAXNM( 'R', col_mem_dim1, col_mem_num+1, col_mem_dim2, col_mem_num/2+1 )
CALL UYAXNM( 'L', col_mem_dim1, col_mem_num+1, col_mem_dim2, col_mem_num/2+1 )
deallocate(col_mem_dim1)
deallocate(col_mem_dim2)
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
CALL UYAXNM( 'R', coldim1, color_num+1, coldim2, color_num/2+1 )
CALL UYAXNM( 'L', coldim1, color_num+1, coldim2, color_num/2+1 )
end if
!-- 実際に三角形領域を描く
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
! 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)
| ||
| ny : | integer, intent(in)
| ||
| nz : | integer, intent(in)
| ||
| val(nx,ny,nz) : | real, intent(inout)
|
CReSS の未定義値を Dcl の未定義値に変換するルーチン 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで, 1, 2 次元の配列に対しても変換可能.
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