C      $Id: x11f.fm4 6645 2006-05-27 22:02:53Z hbabcock $
C      Mesh plot demo
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)
      integer i, j, k, ifshade, xpts, ypts
      parameter (xpts=35, ypts=46)

      real*8 x(xpts), y(ypts), z(xpts,ypts), xx, yy

      character*80 title(2)
      real*8 alt(2),az(2)
      integer opt(2)
      data alt /33.0d0,17.0d0/
      data az  /24.0d0,115.0d0/
C      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*8 zmin, zmax, step, clevel(nlevel)
C      Plotting options for 3d plots, see plplot.h for the C definitions
C      of these options.
      integer DRAW_LINEX, DRAW_LINEY, DRAW_LINEXY, MAG_COLOR,
     &  BASE_CONT, TOP_CONT, SURF_CONT, DRAW_SIDES, FACETED, MESH
      parameter(DRAW_LINEX = 1)
      parameter(DRAW_LINEY = 2)
      parameter(DRAW_LINEXY = 3)
      parameter(MAG_COLOR = 4)
      parameter(BASE_CONT = 8)
      parameter(TOP_CONT = 16)
      parameter(SURF_CONT = 32)
      parameter(DRAW_SIDES = 64)
      parameter(FACETED = 128)
      parameter(MESH = 256)
      integer PL_PARSE_FULL
      parameter(PL_PARSE_FULL = 1)
C      Process command-line arguments
      call plparseopts(PL_PARSE_FULL)


      do i = 1,xpts
        x(i) = 3.d0*dble(i-1-(xpts/2))/dble (xpts/2)
      enddo
      do j = 1,ypts
        y(j) = 3.d0*dble(j-1-(ypts/2))/dble (ypts/2)
      enddo

      do i=1,xpts
        xx = x(i)
        do j=1,ypts
          yy = y(j)
          z(i,j) = 3.d0 * (1.d0-xx)*(1.d0-xx) *
     &      exp(-(xx*xx) - (yy+1.d0)*(yy+1.d0)) -
     &      10.d0 * (xx/5.d0 - xx**3 - yy**5) * exp(-xx*xx-yy*yy) -
     &      1.d0/3.d0 * exp(-(xx+1.d0)*(xx+1.d0) - (yy*yy))
          if(.false.) then
C            Jungfraujoch/Interlaken
            if(z(i,j).lt.-1.d0) z(i,j) = -1.d0
          endif
        enddo
      enddo
      call a2mnmx(z, xpts, ypts, zmin, zmax)
      step = (zmax-zmin)/(nlevel+1)
      do i = 1, nlevel
        clevel(i) = zmin + step*i
      enddo

      call plinit()
      call cmap1_init(0)
      do k=1,2
        do ifshade = 0, 3
          call pladv(0)
          call plcol0(1)
          call plvpor(0.0d0, 1.0d0, 0.0d0, 0.9d0 )
          call plwind(-1.0d0, 1.0d0, -1.0d0, 1.5d0 )
          call plw3d(1.0d0, 1.0d0, 1.2d0, -3.0d0,
     &      3.0d0, -3.0d0, 3.0d0, zmin, zmax, alt(k),az(k))
          call plbox3('bnstu','x axis', 0.0d0, 0,
     &      'bnstu', 'y axis', 0.0d0, 0,
     &      'bcdmnstuv','z axis', 0.0d0, 0)
          call plcol0(2)
          if(ifshade.eq.0) then
C            wireframe plot
            call plmesh(x, y, z, xpts, ypts,
     &        opt(k),
     &        xpts)
          elseif(ifshade.eq.1) then
C            magnitude colored wireframe plot
            call plmesh(x, y, z, xpts, ypts,
     &        ior(opt(k), MAG_COLOR),
     &        xpts)
          elseif(ifshade.eq.2) then
C            magnitude colored wireframe plot with sides
            call plot3d(x, y, z, xpts, ypts,
     &        ior(opt(k), MAG_COLOR),
     &        1, xpts)
          elseif(ifshade.eq.3) then
C             magnitude colored wireframe plot with base contour
            call plmeshc(x, y, z, xpts, ypts,
     &        ior(opt(k), ior(MAG_COLOR, BASE_CONT)),
     &        clevel, nlevel, xpts)
          else
            stop 'x11f: bad logic'
          endif
          call plcol0(3)
          call plmtex('t', 1.0d0, 0.5d0, 0.5d0, title(k))
        enddo
      enddo
      call plend
      end

C----------------------------------------------------------------------------
      subroutine cmap1_init(gray)
C      For gray.eq.1, basic grayscale variation from half-dark
C      to light.  Otherwise, hue variations around the front of the
C      colour wheel from blue to green to red with constant lightness
C      and saturation.

      implicit none
      integer gray
      real*8 i(0:1), h(0:1), l(0:1), s(0:1)
      integer rev(0:1)
C      left boundary
      i(0) = 0.d0
C      right boundary
      i(1) = 1.d0
      if (gray.eq.1) then
C        hue -- low: red (arbitrary if s=0)
        h(0) = 0.0d0
C        hue -- high: red (arbitrary if s=0)
        h(1) = 0.0d0
C        lightness -- low: half-dark
        l(0) = 0.5d0
C        lightness -- high: light
        l(1) = 1.0d0
C        minimum saturation
        s(0) = 0.0d0
C        minimum saturation
        s(1) = 0.0d0
      else
C        This combination of hues ranges from blue to cyan to green to yellow
C        to red (front of colour wheel) with constant lightness = 0.6
C        and saturation = 0.8.

C        hue -- low: blue
        h(0) = 240.d0
C        hue -- high: red
        h(1) = 0.0d0
C        lightness -- low:
        l(0) = 0.6d0
C        lightness -- high:
        l(1) = 0.6d0
C        saturation
        s(0) = 0.8d0
C        minimum saturation
        s(1) = 0.8d0
      endif
      rev(0) = 0
      rev(1) = 0
      call plscmap1n(256)
      call plscmap1l(0, 2, i, h, l, s, rev)
      end

C----------------------------------------------------------------------------
C      Subroutine a2mnmx
C      Minimum and the maximum elements of a 2-d array.

      subroutine a2mnmx(f, nx, ny, fmin, fmax)
      implicit none

      integer   i, j, nx, ny
      real*8    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
