From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/gio/ncarutil/autograph/agfpbn.f | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 sys/gio/ncarutil/autograph/agfpbn.f (limited to 'sys/gio/ncarutil/autograph/agfpbn.f') diff --git a/sys/gio/ncarutil/autograph/agfpbn.f b/sys/gio/ncarutil/autograph/agfpbn.f new file mode 100644 index 00000000..f4900b60 --- /dev/null +++ b/sys/gio/ncarutil/autograph/agfpbn.f @@ -0,0 +1,37 @@ +C +C +C +-----------------------------------------------------------------+ +C | | +C | Copyright (C) 1986 by UCAR | +C | University Corporation for Atmospheric Research | +C | All Rights Reserved | +C | | +C | NCARGRAPHICS Version 1.00 | +C | | +C +-----------------------------------------------------------------+ +C +C +C --------------------------------------------------------------------- +C + INTEGER FUNCTION AGFPBN (FPDP) +C +C The value of AGFPBN(FPDP) is a binary dash pattern, obtained from the +C floating-point dash pattern FPDP. On machines having a word length +C greater than 16 bits, AGFPBN(FPDP) = IFIX(FPDP). On machines having +C a word length of 16 bits, this is not true. For example, when FPDP = +C 65535. (2 to the 16th minus 1), the equivalent binary dash pattern +C does not have the value 65535, but the value -1 (assuming integers +C are represented in a ones' complement format). So, the functions +C ISHIFT and IOR must be used to generate the dash pattern. +C + TEMP=FPDP + AGFPBN=0 +C + DO 101 I=1,16 + IF (AMOD(TEMP,2.).GE.1.) AGFPBN=IOR(AGFPBN,ISHIFT(1,I-1)) + TEMP=TEMP/2. + 101 CONTINUE +C + RETURN +C + END -- cgit