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
00021
00022 subroutine contor2 (a,x,y,m,n,v,iv,userplot)
00023 save
00024 external userplot
00025 dimension ix(50,250),xb(50,250),iy(50),yl(50),dx(250)
00026 c
00027 c subroutine userplot converts from (x,y) coordinates to
00028 c the desired rectangular output grid. if the original grid
00029 c is already rectangular and correctly scaled (see mcinit),
00030 c just set userplot = plot in the call to contor.
00031 c
00032 real v(iv),a(m,n),x(m),y(n)
00033 mm=m-1
00034 nn=n-1
00035 do 10 i=1,mm
00036 dx(i)=x(i+1)-x(i)
00037 do 10 k=1,iv
00038 ix(k,i)=0
00039 10 continue
00040 do 60 j=1,nn
00041 dely=y(j+1)-y(j)
00042 do 15 k=1,iv
00043 15 iy(k)=0
00044 do 50 i=1,mm
00045 delx=dx(i)
00046 v1=a(i,j)
00047 v2=a(i+1,j)
00048 v3=a(i,j+1)
00049 v4=a(i+1,j+1)
00050 do 40 k=1,iv
00051 val=v(k)
00052 if (val.lt.-1.e10) go to 40
00053 icase=1
00054 if (val.gt.v1) icase=icase+1
00055 if (val.gt.v2) icase=icase+2
00056 if (val.gt.v3) icase=icase+4
00057 if (val.gt.v4) icase=9-icase
00058 go to (40,24,25,26,27,28,29,30),icase
00059 24 x0=x(i)
00060 if(iy(k).ne.0)then
00061 y0=yl(k)
00062 else
00063 y0=y(j)+dely*(val-v1)/(v3-v1)
00064 end if
00065 if(ix(k,i).ne.0)then
00066 x1=xb(k,i)
00067 else
00068 x1=x(i)+delx*(val-v1)/(v2-v1)
00069 end if
00070 y1=y(j)
00071 go to 35
00072 25 if(ix(k,i).ne.0)then
00073 x0=xb(k,i)
00074 else
00075 x0=x(i)+delx*(val-v1)/(v2-v1)
00076 end if
00077 y0=y(j)
00078 x1=x(i+1)
00079 y1=y(j)+dely*(val-v2)/(v4-v2)
00080 go to 35
00081 26 x0=x(i)
00082 if(iy(k).ne.0)then
00083 y0=yl(k)
00084 else
00085 y0=y(j)+dely*(val-v1)/(v3-v1)
00086 end if
00087 x1=x(i+1)
00088 y1=y(j)+dely*(val-v2)/(v4-v2)
00089 go to 35
00090 27 x0=x(i)
00091 if(iy(k).ne.0)then
00092 y0=yl(k)
00093 else
00094 y0=y(j)+dely*(val-v1)/(v3-v1)
00095 end if
00096 x1=x(i)+delx*(val-v3)/(v4-v3)
00097 y1=y(j+1)
00098 go to 35
00099 28 if(ix(k,i).ne.0)then
00100 x0=xb(k,i)
00101 else
00102 x0=x(i)+delx*(val-v1)/(v2-v1)
00103 end if
00104 y0=y(j)
00105 x1=x(i)+delx*(val-v3)/(v4-v3)
00106 y1=y(j+1)
00107 go to 35
00108 29 x0=x(i)
00109 if(iy(k).ne.0)then
00110 y0=yl(k)
00111 else
00112 y0=y(j)+dely*(val-v1)/(v3-v1)
00113 end if
00114 if(ix(k,i).ne.0)then
00115 x1=xb(k,i)
00116 else
00117 x1=x(i)+delx*(val-v1)/(v2-v1)
00118 end if
00119 y1=y(j)
00120 call userplot(x0,y0,3)
00121 call userplot(x1,y1,2)
00122 30 x0=x(i)+delx*(val-v3)/(v4-v3)
00123 y0=y(j+1)
00124 x1=x(i+1)
00125 y1=y(j)+dely*(val-v2)/(v4-v2)
00126 35 call userplot(x0,y0,3)
00127 call userplot(x1,y1,2)
00128 if(x1.eq.x(i+1))then
00129 iy(k)=1
00130 yl(k)=y1
00131 else
00132 iy(k)=0
00133 end if
00134 if(y0.eq.y(j+1))then
00135 ix(k,i)=1
00136 xb(k,i)=x0
00137 else if(y1.eq.y(j+1))then
00138 ix(k,i)=1
00139 xb(k,i)=x1
00140 else
00141 ix(k,i)=0
00142 end if
00143 40 continue
00144 50 continue
00145 60 continue
00146 end
