module plplotlib_mod !! Wrapper module for plplot to give it a more matplotlib like personality use kinds_mod, only: wp use plplot use array_mod use text_mod implicit none private integer,parameter::pp = plflt integer,parameter::pi = kind(1) character(*),parameter::default_dev = 'svgqt' !! Default output device !=================! != Library State =! !=================! logical::didShow = .false. !! Flag for library display status real(pp)::fontScale = 1.0_pp !! Font scale factor to resetPen logical::blackOnWhite = .true. !! Reverse black and white logical::transparentBackground = .false. !! Transparent background !==============! != Interfaces =! !==============! interface localize module procedure localize_1 module procedure localize_2 end interface !===========! != Exports =! !===========! public::setup,show public::figure public::subplot public::xylim,xlim,ylim,xyzlim public::labels,xlabel,ylabel,title public::ticks,xticks,yticks,box public::legend public::binData public::plot,plot3 public::scatter,errorbar public::contour,contourf public::colorbar,colorbar2 public::bar,barh public::hist public::fillBetween,fillBetweenx public::quiver public::surface,wireframe contains !===================! != Helper Routines =! !===================! function binData(d,N,db,normalize) result(o) !! Count data in each bin real(wp),dimension(:),intent(in)::d !! Data for binning integer,intent(in),optional::N !! Number of bins real(wp),dimension(2),intent(in),optional::db !! Boundaries of bin range integer,intent(in),optional::normalize !! Normalization type (1=sum, 2=bin size, 3=maxval) real(wp),dimension(:,:),allocatable::o real(wp),dimension(:),allocatable::b integer::Nl,k Nl = 10 if(present(N)) Nl = N if(present(db)) then b = linspace(db(1),db(2),Nl+1) else b = linspace(minval(d)-epsilon(1.0_wp),maxval(d)+epsilon(1.0_wp),Nl+1) end if allocate(o(Nl,2)) o(:,1) = (b(1:Nl)+b(2:Nl+1))/2.0_wp do k=1,Nl o(k,2) = real(count(d>=b(k) .and. d<=b(k+1)),wp) end do if(present(normalize)) then select case(normalize) case(1) o(:,2) = o(:,2)/sum(o(:,2)) case(2) do k=1,Nl o(k,2) = o(k,2)/(b(k+1)-b(k)) end do case(3) o(:,2) = o(:,2)/maxval(o(:,2)) end select end if end function binData function localize_1(A) result(o) real(wp),dimension(:),intent(in)::A real(pp),dimension(:),allocatable::o integer::N,k N = size(A) allocate(o(N)) forall(k=1:N) o(k) = real(A(k),pp) end function localize_1 function localize_2(A) result(o) real(wp),dimension(:,:),intent(in)::A real(pp),dimension(:,:),allocatable::o integer::N,M,i,j N = size(A,1) M = size(A,2) allocate(o(N,M)) forall(i=1:N,j=1:M) o(i,j) = real(A(i,j),pp) end function localize_2 !============================! != Axes and Figure Routines =! !============================! subroutine figure !! Create a new figure logical,save::isFirst = .true. if(.not.isFirst) then call pleop() else isFirst = .false. end if call plbop() call plssub(1,1) call pladv(1) call resetPen() end subroutine figure subroutine subplot(ny,nx,i,aspect,is3d) !! Create a set of axes on a figure integer,intent(in)::nx !! Number of subplot columns integer,intent(in)::ny !! Number of subplot rows integer,intent(in)::i !! Subplot to use real(wp),intent(in),optional::aspect !! Aspect ratio of the axes logical,intent(in),optional::is3d logical::is3dl call plssub(nx,ny) call pladv(i) call resetPen() is3dl = .false. if(present(is3d)) is3dl = is3d if(is3dl) then call plvpor(0.0_pp,1.0_pp,0.0_pp,1.0_pp) else if(present(aspect)) then call plvasp(real(aspect,pp)) else call plvsta() end if end if call defaultLim() end subroutine subplot subroutine defaultLim real(pp),parameter::eps = epsilon(1.0_pp) call plwind(-eps,eps,-eps,eps) end subroutine defaultLim subroutine xylim(xb,yb) !! Set the x and y ranges of the plot real(wp),dimension(2),intent(in)::xb !! x-range of plot real(wp),dimension(2),intent(in)::yb !! y-range of plot real(pp),dimension(2)::xbl,ybl xbl = localize(xb) ybl = localize(yb) call plwind(xbl(1),xbl(2),ybl(1),ybl(2)) end subroutine xylim subroutine xlim(xl,xh) !! Set the limits of the x-axis real(wp),intent(in)::xl,xh real(pp)::x1,x2,y1,y2 call plgvpw(x1,x2,y1,y2) call plwind(real(xl,pp),real(xh,pp),y1,y2) end subroutine xlim subroutine ylim(yl,yh) !! Set the limits of the y-axis real(wp),intent(in)::yl,yh real(pp)::x1,x2,y1,y2 call plgvpw(x1,x2,y1,y2) call plwind(x1,x2,real(yl,pp),real(yh,pp)) end subroutine ylim subroutine xyzlim(xb,yb,zb,altitude,azimuth,zoom) !! Set the limits for a 3d plot real(wp),dimension(2),intent(in)::xb !! x-range of plot real(wp),dimension(2),intent(in)::yb !! y-range of plot real(wp),dimension(2),intent(in)::zb !! z-range of plot real(wp),intent(in),optional::altitude !! Altitude angle of plot in degrees real(wp),intent(in),optional::azimuth !! Azimuth angle of plot in degrees real(wp),intent(in),optional::zoom !! Zoom ratio (default 1.0) real(pp)::al,az,zm al = 45.0_pp if(present(altitude)) al = real(altitude,pp) az = 60.0_pp if(present(azimuth)) az = real(azimuth,pp) zm = 1.0_pp if(present(zoom)) zm = real(zoom,pp) call plwind(-1.0_pp,1.0_pp,-1.0_pp,1.5_pp) call plw3d(zm,zm,1.2_pp*zm, & & real(xb(1),pp),real(xb(2),pp), & & real(yb(1),pp),real(yb(2),pp), & & real(zb(1),pp),real(zb(2),pp),al,az) end subroutine xyzlim subroutine ticks(dx,dy,logx,logy,color,lineWidth) !! Set the ticks for the axes real(wp),intent(in),optional::dx !! Spacing between ticks on x-axis real(wp),intent(in),optional::dy !! Spacing between ticks on y-axis logical,intent(in),optional::logx !! Flag for log-ticks and labels on x-axis logical,intent(in),optional::logy !! Flag for log-ticks and labels on y-axis character(*),intent(in),optional::color !! Color code for ticks, box, and labels real(wp),optional::linewidth !! Line width for ticks and box real(pp)::dxl,dyl character(10)::xopts,yopts dxl = 0.0_pp if(present(dx)) dxl = real(dx,pp) dyl = 0.0_pp if(present(dy)) dyl = real(dy,pp) xopts = 'bcnst' if(present(logx)) then if(logx) xopts = 'bcnstl' end if yopts = 'bcnstv' if(present(logy)) then if(logy) yopts = 'bcnstvl' end if call resetPen() if(present(color)) call setColor(color) if(present(lineWidth)) call setLineWidth(lineWidth) call plbox(xopts,dxl,0,yopts,dyl,0) call resetPen() end subroutine ticks subroutine box(xLabel,yLabel,zLabel,color) !! Set x,y and plot labels character(*),intent(in)::xLabel !! Label for x-axis character(*),intent(in)::yLabel !! Label for x-axis character(*),intent(in)::zLabel !! Label for z-axis character(*),intent(in),optional::color !! Color of labels if(present(color)) call setColor(color) call plbox3('bnstu',xLabel,0.0_pp,0,'bnstu',yLabel,0.0_pp,0,'bnstu',zLabel,0.0_pp,0) call resetPen() end subroutine box subroutine xticks(d,logScale,primary,secondary,color,lineWidth) !! Set the ticks for the x-axis real(wp),intent(in),optional::d !! Spacing between ticks logical,intent(in),optional::logScale !! Flag for log-ticks and labels logical,intent(in),optional::primary !! Draw primary axis logical,intent(in),optional::secondary !! Draw secondary axis character(*),intent(in),optional::color !! Color code for ticks, box, and labels real(wp),optional::linewidth !! Line width for ticks and box real(pp)::dxl,dyl character(10)::xopts,yopts dxl = 0.0_pp dyl = 0.0_pp if(present(d)) dxl = real(d,pp) xopts = 'nst' if(present(primary)) then if(primary) xopts = trim(xopts)//'b' else xopts = trim(xopts)//'b' end if if(present(secondary)) then if(secondary) xopts = trim(xopts)//'c' else xopts = trim(xopts)//'c' end if if(present(logScale)) then if(logScale) xopts = trim(xopts)//'l' end if yopts = '' if(present(color)) call setColor(color) if(present(lineWidth)) call setLineWidth(lineWidth) call plbox(xopts,dxl,0,yopts,dyl,0) call resetPen() end subroutine xticks subroutine yticks(d,logScale,primary,secondary,color,lineWidth) !! Set the ticks for the y-axis real(wp),intent(in),optional::d !! Spacing between ticks logical,intent(in),optional::logScale !! Flag for log-ticks and labels logical,intent(in),optional::primary !! Draw primary axis logical,intent(in),optional::secondary !! Draw secondary axis character(*),intent(in),optional::color !! Color code for ticks, box, and labels real(wp),optional::linewidth !! Line width for ticks and box real(pp)::dxl,dyl character(10)::xopts,yopts dxl = 0.0_pp dyl = 0.0_pp if(present(d)) dyl = real(d,pp) yopts = 'nst' if(present(primary)) then if(primary) yopts = trim(xopts)//'b' else yopts = trim(yopts)//'b' end if if(present(secondary)) then if(secondary) yopts = trim(yopts)//'c' else yopts = trim(yopts)//'c' end if if(present(logScale)) then if(logScale) yopts = trim(yopts)//'l' end if xopts = '' if(present(color)) call setColor(color) if(present(lineWidth)) call setLineWidth(lineWidth) call plbox(xopts,dxl,0,yopts,dyl,0) call resetPen() end subroutine yticks subroutine labels(xLabel,yLabel,plotLabel,color) !! Set x,y and plot labels character(*),intent(in)::xLabel !! Label for x-axis character(*),intent(in)::yLabel !! Label for x-axis character(*),intent(in)::plotLabel !! Label entire plot character(*),intent(in),optional::color !! Color of labels if(present(color)) call setColor(color) call pllab(xLabel,yLabel,plotLabel) call resetPen() end subroutine labels subroutine xlabel(label,color) !! Set x-label character(*),intent(in)::label !! Label for axis character(*),intent(in),optional::color !! Color of labels if(present(color)) call setColor(color) call plmtex('b',3.0_pp,0.5_pp,0.5_pp,label) call resetPen() end subroutine xlabel subroutine ylabel(label,color) !! Set y-label character(*),intent(in)::label !! Label for axis character(*),intent(in),optional::color !! Color of labels if(present(color)) call setColor(color) call plmtex('l',5.0_pp,0.5_pp,0.5_pp,label) call resetPen() end subroutine ylabel subroutine title(label,color) !! Set plot title character(*),intent(in)::label !! Label for plot character(*),intent(in),optional::color !! Color of labels if(present(color)) call setColor(color) call plmtex('t',1.5_pp,0.5_pp,0.5_pp,label) call resetPen() end subroutine title subroutine colorbar(z,N,leftLabel,rightLabel) !! Add a colorbar to the top of the plot real(wp),dimension(:,:),intent(in)::z !! Data used for levels computation integer,intent(in)::N !! Number of levels to compute character(*),intent(in),optional::leftLabel !! Label for left side of colorbar character(*),intent(in),optional::rightLabel !! Label for right side of colorbar real(pp),dimension(:,:),allocatable::values character(64),dimension(2)::labels real(pp)::fill_width real(pp)::cont_width integer::cont_color real(pp)::colorbar_width real(pp)::colorbar_height integer::k values = reshape( & & real([( real(k-1,wp)/real(N-1,wp)*(maxval(z)-minval(z))+minval(z) ,k=1,N)],pp), & & [N,1]) fill_width = 2.0_pp cont_width = 0.0_pp cont_color = 1 labels = '' if(present(leftLabel )) labels(1) = leftLabel if(present(rightLabel)) labels(2) = rightLabel call plcolorbar(colorbar_width,colorbar_height,& & ior(PL_COLORBAR_GRADIENT,PL_COLORBAR_SHADE_LABEL),PL_POSITION_TOP,& & 0.0_pp,0.01_pp,0.75_pp,0.05_pp,& & 0,1,1,0.0_pp,0.0_pp, & & cont_color,cont_width, & & [PL_COLORBAR_LABEL_LEFT,PL_COLORBAR_LABEL_RIGHT],labels, & & ['bcvmt'],[0.0_pp],[0],[size(values)],values) end subroutine colorbar subroutine colorbar2(z,N,leftLabel,rightLabel) !! Add a colorbar to the top of the plot real(wp),dimension(:,:),intent(in)::z !! Data used for levels computation integer,intent(in)::N !! Number of levels to compute character(*),intent(in),optional::leftLabel !! Label for left side of colorbar character(*),intent(in),optional::rightLabel !! Label for right side of colorbar real(pp),dimension(:,:),allocatable::values character(64),dimension(2)::labels real(pp)::fill_width real(pp)::cont_width integer::cont_color real(pp)::colorbar_width real(pp)::colorbar_height integer::k values = reshape( & & real([( real(k-1,wp)/real(N-1,wp)*(maxval(z)-minval(z))+minval(z) ,k=1,N)],pp), & & [N,1]) fill_width = 2.0_pp cont_width = 0.0_pp cont_color = 1 labels = '' if(present(leftLabel )) labels(1) = leftLabel if(present(rightLabel)) labels(2) = rightLabel call plcolorbar(colorbar_width,colorbar_height,& & ior(PL_COLORBAR_GRADIENT,PL_COLORBAR_SHADE_LABEL),PL_POSITION_RIGHT,& & 0.01_pp,0.0_pp,0.05_pp,0.75_pp,& & 0,1,1,0.0_pp,0.0_pp, & & cont_color,cont_width, & & [PL_COLORBAR_LABEL_BOTTOM,PL_COLORBAR_LABEL_TOP],labels, & & ['bcvmt'],[0.0_pp],[0],[size(values)],values) end subroutine colorbar2 subroutine legend(corner,series,lineWidths,markScales,markCounts,ncol) !! Create legend for plot data !! !! FIXME: Text sizing should be modifiable character(*),intent(in)::corner !! Corner for legend character(*),dimension(:,:),intent(in)::series !! Data series in rows !! [name,textColor,lineStyle,lineColor,markStyle,markColor,boxColor] real(wp),dimension(:),intent(in),optional::lineWidths !! Line widths for the plots real(wp),dimension(:),intent(in),optional::markScales !! Marker sizes for the plots integer,dimension(:),intent(in),optional::markCounts !! Marker counts for the plots integer,intent(in),optional::ncol !! Number of columns real(pp)::width,height,xoff,yoff real(pp)::plotWidth integer::opt,cornerl integer::bg_color,bb_color,bb_style,lncol,lnrow integer,dimension(size(series,1))::opts real(pp),dimension(size(series,1))::lwidths,mscales integer,dimension(size(series,1))::mcounts,text_colors real(pp)::text_offset,text_scale,text_spacing,text_justification integer,dimension(size(series,1))::box_colors,box_patterns real(pp),dimension(size(series,1))::box_scales,box_line_widths integer,dimension(size(series,1))::line_colors,line_styles integer,dimension(size(series,1))::mark_colors character(64),dimension(size(series,1))::mark_styles integer::k call doLegendBox() opts = 0 do k=1,size(series,1) if(series(k,3)/='') opts(k) = ior(opts(k),PL_LEGEND_LINE) if(series(k,5)/='') opts(k) = ior(opts(k),PL_LEGEND_SYMBOL) if(series(k,7)/='') opts(k) = ior(opts(k),PL_LEGEND_COLOR_BOX) end do call doText() call doBoxes() call doLines() call doMarkers() call pllegend(width,height,opt,cornerl,xoff,yoff,plotWidth, & & bg_color,bb_color,bb_style, & & lnrow,lncol,size(series,1),opts,text_offset, & & text_scale,text_spacing,text_justification,text_colors,series(:,1), & & box_colors,box_patterns,box_scales,box_line_widths, & & line_colors,line_styles,lwidths, & & mark_colors,mscales,mcounts,mark_styles) contains subroutine doLegendBox opt = PL_LEGEND_BACKGROUND+PL_LEGEND_BOUNDING_BOX cornerl = getCorner(corner) xoff = 0.0_pp yoff = 0.0_pp plotWidth = 0.05_pp bg_color = 0 bb_color = 1 bb_style = getLineStyleCode('-') lncol = 1 if(present(ncol)) lncol = ncol lnrow = size(series,1)/lncol end subroutine doLegendBox subroutine doText text_offset = 0.3_pp text_scale = fontScale text_spacing = 3.0_pp text_justification = 0.0_pp do k=1,size(series,1) text_colors = getColorCode(series(k,2)) end do end subroutine doText subroutine doBoxes do k=1,size(series,1) box_colors(k) = getColorCode(series(k,7)) end do box_patterns = 0 box_scales = 0.5_pp box_line_widths = 0.0_pp end subroutine doBoxes subroutine doLines lwidths = 1.0_pp if(present(lineWidths)) lwidths = real(lineWidths,pp) do k=1,size(series,1) line_colors(k) = getColorCode(series(k,4)) line_styles(k) = getLineStyleCode(series(k,3)) end do end subroutine doLines subroutine doMarkers mcounts = 2 if(present(markCounts)) mcounts = markCounts mscales = 1.0_pp if(present(markScales)) mscales = real(markScales,pp) do k=1,size(series,1) mark_colors(k) = getColorCode(series(k,6)) mark_styles(k) = getSymbolCode(series(k,5)) end do end subroutine doMarkers function getCorner(text) result(code) character(*),intent(in)::text integer::code code = PL_POSITION_INSIDE if( startsWith(text,'upper') ) code = code+PL_POSITION_TOP if( startsWith(text,'lower') ) code = code+PL_POSITION_BOTTOM if( endsWith(text,'right') ) code = code+PL_POSITION_RIGHT if( endsWith(text,'left' ) ) code = code+PL_POSITION_LEFT end function getCorner end subroutine legend !=====================! != Plotting Routines =! !=====================! subroutine hist(d,N,db,relWidth,fillColor,fillPattern,lineColor,lineWidth) !! Create a histogram real(wp),dimension(:),intent(in)::d !! Data for binning integer,intent(in),optional::N !! Number of bins real(wp),dimension(2),intent(in),optional::db !! Boundaries of bin range real(wp),intent(in),optional::relWidth !! Relative width of bars (default 0.8) character(*),intent(in),optional::fillColor !! Color of bar fills character(*),intent(in),optional::fillPattern !! Pattern of bar fills character(*),intent(in),optional::lineColor !! Color of lines around bars real(wp),optional::lineWidth !! Width of lines around bars real(wp),dimension(:,:),allocatable::h real(wp),dimension(2)::dbl integer::Nl real(wp)::relWidthl real(wp)::lineWidthl Nl = 20 if(present(N)) Nl = N if(present(db)) then dbl = db else dbl = mixval(d)+[-1.0_wp,1.0_wp]*epsilon(1.0_wp) end if h = binData(d,Nl,dbl,normalize=3) relWidthl = 1.0_wp if(present(relWidth)) relWidthl = relWidth lineWidthl = 0.5_wp if(present(lineWidth)) lineWidthl = lineWidth if(present(lineColor)) then if(present(fillColor)) then if(present(fillPattern)) then call bar(h(:,1),h(:,2),relWidth=relWidthl,lineColor=lineColor,lineWidth=lineWidthl, & & fillColor=fillColor,fillPattern=fillPattern) else call bar(h(:,1),h(:,2),relWidth=relWidthl,lineColor=lineColor,lineWidth=lineWidthl, & & fillColor=fillColor) end if else if(present(fillPattern)) then call bar(h(:,1),h(:,2),h(:,2),relWidth=relWidthl,lineColor=lineColor,lineWidth=lineWidthl, & & fillPattern=fillPattern) else call bar(h(:,1),h(:,2),h(:,2),relWidth=relWidthl,lineColor=lineColor,lineWidth=lineWidthl) end if end if else if(present(fillColor)) then if(present(fillPattern)) then call bar(h(:,1),h(:,2),relWidth=relWidthl,lineWidth=lineWidthl, & & fillColor=fillColor,fillPattern=fillPattern) else call bar(h(:,1),h(:,2),relWidth=relWidthl,lineWidth=lineWidthl, & & fillColor=fillColor) end if else if(present(fillPattern)) then call bar(h(:,1),h(:,2),h(:,2),relWidth=relWidthl,lineWidth=lineWidthl, & & fillPattern=fillPattern) else call bar(h(:,1),h(:,2),h(:,2),relWidth=relWidthl,lineWidth=lineWidthl) end if end if end if call resetPen() end subroutine hist subroutine scatter(x,y,c,s,markColor,markStyle,markSize) !! Create scatter plot of data real(wp),dimension(:),intent(in)::x !! x-coordinates of data real(wp),dimension(:),intent(in)::y !! y-coordinates of data real(wp),dimension(:),intent(in),optional::c !! Data for smooth coloring real(wp),dimension(:),intent(in),optional::s !! Data for marker scaling character(*),intent(in),optional::markColor !! Color of markers; overridden by z character(*),intent(in),optional::markStyle !! Style of markers real(wp),intent(in),optional::markSize !! Size of markers real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:),allocatable::cb character(32)::code integer::k xl = localize(x) yl = localize(y) if(present(markColor)) call setColor(markColor) code = getSymbolCode('') if(present(markStyle)) code = getSymbolCode(markStyle) if(present(markSize)) call plschr(0.0_pp,real(markSize,pp)) if(present(markSize)) call plssym(0.0_pp,real(markSize,pp)) if(present(c)) cb = real(mixval(c),pp) do k=1,size(x) if(present(c)) call plcol1( real( (c(k)-cb(1))/(cb(2)-cb(1)) ,pp) ) if(present(s)) call plschr(0.0_pp,real(s(k),pp)) if(present(s)) call plssym(0.0_pp,real(s(k),pp)) call plptex(xl(k),yl(k),0.0_pp,0.0_pp,0.5_pp,code) end do call resetPen() end subroutine scatter subroutine plot(x,y,lineColor,lineStyle,lineWidth,markColor,markStyle,markSize) !! Plot data using lines and or markers real(wp),dimension(:),intent(in)::x !! x-data for plot real(wp),dimension(:),intent(in)::y !! y-data for plot character(*),intent(in),optional::lineColor !! Color of line character(*),intent(in),optional::lineStyle !! Style of line; '' for no line real(wp),intent(in),optional::lineWidth !! Width of line character(*),intent(in),optional::markColor !! Color of markers, if any character(*),intent(in),optional::markStyle !! Style of markers; '' or absent for none real(wp),intent(in),optional::markSize !! Size of markers, if any real(pp),dimension(:),allocatable::xl,yl character(32)::code integer::k xl = localize(x) yl = localize(y) if(present(lineColor)) call setColor(lineColor) if(present(lineWidth)) call setLineWidth(lineWidth) if(present(lineStyle)) then call setLineStyle(lineStyle) if(lineStyle/='') call plline(xl,yl) else call plline(xl,yl) end if call resetPen() if(present(markColor)) call setColor(markColor) if(present(markSize)) call plssym(0.0_pp,real(markSize,pp)) if(present(markStyle)) then code = getSymbolCode(markStyle) if(markStyle/='') then do k=1,size(x) call plptex(xl(k),yl(k),0.0_pp,0.0_pp,0.5_pp,code) end do end if end if call resetPen() end subroutine plot subroutine plot3(x,y,z,lineColor,lineStyle,lineWidth,markColor,markStyle,markSize) !! Plot data using lines and or markers real(wp),dimension(:),intent(in)::x !! x-data for plot real(wp),dimension(:),intent(in)::y !! y-data for plot real(wp),dimension(:),intent(in)::z !! z-data for plot character(*),intent(in),optional::lineColor !! Color of line character(*),intent(in),optional::lineStyle !! Style of line; '' for no line real(wp),intent(in),optional::lineWidth !! Width of line character(*),intent(in),optional::markColor !! Color of markers, if any character(*),intent(in),optional::markStyle !! Style of markers; '' or absent for none real(wp),intent(in),optional::markSize !! Size of markers, if any real(pp),dimension(:),allocatable::xl,yl,zl real(pp)::dx,dy,dz,sx,sy,sz character(32)::code integer::k xl = localize(x) yl = localize(y) zl = localize(z) if(present(lineColor)) call setColor(lineColor) if(present(lineWidth)) call setLineWidth(lineWidth) if(present(lineStyle)) then call setLineStyle(lineStyle) if(lineStyle/='') call plline(xl,yl) else call plline3(xl,yl,zl) end if call resetPen() if(present(markColor)) call setColor(markColor) if(present(markSize)) call plssym(0.0_pp,real(markSize,pp)) if(present(markStyle)) then code = getSymbolCode(markStyle) if(markStyle/='') then dx = 1.0_pp dy = 0.0_pp dz = 0.0_pp sx = 0.0_pp sy = 0.0_pp sz = 0.0_pp do k=1,size(x) call plptex3(xl(k),yl(k),zl(k),dx,dy,dz,sx,sy,sz,0.5_pp,code) end do end if end if call resetPen() end subroutine plot3 subroutine contour(x,y,z,N,lineColor,lineStyle,lineWidth) !! Plot contour lines real(wp),dimension(:),intent(in)::x !! x-coordinates of data real(wp),dimension(:),intent(in)::y !! y-coordinates of data real(wp),dimension(:,:),intent(in)::z !! Data for contouring integer,intent(in),optional::N !! Number of levels to use in contour character(*),intent(in),optional::lineColor !! Color of contour lines character(*),intent(in),optional::lineStyle !! Style of contour lines real(wp),optional::lineWidth !! Width of contour lines real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:,:),allocatable::zl real(pp),dimension(:),allocatable::edge integer::Nl,k xl = localize(x) yl = localize(y) zl = localize(z) Nl = 20 if(present(N)) Nl = N edge = [( real(k-1,pp)/real(Nl-1,pp)*(maxval(zl)-minval(zl))+minval(zl) ,k=1,Nl)] if(present(lineColor)) call setColor(lineColor) if(present(lineStyle)) call setLineStyle(lineStyle) if(present(lineWidth)) call setLineWidth(lineWidth) call plcont(zl,edge,xl,yl) call resetPen() end subroutine contour subroutine surface(x,y,z,N,lineStyle) !! Plot a 3d surface real(wp),dimension(:),intent(in)::x !! x-coordinates of data real(wp),dimension(:),intent(in)::y !! y-coordinates of data real(wp),dimension(:,:),intent(in)::z !! Data for contouring integer,intent(in),optional::N !! Number of levels to use in surface colors character(*),intent(in),optional::lineStyle !! Style for xy lines ( '-' = on, '' = off ) real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:,:),allocatable::zl real(pp),dimension(:),allocatable::edge integer::Nl,opt opt = MAG_COLOR xl = localize(x) yl = localize(y) zl = localize(z) Nl = 20 if(present(N)) then Nl = N opt = ior(opt,SURF_CONT) end if edge = localize(linspace(minval(z),maxval(z),Nl)) if(present(lineStyle)) then select case(lineStyle) case('') opt = opt case('-') opt = ior(opt,FACETED) end select end if call plsurf3d(xl,yl,zl,opt,edge) call resetPen() end subroutine surface subroutine wireframe(x,y,z,lineColor) !! Plot a 3d wireframe real(wp),dimension(:),intent(in)::x !! x-coordinates of data real(wp),dimension(:),intent(in)::y !! y-coordinates of data real(wp),dimension(:,:),intent(in)::z !! Data for contouring character(*),intent(in),optional::lineColor !! Color of contour lines real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:,:),allocatable::zl xl = localize(x) yl = localize(y) zl = localize(z) if(present(lineColor)) then call setColor(lineColor) call plot3d(xl,yl,zl,DRAW_LINEXY,.false.) else call plot3d(xl,yl,zl,ior(DRAW_LINEXY,MAG_COLOR),.false.) end if call resetPen() end subroutine wireframe subroutine contourf(x,y,z,N) !! Plot filled contours real(wp),dimension(:),intent(in)::x !! x-coordinates of data real(wp),dimension(:),intent(in)::y !! y-coordinates of data real(wp),dimension(:,:),intent(in)::z !! Data for contouring integer,intent(in),optional::N !! Number of levels to use in contour real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:,:),allocatable::zl real(pp),dimension(:),allocatable::edge character(1)::defined real(pp)::fill_width real(pp)::cont_width integer::cont_color integer::Nl xl = localize(x) yl = localize(y) zl = localize(z) Nl = 20 if(present(N)) Nl = N edge = localize(linspace(minval(z),maxval(z),Nl)) fill_width = -1.0_pp cont_width = -1.0_pp cont_color = -1 call plshades(zl,defined,minval(xl),maxval(xl),minval(yl),maxval(yl), & & edge,fill_width,cont_color,cont_width) call resetPen() end subroutine contourf subroutine quiver(x,y,u,v,s,c,scaling,lineColor,lineStyle,lineWidth) !! Plot vectors real(wp),dimension(:),intent(in)::x !! x-positions of vectors real(wp),dimension(:),intent(in)::y !! y-positions of vectors real(wp),dimension(:,:),intent(in)::u !! u-components of vectors real(wp),dimension(:,:),intent(in)::v !! v-components of vectors real(wp),dimension(:,:),intent(in),optional::s !! Scale of vectors real(wp),dimension(:,:),intent(in),optional::c !! Color values for vectors real(wp),intent(in),optional::scaling !! Scaling of vectors !! < 0 = Automatic, then scaled !! 0 = Automatic !! > 0 = Directly scaled character(*),intent(in),optional::lineColor !! Color of vectors character(*),intent(in),optional::lineStyle !! Style of vectors' lines real(wp),optional::lineWidth !! Width of vectors' lines real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:,:),allocatable::ul,vl,sl real(pp),dimension(2)::xb,yb,sb,cb,d real(pp)::scalingl,scl,mag,clr integer::i,j xl = localize(x) yl = localize(y) ul = localize(u) vl = localize(v) d = real([x(2)-x(1),y(2)-y(1)],pp) xb = real(mixval(x),pp) yb = real(mixval(y),pp) if(present(s)) then sl = localize(s) sl = sl/maxval(sl) else sl = localize(u**2+v**2) sl = sqrt(sl) sl = sl/maxval(sl) end if sb = [minval(sl),maxval(sl)] cb = 0.0_wp if(present(c)) cb = real([minval(c),maxval(c)],pp) scalingl = 1.0_pp if(present(scaling)) scalingl = real(scaling,pp) if(present(lineColor)) call setColor(lineColor) if(present(lineStyle)) call setLineStyle(lineStyle) if(present(lineWidth)) call setLineWidth(lineWidth) do i=1,size(u,1) do j=1,size(u,2) mag = norm2([ul(i,j),vl(i,j)]) scl = scalingl*norm2(d)*sl(i,j) if(abs(scl)<1.0E-5_wp) cycle if(present(c)) then clr = real( (c(i,j)-cb(1))/(cb(2)-cb(1)) ,pp) clr = max(clr,0.0_pp) clr = min(clr,1.0_pp) call plcol1( clr ) end if call plvect(ul(i:i,j:j)/mag,vl(i:i,j:j)/mag,scl,xl(i:i),yl(j:j)) end do end do call resetPen() end subroutine quiver subroutine bar(x,y,c,relWidth,fillColor,fillPattern,lineColor,lineWidth) !! Create a bar graph real(wp),dimension(:),intent(in)::x !! x-positions of the bars' centers real(wp),dimension(:),intent(in)::y !! y-positions of the bars' tops real(wp),dimension(:),intent(in),optional::c !! Color scale for bars real(wp),intent(in),optional::relWidth !! Relative width of bars (default 0.8) character(*),intent(in),optional::fillColor !! Color of bar fills character(*),intent(in),optional::fillPattern !! Pattern of bar fills character(*),intent(in),optional::lineColor !! Color of lines around bars real(wp),optional::lineWidth !! Width of lines around bars real(pp),dimension(4)::xl,yl real(pp),dimension(2)::cb real(pp)::dx,dxs integer::k cb = 0.0_wp if(present(c)) cb = real(mixval(c),pp) dxs = 0.8_pp if(present(relWidth)) dxs = real(relWidth,pp) if(size(x)>1) then dx = dxs*real(x(2)-x(1),pp)/2.0_pp else dx = dxs end if if(present(lineWidth)) call setLineWidth(lineWidth) do k=1,size(x) xl = real([x(k)-dx,x(k)-dx,x(k)+dx,x(k)+dx],pp) yl = real([0.0_wp,y(k),y(k),0.0_wp],pp) if(present(fillColor)) call setColor(fillColor) if(present(fillPattern)) call setFillPattern(fillPattern) if(present(c)) call plcol1( real( (c(k)-cb(1))/(cb(2)-cb(1)) ,pp) ) call plfill(xl,yl) if(present(lineColor)) call setColor(lineColor) call plline(xl,yl) end do call resetPen() end subroutine bar subroutine barh(y,x,c,relWidth,fillColor,fillPattern,lineColor,lineWidth) !! Create a horizontal bar graph real(wp),dimension(:),intent(in)::y !! y-positions of the bars' centers real(wp),dimension(:),intent(in)::x !! x-positions of the bars' tops real(wp),dimension(:),intent(in),optional::c !! Color scale for bars real(wp),intent(in),optional::relWidth !! Relative width of bars character(*),intent(in),optional::fillColor !! Color of bar fills character(*),intent(in),optional::fillPattern !! Pattern of bar fills character(*),intent(in),optional::lineColor !! Color of lines around bars real(wp),optional::lineWidth !! Width of lines around bars real(pp),dimension(4)::xl,yl real(pp),dimension(2)::cb real(pp)::dy,dys integer::k cb = 0.0_wp if(present(c)) cb = real(mixval(c),pp) dys = 0.8_pp if(present(relWidth)) dys = real(relWidth,pp) dy = dys*real(y(2)-y(1),pp)/2.0_pp if(present(lineWidth)) call setLineWidth(lineWidth) do k=1,size(x) yl = real([y(k)-dy,y(k)-dy,y(k)+dy,y(k)+dy],pp) xl = real([0.0_wp,x(k),x(k),0.0_wp],pp) if(present(fillColor)) call setColor(fillColor) if(present(fillPattern)) call setFillPattern(fillPattern) if(present(c)) call plcol1( real( (c(k)-cb(1))/(cb(2)-cb(1)) ,pp) ) call plfill(xl,yl) if(present(lineColor)) call setColor(lineColor) call plline(xl,yl) end do call resetPen() end subroutine barh subroutine fillBetween(x,y1,y0,fillColor,fillPattern,lineWidth) !! Fill space between two lines real(wp),dimension(:),intent(in)::x real(wp),dimension(:),intent(in)::y1 real(wp),dimension(:),intent(in),optional::y0 character(*),intent(in),optional::fillColor character(*),intent(in),optional::fillPattern real(wp),intent(in),optional::lineWidth real(pp),dimension(:),allocatable::xl,y1l,y0l integer::N N = size(x) xl = localize(x) y1l = localize(y1) if(present(y0)) then y0l = localize(y0) else allocate(y0l(N)) y0l = 0.0_pp end if if(present(fillColor)) call setColor(fillColor) if(present(fillPattern)) call setFillPattern(fillPattern) if(present(lineWidth)) call setLineWidth(lineWidth) call plfill([xl(1:N:1),xl(N:1:-1)],[y1l(1:N:1),y0l(N:1:-1)]) call resetPen() end subroutine fillBetween subroutine fillBetweenx(y,x1,x0,fillColor,fillPattern,lineWidth) !! Fill space between two lines real(wp),dimension(:),intent(in)::y real(wp),dimension(:),intent(in)::x1 real(wp),dimension(:),intent(in),optional::x0 character(*),intent(in),optional::fillColor character(*),intent(in),optional::fillPattern real(wp),intent(in),optional::lineWidth real(pp),dimension(:),allocatable::yl,x1l,x0l integer::N N = size(y) yl = localize(y) x1l = localize(x1) if(present(x0)) then x0l = localize(x0) else allocate(x0l(N)) x0l = 0.0_pp end if if(present(fillColor)) call setColor(fillColor) if(present(fillPattern)) call setFillPattern(fillPattern) if(present(lineWidth)) call setLineWidth(lineWidth) call plfill([x1l(1:N:1),x0l(N:1:-1)],[yl(1:N:1),yl(N:1:-1)]) call resetPen() end subroutine fillBetweenx subroutine errorbar(x,y,xerr,yerr,lineColor,lineStyle,lineWidth) !! Plot error bars for a set of data points real(wp),dimension(:),intent(in)::x !! x-data for plot real(wp),dimension(:),intent(in)::y !! y-data for plot real(wp),dimension(:),intent(in),optional::xerr !! x-data error for plot real(wp),dimension(:),intent(in),optional::yerr !! y-data error for plot character(*),intent(in),optional::lineColor !! Color of line character(*),intent(in),optional::lineStyle !! Style of line; '' for no line real(wp),intent(in),optional::lineWidth !! Width of line real(pp),dimension(:),allocatable::xl,yl real(pp),dimension(:),allocatable::xll,xlh real(pp),dimension(:),allocatable::yll,ylh xl = localize(x) yl = localize(y) if(present(lineColor)) call setColor(lineColor) if(present(lineWidth)) call setLineWidth(lineWidth) if(present(lineStyle)) call setLineStyle(lineStyle) if(present(xerr)) then xll = localize(x-xerr) xlh = localize(x+xerr) call plerrx(xll,xlh,yl) end if if(present(yerr)) then yll = localize(y-yerr) ylh = localize(y+yerr) call plerry(xl,yll,ylh) end if call resetPen() end subroutine !========================! != Drawing Pen Routines =! !========================! subroutine resetPen !! Reset pen to default state call setColor('') call setLineStyle('') call setLineWidth(0.5_wp) call setFillPattern('') call plschr(0.0_pp,real(fontScale,pp)) call plssym(0.0_pp,real(fontScale,pp)) end subroutine resetPen subroutine setLineWidth(lineWidth) real(wp),intent(in)::lineWidth call plwidth(real(lineWidth,pp)) end subroutine setLineWidth subroutine setLineStyle(style) !! Set the current pen line style character(*),intent(in)::style !! Style to set call pllsty(getLineStyleCode(style)) end subroutine setLineStyle function getLineStyleCode(style) result(code) !! Return the code for a line style character(*),intent(in)::style !! Style desired integer::code select case(style) case('-') code = 1 case(':') code = 2 case('--') code = 3 case default code = 1 end select end function getLineStyleCode function getSymbolCode(style) result(code) !! Return the code for a symbol style character(*),intent(in)::style !! Style desired character(32)::code select case(style) case('+') code = '#(140)' case('x') code = '#(141)' case('*') code = '#(142)' case('.') code = '#(143)' case('s') code = '#(144)' case(',') code = '#(850)' case('^') code = '#(852)' case('<') code = '#(853)' case('v') code = '#(854)' case('>') code = '#(855)' case default code = '#(143)' end select end function getSymbolCode subroutine setFillPattern(style) character(*),intent(in)::style call plpsty(getFillCode(style)) end subroutine setFillPattern function getFillCode(style) result(code) character(*),intent(in)::style integer::code select case(style) case('') code = 0 case('-') code = 1 case('/') code = 3 case('|') code = 2 case('\') code = 4 case('#') code = 7 case('x') code = 8 case default code = 0 end select end function getFillCode subroutine setColor(color) !! Set the current pen color character(*),intent(in)::color !! Name of color to set integer::ios real(pp)::v read(color,*,iostat=ios) v if(ios==0) then call plcol1(v) else call plcol0(getColorCode(color)) end if end subroutine setColor function getColorCode(color) result(code) character(*),intent(in)::color integer::code select case(color) case('w','white') if(blackOnWhite) then code = 1 else code = 2 end if case('k','black') if(blackOnWhite) then code = 2 else code = 1 end if case('r','red') code = 3 case('g','green') code = 4 case('b','blue') code= 5 case('c','cyan') code = 6 case('m','magenta') code= 7 case('y','yellow') code = 8 case('fg') code = 2 case('bg') code = 1 case default code = 2 end select code = code-1 end function getColorCode !===========================! != Library Status Routines =! !===========================! subroutine setup(device,fileName,fontScaling,whiteOnBlack,transparent,colormap,figSize) !! Setup PlPlot library, optionally overriding defaults character(*),intent(in),optional::device !! Output device to use !! !! * qtwidget !! * svgqt !! * pngqt character(*),intent(in),optional::fileName !! Name of file(s) to write to !! !! The text `%n` will be replaced with the figure number real(wp),intent(in),optional::fontScaling !! Font scaling relative to default value logical,intent(in),optional::whiteOnBlack !! Default foreground and background colors logical,intent(in),optional::transparent !! Transparent background character(*),intent(in),optional::colormap !! Colormap to use integer,dimension(2),intent(in),optional::figSize !! Size of figures to produce in pixels character(64)::bufx,bufy if(present(device)) then call plsdev(device) else call plsdev(default_dev) end if call plsfam(1,1,100) if(present(fileName)) then call plsfnam(fileName) else call plsfnam('out') end if if(present(whiteOnBlack)) blackOnWhite = .not. whiteOnBlack if(present(transparent)) transparentBackground = transparent call setIndexedColors() if(present(colormap)) then call setColormap(colormap) else call setColormap('CoolWarm') end if call plfontld(0) if(present(fontScaling)) fontScale = real(fontScaling,pp) if(present(figSize)) then write(bufx,*) figSize(1) write(bufy,*) figSize(2) call plsetopt('geometry',trim(adjustl(bufx))//'x'//trim(adjustl(bufy))) else call plsetopt('geometry','640x480') end if call plinit() call resetPen() end subroutine setup subroutine show !! Show the plots end finialize the PlPlot library if(.not.didShow) then call plend() didShow = .true. end if end subroutine show !======================! != Color Map Routines =! !======================! subroutine setIndexedColors !! Setup the indexed colors integer,dimension(8,3)::rgb real(plflt),dimension(8)::a rgb(getColorCode('w')+1,:) = [255,255,255] ! White rgb(getColorCode('k')+1,:) = [ 0, 0, 0] ! Black rgb(getColorCode('r')+1,:) = [255, 0, 0] ! Red rgb(getColorCode('g')+1,:) = [ 0,255, 0] ! Green rgb(getColorCode('b')+1,:) = [ 0, 0,255] ! Blue rgb(getColorCode('c')+1,:) = [ 0,255,255] ! Cyan rgb(getColorCode('m')+1,:) = [255, 0,255] ! Magenta rgb(getColorCode('y')+1,:) = [255,255, 0] ! Yellow a = 1.0_plflt if(transparentBackground) a(1) = 0.0_wp call plscmap0a(rgb(:,1),rgb(:,2),rgb(:,3),a) end subroutine setIndexedColors subroutine setColormap(colormap) !! Set the continuous colormap character(*),intent(in)::colormap !! Name of colormap to use real(pp),dimension(:),allocatable::i,h,s,v select case(colormap) case('CoolWarm') h = [240.0,195.0,45.0,0.0] s = [0.60, 0.95, 0.95, 0.60] v = [0.80, 0.30, 0.30, 0.80] i = [0.00, 0.50, 0.50, 1.00] call plscmap1n(256) call plscmap1l(.false.,i,h,s,v) case('Gray') call plspal1('cmap1_gray.pal',1) case('BlueYellow') call plspal1('cmap1_blue_yellow.pal',1) case('BlueRed') call plspal1('cmap1_blue_red.pal',1) case('Radar') call plspal1('cmap1_radar.pal',1) case('HighFreq') call plspal1('cmap1_highfreq.pal',1) case('LowFreq') call plspal1('cmap1_lowfreq.pal',1) end select end subroutine setColormap end module plplotlib_mod