view release on metacpan or  search on metacpan

test/srex01.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 qw( bndary gendat drawcl );
use strict;
   
&NCAR::gopks( 6, 1 );
&NCAR::gopwk( 1, 2, 1 );
&NCAR::gacwk( 1 );

use NCAR::COMMON qw( %SRFIP1 );

#
#
# Define the required arrays.
#
my $XDAT = zeroes float, 100;
my $YDAT = zeroes float, 100;
my $ODAT = zeroes float, 40, 40;
my $ZDAT = zeroes float, 100, 100;
my $QDAT = zeroes float, 100, 100;
my $WORK = zeroes long, 20000;
#
# Define the data for the label on top of the graph.
#
my $PLBL = 'Longs Peak relief using SRFACE';
# 
# Define the line of sight (viewpoint and point looked at).
#
my $STLN = float [ 5247.5 , 5247.5 , 2530. , 247.5 , 247.5 , 1280. ];
#
# Generate x-coordinate values.
#
for my $I ( 1 .. 100 ) {
  set( $XDAT, $I-1, 5*($I-1) );
}
#
# Generate y-coordinate values.
#
for my $J ( 1 .. 100 ) {
  set( $YDAT, $J-1, 5*($J-1) );
}
#
# Put the original Long's Peak data in the array ODAT.
#
open DAT, "<data/srex01.dat";
for my $J ( 1 .. 40 ) {
  my $X = <DAT>;
  chomp $X;
  $X =~ s/^\s*//o;
  $X =~ s/\s*$//o;
  my @X = split m/\s+/o, $X;
  for my $I ( 1 .. 40 ) {
    set( $ODAT, $J-1, $I-1, $X[$I-1] );
  }
}
close DAT;
#
# Interpolate to get more closely-spaced data in the array QDAT.
#
for my $J ( 1 .. 100 ) {
  my $FL=1.+38.99999999*($J-1)/99.;
  my $L=int($FL);
  $FL=$FL-$L;
  for my $I ( 1 .. 100 ) {
    my $FK=1.+38.99999999*($I-1)/99.;
    my $K=int($FK);
    $FK=$FK-$K;
    set( $QDAT, $J-1, $I-1, 
     (1.-$FL)*((1.-$FK)*at($ODAT,$L-1,$K-1)+$FK*at($ODAT,$L-1,$K))+
         $FL *((1.-$FK)*at($ODAT,$L  ,$K-1)+$FK*at($ODAT,$L  ,$K))
    );
  }
}
#
# Apply a nine-point smoother to get smoother data in the array ZDAT.
#
for my $J ( 1 .. 100 ) {
  my $JM1=&NCAR::Test::max($J-1,1);
  my $JP1=&NCAR::Test::min($J+1,100);
  for my $I ( 1 .. 100 ) {
    my $IM1=&NCAR::Test::max($I-1,1);
    my $IP1=&NCAR::Test::min($I+1,100);
    set( $ZDAT, $J-1, $I-1,
     .2500*at( $QDAT, $J-1, $I-1 )+
     .1250*(at( $QDAT,$J-1,$IM1-1)+at( $QDAT,$J-1,$IP1-1)+
            at( $QDAT,$JM1-1,$I-1)+at( $QDAT,$JP1-1,$I-1))+
     .0625*(at( $QDAT,$JM1-1,$IM1-1)+at( $QDAT,$JM1-1,$IP1-1)+
            at( $QDAT,$JP1-1,$IM1-1)+at( $QDAT,$JP1-1,$IP1-1))
    );
  }
}
#
# Plot the data four times.
#
for my $NPLT ( 1 .. 4 ) {
#
# Before the 2nd, 3rd, and 4th plots, rotate the data by 90 degrees.
#
  if( $NPLT != 1 ) {
    for my $J ( 1 .. 100 ) {
      for my $I ( 1 .. 100 ) {
        set( $QDAT, $J-1, $I-1, at( $ZDAT, $J-1, $I-1 ) );
      }
    }
    for my $J ( 1 .. 100 ) {
      my $K=101-$J;
      for my $I ( 1 .. 100 ) {
        my $L=$I;
        set( $ZDAT, $J-1, $I-1, at( $QDAT, $L-1, $K-1 ) );
      }
    }