!DEC$DEFINE Main_mPlot ! Double-comment this line if ! you don't want demo program ! *********************************************************** ! * This file contains the package of MATLAB-style-callable * ! * routines for plain graphics and few calling examples. * ! * RGB color scheme is used (TrueColor mode supported). * ! * Compile in DVF 5.x environment (e.g. as QuickWin Appl.) * ! * Last modified: 03/20/99 * ! * Bugs to: Valery E.Grikurov * ! *********************************************************** !DEC$IF DEFINED (Main_mPlot) program mPlot use dflib !************** GLOBAL PACKAGE VARIABLES *********************** integer(4), parameter :: DW = 33 ! Descriptor of Dialog Window, may be any integer ! larger the number of "open" statements in your code integer(4) nfig ! Graph windows counter integer(4) bkclr /0/ ! Initial background color (0 - black, 1 - white) logical(4) ifhold /.FALSE./ ! .TRUE. if hold is on, .FALSE. otherwise logical(4) ifgrid /.FALSE./ ! .TRUE. if grid is on, .FALSE. otherwise logical(4) ifaxis /.TRUE./ ! .TRUE. for default axis behavior, .FALSE. otherwise integer(4) dummy ! Dummy integer !*********** END of GLOBAL PACKAGE VARIABLES ******************* character(1) yes complex(8) w(-1000:1000) real(8) x(-1000:1000),y(-1000:1000) ! Maximazing main window type (QWINFO) wn wn.type=qwin$max dummy=setwsizeqq(qwin$framewindow,wn) ! Openning Dialog (user's I/O) Window !********************* PACKAGE ROUTINES *********************** call OpenDialogBox() !***************** END of PACKAGE ROUTINES *********************** ! Example 1 mp = 100! Points of each curve mc = 6 ! Number of curves hp = 0.05 hc = 0.25 write(DW,*) 'Example 1: Mapping of Cartesian lines by sin(z)' !********************* PACKAGE ROUTINES *********************** call whitebg() call figure(1) call grid('on') call axis( (/-3.,3.,-3.,3./), (/1,1/) ) !***************** END of PACKAGE ROUTINES *********************** do jc = -mc,mc do jp = -mp,mp ! Horizontal lines w(jp) = sin(cmplx( hp*jp, hc*jc, 8)) enddo x = real(w) y = imag(w) !********************* PACKAGE ROUTINES *********************** call plot( x(-mp:mp), y(-mp:mp) ) call legend('Im Z = const', 'b') !***************** END of PACKAGE ROUTINES *********************** do jp = -mp,mp ! Verticalal lines w(jp) = sin(cmplx( hc*jc, hp*jp, 8)) enddo x = real(w) y = imag(w) !********************* PACKAGE ROUTINES *********************** call plot( x(-mp:mp), y(-mp:mp), 'm' ) call legend('Re Z = const', 'm', 01) call hold('on') !***************** END of PACKAGE ROUTINES *********************** enddo !********************* PACKAGE ROUTINES *********************** call title('W = SIN(Z): mapping of Cartesian lines') call xlabel('re W') call ylabel('im W') call hold() !***************** END of PACKAGE ROUTINES *********************** ! Example 2 mp = 1000 ! Points of curve hp = 0.0025 write(DW,*) 'Example 2: High oscillations' !********************* PACKAGE ROUTINES *********************** call grid('off') call hold('off') call hold() call whitebg() call axis((/-5.,5.,-2.,2./), (/1,1/)) call figure(2) !***************** END of PACKAGE ROUTINES *********************** do jp = -mp,mp x(jp) = jp*hp enddo y(-mp:mp) = cos(100*x(-mp:mp)**2 )*exp( -0.5*x(-mp:mp)**2) !********************* PACKAGE ROUTINES *********************** call plot(x(-mp:mp),y(-mp:mp),'r') call title('High oscillations') !***************** END of PACKAGE ROUTINES *********************** ! Example 3 mp = 200 ! Points of curve hp = 0.05 lp = mp/nint(1./hp) pi = 3.14159 write(DW,*) 'Example 3: Marking of data points' !********************* PACKAGE ROUTINES *********************** call whitebg() call figure(3) call axis((/0.,hp*mp,-1.,1./), (/-1,-1/)) !***************** END of PACKAGE ROUTINES *********************** do jp = 0,mp x(jp) = jp*hp enddo y(0:mp) = sin(pi*x(0:mp))*exp( -0.25*x(0:mp)) !********************* PACKAGE ROUTINES *********************** call plot(x(0:mp),y(0:mp),'b:') call hold('on') call legend('All points','b.',40) !***************** END of PACKAGE ROUTINES *********************** do jp = 0,lp x(jp) = jp*hp*mp/float(lp) enddo y(0:lp) = sin(pi*x(0:lp))*exp( -0.25*x(0:lp)) !********************* PACKAGE ROUTINES *********************** call plot(x(0:lp),y(0:lp),'r+') call legend('Zero points','r+',41) !***************** END of PACKAGE ROUTINES *********************** do jp = 1,lp x(jp) = (2*jp-1)*hp*mp/float(lp)/2 enddo y(1:lp) = sin(pi*x(1:lp))*exp( -0.25*x(1:lp)) !********************* PACKAGE ROUTINES *********************** call plot(x(1:lp),y(1:lp),'mo') call legend('Extrema points','mo',42) call title('Marking of data points') ! call hold() !***************** END of PACKAGE ROUTINES *********************** ! Example of user's I/O write(DW,'(a \)') 'Close windows (Y/N)? ' read(DW,*) yes if(yes.eq.'y' .or. yes.eq.'Y') then !********************* PACKAGE ROUTINES *********************** call delete(1) call delete(2) call delete(3) !***************** END of PACKAGE ROUTINES *********************** endif call Wait() contains !DEC$ENDIF !************************* ! User-friendly routines * !************************* subroutine OpenDialogBox() ! Openning Dialog (user's I/O) Window type (QWINFO) wn wn=qwinfo(QWIN$SET,0,24,6,106) open(DW,file='user',title='Dialog Box') dummy=setwsizeqq(DW,wn) dummy = setbkcolorrgb(#FFFF00) call clearscreen ($GCLEARSCREEN) dummy=settextcolorrgb(#000000) dummy=displaycursor($GCURSORON) end subroutine OpenDialogBox subroutine whitebg() ! Consequent calls of this routine ! toggle background color from black to white and vice versa bkclr = mod(bkclr+1,2) end subroutine whitebg subroutine figure(handle) integer(4) handle ! Directs output to graph window "handle" nfig = handle end subroutine figure subroutine delete(handle) integer(4) handle ! Same as close close(handle,status='delete') end subroutine delete subroutine hold(toggle) ! Calling: ! call hold('on') ! toggles hold to 'ON' ! call hold('off') ! toggles hold to 'OFF' ! call hold() ! displays hold status character*(*), optional :: toggle if(present(toggle)) then if(toggle == 'on') ifhold = .TRUE. if(toggle == 'off') ifhold = .FALSE. elseif(ifhold) then write(DW,*) 'hold is ON' elseif(.not. ifhold) then write(DW,*) 'hold is OFF' endif end subroutine hold subroutine grid(toggle) ! Calling: ! call grid('on') ! toggles grid to 'ON' ! call grid('off') ! toggles grid to 'OFF' ! call grid() ! displays grid status character*(*), optional :: toggle if(present(toggle)) then if(toggle == 'on') ifgrid = .TRUE. if(toggle == 'off') ifgrid = .FALSE. elseif(ifgrid) then write(DW,*) 'grid is ON' elseif(.not. ifgrid) then write(DW,*) 'grid is OFF' endif end subroutine grid subroutine plot(x,y,attr) ! plot is MATLAB-style callable routine for plane graphics ! Only the following functionality of MATLAB's plot is supported ! ----------------------------------------------------------------- ! plot(x,y) plots vector y versus vector x ! plot(y) plots the columns of y versus their index ! Various line types, plot symbols and colors may be obtained with ! plot(x,y,attr) where attr is a character string made from one ! element from any or all the following 3 columns: ! ! y yellow . point _ solid ! m magenta o circle : dotted ! c cyan x x-mark ; dashdot ! r red + plus - dashed ! g green * asterisk h histogram ! b blue ! w white ! k black ! ! For example, plot(x,y,'c+:') plots a cyan dotted line with a plus ! at each data point; plot(x,y,'b*') plots blue asterisk at each data ! point but does not draw any line real(8), dimension(:) :: x real(8), dimension(:), optional :: y character*(*), optional :: attr character(10) wtitle integer(4) TwoBgr (0:1) /#000000, #FFFFF0/ integer(4) rgb(0:2) /#00,#F0,#FF/ real(8) x1,y1,x2,y2 common /_w/ x1,y1,x2,y2 integer(2) r1,c1,r2,c2 common /pixel_w/ r1,c1,r2,c2 real(8), allocatable :: xx(:),yy(:) integer(4) PlotMode(3) equivalence (PlotMode(1),ifcolor), (PlotMode(2),ifmark), (PlotMode(3),ifstyle) real(8) shift_x,shift_y type (QWINFO) wn type (WXYCOORD) wxy type (FONTINFO) finfo if (.not. ifhold) then write(wtitle,'(a ,i3)') 'Figure ',nfig open(nfig,file='user',title=wtitle) dummy = setbkcolorrgb( TwoBgr(bkclr) ) call clearscreen ($GCLEARSCREEN) wn.type = QWIN$RESTORE dummy=setwsizeqq(nfig,wn) dummy=initializefonts() end if n = size(x) allocate( xx(n), yy(n) ) if(present(y)) then if(size(y).ne.size(x)) then write(DW,*) 'Error in "plot": array dimensions must agree => x (',& int2(size(x)),'), y (',int2(size(y)),')' goto 1 endif do j = 1,n xx(j) = x(j) yy(j) = y(j) end do else do j = 1,n yy(j) = x(j) xx(j) = dfloat(j) end do endif if(.not.ifhold) then call set_limits(xx,yy,x1,x2,y1,y2) dummy = limits_w(x1,y1,x2,y2) if(dummy.ne.0) goto 1 endif ifcolor = 0 ifmark = 0 ifstyle = 0 if(present(attr)) PlotMode = plot_mode(attr) if(ifcolor.gt.0) then dummy = setcolorrgb( select_color(attr(ifcolor:ifcolor)) ) else dummy = setcolorrgb( select_color('b') ) endif dummy = setfont('t''Arial''h18''e''b') dummy = getfontinfo(finfo) do j = 1,n if(ifmark.eq.0) then if(ifstyle.gt.0) then call style_draw(j,n,xx,yy,ifstyle,attr) else call moveto_w( xx(j), yy(j), wxy ) if(j.lt.n) dummy = lineto_w( xx(j+1), yy(j+1) ) endif else shift_x = 0.5*(x2-x1)*finfo.avgwidth/float(c2-c1) shift_y = 0.5*(y2-y1)*finfo.pixheight/float(r2-r1) call moveto_w( xx(j)-shift_x, yy(j)-shift_y, wxy ) call outgtext(attr(ifmark:ifmark)) if(ifstyle.gt.0) call style_draw(j,n,xx,yy,ifstyle,attr) endif enddo if(.not.ifhold) then call draw_axis(x1,x2,y1,y2) call draw_ticks(x1,x2,y1,y2) endif 1 deallocate( xx,yy ) end subroutine plot subroutine Wait() ! Waiting of closing (ALT+F4 or equivalent) an application write(DW,'(a \)') 'Close application manually' do while (.true.) enddo end subroutine Wait subroutine title(string) character*(*) string ! Print title "string" integer(4) AxisClr(0:1) /#FFFFF0, #000000/ dummy = setfont('t''Times New Roman''h22w10''u') dummy = setcolorrgb( AxisClr(bkclr) ) call string_position(string,'title') call outgtext(string) end subroutine title subroutine xlabel(string) character*(*) string ! Print X-caption "string" integer(4) AxisClr(0:1) /#FFFFF0, #000000/ dummy = setfont('t''Arial''h18w10''i') dummy = setcolorrgb( AxisClr(bkclr) ) call string_position(string,'xlabel') call outgtext(string) end subroutine xlabel subroutine ylabel(string) character*(*) string ! Print Y-caption "string" integer(4) AxisClr(0:1) /#FFFFF0, #000000/ dummy = setfont('t''Arial''h18w10''i') dummy = setcolorrgb( AxisClr(bkclr) ) call string_position(string,'ylabel') call setgtextrotation(900) call outgtext(string) call setgtextrotation(0) end subroutine ylabel subroutine axis(limits,drawing) real(4), optional :: limits(4) integer(4), optional :: drawing(2) ! Default axis behaviour is as follows: ! 1) limits set to data range ! 2) drawing of axis with reasonable number of ticks ! ! call axis( (/x1,x2,y1,y2/) ) set axis limits to [x1,x2], [y1,y2] ! unless x1.ne.x2 and/or y1.ne.y2, ! while x1.eq.x2 and/or y1.eq.y2 ! set limits to data range ! call axis( (/x1,x2,y1,y2/), (/ 0, 0/) ) is equivalent to previous line ! call axis( (/x1,x2,y1,y2/), (/ 1, 1/) ) set limits but suppress axis drawing ! call axis( (/x1,x2,y1,y2/), (/-1,-1/) ) set limits but suppress ticks ! call axis() restores axis behavior to default ! ! Use axis BEFORE calling plot real(8) ax1,ay1,ax2,ay2 integer(4) draw_x,draw_y common /axis_/ ax1,ay1,ax2,ay2,draw_x,draw_y if(.not.present(limits) .and. .not.present(drawing) ) then ifaxis = .TRUE. elseif( present(limits) .and. .not.present(drawing) ) then ifaxis = .FALSE. ax1 = limits(1) ax2 = limits(2) ay1 = limits(3) ay2 = limits(4) draw_x = 0 draw_y = 0 else ifaxis = .FALSE. ax1 = limits(1) ax2 = limits(2) ay1 = limits(3) ay2 = limits(4) draw_x = drawing(1) draw_y = drawing(2) endif end subroutine axis subroutine legend(string, attr, xy) ! Plot legend 'string' for line with attribute 'attr' ! If given, two-digits integer 'xy' moves legend ! from left-upper corner to ! (1+x)*X_shift, (1+y)*Y_shift starting point, ! where X_shift, Y_shift - some default values character*(*) string character*(*) attr integer(4), optional :: xy real(8) x1,y1,x2,y2 common /_w/ x1,y1,x2,y2 integer(2) r1,c1,r2,c2 common /pixel_w/ r1,c1,r2,c2 real(8) xx(10),yy(10) integer(4) PlotMode(3) equivalence (PlotMode(1),ifcolor), (PlotMode(2),ifmark), (PlotMode(3),ifstyle) real(8) shift_x,shift_y type (WXYCOORD) wxy type (FONTINFO) finfo ny = 0 nx = 0 n = 5 if(present(xy)) then ny = mod(xy,10) nx = (xy - ny)/10 endif do j=1,n+1 xx(j) = x1+0.025*(x2-x1)*(j+nx) yy(j) = y1+0.05 *(y2-y1)*(1+ny) enddo ifcolor = 0 ifmark = 0 ifstyle = 0 PlotMode = plot_mode(attr) if(ifcolor.gt.0) then dummy = setcolorrgb( select_color(attr(ifcolor:ifcolor)) ) else dummy = setcolorrgb( select_color('b') ) endif dummy = setfont('t''Arial''h18''e''b') dummy = getfontinfo(finfo) do j = 1,n if(ifmark.eq.0) then if(ifstyle.gt.0) then call style_draw(j,n,xx,yy,ifstyle,attr) else call moveto_w( xx(j), yy(j), wxy ) if(j.lt.n) dummy = lineto_w( xx(j+1), yy(j+1) ) endif else shift_x = 0.5*(x2-x1)*finfo.avgwidth/float(c2-c1) shift_y = 0.5*(y2-y1)*finfo.pixheight/float(r2-r1) call moveto_w( xx(j)-shift_x, yy(j)-shift_y, wxy ) call outgtext(attr(ifmark:ifmark)) if(ifstyle.gt.0) call style_draw(j,n,xx,yy,ifstyle,attr) endif enddo call moveto_w(xx(n+1),yy(n+1),wxy) dummy = setfont('t''Arial''h18''b') call outgtext(string) end subroutine legend !********************* ! Low-level routines * !********************* subroutine draw_ticks(x1,x2,y1,y2) ! Ticks ploting real(8) x1,y1,x2,y2 real(8) ax1,ay1,ax2,ay2 integer(4) draw_x,draw_y common /axis_/ ax1,ay1,ax2,ay2,draw_x,draw_y real(8) orig_x,orig_y integer(4) AxisClr(0:1) /#FFFFF0, #000000/ real(8) major_x, major_y, minor_x, minor_y, tick_x, tick_y,dash_x,dash_y type (WXYCOORD) wxy if(x1*x2.lt.0.) then orig_x = 0. major_x = dmin1(x2/5.,-x1/5.) minor_x = dmin1(x2/25.,-x1/25.) else orig_x = x1 major_x = (x2-x1)/10. minor_x = (x2-x1)/50. endif if(y1*y2.lt.0.) then orig_y = 0. major_y = dmin1(y2/5.,-y1/5.) minor_y = dmin1(y2/25.,-y1/25.) else orig_y = y2 major_y = (y2-y1)/10. minor_y = (y2-y1)/50. endif tick_x = 0.02*(y1-y2) tick_y = 0.02*(x2-x1) dash_y = 0.01*(y1-y2) dash_x = 0.01*(x2-x1) dummy = setcolorrgb( AxisClr(bkclr) ) do j_maj = 0,10 if(ifgrid) then do j_dash = 1,50 call moveto_w( x1+j_maj*major_x, y2+(2*j_dash-2)*dash_y, wxy ) dummy = lineto_w( x1+j_maj*major_x, y2+(2*j_dash-1)*dash_y ) enddo endif if(draw_x .lt. 0 .or. ifaxis) then call moveto_w( x1+j_maj*major_x,orig_y, wxy ) dummy = lineto_w( x1+j_maj*major_x,orig_y+tick_x ) do j_min = 1,4 call moveto_w( x1+j_maj*major_x+j_min*minor_x,orig_y, wxy ) dummy = lineto_w( x1+j_maj*major_x+j_min*minor_x,orig_y+tick_x/2. ) enddo endif enddo do j_maj = 0,10 if(ifgrid) then do j_dash = 1,50 call moveto_w( x1+(2*j_dash-2)*dash_x, y1+j_maj*major_y, wxy ) dummy = lineto_w( x1+(2*j_dash-1)*dash_x, y1+j_maj*major_y ) enddo endif if(draw_y .lt. 0 .or. ifaxis) then call moveto_w( orig_x,y1+j_maj*major_y, wxy ) dummy = lineto_w( orig_x+tick_y,y1+j_maj*major_y ) do j_min = 1,4 call moveto_w( orig_x,y1+j_maj*major_y+j_min*minor_y, wxy ) dummy = lineto_w( orig_x+tick_y/2.,y1+j_maj*major_y+j_min*minor_y ) enddo endif enddo end subroutine draw_ticks subroutine draw_axis(x1,x2,y1,y2) ! Axis ploting real(8) x1,y1,x2,y2 real(8) ax1,ay1,ax2,ay2 integer(4) draw_x,draw_y common /axis_/ ax1,ay1,ax2,ay2,draw_x,draw_y integer(4) AxisClr(0:1) /#FFFFF0, #000000/ real(8) orig_x,orig_y type (WXYCOORD) wxy if(x1*x2.lt.0.) then orig_x = 0. else orig_x = x1 endif if(y1*y2.lt.0.) then orig_y = 0. else orig_y = y2 endif dummy = setcolorrgb( AxisClr(bkclr) ) if(draw_x .le. 0 .or. ifaxis) then call moveto_w( x1,orig_y, wxy ) dummy = lineto_w( x2,orig_y ) endif if(draw_y .le. 0 .or. ifaxis) then call moveto_w( orig_x,y1, wxy ) dummy = lineto_w( orig_x,y2 ) endif end subroutine draw_axis subroutine set_limits(xx,yy,x1,x2,y1,y2) ! Set math.bounds of graph window real(8) x1,y1,x2,y2,xx(:),yy(:) real(8) ax1,ay1,ax2,ay2 integer(4) draw_x,draw_y common /axis_/ ax1,ay1,ax2,ay2,draw_x,draw_y if(ifaxis) then x1 = minval(xx) x2 = maxval(xx) y1 = maxval(yy) y2 = minval(yy) elseif(ax1-ax2.ne.0. .and. ay1-ay2.eq.0.) then x1 = ax1 x2 = ax2 y1 = maxval(yy) y2 = minval(yy) elseif(ay1-ay2.ne.0. .and. ax1-ax2.eq.0.) then y1 = ay2 y2 = ay1 x2 = maxval(xx) x1 = minval(xx) elseif(ay1-ay2.ne.0. .and. ax1-ax2.ne.0.) then x1 = ax1 x2 = ax2 y1 = ay2 y2 = ay1 else x1 = minval(xx) x2 = maxval(xx) y1 = maxval(yy) y2 = minval(yy) endif end subroutine set_limits integer(4) function limits_w(x1,y1,x2,y2) ! Set phys.bounds of graph window ! Returns 0 if successful real(8) x1,y1,x2,y2 integer(2) r1,c1,r2,c2 common /pixel_w/ r1,c1,r2,c2 type (WINDOWCONFIG) wcfg limits_w = 0 dummy=setactiveqq(nfig) if(.not. getwindowconfig(wcfg) ) then write(DW,*) 'Error in "plot": cannot set graph window' limits_w = -1 return endif c1 = 0.25*wcfg.numxpixels ! Better solution??? r1 = 0.25*wcfg.numypixels ! 50% of window usage c2 = 0.75*wcfg.numxpixels ! to view the whole graph r2 = 0.75*wcfg.numypixels ! w/o need of scrolling call setviewport(c1,r1,c2,r2) if(setwindow(.true._2,x1,y1,x2,y2) .eq.0) then write(DW,*) 'Error in "plot": invalid data range' limits_w = -1 return endif end function limits_w integer(4) function select_color(clr) character(1) clr if(clr.eq.'k') select_color = rgbtointeger(#00, #00, #00) if(clr.eq.'w') select_color = rgbtointeger(#FF, #FF, #FF) if(clr.eq.'r') select_color = rgbtointeger(#FF, #00, #00) if(clr.eq.'g') select_color = rgbtointeger(#00, #FF, #00) if(clr.eq.'b') select_color = rgbtointeger(#00, #00, #FF) if(clr.eq.'y') select_color = rgbtointeger(#FF, #FF, #00) if(clr.eq.'c') select_color = rgbtointeger(#00, #FF, #FF) if(clr.eq.'m') select_color = rgbtointeger(#FF, #00, #FF) end function select_color subroutine string_position(string,orient) character*(*) string,orient real(8) x1,y1,x2,y2 common /_w/ x1,y1,x2,y2 integer(2) r1,c1,r2,c2 common /pixel_w/ r1,c1,r2,c2 type (WXYCOORD) wxy type (FONTINFO) finfo real(8) shift_height,shift dummy = getfontinfo(finfo) if(orient.eq.'title') then shift = (x2-x1)*(1.-len_trim(string)*finfo.avgwidth/float(c2-c1))/2 call setviewport(c1,nint(0.80*r1),c2,r2) call moveto_w(x1+shift,y1,wxy) elseif(orient.eq.'xlabel') then shift = (x2-x1)*(1.-len_trim(string)*finfo.avgwidth/float(c2-c1))/2 shift_height = + finfo.pixheight*(y2-y1)/(r1-r2) call setviewport(c1,r1,c2,nint(1.10*r2)) call moveto_w(x1+shift,y2+shift_height,wxy) elseif(orient.eq.'ylabel') then shift = - (y2-y1)*(1.-len_trim(string)*finfo.avgwidth/float(r2-r1))/2 call setviewport(nint(0.80*c1),r1,c2,r2) call moveto_w(x1,y2+shift,wxy) endif end subroutine string_position function plot_mode(attr) integer(4) :: plot_mode(3) character*(*) :: attr ifcolor = 0 ifmark = 0 ifstyle = 0 do j = 1,len_trim(attr) if(attr(j:j) .eq. 'k' ) ifcolor = j if(attr(j:j) .eq. 'b' ) ifcolor = j if(attr(j:j) .eq. 'g' ) ifcolor = j if(attr(j:j) .eq. 'r' ) ifcolor = j if(attr(j:j) .eq. 'c' ) ifcolor = j if(attr(j:j) .eq. 'm' ) ifcolor = j if(attr(j:j) .eq. 'w' ) ifcolor = j if(attr(j:j) .eq. 'y' ) ifcolor = j if(attr(j:j) .eq. '+' ) ifmark = j if(attr(j:j) .eq. '.' ) ifmark = j if(attr(j:j) .eq. '*' ) ifmark = j if(attr(j:j) .eq. 'o' ) ifmark = j if(attr(j:j) .eq. 'x' ) ifmark = j if(attr(j:j) .eq. '-' ) ifstyle = j if(attr(j:j) .eq. '_' ) ifstyle = j if(attr(j:j) .eq. ':' ) ifstyle = j if(attr(j:j) .eq. ';' ) ifstyle = j if(attr(j:j) .eq. 'h' ) ifstyle = j enddo plot_mode = (/ifcolor,ifmark,ifstyle/) end function plot_mode subroutine style_draw(j,n,xx,yy,ifstyle,attr) real(8), dimension(:) :: xx,yy character*(*) attr real(8) shift_x,shift_y type (WXYCOORD) wxy if(attr(ifstyle:ifstyle).eq.'_' .and. j.lt.n) then call moveto_w( xx(j), yy(j), wxy ) dummy = lineto_w( xx(j+1), yy(j+1) ) endif if(attr(ifstyle:ifstyle).eq.'h' .and. j.lt.n) then call moveto_w( xx(j), yy(j), wxy ) dummy = lineto_w( xx(j+1), yy(j) ) dummy = lineto_w( xx(j+1), yy(j+1) ) endif if(attr(ifstyle:ifstyle).eq.':' .and. j.lt.n) then call moveto_w( xx(j), yy(j), wxy ) shift_x = 0.1*( xx(j+1)-xx(j) ) + xx(j) shift_y = 0.1*( yy(j+1)-yy(j) ) + yy(j) dummy = lineto_w( shift_x, shift_y ) endif if(attr(ifstyle:ifstyle).eq.'-' .and. j.lt.n) then call moveto_w( xx(j), yy(j), wxy ) shift_x = 0.5*( xx(j+1)-xx(j) ) + xx(j) shift_y = 0.5*( yy(j+1)-yy(j) ) + yy(j) dummy = lineto_w( shift_x, shift_y ) endif if(attr(ifstyle:ifstyle).eq.';' .and. j.lt.n) then call moveto_w( xx(j), yy(j), wxy ) shift_x = 0.5*( xx(j+1)-xx(j) ) + xx(j) shift_y = 0.5*( yy(j+1)-yy(j) ) + yy(j) dummy = lineto_w( shift_x, shift_y ) shift_x = 0.7*( xx(j+1)-xx(j) ) + xx(j) shift_y = 0.7*( yy(j+1)-yy(j) ) + yy(j) call moveto_w( shift_x, shift_y, wxy ) shift_x = 0.8*( xx(j+1)-xx(j) ) + xx(j) shift_y = 0.8*( yy(j+1)-yy(j) ) + yy(j) dummy = lineto_w( shift_x, shift_y ) endif end subroutine style_draw !DEC$IF DEFINED (Main_mPlot) end program mPlot !DEC$ENDIF