dorian has asked for the wisdom of the Perl Monks concerning the following question:
If somebody has an idea about how to improve it, I would be very pleased. You can email me to get a seg y file to make tests Thanks in advance, Dorian
use vars qw( $VERSION ); ($VERSION) = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); use Tk; use Tk::Zinc; use PDL; #use strict; my $defaultfont = '-adobe-helvetica-bold-r-normal--*-120-*-*-*-*-*-*'; my $mw = MainWindow->new(); my $zinc = $mw->Zinc(-width => 900, -height => 700, -font => "10x20", # usually fonts are sets in resources # but for this example it is set in the + code! -borderwidth => 3, -relief => 'sunken',-backcolor=>'white +' )->pack; $i=0; #DECLARACION DE VARIABLES $b=pdl[1..1000]; $array2=pdl[[1],[1..1000]]; $file='D:\perl\download\prueba.sgy'; $[ = 1; open (IN,$file); binmode(IN); read (IN,$buf,3200); if (read (IN,$buf,400)){ $dsr = substr ($buf,17,2) ; $sr = unpack ( "n" , $dsr); $dsample = substr ($buf,21,2) ; $sample = unpack ( "n" , $dsample); $dcode= substr ($buf,25,2) ; $code = unpack ( "n" , $dcode); if ($code>4) { $code=1; } $btr=4; if ($code==3){$btr=2;} } $pertrace=($sample*$btr)+240; $bt=($pertrace-240)/4; $t=0; $m=0; $trace_value=pdl[1..10000]; $b=pdl[[1],[1..10000]]; #open (data,'>d:\perl\beta\dumpnum4.txt'); while (read (IN,$buf,$pertrace)) { $[ = 1; for ($i=0;$i<$bt;$i++) { $bit_string=unpack("B*",substr($buf,241+$i*4,4)); set $trace_value,$i,(conv_bit_string_2_ibm32float($bit_string)); } for ($i=0;$i<$bt;$i++) { $[ = 0; $array2[0][2*$i+1]=($i/4)+20; #eje de tiempo $array2[0][2*$i]=$trace_value->at($i)+30+$t*4; #valor de la ampl +itud # $m++; } $b=$zinc->add('curve',1,@array2,-filled=>1,-fillrule=>'negative'); $t++; #cuenta la cantidad de trazas # $m=0; #reinicia los valores del tiempo. last if ($t>1); #esta instruccion no sera necesaria cuando se c +uenten todas las trazas } close IN; #close data; # $b=$zinc->add('curve',1,@array2,-filled=>1,-fillrule=>'negative') +; MainLoop; sub conv_bit_string_2_ibm32float { $aux=$_[0]; $aux = shift; @aux2=$aux; $first_digit = substr($aux, 0, 1); $sign_bit = (-1)**$first_digit; $bin_exponent = substr($aux, 1, 7); $exponent = bin2dec($bin_exponent); $bin_fraction = substr($aux, 8, 24); @bit_chars = unpack("A1" x length($bin_fraction), $bin_fraction); $place_holder = -1; $fraction = 0; foreach $bit ( @bit_chars ) { $fraction += $bit * (2 ** $place_holder); $place_holder += -1; } $ibm_float = (($sign_bit) * (16 ** ($exponent - 64))*($fraction))/3000 +; return $ibm_float; } sub bin2dec { return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: graphic a segy file
by BrowserUk (Patriarch) on May 14, 2005 at 13:11 UTC | |
|
Re: graphic a segy file
by dynamo (Chaplain) on May 13, 2005 at 23:09 UTC | |
by merlyn (Sage) on May 13, 2005 at 23:11 UTC | |
by dynamo (Chaplain) on May 13, 2005 at 23:14 UTC | |
|
Re: graphic a segy file
by zentara (Cardinal) on May 14, 2005 at 12:14 UTC | |
by dorian (Novice) on May 18, 2005 at 17:06 UTC |