!------------------------------------------------- ! UDpack Module !------------------------------------------------- module udpack use dcl_common interface DclSetCoutourLevel module procedure DclSetContourA, DclSetContourB end interface private :: DclSetContourA, DclSetContourB contains subroutine DclDrawContour(z) !2次元等高線図を描く real, intent(in), dimension(:,:) :: z integer, dimension((size(z,1)+2)*(size(z,2)+2)*6/32+4) :: ibr nx = size(z,1) ny = size(z,2) nbr = (size(z,1)+2)*(size(z,2)+2)*6/32+4 call udcntz(z,nx,nx,ny,ibr,nbr) end subroutine subroutine DclSetContourA(xmin, xmax, dx) !コンターレベル値を設定する. real, intent(in) :: xmin,xmax !コンターレベルの最小最大値 real, intent(in) :: dx !きざみ幅 call udgcla(xmin,xmax,dx) end subroutine subroutine DclSetContourB(z,dx) !コンターレベル値を配列で設定する. real, intent(in), dimension(:,:) :: z ! 2次元配列 real, intent(in) :: dx !きざみ幅 nx = size(z,1) ny = size(z,2) call udgclb(z,nx,nx,ny,dx) end subroutine !----------------------------------------------------- ! コンターラインの属性を指定して1本のコンターレベルを設定する. subroutine DclSetContourLine(level,index ,type ,label ,height) real, intent(in) :: level integer, intent(in), optional :: index,type character(len=*), intent(in), optional :: label real, intent(in), optional :: height logical :: ldash character(len=8) :: label0 if(present(type)) then itype0 = type else call udlget('ldash', ldash) if(ldash .and. level<0.) then call udiget('idash', itype0) else call udiget('isolid', itype0) end if end if if(present(index)) then index0 = index else call udiget('indxmn', index0) end if if(present(label)) then label0 = label else label0 = " " end if if(present(height)) then height0 = height else height0 = 0. end if call udsclv(level,index0,itype0,label0,height0) end subroutine !----------------------------------------------------- ! 第nl番目のコンターレベルの属性 subroutine DclGetContourLine(number,level,index,type,label,height) integer, intent(in) :: number real, intent(out), optional :: level integer, intent(out), optional :: index,type character(len=*), intent(out), optional :: label real, intent(out), optional :: height character(len=8) :: label0 call udqclv(zlev0,index0,itype0,label0,height0,number) if(present(level)) level = zlev0 if(present(type )) type = itype0 if(present(index)) index = index0 if(present(label)) label = label0 if(present(height)) height = height0 end subroutine function DclGetContourLevelNumber() !現在設定されているコンターレベルの総本数 integer :: DclGetContourLevelNumber call udqcln(DclGetContourLevelNumber) end function subroutine DclDelContourLevel(zlev) !あるコンターレベルを削除する. real, intent(in) :: zlev !削除するコンターレベルの値 call uddclv(zlev) end subroutine subroutine DclClearCounourLevel() !コンターレベルを無効にする. call udiclv() end subroutine function DclGetContourInterval(nlev) !コンターレベルの間隔を求める. integer, intent(in) :: nlev !何番目のコンター間隔を調べるか指定する DclGetContourInterval = rudlev(nlev) end function subroutine DclSetContourLabelFormat(cfmt) !コンターラベルのフォーマットを指定する. character(len=*), intent(in) :: cfmt !指定するフォーマット(長さは16文字以下) call udsfmt(cfmt) end subroutine subroutine DclGetContourLabelFormat(cfmt) !現在設定されているフォーマット character(len=*), intent(out) :: cfmt call udqfmt(cfmt) end subroutine end module