view release on metacpan or  search on metacpan

test/cpex03.t  view on Meta::CPAN

my $XFIJ = zeroes float, 33, 33;
my $YFIJ = zeroes float, 33, 33;
#
# Turn off the clipping indicator.
#
&NCAR::gsclip (0);
#
# Set all the GKS aspect source flags to "individual".
#
&NCAR::gsasf ($IASF);
#
# Turn on the positioning of labels by the penalty scheme and provide a
# little more room for X and Y coordinates defining contour lines, so
# as not to have labels right next to each other on a contour line.
#
&NCAR::cpseti ('LLP - LINE LABEL POSITIONING',3);
&NCAR::cpseti ('RWC - REAL WORKSPACE FOR CONTOURS',200);
#
# Turn on the drawing of the high and low label boxes.
#
&NCAR::cpseti ('HLB - HIGH/LOW LABEL BOX FLAG',1);
#
# Tell CONPACK to delete high/low labels which overlap the informational
# label or another high/low label, but to move those which overlap the
# edge inward a little.
#
&NCAR::cpseti ('HLO - HIGH/LOW LABEL OVERLAP FLAG',11);
#
# Make all CONPACK-written characters a little bigger.
#
&NCAR::cpsetr ('CWM - CHARACTER WIDTH MULTIPLIER',1.25);
#
# Turn on the drawing of the grid edge ("contour line number -1") and
# thicken it somewhat.
#
&NCAR::cpseti ('PAI - PARAMETER ARRAY INDEX',-1);
&NCAR::cpseti ('CLU - CONTOUR LEVEL USE FLAG',1);
&NCAR::cpsetr ('CLL - CONTOUR LEVEL LINE WIDTH',2.);
#
# Tell CONPACK to do no SET call.
#
&NCAR::cpseti ('SET - DO-SET-CALL FLAG',0);
#
# Turn on the special-value feature and the outlining of special-value
# areas ("contour line number -2"), using a double-width line.
#
&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.);
#
# Generate an array of test data.
#
my @t;
open DAT, "<data/cpex03.dat";
{
  local $/ = undef;
  my $t = <DAT>;
  $t =~ s/^\s*//o;
  $t =~ s/\s*$//o;
  @t = split m/\s+/o, $t;
}
close DAT;
for my $I ( 1 .. 33 ) {
  for my $J ( 1 .. 33 ) {
    set( $ZDAT, $J-1, $I-1, shift( @t ) );
  }
}
#
# Put special values in a roughly circular area.
#
for my $I ( 1 .. 33 ) {
  for my $J ( 1 .. 33 ) {
    if( ( ($I-20)*($I-20)+($J-10)*($J-10) ) < 25 ) {
      set( $ZDAT, $J-1, $I-1, 1.E36 );
    }
  }
}

sub Log10 {
  my $x = shift;
  return log( $x ) / log( 10 );
}
#
# Do four different plots, one in each quadrant.
#
for my $IPLT ( 1 .. 4 ) {
#
# Compute viewport parameters.
#
  my $XVPL=.0250+.5000*(($IPLT-1)%2);
  my $XVPR=.4750+.5000*(($IPLT-1)%2);
  my $YVPB=.0250+.5000*int((4-$IPLT)/2);
  my $YVPT=.4750+.5000*int((4-$IPLT)/2);
#
# For each of the four plots, use a different mapping function and
# create a different background.
#
  &NCAR::cpseti ('MAP - MAPPING FUNCTION',$IPLT);
#
# EZMAP.
#
  if( $IPLT == 1 ) {
    &NCAR::mapsti ('GR - GRID INTERVAL',30);
    &NCAR::mapstc ('OU - OUTLINE DATASET','CO');
    &NCAR::mapsti ('DO - DOTTING OF OUTLINES',1);
    &NCAR::mappos ($XVPL,$XVPR,$YVPB,$YVPT);
    &NCAR::maproj ('OR - ORTHOGRAPHIC',40.,-95.,0.);
    &NCAR::mapset ('MA - MAXIMAL AREA',
                   float( [ 0., 0. ] ),
                   float( [ 0., 0. ] ),
                   float( [ 0., 0. ] ),
                   float( [ 0., 0. ] )
                  );
    &NCAR::mapdrw();
    &NCAR::cpsetr ('XC1 - LONGITUDE AT I = 1',-160.);
    &NCAR::cpsetr ('XCM - LONGITUDE AT I = M',-30.);
    &NCAR::cpsetr ('YC1 - LATITUDE AT J = 1',-10.);
    &NCAR::cpsetr ('YCN - LATITUDE AT J = N',70.);
#
# Polar coordinates.