| 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_min : | real, intent(in)
| ||
| cont_max : | real, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| form_typec : | character(6), intent(in), optional
| ||
| form_types : | character(6), intent(in), optional
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| color_num : | integer, intent(in), optional
| ||
| cont_num : | integer, intent(in), optional
| ||
| nongrid : | character(2), intent(in), optional
| ||
| xg(:,:) : | real, intent(in), optional
| ||
| yg(:,:) : | real, intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する.
subroutine Dcl_2D_cont_shade( outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg )
! 2 次元で 2 変数を等値線とカラーシェードで描画する.
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列
real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列
real, intent(in) :: cont_min ! 等値線を描く最小値
real, intent(in) :: cont_max ! 等値線を描く最大値
real, intent(in) :: shade_min ! シェードを描く最小値
real, intent(in) :: shade_max ! シェードを描く最大値
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
character(6), intent(in), optional :: form_typec ! contour 用のフォーマット
character(6), intent(in), optional :: form_types ! shade 用のフォーマット
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer, intent(in), optional :: color_num ! カラーの数
integer, intent(in), optional :: cont_num ! 等値線の数
character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか.
! nongrid = 'ox' で判断.
! 1 文字目が横軸, 2 文字目が縦軸.
! o = 不等間隔, x = 等間隔.
! デフォルトでは 'xx'.
real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標
real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標
! 第一要素が線の位置データで, 複数本描く場合は,
! 第二要素を 2 個以上にして描く.
! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを
! 描くことも可能.
! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の
! 線を表すように指定すること.
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
if(present(xg))then
do i=1,size(xg,2)
call DclScalingPoint( xg(:,i), yg(:,i) )
end do
end if
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
if(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
call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', x_title, 0.0 )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
call DclSetContourLabelFormat(form_typec)
if(present(cont_num))then
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
else
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
end if
call DclDrawContour( contour )
if(present(xg))then
do i=1,size(xg,2)
call DclDrawLine( xg(:,i), yg(:,i) )
end do
end if
if(present(color_num))then
call tone_bar( color_num, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
else
call tone_bar( 56, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
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_min : | real, intent(in)
| ||
| cont_max : | real, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| form_typec : | character(6), intent(in), optional
| ||
| form_types : | character(6), intent(in), optional
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| color_num : | integer, intent(in), optional
| ||
| cont_num : | integer, intent(in), optional
| ||
| nongrid : | character(2), intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する. 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える.
subroutine Dcl_2D_cont_shade_MapPro( map_pro, outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid )
! 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_min ! 等値線を描く最小値
real, intent(in) :: cont_max ! 等値線を描く最大値
real, intent(in) :: shade_min ! シェードを描く最小値
real, intent(in) :: shade_max ! シェードを描く最大値
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
character(6), intent(in), optional :: form_typec ! contour 用のフォーマット
character(6), intent(in), optional :: form_types ! shade 用のフォーマット
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer, intent(in), optional :: color_num ! カラーの数
integer, intent(in), optional :: cont_num ! 等値線の数
character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか.
! nongrid = 'ox' で判断.
! 1 文字目が横軸, 2 文字目が縦軸.
! o = 不等間隔, x = 等間隔.
! デフォルトでは 'xx'.
real, parameter :: pi=3.14159265
real, parameter :: radius=6.38e6
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: uratio
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
real :: map_lat_min, map_lat_max, map_lon_min, map_lon_max
real :: mlat2dis_min, mlat2dis_max
nx=size(x)
ny=size(y)
!-- 引数を rad 単位に変換
map_lon_min=x(1)*pi/180.0
map_lon_max=x(nx)*pi/180.0
map_lat_min=y(1)*pi/180.0
map_lat_max=y(ny)*pi/180.0
mlat2dis_min=log(tan(0.25*pi+0.5*map_lat_min))
mlat2dis_max=log(tan(0.25*pi+0.5*map_lat_max))
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- 地図独自のオプション ---
!-- 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
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetParm( 'MAP:LGRIDMN', .false. )
call DclSetParm( 'MAP:INDEXMJ', 1 )
call DclSetParm( 'MAP:dgridmj', 1. )
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransNumber( map_pro )
call DclFitMapParm
call DclSetTransFunction
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
call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawAxis( 'bt', 1.0, 0.5 )
call DclDrawAxis( 'rl', 1.0, 0.5 )
! call DclDrawScaledAxis
call DclDrawTitle( 'b', x_title, 0.0 )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
call DclDrawMap( 'coast_world' )
call DclDrawGlobe()
call DclSetContourLabelFormat(form_typec)
if(present(cont_num))then
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
else
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
end if
call DclDrawContour( contour )
if(present(color_num))then
call tone_bar( color_num, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
else
call tone_bar( 56, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
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_min : | real, intent(in)
| ||
| cont_max : | real, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| form_typec : | character(6), intent(in), optional
| ||
| form_types : | character(6), intent(in), optional
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| color_num : | integer, intent(in), optional
| ||
| cont_num : | integer, intent(in), optional
| ||
| nongrid : | character(2), intent(in), optional
|
2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応
subroutine Dcl_2D_cont_shade_calendar( outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, date, days, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid )
! 2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列
real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列
real, intent(in) :: cont_min ! 等値線を描く最小値
real, intent(in) :: cont_max ! 等値線を描く最大値
real, intent(in) :: shade_min ! シェードを描く最小値
real, intent(in) :: shade_max ! シェードを描く最大値
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
character(6), intent(in), optional :: form_typec ! contour 用のフォーマット
character(6), intent(in), optional :: form_types ! shade 用のフォーマット
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer, intent(in), optional :: color_num ! カラーの数
integer, intent(in), optional :: cont_num ! 等値線の数
character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか.
! nongrid = 'ox' で判断.
! 1 文字目が横軸, 2 文字目が縦軸.
! o = 不等間隔, x = 等間隔.
! デフォルトでは 'xx'.
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
nx=size(x)
ny=size(y)
!-- 日付が与えられているかを表示
write(*,*) "start day is", date%year, date%month, date%day
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetWindow( 0.0, real(days), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
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
call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawAxisCalendar( 'bt', date, nd=days )
call DclDrawScaledAxis( 'lr' )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
call DclSetContourLabelFormat(form_typec)
if(present(cont_num))then
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
else
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
end if
call DclDrawContour( contour )
if(present(color_num))then
call tone_bar( color_num, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
else
call tone_bar( 56, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
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)
| ||
| vnx : | integer, intent(in)
| ||
| vny : | integer, intent(in)
| ||
| cont_min : | real, intent(in)
| ||
| cont_max : | real, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| form_typec : | character(6), intent(in), optional
| ||
| form_types : | character(6), intent(in), optional
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| color_num : | integer, intent(in), optional
| ||
| cont_num : | integer, intent(in), optional
| ||
| nongrid : | character(2), intent(in), optional
|
2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.
subroutine Dcl_2D_cont_shade_vec( outname, x, y, contour, shade, vecx, vecy, vnx, vny, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid )
! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する.
! 最大 4 変数同時描画が可能となる.
! 基本的に右にカラーバーがつくので, ユニットベクトルは
! コンターインターバルの下に文字で表示される.
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列
real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列
real, intent(inout) :: vecx(size(x),size(y)) ! x 方向のベクトル
real, intent(inout) :: vecy(size(x),size(y)) ! x 方向のベクトル
integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用)
real, intent(in) :: cont_min ! 等値線を描く最小値
real, intent(in) :: cont_max ! 等値線を描く最大値
real, intent(in) :: shade_min ! シェードを描く最小値
real, intent(in) :: shade_max ! シェードを描く最大値
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
character(6), intent(in), optional :: form_typec ! contour 用のフォーマット
character(6), intent(in), optional :: form_types ! shade 用のフォーマット
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer, intent(in), optional :: color_num ! カラーの数
integer, intent(in), optional :: cont_num ! 等値線の数
character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか.
! nongrid = 'ox' で判断.
! 1 文字目が横軸, 2 文字目が縦軸.
! o = 不等間隔, x = 等間隔.
! デフォルトでは 'xx'.
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: factx, facty
real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
intrinsic :: nint
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- エラー処理
if(nx<vnx.or.ny<vny)then
write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
stop
end if
if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then
write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2."
stop
end if
!-- 警告
if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then
write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny."
else
if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then
if(mod((nx-1),(vnx-1))/=0)then
write(*,*) "****WARNING**** : vnx is not the factor of nx."
else
write(*,*) "****WARNING**** : vny is not the factor of ny."
end if
end if
end if
!-- ベクトル場の間引き
factx=real(nx-1)/real(vnx-1)
facty=real(ny-1)/real(vny-1)
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(i,1)=vecx(1+nint(factx*(i-1)),1)
vm(i,1)=vecy(1+nint(factx*(i-1)),1)
end do
do j=2,vny
um(1,j)=vecx(1,1+nint((j-1)*facty))
vm(1,j)=vecy(1,1+nint((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
end do
end do
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
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
call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', x_title, 0.0 )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
call DclSetContourLabelFormat(form_typec)
if(present(cont_num))then
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
else
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
end if
call DclDrawContour( contour )
call DclDrawVectors( um, vm )
if(present(color_num))then
call tone_bar( color_num, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
else
call tone_bar( 56, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
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)
| ||
| vnx : | integer, intent(in)
| ||
| vny : | integer, intent(in)
| ||
| cont_min : | real, intent(in)
| ||
| cont_max : | real, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| form_typec : | character(6), intent(in), optional
| ||
| form_types : | character(6), intent(in), optional
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| color_num : | integer, intent(in), optional
| ||
| cont_num : | integer, intent(in), optional
| ||
| nongrid : | character(2), intent(in), optional
|
2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. 最大 4 変数同時描画が可能となる. 基本的に右にカラーバーがつくので, ユニットベクトルは コンターインターバルの下に文字で表示される.
subroutine Dcl_2D_cont_shade_vec_calendar( outname, x, y, contour, shade, vecx, vecy, vnx, vny, cont_min, cont_max, shade_min, shade_max, x_title, y_title, date, days, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid )
! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する.
! 最大 4 変数同時描画が可能となる.
! 基本的に右にカラーバーがつくので, ユニットベクトルは
! コンターインターバルの下に文字で表示される.
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列
real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列
real, intent(inout) :: vecx(size(x),size(y)) ! x 方向のベクトル
real, intent(inout) :: vecy(size(x),size(y)) ! x 方向のベクトル
integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用)
real, intent(in) :: cont_min ! 等値線を描く最小値
real, intent(in) :: cont_max ! 等値線を描く最大値
real, intent(in) :: shade_min ! シェードを描く最小値
real, intent(in) :: shade_max ! シェードを描く最大値
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
character(6), intent(in), optional :: form_typec ! contour 用のフォーマット
character(6), intent(in), optional :: form_types ! shade 用のフォーマット
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer, intent(in), optional :: color_num ! カラーの数
integer, intent(in), optional :: cont_num ! 等値線の数
character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか.
! nongrid = 'ox' で判断.
! 1 文字目が横軸, 2 文字目が縦軸.
! o = 不等間隔, x = 等間隔.
! デフォルトでは 'xx'.
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: factx, facty
real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
nx=size(x)
ny=size(y)
!-- 日付が与えられているかを表示
write(*,*) "start day is", date%year, date%month, date%day
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- エラー処理
if(nx<vnx.or.ny<vny)then
write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
stop
end if
if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then
write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2."
stop
end if
!-- 警告
if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then
write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny."
else
if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then
if(mod((nx-1),(vnx-1))/=0)then
write(*,*) "****WARNING**** : vnx is not the factor of nx."
else
write(*,*) "****WARNING**** : vny is not the factor of ny."
end if
end if
end if
!-- ベクトル場の間引き
factx=real(nx-1)/real(vnx-1)
facty=real(ny-1)/real(vny-1)
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(i,1)=vecx(1+nint(factx*(i-1)),1)
vm(i,1)=vecy(1+nint(factx*(i-1)),1)
end do
do j=2,vny
um(1,j)=vecx(1,1+nint((j-1)*facty))
vm(1,j)=vecy(1,1+nint((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1)))
end do
end do
!-- 処理ここまで ---
call undef_CReSS2Dcl( nx, ny, 1, contour)
call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetWindow( 0.0, real(days), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
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
call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawAxisCalendar( 'bt', date, nd=days )
call DclDrawScaledAxis( 'lr' )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
call DclSetContourLabelFormat(form_typec)
if(present(cont_num))then
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/cont_num )
else
call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
end if
call DclDrawContour( contour )
call DclDrawVectors( um, vm )
if(present(color_num))then
call tone_bar( color_num, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
else
call tone_bar( 56, shade_min, shade_max, vx_max+0.05, 0.875, vy_min, vy_max, form_types )
end if
end subroutine
| Subroutine : | |||
| judge : | character(1), intent(in)
| ||
| outname : | character(*), intent(in)
| ||
| lnum : | integer, intent(in)
| ||
| pnum : | integer, intent(in)
| ||
| lstep : | integer, intent(in)
| ||
| pstep : | integer, intent(in)
| ||
| xline(lstep, lnum) : | real, intent(in)
| ||
| yline(lstep, lnum) : | real, intent(in)
| ||
| xpoint(pstep, pnum) : | real, intent(in)
| ||
| ypoint(pstep, pnum) : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| xmin : | real, intent(in), optional
| ||
| xmax : | real, intent(in), optional
| ||
| ymin : | real, intent(in), optional
| ||
| ymax : | real, 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, lnum, pnum, lstep, pstep, xline, yline, xpoint, ypoint, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax )
! 2 次元平面内において複数の曲線, ポイントで描画する.
! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
! 第二要素で曲線の本数を設定. ポイントについても同様.
! つまり, 例として以下のように配列を用意する.
! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
! ポイントを 100 個描きたいとすると,
! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
! として引数に読み込ませればよい.
! このとき, 上の引数に対応する関係は以下のとおりである.
! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
use dcl
implicit none
character(1), intent(in) :: judge ! グラフの種類
! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画.
! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
character(*), intent(in) :: outname ! グラフのタイトル
integer, intent(in) :: lnum ! 曲線の本数
integer, intent(in) :: pnum ! ポイントの種類数
integer, intent(in) :: lstep ! 曲線の 1 本の配列数
integer, intent(in) :: pstep ! 1 種類のポイントの個数
real, intent(in) :: xline(lstep, lnum) ! 曲線群の x 座標
real, intent(in) :: yline(lstep, lnum) ! 曲線群の y 座標
real, intent(in) :: xpoint(pstep, pnum) ! ポイント群の x 座標
real, intent(in) :: ypoint(pstep, pnum) ! ポイント群の y 座標
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
real, intent(in), optional :: xmin ! x 方向のグラフ左端
real, intent(in), optional :: xmax ! x 方向のグラフ右端
real, intent(in), optional :: ymin ! y 方向のグラフ左端
real, intent(in), optional :: ymax ! y 方向のグラフ右端
integer :: i, j, k ! 作業用添字
integer, parameter :: lim=990 ! ラインインデックスの最大値
integer :: nnum
real :: vx_min, vx_max, vy_min, vy_max
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- 処理ここまで ---
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
if(present(xmin))then
call DclSetWindow( xmin, xmax, ymin, ymax )
else
if(judge=='p'.or.judge=='a')then
do i=1,pnum
call DclScalingPoint( xpoint(:,j), ypoint(:,j) )
end do
end if
if(judge=='l'.or.judge=='a')then
do j=1,lnum
call DclScalingPoint( xline(:,j), yline(:,j) )
end do
end if
call DclFitScalingParm
end if
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
! call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', x_title, 0.0 )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
if(judge=='p'.or.judge=='a')then
if(pnum==1)then
call DclDrawMarker( xpoint(:,1), ypoint(:,1) )
else
do i=1,pnum
call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j )
end do
end if
end if
if(judge=='l'.or.judge=='a')then
if(lnum==1)then
call DclDrawLine( xline(:,1), yline(:,1) )
else
nnum=lim/lnum
do j=1,lnum
call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) )
end do
end if
end if
! call DclSetContourLabelFormat(form_typec)
! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
! call DclDrawContour( contour )
! call DclDrawVectors( um, vm )
end subroutine
| Subroutine : | |||
| judge : | character(1), intent(in)
| ||
| outname : | character(*), intent(in)
| ||
| lnum : | integer, intent(in)
| ||
| pnum : | integer, intent(in)
| ||
| lstep : | integer, intent(in)
| ||
| pstep : | integer, intent(in)
| ||
| xline(lstep, lnum) : | real, intent(in)
| ||
| yline(lstep, lnum) : | real, intent(in)
| ||
| xpoint(pstep, pnum) : | real, intent(in)
| ||
| ypoint(pstep, pnum) : | real, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| date : | type(dcl_date), intent(in)
| ||
| days : | integer, intent(in)
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, intent(in), optional
| ||
| xmin : | real, intent(in), optional
| ||
| xmax : | real, intent(in), optional
| ||
| ymin : | real, intent(in), optional
| ||
| ymax : | real, 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, lnum, pnum, lstep, pstep, xline, yline, xpoint, ypoint, x_title, y_title, date, days, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax )
! 2 次元平面内において複数の曲線, ポイントで描画する.
! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
! 第二要素で曲線の本数を設定. ポイントについても同様.
! つまり, 例として以下のように配列を用意する.
! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
! ポイントを 100 個描きたいとすると,
! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
! として引数に読み込ませればよい.
! このとき, 上の引数に対応する関係は以下のとおりである.
! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
use dcl
implicit none
character(1), intent(in) :: judge ! グラフの種類
! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画.
! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり.
character(*), intent(in) :: outname ! グラフのタイトル
integer, intent(in) :: lnum ! 曲線の本数
integer, intent(in) :: pnum ! ポイントの種類数
integer, intent(in) :: lstep ! 曲線の 1 本の配列数
integer, intent(in) :: pstep ! 1 種類のポイントの個数
real, intent(in) :: xline(lstep, lnum) ! 曲線群の x 座標
real, intent(in) :: yline(lstep, lnum) ! 曲線群の y 座標
real, intent(in) :: xpoint(pstep, pnum) ! ポイント群の x 座標
real, intent(in) :: ypoint(pstep, pnum) ! ポイント群の y 座標
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd]
integer, intent(in) :: days ! 描画日数 [day]
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
real, intent(in), optional :: xmin ! x 方向のグラフ左端
real, intent(in), optional :: xmax ! x 方向のグラフ右端
real, intent(in), optional :: ymin ! y 方向のグラフ左端
real, intent(in), optional :: ymax ! y 方向のグラフ右端
integer :: i, j, k ! 作業用添字
integer, parameter :: lim=990 ! ラインインデックスの最大値
integer :: nnum
real :: vx_min, vx_max, vy_min, vy_max
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- 処理ここまで ---
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
if(present(xmin))then
call DclSetWindow( xmin, xmax, ymin, ymax )
else
if(judge=='p'.or.judge=='a')then
do i=1,pnum
call DclScalingPoint( xpoint(:,j), ypoint(:,j) )
end do
end if
if(judge=='l'.or.judge=='a')then
do j=1,lnum
call DclScalingPoint( xline(:,j), yline(:,j) )
end do
end if
call DclFitScalingParm
end if
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
! call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawAxisCalendar( 'bt', date, nd=days )
call DclDrawScaledAxis( 'lr' )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
if(judge=='p'.or.judge=='a')then
if(pnum==1)then
call DclDrawMarker( xpoint(:,1), ypoint(:,1) )
else
do i=1,pnum
call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j )
end do
end if
end if
if(judge=='l'.or.judge=='a')then
if(lnum==1)then
call DclDrawLine( xline(:,1), yline(:,1) )
else
nnum=lim/lnum
do j=1,lnum
call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) )
end do
end if
end if
! call DclSetContourLabelFormat(form_typec)
! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
! call DclDrawContour( contour )
! call DclDrawVectors( um, vm )
end subroutine
| Subroutine : | |||
| outname : | character(*), intent(in)
| ||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| lnum : | integer, intent(in)
| ||
| pnum : | integer, intent(in)
| ||
| lstep : | integer, intent(in)
| ||
| pstep : | integer, intent(in)
| ||
| xline(lstep, lnum) : | real, intent(in)
| ||
| yline(lstep, lnum) : | real, intent(in)
| ||
| xpoint(pstep, pnum) : | real, intent(in)
| ||
| ypoint(pstep, pnum) : | real, intent(in)
| ||
| vecx(size(x),size(y)) : | real, intent(in)
| ||
| vecy(size(x),size(y)) : | real, intent(in)
| ||
| vnx : | integer, intent(in)
| ||
| vny : | integer, intent(in)
| ||
| x_title : | character(*), intent(in)
| ||
| y_title : | character(*), intent(in)
| ||
| viewx_min : | real, intent(in), optional
| ||
| viewx_max : | real, intent(in), optional
| ||
| viewy_min : | real, intent(in), optional
| ||
| viewy_max : | real, 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( outname, x, y, lnum, pnum, lstep, pstep, xline, yline, xpoint, ypoint, vecx, vecy, vnx, vny, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max )
! 2 次元平面内においてベクトルと複数の曲線, ポイントで描画する.
! 与える曲線とポイントはそれぞれ別個の配列で定義されており,
! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類,
! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を
! 第二要素で曲線の本数を設定. ポイントについても同様.
! つまり, 例として以下のように配列を用意する.
! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を
! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の
! ポイントを 100 個描きたいとすると,
! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5)
! として引数に読み込ませればよい.
! このとき, 上の引数に対応する関係は以下のとおりである.
! lnum = 3, pnum = 5, lstep = 1000, pstep = 100
use dcl
implicit none
character(*), intent(in) :: outname ! グラフのタイトル
real, intent(in) :: x(:) ! x 方向の格子点座標
real, intent(in) :: y(:) ! y 方向の格子点座標
integer, intent(in) :: lnum ! 曲線の本数
integer, intent(in) :: pnum ! ポイントの種類数
integer, intent(in) :: lstep ! 曲線の 1 本の配列数
integer, intent(in) :: pstep ! 1 種類のポイントの個数
real, intent(in) :: xline(lstep, lnum) ! 曲線群の x 座標
real, intent(in) :: yline(lstep, lnum) ! 曲線群の y 座標
real, intent(in) :: xpoint(pstep, pnum) ! ポイント群の x 座標
real, intent(in) :: ypoint(pstep, pnum) ! ポイント群の y 座標
real, intent(in) :: vecx(size(x),size(y)) ! x 方向のベクトル
real, intent(in) :: vecy(size(x),size(y)) ! x 方向のベクトル
integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用)
integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用)
character(*), intent(in) :: x_title ! x 軸のタイトル
character(*), intent(in) :: y_title ! y 軸のタイトル
real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値
real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値
real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値
real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値
integer :: i, j, k ! 作業用添字
integer :: nx, ny
real :: factx, facty
real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入
real :: vx_min, vx_max, vy_min, vy_max
real :: undef, RMISS
nx=size(x)
ny=size(y)
!-- optional 引数の処理 ---
if(present(viewx_min))then
vx_min=viewx_min
else
vx_min=0.2
end if
if(present(viewx_max))then
vx_max=viewx_max
else
vx_max=0.8
end if
if(present(viewy_min))then
vy_min=viewy_min
else
vy_min=0.2
end if
if(present(viewy_max))then
vy_max=viewy_max
else
vy_max=0.8
end if
!-- エラー処理
if(nx<vnx.or.ny<vny)then
write(*,*) "*****ERROR***** : vnx > nx or vny > ny."
stop
end if
!-- 警告
if(mod(nx,(vnx-1))/=0.or.mod(ny,(vny-1))/=0)then
write(*,*) "****WARNING**** : vnx or vny is not the factor of nx or ny."
end if
!-- ベクトル場の間引き
factx=real(nx)/real(vnx-1)
facty=real(ny)/real(vny-1)
!-- 起点を 1 から始める
um(1,1)=vecx(1,1)
vm(1,1)=vecy(1,1)
do i=2,vnx
um(i,1)=vecx(int(factx*(i-1)),1)
vm(i,1)=vecy(int(factx*(i-1)),1)
end do
do j=2,vny
um(1,j)=vecx(1,int((j-1)*facty))
vm(1,j)=vecy(1,int((j-1)*facty))
end do
do j=2,vny
do i=2,vnx
um(i,j)=vecx(int(factx*(i-1)),int(facty*(j-1)))
vm(i,j)=vecy(int(factx*(i-1)),int(facty*(j-1)))
end do
end do
!-- 処理ここまで ---
! call undef_CReSS2Dcl( nx, ny, 1, contour)
! call undef_CReSS2Dcl( nx, ny, 1, shade)
call UWSGXZ(.FALSE.)
call UWSGYZ(.FALSE.)
call DclNewFrame
call DclSetWindow( x(1), x(nx), y(1), y(ny) )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call DclSetTransFunction
! call DclShadeContourEx( shade )
CALL UZLSET( 'LABELYL', .TRUE. )
CALL UZLSET( 'LABELYR', .FALSE. )
call DclDrawScaledAxis
call DclDrawTitle( 'b', x_title, 0.0 )
call DclDrawTitle( 'l', y_title, 0.0 )
call DclDrawTitle( 't', outname, 0.0, 2 )
!-- ポイントと曲線の設定 ---
!-- num 数に応じて do ループで回すので, num 数は任意で OK.
!-- num = 1 の場合は黒色で固定
if(pnum==1)then
call DclDrawMarker( xpoint(:,1), yline(:,1) )
else
do i=1,pnum
call DclDrawMarker( xpoint(:,j), yline(:,j), type=j )
end do
end if
if(lnum==1)then
call DclDrawLine( xline(:,1), yline(:,1) )
else
do j=1,lnum
call DclDrawLine( xline(:,j), yline(:,j), index=(90+10*j+1) )
end do
end if
! call DclSetContourLabelFormat(form_typec)
! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 )
! call DclDrawContour( contour )
call DclDrawVectors( um, vm )
end subroutine
| Subroutine : | |||
| head : | character(*), intent(in)
| ||
| time : | integer, intent(in)
| ||
| title : | character(*), intent(inout)
| ||
| forma : | character(6), intent(in), optional
| ||
| factor : | integer, intent(in), optional
| ||
| 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
if(present(forma))then
formb=forma
else
formb='(i8.8)'
end if
if(present(factor))then
facttime=time/factor
else
facttime=time
end if
write(tmpname,formb) facttime
len_num=len_trim(tmpname)
if(present(unite))then
title=trim(head)//'_(t='//tmpname(1:len_num)//trim(unite)//')"'
else
title=trim(head)//'_(t='//tmpname(1:len_num)//'[s])"'
end if
end subroutine
| Subroutine : | |||
| color_num : | integer, intent(in)
| ||
| val_min : | real, intent(in)
| ||
| val_max : | 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
|
カラーマップの色と数値を対応させる自動ルーチン
subroutine color_setting( color_num, val_min, val_max, col_tab, col_max, col_min, col_bg ) ! カラーマップの色と数値を対応させる自動ルーチン
use dcl
implicit none
integer, intent(in) :: color_num ! 使用するカラーの種類
real, intent(in) :: val_min ! 描くカラーの最小値
real, intent(in) :: val_max ! 描くカラーの最大値
integer, intent(in), optional :: col_tab ! dcl のカラーテーブル
integer, intent(in), optional :: col_min ! 使用するカラー番号の最小値(上2桁)
integer, intent(in), optional :: col_max ! 使用するカラー番号の最大値(上2桁)
logical, intent(in), optional :: col_bg ! 背景色の入れ替え デフォルトなし.
integer :: map_num ! カラーマップのマップ番号指定 (optional 属性をつけること)
integer :: i, j, k ! 作業用添字
integer :: ipat
real :: dv ! カラーマップに対応する値の幅
integer :: cmap_min, cmap_max
real :: tlev1, tlev2
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
write(*,*) "col_tab", map_num
call sgscmn(map_num)
call UEITLV
dv=(val_max-val_min)/color_num
do k=1,color_num
TLEV1=val_min+(k-1)*dv
TLEV2=TLEV1+dv
IPAT=(cmap_min+int((k-1)*(real(cmap_max)/real(color_num))))*1000+199
CALL UESTLV( TLEV1, TLEV2, IPAT )
end do
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 : | |||
| color_num : | integer, intent(in)
| ||
| shade_min : | real, intent(in)
| ||
| shade_max : | real, intent(in)
| ||
| vx_min : | real, intent(in)
| ||
| vx_max : | real, intent(in)
| ||
| vy_min : | real, intent(in)
| ||
| vy_max : | real, intent(in)
| ||
| form_types : | character(6), intent(in)
|
右にトーンバーを自動生成する
subroutine tone_bar( color_num, shade_min, shade_max, vx_min, vx_max, vy_min, vy_max, form_types ) ! 右にトーンバーを自動生成する
use dcl
implicit none
integer, intent(in) :: color_num ! 使用する色の数
real, intent(in) :: shade_min ! 最小値
real, intent(in) :: shade_max ! 最大値
real, intent(in) :: vx_min ! ビューポートの x 方向の最小値
real, intent(in) :: vx_max ! ビューポートの x 方向の最大値
real, intent(in) :: vy_min ! ビューポートの y 方向の最小値
real, intent(in) :: vy_max ! ビューポートの y 方向の最大値
character(6), intent(in) :: form_types ! ラベルフォーマット
integer :: k
real :: pi(2,color_num+1)
real :: dp
real :: coldim1(color_num+1), coldim2(color_num/2+1)
call GRFIG
call DclSetWindow( 0.0, 1.0, shade_min, shade_max )
call DclSetViewPort( vx_min, vx_max, vy_min, vy_max )
call GRSTRN(1)
call DclSetTransFunction
dp = (shade_max-shade_min)/color_num
do k=1,color_num+1
PI(1,K) = shade_min + (K-1)*DP
PI(2,K) = shade_min + (K-1)*DP
end do
!-- トーンの目盛を描くための配列を調整.
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 DclSetXGrid( (/0.0,1.0/) )
call DclSetYGrid( PI(1,:) )
call DclShadeContourEx( PI )
CALL SLPVPR( 3 )
CALL UZLSET( 'LABELYR', .TRUE. )
CALL UZLSET( 'LABELYL', .FALSE. )
CALL UYSFMT( form_types )
CALL UYAXNM( 'R', coldim1, color_num+1, coldim2, color_num/2+1 )
CALL UYAXNM( 'L', coldim1, color_num+1, coldim2, color_num/2+1 )
! 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