C      $Id: x16f.fm4 6212 2005-04-27 06:44:27Z rlaboiss $
C      plshades demo, using color fill
C
C      Copyright (C) 2004  Alan W. Irwin
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)
      real*8 xx, yy, argx, argy, distort, r, t
      integer NLEVEL, NX, NY, PERIMETERPTS, xdim, ydim
      parameter(NLEVEL = 20)
C      xdim and ydim are the static dimensions of the 2D arrays while
C      NX and NY are the defined area.
      parameter(xdim=99, NX = 35)
      parameter(ydim=100, NY = 46)
      parameter(PERIMETERPTS = 100)
      real*8 clevel(NLEVEL), shedge(NLEVEL+1),
     &  z(xdim,ydim), w(xdim,ydim), xg1(xdim), yg1(ydim),
     &  xg2(xdim,ydim), yg2(xdim,ydim), zmin, zmax,
     &  px(PERIMETERPTS), py(PERIMETERPTS)
      integer fill_width, cont_color, cont_width
      integer i, j
C      dummy to fill argument list with something not currently used.
      character*1 defined
      real*8 tr(6)
      common /plplot/tr

      integer PL_PARSE_FULL
      parameter(PL_PARSE_FULL = 1)
C      Process command-line arguments
      call plparseopts(PL_PARSE_FULL)

C      Reduce colors in cmap 0 so that cmap 1 is useful on a 16-color display
      call plscmap0n(3)

C      Initialize plplot

      call plinit()
C      Set up transformation matrix

      tr(1) = 2.d0/(NX-1)
      tr(2) = 0.d0
      tr(3) = -1.d0
      tr(4) = 0.d0
      tr(5) = 2.d0/(NY-1)
      tr(6) = -1.d0

C      Calculate the data matrices.
      do i=1,NX
        xx = dble(i-1-(NX/2))/dble (NX/2)
        do j=1,NY
          yy = dble(j-1-(NY/2))/dble (NY/2) - 1.0d0
          z(i,j) = - sin(7.d0*xx) * cos(7.d0*yy) + xx*xx - yy*yy
          w(i,j) = - cos(7.d0*xx) * sin(7.d0*yy) + 2.d0*xx*yy
        enddo
      enddo

      call a2mnmx(z, NX, NY, zmin, zmax, xdim)
      do i = 1, NLEVEL
        clevel(i) = zmin + (zmax - zmin) * (i - 0.5d0) / dble(NLEVEL)
      enddo
      do i = 1, NLEVEL+1
        shedge(i) = zmin + (zmax - zmin) * dble(i-1) / dble(NLEVEL)
      enddo

C      Build the 1-d coord arrays.
      distort = 0.4d0
      do i=1,NX
        xx = -1.d0 + dble(i-1)*2.d0/dble(NX-1)
        xg1(i) = xx + distort*cos(0.5d0*PI*xx)
      enddo

      do j=1,NY
        yy = -1.d0 + dble(j-1)*2.d0/dble(NY-1)
        yg1(j) = yy - distort*cos(0.5d0*PI*yy)
      enddo

C      Build the 2-d coord arrays.
      do i=1,NX
        xx = -1.d0 + dble(i-1)*2.d0/dble(NX-1)
        argx = 0.5d0*PI*xx
        do j=1,NY
          yy = -1.d0 + dble(j-1)*2.d0/dble(NY-1)
          argy = 0.5d0*PI*yy
          xg2(i,j) = xx + distort*cos(argx)*cos(argy)
          yg2(i,j) = yy - distort*cos(argx)*cos(argy)
        enddo
      enddo

C      Plot using transform of index range to xmin, xmax, ymin, ymax
      call pladv(0)
      call plvpor(0.1d0, 0.9d0, 0.1d0, 0.9d0)
      call plwind(-1.0d0, 1.0d0, -1.0d0, 1.0d0)

      call plpsty(0)

      fill_width = 2
      cont_color = 0
      cont_width = 0
      call plshades0(z, NX, NY, defined, -1.d0, 1.d0, -1.d0, 1.d0,
     &  shedge, NLEVEL+1, fill_width,
     &  cont_color, cont_width, xdim)

      call plcol0(1)
      call plbox('bcnst', 0.0d0, 0, 'bcnstv', 0.0d0, 0)
      call plcol0(2)
      call pllab('distance', 'altitude', 'Bogon density')

