C      $Id: x08f.fm4,v 1.14 2005/04/27 06:43:54 rlaboiss Exp $
C      3-d 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, xdim, ydim
C      xdim is the leading dimension of z, xpts <= xdim is the leading
C      dimension of z that is defined.
      parameter (xdim=99, ydim=100, xpts=35, ypts=46)
      real*8 x(xdim), y(ydim), z(xdim,ypts), xx, yy, r

      character*80 title(2)
      real*8 alt(2),az(2)
      data alt /60.0d0,20.0d0/
      data az  /30.0d0,60.0d0/
      data title /'#frPLplot Example 8 - Alt=60, Az=30',
     &            '#frPLplot Example 8 - Alt=20, Az=60'/
      integer rosen
      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)


      rosen = 1

      do i = 1,xpts
        x(i) = dble(i-1-(xpts/2))/dble (xpts/2)
        if(rosen.eq.1) x(i) = 1.5d0*x(i)
      enddo
      do j = 1,ypts
        y(j) = dble(j-1-(ypts/2))/dble (ypts/2)
        if(rosen.eq.1) y(j) = y(j) + 0.5d0
      enddo

      do i=1,xpts
        xx = x(i)
        do j=1,ypts
          yy = y(j)
          if(rosen.eq.1) then
            z(i,j) = (1.d0 - xx)**2 + 100.d0*(yy - xx**2)**2
C            The log argument may be zero for just the right grid.
            if(z(i,j).gt.0.d0) then
              z(i,j) = log(z(i,j))
            else
              z(i,j) = -5.d0
            endif
          else
C            sombrero function
            r = sqrt(xx*xx + yy*yy)
            z(i,j) = exp(-r*r) * cos(2.0d0*PI*r)
          endif
        enddo
      enddo
      call a2mnmx(z, xpts, ypts, zmin, zmax, xdim)
      step = (zmax-zmin)/(nlevel+1)
      do i = 1, nlevel
        clevel(i) = zmin + step*i
      enddo

      call plinit()
      call pllightsource(1.d0, 1.d0, 1.d0)
      do k=1,2
        do ifshade = 0, 3
          call pladv(0)
          call plvpor(0.0d0, 1.0d0, 0.0d0, 0.9d0 )
          call plwind(-1.0d0, 1.0d0, -0.9d0, 1.1d0 )
          call plcol0(3)
          call plmtex('t', 1.0d0, 0.5d0, 0.5d0, title(k))
          call plcol0(1)
          if(rosen.eq.1) then
            call plw3d(1.0d0, 1.0d0, 1.0d0, -1.5d0,
     &        1.5d0, -0.5d0, 1.5d0, zmin, zmax, alt(k),az(k))
          else
            call plw3d(1.0d0, 1.0d0, 1.0d0, -1.0d0,
     &        1.0d0, -1.0d0, 1.0d0, zmin, zmax, alt(k),az(k))
          endif
          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            diffuse light surface plot
            call cmap1_init(1)
            call plsurf3d(x, y, z, xpts, ypts,
     &        0,
     &        clevel, 0, xdim)
          elseif(ifshade.eq.1) then
C            magnitude colored plot
            call cmap1_init(0)
            call plsurf3d(x, y, z, xpts, ypts,
     &        MAG_COLOR,
     &        clevel, 0, xdim)
          elseif(ifshade.eq.2) then
C            magnitude colored plot with faceted squares
            call cmap1_init(0)
            call plsurf3d(x, y, z, xpts, ypts,
     &        ior(MAG_COLOR, FACETED),
     &        clevel, 0, xdim)
          elseif(ifshade.eq.3) then
C            magnitude colored plot with contours
            call cmap1_init(0)
            call plsurf3d(x, y, z, xpts, ypts,
     &        ior(MAG_COLOR, ior(SURF_CONT, BASE_CONT)),
     &        clevel, nlevel, xdim)
          else
            stop 'x08f: bad logic'
          endif
        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, 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
