/* set.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include <stdlib.h>
#include "f2c.h"
/* Common Block Declarations */
extern struct {
real xpgmin, ypgmin, xpgmax, ypgmax, xclbot, yclbot, xcltop, ycltop, xbot,
ybot, xtop, ytop, xmin, ymin, xmax, ymax;
integer ixcoor, iycoor;
real alphxx, betaxx, alphyy, betayy, tmajx, tminx, tmajy, tminy;
integer majrx, minrx, majry, minry, isizx, isizy;
real xphold, yphold;
} zzzplt_;
#define zzzplt_1 zzzplt_
extern struct {
real xphmax, yphmax;
integer ixpmax, iypmax;
real xpscal, ypscal;
integer iflip, nplotr;
char cfile[64];
} zzpltr_;
#define zzpltr_1 zzpltr_
/* Table of constant values */
static integer c__1 = 1;
/* ======================================================================= */
/* Device independent setup routines: */
/* Subroutine */ int set_(real *xobj1, real *xobj2, real *yobj1, real *yobj2,
real *xsub1, real *xsub2, real *ysub1, real *ysub2, integer *ltype)
{
/* Initialized data */
static shortint ixc[4] = { 1,1,-1,-1 };
static shortint iyc[4] = { 1,-1,1,-1 };
/* Format strings */
static char fmt_9001[] = "(//\002 ********** Illegal parameters in SET *"
"*********\002/4(1x,1pg12.5)/4(1x,1pg12.5),i6)";
/* Builtin functions */
double r_lg10(real *);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
static real sxmin, sxmax, symin, symax;
/* Fortran I/O blocks */
static cilist io___7 = { 0, 6, 0, fmt_9001, 0 };
/* Set the relationship between the physical space and the user space. */
/* .......................................................................
*/
/* Internal Data for PLOTPAK */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* Check entry values for reasonableness. */
if (*xobj1 < zzzplt_1.xpgmin || *xobj1 >= *xobj2 || *xobj2 >
zzzplt_1.xpgmax || *xsub1 == *xsub2 || *yobj1 < zzzplt_1.ypgmin ||
*yobj1 >= *yobj2 || *yobj2 > zzzplt_1.ypgmax || *ysub1 == *ysub2
|| *ltype <= 0 || *ltype > 4) {
goto L9000;
}
/* .......................................................................
*/
zzzplt_1.xbot = *xobj1;
zzzplt_1.ybot = *yobj1;
zzzplt_1.xtop = *xobj2;
zzzplt_1.ytop = *yobj2;
zzzplt_1.xmin = *xsub1;
zzzplt_1.xmax = *xsub2;
zzzplt_1.ymin = *ysub1;
zzzplt_1.ymax = *ysub2;
zzzplt_1.ixcoor = ixc[*ltype - 1];
zzzplt_1.iycoor = iyc[*ltype - 1];
if (zzzplt_1.ixcoor >= 0) {
sxmin = *xsub1;
sxmax = *xsub2;
} else {
if (*xsub1 <= 0.f || *xsub2 <= 0.f) {
goto L9000;
}
sxmin = r_lg10(xsub1);
sxmax = r_lg10(xsub2);
}
if (zzzplt_1.iycoor >= 0) {
symin = *ysub1;
symax = *ysub2;
} else {
if (*ysub1 <= 0.f || *ysub2 <= 0.f) {
goto L9000;
}
symin = r_lg10(ysub1);
symax = r_lg10(ysub2);
}
/* Calculate the alpha and beta scaling factors to map user space */
/* into physical space. */
zzzplt_1.alphxx = (zzzplt_1.xtop - zzzplt_1.xbot) / (sxmax - sxmin);
zzzplt_1.betaxx = zzzplt_1.xbot - zzzplt_1.alphxx * sxmin;
zzzplt_1.alphyy = (zzzplt_1.ytop - zzzplt_1.ybot) / (symax - symin);
zzzplt_1.betayy = zzzplt_1.ybot - zzzplt_1.alphyy * symin;
return 0;
/* .......................................................................
*/
L9000:
/* CC OPEN( 98 , FILE='PLOTPAK.ERR' , STATUS='NEW' ) */
/* CC WRITE(98,9001) XOBJ1,XOBJ2 , YOBJ1,YOBJ2 , */
/* CC X XSUB1,XSUB2 , YSUB1,YSUB2 , LTYPE */
/* L9001: */
/* cc CLOSE( 98 ) */
s_wsfe(&io___7);
do_fio(&c__1, (char *)&(*xobj1), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*xobj2), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*yobj1), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*yobj2), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*xsub1), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*xsub2), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*ysub1), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*ysub2), (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&(*ltype), (ftnlen)sizeof(integer));
e_wsfe();
exit(0) ;
return 0;
} /* set_ */
syntax highlighted by Code2HTML, v. 0.9.1