Menu
▾
▴
[Plplot-cvs] SF.net SVN: plplot:[8557] trunk
|
From: <and...@us...> - 2008-07-22 15:57:33
|
Revision: 8557
http://plplot.svn.sourceforge.net/plplot/?rev=8557&view=rev
Author: andrewross
Date: 2008-07-22 15:57:38 +0000 (Tue, 22 Jul 2008)
Log Message:
-----------
Add f77 and f95 support for plrandd, plrandi and plseed.
Fix f77 support for plot3dc (previously untested by examples).
Add f77 version of example 21. Note that this current crashes for me so is disabled as part of ctest.
Modified Paths:
--------------
trunk/bindings/f77/plstubs.h
trunk/bindings/f77/scstubs.c
trunk/bindings/f95/plstubs.h
trunk/bindings/f95/scstubs.c
trunk/bindings/f95/sfstubsf95.f90
trunk/examples/f77/CMakeLists.txt
Added Paths:
-----------
trunk/examples/f77/x21f.fm4
Modified: trunk/bindings/f77/plstubs.h
===================================================================
--- trunk/bindings/f77/plstubs.h 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/bindings/f77/plstubs.h 2008-07-22 15:57:38 UTC (rev 8557)
@@ -235,8 +235,8 @@
#define PLMTEX7 FNAME(PLMTEX7,plmtex7)
#define PLMTEX37 FNAME(PLMTEX37,plmtex37)
#define PLOT3D FNAME(PLOT3D,plot3d)
-#define PLOT3DC_ FNAME_(PLOT3DC_,plot3dc_)
-#define PLOT3DC FNAME(PLOT3DC_,plot3dc_)
+#define PLOT3DC_ FNAME_(PLOT3DC,plot3dc)
+#define PLOT3DC FNAME(PLOT3DC,plot3dc)
#define PLOT3DCL FNAME(PLOT3DCL,plot3dcl)
#define PLPARSEOPTS7 FNAME(PLPARSEOPTS7,plparseopts7)
#define PLPAT FNAME(PLPAT,plpat)
@@ -247,6 +247,8 @@
#define PLPSTY FNAME(PLPSTY,plpsty)
#define PLPTEX7 FNAME(PLPTEX7,plptex7)
#define PLPTEX37 FNAME(PLPTEX37,plptex37)
+#define PLRANDD FNAME(PLRANDD,plrandd)
+#define PLRANDI FNAME(PLRANDI,plrandi)
#define PLREPLOT FNAME(PLREPLOT,plreplot)
#define PLRGB FNAME(PLRGB,plrgb)
#define PLRGB1 FNAME(PLRGB1,plrgb1)
@@ -272,6 +274,7 @@
#define PLSDIORI FNAME(PLSDIORI,plsdiori)
#define PLSDIPLT FNAME(PLSDIPLT,plsdiplt)
#define PLSDIPLZ FNAME(PLSDIPLZ,plsdiplz)
+#define PLSEED FNAME(PLSEED,plseed)
#define PLSESC FNAME(PLSESC,plsesc)
#define PLSETOPT7 FNAME(PLSETOPT7,plsetopt7)
#define PLSFAM FNAME(PLSFAM,plsfam)
Modified: trunk/bindings/f77/scstubs.c
===================================================================
--- trunk/bindings/f77/scstubs.c 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/bindings/f77/scstubs.c 2008-07-22 15:57:38 UTC (rev 8557)
@@ -597,6 +597,18 @@
c_plptex3(*x, *y, *z, *dx, *dy, *dz, *sx, *sy, *sz, *just, text);
}
+PLFLT
+PLRANDD()
+{
+ return c_plrandd();
+}
+
+unsigned long
+PLRANDI()
+{
+ return c_plrandi();
+}
+
void
PLREPLOT(void)
{
@@ -752,6 +764,12 @@
}
void
+PLSEED(unsigned int s)
+{
+ c_plseed(s);
+}
+
+void
PLSESC(PLINT *esc)
{
c_plsesc((char) *esc);
Modified: trunk/bindings/f95/plstubs.h
===================================================================
--- trunk/bindings/f95/plstubs.h 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/bindings/f95/plstubs.h 2008-07-22 15:57:38 UTC (rev 8557)
@@ -247,6 +247,8 @@
#define PLPSTY FNAME(PLPSTY,plpsty)
#define PLPTEX7 FNAME(PLPTEX7,plptex7)
#define PLPTEX37 FNAME(PLPTEX37,plptex37)
+#define PLRANDD FNAME(PLRANDDF77,plranddf77)
+#define PLRANDI FNAME(PLRANDIF77,plrandif77)
#define PLREPLOT FNAME(PLREPLOT,plreplot)
#define PLRGB FNAME(PLRGB,plrgb)
#define PLRGB1 FNAME(PLRGB1,plrgb1)
@@ -274,6 +276,7 @@
#define PLSDIORI FNAME(PLSDIORI,plsdiori)
#define PLSDIPLT FNAME(PLSDIPLT,plsdiplt)
#define PLSDIPLZ FNAME(PLSDIPLZ,plsdiplz)
+#define PLSEED FNAME(PLSEEDF77,plseedf77)
#define PLSESC FNAME(PLSESC,plsesc)
#define PLSETOPT7 FNAME(PLSETOPT7,plsetopt7)
#define PLSFAM FNAME(PLSFAM,plsfam)
Modified: trunk/bindings/f95/scstubs.c
===================================================================
--- trunk/bindings/f95/scstubs.c 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/bindings/f95/scstubs.c 2008-07-22 15:57:38 UTC (rev 8557)
@@ -599,6 +599,18 @@
c_plptex3(*x, *y, *z, *dx, *dy, *dz, *sx, *sy, *sz, *just, text);
}
+PLFLT
+PLRANDD()
+{
+ return c_plrandd();
+}
+
+unsigned long
+PLRANDI()
+{
+ return c_plrandi();
+}
+
void
PLREPLOT(void)
{
@@ -768,6 +780,12 @@
}
void
+PLSEED(unsigned int s)
+{
+ c_plseed(s);
+}
+
+void
PLSESC(PLINT *esc)
{
c_plsesc((char) *esc);
Modified: trunk/bindings/f95/sfstubsf95.f90
===================================================================
--- trunk/bindings/f95/sfstubsf95.f90 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/bindings/f95/sfstubsf95.f90 2008-07-22 15:57:38 UTC (rev 8557)
@@ -506,6 +506,16 @@
end interface
interface
+ function plrandd()
+ end function plrandd
+ end interface
+
+ interface
+ function plrandi()
+ end function plrandi
+ end interface
+
+ interface
subroutine plreplot
end subroutine plreplot
end interface
@@ -653,6 +663,11 @@
end subroutine plsdiplz
end interface
+ interface
+ subroutine plseed()
+ end subroutine plseed
+ end interface
+
! TODO: character-version
interface
subroutine plsesc( esc )
Modified: trunk/examples/f77/CMakeLists.txt
===================================================================
--- trunk/examples/f77/CMakeLists.txt 2008-07-22 12:47:26 UTC (rev 8556)
+++ trunk/examples/f77/CMakeLists.txt 2008-07-22 15:57:38 UTC (rev 8557)
@@ -42,6 +42,7 @@
"18"
"19"
"20"
+"21"
"22"
"23"
"28"
Added: trunk/examples/f77/x21f.fm4
===================================================================
--- trunk/examples/f77/x21f.fm4 (rev 0)
+++ trunk/examples/f77/x21f.fm4 2008-07-22 15:57:38 UTC (rev 8557)
@@ -0,0 +1,297 @@
+C $Id:$
+C Grid data demo.
+C
+C Copyright (C) 2004 Joao Cardoso
+C Copyright (C) 2008 Andrew Ross
+C
+C This file is part of PLplot.
+C
+C PLplot is free software; you can redistribute it and/or modify
+C it under the terms of the GNU General Library Public License as
+C published by the Free Software Foundation; either version 2 of the
+C License, or (at your option) any later version.
+C
+C PLplot is distributed in the hope that it will be useful,
+C but WITHOUT ANY WARRANTY; without even the implied warranty of
+C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+C GNU Library General Public License for more details.
+C
+C You should have received a copy of the GNU Library General Public
+C License along with PLplot; if not, write to the Free Software
+C Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+ implicit none
+
+ real*8 PI
+ parameter (PI = 3.1415926535897932384d0)
+
+ integer PL_PARSE_FULL
+ parameter(PL_PARSE_FULL = 1)
+
+ integer GRID_CSA, GRID_DTLI, GRID_NNI, GRID_NNIDW, GRID_NNLI,
+ & GRID_NNAIDW
+ parameter (GRID_CSA = 1)
+ parameter (GRID_DTLI = 2)
+ parameter (GRID_NNI = 3)
+ parameter (GRID_NNIDW = 4)
+ parameter (GRID_NNLI = 5)
+ parameter (GRID_NNAIDW = 6)
+
+ integer DRAW_LINEXY, MAG_COLOR, BASE_CONT
+ parameter(DRAW_LINEXY = 3)
+ parameter(MAG_COLOR = 4)
+ parameter(BASE_CONT = 8)
+
+ external plrandd
+ real*8 plrandd
+
+ integer pts, xp, yp, nl, knn_order, randn, rosen
+ real*8 threshold, wmin
+ parameter (pts = 500)
+ parameter (xp = 25)
+ parameter (yp = 20)
+ parameter (nl = 15)
+ parameter (knn_order = 20)
+ parameter (threshold = 1.001)
+ parameter (wmin = -1e3)
+ parameter (randn = 0)
+ parameter (rosen = 0)
+
+ real*8 xmin, xmax, ymin, ymax
+
+ real*8 x(pts), y(pts), z(pts), clev(nl)
+ real*8 xg(xp), yg(yp), zg(xp,yp)
+ real*8 zmin, zmax, lzmin, lzmax
+ integer i, j, k
+ integer alg;
+ character*80 title(6)
+ data title /'Cubic Spline Approximation',
+ & 'Delaunay Linear Interpolation',
+ & 'Natural Neighbors Interpolation',
+ & 'KNN Inv. Distance Weighted',
+ & '3NN Linear Interpolation',
+ & '4NN Around Inv. Dist. Weighted'/
+
+ real*8 opt(6)
+ data opt /0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0/
+
+ real*8 xt, yt
+
+ real*8 r
+ integer ii, jj
+ real*8 dist, d
+
+ xmin = -0.2
+ ymin = -0.2
+ xmax = 0.6
+ ymax = 0.6
+
+c call plMergeOpts(options, "x21c options", NULL);
+ call plparseopts(PL_PARSE_FULL);
+
+ opt(3) = wmin;
+ opt(4) = dble(knn_order);
+ opt(5) = threshold;
+
+c Initialize plplot
+
+ call plinit
+
+ do i=1,pts
+ xt = (xmax-xmin)*plrandd()
+ yt = (ymax-ymin)*plrandd()
+ if (randn.eq.0) then
+ x(i) = xt + xmin
+ y(i) = yt + ymin
+ else
+ x(i) = sqrt(-2.d0*log(xt)) * cos(2.d0*PI*yt) + xmin
+ y(i) = sqrt(-2.d0*log(xt)) * sin(2.d0*PI*yt) + ymin
+ endif
+ if (rosen.eq.0) then
+ r = sqrt(x(i)*x(i) + y(i)*y(i))
+ z(i) = exp(-r*r)*cos(2.d0*PI*r)
+ else
+ z(i) = log((1.d0-x(i))**2 + 100.d0*(y(i)-x(i)**2)**2)
+ endif
+ enddo
+
+ zmin = z(1)
+ zmax = z(1)
+ do i=2,pts
+ zmax = max(zmax,z(i))
+ zmin = min(zmin,z(i))
+ enddo
+
+ do i=1,xp
+ xg(i) = xmin + (xmax-xmin)*(i-1.d0)/(xp-1.d0)
+ enddo
+ do i=1,yp
+ yg(i) = ymin + (ymax-ymin)*(i-1.d0)/(yp-1.d0)
+ enddo
+
+ call plcol0(1)
+ call plenv(xmin, xmax, ymin, ymax, 2, 0)
+ call plcol0(15)
+ call pllab("X", "Y", "The original data sampling")
+ call plcol0(2)
+ call plpoin(pts, x, y, 5)
+ call pladv(0)
+
+ call plssub(3,2)
+
+ do k=1,2
+ call pladv(0);
+ do alg=1,6
+
+ call plgriddata(x, y, z, pts, xg, xp, yg, yp, zg, alg,
+ & opt(alg))
+
+c - CSA can generate NaNs (only interpolates? !).
+c - DTLI and NNI can generate NaNs for points outside the convex hull
+c of the data points.
+c - NNLI can generate NaNs if a sufficiently thick triangle is not found
+c
+c PLplot should be NaN/Inf aware, but changing it now is quite a job...
+c so, instead of not plotting the NaN regions, a weighted average over
+c the neighbors is done.
+c
+
+ if ((alg.eq.GRID_CSA).or.(alg.eq.GRID_DTLI).or.
+ & (alg.eq.GRID_NNLI).or.(alg.eq.GRID_NNI)) then
+
+ do i=1,xp
+ do j=1,yp
+ if (isnan(zg(i,j))) then
+c average (IDW) over the 8 neighbors
+
+ zg(i,j) = 0.d0
+ dist = 0.d0
+
+ ii=i-1
+ do while ((ii.le.i+1).and.(ii.le.xp))
+ jj = j-1
+ do while ((jj.le.j+1).and.(jj.le.yp))
+ if ((ii.ge.1) .and. (jj.ge.1) .and.
+ & (.not.isnan(zg(ii,jj))) ) then
+ if (abs(ii-i) + abs(jj-j) .eq. 1) then
+ d = 1.d0
+ else
+ d = 1.4142
+ endif
+ zg(i,j) = zg(i,j) + zg(ii,jj)/(d*d)
+ dist = dist + d
+ endif
+ jj = jj+1
+ enddo
+ ii = ii+1
+ enddo
+ if (dist.ne.0.d0) then
+ zg(i,j) = zg(i,j) / dist
+ else
+ zg(i,j) = zmin
+ endif
+ endif
+ enddo
+ enddo
+ endif
+
+ call a2mnmx(zg, xp, yp, lzmax, lzmin, xp);
+
+ call plcol0(1)
+ call pladv(alg)
+
+ if (k.eq.0) then
+
+ lzmin = min(lzmin, zmin)
+ lzmax = max(lzmax, zmax)
+ do i=1,nl
+ clev(i) = lzmin + (lzmax-lzmin)/(nl-1.d0)*(i-1.d0);
+ enddo
+ call plenv0(xmin, xmax, ymin, ymax, 2, 0)
+ call plcol0(15)
+ call pllab("X", "Y", title(alg))
+ call plshades(zg, xp, yp, xmin, xmax, ymin, ymax,
+ & clev, nl, 1, 0, 1, 1)
+ call plcol0(2)
+ else
+
+ do i = 1,nl
+ clev(i) = lzmin + (lzmax-lzmin)/(nl-1.d0)*(i-1.d0);
+ enddo
+ call cmap1_init()
+ call plvpor(0.0, 1.0, 0.0, 0.9)
+ call plwind(-1.1, 0.75, -0.65, 1.20)
+c
+c For the comparison to be fair, all plots should have the
+c same z values, but to get the max/min of the data generated
+c by all algorithms would imply two passes. Keep it simple.
+c
+c plw3d(1., 1., 1., xmin, xmax, ymin, ymax, zmin, zmax, 30, -60);
+c
+
+ call plw3d(1., 1., 1., xmin, xmax, ymin, ymax, lzmin,
+ & lzmax, 30, -40)
+ call plbox3("bntu", "X", 0., 0,
+ & "bntu", "Y", 0., 0,
+ & "bcdfntu", "Z", 0.5, 0)
+ call plcol0(15)
+ call pllab("", "", title(alg))
+c call plot3dc(xg, yg, zg, xp, yp, ior(ior(DRAW_LINEXY,
+c & MAG_COLOR), BASE_CONT), clev, nl, xp)
+ endif
+ enddo
+ enddo
+
+ end
+
+ subroutine cmap1_init
+ implicit none
+ real*8 i(2), h(2), l(2), s(2)
+
+ i(0) = 0.d0
+ i(1) = 1.d0
+
+ h(0) = 240.d0
+ h(1) = 0.d0
+
+ l(0) = 0.6d0
+ l(1) = 0.6d0
+
+ s(0) = 0.8d0
+ s(1) = 0.8d0
+
+ call plscmap1n(256)
+ call plscmap1l(0, 2, i, h, l, s, 0)
+ end subroutine
+
+
+ function isnan(x)
+ implicit none
+
+ logical isnan
+ real*8 x
+
+ isnan = (x.ne.x)
+ return
+ end function
+
+
+C----------------------------------------------------------------------------
+C Subroutine a2mnmx
+C Minimum and the maximum elements of a 2-d array.
+
+ subroutine a2mnmx(f, nx, ny, fmin, fmax, xdim)
+ implicit none
+
+ integer i, j, nx, ny, xdim
+ real*8 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
Property changes on: trunk/examples/f77/x21f.fm4
___________________________________________________________________
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