C      Plot using 1d coordinate transform
      call pladv(0)
      call plvpor(0.1d0, 0.9d0, 0.1d0, 0.9d0)
      call plwind(-1.0d0, 1.0d0, -1.0d0, 1.0d0)

      call plpsty(0)

      fill_width = 2
      cont_color = 0
      cont_width = 0
      call plshades1(z, NX, NY, defined, -1.d0, 1.d0, -1.d0, 1.d0,
     &  shedge, NLEVEL+1, fill_width,
     &  cont_color, cont_width, xg1, yg1, xdim)

      call plcol0(1)
      call plbox('bcnst', 0.0d0, 0, 'bcnstv', 0.0d0, 0)
      call plcol0(2)
      call pllab('distance', 'altitude', 'Bogon density')

C      Plot using 2d coordinate transform
      call pladv(0)
      call plvpor(0.1d0, 0.9d0, 0.1d0, 0.9d0)
      call plwind(-1.0d0, 1.0d0, -1.0d0, 1.0d0)

      call plpsty(0)

      fill_width = 2
      cont_color = 0
      cont_width = 0
      call plshades2(z, NX, NY, defined, -1.d0, 1.d0, -1.d0, 1.d0,
     &  shedge, NLEVEL+1, fill_width,
     &  cont_color, cont_width, xg2, yg2, xdim)

      call plcol0(1)
      call plbox('bcnst', 0.0d0, 0, 'bcnstv', 0.0d0, 0)
      call plcol0(2)
      call plcon2(w, xdim, ny, 1, nx, 1, ny, clevel, NLEVEL, xg2, yg2)
      call pllab('distance', 'altitude',
     &  'Bogon density, with streamlines')

C      Plot using 2d coordinate transform and plshades contours.
      call pladv(0)
      call plvpor(0.1d0, 0.9d0, 0.1d0, 0.9d0)
      call plwind(-1.0d0, 1.0d0, -1.0d0, 1.0d0)

      call plpsty(0)

      fill_width = 2
      cont_color = 2
      cont_width = 3
      call plshades2(z, NX, NY, defined, -1.d0, 1.d0, -1.d0, 1.d0,
     &  shedge, NLEVEL+1, fill_width,
     &  cont_color, cont_width, xg2, yg2, xdim)

      call plcol0(1)
      call plbox('bcnst', 0.0d0, 0, 'bcnstv', 0.0d0, 0)
      call plcol0(2)
      call pllab('distance', 'altitude', 'Bogon density')

C      Example with polar coordinates.
      call pladv(0)
      call plvpor(0.1d0, 0.9d0, 0.1d0, 0.9d0)
      call plwind(-1.d0, 1.d0, -1.d0, 1.d0)

      call plpsty(0)

C      Build new coordinate matrices.
      do i = 1, NX
        r = dble(i-1)/dble(NX-1)
        do j = 1, NY
          t = (2.d0*PI/dble(NY-1))*dble(j-1)
          xg2(i,j) = r*cos(t)
          yg2(i,j) = r*sin(t)
          z(i,j) = exp(-r*r)*cos(5.d0*PI*r)*cos(5.d0*t)
        enddo
      enddo

C      Need a new shedge to go along with the new data set.
      call a2mnmx(z, NX, NY, zmin, zmax, xdim)
      do i = 1, NLEVEL+1
        shedge(i) = zmin + (zmax - zmin) * dble(i-1) / dble(NLEVEL)
      enddo

C      Now we can shade the interior region.
      fill_width = 2
      cont_color = 0
      cont_width = 0
      call plshades2(z, NX, NY, defined, -1.d0, 1.d0, -1.d0, 1.d0,
     &  shedge, NLEVEL+1, fill_width,
     &  cont_color, cont_width, xg2, yg2, xdim)

C      Now we can draw the perimeter.  (If do before, shade stuff may overlap.)
      do i = 1, PERIMETERPTS
        t = (2.d0*PI/dble(PERIMETERPTS-1))*dble(i-1)
        px(i) = cos(t)
        py(i) = sin(t)
      enddo

      call plcol0(1)
      call plline(PERIMETERPTS, px, py)

C      And label the plot.
      call plcol0(2)
      call pllab( '', '',  'Tokamak Bogon Instability' )

      call plend
      end

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
