view release on metacpan or  search on metacpan

test/vvex01.t  view on Meta::CPAN

use Test;
BEGIN { plan tests => 1 };
use NCAR;
ok(1); # If we made it this far, we're ok.;

#########################

# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
unlink( 'gmeta' );

use PDL;
use NCAR::Test;  
&NCAR::gopks( 6, 1 );
&NCAR::gopwk( 1, 2, 1 );
&NCAR::gacwk( 1 );

#
# This example overlays vectors on a polar contour plot using 
# data generated with a randomizing algorithm. The first frame colors
# the vectors according to the data used to generate the contour plot,
# with the result that the color of the vectors corresponds to the 
# contour level at each location. In the second frame the vectors 
# are colored by magnitude.
# 
# The contour, vector field component, and area map array declarations:
#
my ( $MSIZE, $NSIZE ) = ( 33, 33 );
my $LAMA=25000;
my $ZDAT = zeroes float, $NSIZE, $MSIZE;
my $U = zeroes float, 60, 60;
my $V = zeroes float, 60, 60;
my $IAMA = zeroes long, $LAMA;
#
# Workspace arrays for Conpack:
#
my $RWRK = zeroes float, 5000;
my $IWRK = zeroes long, 1000;
#
# ARSCAM arrays:
#
my $XCRA = zeroes float, 1000;
my $YCRA = zeroes float, 1000;
my $IARA = zeroes long, 10;
my $IGRA = zeroes long, 10;
#
# Declare the masked rendering routines for drawing and shading the
# contour plot, as well as for drawing the vectors
#
#     EXTERNAL DRAWCL
#     EXTERNAL SHADER
#     EXTERNAL VVUDMV
#
my @t;
open DAT, "<data/vvex01.ZDAT.dat";
{
  local $/ = undef;
  my $t = <DAT>;
  $t =~ s/^\s*//o;
  $t =~ s/\s*$//o;
  @t = split m/\s+/o, $t;
}
close DAT;
for my $J ( 1 .. $NSIZE ) {
  for my $I ( 1 .. $MSIZE ) {
    set( $ZDAT, $J-1, $I-1, shift( @t ) );
  }
}
#
for my $I ( 1 .. $MSIZE ) {
  for my $J ( 1 .. $NSIZE ) {
    if( ( ($I-20)*($I-20) + ($J-10)*($J-10) ) < 25 ) { 
      set( $ZDAT, $J-1, $I-1, 1.E36 );
    }
  }
}
#
# Subroutine GENARA generates smoothly varying random data in its 
# second array argument based upon the contents of the first. Call it
# twice to randomize both the U and V vector component data arrays.
# Then set up the color table.
#
open DAT, "<data/vvex01.U.dat";
{
  local $/ = undef;
  my $t = <DAT>;
  $t =~ s/^\s*//o;
  $t =~ s/\s*$//o;
  @t = split m/\s+/o, $t;
}
close DAT;
for my $J ( 1 .. 60 ) {
  for my $I ( 1 .. 60 ) {
    set( $U, $J-1, $I-1, shift( @t ) );
  }
}
open DAT, "<data/vvex01.V.dat";
{
  local $/ = undef;
  my $t = <DAT>;
  $t =~ s/^\s*//o;
  $t =~ s/\s*$//o;
  @t = split m/\s+/o, $t;
}
close DAT;
for my $J ( 1 .. 60 ) {
  for my $I ( 1 .. 60 ) {
    set( $V, $J-1, $I-1, shift( @t ) );
  }
}

&DFCLRS() ;
#
# Conpack setup:
# ===============================================================
# Set up a polar coordinate system mapping for Conpack
#
&NCAR::set    (0.05,0.95,0.05,0.95,-1.0,1.0,-1.0,1.0,1);
&NCAR::cpseti ('MAP - Mapping Function',2);
&NCAR::cpseti ('SET - Do-Set-Call Flag',0);
&NCAR::cpsetr ('XC1 - Rho At I = 1',.1);
&NCAR::cpsetr ('XCM - Rho At I = M',1.);
&NCAR::cpsetr ('YC1 - Theta At J = 1',0.0);
&NCAR::cpsetr ('YCN - Theta At J = N',360.0);
#
# Enable special value processing and outline special value regions
#
&NCAR::cpsetr ('SPV - Special Value',1.E36);
&NCAR::cpseti ('PAI - Parameter Array Index',-2);
&NCAR::cpseti ('CLU - Contour Level Use Flag',1);
&NCAR::cpsetr ('CLL - Contour Level Line Width',2.);
#
# Adjust Conpack labelling and outline the data field.
#
&NCAR::cpseti ('LLP - Line Label Positioning',3);
&NCAR::cpseti ('RWC - Real Workspace For Contours',200);
&NCAR::cpseti ('HLB - High/Low Label Box Flag',1);
&NCAR::cpseti ('HLO - High/Low Label Overlap Flag',11);
&NCAR::cpsetr ('CWM - Character Width Multiplier',1.25);
&NCAR::cpseti ('PAI - Parameter Array Index',-1);
&NCAR::cpseti ('CLU - Contour Level Use Flag',1);
&NCAR::cpsetr ('CLL - Contour Level Line Width',2.);
#
# Initialize the drawing of the contour plot, and tell Conpack 
# to pick the contour levels.
#
&NCAR::cprect ($ZDAT,$MSIZE,$MSIZE,$NSIZE,$RWRK,5000,$IWRK,1000);
&NCAR::cppkcl ($ZDAT,$RWRK,$IWRK);
#
# Set the attributes of the contour lines
#
&NCAR::cpgeti ('NCL - Number Of Contour Levels',my $NCLV);
for my $ICLV ( 1 .. $NCLV ) {
  &NCAR::cpseti ('PAI - Parameter Array Index',$ICLV);
  &NCAR::cpgeti ('CLU - Contour Level Use Flag',my $ICLU);
  if( $ICLU == 3 ) {
    &NCAR::cpseti ('CLL - Contour-Line Line Width',2);
  }
  &NCAR::cpseti ('AIA - Area Identifier Above Level',0);
  &NCAR::cpseti ('AIB - Area Identifier Below Level',0);
}
#
# Add two new levels for which no contour lines are to be drawn, but