"Fossies" - the Fresh Open Source Software Archive

Member "PerlCDF38_0/testhyper.pl" (19 Nov 2019, 3149 Bytes) of package /linux/misc/PerlCDF38_0.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "testhyper.pl" see the Fossies "Dox" file reference documentation.

    1 #!/usr/bin/perl -w
    2 
    3 #
    4 # testPerlCDFii
    5 #
    6 #   This program tests the PerlCDF internal interface.  PerlCDF must be installed.
    7 #   See README.
    8 #
    9 #  Usage:
   10 #     perl testPerlCDFii.pl
   11 #
   12 # Written By:
   13 #
   14 #    Emily A. Greene
   15 #    NSSDC / Hughes STX
   16 #
   17 #    17 October, 1995
   18 #
   19 #    Version 1.0
   20 #    Modified by: Michael Liu  - 20 March, 1998
   21 #    Version 2.0
   22 #    Modified by: Michael Liu  - 07 January, 2005
   23 #
   24 #############################################################################
   25 #
   26 #  Translated from qst2ic.c v. 1.10 by J. Love
   27 #
   28 #  Differences include:
   29 #     z Variable is 5 strings each 8 characters long not a 40 character buffer
   30 #          tests changed accordingly
   31 #     maxiumum records written is a variable
   32 #     Arrays are all 1 Dimensional.  2 dimensionality handled within CDF.
   33 #     Added section confirming rVARs recCount, etc.
   34 #     Added a few informational messages
   35 #     Tests Epoch routines
   36 # Note: As Perl uses double, a variable of data type CDF_REAL4/FLOAT will 
   37 #   cause some minor value deviation due to different floating-point type 
   38 #   representations. If the value is returned from the CDF's C routine 
   39 #   and compared with Perl value, an epsilon is used for checkng their
   40 #   equality. 10**(-9) is used for double and 10**(-5) for 
   41 #   float/real. No problem for CDF_REAL8 data type.
   42 #     
   43 #############################################################################
   44 
   45 use strict;
   46 use Math::BigInt;
   47 
   48 BEGIN { unshift @INC,'/home/liu/PerlCDF38_0/blib/arch',
   49                      '/home/liu/PerlCDF38_0/blib/lib'; }
   50 use CDF;
   51 my $id;
   52 my $status;
   53 $status = CDF::CDFlib (&OPEN_, &CDF_, $ARGV[0], \$id,
   54                &NULL_);
   55 QuitCDF ("4.0", $status) if ($status < &CDF_OK) ;
   56 
   57 my @indices;
   58 my @counts;
   59 my @intervals;
   60 my @values;
   61 
   62 $indices[0] = 0;
   63 $counts[0] = 3;
   64 $intervals[0] = 1;
   65 
   66 $status = CDF::CDFlib (&SELECT_, &zVAR_, $ARGV[1],
   67                                 &zVAR_RECNUMBER_, 0,
   68                 &zVAR_RECCOUNT_, 20,
   69                 &zVAR_RECINTERVAL_, 1,
   70                 &zVAR_DIMINDICES_, \@indices,
   71                 &zVAR_DIMCOUNTS_, \@counts,
   72                 &zVAR_DIMINTERVALS_, \@intervals,
   73                &GET_, &zVAR_HYPERDATA_, \@values,
   74                &NULL_);
   75 QuitCDF ("10.0z", $status) if ($status < &CDF_OK) ;
   76 my $x0;
   77 
   78 for ($x0 = 0; $x0 <= $#values; $x0++) {
   79    print "$x0: $values[$x0]\n";
   80 }
   81   
   82 $status = CDF::CDFlib (&CLOSE_, &CDF_,
   83                &NULL_);
   84 QuitCDF ("28.2", $status) if ($status < &CDF_OK) ;
   85 
   86 #############################################################################
   87 # QuitCDF.
   88 #############################################################################
   89 sub QuitCDF {
   90     my ($where, $status)=@_;
   91 
   92   print "Aborting at $where ...\n";
   93   if ($status < &CDF_OK) {
   94     my $text;
   95     CDF::CDFlib (&SELECT_, &CDF_STATUS_, $status,
   96            &GET_, &STATUS_TEXT_, \$text,
   97            &NULL_);
   98     print $text;
   99   }
  100   CDF::CDFlib (&CLOSE_, &CDF_,
  101       &NULL_);
  102   print "...test aborted.\n";
  103   exit;
  104     
  105 }#endsub QuitCDF
  106 
  107 #############################################################################
  108 #  QuitEPOCH
  109 #############################################################################
  110 sub QuitEPOCH {
  111   my ($where) = @_;
  112   print "Aborting at $where...test aborted.\n";
  113   exit;
  114 
  115 }#endsub QuitEPOCH