Menu
▾
▴
[Plplot-cvs] SF.net SVN: plplot:[8578] trunk
|
From: <and...@us...> - 2008-07-24 13:11:12
|
Revision: 8578
http://plplot.svn.sourceforge.net/plplot/?rev=8578&view=rev
Author: andrewross
Date: 2008-07-24 13:11:19 +0000 (Thu, 24 Jul 2008)
Log Message:
-----------
Fix plimagefr support for f77 and f95 bindings. Update example 20 for f77 and f95. Now
included in standard tests run with ctest. Note that the results between the two are
identical, but differ slightly from the C results. The differences are on the first page.
Modified Paths:
--------------
trunk/bindings/f77/plstubs.h
trunk/bindings/f77/sccont.c
trunk/bindings/f77/scstubs.c
trunk/bindings/f77/sfstubs.fm4
trunk/bindings/f95/plstubs.h
trunk/bindings/f95/sccont.c
trunk/bindings/f95/sfstubs.f90
trunk/bindings/f95/sfstubsf95.f90
trunk/examples/f77/x20f.fm4
trunk/examples/f95/x20f.f90
trunk/plplot_test/test_f77.sh.in
trunk/plplot_test/test_f95.sh.in
Modified: trunk/bindings/f77/plstubs.h
===================================================================
--- trunk/bindings/f77/plstubs.h 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f77/plstubs.h 2008-07-24 13:11:19 UTC (rev 8578)
@@ -218,8 +218,10 @@
#define PLHLS FNAME(PLHLS,plhls)
#define PLHLSRGB FNAME(PLHLSRGB,plhlsrgb)
#define PLIMAGE FNAME(PLIMAGE,plimage)
-/* Commented out for now - needs fixing to use pltr */
-/*#define PLIMAGEFR FNAME(PLIMAGEFR,plimagefr)*/
+#define PLIMAGEFR07 FNAME(PLIMAGEFR07,plimagefr07)
+#define PLIMAGEFR17 FNAME(PLIMAGEFR17,plimagefr17)
+#define PLIMAGEFR27 FNAME(PLIMAGEFR27,plimagefr27)
+#define PLIMAGEFR7 FNAME(PLIMAGEFR7,plimagefr7)
#define PLINIT FNAME(PLINIT,plinit)
#define PLJOIN FNAME(PLJOIN,pljoin)
#define PLLAB7 FNAME(PLLAB7,pllab7)
Modified: trunk/bindings/f77/sccont.c
===================================================================
--- trunk/bindings/f77/sccont.c 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f77/sccont.c 2008-07-24 13:11:19 UTC (rev 8578)
@@ -746,3 +746,119 @@
plFree2dGrid(a, *nptsx, *nptsy);
}
+
+void
+PLIMAGEFR07(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr0, NULL);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
+PLIMAGEFR17(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *xg, PLFLT *yg, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+ PLcGrid cgrid;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ cgrid.nx = (*nx)+1;
+ cgrid.ny = (*ny)+1;
+ cgrid.xg = xg;
+ cgrid.yg = yg;
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr1, (void *) &cgrid);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
+PLIMAGEFR27(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *xg, PLFLT *yg, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+ PLcGrid2 cgrid2;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+ plAlloc2dGrid(&cgrid2.xg, (*nx)+1, (*ny)+1);
+ plAlloc2dGrid(&cgrid2.yg, (*nx)+1, (*ny)+1);
+
+ cgrid2.nx = (*nx)+1;
+ cgrid2.ny = (*ny)+1;
+ for ( i = 0 ; i <= *nx ; i ++ ) {
+ for ( j = 0 ; j <= *ny ; j ++ ) {
+ cgrid2.xg[i][j] = xg[i + j * ((*lx)+1)];
+ cgrid2.yg[i][j] = yg[i + j * ((*lx)+1)];
+ }
+ }
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr2, (void *) &cgrid2);
+
+ plFree2dGrid(pidata, *nx, *ny);
+ plFree2dGrid(cgrid2.xg, (*nx)+1, (*ny)+1);
+ plFree2dGrid(cgrid2.yg, (*nx)+1, (*ny)+1);
+}
+
+void
+PLIMAGEFR7(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *ftr, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr, (void *) ftr);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
Modified: trunk/bindings/f77/scstubs.c
===================================================================
--- trunk/bindings/f77/scstubs.c 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f77/scstubs.c 2008-07-24 13:11:19 UTC (rev 8578)
@@ -386,37 +386,10 @@
c_plhlsrgb(*h, *l, *s, r, g, b);
}
-#if 0
void
-PLIMAGEFR(PLFLT *idata, PLINT *nx, PLINT *ny,
- PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax, PLFLT *zmin, PLFLT *zmax,
- PLFLT *Dxmin, PLFLT *Dxmax, PLFLT *Dymin, PLFLT *Dymax,
- PLFLT *valuemin, PLFLT *valuemax)
-{
- int i, j;
- PLFLT **pidata;
-
- plAlloc2dGrid(&pidata, *nx, *ny);
-
- for ( i = 0 ; i < *nx ; i ++ ) {
- for ( j = 0 ; j < *ny ; j ++ ) {
- pidata[i][j] = idata[i + j * (*nx)];
- }
- }
-
- c_plimagefr(pidata, *nx, *ny,
- *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
- *Dxmin, *Dxmax, *Dymin, *Dymax,
- *valuemin, *valuemax);
-
- plFree2dGrid(pidata, *nx, *ny);
-}
-#endif
-
-void
PLIMAGE(PLFLT *idata, PLINT *nx, PLINT *ny,
PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax, PLFLT *zmin, PLFLT *zmax,
- PLFLT *Dxmin, PLFLT *Dxmax, PLFLT *Dymin, PLFLT *Dymax)
+ PLFLT *Dxmin, PLFLT *Dxmax, PLFLT *Dymin, PLFLT *Dymax, PLINT *lx)
{
int i, j;
PLFLT **pidata;
@@ -425,7 +398,7 @@
for ( i = 0 ; i < *nx ; i ++ ) {
for ( j = 0 ; j < *ny ; j ++ ) {
- pidata[i][j] = idata[i + j * (*nx)];
+ pidata[i][j] = idata[i + j * (*lx)];
}
}
Modified: trunk/bindings/f77/sfstubs.fm4
===================================================================
--- trunk/bindings/f77/sfstubs.fm4 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f77/sfstubs.fm4 2008-07-24 13:11:19 UTC (rev 8578)
@@ -507,6 +507,68 @@
!***********************************************************************
+ subroutine plimagefr0(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,lx)
+
+ implicit none
+ integer nx, ny, lx
+ real*8 z(nx, ny)
+ real*8 xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr07(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,lx)
+
+ end
+
+!***********************************************************************
+
+ subroutine plimagefr1(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,xg,yg,lx)
+
+ implicit none
+ integer nx, ny, lx
+ real*8 z(nx, ny), xg(nx), yg(ny)
+ real*8 xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr17(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,xg,yg,lx)
+
+ end
+
+!***********************************************************************
+
+ subroutine plimagefr2(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,xg,yg,lx)
+
+ implicit none
+ integer nx, ny, lx
+ real*8 z(nx, ny), xg(nx,ny), yg(nx,ny)
+ real*8 xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr27(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,xg,yg,lx)
+
+ end
+
+!***********************************************************************
+
+ subroutine plimagefr(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,lx)
+
+ implicit none
+ integer nx, ny, lx
+ real*8 z(nx, ny)
+ real*8 xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+ real*8 tr(6)
+ common /plplot/ tr
+
+ call plimagefr7(z,nx,ny,xmin,xmax,ymin,ymax,zmin,zmax,
+ & valuemin,valuemax,tr,lx)
+
+ end
+
+!***********************************************************************
+
subroutine pllab(xlab,ylab,title)
implicit none
Modified: trunk/bindings/f95/plstubs.h
===================================================================
--- trunk/bindings/f95/plstubs.h 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f95/plstubs.h 2008-07-24 13:11:19 UTC (rev 8578)
@@ -213,8 +213,10 @@
#define PLHLS FNAME(PLHLS,plhls)
#define PLHLSRGB FNAME(PLHLSRGB,plhlsrgb)
#define PLIMAGE FNAME(PLIMAGEF77,plimagef77)
-/* Commented out until fixed to use pltr */
-/*#define PLIMAGEFR FNAME(PLIMAGEFRF77,plimagefrf77)*/
+#define PLIMAGEFR07 FNAME(PLIMAGEFR07,plimagefr07)
+#define PLIMAGEFR17 FNAME(PLIMAGEFR17,plimagefr17)
+#define PLIMAGEFR27 FNAME(PLIMAGEFR27,plimagefr27)
+#define PLIMAGEFR7 FNAME(PLIMAGEFR7,plimagefr7)
#define PLINIT FNAME(PLINIT,plinit)
#define PLJOIN FNAME(PLJOIN,pljoin)
#define PLLAB7 FNAME(PLLAB7,pllab7)
Modified: trunk/bindings/f95/sccont.c
===================================================================
--- trunk/bindings/f95/sccont.c 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f95/sccont.c 2008-07-24 13:11:19 UTC (rev 8578)
@@ -743,3 +743,120 @@
/* Clean up memory allocated for a */
plFree2dGrid(a, *nx, *ny);
}
+
+void
+PLIMAGEFR07(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+ printf("%f %f\n",*valuemax,*valuemin);
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr0, NULL);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
+PLIMAGEFR17(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *xg, PLFLT *yg, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+ PLcGrid cgrid;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ cgrid.nx = (*nx)+1;
+ cgrid.ny = (*ny)+1;
+ cgrid.xg = xg;
+ cgrid.yg = yg;
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr1, (void *) &cgrid);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
+
+void
+PLIMAGEFR27(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *xg, PLFLT *yg, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+ PLcGrid2 cgrid2;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+ plAlloc2dGrid(&cgrid2.xg, (*nx)+1, (*ny)+1);
+ plAlloc2dGrid(&cgrid2.yg, (*nx)+1, (*ny)+1);
+
+ cgrid2.nx = (*nx)+1;
+ cgrid2.ny = (*ny)+1;
+ for ( i = 0 ; i <= *nx ; i ++ ) {
+ for ( j = 0 ; j <= *ny ; j ++ ) {
+ cgrid2.xg[i][j] = xg[i + j * ((*lx)+1)];
+ cgrid2.yg[i][j] = yg[i + j * ((*lx)+1)];
+ }
+ }
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr2, (void *) &cgrid2);
+
+ plFree2dGrid(pidata, *nx, *ny);
+ plFree2dGrid(cgrid2.xg, (*nx)+1, (*ny)+1);
+ plFree2dGrid(cgrid2.yg, (*nx)+1, (*ny)+1);
+}
+
+void
+PLIMAGEFR7(PLFLT *idata, PLINT *nx, PLINT *ny,
+ PLFLT *xmin, PLFLT *xmax, PLFLT *ymin, PLFLT *ymax,
+ PLFLT *zmin, PLFLT *zmax, PLFLT *valuemin, PLFLT *valuemax,
+ PLFLT *ftr, PLINT *lx)
+{
+ int i, j;
+ PLFLT **pidata;
+
+ plAlloc2dGrid(&pidata, *nx, *ny);
+
+ for ( i = 0 ; i < *nx ; i ++ ) {
+ for ( j = 0 ; j < *ny ; j ++ ) {
+ pidata[i][j] = idata[i + j * (*lx)];
+ }
+ }
+
+ c_plimagefr(pidata, *nx, *ny,
+ *xmin, *xmax, *ymin, *ymax, *zmin, *zmax,
+ *valuemin, *valuemax, pltr, (void *) ftr);
+
+ plFree2dGrid(pidata, *nx, *ny);
+}
Modified: trunk/bindings/f95/sfstubs.f90
===================================================================
--- trunk/bindings/f95/sfstubs.f90 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f95/sfstubs.f90 2008-07-24 13:11:19 UTC (rev 8578)
@@ -590,6 +590,67 @@
!***********************************************************************
+ subroutine plimagefr_0(z,xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax)
+
+ implicit none
+ integer nx, ny, lx
+ real(kind=plflt) z(:,:)
+ real(kind=plflt) xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr07(z,size(z,1),size(z,2),xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,size(z,1))
+
+ end subroutine
+
+!***********************************************************************
+
+ subroutine plimagefr_1(z,xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,xg,yg)
+
+ implicit none
+ integer nx, ny, lx
+ real(kind=plflt) z(:,:), xg(:), yg(:)
+ real(kind=plflt) xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr17(z,size(z,1),size(z,2),xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,xg,yg,size(z,1))
+
+ end subroutine
+
+!***********************************************************************
+
+ subroutine plimagefr_2(z,xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,xg,yg)
+
+ implicit none
+ integer nx, ny, lx
+ real(kind=plflt) z(:,:), xg(:,:), yg(:,:)
+ real(kind=plflt) xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+
+ call plimagefr27(z,size(z,1),size(z,2),xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,xg,yg,size(z,1))
+
+ end subroutine
+
+!***********************************************************************
+
+ subroutine plimagefr_tr(z,xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,tr)
+
+ implicit none
+ integer nx, ny, lx
+ real(kind=plflt) z(:,:)
+ real(kind=plflt) xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax
+ real(kind=plflt) tr(6)
+
+ call plimagefr7(z,size(z,1),size(z,2),xmin,xmax,ymin,ymax,zmin,zmax, &
+ valuemin,valuemax,tr,size(z,1))
+
+ end subroutine
+
+!***********************************************************************
+
subroutine pllab(xlab,ylab,title)
implicit none
Modified: trunk/bindings/f95/sfstubsf95.f90
===================================================================
--- trunk/bindings/f95/sfstubsf95.f90 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/bindings/f95/sfstubsf95.f90 2008-07-24 13:11:19 UTC (rev 8578)
@@ -100,6 +100,15 @@
end interface
private :: plshades_multiple_0, plshades_multiple_1, &
plshades_multiple_2, plshades_multiple_tr
+
+ interface plimagefr
+ module procedure plimagefr_0
+ module procedure plimagefr_1
+ module procedure plimagefr_2
+ module procedure plimagefr_tr
+ end interface
+ private :: plimagefr_0, plimagefr_1, plimagefr_2, plimagefr_tr
+
contains
include 'sfstubs.f90'
end module plplotp
@@ -973,7 +982,7 @@
nx = size(idata,1)
ny = size(idata,2)
call plimagef77( idata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, &
- dxmin, dxmax, dymin, dymax )
+ dxmin, dxmax, dymin, dymax, nx )
end subroutine plimage
subroutine plline( x, y )
Modified: trunk/examples/f77/x20f.fm4
===================================================================
--- trunk/examples/f77/x20f.fm4 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/examples/f77/x20f.fm4 2008-07-24 13:11:19 UTC (rev 8578)
@@ -1,6 +1,7 @@
C $Id: x20c.c 8033 2007-11-23 15:28:09Z andrewross $
C
C Copyright (C) 2004 Alan W. Irwin
+C Copyright (C) 2008 Andrew Ross
C
C This file is part of PLplot.
C
@@ -73,8 +74,8 @@
real*8 XDIMR, YDIMR
parameter(XDIM = 260, YDIM = 260)
parameter(XDIMR = XDIM, YDIMR = YDIM)
- real*8 M_PI
- parameter(M_PI = 3.1415926d0)
+ real*8 PI
+ parameter(PI = 3.1415926535897932384d0)
real*8 x(XDIM), y(YDIM), z(XDIM,YDIM), r(XDIM,YDIM)
real*8 xi, yi, xe, ye
@@ -84,10 +85,16 @@
C
C Dimensions taken from "lena.pgm"
C
- integer width, height, num_col
+ integer width, height, num_col, WDIM, HDIM
+ parameter (WDIM = 500)
+ parameter (HDIM = 500)
data width, height / 500, 500/
- real*8 img_f(500,500)
+ real*8 img_f(WDIM,HDIM)
+ real*8 xg(WDIM+1,HDIM+1), yg(WDIM+1,HDIM+1)
+ real*8 img_max, img_min
+ real x0, y0, dy, stretch
+
logical read_img
external read_img
@@ -120,9 +127,9 @@
C
C call plMergeOpts(options, 'x20c options', NULL)
- dbg = .true.
+ dbg = .false.
nosombrero = .false.
- nointeractive = .true.
+ nointeractive = .false.
f_name = ' '
call plparseopts(PL_PARSE_FULL)
@@ -154,7 +161,7 @@
call plimage(z, XDIM, YDIM,
& 1.d0, XDIMR, 1.d0, YDIMR, 0.d0, 0.d0,
- & 1.d0, XDIMR, 1.d0, YDIMR)
+ & 1.d0, XDIMR, 1.d0, YDIMR, XDIM)
call pladv(0)
endif
@@ -163,27 +170,27 @@
if (.not. nosombrero) then
C draw a yellow plot box, useful for diagnostics! :(
call plcol0(2)
- call plenv(0.d0, 2.d0*M_PI, 0.0d0, 3.d0*M_PI, 1, -1)
+ call plenv(0.d0, 2.d0*PI, 0.0d0, 3.d0*PI, 1, -1)
do 210 i=1,XDIM
- x(i) = (i-1)*2.d0*M_PI/(XDIM-1)
+ x(i) = dble(i-1)*2.d0*PI/dble(XDIM-1)
210 continue
do 220 i=1,YDIM
- y(i) = (i-1)*3.d0*M_PI/(YDIM-1)
+ y(i) = dble(i-1)*3.d0*PI/dble(YDIM-1)
220 continue
do 240 i=1,XDIM
do 230 j=1,YDIM
- r(i,j) = sqrt(x(i)*x(i)+y(j)*y(j))+1e-3
+ r(i,j) = sqrt(x(i)*x(i)+y(j)*y(j))+1.d-3
z(i,j) = sin(r(i,j)) / (r(i,j))
230 continue
240 continue
- call pllab('No, an amplitude clipped ''sombrero''', '',
+ call pllab('No, an amplitude clipped "sombrero"', '',
& 'Saturn?')
call plptex(2.d0, 2.d0, 3.d0, 4.d0, 0.d0, 'Transparent image')
- call plimage(z, XDIM, YDIM, 0.d0, 2.d0*M_PI, 0.0d0, 3.d0*M_PI,
- & 0.05d0, 1.d0, 0.d0, 2.d0*M_PI, 0.d0, 3.d0*M_PI)
+ call plimage(z, XDIM, YDIM, 0.d0, 2.d0*PI, 0.0d0, 3.d0*PI,
+ & 0.05d0, 1.d0, 0.d0, 2.d0*PI, 0.d0, 3.d0*PI, XDIM)
C Save the plot
if (f_name .ne. ' ') then
@@ -213,19 +220,19 @@
call gray_cmap(num_col)
C Display Lena
- width_r = width
- height_r = height
+ width_r = dble(width)
+ height_r = dble(height)
call plenv(1.d0, width_r, 1.d0, height_r, 1, -1)
if (.not. nointeractive) then
- call pllab('Set and drag Button 1 to (re)set selection, Butto
- &n 2 to finish.',' ','Lena...')
+ call pllab('Set and drag Button 1 to (re)set selection, '//
+ & 'Button 2 to finish.',' ','Lena...')
else
call pllab('',' ','Lena...')
endif
call plimage(img_f, width, height, 1.d0, width_r, 1.d0,
- & height_r, 0.d0, 0.d0, 1.d0, width_r, 1.d0, height_r)
+ & height_r, 0.d0, 0.d0, 1.d0, width_r, 1.d0, height_r, WDIM)
C Selection/expansion demo
@@ -260,7 +267,7 @@
C Display selection only
call plimage(img_f, width, height, 1.d0, width_r, 1.d0,
- & height_r, 0.d0, 0.d0, xi, xe, ye, yi)
+ & height_r, 0.d0, 0.d0, xi, xe, ye, yi, WDIM)
call plspause(1)
call pladv(0)
@@ -268,12 +275,46 @@
C Zoom in selection
call plenv(xi, xe, ye, yi, 1, -1)
call plimage(img_f, width, height, 1.d0, width_r, 1.d0,
- & height_r, 0.d0, 0.d0, xi, xe, ye, yi)
+ & height_r, 0.d0, 0.d0, xi, xe, ye, yi, WDIM)
call pladv(0)
endif
+c Base the dynamic range on the image contents.
+
+ call a2mnmx(img_f,width,height,img_min,img_max,WDIM)
+
+ call plcol(2)
+ call plenv(0.d0, width_r, 0.d0, height_r, 1, -1)
+ call pllab("", "", "Reduced dynamic range image example")
+ call plimagefr0(img_f, width, height, 0.d0, width_r, 0.d0,
+ & height_r, 0.d0, 0.d0, img_min + img_max * 0.25d0,
+ & img_max - img_max * 0.25d0, WDIM)
+
+c Draw a distorted version of the original image, showing its
+c full dynamic range.
+ call plenv(0.d0, width_r, 0.d0, height_r, 1, -1)
+ call pllab("", "", "Distorted image example")
+
+c Populate the 2-d grids used for the distortion
+c NB grids must be 1 larger in each dimension than the image
+c since the coordinates are for the corner of each pixel.
+ x0 = 0.5d0*width_r
+ y0 = 0.5d0*height_r
+ dy = 0.5d0*height_r
+ stretch = 0.5d0
+ do i=1,width+1
+ do j=1,height+1
+ xg(i,j) = x0 + (x0-dble(i-1))*(1.0d0 - stretch*
+ & cos((dble(j-1)-y0)/dy*PI*0.5d0))
+ yg(i,j) = dble(j-1)
+ enddo
+ enddo
+ call plimagefr2(img_f, width, height, 0.d0, width_r, 0.d0,
+ & height_r, 0.d0, 0.d0, img_min, img_max, xg, yg, WDIM)
+ call pladv(0)
+
+
call plend()
- call exit(0)
end
@@ -282,7 +323,7 @@
implicit none
character(*) fname
integer width, height
- real*8 img_f(width*height)
+ real*8 img_f(width,height)
integer num_col
character img
@@ -383,8 +424,7 @@
do 210 i = 1,w
record = record + 1
read( 10, rec = record ) img
- k = i + (h-j)*w
- img_f(k) = dble(ichar(img))
+ img_f(i,h-j+1) = dble(ichar(img))
210 continue
220 continue
@@ -514,6 +554,7 @@
yi = yyi
CC get_clip = gin.keysym == 'Q'
+ get_clip = .false.
else
C driver has no xormod capability, just do nothing
get_clip = .false.
@@ -542,3 +583,23 @@
call plscmap1l(1, 2, pos, r, g, b, 0)
end
+
+C----------------------------------------------------------------------------
+C Subroutine a2mmx
+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
Modified: trunk/examples/f95/x20f.f90
===================================================================
--- trunk/examples/f95/x20f.f90 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/examples/f95/x20f.f90 2008-07-24 13:11:19 UTC (rev 8578)
@@ -1,7 +1,9 @@
-! $Id: x20c.c 8033 2007-11-23 15:28:09Z andrewross $
+! $Id:$
!
! Copyright (C) 2004 Alan W. Irwin
+! Copyright (C) 2008 Andrew Ross
!
+!
! This file is part of PLplot.
!
! PLplot is free software; you can redistribute it and/or modify
@@ -84,7 +86,11 @@
!
integer width, height, num_col
real(kind=plflt), dimension(:,:), pointer :: img_f
+ real(kind=plflt), dimension(:,:), pointer :: xg, yg
+ real(kind=plflt) :: img_max, img_min
+ real(kind=plflt) :: x0, y0, dy, stretch
+
!
! Parameters from command-line
!
@@ -107,9 +113,9 @@
!
! call plMergeOpts(options, 'x20c options', NULL)
- dbg = .true.
+ dbg = .false.
nosombrero = .false.
- nointeractive = .true.
+ nointeractive = .false.
f_name = ' '
call plparseopts(PL_PARSE_FULL)
@@ -154,20 +160,20 @@
call plenv(0._plflt, 2._plflt*M_PI, 0.0_plflt, 3._plflt*M_PI, 1, -1)
do i=1,XDIM
- x(i) = (i-1)*2._plflt*M_PI/(XDIM-1)
+ x(i) = dble(i-1)*2._plflt*M_PI/dble(XDIM-1)
enddo
do i=1,YDIM
- y(i) = (i-1)*3._plflt*M_PI/(YDIM-1)
+ y(i) = dble(i-1)*3._plflt*M_PI/dble(YDIM-1)
enddo
do i=1,XDIM
do j=1,YDIM
- r(i,j) = sqrt(x(i)*x(i)+y(j)*y(j))+1e-3
+ r(i,j) = sqrt(x(i)*x(i)+y(j)*y(j))+0.001_plflt
z(i,j) = sin(r(i,j)) / (r(i,j))
enddo
enddo
- call pllab('No, an amplitude clipped ''sombrero''', '', &
+ call pllab('No, an amplitude clipped "sombrero"', '', &
'Saturn?')
call plptex(2._plflt, 2._plflt, 3._plflt, 4._plflt, 0._plflt, 'Transparent image')
call plimage(z, 0._plflt, 2._plflt*M_PI, 0.0_plflt, 3._plflt*M_PI, &
@@ -199,13 +205,13 @@
call gray_cmap(num_col)
! Display Lena
- width_r = width
- height_r = height
+ width_r = dble(width)
+ height_r = dble(height)
call plenv(1._plflt, width_r, 1._plflt, height_r, 1, -1)
if (.not. nointeractive) then
- call pllab('Set and drag Button 1 to (re)set selection, Butto&
- &n 2 to finish.',' ','Lena...')
+ call pllab('Set and drag Button 1 to (re)set selection, Butto'// &
+ 'n 2 to finish.',' ','Lena...')
else
call pllab('',' ','Lena...')
endif
@@ -257,6 +263,44 @@
call pladv(0)
endif
+! Base the dynamic range on the image contents.
+
+ call a2mnmx(img_f,width,height,img_min,img_max,width)
+
+ call plcol(2)
+ call plenv(0._plflt, width_r, 0._plflt, height_r, 1, -1)
+ call pllab("", "", "Reduced dynamic range image example")
+ call plimagefr(img_f, 0._plflt, width_r, 0._plflt, &
+ height_r, 0._plflt, 0._plflt, img_min + img_max * 0.25_plflt, &
+ img_max - img_max * 0.25_plflt)
+
+! Draw a distorted version of the original image, showing its
+! full dynamic range.
+ call plenv(0._plflt, width_r, 0._plflt, height_r, 1, -1)
+ call pllab("", "", "Distorted image example")
+
+! Populate the 2-d grids used for the distortion
+! NB grids must be 1 larger in each dimension than the image
+! since the coordinates are for the corner of each pixel.
+ allocate( xg(width+1,height+1) )
+ allocate( yg(width+1,height+1) )
+ x0 = 0.5_plflt*width_r
+ y0 = 0.5_plflt*height_r
+ dy = 0.5_plflt*height_r
+ stretch = 0.5_plflt
+ do i=1,width+1
+ do j=1,height+1
+ xg(i,j) = x0 + (x0-dble(i-1))*(1.0_plflt - stretch* &
+ cos((dble(j-1)-y0)/dy*M_PI*0.5_plflt))
+ yg(i,j) = dble(j-1)
+ enddo
+ enddo
+ call plimagefr(img_f, 0._plflt, width_r, 0._plflt, &
+ height_r, 0._plflt, 0._plflt, img_min, img_max, xg, yg)
+ call pladv(0)
+
+ deallocate( img_f, xg, yg )
+
call plend()
call exit(0)
@@ -496,6 +540,7 @@
yi = yyi
!C get_clip = gin.keysym == 'Q'
+ get_clip = .false.
else
! driver has no xormod capability, just do nothing
get_clip = .false.
@@ -529,3 +574,24 @@
end subroutine
end program
+
+!----------------------------------------------------------------------------
+! Subroutine a2mmx
+! 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
Modified: trunk/plplot_test/test_f77.sh.in
===================================================================
--- trunk/plplot_test/test_f77.sh.in 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/plplot_test/test_f77.sh.in 2008-07-24 13:11:19 UTC (rev 8578)
@@ -48,8 +48,8 @@
fi
# Do the standard non-interactive examples.
-# skip 14, 17, and 20 because they are interactive, and 20 not implemented.
- for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 21 22 23 28 29 30 ; do
+# skip 14 and 17 because they are interactive.
+ for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 20 21 22 23 28 29 30 ; do
$f77dir/x${index}f -dev $device -o ${OUTPUT_DIR}/x${index}f.$dsuffix $options 2> test.error
status_code=$?
cat test.error
@@ -87,8 +87,8 @@
fi
# Do the standard non-interactive examples.
-# skip 14, 17, and 20 because they are interactive, and 20 not implemented.
- for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 21 22 23 28 29 30 ; do
+# skip 14 and 17 because they are interactive.
+ for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 20 21 22 23 28 29 30 ; do
$f77dir/x${index}f <<EOF 2> test.error
$device
${OUTPUT_DIR}/x${index}f.$dsuffix
Modified: trunk/plplot_test/test_f95.sh.in
===================================================================
--- trunk/plplot_test/test_f95.sh.in 2008-07-24 13:09:41 UTC (rev 8577)
+++ trunk/plplot_test/test_f95.sh.in 2008-07-24 13:11:19 UTC (rev 8578)
@@ -49,10 +49,8 @@
# Do the standard non-interactive examples.
-# skip 14, 17, and 20 because they are interactive, and 20 not implemented.
-# skip 21 because it delivers variable results depending on computer timing
-# and load (and not implemented yet).
- for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 21 22 23 28 29 30; do
+# skip 14 and 17 because they are interactive.
+ for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 20 21 22 23 28 29 30; do
$f95dir/x${index}f -dev $device -o ${OUTPUT_DIR}/x${index}f95.$dsuffix $options 2> test.error
status_code=$?
cat test.error
@@ -90,10 +88,8 @@
# Do the standard non-interactive examples.
-# skip 14, 17, and 20 because they are interactive, and 20 not implemented.
-# skip 21 because it delivers variable results depending on computer timing
-# and load (and not implemented yet).
- for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 21 22 23 28 29 30; do
+# skip 14 and 17 because they are interactive.
+ for index in 01 02 03 04 05 06 07 08 09 10 11 12 13 15 16 18 19 20 21 22 23 28 29 30; do
$f95dir/x${index}f <<EOF 2> test.error
$device
${OUTPUT_DIR}/x${index}f95.$dsuffix
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
