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)
| ||
form_types : | character(6), 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
| ||
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
| ||
mono : | logical, intent(in), optional
| ||
mono_val(:) : | real, intent(in), optional
| ||
mono_lev(:) : | integer, intent(in), optional
| ||
trigleg : | character(1), 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, mono, mono_val, mono_lev, trigleg ) ! 2 次元で 2 変数を等値線とカラーシェードで描画する. use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS logical :: monoto nx=size(x) ny=size(y) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( x(1), x(nx), y(1), y(ny) ) if(present(xg))then do i=1,size(xg,2) call DclScalingPoint( xg(:,i), yg(:,i) ) end do end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.true.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if if(monoto.eqv..true.)then call DclShadeContour( shade ) else call DclShadeContourEx( shade ) end if CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) if(present(xg))then do i=1,size(xg,2) call DclDrawLine( xg(:,i), yg(:,i) ) end do end if if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
map_pro : | integer, intent(in)
| ||
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)
| ||
form_types : | character(6), 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
| ||
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
| ||
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
|
2 次元で 2 変数を等値線とカラーシェードで描画する. 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える. 現在, xg, yg オプションは地図投影の関係上, 機能させていない.
subroutine Dcl_2D_cont_shade_MapPro( map_pro, outname, x, y, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg, mlitv ) ! 2 次元で 2 変数を等値線とカラーシェードで描画する. ! 引数 map_pro で地図番号を選択し, 地図投影モードに切り替える. ! 現在, xg, yg オプションは地図投影の関係上, 機能させていない. use dcl implicit none integer, intent(in) :: map_pro ! DCL の地図変換関数番号 character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 [deg] real, intent(in) :: y(:) ! y 方向の格子点座標 [deg] real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. real, intent(in), optional :: mlitv ! メジャーライン, 目盛の表示間隔 [degree]. デフォルトは 1 degree. real, parameter :: pi=3.14159265 real, parameter :: radius=6.38e6 integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: uratio real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS real :: map_lat_min, map_lat_max, map_lon_min, map_lon_max real :: mlat2dis_min, mlat2dis_max, mditv logical :: monoto nx=size(x) ny=size(y) !-- 引数を rad 単位に変換 map_lon_min=x(1)*pi/180.0 map_lon_max=x(nx)*pi/180.0 map_lat_min=y(1)*pi/180.0 map_lat_max=y(ny)*pi/180.0 mlat2dis_min=log(tan(0.25*pi+0.5*map_lat_min)) mlat2dis_max=log(tan(0.25*pi+0.5*map_lat_max)) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if if(present(mlitv))then mditv=mlitv else mditv=1.0 end if !-- 地図独自のオプション --- !-- MapFit ルーチンを用いると, 地図の vp が強制的に変更されるので, !-- その修正を行う. !-- u 座標系でのアスペクト比をとり, 長さの長い方の vp を基準にして, !-- 短い方の vp を修正する. uratio=(mlat2dis_max-mlat2dis_min)/(map_lon_max-map_lon_min) ! u 座標系での ratio if( uratio>1.0 )then ! y 軸の方が長いので, vratio で vxmin, vxmax を 0.5 を基準に修正. ! 修正公式は以下のとおり : ! vxmax+vxmin=1.0, vxmax-vxmin=(vymax-vymin)/uratio ! これをそれぞれ解くと, vymax, vymin は基準系なので引数のものを使用し, ! vxmax=0.5*(1.0+(vymax-vymin)/uratio) ! vxmin=0.5*(1.0-(vymax-vymin)/uratio) vx_max=0.5*(1.0+(vy_max-vy_min)/uratio) vx_min=0.5*(1.0-(vy_max-vy_min)/uratio) else ! x 軸の方が長いので, vratio で vymin, vymax を 0.5 を基準に修正. ! 修正公式は以下のとおり : ! vymax+vymin=1.0, vymax-vymin=uratio*(vxmax-vxmin) ! これをそれぞれ解くと, vxmax, vxmin は基準系なので引数のものを使用し, ! vymax=0.5*(1.0+(uratio*(vxmax-vxmin)) ! vymin=0.5*(1.0-(uratio*(vxmax-vxmin)) vy_max=0.5*(1.0+uratio*(vx_max-vx_min)) vy_min=0.5*(1.0-uratio*(vx_max-vx_min)) end if if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetParm( 'MAP:LGRIDMN', .false. ) call DclSetParm( 'MAP:INDEXMJ', 1 ) ! call DclSetParm( 'MAP:INDEXOUT', 51 ) ! 海岸線の色設定, どうするかは再考 call DclSetParm( 'MAP:dgridmj', mditv ) call DclSetWindow( x(1), x(nx), y(1), y(ny) ) call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransNumber( map_pro ) call DclFitMapParm call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.false.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if call DclSetParm( 'GRAPH:LCLIP', .true. ) ! call DclDrawViewPortFrame( 1 ) if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if if(monoto.eqv..true.)then call DclShadeContour( shade ) else call DclShadeContourEx( shade ) end if CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawAxis( 'bt', mditv, 0.5*mditv ) call DclDrawAxis( 'rl', mditv, 0.5*mditv ) ! call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) call DclDrawMap( 'coast_world' ) call DclDrawGlobe() call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
outname : | character(*), intent(in)
| ||
x(:) : | real, intent(in)
| ||
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)
| ||
form_types : | character(6), 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
| ||
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
| ||
mono : | logical, intent(in), optional
| ||
mono_val(:) : | real, intent(in), optional
| ||
mono_lev(:) : | integer, intent(in), optional
| ||
trigleg : | character(1), 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, xg, yg, mono, mono_val, mono_lev, trigleg ) ! 2 次元で 2 変数を等値線とカラーシェードで描画する. calender 対応 use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd] integer, intent(in) :: days ! 描画日数 [day] character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS logical :: monoto nx=size(x) ny=size(y) !-- 日付が与えられているかを表示 write(*,*) "start day is", date%year, date%month, date%day !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( 0.0, real(days), y(1), y(ny) ) if(present(xg))then do i=1,size(xg,2) call DclScalingPoint( xg(:,i), yg(:,i) ) end do end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.false.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if if(monoto.eqv..true.)then call DclShadeContour( shade ) else call DclShadeContourEx( shade ) end if CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawAxisCalendar( 'bt', date, nd=days ) call DclDrawScaledAxis( 'lr' ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) if(present(xg))then do i=1,size(xg,2) call DclDrawLine( xg(:,i), yg(:,i) ) end do end if if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
outname : | character(*), intent(in)
| ||
x(:) : | real, intent(in)
| ||
y(:) : | real, intent(in)
| ||
grid_point(size(x),size(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)
| ||
form_types : | character(6), 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
| ||
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
| ||
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
|
2 次元で 2 変数を等値線とカラーシェードで描画する. terrain following 版
subroutine Dcl_2D_cont_shade_terrain( outname, x, y, grid_point, contour, shade, cont_min, cont_max, shade_min, shade_max, x_title, y_title, form_typec, form_types, viewx_min, viewx_max, viewy_min, viewy_max, color_num, cont_num, nongrid, xg, yg, mono, mono_val, mono_lev, trigleg, trn_paint, trn_col, layer_line ) ! 2 次元で 2 変数を等値線とカラーシェードで描画する. ! terrain following 版 use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(in) :: grid_point(size(x),size(y)) ! terrain following 座標 real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. logical, intent(in), optional :: trn_paint ! 地形に色を塗るか. [def:.false.] integer, intent(in), optional :: trn_col ! 地形に塗る色のカラー番号 logical, intent(in), optional :: layer_line ! 各層の格子線を表示する. [def:.false.] integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS, interc logical :: monoto real :: cx(size(x),size(y)), cy(size(x),size(y)) real :: trn(size(x)+2), trn_x(size(x)+2) real :: cxmax, cxmin, cymax, cymin character(10) :: val_c integer :: maxcy, maxcx, trn_color nx=size(x) ny=size(y) !-- c 座標系への変換 do j=1,ny do i=1,nx cx(i,j)=x(i) cy(i,j)=grid_point(i,j) end do end do !-- c 座標系極値の計算 cxmin=x(1) cxmax=x(nx) cymin=cy(1,1) cymax=cy(1,ny) do i=2,nx if(cymin>cy(i,1))then cymin=cy(i,1) end if if(cymax<cy(i,ny))then cymax=cy(i,ny) end if end do !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- !-- contour を axis の前に描くので, 下に contour interval が表示されない !-- ようにするルーチン. contour interval は別途設定. call udlset('LMSG',.false.) call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( x(1), x(nx), y(1), y(ny) ) if(present(xg))then do i=1,size(xg,2) call DclScalingPoint( xg(:,i), yg(:,i) ) end do end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransNumber(51) call g2sctr(nx, ny, x, y, cx, cy ) call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.false.) ! call DclSetParm('ENABLE_SOFTFILL',.true.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if call uelset('ltone',.true.) if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if ! if(monoto.eqv..true.)then ! call DclShadeContour( shade ) ! else call DclShadeContour( shade ) ! end if call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) call g2qctm( cxmin, cxmax, cymin, cymax ) call DclSetWindow( cxmin, cxmax, cymin, cymax ) call DclSetTransNumber(1) call DclSetTransFunction CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) !-- 地形領域に色塗り if(present(trn_paint))then if(trn_paint.eqv..true.)then if(present(trn_col))then trn_color=trn_col else trn_color=1999 end if do i=1,nx trn(i)=grid_point(i,1) trn_x(i)=x(i) ! if(bot(i)==trn(i))then ! call DclShadeRegion( ) ! end if end do trn(nx+1)=cymin trn(nx+2)=cymin trn_x(nx+1)=x(nx) trn_x(nx+2)=x(1) call DclShadeRegion( trn_x(1:nx+2), trn(1:nx+2), trn_color) end if end if ! call DclSetContourLabelFormat(form_typec) ! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) ! call DclDrawContour( contour ) interc=DclGetContourInterval(1) write(*,*) interc write(val_c,'(E10.3)') interc call DclDrawTitle('b','_CONTOUR INTERVAL ='//val_c//'"',0.0,1) if(present(xg))then do i=1,size(xg,2) call DclDrawLine( xg(:,i), yg(:,i) ) end do end if if(present(layer_line))then if(layer_line.eqv..true.)then do i=1,ny call DclDrawLine( x, grid_point(:,i) ) end do end if end if if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
outname : | character(*), intent(in)
| ||
x(:) : | real, intent(in)
| ||
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)
| ||
form_types : | character(6), 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
| ||
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
| ||
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
|
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, xg, yg, mono, mono_val, mono_lev, trigleg, unitv, vfact, unit_fact_sign, unit_fact, unit_title, unit_posi ) ! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. ! 最大 4 変数同時描画が可能となる. ! 基本的に右にカラーバーがつくので, ユニットベクトルは ! コンターインターバルの下に文字で表示される. use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(inout) :: vecx(size(x),size(y)) ! x 方向のベクトル real, intent(inout) :: vecy(size(x),size(y)) ! x 方向のベクトル integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用) integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用) real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. logical, intent(in), optional :: unitv ! 単位ベクトルを描くかどうか. default = .true. real, intent(in), optional :: vfact(2) ! x,y 方向のスケーリングファクター ! この値を指定すると, 内部的に決められないので, ベクトルが格子以上に ! 伸びる可能性がある. ! 設定しない場合は, x, y の水平スケールと V 系のアスペクト比を考慮 ! して, vfact と一致させるようにする. logical, intent(in), optional :: unit_fact_sign ! unitv = .true. のとき, ! .true. = u, v の U 座標系での値を unit_fact に与えると, ! unit_fact はその値を単位ベクトルの単位として表示する. ! unit の V 座標系の値は u, v の大きい方を 0.1 として表示する. real, intent(in), optional :: unit_fact(2) ! x,y の単位ベクトルの v 座標系での長さ ! default = (0.1,0.1) character(*), intent(in), optional :: unit_title(2) ! x,y の単位ベクトルのタイトル ! default = 描かない. real, intent(in), optional :: unit_posi(2) ! 単位ベクトルを描き始める原点座標 (V 系) ! default = カラーバーの左端と同じで, 図の右下端から開始. ! カラーバーはこれにぶつからないように自動的に短くする. integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: factx, facty real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入 real :: vx_min, vx_max, vy_min, vy_max, vvx_min, vvx_max, vvy_min, vvy_max real :: unitvp(2), unitvl(2), unit_auto_fact(2) real :: undef, RMISS intrinsic :: nint logical :: monoto, unitvs nx=size(x) ny=size(y) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if !-- エラー処理 if(nx<vnx.or.ny<vny)then write(*,*) "*****ERROR***** : vnx > nx or vny > ny." stop end if if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2." stop end if !-- 警告 if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny." else if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then if(mod((nx-1),(vnx-1))/=0)then write(*,*) "****WARNING**** : vnx is not the factor of nx." else write(*,*) "****WARNING**** : vny is not the factor of ny." end if end if end if !-- ベクトル場の間引き factx=real(nx-1)/real(vnx-1) facty=real(ny-1)/real(vny-1) !-- 起点を 1 から始める um(1,1)=vecx(1,1) vm(1,1)=vecy(1,1) do i=2,vnx um(i,1)=vecx(1+nint(factx*(i-1)),1) vm(i,1)=vecy(1+nint(factx*(i-1)),1) end do do j=2,vny um(1,j)=vecx(1,1+nint((j-1)*facty)) vm(1,j)=vecy(1,1+nint((j-1)*facty)) end do do j=2,vny do i=2,vnx um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1))) vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1))) end do end do if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( x(1), x(nx), y(1), y(ny) ) if(present(xg))then do i=1,size(xg,2) call DclScalingPoint( xg(:,i), yg(:,i) ) end do end if !-- ベクトルスケールについての設定 if(present(unit_fact_sign))then if(unit_fact_sign.eqv..true.)then if(present(unit_fact))then unit_auto_fact(1)=unit_fact(1) unit_auto_fact(2)=unit_fact(2) else write(*,*) "### ERROR ### : unit_fact_sign is .true. then," write(*,*) " unit_fact must configure." write(*,*) "STOP." stop end if else unit_auto_fact(1)=1.0 unit_auto_fact(2)=1.0 end if else unit_auto_fact(1)=1.0 unit_auto_fact(2)=1.0 end if if(present(vfact))then call DclSetParm( 'VECTOR:LNRMAL', .false. ) call DclSetParm( 'VECTOR:XFACT1', vfact(1) ) call DclSetParm( 'VECTOR:YFACT1', vfact(2) ) unit_auto_fact(1)=unit_auto_fact(1)*vfact(1) unit_auto_fact(2)=unit_auto_fact(2)*vfact(2) else call DclSetParm( 'VECTOR:LNRMAL', .true.) call DclSetParm( 'VECTOR:XFACT1', unitvl(1) ) call DclSetParm( 'VECTOR:YFACT1', unitvl(2) ) unit_auto_fact(1)=unit_auto_fact(1)*unitvl(1) unit_auto_fact(2)=unit_auto_fact(2)*unitvl(2) unitvl=0.0 end if !-- ユニットベクトルについての設定 if(present(unitv))then unitvs=unitv else unitvs=.true. end if if(unitvs.eqv..true.)then call DclSetParm( 'VECTOR:LUNIT', unitvs ) !-- 単位ベクトルの長さ if(present(unit_fact))then if(present(unit_fact_sign))then if(unit_fact_sign.eqv..true.)then unitvl(:)=unit_auto_fact(:) else unitvl(:)=unit_fact(:) end if else unitvl(:)=unit_fact(:) end if else unitvl=(/0.1, 0.1/) end if !-- 単位ベクトルの書き始めの位置 if(present(unit_posi))then vvx_min=unit_posi(1) vvy_min=unit_posi(2) else vvx_min=vx_max+0.05 vvy_min=vy_min end if vvy_max=vvy_min+unitvl(2)+0.05 call DclSetParm( 'VECTOR:VXUNIT', unitvl(1) ) call DclSetParm( 'VECTOR:VYUNIT', unitvl(2) ) call DclSetParm( 'VECTOR:VXULOC', vvx_min ) call DclSetParm( 'VECTOR:VYULOC', vvy_min ) !-- タイトルを書くかどうか if(present(unit_title))then call DclSetUnitVectorTitle( 'X', trim(unit_title(1)) ) call DclSetUnitVectorTitle( 'Y', trim(unit_title(2)) ) call DclSetParm( 'VECTOR:LUMSG', .false. ) else ! タイトルを書かないなら, グラフの下部にスケーリングファクターを明記 call DclSetParm( 'VECTOR:LUMSG', .true. ) end if else call DclSetParm( 'VECTOR:LUNIT', unitvs ) vvx_min=0.0 vvx_max=0.0 vvy_min=0.0 vvy_max=vy_min end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.false.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if if(monoto.eqv..true.)then call DclShadeContour( shade ) else call DclShadeContourEx( shade ) end if CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) call DclDrawVectors( um, vm ) if(present(xg))then do i=1,size(xg,2) call DclDrawLine( xg(:,i), yg(:,i) ) end do end if if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vvy_max, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vvy_max, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
outname : | character(*), intent(in)
| ||
x(:) : | real, intent(in)
| ||
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)
| ||
form_types : | character(6), 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
| ||
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
| ||
mono : | logical, intent(in), optional
| ||
mono_val(:) : | real, intent(in), optional
| ||
mono_lev(:) : | integer, intent(in), optional
| ||
trigleg : | character(1), 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, xg, yg, mono, mono_val, mono_lev, trigleg ) ! 2 次元で 3 変数を等値線, カラーシェード, ベクトルで描画する. ! 最大 4 変数同時描画が可能となる. ! 基本的に右にカラーバーがつくので, ユニットベクトルは ! コンターインターバルの下に文字で表示される. use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(inout) :: contour(size(x),size(y)) ! 等値線に描く配列 real, intent(inout) :: shade(size(x),size(y)) ! カラーシェードに描く配列 real, intent(inout) :: vecx(size(x),size(y)) ! x 方向のベクトル real, intent(inout) :: vecy(size(x),size(y)) ! x 方向のベクトル integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用) integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用) real, intent(in) :: cont_min ! 等値線を描く最小値 real, intent(in) :: cont_max ! 等値線を描く最大値 real, intent(in) :: shade_min ! シェードを描く最小値 real, intent(in) :: shade_max ! シェードを描く最大値 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd] integer, intent(in) :: days ! 描画日数 [day] character(6), intent(in) :: form_typec ! contour 用のフォーマット character(6), intent(in) :: form_types ! shade 用のフォーマット real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer, intent(in), optional :: color_num ! カラーの数 integer, intent(in), optional :: cont_num ! 等値線の数 character(2), intent(in), optional :: nongrid ! 不等間隔格子にするか. ! nongrid = 'ox' で判断. ! 1 文字目が横軸, 2 文字目が縦軸. ! o = 不等間隔, x = 等間隔. ! デフォルトでは 'xx'. real, intent(in), optional :: xg(:,:) ! x 軸に入れるグリッド線の座標 real, intent(in), optional :: yg(:,:) ! y 軸に入れるグリッド線の座標 ! 第一要素が線の位置データで, 複数本描く場合は, ! 第二要素を 2 個以上にして描く. ! 配列に入れるデータ次第で直線ではなく, 曲線グリッドを ! 描くことも可能. ! 3 本の線を描く場合は, xg(:,1) と yg(:,1) で 1 本の ! 線を表すように指定すること. logical, intent(in), optional :: mono ! モノトーンの階調にする [.true.] ! デフォルトは .false. real, intent(in), optional :: mono_val(:) ! 階調の境界値. ! mono=.true. のときに必ず設定しないとエラーを返す. ! 値は mono_lev + 1 成分存在しなければならない. integer, intent(in), optional :: mono_lev(:) ! トーンマップ番号. dcl の 3 桁 ! mono=.true. のときに設定しないとエラーを返す. character(1), intent(in), optional :: trigleg ! トーンバーの三角形オプション. ! オプションの値は, tone_bar ルーチンの trigle と同じ. integer :: i, j, k ! 作業用添字 integer :: nx, ny, s_num, c_num real :: factx, facty real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入 real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS logical :: monoto nx=size(x) ny=size(y) !-- 日付が与えられているかを表示 write(*,*) "start day is", date%year, date%month, date%day !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if !-- エラー処理 if(nx<vnx.or.ny<vny)then write(*,*) "*****ERROR***** : vnx > nx or vny > ny." stop end if if(nx<2.or.vnx<2.or.ny<2.or.vny<2)then write(*,*) "*****ERROR***** : nx or ny or vnx or vny is less than 2." stop end if !-- 警告 if(mod((nx-1),(vnx-1))/=0.and.mod((ny-1),(vny-1))/=0)then write(*,*) "****WARNING**** : vnx or vny is not the factor of nx and ny." else if(mod((nx-1),(vnx-1))/=0.or.mod((ny-1),(vny-1))/=0)then if(mod((nx-1),(vnx-1))/=0)then write(*,*) "****WARNING**** : vnx is not the factor of nx." else write(*,*) "****WARNING**** : vny is not the factor of ny." end if end if end if !-- ベクトル場の間引き factx=real(nx-1)/real(vnx-1) facty=real(ny-1)/real(vny-1) !-- 起点を 1 から始める um(1,1)=vecx(1,1) vm(1,1)=vecy(1,1) do i=2,vnx um(i,1)=vecx(1+nint(factx*(i-1)),1) vm(i,1)=vecy(1+nint(factx*(i-1)),1) end do do j=2,vny um(1,j)=vecx(1,1+nint((j-1)*facty)) vm(1,j)=vecy(1,1+nint((j-1)*facty)) end do do j=2,vny do i=2,vnx um(i,j)=vecx(1+nint(factx*(i-1)),1+nint(facty*(j-1))) vm(i,j)=vecy(1+nint(factx*(i-1)),1+nint(facty*(j-1))) end do end do if(present(color_num))then s_num=color_num else s_num=56 end if if(present(cont_num))then c_num=cont_num else c_num=10 end if if(present(mono))then if(present(mono_val).and.present(mono_lev))then if(size(mono_val)-1==size(mono_lev))then monoto=mono else write(*,*) "*** ERROR ***" write(*,*) "[array number] : mono_val = mono_lev + 1" write(*,*) "STOP" stop end if else write(*,*) "*** ERROR ***" write(*,*) "When option MONO is true, MONO_VAL and MONO_LEV must be specified." write(*,*) "STOP" stop end if else monoto=.false. end if !-- 処理ここまで --- call undef_CReSS2Dcl( nx, ny, 1, contour) call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( 0.0, real(days), y(1), y(ny) ) if(present(xg))then do i=1,size(xg,2) call DclScalingPoint( xg(:,i), yg(:,i) ) end do end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclClearShadeLevel call DclSetShadeLevel( mono_val, mono_lev ) else call DclSetParm('ENABLE_SOFTFILL',.false.) ! call DclClearShadeLevel ! call DclSetShadeLevel( shade_min, shade_max, & ! & (shade_max-shade_min)/s_num ) end if if(present(nongrid))then if(nongrid(1:1)=='o')then call DclSetXGrid( x ) end if if(nongrid(2:2)=='o')then call DclSetYgrid( y ) end if end if if(monoto.eqv..true.)then call DclShadeContour( shade ) else call DclShadeContourEx( shade ) end if CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawAxisCalendar( 'bt', date, nd=days ) call DclDrawScaledAxis( 'lr' ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) call DclSetContourLabelFormat(form_typec) call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/c_num ) call DclDrawContour( contour ) call DclDrawVectors( um, vm ) if(present(xg))then do i=1,size(xg,2) call DclDrawLine( xg(:,i), yg(:,i) ) end do end if if(present(trigleg))then call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto, trigle=trigleg ) else call tone_bar( s_num, shade_min, shade_max, vx_max+0.05, vx_max+0.075, vy_min, vy_max, form_types, mono_log=monoto ) end if end subroutine
Subroutine : | |||
judge : | character(1), intent(in)
| ||
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)
| ||
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, xline, yline, xpoint, ypoint, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax ) ! 2 次元平面内において複数の曲線, ポイントで描画する. ! 与える曲線とポイントはそれぞれ別個の配列で定義されており, ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を ! 第二要素で曲線の本数を設定. ポイントについても同様. ! つまり, 例として以下のように配列を用意する. ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ! ポイントを 100 個描きたいとすると, ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) ! として引数に読み込ませればよい. ! このとき, 上の引数に対応する関係は以下のとおりである. ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100 use dcl implicit none character(1), intent(in) :: judge ! グラフの種類 ! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画. ! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり. character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: xline(:,:) ! 曲線群の x 座標 real, intent(in) :: yline(size(xline,1),size(xline,2)) ! 曲線群の y 座標 real, intent(in) :: xpoint(:,:) ! ポイント群の x 座標 real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2)) ! ポイント群の y 座標 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 real, intent(in), optional :: xmin ! x 方向のグラフ左端 real, intent(in), optional :: xmax ! x 方向のグラフ右端 real, intent(in), optional :: ymin ! y 方向のグラフ左端 real, intent(in), optional :: ymax ! y 方向のグラフ右端 integer :: i, j, k ! 作業用添字 integer, parameter :: lim=990 ! ラインインデックスの最大値 integer :: nnum, lstep, pstep, lnum, pnum real :: vx_min, vx_max, vy_min, vy_max lstep=size(xline,1) pstep=size(xpoint,1) lnum=size(xline,2) pnum=size(xpoint,2) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if !-- 処理ここまで --- call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame if(present(xmin))then call DclSetWindow( xmin, xmax, ymin, ymax ) else if(judge=='p'.or.judge=='a')then do i=1,pnum call DclScalingPoint( xpoint(:,j), ypoint(:,j) ) end do end if if(judge=='l'.or.judge=='a')then do j=1,lnum call DclScalingPoint( xline(:,j), yline(:,j) ) end do end if call DclFitScalingParm end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction ! call DclShadeContourEx( shade ) CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) !-- ポイントと曲線の設定 --- !-- num 数に応じて do ループで回すので, num 数は任意で OK. !-- num = 1 の場合は黒色で固定 if(judge=='p'.or.judge=='a')then if(pnum==1)then call DclDrawMarker( xpoint(:,1), ypoint(:,1) ) else do i=1,pnum call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j ) end do end if end if if(judge=='l'.or.judge=='a')then if(lnum==1)then call DclDrawLine( xline(:,1), yline(:,1) ) else nnum=lim/lnum do j=1,lnum call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) ) end do end if end if ! call DclSetContourLabelFormat(form_typec) ! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 ) ! call DclDrawContour( contour ) ! call DclDrawVectors( um, vm ) end subroutine
Subroutine : | |||
judge : | character(1), intent(in)
| ||
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)
| ||
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, xline, yline, xpoint, ypoint, x_title, y_title, date, days, viewx_min, viewx_max, viewy_min, viewy_max, xmin, xmax, ymin, ymax ) ! 2 次元平面内において複数の曲線, ポイントで描画する. ! 与える曲線とポイントはそれぞれ別個の配列で定義されており, ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を ! 第二要素で曲線の本数を設定. ポイントについても同様. ! つまり, 例として以下のように配列を用意する. ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ! ポイントを 100 個描きたいとすると, ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) ! として引数に読み込ませればよい. ! このとき, 上の引数に対応する関係は以下のとおりである. ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100 use dcl implicit none character(1), intent(in) :: judge ! グラフの種類 ! 'p' = ポイントのみ描画, 'l' = ラインのみ, 'a' = 両方描画. ! 片方しか描画しない場合でも, ダミー配列を読み込ませる必要あり. character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: xline(:,:) ! 曲線群の x 座標 real, intent(in) :: yline(size(xline,1),size(xline,2)) ! 曲線群の y 座標 real, intent(in) :: xpoint(:,:) ! ポイント群の x 座標 real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2)) ! ポイント群の y 座標 character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル type(dcl_date), intent(in) :: date ! 開始日付 [yyyy:mm:dd] integer, intent(in) :: days ! 描画日数 [day] real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 real, intent(in), optional :: xmin ! x 方向のグラフ左端 real, intent(in), optional :: xmax ! x 方向のグラフ右端 real, intent(in), optional :: ymin ! y 方向のグラフ左端 real, intent(in), optional :: ymax ! y 方向のグラフ右端 integer :: i, j, k ! 作業用添字 integer, parameter :: lim=990 ! ラインインデックスの最大値 integer :: nnum integer :: lstep, pstep, lnum, pnum real :: vx_min, vx_max, vy_min, vy_max lstep=size(xline,1) pstep=size(xpoint,1) lnum=size(xline,2) pnum=size(xpoint,2) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if !-- 処理ここまで --- call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame if(present(xmin))then call DclSetWindow( xmin, xmax, ymin, ymax ) else if(judge=='p'.or.judge=='a')then do i=1,pnum call DclScalingPoint( xpoint(:,j), ypoint(:,j) ) end do end if if(judge=='l'.or.judge=='a')then do j=1,lnum call DclScalingPoint( xline(:,j), yline(:,j) ) end do end if call DclFitScalingParm end if call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction ! call DclShadeContourEx( shade ) CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawAxisCalendar( 'bt', date, nd=days ) call DclDrawScaledAxis( 'lr' ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) !-- ポイントと曲線の設定 --- !-- num 数に応じて do ループで回すので, num 数は任意で OK. !-- num = 1 の場合は黒色で固定 if(judge=='p'.or.judge=='a')then if(pnum==1)then call DclDrawMarker( xpoint(:,1), ypoint(:,1) ) else do i=1,pnum call DclDrawMarker( xpoint(:,j), ypoint(:,j), type=j ) end do end if end if if(judge=='l'.or.judge=='a')then if(lnum==1)then call DclDrawLine( xline(:,1), yline(:,1) ) else nnum=lim/lnum do j=1,lnum call DclDrawLine( xline(:,j), yline(:,j), index=(100+nnum*(j-1)+1) ) end do end if end if ! call DclSetContourLabelFormat(form_typec) ! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 ) ! call DclDrawContour( contour ) ! call DclDrawVectors( um, vm ) end subroutine
Subroutine : | |||
outname : | character(*), intent(in)
| ||
x(:) : | real, intent(in)
| ||
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)
| ||
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, xline, yline, xpoint, ypoint, vecx, vecy, vnx, vny, x_title, y_title, viewx_min, viewx_max, viewy_min, viewy_max ) ! 2 次元平面内においてベクトルと複数の曲線, ポイントで描画する. ! 与える曲線とポイントはそれぞれ別個の配列で定義されており, ! 曲線については, x, y 座標の 2 種類, ポイントについても同様の 2 種類, ! さらに曲線の x, y 座標用配列は第一要素で 1 本の曲線の連続を ! 第二要素で曲線の本数を設定. ポイントについても同様. ! つまり, 例として以下のように配列を用意する. ! 3 本の曲線, 5 種類のポイントを描きたく, 曲線については 1 本の曲線を ! 描くためには 1000 個の点の連続で描かれ, ポイントについては 1 種類の ! ポイントを 100 個描きたいとすると, ! xline(1000, 3), yline(1000, 3), xpoint(100, 5), y(100, 5) ! として引数に読み込ませればよい. ! このとき, 上の引数に対応する関係は以下のとおりである. ! lnum = 3, pnum = 5, lstep = 1000, pstep = 100 use dcl implicit none character(*), intent(in) :: outname ! グラフのタイトル real, intent(in) :: x(:) ! x 方向の格子点座標 real, intent(in) :: y(:) ! y 方向の格子点座標 real, intent(in) :: xline(:,:) ! 曲線群の x 座標 real, intent(in) :: yline(size(xline,1),size(xline,2)) ! 曲線群の y 座標 real, intent(in) :: xpoint(:,:) ! ポイント群の x 座標 real, intent(in) :: ypoint(size(xpoint,1),size(xpoint,2)) ! ポイント群の y 座標 real, intent(in) :: vecx(size(x),size(y)) ! x 方向のベクトル real, intent(in) :: vecy(size(x),size(y)) ! x 方向のベクトル integer, intent(in) :: vnx ! x 方向のベクトル格子点 (間引き使用) integer, intent(in) :: vny ! y 方向のベクトル格子点 (間引き使用) character(*), intent(in) :: x_title ! x 軸のタイトル character(*), intent(in) :: y_title ! y 軸のタイトル real, intent(in), optional :: viewx_min ! ビューポートの x 方向の最小値 real, intent(in), optional :: viewx_max ! ビューポートの x 方向の最大値 real, intent(in), optional :: viewy_min ! ビューポートの y 方向の最小値 real, intent(in), optional :: viewy_max ! ビューポートの y 方向の最大値 integer :: i, j, k ! 作業用添字 integer :: nx, ny integer :: lstep, pstep, lnum, pnum real :: factx, facty real, dimension(vnx,vny) :: um, vm ! ベクトル間引き後の値を代入 real :: vx_min, vx_max, vy_min, vy_max real :: undef, RMISS nx=size(x) ny=size(y) lstep=size(xline,1) pstep=size(xpoint,1) lnum=size(xline,2) pnum=size(xpoint,2) !-- optional 引数の処理 --- if(present(viewx_min))then vx_min=viewx_min else vx_min=0.2 end if if(present(viewx_max))then vx_max=viewx_max else vx_max=0.8 end if if(present(viewy_min))then vy_min=viewy_min else vy_min=0.2 end if if(present(viewy_max))then vy_max=viewy_max else vy_max=0.8 end if !-- エラー処理 if(nx<vnx.or.ny<vny)then write(*,*) "*****ERROR***** : vnx > nx or vny > ny." stop end if !-- 警告 if(mod(nx,(vnx-1))/=0.or.mod(ny,(vny-1))/=0)then write(*,*) "****WARNING**** : vnx or vny is not the factor of nx or ny." end if !-- ベクトル場の間引き factx=real(nx)/real(vnx-1) facty=real(ny)/real(vny-1) !-- 起点を 1 から始める um(1,1)=vecx(1,1) vm(1,1)=vecy(1,1) do i=2,vnx um(i,1)=vecx(int(factx*(i-1)),1) vm(i,1)=vecy(int(factx*(i-1)),1) end do do j=2,vny um(1,j)=vecx(1,int((j-1)*facty)) vm(1,j)=vecy(1,int((j-1)*facty)) end do do j=2,vny do i=2,vnx um(i,j)=vecx(int(factx*(i-1)),int(facty*(j-1))) vm(i,j)=vecy(int(factx*(i-1)),int(facty*(j-1))) end do end do !-- 処理ここまで --- ! call undef_CReSS2Dcl( nx, ny, 1, contour) ! call undef_CReSS2Dcl( nx, ny, 1, shade) call UWSGXZ(.FALSE.) call UWSGYZ(.FALSE.) call DclNewFrame call DclSetWindow( x(1), x(nx), y(1), y(ny) ) call DclSetViewPort( vx_min, vx_max, vy_min, vy_max ) call DclSetTransFunction ! call DclShadeContourEx( shade ) CALL UZLSET( 'LABELYL', .TRUE. ) CALL UZLSET( 'LABELYR', .FALSE. ) call DclDrawScaledAxis call DclDrawTitle( 'b', x_title, 0.0 ) call DclDrawTitle( 'l', y_title, 0.0 ) call DclDrawTitle( 't', outname, 0.0, 2 ) !-- ポイントと曲線の設定 --- !-- num 数に応じて do ループで回すので, num 数は任意で OK. !-- num = 1 の場合は黒色で固定 if(pnum==1)then call DclDrawMarker( xpoint(:,1), yline(:,1) ) else do i=1,pnum call DclDrawMarker( xpoint(:,j), yline(:,j), type=j ) end do end if if(lnum==1)then call DclDrawLine( xline(:,1), yline(:,1) ) else do j=1,lnum call DclDrawLine( xline(:,j), yline(:,j), index=(90+10*j+1) ) end do end if ! call DclSetContourLabelFormat(form_typec) ! call DclSetContourLevel( cont_min, cont_max, (cont_max-cont_min)/10 ) ! call DclDrawContour( contour ) call DclDrawVectors( um, vm ) end subroutine
Subroutine : | |||
head : | character(*), intent(in)
| ||
time : | integer, intent(in)
| ||
title : | character(*), intent(inout)
| ||
forma : | character(6), intent(in), optional
| ||
factor : | integer, intent(in), optional
| ||
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 : | |||
x_length : | real, intent(in)
| ||
y_length : | real, intent(in)
| ||
vx_length : | real, intent(in)
| ||
vy_length : | 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( x_length, y_length, vx_length, vy_length, vx_scale, vy_scale ) ! 風速ベクトルを描画アスペクト比に合わせるための V 座標系における単位ベクトル ! を計算するルーチン. x 方向の値を指定し, そのときの y 方向のスケールを決める. ! 計算方法は以下のとおり. ! U 座標系で (uu, uv) のベクトルを V 座標系で (vu,vv) にしたい. ! (vu, vv)=(vx_scale*uu, vy_scale*uv) という関係をもつ. ! 一方, グラフの描画領域の幅を U, V 座標系でそれぞれ ux, uy, vx, vy とすると, ! x 方向を基準に y 方向の伸縮を決めるとき, ! v 座標系では, vy/vx=v_asp 倍だけ y 方向ベクトルにかけ, ! u 座標系では, 1/(uy/ux)=1/u_asp 倍だけ y 方向ベクトルにかけるので, ! (vu, vv)=(vx_scale*uu, (v_asp/u_asp)*vy_scale*vy) という関係をもてばよい. ! これについての詳しい概念図は Tex ファイル参照. ! よって, vx_scale, vy_scale が同じ比率で変化するとき, ! (つまり, 風速ベクトルとして変化するとき) ! vy_scale=vx_scale*v_asp*u_asp となる. implicit none real, intent(in) :: x_length ! 横方向の描画距離 [m] real, intent(in) :: y_length ! 縦方向の描画距離 [m] real, intent(in) :: vx_length ! 縦方向の V 系での描画範囲 real, intent(in) :: vy_length ! 横方向の V 系での描画範囲 real, intent(in) :: vx_scale ! x 方向のスケーリングファクター real, intent(inout) :: vy_scale ! y 方向のスケーリングファクター real :: u_asp, v_asp u_asp=y_length/x_length v_asp=vy_length/vx_length vy_scale=(v_asp/u_asp)*vx_scale end subroutine
Subroutine : | |||
color_num : | integer, intent(in)
| ||
val_min : | real, intent(in)
| ||
val_max : | real, intent(in)
| ||
col_tab : | integer, intent(in), optional
| ||
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
|
カラーマップの色と数値を対応させる自動ルーチン
subroutine color_setting( color_num, val_min, val_max, col_tab, col_max, col_min, col_bg, reverse, min_tab, max_tab ) ! カラーマップの色と数値を対応させる自動ルーチン use dcl implicit none integer, intent(in) :: color_num ! 使用するカラーの種類 real, intent(in) :: val_min ! 描くカラーの最小値 real, intent(in) :: val_max ! 描くカラーの最大値 integer, intent(in), optional :: col_tab ! dcl のカラーテーブル integer, intent(in), optional :: col_min ! 使用するカラー番号の最小値(上2桁) integer, intent(in), optional :: col_max ! 使用するカラー番号の最大値(上2桁) logical, intent(in), optional :: col_bg ! 背景色の入れ替え デフォルトなし. integer :: map_num ! カラーマップのマップ番号指定 (optional 属性をつけること) integer :: i, j, k ! 作業用添字 logical, intent(in), optional :: reverse ! カラー番号を反転させる. integer, intent(in), optional :: min_tab ! val_min 以下の値に対応するカラー番号, デフォルトは黒 integer, intent(in), optional :: max_tab ! val_max 以上の値に対応するカラー番号, デフォルトは黒 integer :: ipat real :: dv ! カラーマップに対応する値の幅 integer :: cmap_min, cmap_max real :: tlev1, tlev2 logical :: rev real :: white_min, black_max real :: RMISS integer :: white, black, ITON !-- Dcl 側の undef 値セット CALL GLRGET( 'RMISS', RMISS ) CALL GLLSET( 'LMISS', .TRUE. ) if(present(col_tab))then map_num=col_tab else map_num=1 end if if(present(col_min))then cmap_min=col_min else cmap_min=14 end if if(present(col_max))then cmap_max=col_max else cmap_max=85 end if if(present(col_bg))then call SWpSET( 'LFGBG', col_bg ) end if if(present(reverse))then rev=reverse else rev=.false. end if if(present(min_tab))then white=min_tab else white=999 end if if(present(max_tab))then black=max_tab else black=1999 end if call sgscmn(map_num) call UEITLV !-- val_max 以上を black で塗る TLEV1=RMISS TLEV2=val_min IPAT=white CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT ) ! CALL UEQTLV( TLEV1, TLEV2, IPAT, color_num+2 ) ! write(*,*) TLEV1, TLEV2, IPAT dv=(val_max-val_min)/color_num if(rev.eqv..true.)then do k=1,color_num TLEV1=val_min+(k-1)*dv TLEV2=TLEV1+dv IPAT=(cmap_min+int((color_num-k)*(real(cmap_max-cmap_min)/real(color_num-1))))*1000+999 CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT ) ! CALL UEQTLV( TLEV1, TLEV2, IPAT, k ) ! write(*,*) TLEV1, TLEV2, IPAT end do else do k=1,color_num TLEV1=val_min+(k-1)*dv TLEV2=TLEV1+dv IPAT=(cmap_min+int((k-1)*(real(cmap_max-cmap_min)/real(color_num-1))))*1000+999 CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT ) ! CALL UEQTLV( TLEV1, TLEV2, IPAT, k ) ! write(*,*) TLEV1, TLEV2, IPAT end do end if TLEV1=val_max TLEV2=RMISS IPAT=black CALL DclSetShadeLevel( TLEV1, TLEV2, IPAT ) ! CALL UEQTLV( TLEV1, TLEV2, IPAT, color_num+1 ) write(*,*) TLEV1, TLEV2, IPAT end subroutine
Subroutine : | |||
val_type : | character(1), intent(in)
| ||
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_min : | real, intent(in)
| ||
val_max : | 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_min, val_max, nega_ton_tab, full_tone ) ! color_setting のモノトーンバージョン ! トーンテーブルは白を抜いて 5 種類しかないので, val_min, val_max を強制的に 5 分割し, トーンを当てはめる. ! また, nega_ton_tab が指定されていれば, 10 分割する. use dcl implicit none integer, intent(in), optional :: ton_tab ! dcl のトーンテーブル real, intent(in) :: val_min ! 描くカラーの最小値 real, intent(in) :: val_max ! 描くカラーの最大値 integer, intent(in), optional :: nega_ton_tab ! トーンテーブルを 2 枚使うとき, 値の小さい領域に向かって濃くしていく場合に指定. このトーンを 0 から負方向に濃くしていく. logical, intent(in), optional :: full_tone ! 白を合わせると, 各トーンで 6 段階あるので, val_min, val_max の差を強制的に 6 分割してトーンを割り当てる. ただし, これをすると, トーンの境界値が切りのよい数値にならない時がある. 値は .true. で有効となる. integer :: map_num ! カラーマップのマップ番号指定 (optional 属性をつけること) integer :: i, j, k ! 作業用添字 integer :: ipat, itvtone, tone_mapping real :: dv ! カラーマップに対応する値の幅 integer :: cmap_min, cmap_max real :: tlev1, tlev2 call UEITLV if(present(nega_ton_tab))then if(present(full_tone))then if(full_tone.eqv..true.)then itvtone=12 else itvtone=10 end if else itvtone=10 end if else if(present(full_tone))then if(full_tone.eqv..true.)then itvtone=6 else itvtone=5 end if else itvtone=5 end if end if dv=(val_max-val_min)/real(itvtone) if(itvtone==10.or.itvtone==12)then tone_mapping=itvtone/2 else tone_mapping=itvtone end if if(itvtone==tone_mapping)then do k=1,tone_mapping TLEV1=val_min+(k-1)*dv TLEV2=TLEV1+dv IPAT=100*ton_tab+k CALL UESTLV( TLEV1, TLEV2, IPAT ) end do else do k=1,tone_mapping TLEV1=0.5*(val_max+val_min)+(k-1)*dv TLEV2=TLEV1+dv IPAT=100*ton_tab+k CALL UESTLV( TLEV1, TLEV2, IPAT ) write(*,*) "tlev", tlev1, tlev2 end do do k=1,tone_mapping TLEV1=0.5*(val_max+val_min)-k*dv TLEV2=TLEV1+dv IPAT=100*nega_ton_tab+k CALL UESTLV( TLEV1, TLEV2, IPAT ) write(*,*) "bgtlev", tlev1, tlev2 end do end if end subroutine
Subroutine : | |||
color_num : | integer, intent(in)
| ||
shade_min : | real, intent(in)
| ||
shade_max : | real, intent(in)
| ||
vx_min : | real, intent(in)
| ||
vx_max : | real, intent(in)
| ||
vy_min : | real, intent(in)
| ||
vy_max : | 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
|
右にトーンバーを自動生成する
subroutine tone_bar( color_num, shade_min, shade_max, vx_min, vx_max, vy_min, vy_max, form_types, mono_log, trigle, tricmin, tricmax, trifact ) ! & tricmin, tricmax, trifact, col_mem_num, col_mem_int ) ! 右にトーンバーを自動生成する use dcl implicit none integer, intent(in) :: color_num ! 使用する色の数 real, intent(in) :: shade_min ! 最小値 real, intent(in) :: shade_max ! 最大値 real, intent(in) :: vx_min ! ビューポートの x 方向の最小値 real, intent(in) :: vx_max ! ビューポートの x 方向の最大値 real, intent(in) :: vy_min ! ビューポートの y 方向の最小値 real, intent(in) :: vy_max ! ビューポートの y 方向の最大値 character(6), intent(in) :: form_types ! ラベルフォーマット logical, intent(in), optional :: mono_log character(1), intent(in), optional :: trigle ! grads 風な三角形を出すかどうか ! [u] = 上だけ, [d] = 下だけ, [a] = 両方, デフォルトでは描かない integer, intent(in), optional :: tricmin ! 下端三角に描くカラーマップ番号 5 桁 integer, intent(in), optional :: tricmax ! 上端三角に描くカラーマップ番号 5 桁 ! これらの色は設定されていなければ, color_setting でセットされている色を使うようにする. real, intent(in), optional :: trifact ! 三角形の高さ (横辺と同じ長さを 1 としてその factor 倍する比率. デフォルトは 1.) !!!!!!!!!!!!!!!!!!!!!!!!!!!! 以下2つは改めて復活 ! integer, intent(in), optional :: col_mem_num ! バーの目盛の数. デフォは 10本. ! real, intent(in), optional :: col_mem_int(col_mem_num) ! 目盛の値を指定する. 配列数は col_mem_num に一致. real, parameter :: RMISS=999.0 integer :: k real :: pi(2,color_num+1) real :: dp real, allocatable :: coldim1(:), coldim2(:) ! real :: coldim1(color_num+1), coldim2(color_num/2+1) logical :: monoto ! モノトーンの処理 real, dimension(3) :: triux, triuy, tridx, tridy real :: factoru, clev1, clev2 integer :: tricmin_num, tricmax_num ! 多角形領域の指定では, 三角形の頂点位置座標がわかればよいので, ! 各座標配列は 3 つ必要 real :: vpx_min, vpx_max, vpy_min, vpy_max ! 実際にとる viewport, trigle 用バッファ. integer :: memori_num !-- オプションの処理 if(present(mono_log))then monoto=mono_log else monoto=.false. end if if(present(trigle))then if(present(trifact))then factoru=trifact else factoru=1.0 end if if(present(tricmin))then tricmin_num=tricmin else CALL DclGetShadeLevel( 1, clev1, clev2, tricmin_num ) write(*,*) "### downer color is", tricmin_num end if if(present(tricmax))then tricmax_num=tricmax else CALL DclGetShadeLevel( color_num+2, clev1, clev2, tricmax_num ) write(*,*) "### upper color is", tricmax_num end if select case(trigle) case('a') triux(1)=vx_min triux(2)=(vx_max+vx_min)*0.5 triux(3)=vx_max triuy(1)=vy_max-factoru*(vx_max-vx_min) triuy(2)=vy_max triuy(3)=triuy(1) tridx=triux tridy(1)=vy_min+factoru*(vx_max-vx_min) tridy(2)=vy_min tridy(3)=tridy(1) vpy_min=tridy(1) vpy_max=triuy(1) case('u') triux(1)=vx_min triux(2)=(vx_max+vx_min)*0.5 triux(3)=vx_max triuy(1)=vy_max triuy(2)=vy_max+factoru*(vx_max-vx_min) triuy(3)=triuy(1) vpy_min=vy_min vpy_max=triuy(1) case('d') tridx(1)=vx_min tridx(2)=(vx_max+vx_min)*0.5 tridx(3)=vx_max tridy(1)=vy_min tridy(2)=vy_min-factoru*(vx_max-vx_min) tridy(3)=tridy(1) vpy_min=tridy(1) vpy_max=vy_max end select vpx_min=vx_min vpx_max=vx_max else vpx_min=vx_min vpx_max=vx_max vpy_min=vy_min vpy_max=vy_max end if !-- 処理ここまで call GRFIG call DclSetWindow( 0.0, 1.0, shade_min, shade_max ) call DclSetViewPort( vpx_min, vpx_max, vpy_min, vpy_max ) call GRSTRN(1) call DclSetTransFunction dp = (shade_max-shade_min)/color_num do k=1,color_num+1 PI(1,K) = shade_min + (K-1)*DP PI(2,K) = shade_min + (K-1)*DP end do !-- トーンの目盛を描くための配列を調整. !-- デフォルトは 10 本 !-- ここの if 文はよく再考 ! if(present(col_mem_num))then ! if(present(col_mem_int))then ! allocate(coldim1(col_mem_num)) ! allocate(coldim2(col_mem_num/2)) ! do k=1,col_mem_num ! coldim1(k)=col_mem_num(k) ! end do ! do k=1,col_mem_num/2 ! coldim1(k)=col_mem_num(2*k-1) ! end do ! do k=1,col_mem_num+1 ! coldim1(k)=PI(1,k) ! end do ! do k=1,col_mem_num/2+1 ! coldim2(k)=PI(1,2*k-1) ! end do ! else ! do k=1,col_mem_num+1 ! coldim1(k)=PI(1,k) ! end do ! do k=1,col_mem_num/2+1 ! coldim2(k)=PI(1,2*k-1) ! end do ! end if ! else do k=1,color_num+1 coldim1(k)=PI(1,k) end do do k=1,color_num/2+1 coldim2(k)=PI(1,2*k-1) end do ! end if call DclSetXGrid( (/0.0,1.0/) ) call DclSetYGrid( PI(1,:) ) if(monoto.eqv..true.)then call DclSetParm('ENABLE_SOFTFILL',.true.) call DclShadeContour( PI ) else call DclSetParm('ENABLE_SOFTFILL',.false.) call DclShadeContourEx( PI ) end if CALL SLPVPR( 3 ) CALL UZLSET( 'LABELYR', .TRUE. ) CALL UZLSET( 'LABELYL', .FALSE. ) CALL UYSFMT( form_types ) CALL UYAXNM( 'R', coldim1, color_num+1, coldim2, color_num/2+1 ) CALL UYAXNM( 'L', coldim1, color_num+1, coldim2, color_num/2+1 ) !-- 実際に三角形領域を描く if(present(trigle))then select case(trigle) case('a') call DclShadeRegionNormalized( triux, triuy, tricmax_num ) call DclShadeRegionNormalized( tridx, tridy, tricmin_num ) call DclDrawLineNormalized( triux, triuy, index=13 ) call DclDrawLineNormalized( tridx, tridy, index=13 ) case('u') call DclShadeRegionNormalized( triux, triuy, tricmax_num ) call DclDrawLineNormalized( triux, triuy, index=13 ) case('d') call DclShadeRegionNormalized( tridx, tridy, tricmin_num ) call DclDrawLineNormalized( tridx, tridy, index=13 ) end select end if deallocate(coldim1) deallocate(coldim2) ! CALL UYAXDV( 'R', (shade_max-shade_min)/real(color_num), (shade_max-shade_min)/real(0.5*color_num) ) ! CALL UYAXDV( 'L', (shade_max-shade_min)/real(color_num), (shade_max-shade_min)/real(0.5*color_num) ) end subroutine
Subroutine : | |||
nx : | integer, intent(in)
| ||
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