Revision: 12124
http://plplot.svn.sourceforge.net/plplot/?rev=12124&view=rev
Author: arjenmarkus
Date: 2012-01-07 11:55:17 +0000 (Sat, 07 Jan 2012)
Log Message:
-----------
Three more Fortran 95 examples adapted to the new style
Modified Paths:
--------------
trunk/examples/f95/x09f.f90
trunk/examples/f95/x10f.f90
trunk/examples/f95/x11f.f90
Modified: trunk/examples/f95/x09f.f90
===================================================================
--- trunk/examples/f95/x09f.f90 2012-01-05 13:59:36 UTC (rev 12123)
+++ trunk/examples/f95/x09f.f90 2012-01-07 11:55:17 UTC (rev 12124)
@@ -1,374 +1,356 @@
-! $Id$
-! Contour plot demo.
+! $Id$
+! Contour plot demo.
!
-! Copyright (C) 2004 Alan W. Irwin
+! Copyright (C) 2004 Alan W. Irwin
!
-! This file is part of PLplot.
+! This file is part of PLplot.
!
-! PLplot is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Library General Public License as
-! published by the Free Software Foundation; either version 2 of the
-! License, or (at your option) any later version.
+! PLplot is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Library General Public License as
+! published by the Free Software Foundation; either version 2 of the
+! License, or (at your option) any later version.
!
-! PLplot is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU Library General Public License for more details.
+! PLplot is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU Library General Public License for more details.
!
-! You should have received a copy of the GNU Library General Public
-! License along with PLplot; if not, write to the Free Software
-! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+! You should have received a copy of the GNU Library General Public
+! License along with PLplot; if not, write to the Free Software
+! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-! Does several contour plots using different coordinate mappings.
- use plplot, PI => PL_PI
- implicit none
- integer i, j, nptsx, nptsy, xdim, ydim
-! xdim and ydim are the absolute static dimensions.
-! nptsx, and nptsy are the (potentially dynamic) defined area of the 2D
-! arrays that is actually used.
- parameter (xdim=99, ydim=100, nptsx=35,nptsy=46)
+! Does several contour plots using different coordinate mappings.
- real(kind=plflt) z(xdim, ydim), w(xdim, ydim), clevel(11), &
- xg1(xdim), yg1(ydim), &
- xg2(xdim, ydim), yg2(xdim, ydim)
- real(kind=plflt) xx, yy, argx, argy, distort
- real(kind=plflt) tr(6)
+program x09f95
+ use plplot, PI => PL_PI, TWOPI => PL_TWOPI
+ use plf95demolib
+ implicit none
+ integer i, j
- data clevel /-1._plflt, -0.8_plflt, -0.6_plflt, &
- -0.4_plflt, -0.2_plflt, &
- 0._plflt, 0.2_plflt, 0.4_plflt, 0.6_plflt ,0.8_plflt, 1._plflt/
-! Process command-line arguments
- call plparseopts(PL_PARSE_FULL)
+! xdim and ydim are the absolute static dimensions.
+! nptsx, and nptsy are the (potentially dynamic) defined area of the 2D
+! arrays that is actually used.
+ integer, parameter :: xdim=99, ydim=100, nptsx=35, nptsy=46
- tr(1) = 2._plflt/dble(nptsx-1)
- tr(2) = 0.0_plflt
- tr(3) = -1.0_plflt
- tr(4) = 0.0_plflt
- tr(5) = 2._plflt/dble(nptsy-1)
- tr(6) = -1.0_plflt
+ real(kind=plflt) :: z(xdim, ydim), w(xdim, ydim), &
+ xg1(xdim), yg1(ydim), &
+ xg2(xdim, ydim), yg2(xdim, ydim)
+ real(kind=plflt) :: xc(nptsx), yc(nptsy)
+ real(kind=plflt) :: xx, yy, argx, argy, distort
+ real(kind=plflt) :: tr(6)
-! Calculate the data matrices.
- do i=1,nptsx
- xx = dble(i-1-(nptsx/2))/dble (nptsx/2)
+ real(kind=plflt) :: clevel(11) = &
+ (/ -1._plflt, -0.8_plflt, -0.6_plflt, -0.4_plflt, -0.2_plflt, &
+ 0._plflt, 0.2_plflt, 0.4_plflt, 0.6_plflt, 0.8_plflt, 1._plflt /)
+
+! Process command-line arguments
+ call plparseopts(PL_PARSE_FULL)
+
+ tr = (/ 2._plflt/dble(nptsx-1), 0.0_plflt, -1.0_plflt, &
+ 0.0_plflt, 2._plflt/dble(nptsy-1), -1.0_plflt /)
+
+! Calculate the data matrices.
+ xc = (arange(0,nptsx) - (nptsx/2)) / dble(nptsx/2)
+ yc = (arange(0,nptsy) - (nptsy/2)) / dble(nptsy/2) - 1.0_plflt
+
+ do i=1,nptsx
do j=1,nptsy
- yy = dble(j-1-(nptsy/2))/dble (nptsy/2) - 1.0_plflt
- z(i,j) = xx*xx - yy*yy
- w(i,j) = 2._plflt*xx*yy
+ z(i,j) = xc(i)**2 - yc(j)**2
+ w(i,j) = 2._plflt*xc(i)*yc(j)
enddo
- enddo
+ enddo
-! Build the 1-d coord arrays.
- distort = 0.4_plflt
- do i=1,nptsx
- xx = -1._plflt + dble(i-1)*2._plflt/dble(nptsx-1)
- xg1(i) = xx + distort*cos(0.5_plflt*PI*xx)
- enddo
+! Build the 1-d coord arrays.
+ distort = 0.4_plflt
- do j=1,nptsy
- yy = -1._plflt + dble(j-1)*2._plflt/dble(nptsy-1)
- yg1(j) = yy - distort*cos(0.5_plflt*PI*yy)
- enddo
+ xg1 = coord_function( arange(0,nptsx) / dble(nptsx-1), distort )
+ yg1 = coord_function( arange(0,nptsy) / dble(nptsy-1), -distort )
-! Build the 2-d coord arrays.
- do i=1,nptsx
+! Build the 2-d coord arrays.
+ do i=1,nptsx
xx = -1._plflt + dble(i-1)*2._plflt/dble(nptsx-1)
argx = 0.5_plflt*PI*xx
do j=1,nptsy
- yy = -1._plflt + dble(j-1)*2._plflt/dble(nptsy-1)
- argy = 0.5_plflt*PI*yy
- xg2(i,j) = xx + distort*cos(argx)*cos(argy)
- yg2(i,j) = yy - distort*cos(argx)*cos(argy)
+ yy = -1._plflt + dble(j-1)*2._plflt/dble(nptsy-1)
+ argy = 0.5_plflt*PI*yy
+ xg2(i,j) = xx + distort*cos(argx)*cos(argy)
+ yg2(i,j) = yy - distort*cos(argx)*cos(argy)
enddo
- enddo
+ enddo
- call plinit
+ call plinit
-! Plot using identity transform
- call pl_setcontlabelformat(4,3)
- call pl_setcontlabelparam(0.006_plflt, 0.3_plflt, 0.1_plflt, 1)
- call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
- call plcol0(2)
- call plcont(z,1,nptsx,1,nptsy,clevel,tr)
- call plstyl(1,1500,1500)
- call plcol0(3)
- call plcont(w,1,nptsx,1,nptsy,clevel,tr)
- call plstyl(0,1500,1500)
- call plcol0(1)
- call pllab('X Coordinate', 'Y Coordinate', &
- 'Streamlines of flow')
- call pl_setcontlabelparam(0.006_plflt, 0.3_plflt, 0.1_plflt, 0)
+! Plot using identity transform
+ call pl_setcontlabelformat(4, 3)
+ call pl_setcontlabelparam(0.006_plflt, 0.3_plflt, 0.1_plflt, 1)
+ call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
+ call plcol0(2)
+ call plcont(z, 1, nptsx, 1, nptsy, clevel, tr)
+ call plstyl(1, 1500, 1500)
+ call plcol0(3)
+ call plcont(w, 1, nptsx, 1, nptsy, clevel, tr)
+ call plstyl(0, 1500, 1500)
+ call plcol0(1)
+ call pllab('X Coordinate', 'Y Coordinate', 'Streamlines of flow')
+ call pl_setcontlabelparam(0.006_plflt, 0.3_plflt, 0.1_plflt, 0)
-! Plot using 1d coordinate transform
- call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
- call plcol0(2)
- call plcont(z,1,nptsx,1,nptsy,clevel, xg1, yg1)
- call plstyl(1,1500,1500)
- call plcol0(3)
- call plcont(w,1,nptsx,1,nptsy,clevel, xg1, yg1)
- call plstyl(0,1500,1500)
- call plcol0(1)
- call pllab('X Coordinate', 'Y Coordinate', &
- 'Streamlines of flow')
+! Plot using 1d coordinate transform
+ call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
+ call plcol0(2)
+ call plcont(z, 1, nptsx, 1, nptsy, clevel, xg1, yg1)
+ call plstyl(1, 1500, 1500)
+ call plcol0(3)
+ call plcont(w, 1, nptsx, 1, nptsy, clevel, xg1, yg1)
+ call plstyl(0, 1500, 1500)
+ call plcol0(1)
+ call pllab('X Coordinate', 'Y Coordinate', 'Streamlines of flow')
-! Plot using 2d coordinate transform
- call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
- call plcol0(2)
- call plcont(z,1,nptsx,1,nptsy,clevel,xg2,yg2)
- call plstyl(1,1500,1500)
- call plcol0(3)
- call plcont(w,1,nptsx,1,nptsy,clevel,xg2,yg2)
- call plstyl(0,1500,1500)
- call plcol0(1)
- call pllab('X Coordinate', 'Y Coordinate', &
- 'Streamlines of flow')
+! Plot using 2d coordinate transform
+ call plenv(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.0_plflt, 0, 0)
+ call plcol0(2)
+ call plcont(z, 1, nptsx, 1, nptsy, clevel, xg2, yg2)
+ call plstyl(1, 1500, 1500)
+ call plcol0(3)
+ call plcont(w, 1, nptsx, 1, nptsy, clevel, xg2, yg2)
+ call plstyl(0, 1500, 1500)
+ call plcol0(1)
+ call pllab('X Coordinate', 'Y Coordinate', 'Streamlines of flow')
- call polar()
- call potential()
+ call polar()
+ call potential()
- call plend
- end
+ call plend
+contains
-! polar contour plot example.
- subroutine polar()
- use plplot, PI => PL_PI
- implicit none
- integer PERIMETERPTS, RPTS, THETAPTS, NLEVEL, xdim, ydim
- parameter(PERIMETERPTS = 100)
-! xdim and ydim are the absolute static size of the 2D arrays.
-! RPTS and THETAPTS are associated with the part of the
-! 2D arrays that are defined.
- parameter(xdim=99, RPTS = 40)
- parameter(ydim=100, THETAPTS = 40)
- parameter(NLEVEL=10)
- integer i,j
- real(kind=plflt) xg(xdim, ydim), yg(xdim, ydim), &
+!----------------------------------------------------------------------------
+! Auxiliary function to compute the coordinates
+
+elemental real(kind=plflt) function coord_function( coord, factor )
+ real(kind=plflt), intent(in) :: coord
+ real(kind=plflt), intent(in) :: factor
+
+ real(kind=plflt) :: tcoord
+
+ tcoord = -1.0_plflt + coord * 2.0_plflt
+ coord_function = tcoord + factor*cos(0.5_plflt*PI*tcoord)
+end function coord_function
+
+!----------------------------------------------------------------------------
+! polar contour plot example.
+subroutine polar()
+ integer, parameter :: PERIMETERPTS = 100
+
+! xdim and ydim are the absolute static size of the 2D arrays.
+! RPTS and THETAPTS are associated with the part of the
+! 2D arrays that are defined.
+ integer, parameter :: xdim=99, RPTS = 40
+ integer, parameter :: ydim=100, THETAPTS = 40
+ integer, parameter :: NLEVEL=10
+ integer :: i,j
+ real(kind=plflt) :: xg(xdim, ydim), yg(xdim, ydim), &
z(xdim, ydim), px(PERIMETERPTS), py(PERIMETERPTS), &
- lev(NLEVEL), t, r, theta
- call plenv(-1._plflt, 1._plflt, -1._plflt, 1._plflt, 0, -2)
- call plcol0(1)
-! perimeter.
- do i = 1, PERIMETERPTS
- t = (2._plflt*PI/(PERIMETERPTS-1))*dble(i-1)
- px(i) = cos(t)
- py(i) = sin(t)
- enddo
- call plline(px, py)
+ lev(NLEVEL), t, r, theta, delta
-! create data to be contoured.
- do j = 1, THETAPTS
+ call plenv(-1._plflt, 1._plflt, -1._plflt, 1._plflt, 0, -2)
+ call plcol0(1)
+
+! perimeter.
+ delta = 2._plflt*PI/(PERIMETERPTS-1)
+ px = cos(delta*arange(0, PERIMETERPTS))
+ py = sin(delta*arange(0, PERIMETERPTS))
+
+ call plline(px, py)
+
+! create data to be contoured.
+ do j = 1, THETAPTS
theta = (2._plflt*PI/dble(THETAPTS-1))*dble(j-1)
do i = 1, RPTS
- r = (i-1)/dble(RPTS-1)
- xg(i,j) = r*cos(theta)
- yg(i,j) = r*sin(theta)
- z(i,j) = r
+ r = (i-1)/dble(RPTS-1)
+ xg(i,j) = r*cos(theta)
+ yg(i,j) = r*sin(theta)
+ z(i,j) = r
enddo
- enddo
+ enddo
-! create contour values.
- do i = 1, NLEVEL
- lev(i) = 0.05_plflt + 0.10_plflt*dble(i-1)
- enddo
+! create contour values.
+ lev = 0.05_plflt + 0.10_plflt * arange(0,nlevel)
-! plot the (polar) contours.
- call plcol0(2)
- call plcont(z, 1, RPTS, 1, THETAPTS, lev, xg, yg)
- call plcol0(1)
- call pllab('', '', 'Polar Contour Plot')
- end
+! plot the (polar) contours.
+ call plcol0(2)
+ call plcont(z, 1, RPTS, 1, THETAPTS, lev, xg, yg)
+ call plcol0(1)
+ call pllab('', '', 'Polar Contour Plot')
+end subroutine polar
-! shielded potential contour plot example
- subroutine potential()
- use plplot, TWOPI => PL_TWOPI
- implicit none
+!----------------------------------------------------------------------------
+! shielded potential contour plot example
+subroutine potential()
- integer NCX, NCY, NPLT, i, j, nx, ny, kx, lx, ky, ly, &
+ integer :: i, j, nx, ny, kx, lx, ky, ly, &
nlevel, ilevgt, ilevlt, nlevlt, nlevgt, &
ncollin, ncolbox, ncollab, &
- nxsub, nysub, xdim, ydim
- real(kind=plflt) r, theta, rmax, x0, &
+ nxsub, nysub
+ real(kind=plflt) :: r, theta, rmax, x0, &
y0, xmin, xmax, eps, q1, d1, &
ymin, ymax, &
q1i, d1i, q2, d2, q2i, d2i, div1, div1i, div2, div2i, &
zmin, zmax, dz, xpmin, xpmax, ypmin, ypmax, &
- xtick, ytick
-! xdim and ydim are the absolute static size of the 2D arrays.
-! NCX and NCY are associated with the part of the
-! 2D arrays that are defined.
- parameter (xdim=99, NCX=40, ydim=100, NCY=64, NPLT=100)
+ xtick, ytick, delta
- real(kind=plflt) z(xdim, ydim), ztmp(xdim, ydim+1)
- real(kind=plflt) xg(xdim, ydim+1), yg(xdim, ydim+1), xtm(NPLT), ytm(NPLT)
+! xdim and ydim are the absolute static size of the 2D arrays.
+! NCX and NCY are associated with the part of the
+! 2D arrays that are defined.
+ integer, parameter :: xdim=99, NCX=40, ydim=100, NCY=64, NPLT=100
- real(kind=plflt) clevel(20)
- character(len=8) xopt, yopt
+ real(kind=plflt) :: z(xdim, ydim), ztmp(xdim, ydim+1)
+ real(kind=plflt) :: xg(xdim, ydim+1), yg(xdim, ydim+1), xtm(NPLT), ytm(NPLT)
- nx = NCX
- ny = NCY
+ real(kind=plflt) :: clevel(20)
+ character(len=8) :: xopt, yopt
- kx = 1
- lx = nx
- ky = 1
- ly = ny
+ nx = NCX
+ ny = NCY
-! Set up r-theta grids
-! Tack on extra cell in theta to handle periodicity.
+ kx = 1
+ lx = nx
+ ky = 1
+ ly = ny
- do i = 1, nx
+! Set up r-theta grids
+! Tack on extra cell in theta to handle periodicity.
+
+ do i = 1, nx
r = i - 0.5_plflt
do j = 1, ny
- theta = TWOPI/dble(ny-1) * (j-0.5_plflt)
- xg(i,j) = r * cos(theta)
- yg(i,j) = r * sin(theta)
+ theta = TWOPI/dble(ny-1) * (j-0.5_plflt)
+ xg(i,j) = r * cos(theta)
+ yg(i,j) = r * sin(theta)
enddo
xg(i, ny+1) = xg(i, 1)
yg(i, ny+1) = yg(i, 1)
- enddo
- call a2mnmx(xg, nx, ny, xmin, xmax, xdim)
- call a2mnmx(yg, nx, ny, ymin, ymax, xdim)
- rmax = r
- x0 = (xmin + xmax)/2._plflt
- y0 = (ymin + ymax)/2._plflt
+ enddo
-! Potential inside a conducting cylinder (or sphere) by method of images.
-! Charge 1 is placed at (d1, d1), with image charge at (d2, d2).
-! Charge 2 is placed at (d1, -d1), with image charge at (d2, -d2).
-! Also put in smoothing term at small distances.
+ xmax = maxval( xg(1:nx,1:ny) )
+ xmin = minval( xg(1:nx,1:ny) )
+ ymax = maxval( yg(1:nx,1:ny) )
+ ymin = minval( yg(1:nx,1:ny) )
- eps = 2._plflt
+ rmax = r
+ x0 = (xmin + xmax)/2._plflt
+ y0 = (ymin + ymax)/2._plflt
- q1 = 1._plflt
- d1 = r/4._plflt
+! Potential inside a conducting cylinder (or sphere) by method of images.
+! Charge 1 is placed at (d1, d1), with image charge at (d2, d2).
+! Charge 2 is placed at (d1, -d1), with image charge at (d2, -d2).
+! Also put in smoothing term at small distances.
- q1i = - q1*r/d1
- d1i = r**2/d1
+ eps = 2._plflt
- q2 = -1._plflt
- d2 = r/4._plflt
+ q1 = 1._plflt
+ d1 = r/4._plflt
- q2i = - q2*r/d2
- d2i = r**2/d2
+ q1i = - q1*r/d1
+ d1i = r**2/d1
- do i = 1, nx
+ q2 = -1._plflt
+ d2 = r/4._plflt
+
+ q2i = - q2*r/d2
+ d2i = r**2/d2
+
+ do i = 1, nx
do j = 1, ny
- div1 = sqrt((xg(i,j)-d1)**2 + (yg(i,j)-d1)**2 + eps**2)
- div1i = sqrt((xg(i,j)-d1i)**2 + (yg(i,j)-d1i)**2 + eps**2)
+ div1 = sqrt((xg(i,j)-d1)**2 + (yg(i,j)-d1)**2 + eps**2)
+ div1i = sqrt((xg(i,j)-d1i)**2 + (yg(i,j)-d1i)**2 + eps**2)
- div2 = sqrt((xg(i,j)-d2)**2 + (yg(i,j)+d2)**2 + eps**2)
- div2i = sqrt((xg(i,j)-d2i)**2 + (yg(i,j)+d2i)**2 + eps**2)
+ div2 = sqrt((xg(i,j)-d2)**2 + (yg(i,j)+d2)**2 + eps**2)
+ div2i = sqrt((xg(i,j)-d2i)**2 + (yg(i,j)+d2i)**2 + eps**2)
- z(i,j) = q1/div1 + q1i/div1i + q2/div2 + q2i/div2i
+ z(i,j) = q1/div1 + q1i/div1i + q2/div2 + q2i/div2i
enddo
- enddo
+ enddo
-! Tack on extra cell in theta to handle periodicity.
+! Tack on extra cell in theta to handle periodicity.
- do i = 1, nx
- do j = 1, ny
- ztmp(i,j) = z(i,j)
- enddo
- ztmp(i, ny+1) = z(i, 1)
- enddo
- call a2mnmx(z, nx, ny, zmin, zmax, xdim)
+ ztmp(:,1:ny) = z
+ ztmp(:,ny+1:ny+1) = z(:,1:1)
-! Set up contour levels.
+ zmax = maxval( z(1:nx,1:ny) )
+ zmin = minval( z(1:nx,1:ny) )
- nlevel = 20
- dz = abs(zmax - zmin)/dble (nlevel)
- do i = 1, nlevel
- clevel(i) = zmin + (i-0.5_plflt)*dz
- enddo
+! Set up contour levels.
-! Split contours into two parts, z > 0, and z < 0.
-! Dashed contours will be at levels 'ilevlt' through 'ilevlt+nlevlt'.
-! Solid contours will be at levels 'ilevgt' through 'ilevgt+nlevgt'.
+ nlevel = 20
+ dz = abs(zmax - zmin)/dble (nlevel)
+ clevel(1:nlevel) = zmin + (arange(1,nlevel+1) - 0.5_plflt) * dz
- ilevlt = 1
- i = 1
- do while(i.le.nlevel.and.clevel(min(i,nlevel)).le.0._plflt)
- i = i + 1
- enddo
- nlevlt = i - 1
- ilevgt = ilevlt + nlevlt
- nlevgt = nlevel - nlevlt
+! Split contours into two parts, z > 0, and z < 0.
+! Dashed contours will be at levels 'ilevlt' through 'ilevlt+nlevlt'.
+! Solid contours will be at levels 'ilevgt' through 'ilevgt+nlevgt'.
+!
+! Since the array clevel is ordered, we can find the level
+! where the values become positive by counting the non-positive
+! elements
-! Advance graphics frame and get ready to plot.
+ ilevlt = 1
+ nlevlt = count( clevel(1:nlevel) <= 0.0_plflt )
+ ilevgt = ilevlt + nlevlt
+ nlevgt = nlevel - nlevlt
- ncollin = 11
- ncolbox = 1
- ncollab = 2
+! Advance graphics frame and get ready to plot.
- call pladv(0)
- call plcol0(ncolbox)
+ ncollin = 11
+ ncolbox = 1
+ ncollab = 2
-! Scale window to user coordinates.
-! Make a bit larger so the boundary doesn't get clipped.
+ call pladv(0)
+ call plcol0(ncolbox)
- eps = 0.05_plflt
- xpmin = xmin - abs(xmin)*eps
- xpmax = xmax + abs(xmax)*eps
- ypmin = ymin - abs(ymin)*eps
- ypmax = ymax + abs(ymax)*eps
+! Scale window to user coordinates.
+! Make a bit larger so the boundary doesn't get clipped.
- call plvpas(0.1_plflt, 0.9_plflt, 0.1_plflt, &
- 0.9_plflt, 1.0_plflt )
- call plwind(xpmin, xpmax, ypmin, ypmax)
+ eps = 0.05_plflt
+ xpmin = xmin - abs(xmin)*eps
+ xpmax = xmax + abs(xmax)*eps
+ ypmin = ymin - abs(ymin)*eps
+ ypmax = ymax + abs(ymax)*eps
- xopt = ' '
- yopt = ' '
- xtick = 0._plflt
- nxsub = 0
- ytick = 0._plflt
- nysub = 0
+ call plvpas(0.1_plflt, 0.9_plflt, 0.1_plflt, 0.9_plflt, 1.0_plflt )
+ call plwind(xpmin, xpmax, ypmin, ypmax)
- call plbox(xopt, xtick, nxsub, yopt, ytick, nysub)
+ xopt = ' '
+ yopt = ' '
+ xtick = 0._plflt
+ nxsub = 0
+ ytick = 0._plflt
+ nysub = 0
-! Call plotter once for z < 0 (dashed), once for z > 0 (solid lines).
+ call plbox(xopt, xtick, nxsub, yopt, ytick, nysub)
- call plcol0(ncollin)
- if(nlevlt .gt. 0) then
- call pllsty(2)
- call plcont(ztmp, kx, lx, ky, ly+1, &
- clevel(ilevlt:nlevlt), xg, yg)
- endif
- if(nlevgt .gt. 0) then
+! Call plotter once for z < 0 (dashed), once for z > 0 (solid lines).
+
+ call plcol0(ncollin)
+ if (nlevlt > 0) then
+ call pllsty(2)
+ call plcont(ztmp, kx, lx, ky, ly+1, &
+ clevel(ilevlt:nlevlt), xg, yg)
+ endif
+ if (nlevgt > 0) then
call pllsty(1)
call plcont(ztmp, kx, lx, ky, ly+1, &
- clevel(ilevgt:ilevgt-1+nlevgt), xg, yg)
- endif
+ clevel(ilevgt:ilevgt-1+nlevgt), xg, yg)
+ endif
-! Draw boundary.
+! Draw boundary.
- do i = 1, NPLT
- theta = (TWOPI)/(NPLT-1) * dble (i-1)
- xtm(i) = x0 + rmax * cos(theta)
- ytm(i) = y0 + rmax * sin(theta)
- enddo
- call plcol0(ncolbox)
- call plline(xtm, ytm)
+ delta = TWOPI/(NPLT-1)
+ xtm = x0 + rmax * cos(delta*arange(0,NPLT))
+ ytm = y0 + rmax * sin(delta*arange(0,NPLT))
- call plcol0(ncollab)
- call pllab('', '', &
- 'Shielded potential of charges in a conducting sphere')
- end
+ call plcol0(ncolbox)
+ call plline(xtm, ytm)
-!----------------------------------------------------------------------------
-! Subroutine a2mnmx
-! Minimum and the maximum elements of a 2-d array.
-
- subroutine a2mnmx(f, nx, ny, fmin, fmax, xdim)
- use plplot
- implicit none
-
- integer i, j, nx, ny, xdim
- real(kind=plflt) f(xdim, ny), fmin, fmax
-
- fmax = f(1, 1)
- fmin = fmax
- do j = 1, ny
- do i = 1, nx
- fmax = max(fmax, f(i, j))
- fmin = min(fmin, f(i, j))
- enddo
- enddo
- end
+ call plcol0(ncollab)
+ call pllab('', '', 'Shielded potential of charges in a conducting sphere')
+end subroutine potential
+end program x09f95
Modified: trunk/examples/f95/x10f.f90
===================================================================
--- trunk/examples/f95/x10f.f90 2012-01-05 13:59:36 UTC (rev 12123)
+++ trunk/examples/f95/x10f.f90 2012-01-07 11:55:17 UTC (rev 12124)
@@ -1,45 +1,45 @@
-! $Id$
-! Demonstration program for PLplot illustrating absolute positioning
-! of graphs on a page
+! $Id$
+! Demonstration program for PLplot illustrating absolute positioning
+! of graphs on a page
!
-! Copyright (C) 2004 Alan W. Irwin
+! Copyright (C) 2004 Alan W. Irwin
!
-! This file is part of PLplot.
+! This file is part of PLplot.
!
-! PLplot is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Library General Public License as
-! published by the Free Software Foundation; either version 2 of the
-! License, or (at your option) any later version.
+! PLplot is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Library General Public License as
+! published by the Free Software Foundation; either version 2 of the
+! License, or (at your option) any later version.
!
-! PLplot is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU Library General Public License for more details.
+! PLplot is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU Library General Public License for more details.
!
-! You should have received a copy of the GNU Library General Public
-! License along with PLplot; if not, write to the Free Software
-! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+! You should have received a copy of the GNU Library General Public
+! License along with PLplot; if not, write to the Free Software
+! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- use plplot
- implicit none
-! Process command-line arguments
- call plparseopts(PL_PARSE_FULL)
+program x10f95
+ use plplot
+ implicit none
+! Process command-line arguments
+ call plparseopts(PL_PARSE_FULL)
- call plinit()
+ call plinit()
- call pladv(0)
- call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
- call plwind(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
- call plbox('bc', 0.0_plflt, 0, 'bc', 0.0_plflt, 0 )
+ call pladv(0)
+ call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ call plwind(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ call plbox('bc', 0.0_plflt, 0, 'bc', 0.0_plflt, 0 )
- call plsvpa(50.0_plflt, 150.0_plflt, 50.0_plflt, &
- 100.0_plflt )
- call plwind(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
- call plbox('bc', 0.0_plflt, 0, 'bc', 0.0_plflt, 0 )
- call plptex(0.5_plflt, 0.5_plflt, 1.0_plflt, 0.0_plflt, &
- 0.5_plflt, 'BOX at (50,150,50,100)' )
+ call plsvpa(50.0_plflt, 150.0_plflt, 50.0_plflt, 100.0_plflt )
+ call plwind(0.0_plflt, 1.0_plflt, 0.0_plflt, 1.0_plflt )
+ call plbox('bc', 0.0_plflt, 0, 'bc', 0.0_plflt, 0 )
+ call plptex(0.5_plflt, 0.5_plflt, 1.0_plflt, 0.0_plflt, &
+ 0.5_plflt, 'BOX at (50,150,50,100)' )
- call plend
+ call plend
- end
+end program x10f95
Modified: trunk/examples/f95/x11f.f90
===================================================================
--- trunk/examples/f95/x11f.f90 2012-01-05 13:59:36 UTC (rev 12123)
+++ trunk/examples/f95/x11f.f90 2012-01-07 11:55:17 UTC (rev 12124)
@@ -1,181 +1,159 @@
-! $Id$
-! Mesh plot demo
+! $Id$
+! Mesh plot demo
!
-! Copyright (C) 2004 Alan W. Irwin
+! Copyright (C) 2004 Alan W. Irwin
!
-! This file is part of PLplot.
+! This file is part of PLplot.
!
-! PLplot is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Library General Public License as
-! published by the Free Software Foundation; either version 2 of the
-! License, or (at your option) any later version.
+! PLplot is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Library General Public License as
+! published by the Free Software Foundation; either version 2 of the
+! License, or (at your option) any later version.
!
-! PLplot is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU Library General Public License for more details.
+! PLplot is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU Library General Public License for more details.
!
-! You should have received a copy of the GNU Library General Public
-! License along with PLplot; if not, write to the Free Software
-! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+! You should have received a copy of the GNU Library General Public
+! License along with PLplot; if not, write to the Free Software
+! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
- use plplot, PI => PL_PI
- implicit none
- integer i, j, k, ifshade, xpts, ypts
- parameter (xpts=35, ypts=46)
+program x11f95
+ use plplot, PI => PL_PI
+ use plf95demolib
+ implicit none
+ integer, parameter :: xpts=35, ypts=46
+ integer :: i, j, k, ifshade
- real(kind=plflt) x(xpts), y(ypts), z(xpts,ypts), xx, yy
+ real(kind=plflt) :: x(xpts), y(ypts), z(xpts,ypts), xx, yy
- character(len=80) title(2)
- real(kind=plflt) alt(2),az(2)
- integer opt(2)
- data alt /33.0_plflt,17.0_plflt/
- data az /24.0_plflt,115.0_plflt/
-! DRAW_LINEXY
- data opt /2*3/
- data title /'#frPLplot Example 11 - Alt=33, Az=24, Opt=3', &
- '#frPLplot Example 11 - Alt=17, Az=115, Opt=3'/
- integer nlevel
- parameter (nlevel = 10)
- real(kind=plflt) zmin, zmax, step, clevel(nlevel)
-! Process command-line arguments
- call plparseopts(PL_PARSE_FULL)
+ character(len=80) :: title(2) = &
+ (/ '#frPLplot Example 11 - Alt=33, Az=24, Opt=3 ', &
+ '#frPLplot Example 11 - Alt=17, Az=115, Opt=3' /)
+ real(kind=plflt) :: alt(2) = (/ 33.0_plflt, 17.0_plflt/)
+ real(kind=plflt) :: az(2) = (/ 24.0_plflt, 115.0_plflt/)
+ integer :: opt(2) = (/ 3, 3 /)
+ integer, parameter :: nlevel = 10
+ real(kind=plflt) :: zmin, zmax, step, clevel(nlevel)
- do i = 1,xpts
- x(i) = 3._plflt*dble(i-1-(xpts/2))/dble (xpts/2)
- enddo
- do j = 1,ypts
- y(j) = 3._plflt*dble(j-1-(ypts/2))/dble (ypts/2)
- enddo
+! Process command-line arguments
+ call plparseopts(PL_PARSE_FULL)
- do i=1,xpts
+ x = 3._plflt * (arange(0,xpts) - (xpts/2)) / dble(xpts/2)
+ y = 3._plflt * (arange(0,ypts) - (ypts/2)) / dble(ypts/2)
+
+ do i=1,xpts
xx = x(i)
do j=1,ypts
- yy = y(j)
- z(i,j) = 3._plflt * (1._plflt-xx)*(1._plflt-xx) * &
- exp(-(xx*xx) - (yy+1._plflt)*(yy+1._plflt)) - &
- 10._plflt * (xx/5._plflt - xx**3 - yy**5) * exp(-xx*xx-yy*yy) - &
- 1._plflt/3._plflt * exp(-(xx+1._plflt)*(xx+1._plflt) - (yy*yy))
- if(.false.) then
-! Jungfraujoch/Interlaken
- if(z(i,j).lt.-1._plflt) z(i,j) = -1._plflt
- endif
+ yy = y(j)
+ z(i,j) = 3._plflt * (1._plflt-xx)*(1._plflt-xx) * &
+ exp(-(xx**2) - (yy+1._plflt)*(yy+1._plflt)) - &
+ 10._plflt * (xx/5._plflt - xx**3 - yy**5) * exp(-xx**2-yy**2) - &
+ 1._plflt/3._plflt * exp(-(xx+1._plflt)*(xx+1._plflt) - (yy**2))
+
enddo
- enddo
- call a2mnmx(z, xpts, ypts, zmin, zmax)
- step = (zmax-zmin)/(nlevel+1)
- do i = 1, nlevel
- clevel(i) = zmin + step*i
- enddo
+ enddo
+ if (.false.) then
+! Jungfraujoch/Interlaken
+ z = max(z, -1._plflt)
+ endif
- call plinit()
- call cmap1_init(0)
- do k=1,2
+ zmin = minval(z)
+ zmax = maxval(z)
+
+ step = (zmax-zmin)/(nlevel+1)
+ clevel = zmin + step * arange(1,nlevel+1)
+
+ call plinit()
+ call cmap1_init(0)
+
+ do k=1,2
do ifshade = 0, 3
- call pladv(0)
- call plcol0(1)
- call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 0.9_plflt )
- call plwind(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.5_plflt )
- call plw3d(1.0_plflt, 1.0_plflt, 1.2_plflt, -3.0_plflt, &
- 3.0_plflt, -3.0_plflt, 3.0_plflt, zmin, zmax, alt(k),az(k))
- call plbox3('bnstu','x axis', 0.0_plflt, 0, &
- 'bnstu', 'y axis', 0.0_plflt, 0, &
- 'bcdmnstuv','z axis', 0.0_plflt, 0)
- call plcol0(2)
- if(ifshade.eq.0) then
-! wireframe plot
- call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
- opt(k))
- elseif(ifshade.eq.1) then
-! magnitude colored wireframe plot
- call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), &
- ior(opt(k), MAG_COLOR))
- elseif(ifshade.eq.2) then
-! magnitude colored wireframe plot with sides
- call plot3d(x(:xpts), y(:ypts), z(:xpts,:ypts), &
- ior(opt(k), MAG_COLOR), .true.)
- elseif(ifshade.eq.3) then
-! magnitude colored wireframe plot with base contour
- call plmeshc(x(:xpts), y(:ypts), z(:xpts,:ypts), &
- ior(opt(k), ior(MAG_COLOR, BASE_CONT)), clevel)
- else
- stop 'x11f: bad logic'
- endif
- call plcol0(3)
- call plmtex('t', 1.0_plflt, 0.5_plflt, 0.5_plflt, title(k))
+ call pladv(0)
+ call plcol0(1)
+ call plvpor(0.0_plflt, 1.0_plflt, 0.0_plflt, 0.9_plflt )
+ call plwind(-1.0_plflt, 1.0_plflt, -1.0_plflt, 1.5_plflt )
+ call plw3d(1.0_plflt, 1.0_plflt, 1.2_plflt, -3.0_plflt, &
+ 3.0_plflt, -3.0_plflt, 3.0_plflt, zmin, zmax, alt(k),az(k))
+ call plbox3('bnstu', 'x axis', 0.0_plflt, 0, &
+ 'bnstu', 'y axis', 0.0_plflt, 0, &
+ 'bcdmnstuv', 'z axis', 0.0_plflt, 0)
+ call plcol0(2)
+
+ select case (ifshade)
+ case (0) ! wireframe plot
+ call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), opt(k))
+
+ case (1) ! magnitude colored wireframe plot
+ call plmesh(x(:xpts), y(:ypts), z(:xpts,:ypts), ior(opt(k), MAG_COLOR))
+
+ case (2) ! magnitude colored wireframe plot with sides
+ call plot3d(x(:xpts), y(:ypts), z(:xpts,:ypts), &
+ ior(opt(k), MAG_COLOR), .true.)
+
+ case (3) ! magnitude colored wireframe plot with base contour
+ call plmeshc(x(:xpts), y(:ypts), z(:xpts,:ypts), &
+ ior(opt(k), ior(MAG_COLOR, BASE_CONT)), clevel)
+
+ case default
+ stop 'x11f: bad logic'
+ end select
+ call plcol0(3)
+ call plmtex('t', 1.0_plflt, 0.5_plflt, 0.5_plflt, title(k))
enddo
- enddo
- call plend
- end
+ enddo
+ call plend
+contains
!----------------------------------------------------------------------------
- subroutine cmap1_init(gray)
-! For gray.eq.1, basic grayscale variation from half-dark
-! to light. Otherwise, hue variations around the front of the
-! colour wheel from blue to green to red with constant lightness
-! and saturation.
+subroutine cmap1_init(gray)
+! For gray.eq.1, basic grayscale variation from half-dark
+! to light. Otherwise, hue variations around the front of the
+! colour wheel from blue to green to red with constant lightness
+! and saturation.
- use plplot
- implicit none
- integer gray
- real(kind=plflt) i(0:1), h(0:1), l(0:1), s(0:1)
-! left boundary
- i(0) = 0._plflt
-! right boundary
- i(1) = 1._plflt
- if (gray.eq.1) then
-! hue -- low: red (arbitrary if s=0)
+ integer gray
+ real(kind=plflt) i(0:1), h(0:1), l(0:1), s(0:1)
+
+! left boundary
+ i(0) = 0._plflt
+! right boundary
+ i(1) = 1._plflt
+ if (gray == 1) then
+! hue -- low: red (arbitrary if s=0)
h(0) = 0.0_plflt
-! hue -- high: red (arbitrary if s=0)
+! hue -- high: red (arbitrary if s=0)
h(1) = 0.0_plflt
-! lightness -- low: half-dark
+! lightness -- low: half-dark
l(0) = 0.5_plflt
-! lightness -- high: light
+! lightness -- high: light
l(1) = 1.0_plflt
-! minimum saturation
+! minimum saturation
s(0) = 0.0_plflt
-! minimum saturation
+! minimum saturation
s(1) = 0.0_plflt
- else
-! This combination of hues ranges from blue to cyan to green to yellow
-! to red (front of colour wheel) with constant lightness = 0.6
-! and saturation = 0.8.
+ else
+! This combination of hues ranges from blue to cyan to green to yellow
+! to red (front of colour wheel) with constant lightness = 0.6
+! and saturation = 0.8.
-! hue -- low: blue
+! hue -- low: blue
h(0) = 240._plflt
-! hue -- high: red
+! hue -- high: red
h(1) = 0.0_plflt
-! lightness -- low:
+! lightness -- low:
l(0) = 0.6_plflt
-! lightness -- high:
+! lightness -- high:
l(1) = 0.6_plflt
-! saturation
+! saturation
s(0) = 0.8_plflt
-! minimum saturation
+! minimum saturation
s(1) = 0.8_plflt
- endif
- call plscmap1n(256)
- call plscmap1l(.false., i, h, l, s)
- end
+ endif
+ call plscmap1n(256)
+ call plscmap1l(.false., i, h, l, s)
+end subroutine cmap1_init
-!----------------------------------------------------------------------------
-! Subroutine a2mnmx
-! Minimum and the maximum elements of a 2-d array.
-
- subroutine a2mnmx(f, nx, ny, fmin, fmax)
- use plplot
- implicit none
-
- integer i, j, nx, ny
- real(kind=plflt) f(nx, ny), fmin, fmax
-
- fmax = f(1, 1)
- fmin = fmax
- do j = 1, ny
- do i = 1, nx
- fmax = max(fmax, f(i, j))
- fmin = min(fmin, f(i, j))
- enddo
- enddo
- end
+end program x11f95
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|