/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:31:43 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "dprpl3.h" #include #include #include /* PARAMETER translations */ #define NEEDX 11 #define NEEDY 11 /* end of PARAMETER translations */ void /*FUNCTION*/ dprpl3( double x1, double x2, double y1, double y2, double *xmin, double *xmax, double *ymin, double *ymax, long *left, long *right, long *bottom, long *top, char *title, char *xname, char *yname, long nlines, long nchars, byte image[], long *ierr) { #define IMAGE(I_,J_) (image+(I_)*(nchars)+(J_)) char fmtx[16], fmty[16]; long int delx1, delx2, i, iline, index, kmajx, kmajy, kminx, kminy, ksiz2x, ksiz2y, ksizex, ksizey, ktestx, l0, l1, lcount, tlen, totx, toty, totym1, xlen, ylab1, ylab2, ylen, ynspce; double fkmajx, fkmajy, fyind, xifac, yfac, yifac, ysmall, yval; /* Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 2007-02/28 DRPRL3 Krogh Fix for rounding problem in labels. *>> 2005-12-06 DPRPL3 Krogh Minor fixes for C conversion. *>> 2001-10-05 DPRPL3 Krogh Fixed formats to use "1p,e" not "1pe" *>> 1996-06-21 DPRPL3 Krogh Changes to use .C. and C%%. *>> 1996-01-23 DPRPL3 Krogh More changes to simplify conversion to C. *>> 1995-11-14 DPRPL3 Krogh Changes to simplify conversion to C. *>> 1994-11-02 DPRPL3 Krogh Changes to use M77CON *>> 1992-09-29 DPRPL3 WVS Changed tabs to spaces *>> 1992-04-29 DPRPL3 CAO Changed ' 's (from 0-length string correction) *>> 1992-04-07 CAO Changed 0-length strings to spaces(error from VAX com *>> 1992-03-17 DPRPL3 CLL Removed F90 syntax. *>> 1992-02-24 DPRPL3 CLL Changed IMAGE*(NIMAGE) to IMAGE*(*) in -PRPL5 *>> 1992-02-21 DPRPL3 CLL Changed a > to .gt. *>> 1992-02-14 DPRPL3 CLL *>> 1992-01-29 SPRPL1 CLL Added choice of no. of rows & cols in output. *>> 1990-10-29 PRPL1 CLL More changes to formatting of x-grid labels. *>> 1990-10-22 PRPL1 CLL Added FAC, XSMALL, YSMALL. *>> 1988-05-24 PRPL1 Lawson Initial code. *>> 1983-04-04 C.L.Lawson & Stella Chan,JPL, Coded for Fortran 77. * Subr DPRPL3 will build a grid and place numeric grid labels and * titles in IMAGE()(). Also returns values in * XMIN, XMAX, YMIN, YMAX, LEFT, RIGHT, BOTTOM, TOP. * ------------------------------------------------------------------ * SUBROUTINE ARGUMENTS * * X1, X2, Y1, Y2 [in, floating point] Min and max values of x and y * values to be plotted. * XMIN, XMAX, YMIN, YMAX [out, floating point] Values to be assigned * to the edges of the plot grid. * LEFT, RIGHT, BOTTOM, TOP [out, integer] Indices for use in IMAGE()() * for locating the edges of the plot grid. * TITLE [in,character] Character string to be printed above the plot * grid as a title for the graph. * XNAME [in,character] Character string to be printed below the plot * grid to identify the abscissa variable. * YNAME [in,character] Character string to be printed in a vertical * column at the left of the plot grid to identify the ordinate * variable. * NLINES [in] Number of lines available in IMAGE()() for the output * image. * NCHARS [in] Number of characters per line available in IMAGE()() for * the output image. * IMAGE() [out,array of chars] Array of at least NLINES elements, * each being a character variable of length at least NCHARS. * This subr will place grid and labeling characters in this array. * IERR [out,integer] Termination status indicator. 0 means ok. * 1 means need larger NCHARS. 2 means need larger NLINES. * ------------------------------------------------------------------ * Descriptions of some of the internal variables. * * NEEDX, NEEDY [integer parameters] These establish the minimum size * of the plotting region. We require at least NEEDX columns from * the leftmost to the rightmost grid line, including these grid * lines. We require at least NEEDY lines from the top to the bottom * grid line, including these grid lines. The nominal setting of * NEEDX and NEEDY is 11 each. The code should function with any * setting greater than 1, but for any hope for a reasonably * useful plot these should should not be too small. * ------------------------------------------------------------------ *--D replaces "?": ?PRPL3, ?PRPL4, ?PRPL5 * Also uses IERM1, IERV1 * ------------------------------------------------------------------ *++(~.C.) Default SIZEX=',KSIZEX', SIZEY=',KSIZEY', SIZED=',KSIZED' *++(.C.) Default SIZEX=',KSIZEX,KSIZ2X', SIZEY=',KSIZEY,KSIZ2Y' *++(.C.) Default SIZED=',KSIZED,KSIZ2D' * Note that in order for these replacements to work, the strings must be * start with a ",", and KSIZE must not be be preceded immediately by a * "," where the replacement is not desired. *++ Replace ",KSIZEX,KSIZ2X" = SIZEX *++ Replace ",KSIZEY,KSIZ2Y" = SIZEY *++ Replace ",KSIZED,KSIZ2D" = SIZED */ /* ------------------------------------------------------------------ *++ CODE for ~.C. is inactive * do 10 I = 1,NLINES * IMAGE(I) = ' ' * 10 continue *++ CODE for .C. is active */ long int j; char numstring[40]; for( i = 1L; i <= nlines; i++ ){ for( j = 1; j <= nchars; j++ ) *IMAGE(i-1L, j-1L) = ' '; *IMAGE(i-1L, nchars) = '\0'; } dprpl4( x1, x2, xmin, xmax, &kmajx, &kminx, fmtx, &ksizex, &ksiz2x ); /*++ END * * Determine values for the first and last grid lines: * XMIN, XMAX, YMIN, YMAX, * the number of major grid intervals: KMAJX, KMAJY, * the space needed for grid line labels: KSIZEX, KSIZEY, * and the formats for grid line labels: FMTX, FMTY. * */ dprpl4( y1, y2, ymin, ymax, &kmajy, &kminy, fmty, &ksizey, &ksiz2y ); ysmall = fmax( fabs( *ymin ), fabs( *ymax ) )*0.0001e0; fkmajx = (double)( kmajx ); /* YNSPCE is the no. of horizontal char positions we allocate for * the (vertical) YNAME. * The leftmost and rightmost grid lines are at char positions * LEFT and RIGHT. We set RIGHT = NCHARS-1, but setting LEFT depends * on KSIZEX and KSIZEY to allow room for the y-grid labels and for * the leftmost x-grid label. * If an x-grid label is centered at char position IC it will begin * in position IC-DELX1 and end in position IC+DELX2. The leftmost * x-grid label will be centered at LEFT. The rightmost x-grid label * will end at position NCHARS. * The y-grid lables all start at char position YLAB1 and end at * YLAB2. * *++ CODE for ~.C. is inactive * FMTY2 = '(' // FMTY // ')' * if (YNAME .eq. ' ') then * YNSPCE = 0 * else * YLEN = len(YNAME) * YNSPCE = 2 * end if *++ CODE for .C. is active */ ylen = strlen( yname ); ynspce = ((int)strspn(yname, " ") == ylen ) ? 0 : 2; delx1 = ksizex/2; /*++ END */ delx2 = ksizex - delx1 - 1; *left = ynspce + 1 + max( ksizey + 1, delx1 ); ylab2 = *left - 2; ylab1 = ylab2 - ksizey + 1; *right = nchars - 1; totx = *right - *left + 1; ktestx = max( NEEDX, delx2 + 1 ); if (totx < ktestx) { *ierr = 1; ierm1( "DPRPL3", *ierr, 0, "Need larger NCHARS to plot and label the given data." , "Have NCHARS", nchars, ',' ); ierv1( "Need at least NCHARS", nchars + ktestx - totx, '.' ); return; } /* Process TITLE if any, and set TOP. * *++ CODE for ~.C. is inactive * if (TITLE .eq. ' ') then * TOP = 1 * else * TOP = 2 * TLEN = len(TITLE) * if (TLEN .le. TOTX) then * L1 = NCHARS - TLEN + 1 - (TOTX-TLEN)/2 * IMAGE(1)(L1:L1+TLEN-1) = TITLE * else if (TLEN .le. NCHARS) then * L1 = NCHARS - TLEN + 1 * IMAGE(1)(L1:L1+TLEN-1) = TITLE * else * IMAGE(1) = TITLE(1:NCHARS) * end if * end if *++ CODE for .C. is active */ tlen = strlen( title ); if ((int)strspn(title, " ") == tlen) { *top = 1; } else { *top = 2; if (tlen <= totx) { l1 = nchars - tlen - (totx - tlen)/2; for (i = 0; i < tlen; i++) *IMAGE(0, l1+i) = title[i]; } else if (tlen <= nchars) { l1 = nchars - tlen; for (i = 0; i < tlen; i++) *IMAGE(0, l1+i) = title[i]; } else { /*++ CODE for .C. is active */ for (i = 0; i < nchars; i++) *IMAGE(0, i) = title[i]; } } xlen = strlen( xname ); if ((int)strspn(xname, " ") == xlen) { *bottom = nlines - 1; } else { *bottom = nlines - 2; /*++ END * * Process XNAME if any, and set BOTTOM. * *++ CODE for ~.C. is inactive * if (XNAME .eq. ' ') then * BOTTOM = NLINES - 1 * else * BOTTOM = NLINES - 2 * XLEN = len(XNAME) * if (XLEN .le. TOTX) then * L1 = NCHARS - XLEN + 1 - (TOTX-XLEN)/2 * IMAGE(NLINES)(L1:L1+XLEN-1) = XNAME * else if (XLEN .le. NCHARS) then * L1 = NCHARS - XLEN + 1 * IMAGE(NLINES)(L1:L1+XLEN-1) = XNAME * else * IMAGE(NLINES) = XNAME(1:NCHARS) * end if * end if *++ CODE for .C. is active */ if (xlen <= totx) { l1 = nchars - xlen - (totx - xlen)/2; for (i = 0; i < xlen; i++) *IMAGE(nlines-1, l1+i) = xname[i]; } else if (xlen <= nchars) { l1 = nchars - xlen; for (i = 0; i < xlen; i++) *IMAGE(nlines-1, l1+i) = xname[i]; } else { for (i = 0; i < nchars; i++) *IMAGE(nlines-1, l1+i) = xname[i]; } } toty = *bottom - *top + 1; /*++ END */ totym1 = toty - 1; if (toty < NEEDY) { *ierr = 2; ierm1( "DPRPL3", *ierr, 0, "Need larger NLINES.", "Have NLINES" , nlines, ',' ); ierv1( "Need at least NLINES", nlines + NEEDY - toty, '.' ); return; } /* Now have LEFT, RIGHT, TOP, and BOTTOM set. Recall that * TOP is a smaller number than BOTTOM. * These are the indices in IMAGE()() of the edges of the plot * grid. * * Process YNAME, if any. */ if (ynspce != 0) { if (ylen <= nlines) { l0 = (nlines - ylen)/2; lcount = ylen; } else { l0 = 0; lcount = nlines; } for (i = 1; i <= lcount; i++) { IMAGE(l0 + i - 1,0)[0] = yname[i - 1]; } } /* Draw grid box. * */ for (i = *top; i <= *bottom; i++) { IMAGE(i - 1,0)[*left - 1] = '|'; IMAGE(i - 1,0)[*right - 1] = '|'; } for (i = *left + 1; i <= (*right - 1); i++) { IMAGE(*top - 1,0)[i - 1] = '-'; IMAGE(*bottom - 1,0)[i - 1] = '-'; } /* Place y grid line labels and "<" marks at * right end of y grid lines. * */ fkmajy = (double)( kmajy ); yfac = (*ymax - *ymin)/fkmajy; yifac = (double)( totym1 )/fkmajy; for (index = 0; index <= kmajy; index++) { fyind = (double)( index ); iline = *bottom - (long)( fyind*yifac + 0.5e0 ); yval = *ymin + fyind*yfac; if (yval - fnint( yval ) <= ysmall) yval = fnint( yval ); /*++ CODE for ~.C. is inactive * if ( abs(YVAL) .lt. YSMALL) then * IMAGE(ILINE)(YLAB2-1:YLAB2) = '0.' * else * write(IMAGE(ILINE)(YLAB1:YLAB2), FMTY2) YVAL * end if * IMAGE(ILINE)(RIGHT+1:RIGHT+1) = '<' *++ CODE for .C. is active */ if( fabs( yval ) < ysmall ){ strncpy(IMAGE(iline - 1L, ylab2 - 2L), "0.", 2); } else{ /* Here fmty is either "%*.*f" or "%*.*e" */ sprintf( numstring, (const char*)fmty, ksizey, ksiz2y, yval); strncpy(IMAGE(iline - 1L, ylab1 - 1L), numstring, ksizey); } IMAGE(iline - 1L,0)[(short)*right] = '<'; } /*++ END * * Place x grid line labels. * */ dprpl5( *xmin, *xmax, kmajx, fmtx, ksizex, ksiz2x, *left, nchars, IMAGE(*bottom,0) ); /* Place "|" marks at top and bottom of interior x grid lines. * */ xifac = (double)( totx - 1 )/fkmajx; for (index = 1; index <= (kmajx - 1); index++) { l1 = *left + (long)( (double)( index )*xifac + 0.5e0 ); IMAGE(*top - 1,0)[l1 - 1] = '|'; IMAGE(*bottom - 1,0)[l1 - 1] = '|'; } return; #undef IMAGE } /* end of function */ /* ================================================================== */ /* PARAMETER translations */ #define IMAX 18 /* end of PARAMETER translations */ void /*FUNCTION*/ dprpl4( double a, double b, double *c, double *d, long *kmajor, long *kminor, byte fmt[6], long *ksized, long *ksiz2d) { long int count, esize, exsize, fsize, hi, i, ig, k, lo; double a1, a2, b1, b2, bma, f, frac, p, small, temp, unit, v, x; static double span[IMAX]={12.0e0,14.0e0,15.0e0,16.0e0,18.0e0,20.0e0, 20.0e0,25.0e0,30.0e0,35.0e0,40.0e0,45.0e0,50.0e0,60.0e0,70.0e0, 80.0e0,90.0e0,100.0e0}; static double ekmn[IMAX]={2.0e0,2.0e0,5.0e0,2.0e0,2.0e0,2.0e0, 5.0e0,5.0e0,10.0e0,5.0e0,10.0e0,5.0e0,10.0e0,10.0e0,10.0e0,10.0e0, 10.0e0,10.0e0}; /* OFFSET Vectors w/subscript range: 1 to dimension */ double *const Ekmn = &ekmn[0] - 1; double *const Span = &span[0] - 1; /* end of OFFSET VECTORS */ /* . Copyright (C) 1992, California Institute of Technology. * . U. S. Government sponsorship under * . NASA contract NAS7-918 is acknowledged. *>> 1992-02-06 DPRPL4 CLL Determine info for grid labeling. *>> 1989-10-31 SCALK8 CLL Force rounding of MKAJOR for Cray. *>> 1985-08-02 SCALK8 Lawson Initial code. * DPRPL4.. Select pleasant grid boundaries and build a format string. * C.L.LAWSON,JPL,1965 JUL 7 * C.L.L.,JPL,1967 FEB 20 CHANGED TO MAKE C AND D ALWAYS * BE MULTIPLES OF UNIT. * MODIFIED BY CLL 7/14/72 FOR A,B CLOSE TO UNDER/OVER FLOW * ------------------------------------------------------------------ * Subroutine arguments * * Input: A, B Output: C, D, KMAJOR, KMINOR, FMT, KSIZED * * A and B are min and max (or max and min) values * of a variable (either abcissa or ordinate) to be graphed. * KMAJOR is the recommended no. of major grid subdivisions. * KMINOR is the recommended no. of subdivisions within a major * subdivision. * C and D are pleasant values to be assigned to the leftmost and * rightmost grid boundaries. Will satisfy C < D. * The closed interval [C,D] will generally contain the values A and * B, except that A and/or B may be outside [C,D] by a distance of * up to 0.0001 * (D-C). * FMT [out, char*15] Recommended format for a single grid label value. * This will not contain parentheses. * Examples: 'ss,f05.01 ' or 'ss,1p,e15.07d02' * KSIZED [out, integer] No. of char positions that will be used to * display a number when it is output using the format, FMT. * ------------------------------------------------------------------ * Description of some of the internal variables. * * ESIZE, EXSIZE, FSIZE [integers] ESIZE and FSIZE give the total no. * of char positions needed for an E or F format, respectively. * EXSIZE is the no. of digit positions needed in the exponent part * of an E format. * * HI, LO, COUNT [integers] COUNT = HI - LO + 1. * HI and LO indicate the position of the most and * least significant digit that must be repesented in the printed * output. Number template: x x x x . x x x * Digit position: 3 2 1 0 -1 -2 -3 * COUNT is the number of digits needed in the output. * For example for the number 593.62 we would have * HI = 2, LO = -2, and COUNT = 5. * * SPAN(), KMAJ(), EKMN() [integers] These prestored tables are * related by SPAN(i) = KMAJ(i) * EKMN(i). * This subr chooses a pair of values * KMAJ(i) and EKMN(i) to return as KMAJOR and KMINOR. The KMAJ() * table may be commented out, in which case its values will be * computed as needed by KMAJ(i) = SPAN(i) / EKMIN(i). * The prestored values in these tables are chosen so the values of * SPAN() are > 10, and .le. 100, and in increasing order, and give * somewhat uniform logorathmic coverage of the range from 10 to 100. * The values of EKMN() are limited to be 2, 5, or 10. * The values of KMAJ() are limited to be .ge. 3 and .le. 10. * ------------------------------------------------------------------ */ /* data KMAJ / 6.0d0, 7.0d0, 3.0d0, 8.0d0, 9.0d0,10.0d0, 4.0d0, * 1 5.0d0, 3.0d0, 7.0d0, 4.0d0, 9.0d0, 5.0d0, 6.0d0, 7.0d0, * 2 8.0d0, 9.0d0, 10.0d0 / */ /* ------------------------------------------------------------------ * CHANGE A,B TO A1,B1, with A1 < B1 */ if (a < b) { a1 = a; b1 = b; } else if (a > b) { a1 = b; b1 = a; } else if (a == 0.0e0) { a1 = -1.0e0; b1 = 1.0e0; } else { small = 0.01e0*fabs( a ); a1 = a - small; b1 = b + small; } /* Now we have A1 < B1 * * PERTURB A1 and B1 TO AVOID BAD * DECISIONS DUE TO ROUND-OFF. */ a2 = a1; b2 = b1; small = (b1 - a1)*0.0001e0; if (a1 != 0.0e0) a1 += small; if (b1 != 0.0e0) b1 -= small; bma = b1 - a1; if (bma <= 0.0e0) { a1 = a2; b1 = b2; bma = b1 - a1; } /* Convert BMA to X*10**G = X*P with 10. < X .le. 100. */ v = log10( bma ); ig = (long)( v ); f = v - (double)( ig ); if (f <= 0.0e0) f += 1.0e0; x = pow(10.0e0,f + 1.0e0); p = bma/x; if (x <= 10.0e0) { x *= 10.0e0; p /= 10.0e0; ig -= 1; } /* ENTER SPAN( ) TABLE USING X */ for (i = 1; i <= IMAX; i++) { if (x <= Span[i]) goto L_95; } i = IMAX; L_95: ; /* DETERMINE WHETHER SPAN(I) CAN BE USED */ for (k = 1; k <= 3; k++) { L_100: unit = Ekmn[i]*p; *c = unit*trunc( a1/unit ); if (*c > a1) *c -= unit; *d = *c + Span[i]*p; if (b1 <= *d) goto L_110; i += 1; if (i <= IMAX) goto L_100; i = 1; p *= 10.0e0; } /* TROUBLE: A or B close to UNDER/OVER FLOW * */ printf(" DPRPL4 ERROR.. A,B,C,D,=%20.8e%20.8e%20.8e%20.8e\n", a, b, *c, *d); L_110: ; if (fabs( *c ) < 0.0001e0*bma) { *c = 0.0e0; } else if (fabs( *d ) < 0.0001e0*bma) { *d = 0.0e0; } /* The ratio SPAN(I)/EKMN(I) is an exact integer value, however * the Cray X/MP sometimes returns a value less than the exact value, * so we take the nearest integer value. * */ *kmajor = nint( Span[i]/Ekmn[i] ); *kminor = Ekmn[i]; temp = log10( fmax( fabs( *c ), fabs( *d ) ) ); hi = (long)( temp ); frac = temp - (double)( hi ); if (frac < 0.0e0) hi -= 1; /* nint() rounds to nearest integer. */ lo = nint( log10( p ) ); if (*kminor == 10.0e0) lo += 1; /* print*,'DPRPL4..' * print'(/a,a/)',' A B KMAJOR KMINOR ', * * ' C D HI LO' * print'(/1x,2g14.6,2i3,2g14.6,2i6)', * * A, B, KMAJOR, KMINOR, C, D, HI, LO * * Set FSIZE to No. of char positions needed if F format is used. * First we assume C and D are each nonnegative. * */ count = hi - lo + 1; if (hi < 0) { /* 0.00xxx */ fsize = count - hi + 1; } else if (lo > -1) { /* xxx00. */ fsize = count + lo + 1; } else { /* x.xx */ fsize = count + 1; } /* Set ESIZE to No. of char positions needed if E format is used. * First we assume C and D are each nonnegative. * EXSIZE is the No. of digit positions needed in the exponent part. * */ if (hi == 0) { exsize = 1; } else { exsize = 1 + (long)( log10( (double)( labs( hi ) ) ) ); } /* x.xxE+yy */ esize = count + 3 + exsize; /* Adjust FSIZE and ESIZE if C or D is negative. * */ if (*c < 0.0e0 || *d < 0.0e0) { fsize += 1; esize += 1; } /* print'(a,i4,a,i4,a,i4)', * * ' FSIZE=',FSIZE,', ESIZE=',ESIZE,', EXSIZE=',EXSIZE * * Build the format string. * */ if (fsize <= esize) { *ksized = fsize; /*++ CODE for ~.C. is inactive * FMT(1:15) = 'ss,f . ' * write(FMT(5:6),'(i2.2)') FSIZE * write(FMT(8:9),'(i2.2)') max(0,-LO) *++ CODE for .C. is active */ strcpy(fmt, "%*.*f"); *ksiz2d = max( 0, -lo ); /*++ END */ } else { *ksized = esize; /*++ CODE for ~.C. is inactive * FMT(1:15) = 'ss,1p,e . e ' * write(FMT(8:15),'(i2.2,''.'',i2.2,''e'',i2.2)') * * ESIZE, COUNT-1, EXSIZE *++ CODE for .C. is active */ strcpy(fmt, "%*.*e"); *ksiz2d = count - 1; /*++ END */ } return; } /* end of function */ /* ================================================================== */ void /*FUNCTION*/ dprpl5( double c, double d, long kmajx, byte fmt[6], long ksized, long ksiz2d, long left, long nimage, byte image[]) { long int avail1, avail2, delx1, delx2, i1, i2, ic, index; double fkmajx, fxind, ixfac, xfac, xsmall, xval; /* . Copyright (C) 1992, California Institute of Technology. * . U. S. Government sponsorship under * . NASA contract NAS7-918 is acknowledged. *>> 1992-02-06 DPRPL5 CLL * DPRPL5 builds a print line of numeric grid labels for the x axis. * ------------------------------------------------------------------ * Subroutine arguments * * Input: C, D, KMAJX, FMT, KSIZED, LEFT, NIMAGE Output: IMAGE * * C and D are pleasant values that have been assigned to the leftmost * and rightmost grid boundaries. Will satisfy C < D. * KMAJX is the recommended no. of major grid subdivisions. * FMT [in, char*15] Recommended format for a single grid label value. * This will not contain parentheses. * Examples: 'ss,f05.01 ' or 'ss,1p,e15.07d02' * KSIZED [in, integer] No. of char positions that will be used to * display a number when it is output using the format, FMT. * LEFT [in, integer] Index of position in IMAGE aligned with the * leftmost grid line. Indexing is 1-based. * NIMAGE [in, integer] Index of last useable position in IMAGE. * The rightmost grid line aligns with index IMAGE-1. * IMAGE [out, char*NIMAGE] Character string in which this subr will * build a print line of numeric grid labels. * ------------------------------------------------------------------ * We assume tests have been made in [D/S]PRPL3 to assure there is * enough space in IMAGE() to at least place the label for the leftmost * x grid line. It extends from LEFT-DELX1 to LEFT+DELX2. DELX1 and * DELX2 are computed in [D/S]PRPL3 for use in tests, and are computed * again in this subroutine for use in placing grid labels. * If there is not enough space for other grid labels we just omit them. * ------------------------------------------------------------------ */ /* ------------------------------------------------------------------ *++ CODE for ~.C. is inactive * character FMT*15, FMT2*17 * IMAGE(1:NIMAGE) = ' ' * FMT2 = '(' // FMT // ')' *++ CODE for .C. is active */ char numstring[40]; for (i1 = 0; i1 < nimage; i1++) image[i1] = ' '; avail1 = 1; /*++ END */ avail2 = nimage; xsmall = 0.0001e0*(d - c); delx1 = ksized/2; delx2 = ksized - delx1 - 1; /* When centering a label on position IC, the label will occupy * positions from IC - DELX1 through IC + DELX2. * * Try to place leftmost grid label. * */ ic = left; if (fabs( c ) < xsmall) { image[ic - 1] = '0'; avail1 = ic + 2; } else { i1 = ic - delx1; i2 = ic + delx2; if (i1 >= avail1 && i2 <= avail2) { sprintf( numstring, (const char*)fmt, ksized, ksiz2d, c); strncpy( &image[(short)(i1-1)], numstring, ksized); avail1 = i2 + 2; /* write(IMAGE(I1:I2), FMT2) C */ } } /* Try to place rightmost grid label. * */ ic = nimage - 1; if (fabs( d ) < xsmall) { if (ic >= avail1) { image[ic - 1] = '0'; avail2 = ic - 2; } } else { i1 = nimage - ksized + 1; i2 = nimage; if (i1 >= avail1) { sprintf( numstring, (const char*)fmt, ksized, ksiz2d, d); strncpy( &image[(short)(i1-1)], numstring, ksized); avail2 = i1 - 2; /* write(IMAGE(I1:I2), FMT2) D */ } } /* Try to place interior grid labels. * */ fkmajx = (double)( kmajx ); xfac = (d - c)/fkmajx; ixfac = (double)( nimage - left - 1 )/fkmajx; for (index = 1; index <= (kmajx - 1); index++) { fxind = (double)( index ); ic = left + nint( fxind*ixfac ); xval = c + fxind*xfac; if (fabs( xval ) < xsmall) { if (ic >= avail1 && ic <= avail2) { image[ic - 1] = '0'; avail1 = ic + 2; } } else { i1 = ic - delx1; i2 = ic + delx2; if (i1 >= avail1 && i2 <= avail2) { if (xval - fnint( xval ) < xsmall) xval = fnint( xval ); sprintf( numstring, (const char*)fmt,ksized, ksiz2d, xval); strncpy( &image[(short)(i1-1L)], numstring, ksized); avail1 = i2 + 2; /* write(IMAGE(I1:I2), FMT2) XVAL */ } } } return; } /* end of function */