fortran.c

Go to the documentation of this file.
00001 /*                       F O R T R A N . C
00002  * BRL-CAD
00003  *
00004  * Copyright (c) 2004-2012 United States Government as represented by
00005  * the U.S. Army Research Laboratory.
00006  *
00007  * This library is free software; you can redistribute it and/or
00008  * modify it under the terms of the GNU Lesser General Public License
00009  * version 2.1 as published by the Free Software Foundation.
00010  *
00011  * This library is distributed in the hope that it will be useful, but
00012  * WITHOUT ANY WARRANTY; without even the implied warranty of
00013  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00014  * Lesser General Public License for more details.
00015  *
00016  * You should have received a copy of the GNU Lesser General Public
00017  * License along with this file; see the file named COPYING for more
00018  * information.
00019  */
00020 /** @addtogroup fort */
00021 /** @{ */
00022 /** @file libbn/fortran.c
00023  *
00024  * @brief
00025  * A FORTRAN-callable interface to libplot3.
00026  *
00027  * A FORTRAN-callable interface to libplot3, which is a public-domain
00028  * UNIX plot library, for 2-D and 3-D plotting in 16-bit signed
00029  * integer spaces, and in floating point.
00030  *
00031  * Note that all routines which expect floating point parameters
00032  * currently expect them to be of type "float" (single precision) so
00033  * that all FORTRAN constants can be written normally, rather than
00034  * having to insist on FORTRAN "double precision" parameters.  This is
00035  * at odds with the C routines and the meta-file format, which both
00036  * operate in "C double" precision.
00037  *
00038  * Note that on machines like the Cray,
00039  * (C float == C double == FORTRAN REAL) != FORTRAN DOUBLE PRECISION
00040  *
00041  * Also note that on the Cray, the only interface provision required
00042  * is that the subroutine name be in all upper case.  Other systems
00043  * may have different requirements, such as adding a leading
00044  * underscore.  It is not clear how to handle this in a general way.
00045  *
00046  * Note that due to the 6-character name space required to be
00047  * generally useful in the FORTRAN environment, the names have been
00048  * shortened.  At the same time, a consistency of naming has been
00049  * implemented; the first character or two giving a clue as to the
00050  * purpose of the subroutine:
00051  *
00052  *@li I General routines, and integer-parameter routines
00053  *@li I2 Routines with enumerated 2-D integer parameters
00054  *@li I3 Routines with enumerated 3-D integer parameters
00055  *@li F2 Routines with enumerated 2-D float parameters
00056  *@li F3 Routines with enumerated 3-D float parameters
00057  *@li A3 Routines with arrays of 3-D float parameters
00058  *
00059  * This name space leaves the door open for a double-precision family
00060  * of routines, D, D2, and D3.
00061  *
00062  */
00063 
00064 #include "common.h"
00065 
00066 #include <stdio.h>
00067 
00068 #include "plot3.h"
00069 
00070 
00071 /**
00072  * P L _ S T R N C P Y
00073  *
00074  * Make null-terminated copy of a string in output buffer, being
00075  * careful not to exceed indicated buffer size Accept "$" as alternate
00076  * string-terminator for FORTRAN Holerith constants, because getting
00077  * FORTRAN to null-terminate strings is to painful (and non-portable)
00078  * to contemplate.
00079  */
00080 void
00081 pl_strncpy(register char *out, register char *in, register int sz)
00082 {
00083     register int c = '\0';
00084 
00085     while (--sz > 0 && (c = *in++) != '\0' && c != '$')
00086         *out++ = c;
00087     *out++ = '\0';
00088 }
00089 
00090 
00091 /**
00092  * Macro 'F' is used to take the 'C' function name, and convert it to
00093  * the convention used for a particular system.  Both lower-case and
00094  * upper-case alternatives have to be provided because there is no way
00095  * to get the C preprocessor to change the case of a token.
00096  *
00097  * Lower case, with a trailing underscore.
00098  */
00099 #define F(lc, uc) lc ## _
00100 
00101 /*
00102  * These interfaces provide necessary access to C library routines
00103  * from the FORTRAN environment
00104  */
00105 
00106 
00107 /**
00108  * I F O P E N
00109  *
00110  * Open a file (by name) for plotting.
00111  */
00112 void
00113 F(ifopen, IFOPEN)(FILE **plotfp, char *name)
00114 {
00115     char buf[128];
00116 
00117     pl_strncpy(buf, name, (int)sizeof(buf));
00118     if ((*plotfp = fopen(buf, "wb")) == NULL)
00119         perror(buf);
00120 }
00121 
00122 /*
00123  * These interfaces provide the standard UNIX-Plot functionality
00124  */
00125 
00126 void
00127 F(i2pnt, I2PNT)(FILE **plotfp, int *x, int *y)
00128 {
00129     pl_point(*plotfp, *x, *y);
00130 }
00131 
00132 void
00133 F(i2line, I2LINE)(FILE **plotfp, int *px1, int *py1, int *px2, int *py2)
00134 {
00135     pl_line(*plotfp, *px1, *py1, *px2, *py2);
00136 }
00137 
00138 void
00139 F(ilinmd, ILINMD)(FILE **plotfp, char *s)
00140 {
00141     char buf[32];
00142     pl_strncpy(buf, s, (int)sizeof(buf));
00143     pl_linmod(*plotfp, buf);
00144 }
00145 
00146 void
00147 F(i2move, I2MOVE)(FILE **plotfp, int *x, int *y)
00148 {
00149     pl_move(*plotfp, *x, *y);
00150 }
00151 
00152 void
00153 F(i2cont, I2CONT)(FILE **plotfp, int *x, int *y)
00154 {
00155     pl_cont(*plotfp, *x, *y);
00156 }
00157 
00158 void
00159 F(i2labl, I2LABL)(FILE **plotfp, char *s)
00160 {
00161     char buf[256];
00162     pl_strncpy(buf, s, (int)sizeof(buf));
00163     pl_label(*plotfp, buf);
00164 }
00165 
00166 void
00167 F(i2spac, I2SPAC)(FILE **plotfp, int *px1, int *py1, int *px2, int *py2)
00168 {
00169     pl_space(*plotfp, *px1, *py1, *px2, *py2);
00170 }
00171 
00172 void
00173 F(ierase, IERASE)(FILE **plotfp)
00174 {
00175     pl_erase(*plotfp);
00176 }
00177 
00178 void
00179 F(i2circ, I2CIRC)(FILE **plotfp, int *x, int *y, int *r)
00180 {
00181     pl_circle(*plotfp, *x, *y, *r);
00182 }
00183 
00184 void
00185 F(i2arc, I2ARC)(FILE **plotfp, int *xc, int *yc, int *px1, int *py1, int *px2, int *py2)
00186 {
00187     pl_arc(*plotfp, *xc, *yc, *px1, *py1, *px2, *py2);
00188 }
00189 
00190 void
00191 F(i2box, I2BOX)(FILE **plotfp, int *px1, int *py1, int *px2, int *py2)
00192 {
00193     pl_box(*plotfp, *px1, *py1, *px2, *py2);
00194 }
00195 
00196 /*
00197  * Here lie the BRL 3-D extensions.
00198  */
00199 
00200 /** Warning: r, g, b are ints.  The output is chars. */
00201 void
00202 F(icolor, ICOLOR)(FILE **plotfp, int *r, int *g, int *b)
00203 {
00204     pl_color(*plotfp, *r, *g, *b);
00205 }
00206 
00207 void
00208 F(iflush, IFLUSH)(FILE **plotfp)
00209 {
00210     pl_flush(*plotfp);
00211 }
00212 
00213 void
00214 F(i3spac, I3SPAC)(FILE **plotfp, int *px1, int *py1, int *pz1, int *px2, int *py2, int *pz2)
00215 {
00216     pl_3space(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00217 }
00218 
00219 void
00220 F(i3pnt, I3PNT)(FILE **plotfp, int *x, int *y, int *z)
00221 {
00222     pl_3point(*plotfp, *x, *y, *z);
00223 
00224 }
00225 
00226 void
00227 F(i3move, I3MOVE)(FILE **plotfp, int *x, int *y, int *z)
00228 {
00229     pl_3move(*plotfp, *x, *y, *z);
00230 }
00231 
00232 void
00233 F(i3cont, I3CONT)(FILE **plotfp, int *x, int *y, int *z)
00234 {
00235     pl_3cont(*plotfp, *x, *y, *z);
00236 }
00237 
00238 void
00239 F(i3line, I3LINE)(FILE **plotfp, int *px1, int *py1, int *pz1, int *px2, int *py2, int *pz2)
00240 {
00241     pl_3line(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00242 }
00243 
00244 void
00245 F(i3box, I3BOX)(FILE **plotfp, int *px1, int *py1, int *pz1, int *px2, int *py2, int *pz2)
00246 {
00247     pl_3box(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00248 }
00249 
00250 /*
00251  * Floating point routines.
00252  */
00253 
00254 void
00255 F(f2pnt, F2PNT)(FILE **plotfp, float *x, float *y)
00256 {
00257     pd_point(*plotfp, *x, *y);
00258 }
00259 
00260 void
00261 F(f2line, F2LINE)(FILE **plotfp, float *px1, float *py1, float *px2, float *py2)
00262 {
00263     pd_line(*plotfp, *px1, *py1, *px2, *py2);
00264 }
00265 
00266 void
00267 F(f2move, F2MOVE)(FILE **plotfp, float *x, float *y)
00268 {
00269     pd_move(*plotfp, *x, *y);
00270 }
00271 
00272 void
00273 F(f2cont, F2CONT)(FILE **plotfp, float *x, float *y)
00274 {
00275     pd_cont(*plotfp, *x, *y);
00276 }
00277 
00278 void
00279 F(f2spac, F2SPAC)(FILE **plotfp, float *px1, float *py1, float *px2, float *py2)
00280 {
00281     pd_space(*plotfp, *px1, *py1, *px2, *py2);
00282 }
00283 
00284 void
00285 F(f2circ, F2CIRC)(FILE **plotfp, float *x, float *y, float *r)
00286 {
00287     pd_circle(*plotfp, *x, *y, *r);
00288 }
00289 
00290 void
00291 F(f2arc, F2ARC)(FILE **plotfp, float *xc, float *yc, float *px1, float *py1, float *px2, float *py2)
00292 {
00293     pd_arc(*plotfp, *xc, *yc, *px1, *py1, *px2, *py2);
00294 }
00295 
00296 void
00297 F(f2box, F2BOX)(FILE **plotfp, float *px1, float *py1, float *px2, float *py2)
00298 {
00299     pd_box(*plotfp, *px1, *py1, *px2, *py2);
00300 }
00301 
00302 /*
00303  * Floating-point 3-D, both in array (vector) and enumerated versions.
00304  * The same remarks about float/double apply as above.
00305  */
00306 
00307 void
00308 F(a2spac, A3SPAC)(FILE **plotfp, float min[3], float max[3])
00309 {
00310     pd_3space(*plotfp, min[0], min[1], min[2], max[0], max[1], max[2]);
00311 }
00312 
00313 void
00314 F(f3spac, F3SPAC)(FILE **plotfp, float *px1, float *py1, float *pz1, float *px2, float *py2, float *pz2)
00315 {
00316     pd_3space(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00317 }
00318 
00319 void
00320 F(a3pnt, A3PNT)(FILE **plotfp, float pt[3])
00321 {
00322     pd_3point(*plotfp, pt[0], pt[1], pt[2]);
00323 }
00324 
00325 void
00326 F(f3pnt, F3PNT)(FILE **plotfp, float *x, float *y, float *z)
00327 {
00328     pd_3point(*plotfp, *x, *y, *z);
00329 }
00330 
00331 void
00332 F(a3move, A3MOVE)(FILE **plotfp, float pt[3])
00333 {
00334     pd_3move(*plotfp, pt[0], pt[1], pt[2]);
00335 }
00336 
00337 void
00338 F(f3move, F3MOVE)(FILE **plotfp, float *x, float *y, float *z)
00339 {
00340     pd_3move(*plotfp, *x, *y, *z);
00341 }
00342 
00343 void
00344 F(a3cont, A3CONT)(FILE **plotfp, float pt[3])
00345 {
00346     pd_3cont(*plotfp, pt[0], pt[1], pt[2]);
00347 }
00348 
00349 void
00350 F(f3cont, F3CONT)(FILE **plotfp, float *x, float *y, float *z)
00351 {
00352     pd_3cont(*plotfp, *x, *y, *z);
00353 }
00354 
00355 void
00356 F(a3line, A3LINE)(FILE **plotfp, float a[3], float b[3])
00357 {
00358     pd_3line(*plotfp, a[0], a[1], a[2], b[0], b[1], b[2]);
00359 }
00360 
00361 void
00362 F(f3line, F3LINE)(FILE **plotfp, float *px1, float *py1, float *pz1, float *px2, float *py2, float *pz2)
00363 {
00364     pd_3line(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00365 }
00366 
00367 void
00368 F(a3box, A3BOX)(FILE **plotfp, float a[3], float b[3])
00369 {
00370     pd_3box(*plotfp, a[0], a[1], a[2], b[0], b[1], b[2]);
00371 }
00372 
00373 void
00374 F(f3box, F3BOX)(FILE **plotfp, float *px1, float *py1, float *pz1, float *px2, float *py2, float *pz2)
00375 {
00376     pd_3box(*plotfp, *px1, *py1, *pz1, *px2, *py2, *pz2);
00377 }
00378 
00379 /** @} */
00380 /*
00381  * Local Variables:
00382  * mode: C
00383  * tab-width: 8
00384  * indent-tabs-mode: t
00385  * c-file-style: "stroustrup"
00386  * End:
00387  * ex: shiftwidth=4 tabstop=8
00388  */
Generated on Tue Dec 11 13:14:27 2012 for LIBBN by  doxygen 1.6.3