00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 subroutine ez3dplot(a,na,iprompt,*)
00021 save
00022 c
00023 c Plot a 3-D picture, using the array a.
00024 c
00025 dimension a(1)
00026 character string*80,c*1
00027 common /mcd color/ icolor
00028 c
00029 save m,n
00030 data m/0/n/0/
00031 c
00032 call devoff
00033 if (iprompt.eq.1) write(6,'(''*** Three-dimensional plot'')')
00034 c
00035 call get_dimensions(m,n,na,iprompt,*99999)
00036 c
00037 call minmax(a,m*n,amin,amax)
00038 if (iprompt.eq.1) write(6,'(a,f,a,f)')
00039 & 'Array minimum = ',amin,', maximum = ',amax
00040 if (amin.ge.amax) return
00041 c
00042 xlen=6.
00043 ylen=6.*aspectratio()
00044 xoff=5.
00045 yoff=5.25*aspectratio()
00046 zfac=6./(amax-amin)
00047 zoff=.5*(amin+amax)
00048 c
00049 10 if (iprompt.eq.1) then
00050 string = ' '
00051 call getstring('Altitude, azimuthal viewing angles, '
00052 $ '[color] (h = help): ',1,56,string)
00053 else
00054 call getstring(' ',1,1,string)
00055 end if
00056 c
00057 do 20 i=1,len(string)
00058 if (string(i:i).gt.' ') then
00059 c = string(i:i)
00060 if (c.ge.'A'.and.c.le.'Z') c = char(ichar(c)+32)
00061 go to 30
00062 end if
00063 20 continue
00064 go to 10
00065 c
00066 30 if (c.eq.'q'.or.c.eq.'x'.or.c.eq.'e') then
00067 go to 9999
00068 else if (c.eq.'h') then
00069 write(6,*)
00070 write(6,*)'e or x = back to mcdraw prompt'
00071 write(6,*)'q = quit mcdraw'
00072 write(6,*)'altitude = angle above the x-y plane'
00073 write(6,*)'azimuth = angle around the z-axis, '
00074 & 'measured from the x-axis toward the y-axis'
00075 write(6,*)'color = "underside" color, if specified'
00076 write(6,*)
00077 go to 10
00078 end if
00079 c
00080 jcolor = 0
00081 call readrq(string,3,alt,azim,xjcolor,xdum,*99)
00082 99 jcolor = nint(xjcolor)
00083 c
00084 call devon
00085 call clear
00086 c
00087 if (jcolor.gt.0) then
00088 c
00089 c Draw the "underside" first:
00090 c
00091 call setvu(2)
00092 call color(jcolor)
00093 call plt3d(a,m,n,alt,azim,xlen,xoff,ylen,yoff,zfac,zoff,ier)
00094 call color(icolor)
00095 call setvu(1)
00096 end if
00097 c
00098 call plt3d(a,m,n,alt,azim,xlen,xoff,ylen,yoff,zfac,zoff,ier)
00099 c
00100 ro = xplot3d(1.,1.,amin)
00101 so = yplot3d(1.,1.,amin)
00102 rx = xplot3d(m+1.,1.,amin)
00103 sx = yplot3d(m+1.,1.,amin)
00104 ry = xplot3d(1.,n+1.,amin)
00105 sy = yplot3d(1.,n+1.,amin)
00106 rz = xplot3d(1.,1.,amin+1.1*(amax-amin))
00107 sz = yplot3d(1.,1.,amin+1.1*(amax-amin))
00108 c
00109 c Which axes should be visible?
00110 c
00111 c call plot(ro,so,3)
00112 c call plot(rx,sx,2)
00113 c call plot(ro,so,3)
00114 c call plot(ry,sy,2)
00115 c call plot(ro,so,3)
00116 c call plot(rz,sz,2)
00117 c
00118 call devoff
00119 if (ier.ne.0) write(6,'(a,i)')'Return status = ',ier
00120 c
00121 go to 10
00122 c
00123 9999 return
00124 99999 return 1
00125 end
