00001 /* set.f -- translated by f2c (version 19961017).
00002    You must link the resulting object file with the libraries:
00003         -lf2c -lm   (in that order)
00004 */
00005 
00006 #include <stdlib.h>
00007 #include "f2c.h"
00008 
00009 /* Common Block Declarations */
00010 
00011 extern struct {
00012     real xpgmin, ypgmin, xpgmax, ypgmax, xclbot, yclbot, xcltop, ycltop, xbot,
00013              ybot, xtop, ytop, xmin, ymin, xmax, ymax;
00014     integer ixcoor, iycoor;
00015     real alphxx, betaxx, alphyy, betayy, tmajx, tminx, tmajy, tminy;
00016     integer majrx, minrx, majry, minry, isizx, isizy;
00017     real xphold, yphold;
00018 } zzzplt_;
00019 
00020 #define zzzplt_1 zzzplt_
00021 
00022 extern struct {
00023     real xphmax, yphmax;
00024     integer ixpmax, iypmax;
00025     real xpscal, ypscal;
00026     integer iflip, nplotr;
00027     char cfile[64];
00028 } zzpltr_;
00029 
00030 #define zzpltr_1 zzpltr_
00031 
00032 /* Table of constant values */
00033 
00034 static integer c__1 = 1;
00035 
00036 /* ======================================================================= */
00037 /*  Device independent setup routines: */
00038 
00039 
00040 
00041 /* Subroutine */ int set_(real *xobj1, real *xobj2, real *yobj1, real *yobj2, 
00042         real *xsub1, real *xsub2, real *ysub1, real *ysub2, integer *ltype)
00043 {
00044     /* Initialized data */
00045 
00046     static shortint ixc[4] = { 1,1,-1,-1 };
00047     static shortint iyc[4] = { 1,-1,1,-1 };
00048 
00049     /* Format strings */
00050     static char fmt_9001[] = "(//\002 ********** Illegal parameters in SET *"
00051             "*********\002/4(1x,1pg12.5)/4(1x,1pg12.5),i6)";
00052 
00053     /* Builtin functions */
00054     double r_lg10(real *);
00055     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00056 
00057     /* Local variables */
00058     static real sxmin, sxmax, symin, symax;
00059 
00060     /* Fortran I/O blocks */
00061     static cilist io___7 = { 0, 6, 0, fmt_9001, 0 };
00062 
00063 
00064 
00065 /*  Set the relationship between the physical space and the user space. */
00066 /* .......................................................................
00067  */
00068 
00069 
00070 /*  Internal Data for PLOTPAK */
00071 
00072 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
00073  */
00074 /*  Check entry values for reasonableness. */
00075 
00076     if (*xobj1 < zzzplt_1.xpgmin || *xobj1 >= *xobj2 || *xobj2 > 
00077             zzzplt_1.xpgmax || *xsub1 == *xsub2 || *yobj1 < zzzplt_1.ypgmin ||
00078              *yobj1 >= *yobj2 || *yobj2 > zzzplt_1.ypgmax || *ysub1 == *ysub2 
00079             || *ltype <= 0 || *ltype > 4) {
00080         goto L9000;
00081     }
00082 /* .......................................................................
00083  */
00084     zzzplt_1.xbot = *xobj1;
00085     zzzplt_1.ybot = *yobj1;
00086     zzzplt_1.xtop = *xobj2;
00087     zzzplt_1.ytop = *yobj2;
00088 
00089     zzzplt_1.xmin = *xsub1;
00090     zzzplt_1.xmax = *xsub2;
00091     zzzplt_1.ymin = *ysub1;
00092     zzzplt_1.ymax = *ysub2;
00093 
00094     zzzplt_1.ixcoor = ixc[*ltype - 1];
00095     zzzplt_1.iycoor = iyc[*ltype - 1];
00096 
00097     if (zzzplt_1.ixcoor >= 0) {
00098         sxmin = *xsub1;
00099         sxmax = *xsub2;
00100     } else {
00101         if (*xsub1 <= 0.f || *xsub2 <= 0.f) {
00102             goto L9000;
00103         }
00104         sxmin = r_lg10(xsub1);
00105         sxmax = r_lg10(xsub2);
00106     }
00107 
00108     if (zzzplt_1.iycoor >= 0) {
00109         symin = *ysub1;
00110         symax = *ysub2;
00111     } else {
00112         if (*ysub1 <= 0.f || *ysub2 <= 0.f) {
00113             goto L9000;
00114         }
00115         symin = r_lg10(ysub1);
00116         symax = r_lg10(ysub2);
00117     }
00118 
00119 /*  Calculate the alpha and beta scaling factors to map user space */
00120 /*  into physical space. */
00121 
00122     zzzplt_1.alphxx = (zzzplt_1.xtop - zzzplt_1.xbot) / (sxmax - sxmin);
00123     zzzplt_1.betaxx = zzzplt_1.xbot - zzzplt_1.alphxx * sxmin;
00124 
00125     zzzplt_1.alphyy = (zzzplt_1.ytop - zzzplt_1.ybot) / (symax - symin);
00126     zzzplt_1.betayy = zzzplt_1.ybot - zzzplt_1.alphyy * symin;
00127 
00128     return 0;
00129 /* .......................................................................
00130  */
00131 L9000:
00132 /* CC      OPEN( 98 , FILE='PLOTPAK.ERR' , STATUS='NEW' ) */
00133 /* CC      WRITE(98,9001) XOBJ1,XOBJ2 , YOBJ1,YOBJ2 , */
00134 /* CC     X               XSUB1,XSUB2 , YSUB1,YSUB2 , LTYPE */
00135 /* L9001: */
00136 /* cc      CLOSE( 98 ) */
00137 
00138     s_wsfe(&io___7);
00139     do_fio(&c__1, (char *)&(*xobj1), (ftnlen)sizeof(real));
00140     do_fio(&c__1, (char *)&(*xobj2), (ftnlen)sizeof(real));
00141     do_fio(&c__1, (char *)&(*yobj1), (ftnlen)sizeof(real));
00142     do_fio(&c__1, (char *)&(*yobj2), (ftnlen)sizeof(real));
00143     do_fio(&c__1, (char *)&(*xsub1), (ftnlen)sizeof(real));
00144     do_fio(&c__1, (char *)&(*xsub2), (ftnlen)sizeof(real));
00145     do_fio(&c__1, (char *)&(*ysub1), (ftnlen)sizeof(real));
00146     do_fio(&c__1, (char *)&(*ysub2), (ftnlen)sizeof(real));
00147     do_fio(&c__1, (char *)&(*ltype), (ftnlen)sizeof(integer));
00148     e_wsfe();
00149     exit(0) ;
00150     return 0;
00151 } /* set_ */
00152