looks results from the CPAN

App-SeismicUnixGui

	   
	   Modeling of Traveltime (T-X) Curves
	    
	   LDG:146O , 1984-1989
	   BOIGM, 1993
	   Depto. de Geofisica, U. de Chile, 1996-**
	    
	   Computations are carried out for a model consisting
	   of a mixture of horizontal constant velocity, and
   	  constant velocity gradient layers.Low velocity zones
	   can be included. Each layer is specified by its top
       and bottom velocity. Rays are traced using equispaced
	   ray parameterss.
	    
	   Data traces are presented  as a grey scale plot.
	   
	   TODO: _Vbot vs. _Vbot_current may confuse
	   key _Vbot is used only initially herein
	   _Vbot_current is the latest value in the gui
	   
	   The following order of operations is needed
	   to prevent the fortran programs from quickly 
	   reading the change (yes) BEFORE the options
	   and values are written out.
	   
	  _setVtop( $immodpg->{_Vtop_current} );
	  _set_option($changeVtop_opt);
	  _set_change($yes);
	   

=head4 
 Examples

=head3 

=head4 CHANGES and their DATES

V0.2 April 4, 2021

April 2021: controlled data input errors
Added model values to namespace of immodpg.pm


=cut

use Moose;
our $VERSION = '0.0.2';

use aliased 'App::SeismicUnixGui::misc::L_SU_global_constants';
use aliased 'App::SeismicUnixGui::configs::big_streams::Project_config';
use aliased 'App::SeismicUnixGui::configs::big_streams::immodpg_config';
use aliased 'App::SeismicUnixGui::big_streams::immodpg_global_constants';
use aliased 'App::SeismicUnixGui::sunix::header::header_values';
use aliased 'App::SeismicUnixGui::misc::manage_files_by2';
use App::SeismicUnixGui::misc::control '0.0.3';
use aliased 'App::SeismicUnixGui::misc::control';
use aliased 'App::SeismicUnixGui::messages::message_director';
use aliased 'App::SeismicUnixGui::specs::big_streams::immodpg_spec';
use aliased 'App::SeismicUnixGui::sunix::shell::xk';

use Scalar::Util qw(looks_like_number);

=pod 
instantiate modules

=cut

my $Project        = Project_config->new();
my $get_L_SU       = L_SU_global_constants->new();
my $get_immodpg    = immodpg_global_constants->new();
my $immodpg_config = immodpg_config->new();
my $immodpg_spec   = immodpg_spec->new();

my $var_L_SU          = $get_L_SU->var();
my $var_immodpg       = $get_immodpg->var();
my $IMMODPG           = $Project->IMMODPG();
my $IMMODPG_INVISIBLE = $Project->IMMODPG_INVISIBLE();

my $empty_string            = $var_L_SU->{_empty_string};
my $yes                     = $var_L_SU->{_yes};
my $no                      = $var_L_SU->{_no};
my $on                      = $var_L_SU->{_on};
my $off                     = $var_L_SU->{_off};
my $global_libs             = $get_L_SU->global_libs();
my $immodpg_model_file_text = $var_immodpg->{_immodpg_model_file_text};
my $immodpg_model           = $var_immodpg->{_immodpg_model};

=head2 private anonymous array

=cut

my $immodpg = {
	_Vbot                              => '',
	_VbotEntry                         => '',
	_Vbot_current                      => '',
	_Vbot_default                      => '',
	_Vbot_multiplied                   => '',
	_Vbot_prior                        => '',
	_Vbot_upper_layer                  => '',
	_Vbot_upper_layerEntry             => '',
	_Vbot_upper_layer_current          => '',
	_Vbot_upper_layer_default          => '',
	_Vbot_upper_layer_prior            => '',
	_Vincrement                        => '',
	_VincrementEntry                   => '',
	_Vincrement_current                => '',
	_Vincrement_default                => '',
	_Vincrement_prior                  => '',
	_Vtop                              => '',
	_Vtop_current                      => '',
	_Vtop_prior                        => '',
	_Vtop_lower_layer_current          => '',
	_Vtop_lower_layer                  => '',
	_Vtop_lower_layer_prior            => '',
	_Vtop_multiplied                   => '',
	_VbotNtop_factor                   => '',
	_VbotNtop_factorEntry              => '',
	_VbotNtop_factor_current           => '',
	_VbotNtop_factor_default           => '',
	_VbotNtop_factor_prior             => '',
	_base_file_name                    => '',

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

			# when user enters Entry widget
			$in_thickness_increment_m      = $yes;
			$outside_thickness_increment_m = $no;

			# reset module values for convenience of renaming
			$immodpg->{_in_thickness_increment_m} = $in_thickness_increment_m;
			$immodpg->{_outside_thickness_increment_m} =
			  $outside_thickness_increment_m;
			$immodpg->{_thickness_increment_m_current} =
			  $thickness_increment_m_current;
			$immodpg->{_thickness_increment_m_prior} =
			  $thickness_increment_m_prior;
			return ();

		}
		else {
			return ();
			print("immodpg, _check_thickness_increment_m, unexpected values\n");
		}

	}
	else {
		print("immodpg, _check_thickness_increment_m, missing widget\n");
		return ();
	}
}

=head2 sub _get_control
find corrected value

=cut

sub _get_control {
	my ($self) = @_;

	my $result;

	if ( length( $immodpg->{_control_value} ) ) {

		$result = $immodpg->{_control_value};

	}
	else {
		print("immodpg, _get_control, unexpected value\n");
	}
	return ($result);
}

#=head2 sub _get_control_VbotNtop_factor
#adjust  bad VbotNtop_factor value
#set defaults
#
#=cut
#
#	sub _get_control_VbotNtop_factor {
#
#		my ($self) = @_;
#
#		my $result;
#
#		if ( not( looks_like_number( $immodpg->{_control_VbotNtop_factor} ) ) ) {
#
#			$immodpg->{_VbotNtop_factor_current} = $immodpg->{_VbotNtop_factor_default};
#			$immodpg->{_VbotNtop_factor_prior}   = $immodpg->{_VbotNtop_factor_default};
#			$immodpg->{_VbotNtop_factorEntry}->delete( 0, 'end' );
#			$immodpg->{_VbotNtop_factorEntry}->insert( 0, $immodpg->{_VbotNtop_factor_current} );
#			$immodpg->{_isVbotNtop_factor_changed_in_gui} = $no,;
#
#		} else {
#			print("immodpg, _get_control_VbotNtop_factor,  bad value\n");
#		}
#
#		return ();
#	}

=head2 sub _get_control_clip
adjust clip value

=cut

sub _get_control_clip {

	my ($self) = @_;

	my $result;

	if ( length( $immodpg->{_control_clip} ) ) {

#		print("1. immodpg, _get_control_clip, old control_clip= $immodpg->{_control_clip}\n");
		my $control_clip = $immodpg->{_control_clip};

		if ( $control_clip <= 0 ) {

			# case 1 layer number exceeds possible value
			$control_clip = 1;
			$result       = $control_clip;

		}
		else {

			#			print("immodpg, _get_control_clip, NADA\n");
			$result = $control_clip;
		}

   #		print("2. immodpg, _get_control_clip, new control_clip= $control_clip\n");
		return ($result);

	}
	else {
		print("immodpg, _get_control_clip,  missing clip value\n");
	}
	return ();
}

=head2 sub _get_control_layer
adjust layer number

=cut

sub _get_control_layer {

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


=cut

sub _get_number_of_layers {

	my ($self) = @_;
	my $number_of_layers;

	if ( length( $immodpg->{_model_file_text} ) ) {

		my $count        = 0;
		my $magic_number = 4;
		my $inbound_model_file_text =
		  $IMMODPG . '/' . $immodpg->{_model_file_text};

# print ("immodpg,_get_number_of_layers,inbound_model_file_text=$inbound_model_file_text\n");

		open( my $fh, '<', $inbound_model_file_text );

		while (<$fh>) {

			$count++;

		}
		close($fh);

		$number_of_layers = $count - $magic_number;

	  #			print("immodpg,_get_number_of_layers, layers = $number_of_layers \n");

	}
	else {

		#		print("immodpg,_get_number_of_layers, missing values\n");
		$number_of_layers = 0;
	}

	my $result = $number_of_layers;
	return ($result);
}

=head2 sub _getVp_ref_dz_ref
Collect the currently update
values in the model for
layers and their velocities and 
thicknesses

=cut

sub _getVp_ref_dz_ref {

	my ($self) = @_;

	my @VPtop = @{ $immodpg->{_refVPtop} };
	my @VPbot = @{ $immodpg->{_refVPbot} };
	my @dz    = @{ $immodpg->{_ref_dz} };
	my $layer = $immodpg->{_model_layer_number};

	#	 print("immodpg,_getVp_ref_dz_ref layer_number = $layer \n");

	if (    looks_like_number($layer)
		and scalar(@VPtop)
		and scalar(@VPbot)
		and scalar(@dz) )
	{

		return ( \@VPtop, \@VPbot, \@dz );

	}
	else {
		print("immodpg,_getVp_ref_dz_ref , unexpected value\n");
		return ();
	}

}

=head2 sub _getVp_ref_dz_scalar
Collect the currently update
values in the model for
layers and their velocities and 
thicknesses

=cut

sub _getVp_ref_dz_scalar {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_model_layer_number} ) ) {

		my ( $_thickness_m_upper_layer, $Vbot_lower_layer );
		my ( @V,                        @result );

		my $layer = $immodpg->{_model_layer_number};

		#			print("immodpg,_getVp_ref_dz_scalar layer_number = $layer \n");

		my @VPtop = @{ $immodpg->{_refVPtop} };
		my @VPbot = @{ $immodpg->{_refVPbot} };
		my @dz    = @{ $immodpg->{_ref_dz} };

		#		$error_switch		= $immodpg->{_error_switch};

		if (    scalar(@VPtop)
			and scalar(@VPbot)
			and scalar(@dz) )
		{

# print("immodpg,_getVp_ref_dz_scalar VPtop= $VPtop[($layer-1)]\n");
# print("immodpg,_getVp_ref_dz_scalar for layer:($layer), VPbot= $VPbot[($layer-1)]\n");

			my $layer_index             = $layer - 1;
			my $layer_index_upper_layer = $layer - 2;
			my $layer_index_lower_layer = $layer;

			# For all cases
			my $Vtop = $VPtop[$layer_index];
			my $Vbot = $VPbot[$layer_index];
			my $dz   = $dz[$layer_index];

			if ( $layer >= 2 ) {

				# CASE of second of two or more layers
				my $Vbot_upper_layer = $VPbot[$layer_index_upper_layer];
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

				@result = @V;

				# print("immodpg,_getVp_ref_dz_scalar: velocities are:  @V \n");
				return ( \@result, $dz );

				#				return ( \@result, $dz, $error_switch );

			}
			elsif ( $layer >= 1 ) {

				# CASE of first of one or more layers
				my $Vbot_upper_layer = $empty_string;
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

				@result = @V;

				#				return ( \@result, $dz, $error_switch );
				return ( \@result, $dz );
			}
			else {
				print(
					"immodpg, _getVp_ref_dz_scalar, unexpected layer number \n"
				);
				return ();
			}
		}
		else {
			return ();
			print(
"immodpg,_getVp_ref_dz_scalar, _get_initial_model gives bad values\ n"
			);
		}

	}
	else {
		print("immodpg,_getVp_ref_dz_scalar,missing layer\n");
		return ();
	}
	return ();

}

=head2 sub _get_initialVp_dz4gui

=cut

sub _get_initialVp_dz4gui {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_model_layer_number} ) ) {

		my ( $_thickness_m_upper_layer, $Vbot_lower_layer );
		my ( @V,                        @result );

		my $layer = $immodpg->{_model_layer_number};
		my ( $refVPtop, $refVPbot, $ref_dz, $error_switch ) =
		  _get_initial_model4gui();

		if (    length($refVPtop)
			and length($refVPbot)
			and length($ref_dz)
			and length($error_switch) )
		{

			my @VPtop = @$refVPtop;
			my @VPbot = @$refVPbot;
			my @dz    = @$ref_dz;

			#		print("immodpg,_get_initialVp_dz4gui VPtop= @VPtop\n");
			#		print("immodpg,_get_initialVp_dz4gui VPbot= @VPbot\n");
			#		print("immodpg,_get_initialVp_dz4gui layer_number = $layer \n");

			my $layer_index             = $layer - 1;
			my $layer_index_upper_layer = $layer - 2;
			my $layer_index_lower_layer = $layer;

			# For all cases
			my $Vtop = $VPtop[$layer_index];
			my $Vbot = $VPbot[$layer_index];
			my $dz   = $dz[$layer_index];

			if ( $layer >= 2 ) {

				# CASE of second of two or more layers
				my $Vbot_upper_layer = $VPbot[$layer_index_upper_layer];
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

				@result = @V;

			  #			print("immodpg_get_initialVp_dz4gui: velocities are:  @V \n");
				return ( \@result, $dz, $error_switch );

			}
			elsif ( $layer >= 1 ) {

				# CASE of first of one or more layers
				my $Vbot_upper_layer = $empty_string;
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

				@result = @V;

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

		print("immodpg,_get_initialVp_dz4gui,missing layer\\n");
		return ();
	}
	return ();

}

=head2 sub _messages
Show warnings or errors in a message box
Message box is defined in main where it is
also made invisible (withdraw)
Here we turn on the message box (deiconify, raise)
The message does not release the program
until OK is clicked and wait variable changes from yes 
to no.

=cut

sub _messages {

	my ( $run_name, $number ) = @_;

	my $run_name_message = message_director->new();
	my $message          = $run_name_message->immodpg($number);

	my $message_box       = $immodpg->{_message_box_w};
	my $message_label     = $immodpg->{_message_label_w};
	my $message_box_wait  = $immodpg->{_message_box_wait};
	my $message_ok_button = $immodpg->{_message_ok_button};

	# print("1 immodpg,_messages, message_box=$message_box\n");

	$message_box->title($run_name);

	$message_label->configure( -textvariable => \$message, );

	$message_box->deiconify();
	$message_box->raise();
	$message_ok_button->waitVariable( \$message_box_wait );
	return ();
}

=head2 sub _setVbot

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files

=cut

sub _setVbot {
	my ($Vbot) = @_;

	if ( looks_like_number($Vbot)
		&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
	{

=head2 instantiate classes

=cut

		my $files   = manage_files_by2->new();
		my $control = control->new();

=head2 Define local
variables

=cut		

		my @X;
		my $Vbot_file = $immodpg->{_Vbot_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $Vbot_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $Vbot;
				$format = $var_immodpg->{_format_real};
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);
				$test = $yes;

			}    # if
		}    # for

	}
	elsif ( $immodpg->{_isVbot_changed_in_gui} eq $no ) {

		# NADA

	}
	else {
		print("immodpg, _setVbot, unexpected answer\n");
	}

	return ();
}

=head2 sub _setVbot_upper_layer

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


=head2 Define local
variables

=cut		

		my @X;
		my $VbotNtop_factor_file = $immodpg->{_VbotNtop_factor_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $VbotNtop_factor_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $VbotNtop_factor;
				$format = '  0.0';
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);
				$test = $yes;

			}    # if
		}    # for

	}
	elsif ( $immodpg->{_isVbotNtop_factor_changed_in_gui} eq $no ) {

		# NADA

	}
	else {
		print("immodpg, _setVbotNtop_factor, unexpected answer\n");
	}

	return ();
}

=head2 sub _setVbotNtop_multiply
Verify another lock file does not exist and
only then:
Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files
_setVbotNtop_multiply

=cut

sub _setVbotNtop_multiply {
	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_Vbot_multiplied} )
		&& looks_like_number( $immodpg->{_Vtop_multiplied} )
		&& looks_like_number( $immodpg->{_Vbot_current} )
		&& looks_like_number( $immodpg->{_Vtop_current} ) )
	{

=head2 instantiate classes

=cut

		my $files   = manage_files_by2->new();
		my $control = control->new();

=head2 Define local
variables

=cut		

		my @X;
		my $file = $immodpg->{_VbotNtop_multiply_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0]   = $immodpg->{_Vbot_multiplied};
				$X[1]   = $immodpg->{_Vtop_multiplied};
				$format = $var_immodpg->{_format_real};
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);
				$test = $yes;

			}    # if
		}    # for

	}
	else {
		print("immodpg, _setVbotNtop_multiply, unexpected answer\n");
	}

	return ();
}

=head2 sub _setVincrement

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


  # print("immodpg, _setVp_dz,Vbot,VPbot[$layer_index]=$VPbot[$layer_index]\n");
			$immodpg->{_refVPbot} = \@VPbot;

		}
		elsif ( $name eq 'Vbot_upper_layer' ) {

			my $refVPbot = $immodpg->{_refVPbot};
			my @VPbot    = @$refVPbot;
			$VPbot[ ( $layer_index - 1 ) ] = $value;

# print("immodpg, _setVp_dz,Vbot_upper_layer,VPbot[($layer_index-1)]=$VPbot[($layer_index-1)]\n");
			$immodpg->{_refVPbot} = \@VPbot;

		}
		elsif ( $name eq 'thickness_m' ) {

			my $ref_dz = $immodpg->{_ref_dz};
			my @dz     = @$ref_dz;
			$dz[$layer_index] = $value;

		# print("immodpg, _setVp_dz, dz: dz[$layer_index]=$dz[$layer_index]\n");
			$immodpg->{_ref_dz} = \@dz;

		}
		else {
			print("immodpg,_setVp_dz, unexpected name \n");
		}
	}
	else {
		print("immodpg, _setVp_dz, missing variable\n");
		print("immodpg, _setVp_dz, name=$name\n");
		print("immodpg, _setVp_dz, value = $value\n");
		print("immodpg, _setVp_dz, _refVPtop = @{$immodpg->{_refVPtop}}\n");
		print("immodpg, _setVp_dz, _refVPbot = @{$immodpg->{_refVPbot}}\n");
		print("immodpg, _setVp_dz, _dz = $immodpg->{_dz}\n");
	}

	return ();
}

=head2 sub _setVtop

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files

=cut

sub _setVtop {

	my ($Vtop) = @_;

	if ( looks_like_number($Vtop)
		&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
	{

		# print("immodpg,_setVtop,write out fortran value of Vtop\n");

=head2 instantiate classes

=cut

		my $files   = manage_files_by2->new();
		my $control = control->new();

=head2 Define local
variables

=cut		

		my @X;
		my $Vtop_file = $immodpg->{_Vtop_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $Vtop_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $Vtop;
				$format = $var_immodpg->{_format_real};
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);
				$test = $yes;

			}    # if
		}    # for

	}
	elsif ( $immodpg->{_isVtop_changed_in_gui} eq $no ) {

		# NADA
		print("immodpg, _setVtop, no change\n");

	}
	else {
		print("immodpg, _setVtop, unexpected answer\n");
	}

	return ();
}

=head2 sub _setVtop_lower_layer

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files

=cut

sub _setVtop_lower_layer {
	my ($Vtop_lower_layer) = @_;

	if ( looks_like_number($Vtop_lower_layer)
		&& $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes )
	{

=head2 instantiate classes

=cut

		my $files   = manage_files_by2->new();
		my $control = control->new();

=head2 Define local
variables

=cut		

		my @X;
		my $Vtop_lower_layer_file = $immodpg->{_Vtop_lower_layer_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $Vtop_lower_layer_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $Vtop_lower_layer;
				$format = $var_immodpg->{_format_real};
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);
				$test = $yes;

			}    # if
		}    # for

	}
	elsif ( $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $no ) {

		# NADA

	}
	else {
		print("immodpg, _setVtop_lower_layer, unexpected answer\n");
	}

	return ();
}

=head2 sub _set_change

Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


=head2 Define local
variables

=cut		

		my @X;
		my $option_file = $immodpg->{_option_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $option_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			# print("immodpg,_set_option, in loop \n");

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $option;
				$format = $var_immodpg->{_format2i};

#				print("2.immodpg,_set_option,option:$option\n");
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);

				$test = $yes;
			}    # if
		}    # for

	}
	elsif ( $immodpg->{_is_option_changed} eq $no ) {
		# NADA
	}
	else {
		print("immodpg, _set_option, unexpected answer\n");
	}
	return ();
}

=head2 sub _updateVbot

keep tabs on Vbot values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

use App::SeismicUnixGui::misc::control '0.0.3' method to check for bad values;

=cut

sub _updateVbot {

	my ($self) = @_;

	if (    looks_like_number( $immodpg->{_Vbot_current} )
		and looks_like_number( $immodpg->{_Vbot_prior} )
		&& $immodpg->{_Vbot_current} != $immodpg->{_Vbot_prior} )
	{

		# CASE Vbot has changed
		$immodpg->{_isVbot_changed_in_gui} = $yes;
		$immodpg->{_Vbot_prior}            = $immodpg->{_Vbot_current};

	 # print("immodpg, _updateVbot, has changed\n");
	 # print("1. immodpg,_updateVbot,Vbot_current=$immodpg->{_Vbot_current}\n");
	 # print("1. immodpg,_updateVbot,Vbot_prior=$immodpg->{_Vbot_prior}\n");

		_set_control( 'Vbot', $immodpg->{_Vbot_current} );
		$immodpg->{_Vbot_current} = _get_control('Vbot');

		_setVp_dz( 'Vbot', $immodpg->{_Vbot_current} );

		return ();

	}
	elsif ( $immodpg->{_Vbot_current} == $immodpg->{_Vbot_prior} ) {

		# CASE Vbot is unchanged
		# print("immodpg, _updateVbot, unchanged\n");
		$immodpg->{_isVbot_changed_in_gui} = $no;

	 # print("2. immodpg,_updateVbot,Vbot_current=$immodpg->{_Vbot_current}\n");
	 # print("2. immodpg,_updateVbot,Vbot_prior=$immodpg->{_Vbot_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVbot, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbot_upper_layer

keep tabs on upper layer Vbottom values
and changes in the values in the 
GUI
current layer must >0

=cut

sub _updateVbot_upper_layer {

	my ($self) = @_;

#	print("mmodpg, _updateVbot_upper_layer, Vbot_upper_layer_current=..$immodpg->{_Vbot_upper_layer_current}..\n");
	if (   looks_like_number( $immodpg->{_Vbot_upper_layer_current} )
		&& $immodpg->{_layer_current} > 0
		&& $immodpg->{_Vbot_upper_layer_current} !=
		$immodpg->{_Vbot_upper_layer_prior} )
	{

		# CASE Vbot_upper_layer changed
		$immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
		$immodpg->{_Vbot_upper_layer_prior} =
		  $immodpg->{_Vbot_upper_layer_current};

# print("immodpg, _updateVbot_upper_layer, updated to $immodpg->{_Vbot_upper_layer_current}\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_current=$immodpg->{_Vbot_upper_layer_current}\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		_set_control( 'Vbot_upper_layer',
			$immodpg->{_Vbot_upper_layer_current} );
		$immodpg->{_Vbot_upper_layer_current} =
		  _get_control('Vbot_upper_layer');

		_setVp_dz( 'Vbot_upper_layer', $immodpg->{_Vbot_upper_layer_current} );
		return ();

	}
	elsif ( looks_like_number( $immodpg->{_Vbot_upper_layer_current} )
		&& $immodpg->{_Vbot_upper_layer_current} ==
		$immodpg->{_Vbot_upper_layer_prior} )
	{

		# CASE Vbot_upper_layer is unchanged
		# print("immodpg, _updateVbot_upper_layer, unchanged\n");
		$immodpg->{_isVbot_upper_layer_changed_in_gui} = $no;

# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		return ();

	}
	elsif ( not( looks_like_number( $immodpg->{_Vbot_upper_layer_current} ) ) )
	{

# CASE Vbot_upper_layer is unchanged
#		print("immodpg, _updateVbot_upper_layer, no value in Vbot_upper_layer NADA\n");
# print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_prior=$immodpg->{_Vbot_upper_layer_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVbot_upper_layer, unexpected\n");

#		print("immodpg,_updateVbot_upper_layer,Vbot_upper_layer_current=$immodpg->{_Vbot_upper_layer_current}\n");
		return ();
	}
}

=head2 sub _update_Vincrement

keep tabs on Vincrement values
and changes in the values in the  
GUI

=cut

sub _updateVincrement {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vincrement_current} )
		&& $immodpg->{_Vincrement_current} != $immodpg->{_Vincrement_prior} )
	{

		# CASE Vincrement changed
		$immodpg->{_Vincrement_current} = $immodpg->{_Vincrement_current};
		$immodpg->{_isVincrement_changed_in_gui} = $yes;

# print("immodpg, _updateVincrement, updated to $immodpg->{_Vincrement_current}\n");

#		print("immodpg,_updateVincrement,Vincrement_current=$immodpg->{_Vincrement_current}\n");
#		print("immodpg,_updateVincrement,Vincrement_prior=$immodpg->{_Vincrement_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_Vincrement_current} == $immodpg->{_Vincrement_prior} ) {

		# CASE Vincrement is unchanged
		# print("immodpg, _updateVincrement, unchanged\n");
		$immodpg->{_isVincrement_changed_in_gui} = $no;

# print("immodpg,_updateVincrement,Vincrement_current=$immodpg->{_Vincrement_current}\n");
# print("immodpg,_updateVincrement,Vincrement_prior=$immodpg->{_Vincrement_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVincrement, unexpected\n");
		return ();
	}
}

=head2 sub _updateVtop

keep tabs on Vtop values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVtop {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vtop_current} )
		&& $immodpg->{_Vtop_current} != $immodpg->{_Vtop_prior} )
	{

		# CASE Vtop changed
		$immodpg->{_isVtop_changed_in_gui} = $yes;
		$immodpg->{_Vtop_prior}            = $immodpg->{_Vtop_current};

	   #		print("immodpg, _updateVtop, updated to $immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_current=$immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_prior=$immodpg->{_Vtop_prior}\n");

		_set_control( 'Vtop', $immodpg->{_Vtop_current} );
		$immodpg->{_Vtop_current} = _get_control('Vtop');
		_setVp_dz( 'Vtop', $immodpg->{_Vtop_current} );

		return ();

	}
	elsif ( $immodpg->{_Vtop_current} == $immodpg->{_Vtop_prior} ) {

		# CASE Vtop is unchanged
		#		print("immodpg, _updateVtop, unchanged\n");
		$immodpg->{_isVtop_changed_in_gui} = $no;

	   #		print("immodpg,_updateVtop,Vtop_current=$immodpg->{_Vtop_current}\n");
	   #		print("immodpg,_updateVtop,Vtop_prior=$immodpg->{_Vtop_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVtop, unexpected\n");
		return ();
	}
}

=head2 sub _updateVtop_lower_layer

keep tabs on Vtop_lower_layer values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVtop_lower_layer {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_Vtop_lower_layer_current} )
		&& $immodpg->{_Vtop_lower_layer_current} !=
		$immodpg->{_Vtop_lower_layer_prior} )
	{

# CASE Vtop changed
#		print("immodpg, _updateVtop_lower_layer, Vcurrent=$immodpg->{_Vtop_lower_layer_current}\n");
		$immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
		$immodpg->{_Vtop_lower_layer_prior} =
		  $immodpg->{_Vtop_lower_layer_current};

		#		print("immodpg, _updateVtop_lower_layer, changed\n");
		_set_control( 'Vtop_lower_layer',
			$immodpg->{_Vtop_lower_layer_current} );
		$immodpg->{_Vtop_lower_layer_current} =
		  _get_control('Vtop_lower_layer');

		_setVp_dz( 'Vtop_lower_layer', $immodpg->{_Vtop_lower_layer_current} );

		return ();

	}
	elsif ( $immodpg->{_Vtop_lower_layer_current} ==
		$immodpg->{_Vtop_lower_layer_prior} )
	{

# CASE Vtop_lower_layer is unchanged
#		print("immodpg, _updateVtop_lower_layer, unchanged\n");
#		print("immodpg, _updateVtop_lower_layer, Vcurrent=$immodpg->{_Vtop_lower_layer_current}\n");
		$immodpg->{_isVtop_lower_layer_changed_in_gui} = $no;

		return ();

	}
	else {
		print("immodpg, _updateVtop_lower_layer, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbotNtop_factor

keep tabs on VbotNtop_factor  values
and changes in the values in the  
GUI

=cut

sub _updateVbotNtop_factor {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_VbotNtop_factor_current} )
		&& $immodpg->{_VbotNtop_factor_current} !=
		$immodpg->{_VbotNtop_factor_prior} )
	{

# CASE VbotNtop_factor changed
#			$immodpg->{_VbotNtop_factor_current}          = $immodpg->{_VbotNtop_factor_current};
		_set_control( 'VbotNtop_factor', $immodpg->{_VbotNtop_factor_current} );
		$immodpg->{_VbotNtop_factor_current} = _get_control('VbotNtop_factor');
		$immodpg->{_isVbotNtop_factor_changed_in_gui} = $yes;

#			print("immodpg, _updateVbotNtop_factor, updated to $immodpg->{_VbotNtop_factor_current}\n");
#			print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_current=$immodpg->{_VbotNtop_factor_current}\n");
#			print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_prior=$immodpg->{_VbotNtop_factor_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_VbotNtop_factor_current} ==
		$immodpg->{_VbotNtop_factor_prior} )
	{

		# CASE VbotNtop_factor is unchanged
		# print("immodpg, _updateVbotNtop_factor, unchanged\n");
		$immodpg->{_isVbotNtop_factor_changed_in_gui} = $no;

# print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_current=$immodpg->{_VbotNtop_factor_current}\n");
# print("immodpg,_updateVbotNtop_factor,VbotNtop_factor_prior=$immodpg->{_VbotNtop_factor_prior}\n");
		return ();

	}
	else {
		print("immodpg, _updateVbotNtop_factor, unexpected\n");
		return ();
	}
}

=head2 sub _updateVbotNtop_multiply

keep tabs on Vbot AND Vtop values together
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _updateVbotNtop_multiply {

	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_Vbot_current} )
		&& looks_like_number( $immodpg->{_Vtop_current} )
		&& looks_like_number( $immodpg->{_Vbot_multiplied} )
		&& looks_like_number( $immodpg->{_Vtop_multiplied} ) )
	{

		$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
		$immodpg->{_Vbot_current} = $immodpg->{_Vbot_multiplied};

		$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
		$immodpg->{_Vtop_current} = $immodpg->{_Vtop_multiplied};

		_set_control( 'Vbot', $immodpg->{_Vbot_current} );
		$immodpg->{_Vbot_current} = _get_control('Vbot');

		_set_control( 'Vtop', $immodpg->{_Vtop_current} );
		$immodpg->{_Vtop_current} = _get_control('Vtop');

		# conveniently short variable names
		my $Vtop_current = $immodpg->{_Vtop_current};
		my $Vbot_current = $immodpg->{_Vbot_current};

		$immodpg->{_VtopEntry}->delete( 0, 'end' );
		$immodpg->{_VtopEntry}->insert( 0, $Vtop_current );
		$immodpg->{_VbotEntry}->delete( 0, 'end' );
		$immodpg->{_VbotEntry}->insert( 0, $Vbot_current );

# print("immodpg, _updateVbotNtop_multiply, updated to $immodpg->{_VbotNtop_multiply_current}\n");
# print("immodpg,_updateVbotNtop_multiply,VbotNtop_multiply_current=$immodpg->{_VbotNtop_multiply_current}\n");
# print("immodpg,_updateVbotNtop_multiply,VbotNtop_multiply_prior=$immodpg->{_VbotNtop_multiply_prior}\n");
#			_checkVbot(); #todo
		_updateVbot();

		#			_checkVtop(); #todo
		_updateVtop();

	}
	else {
		print("immodpg, _updateVbotNtop_factor, unexpected\n");
		return ();
	}
}

=head2 sub _update_clip

keep tabs on clip values
and changes in the values in the  
GUI

=cut

sub _update_clip {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_clip4plot_current} )
		&& $immodpg->{_clip4plot_current} != $immodpg->{_clip4plot_prior} )
	{

		# CASE clip changed
		$immodpg->{_clip4plot_current}      = $immodpg->{_clip4plot_current};
		$immodpg->{_is_clip_changed_in_gui} = $yes;

# print("immodpg, _update_clip, updated to $immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_current=$immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_prior=$immodpg->{_clip4plot_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_clip4plot_current} == $immodpg->{_clip4plot_prior} ) {

		# CASE clip4plot  is unchanged
		# print("immodpg, _update_clip, unchanged\n");
		$immodpg->{_is_clip_changed_in_gui} = $no;

# print("immodpg,_update_clip,clip4plot_current=$immodpg->{_clip4plot_current}\n");
# print("immodpg,_update_clip,clip4plot_prior=$immodpg->{_clip4plot_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_clip, unexpected\n");
		return ();
	}
}

=head2 sub _update_thickness_m

keep tabs on thickness_m values
and changes in the values in the  
GUI
Also updates an shared copy
of the model properties

=cut

sub _update_thickness_m {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_thickness_m_current} )
		&& $immodpg->{_thickness_m_current} != $immodpg->{_thickness_m_prior} )
	{

		# CASE _thickness_m changed
		$immodpg->{_is_thickness_m_changed_in_gui} = $yes;

# print("immodpg, _update_thickness_m, updated to $immodpg->{_thickness_m_current}\n");
#	print("immodpg,_update_thickness_m,_thickness_m_current=$immodpg->{_thickness_m_current}\n");
# print("immodpg,_update_thickness_m,_thickness_m_prior=$immodpg->{_thickness_m_prior}\n");

		_set_control( 'thickness_m', $immodpg->{_thickness_m_current} );
		$immodpg->{_thickness_m_current} = _get_control('thickness_m');
		_setVp_dz( 'thickness_m', $immodpg->{_thickness_m_current} );

		return ();

	}
	elsif ( $immodpg->{_thickness_m_current} == $immodpg->{_thickness_m_prior} )
	{

		# CASE _thickness_m is unchanged
		# print("immodpg, _update_thickness_m, unchanged\n");
		$immodpg->{_is_thickness_m_changed_in_gui} = $no;

# print("immodpg,_update_thickness_m,_thickness_m_current=$immodpg->{_thickness_m_current}\n");
# print("immodpg,_update_thickness_m,_thickness_m_prior=$immodpg->{_thickness_m_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_thickness_m, unexpected\n");
		return ();
	}
}

=head2 sub _update_thickness_increment_m_in_gui

keep tabs on thickness_increment_m values
and changes in the values in the  
GUI

=cut

sub _update_thickness_increment_m_in_gui {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_thickness_increment_m_current} )
		&& $immodpg->{_thickness_increment_m_current} !=
		$immodpg->{_thickness_increment_m_prior} )
	{

		# CASE thickness changed
		$immodpg->{_thickness_increment_m_prior} =
		  $immodpg->{_thickness_increment_m_current};
		$immodpg->{_is_layer_changed_in_gui} = $yes;

# print("immodpg, _update_thickness_increment_m_in_gui, updated to $immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_current=$immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_prior=$immodpg->{_thickness_increment_m_prior}\n");
		return ();

	}
	elsif ( $immodpg->{_thickness_increment_m_current} ==
		$immodpg->{_thickness_increment_m_prior} )
	{

		# CASE thickness_increment_m is unchanged
		# print("immodpg, _update_thickness_increment_m_in_gui, unchanged\n");
		$immodpg->{_is_layer_changed_in_gui} = $no;

# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_current=$immodpg->{_thickness_increment_m_current}\n");
# print("immodpg,_update_thickness_increment_m_in_gui,thickness_increment_m_prior=$immodpg->{_thickness_increment_m_prior}\n");
		return ();

	}
	else {
		print("immodpg, _update_thickness_increment_m_in_gui, unexpected\n");
		return ();
	}
}

=head2 sub _update_layer_in_gui

keep tabs on layer values
and changes in the values in the  
GUI

update prior in advance of _check_layer

=cut

sub _update_layer_in_gui {

	my ($self) = @_;

	if (
		looks_like_number( $immodpg->{_layer_current} )
		and length(
			$immodpg->{_layer_prior} and length( $immodpg->{_layerEntry} )
		)
		and ( $immodpg->{_layer_current} != $immodpg->{_layer_prior} )
	  )
	{

		# CASE layer changed
		$immodpg->{_is_layer_changed_in_gui} = $yes;
		my $layer_current   = $immodpg->{_layer_current};
		my $new_layer_prior = $immodpg->{_layer_current};

		$immodpg->{_layerEntry}->delete( 0, 'end' );
		$immodpg->{_layerEntry}->insert( 0, $layer_current );

		$immodpg->{_layer_prior} = $new_layer_prior;

#		print("immodpg, _update_layer_in_gui, prior=$immodpg->{_layer_prior}current= $immodpg->{_layer_current}\n");

		return ();

	}
	elsif ( looks_like_number( $immodpg->{_layer_current} )
		and looks_like_number( $immodpg->{_layer_prior} )
		and ( $immodpg->{_layer_current} == $immodpg->{_layer_prior} ) )
	{

		# CASE layer has not changed
		#		print("immodpg, _update_layer_in_gui, unchanged\n");
		$immodpg->{_is_layer_changed_in_gui} = $no;

		$immodpg->{_layerEntry}->delete( 0, 'end' );
		$immodpg->{_layerEntry}->insert( 0, $immodpg->{_layer_current} );

#		print("immodpg,_update_layer_in_gui, prior=$immodpg->{_layer_prior},current=$immodpg->{_layer_current}\n");
		return ();

	}
	else {
		print("immodpg, _update_layer_in_gui, unexpected\n");
		return ();
	}
	return ();
}

=head2 sub _update_lower_layer_in_gui

keep tabs on lower_layer values
and changes in the values in the  
GUI

=cut

sub _update_lower_layer_in_gui {

	my ($self) = @_;

	if (   $immodpg->{_is_layer_changed_in_gui} eq $yes
		&& $immodpg->{_layer_current} >= 1 )
	{

		# CASE layer changed
		my $lower_layer   = $immodpg->{_layer_current} + 1;
		my $layer_current = ( $immodpg->{_lower_layerLabel} )
		  ->configure( -textvariable => \$lower_layer, );

		return ();

	}
	elsif ( $immodpg->{_is_layer_changed_in_gui} eq $no ) {

		# CASE layer is unchanged
		#		print("immodpg, _update_lower_layer_in_gui, unchanged\n");
		return ();

	}
	else {
		print("immodpg, _update_lower_layer_in_gui, unexpected\n");
		return ();
	}
}

=head2 sub _update_upper_layer_in_gui

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

	#    print("$simple_model_txt \n");

	if (   length($variables)
		&& length($format_title)
		&& length($format_values)
		&& length($simple_model_txt)
		&& length($number_of_layers) )
	{

=pod
declare private variables

=cut

		my ( @Vtop, @Vbot, @dz );
		my $file     = $simple_model_txt;
		my $outbound = $variables->{_CONFIG} . '/' . $file;

		my ( $Vtop_ref, $Vbot_ref, $dz_ref ) = _getVp_ref_dz_ref();
		@Vtop = @$Vtop_ref;
		@Vbot = @$Vbot_ref;
		@dz   = @$dz_ref;

		# print("immodpg,_getVp_ref_dz_ref; VPtop,VPbot,dz= @Vtop,@Vbot,@dz\n");

		open( OUT, ">$outbound" );
		printf OUT $format_title . "\n",
		  "    VPtop    VPbottom    thickness(m)";

		for ( my $i = 0 ; $i < $number_of_layers ; $i++ ) {
			print OUT ("     $Vtop[$i] \t$Vbot[$i]\t\t$dz[$i]\n");
		}

		close(OUT);

		#		print("immodpg,_write_simple_model_txt\n");

	}
	else {
		print("immodpg,_write_simple_model_txt, no output\n");
		print("variables             = $immodpg_spec->variables()\n");
		print(
"format_title         = $var_immodpg->{_model_text_file_format_title}\n"
		);
		print(
"format_values           = $var_immodpg->{_model_text_file_format_values}\n"
		);
		print("simple_model_txt     = $var_immodpg->{_simple_model_txt}\n");
		print("number_of_layers     = _get_number_of_layers()\n");
	}
}

=head2 sub get_initialVp_dz4gui

=cut

sub get_initialVp_dz4gui {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_model_layer_number} ) ) {

		my ( $_thickness_m_upper_layer, $Vbot_lower_layer );
		my ( @V,                        @result );

		my $layer = $immodpg->{_model_layer_number};

		my ( $refVPtop, $refVPbot, $ref_dz, $error_switch ) =
		  _get_initial_model();

		if (    length($refVPtop)
			and length($refVPbot)
			and length($ref_dz)
			and length($error_switch) )
		{

			my @VPtop = @$refVPtop;
			my @VPbot = @$refVPbot;
			my @dz    = @$ref_dz;

			#			print("immodpg,get_initialVp_dz4gui VPtop= @VPtop\n");
			#			print("immodpg,get_initialVp_dz4gui VPbot= @VPbot\n");
			#			print("immodpg,get_initialVp_dz4gui dz= @dz\n");
			#			print("immodpg,get_initialVp_dz4gui layer_number = $layer \n");

			my $layer_index             = $layer - 1;
			my $layer_index_upper_layer = $layer - 2;
			my $layer_index_lower_layer = $layer;

			# For all cases
			my $Vtop = $VPtop[$layer_index];
			my $Vbot = $VPbot[$layer_index];
			my $dz   = $dz[$layer_index];

			if ( $layer >= 2 ) {

				#	 CASE of second of two or more layers
				my $Vbot_upper_layer = $VPbot[$layer_index_upper_layer];
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

				@result = @V;

			#				print("immodpg, get_initialVp_dz4gui: velocities are:  @V \n");
				return ( \@result, $dz, $error_switch );

			}
			elsif ( $layer >= 1 ) {

				# CASE of first of one or more layers
				my $Vbot_upper_layer = $empty_string;
				my $Vtop_lower_layer = $VPtop[$layer_index_lower_layer];

				$V[0] = $Vbot_upper_layer;
				$V[1] = $Vtop;
				$V[2] = $Vbot;
				$V[3] = $Vtop_lower_layer;

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

	  $immodpg->{_Vtop_lower_layer_default};
	$immodpg->{_Vtop_lower_layer_prior} = $immodpg->{_Vtop_lower_layer_default};
	$immodpg->{_inVtop_lower_layer}     = $no;
	$immodpg->{_outsideVtop_lower_layer} = $yes;

	# default values for VbotNtop_factor-related variables
	$immodpg->{_VbotNtop_factor_default} = $immodpg->{_VbotNtop_factor};
	$immodpg->{_VbotNtop_factor_current} = $immodpg->{_VbotNtop_factor_default};
	$immodpg->{_VbotNtop_factor_prior}   = $immodpg->{_VbotNtop_factor_default};
	$immodpg->{_inVbotNtop_factor}       = $no;
	$immodpg->{_outsideVbotNtop_factor}  = $yes;

	# default values for clip-related variables
	$immodpg->{_clip4plot_default} = $immodpg->{_clip};
	$immodpg->{_clip4plot_current} = $immodpg->{_clip4plot_default};
	$immodpg->{_clip4plot_prior}   = $immodpg->{_clip4plot_default};
	$immodpg->{_clip4plot}         = $immodpg->{_clip4plot_default};
	$immodpg->{_in_clip}           = $no;
	$immodpg->{_outside_clip}      = $yes;

	# default values for layer-related variables
	$immodpg->{_layer_default} = $immodpg->{_layer};
	$immodpg->{_layer_current} = $immodpg->{_layer_default};
	$immodpg->{_layer_prior}   = $immodpg->{_layer_default};
	$immodpg->{_in_layer}      = $no;
	$immodpg->{_outside_layer} = $yes;

	# default values for thickness_m-related variables
	$immodpg->{_thickness_m_default} = $immodpg->{_thickness_m};
	$immodpg->{_thickness_m_current} = $immodpg->{_thickness_m_default};
	$immodpg->{_thickness_m_prior}   = $immodpg->{_thickness_m_default};
	$immodpg->{_in_thickness_m}      = $no;
	$immodpg->{_outside_thickness_m} = $yes;

	# default values for thickness_increment_m-related variables
	$immodpg->{_thickness_increment_m_default} =
	  $immodpg->{_thickness_increment_m};
	$immodpg->{_thickness_increment_m_current} =
	  $immodpg->{_thickness_increment_m_default};
	$immodpg->{_thickness_increment_m_prior} =
	  $immodpg->{_thickness_increment_m_default};
	$immodpg->{_in_thickness_increment_m}      = $no;
	$immodpg->{_outside_thickness_increment_m} = $yes;

}

=head2 sub setVbot_minus

update Vbot value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVbot_minus {

	my ($self) = @_;

	if ( length( $immodpg->{_VbotEntry} )
		and looks_like_number( $immodpg->{_Vincrement_current} ) )
	{

		my $Vbot = ( $immodpg->{_VbotEntry} )->get();

		if ( looks_like_number($Vbot) ) {

			my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
			my $newVbot    = $Vbot - $Vincrement;
			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			#				$immodpg->{_isVbot_changed_in_gui} = $yes;
			#				_checkVbot(); # todo
			_updateVbot();

			if ( $immodpg->{_isVbot_changed_in_gui} eq $yes ) {

				# for fortran program to read
				_set_option($Vbot_minus_opt);
				_set_change($yes);

		   #					print("immodpg, setVbot_minus, Vbot is changed: $yes \n");
		   #					print("immodpg, setVbot_minus,option:$Vbot_minus_opt\n");
		   #					print("immodpg, setVbot_minus, V=$immodpg->{_Vbot_current}\n");

			}
			else {

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				# print("immodpg, setVbot_minus, same Vbot NADA\n");
			}

		}
		else {
			print("immodpg, setVbot_minus, Vbot value missing\n");
		}

	}
	else {
		print("immodpg, setVbot_minus, missing widget or Vincrement\n");

#		print("immodpg, setVbot_minus, VbotEntry=$immodpg->{_VbotEntry}\n");
#		print("immodpg, setVbot_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
	}
	return ();
}

=head2 sub setVbot_plus

update Vbot value in gui
update private value in this module
output option for immodpg.for

=cut

sub setVbot_plus {

	my ($self) = @_;

	if ( length( $immodpg->{_VbotEntry} )
		&& looks_like_number( $immodpg->{_Vincrement_current} ) )
	{

		my $Vbot = ( $immodpg->{_VbotEntry} )->get();

		if ( looks_like_number($Vbot) ) {

			my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
			my $newVbot    = $Vbot + $Vincrement;

			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			#				$immodpg->{_isVbot_changed_in_gui} = $yes;
			#				_checkVbot(); #todo
			_updateVbot();

			#			print("immodpg, setVbot_plus, new Vbot= $newVbot\n");

			# print("immodpg, setVbot_plus, Vincrement= $Vincrement\n");

			if ( $immodpg->{_isVbot_changed_in_gui} eq $yes ) {

				# for fortran program to read
				_set_option($Vbot_plus_opt);
				_set_change($yes);

		  #					print("immodpg, setVbot_plus, Vbot_plus_opt:$Vbot_plus_opt \n");

			}
			else {

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				#				print("immodpg, setVbot_plus, same Vbot NADA\n");
			}

		}
		else {
			print("immodpg, setVbot_plus, Vbot value missing\n");
		}

	}
	else {
		print("immodpg, setVbot_plus, missing widget or Vincrement\n");

		#		print("immodpg, setVbot_plus, VbotEntry=$immodpg->{_VbotEntry}\n");
		#		print("immodpg, setVbot_plus, Vincrement=$immodpg->{_Vincrement}\n");
	}
	return ();
}

=head2 sub setVtop_minus

update Vtop value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVtop_minus {

	my ($self) = @_;

	if ( length( $immodpg->{_VtopEntry} )
		&& looks_like_number( $immodpg->{_Vincrement_current} ) )
	{

		my $Vtop = ( $immodpg->{_VtopEntry} )->get();

		if ( looks_like_number($Vtop) ) {

			my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
			my $newVtop    = $Vtop - $Vincrement;

			_set_control( 'Vtop', $newVtop );
			$newVtop = _get_control('Vtop');

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			#				$immodpg->{_isVtop_changed_in_gui} = $yes;
			#				_checkVtop(); #todo
			_updateVtop();

			if ( $immodpg->{_isVtop_changed_in_gui} eq $yes ) {

				# for fortran program to read
				_set_option($Vtop_minus_opt);
				_set_change($yes);

			#				print("immodpg, setVtop_minus,option:$Vtop_minus_opt\n");
			#				print("immodpg, setVtop_minus, V=$immodpg->{_Vtop_current}\n");

			}
			else {

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				print("immodpg, setVtop_minus, same Vtop NADA\n");
			}

		}
		else {
			print("immodpg, setVtop_minus, Vtop value missing\n");
		}

	}
	else {
		print("immodpg, setVtop_minus, missing widget or Vincrement\n");
		print("immodpg, setVtop_minus, VtopEntry=$immodpg->{_VtopEntry}\n");
		print(
"immodpg, setVtop_minus, Vincrement=$immodpg->{_Vincrement_current}\n"
		);
	}
	return ();
}

=head2 sub setVtop_plus

update Vtop value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVtop_plus {

	my ($self) = @_;

	#   print("0. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
	if (   length( $immodpg->{_VtopEntry} )
		&& length( $immodpg->{_VincrementEntry} ) )
	{

	   #		print("1. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
		my $Vtop = ( $immodpg->{_VtopEntry} )->get();

		if ( looks_like_number($Vtop) ) {

			my $Vincrement = ( $immodpg->{_VincrementEntry} )->get();
			my $newVtop    = $Vtop + $Vincrement;

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			_set_control( 'Vtop', $immodpg->{_Vtop_current} );
			$immodpg->{_Vtop_current} = _get_control('Vtop');
			$newVtop = $immodpg->{_Vtop_current};

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			#				$immodpg->{_isVtop_changed_in_gui} = $yes;
			#				_checkVtop(); #todo
			_updateVtop();

#				print("immodpg, setVtop_plus, $immodpg->{_Vtop_current}= $immodpg->{_Vtop_current}\n");
#			print("immodpg, setVtop_plus, Vincrement= $Vincrement\n");
#			print("2. immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
			if ( $immodpg->{_isVtop_changed_in_gui} eq $yes ) {

				# for fortran program to read
				_set_option($Vtop_plus_opt);
				_set_change($yes);

			#					print("immodpg, setVtop_plus,option:$Vtop_plus_opt\n");
			#					print("immodpg, setVtop_plus, V=$immodpg->{_Vtop_current}\n");

			}
			else {

#				print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
#				print("immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n");

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				#				print("immodpg, setVtop_plus, same Vtop NADA\n");
			}

		}
		else {
			print("immodpg, setVtop_plus, Vtop value missing\n");

#			print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
#			print("immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n");
		}

	}
	else {
		print("immodpg, setVtop_plus, missing widget or Vincrement\n");
		print("immodpg, setVtop_plus, VtopEntry=$immodpg->{_VtopEntry}\n");
		print(
"immodpg, setVtop_plus, Vincrement=$immodpg->{_Vincrement_current}\n"
		);

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

		_updateVbot();

		if ( length( $immodpg->{_isVbot_changed_in_gui} )
			&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
		{

			# for fortran program to read
			#				print("immodpg, set_Vbot, Vbot is changed: $yes \n");
			#				print("immodpg, setVbot,option:$Vbot_opt\n");
			#				print("immodpg, setVbot, V=$immodpg->{_Vbot_current}\n");

			_setVbot( $immodpg->{_Vbot_current} );
			_set_option($Vbot_opt);
			_set_change($yes);

		}
		else {

			#			negative cases are reset by fortran program
			#			and so eliminate need to read locked files
			#			while use of locked files helps most of the time
			#			creation and deletion of locked files in perl are not
			#			failsafe

			#  print("immodpg, setVbot, same Vbot NADA\n");
		}

	}
	else {

	}
}

=head2 sub setVbot_upper_layer

When you enter or leave a field,
check what the current Vbot_upper_layer value is
compared to former Vbot_upper_layer values
Vtop value is updated in immodpg.for 
through a message in file= "Vbot_lower"
(&_setVbot_upper_layer)

=cut

sub setVbot_upper_layer {

	my ($self) = @_;

	# for convenience
	my $layer_current = $immodpg->{_layer_current};
	my $newVbot_upper_layer;

	if ( length( $immodpg->{_Vbot_upper_layerEntry} ) ) {

		$immodpg->{_Vbot_upper_layer_current} =
		  ( $immodpg->{_Vbot_upper_layerEntry} )->get();
		my $Vbot_upper_layer_current = $immodpg->{_Vbot_upper_layer_current};

# print("1. immodpg, setVbot_upper_layer, immodpg->{_Vbot_upper_layer_current}=$Vbot_upper_layer_current\n");
		if (    length $Vbot_upper_layer_current
			and looks_like_number($Vbot_upper_layer_current)
			and $layer_current > 0 )
		{

# print("immodpg, setVbot_upper_layer, immodpg->{_Vbot_upper_layer_current}=$immodpg->{_Vbot_upper_layer_current}\n");

			_set_control( 'Vbot_upper_layer',
				$immodpg->{_Vbot_upper_layer_current} );
			$immodpg->{_Vbot_upper_layer_current} =
			  _get_control('Vbot_upper_layer');
			$newVbot_upper_layer = $immodpg->{_Vbot_upper_layer_current};

# print("2. immodpg, setVbot_upper_layer, newVbot_upper_layer=$newVbot_upper_layer\n");

			$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vbot_upper_layerEntry}
			  ->insert( 0, $newVbot_upper_layer );

			_checkVbot_upper_layer();
			_updateVbot_upper_layer();

			if ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes ) {

				# for fortran program to read

				_setVbot_upper_layer( $immodpg->{_Vbot_upper_layer_current} );
				_set_option($Vbot_upper_layer_opt);
				_set_change($yes);

#				print("immodpg, setVbot_upper_layer,option:$Vbot_upper_layer_opt\n");
#				print("immodpg, setVbot_upper_layer,V= $immodpg->{_Vbot_upper_layer_current}\n");

			}
			else {

				#			negative cases are reset by fortran program
				#			and so eliminate need to read locked files
				#			while use of locked files helps most of the time
				#			creation and deletion of locked files in perl are not
				#			failsafe

				# print("immodpg, setVbot_upper_layer, same Vbot NADA\n");
			}

		}
		else {

 # print("immodpg, setVbot_upper_layer, Velocity is empty in non-layer NADA\n");
		}

	}
	else {

	}
}

=head2 setVbotNVtop_lower_layer_minus
update Vbot value in gui
update Vtop_lower_layer value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVbotNVtop_lower_layer_minus {

	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_Vincrement_current} )
		&& length( $immodpg->{_Vtop_lower_layerEntry} )
		&& length( $immodpg->{_VbotEntry} ) )
	{

		my $Vbot             = ( $immodpg->{_VbotEntry} )->get();
		my $Vtop_lower_layer = ( $immodpg->{_Vtop_lower_layerEntry} )->get();
		my $Vincrement       = ( $immodpg->{_VincrementEntry} )->get();

		if (   looks_like_number($Vtop_lower_layer)
			&& looks_like_number($Vbot) )
		{

			my $newVtop_lower_layer = $Vtop_lower_layer - $Vincrement;
			my $newVbot             = $Vbot - $Vincrement;

			_set_control( 'Vtop', $newVtop_lower_layer );
			$newVtop_lower_layer = _get_control('Vtop');
			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');

			$immodpg->{_Vtop_lower_layer_prior} =
			  $immodpg->{_Vtop_lower_layer_current};
			$immodpg->{_Vtop_lower_layer_current} = $newVtop_lower_layer;

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vtop_lower_layerEntry}
			  ->insert( 0, $newVtop_lower_layer );

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			#				$immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
			#				$immodpg->{_isVbot_changed_in_gui}             = $yes;
			#				_checkVbot(); #todo
			_updateVbot();

			#				_checkVtop_lower_layer(); #todo
			_updateVtop_lower_layer();

			if (   $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes
				&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
			{

# for fortran program to read
#				print("immodpg, setVbotNVtop_lower_layer_minus, Vbot is changed: $yes \n");

				_set_option($VbotNVtop_lower_layer_minus_opt);
				_set_change($yes);

#				print("immodpg, setVbotNVtop_lower_layer_minus,option:$VbotNVtop_lower_layer_minus_opt\n");
#				print("immodpg, setVbotNVtop_lower_layer_minus, V=$immodpg->{_Vtop_lower_layer_current}\n");

			}
			else {

#	negative cases are reset by fortran program
#	and so eliminate need to read locked files
#	while use of locked files helps most of the time
#	creation and deletion of locked files in perl are not
#	failsafe
#
#				print("immodpg, setVbotNVtop_lower_layer_minus, same Vbot and Vtop_lower_layer; NADA\n");
			}

		}
		else {
			print(
"immodpg, setVbotNVtop_lower_layer_minus, Vbot or Vtop_lower_layer value missing\n"
			);
		}

	}
	else {
		print(
"immodpg, setVbotNVtop_lower_layer_minus, missing widget or Vincrement\n"
		);

#		print("immodpg, setVtopNVtop_lower_layer_minus, Vtop_lower_layerEntry=$immodpg->{_Vtop_lower_layerEntry}\n");
#		print("immodpg, setVtopNVtop_lower_layer_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
	}
	return ();
}

=head2 setVbotNVtop_lower_layer_plus
update Vbot value in gui
update Vtop_lower_layer value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVbotNVtop_lower_layer_plus {

	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_Vincrement_current} )
		&& length( $immodpg->{_Vtop_lower_layerEntry} )
		&& length( $immodpg->{_VbotEntry} ) )
	{

		my $Vbot             = ( $immodpg->{_VbotEntry} )->get();
		my $Vtop_lower_layer = ( $immodpg->{_Vtop_lower_layerEntry} )->get();
		my $Vincrement       = ( $immodpg->{_VincrementEntry} )->get();

		if (   looks_like_number($Vtop_lower_layer)
			&& looks_like_number($Vbot) )
		{

			my $newVtop_lower_layer = $Vtop_lower_layer + $Vincrement;
			my $newVbot             = $Vbot + $Vincrement;

			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');
			_set_control( 'Vtop', $newVtop_lower_layer );
			$newVtop_lower_layer = _get_control('Vtop');

			$immodpg->{_Vtop_lower_layer_prior} =
			  $immodpg->{_Vtop_lower_layer_current};
			$immodpg->{_Vtop_lower_layer_current} = $newVtop_lower_layer;

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vtop_lower_layerEntry}
			  ->insert( 0, $newVtop_lower_layer );

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			#				$immodpg->{_isVtop_lower_layer_changed_in_gui} = $yes;
			#				$immodpg->{_isVbot_changed_in_gui}             = $yes;

			_checkVbot();                # todo
			_updateVbot();
			_checkVtop_lower_layer();    # todo
			_updateVtop_lower_layer();

#			print("immodpg, setVbotNVtop_lower_layer_plus, new Vtop_lower_layer= $newVtop_lower_layer\n");
#			print("immodpg, setVbotNVtop_lower_layer_plus, Vincrement= $Vincrement\n");

			if (   $immodpg->{_isVtop_lower_layer_changed_in_gui} eq $yes
				&& $immodpg->{_isVbot_changed_in_gui} eq $yes )
			{

 # for fortran program to read
 #				print("immodpg, setVbotNVtop_lower_layer_plus, Vbot is changed: $yes \n");

				_set_option($VbotNVtop_lower_layer_plus_opt);
				_set_change($yes);

#				print("immodpg, setVbotNVtop_lower_layer_plus,option:$VbotNVtop_lower_layer_plus_opt\n");
#				print("immodpg, setVbotNVtop_lower_layer_plus, V=$immodpg->{_Vtop_lower_layer_current}\n");

			}
			else {

#	negative cases are reset by fortran program
#	and so eliminate need to read locked files
#	while use of locked files helps most of the time
#	creation and deletion of locked files in perl are not
#	failsafe
#
#				print("immodpg, setVbotNVtop_lower_layer_plus, same Vbot and Vtop_lower_layer; NADA\n");
			}

		}
		else {
			print(
"immodpg, setVbotNVtop_lower_layer_plus, Vbot or Vtop_lower_layer value missing\n"
			);
		}

	}
	else {
		print(
"immodpg, setVbotNVtop_lower_layer_plus, missing widget or Vincrement\n"
		);

#		print("immodpg, setVtopNVtop_lower_layer_plus, Vtop_lower_layerEntry=$immodpg->{_Vtop_lower_layerEntry}\n");
		print(
"immodpg, setVtopNVtop_lower_layer_plus, Vincrement=$immodpg->{_Vincrement_current}\n"
		);
	}
	return ();
}

=head2 sub setVtopNVbot_upper_layer_minus
update Vtop value in gui
update Vbot_upper_layer value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVtopNVbot_upper_layer_minus {

	my ($self) = @_;

	# print("layer_current = $immodpg->{_layer_current};\n");
	if (
		   looks_like_number( $immodpg->{_Vincrement_current} )
		&& length( $immodpg->{_Vbot_upper_layerEntry} )
		&& length( $immodpg->{_VtopEntry} )

	  )
	{

		my $Vtop             = ( $immodpg->{_VtopEntry} )->get();
		my $Vbot_upper_layer = ( $immodpg->{_Vbot_upper_layerEntry} )->get();
		my $Vincrement       = ( $immodpg->{_VincrementEntry} )->get();
		my $layer_current    = $immodpg->{_layer_current};

		if ( looks_like_number($Vbot_upper_layer) && looks_like_number($Vtop)
			and $layer_current > 1 )
		{

			my $newVbot_upper_layer = $Vbot_upper_layer - $Vincrement;
			my $newVtop             = $Vtop - $Vincrement;

			_set_control( 'Vbot', $newVbot_upper_layer );
			$newVbot_upper_layer = _get_control('Vbot');

			_set_control( 'Vtop', $newVtop );
			$newVtop = _get_control('Vtop');

			$immodpg->{_Vbot_upper_layer_prior} =
			  $immodpg->{_Vbot_upper_layer_current};
			$immodpg->{_Vbot_upper_layer_current} = $newVbot_upper_layer;

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vbot_upper_layerEntry}
			  ->insert( 0, $newVbot_upper_layer );

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			#				$immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
			#				$immodpg->{_isVtop_changed_in_gui}             = $yes;

#			print("immodpg, setVtopNVbot_upper_layer_minus, new Vbot_upper_layer= $newVbot_upper_layer\n");
# print("immodpg, setVtopNVbot_upper_layer_minus, Vincrement= $Vincrement\n");

			#				_checkVtop(); #todo
			_updateVtop();

			#				_checkVbot_upper_layer(); #todo
			_updateVbot_upper_layer();

			if (   $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes
				&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
			{

# for fortran program to read
#					print("immodpg, setVtopNVbot_upper_layer_minus, Vbot is changed: $yes \n");

				_set_option($VtopNVbot_upper_layer_minus_opt);
				_set_change($yes);

#				print("immodpg, setVtopNVbot_upper_layer_minus,option:$VtopNVbot_upper_layer_minus_opt\n");
#				print("immodpg, setVtopNVbot_upper_layer_minus, V=$immodpg->{_Vbot_upper_layer_current}\n");

			}
			else {

#	negative cases are reset by fortran program
#	and so eliminate need to read locked files
#	while use of locked files helps most of the time
#	creation and deletion of locked files in perl are not
#	failsafe
#
# print("immodpg, setVtopNVbot_upper_layer_minus, same Vtop and Vbot_upper_layer; NADA\n");
			}

		}
		else {

# print("immodpg, setVtopNVbot_upper_layer_minus, Vtop or Vbot_upper_layer value missing-NADA\n");
		}

	}
	else {
		print(
"immodpg, setVtopNVbot_upper_layer_minus, missing widget or Vincrement\n"
		);

#		print("immodpg, setVtopNVbot_upper_layer_minus, Vbot_upper_layerEntry=$immodpg->{_Vbot_upper_layerEntry}\n");
#		print("immodpg, setVtopNVbot_upper_layer_minus, Vincrement=$immodpg->{_Vincrement_current}\n");
	}
	return ();
}

=head2 sub setVtopNVbot_upper_layer_plus

update Vtop value in gui
update Vbot_upper_layer value in gui
update private value in this module

output option for immodpg.for

=cut

sub setVtopNVbot_upper_layer_plus {

	my ($self) = @_;

	if (
		   looks_like_number( $immodpg->{_Vincrement_current} )
		&& length( $immodpg->{_Vbot_upper_layerEntry} )
		&& length( $immodpg->{_VtopEntry} )

	  )
	{

		my $Vtop             = ( $immodpg->{_VtopEntry} )->get();
		my $Vbot_upper_layer = ( $immodpg->{_Vbot_upper_layerEntry} )->get();
		my $Vincrement       = ( $immodpg->{_VincrementEntry} )->get();
		my $layer_current    = $immodpg->{_layer_current};

		if ( looks_like_number($Vbot_upper_layer) && looks_like_number($Vtop)
			and $layer_current > 1 )
		{

			my $newVbot_upper_layer = $Vbot_upper_layer + $Vincrement;
			my $newVtop             = $Vtop + $Vincrement;

			_set_control( 'Vbot', $newVbot_upper_layer );
			$newVbot_upper_layer = _get_control('Vbot');

			_set_control( 'Vtop', $newVtop );
			$newVtop = _get_control('Vtop');

			$immodpg->{_Vbot_upper_layer_prior} =
			  $immodpg->{_Vbot_upper_layer_current};
			$immodpg->{_Vbot_upper_layer_current} = $newVbot_upper_layer;

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vbot_upper_layerEntry}
			  ->insert( 0, $newVbot_upper_layer );

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			#				$immodpg->{_isVbot_upper_layer_changed_in_gui} = $yes;
			#				$immodpg->{_isVtop_changed_in_gui}             = $yes;
			#				_checkVtop(); #todo
			_updateVtop();

			#				_checkVbot_upper_layer(); # todo
			_updateVbot_upper_layer();

#			print("immodpg, setVtopNVbot_upper_layer_plus, new Vbot_upper_layer= $newVbot_upper_layer\n");
#			print("immodpg, setVtopNVbot_upper_layer_plus, Vincrement= $Vincrement\n");

			if (   $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $yes
				&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
			{

	# for fortran program to read
	#	print("immodpg, setVtopNVbot_upper_layer_plus, Vbot is changed: $yes \n");

				_set_option($VtopNVbot_upper_layer_plus_opt);
				_set_change($yes);

#				print("immodpg, setVtopNVbot_upper_layer_plus,option:$VtopNVbot_upper_layer_plus_opt\n");
#				print("immodpg, setVtopNVbot_upper_layer_plus, V=$immodpg->{_Vbot_upper_layer_current}\n");

			}
			else {

#	negative cases are reset by fortran program
#	and so eliminate need to read locked files
#	while use of locked files helps most of the time
#	creation and deletion of locked files in perl are not
#	failsafe
#
#				print("immodpg, setVtopNVbot_upper_layer_plus, same Vtop and Vbot_upper_layer; NADA\n");

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

		$immodpg->{_VbotNtop_factor_current} =
		  $immodpg->{_VbotNtop_factorEntry}->get();

# print("1, immodpg, setVbotNtop_factor,immodpg->{_VbotNtop_factor_current}: $immodpg->{_VbotNtop_factor_current} \n");
		_set_control( 'VbotNtop_factor', $immodpg->{_VbotNtop_factor_current} );
		$immodpg->{_VbotNtop_factor_current} = _get_control('VbotNtop_factor');
		my $newVbotNtop_factor = $immodpg->{_VbotNtop_factor_current};

# print("2. immodpg, setVbotNtop_factor,newVbotNtop_factor:$newVbotNtop_factor\n");

		$immodpg->{_VbotNtop_factorEntry}->delete( 0, 'end' );
		$immodpg->{_VbotNtop_factorEntry}->insert( 0, $newVbotNtop_factor );

		_checkVbotNtop_factor();
		_updateVbotNtop_factor();
		_write_config();

		if ( $immodpg->{_isVbotNtop_factor_changed_in_gui} eq $yes ) {

			_setVbotNtop_factor( $immodpg->{_VbotNtop_factor_current} );
			_set_option($changeVbotNtop_factor_opt);
			_set_change($yes);

	 # print("immodpg, setVbotNtop_factor,option:$changeVbotNtop_factor_opt\n");

		}
		else {
			_set_change($no);

		# print("immodpg, setVbotNtop_factor, same VbotNtop_factor_opt NADA\n");
		}

	}
	else {
		print("immodpg, setVbotNtop_factor, bad factor or widget\n");

		# correct for bad typing
		#			_set_control('VbotNtop_factor',)
		#			_set_VbotNtop_factor_control();
		#			_get_control_VbotNtop_factor();
	}
}

#

=head2 sub setVbotNtop_multiply
Multiply Vbot and Vtop with factor

_updateVbotNtop_multiply
gui values for widgets
VbotEntry and VtopEntry 
	
output option for immodpg.for

=cut

sub setVbotNtop_multiply {

	my ($self) = @_;

	if (   looks_like_number( $immodpg->{_VbotNtop_factor_current} )
		&& length( $immodpg->{_VbotEntry}->get() )
		&& length( $immodpg->{_VtopEntry}->get() ) )
	{

		my $factor          = $immodpg->{_VbotNtop_factorEntry}->get();
		my $Vbot            = ( $immodpg->{_VbotEntry} )->get();
		my $Vtop            = ( $immodpg->{_VtopEntry} )->get();
		my $Vbot_multiplied = $Vbot * $factor;
		my $Vtop_multiplied = $Vtop * $factor;
		$immodpg->{_Vbot_multiplied} = $Vbot_multiplied;
		$immodpg->{_Vtop_multiplied} = $Vtop_multiplied;

# print("immodpg, setVbotNtop_multiply, Vbot=$Vbot_multiplied=, Vtop= $Vtop_multiplied\n");

		_updateVbotNtop_multiply();
		_set_option($VbotNtop_multiply_opt);
		_set_change($yes);

	}
	else {
		print("immodpg, setVbotNtop_multiply, missing value\n");
	}

	return ();

}

=head2 sub setVbotNtop_minus

update Vbot and Vtop values in gui
update private svalue in this module
output option for immodpg.for

=cut

sub setVbotNtop_minus {

	my ($self) = @_;

	if (   length( $immodpg->{_VbotEntry} )
		&& length( $immodpg->{_VtopEntry} ) )
	{

		my $Vbot       = ( $immodpg->{_VbotEntry} )->get();
		my $Vtop       = ( $immodpg->{_VtopEntry} )->get();
		my $Vincrement = $immodpg->{_VincrementEntry}->get();

		if (   looks_like_number($Vbot)
			&& looks_like_number($Vtop)
			&& looks_like_number($Vincrement) )
		{

			my $newVbot = $Vbot - $Vincrement;

			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			_updateVbot();

			my $newVtop = $Vtop - $Vincrement;
			_set_control( 'Vtop', $newVtop );
			$newVtop = _get_control('Vtop');

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			_updateVtop();

#			print("immodpg, setVbotNtop_minus, new Vbot= $newVbot\n");
#			print("immodpg, setVbotNtop_minus, new Vtop= $newVtop\n");
#			print("immodpg, setVbotNtop_minus, Vincrement= $Vincrement\n");

			if (   $immodpg->{_isVbot_changed_in_gui} eq $yes
				&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
			{

				# for fortran program to read
				_set_option($VbotNtop_minus_opt);
				_set_change($yes);

#				print("immodpg, setVbotNtop_minus, VbotNtop_minus_opt:$VbotNtop_minus_opt \n");

			}
			else {

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				#				print("immodpg, setVbotNtop_minus, same VbotNtop NADA\n");
			}

		}
		else {
			print("immodpg, setVbotNtop_minus, VbotNtop value missing\n");
		}

	}
	else {
		print("immodpg, setVbotNtop_minus, missing widget or Vincrement\n");
   #		print("immodpg, setVbotNtop_minus, Vincrement=$immodpg->{_Vincrement}\n");
	}
	return ();
}

=head2 sub setVbotNtop_plus

update Vbot and Vtop values in gui
update private svalue in this module
output option for immodpg.for

=cut

sub setVbotNtop_plus {

	my ($self) = @_;

	if (   length( $immodpg->{_VbotEntry} )
		&& length( $immodpg->{_VtopEntry} ) )
	{

		my $Vbot       = ( $immodpg->{_VbotEntry} )->get();
		my $Vtop       = ( $immodpg->{_VtopEntry} )->get();
		my $Vincrement = $immodpg->{_VincrementEntry}->get();

		if (   looks_like_number($Vbot)
			&& looks_like_number($Vtop)
			&& looks_like_number($Vincrement) )
		{

			my $newVbot = $Vbot + $Vincrement;

			_set_control( 'Vbot', $newVbot );
			$newVbot = _get_control('Vbot');

			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $newVbot;

			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $newVbot );

			_updateVbot();

			my $newVtop = $Vtop + $Vincrement;
			_set_control( 'Vtop', $newVtop );
			$newVtop = _get_control('Vtop');

			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $newVtop;

			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $newVtop );

			_updateVtop();

#			print("immodpg, setVbotNtop_plus, new Vbot= $newVbot\n");
#			print("immodpg, setVbotNtop_plus, new Vtop= $newVtop\n");
#			print("immodpg, setVbotNtop_plus, Vincrement= $Vincrement\n");

			if (   $immodpg->{_isVbot_changed_in_gui} eq $yes
				&& $immodpg->{_isVtop_changed_in_gui} eq $yes )
			{

				# for fortran program to read
				_set_option($VbotNtop_plus_opt);
				_set_change($yes);

#					print("immodpg, setVbotNtop_plus, VbotNtop_plus_opt:$VbotNtop_plus_opt \n");

			}
			else {

				#	negative cases are reset by fortran program
				#	and so eliminate need to read locked files
				#	while use of locked files helps most of the time
				#	creation and deletion of locked files in perl are not
				#	failsafe
				#
				#				print("immodpg, setVbotNtop_plus, same VbotNtop NADA\n");
			}

		}
		else {
			print("immodpg, setVbotNtop_plus, VbotNtop value missing\n");
		}

	}
	else {

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN


=cut

sub set_clip {

	my ($self) = @_;

	if ( length( $immodpg->{_clip4plotEntry} ) ) {

		$immodpg->{_clip4plot_current} = $immodpg->{_clip4plotEntry}->get();

# print("1. immodpg, set_clip,immodpg->{_clip4plot_current}:$immodpg->{_clip4plot_current}\n");

		_set_control( 'clip4plot', $immodpg->{_clip4plot_current} );
		$immodpg->{_clip4plot_current} = _get_control('clip4plot');
		my $new_clip4plot = $immodpg->{_clip4plot_current};

# print("2. immodpg, set_clip,immodpg->{_clip4plot_current}:$immodpg->{_clip4plot_current}\n");

		$immodpg->{_clip4plotEntry}->delete( 0, 'end' );
		$immodpg->{_clip4plotEntry}->insert( 0, $new_clip4plot );

		_check_clip();
		_update_clip();
		_write_config();

		if ( $immodpg->{_is_clip_changed_in_gui} eq $yes ) {

			_set_clip( $immodpg->{_clip4plot_current} );
			_set_option($change_clip_opt);
			_set_change($yes);

#			print("immodpg, set_clip,immodpg->{_clip4plot_current}=$immodpg->{_clip4plot_current}\n");

		}
		else {
			_set_change($no);

			# print("immodpg, set_clip, same clip NADA\n");
		}

	}
	else {

	}
}

=head2 sub set_layer
When you enter or leave
check what the current layer value is
compared to former layer values

=cut

sub set_layer {
	my ($self) = @_;

	#	print("immodpg, set_layer, $immodpg->{_layerEntry}\n");

	if (   length( $immodpg->{_layerEntry} )
		&& looks_like_number( $immodpg->{_layer_current} )
		&& length $immodpg->{_VbotEntry}
		&& length $immodpg->{_VtopEntry}
		&& length $immodpg->{_Vbot_upper_layerEntry}
		&& length $immodpg->{_Vtop_lower_layerEntry}
		&& length( $immodpg->{_thickness_mEntry} )
		&& looks_like_number( $immodpg->{_thickness_m_current} ) )
	{

		_check_layer();
		_update_layer_in_gui();
		_update_upper_layer_in_gui();
		_update_lower_layer_in_gui();

		#		_write_config();  TODO

		if ( $immodpg->{_is_layer_changed_in_gui} eq $yes ) {

=head3 Get model values from
immodpg.out for initial settings
in GUI
If the layer changes, also change associated 
velocity values and thickness values of the new layer

=cut

# print("immodpg, set_layer, layer is changed to: $immodpg->{_layer_current}\n");
			_set_model_layer( $immodpg->{_layer_current} );

			my ( $Vp_ref, $dz ) = _getVp_ref_dz_scalar();
			my @V           = @$Vp_ref;
			my $thickness_m = $dz;

			#	print("immodpg,set_layer,thickness=$thickness_m \n");

			my $Vbot_upper_layer = $V[0];
			my $Vtop             = $V[1];
			my $Vbot             = $V[2];
			my $Vtop_lower_layer = $V[3];

# print("immodpg, set_layer, Vbot=$Vbot for layer=$immodpg->{_layer_current} \n");
			$immodpg->{_thickness_mEntry}->delete( 0, 'end' );
			$immodpg->{_thickness_mEntry}->insert( 0, $thickness_m );

			# print("immodpg, set_layer, Vbot=$Vbot\n");
			$immodpg->{_VbotEntry}->delete( 0, 'end' );
			$immodpg->{_VbotEntry}->insert( 0, $Vbot );

			# print("immodpg, set_layer, Vtop=$Vtop\n");
			$immodpg->{_VtopEntry}->delete( 0, 'end' );
			$immodpg->{_VtopEntry}->insert( 0, $Vtop );

			# print("immodpg, set_layer, Vbot_upper_layer=$Vbot_upper_layer\n");
			$immodpg->{_Vbot_upper_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vbot_upper_layerEntry}->insert( 0, $Vbot_upper_layer );

			# print("immodpg, set_layer, Vtop_lower_layer=$Vtop_lower_layer\n");
			$immodpg->{_Vtop_lower_layerEntry}->delete( 0, 'end' );
			$immodpg->{_Vtop_lower_layerEntry}->insert( 0, $Vtop_lower_layer );

			# update stored values
			$immodpg->{_Vtop_prior}   = $immodpg->{_Vtop_current};
			$immodpg->{_Vtop_current} = $Vtop;
			$immodpg->{_Vbot_prior}   = $immodpg->{_Vbot_current};
			$immodpg->{_Vbot_current} = $Vbot;
			$immodpg->{_Vbot_upper_layer_prior} =
			  $immodpg->{_Vbot_upper_layer_current};

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

=head2 set_model_layer
Set the number of layers in
mmodpg

=cut

sub set_model_layer {

	my ( $self, $model_layer_number ) = @_;

	if ( $model_layer_number != 0
		&& length($model_layer_number) )
	{

		$immodpg->{_model_layer_number} = $model_layer_number;

	}
	else {
		print("immodpg, set_model_layer, unexpected layer# \n");
	}

#	print("immodpg, set_model_layer,modellayer# =$immodpg->{_model_layer_number}\n");

	return ();
}

=head2 sub set_replacement4missing


=cut

sub set_replacement4missing {

	my ( $self, $replacement4missing ) = @_;

	if ( length($replacement4missing) ) {

		$immodpg->{_replacement4missing} = $replacement4missing;

	}
	else {
		print("immodpg, set_replacement4missing, missing replacement\n");
	}
	return ();
}

=head2 sub set_thickness_m_minus

update _thickness_m value in gui
update private value in this module

output option for immodpg.for

=cut

sub set_thickness_m_minus {

	my ($self) = @_;

	if ( length( $immodpg->{_thickness_mEntry} )
		&& looks_like_number( $immodpg->{_thickness_increment_m} ) )
	{

		my $thickness_m = ( $immodpg->{_thickness_mEntry} )->get();

		if ( looks_like_number($thickness_m) ) {

			my $thickness_increment_m =
			  ( $immodpg->{_thickness_increment_mEntry} )->get();
			my $new_thickness_m = $thickness_m - $thickness_increment_m;
			_set_control( 'thickness_m', $new_thickness_m );
			$new_thickness_m = _get_control('thickness_m');

			$immodpg->{_thickness_m_prior}   = $immodpg->{_thickness_m_current};
			$immodpg->{_thickness_m_current} = $new_thickness_m;

			$immodpg->{_thickness_mEntry}->delete( 0, 'end' );
			$immodpg->{_thickness_mEntry}->insert( 0, $new_thickness_m );

#			print("immodpg, set new _thickness_m= $new_thickness_m\n");
#			print("immodpg, set_thickness_m_minus, thickness_increment_m= $thickness_increment_m\n");

			#				_check_thickness_m(); #todo
			_update_thickness_m();

			$immodpg->{_is_thickness_m_changed_in_gui} = $yes;

			if ( $immodpg->{_is_thickness_m_changed_in_gui} eq $yes ) {

	# for fortran program to read
	# print("immodpg, set_thickness_m_minus, _thickness_m is changed: $yes \n");

				#				   _set_thickness_m( $immodpg->{_thickness_m_current} );
				_set_option($thickness_m_minus_opt);
				_set_change($yes);

#								print("immodpg, set_thickness_m_minus,option:$thickness_m_minus_opt\n");
#								print("immodpg, set_thickness_m_minus, V=$immodpg->{_thickness_m_current}\n");

			}
			else {

			#	negative cases are reset by fortran program
			#	and so eliminate need to read locked files
			#	while use of locked files helps most of the time
			#	creation and deletion of locked files in perl are not
			#	failsafe
			#
			#	print("immodpg, set_thickness_m_minus, same _thickness_m NADA\n");
			}

		}
		else {
			print(
				"immodpg, set_thickness_m_minus, _thickness_m value missing\n");

#			print("immodpg, set_thickness_m_minus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
#			print("immodpg, set_thickness_m_minus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");
		}

	}
	else {
		print(
"immodpg, set_thickness_m_minus, missing widget or thickness_increment_m\n"
		);
	}
	return ();
}

=head2 sub set_thickness_m_plus

update _thickness_m value in gui
update private value in this module

output option for immodpg.for

=cut

sub set_thickness_m_plus {

	my ($self) = @_;

	if ( length( $immodpg->{_thickness_mEntry} )
		&& looks_like_number( $immodpg->{_thickness_increment_m} ) )
	{

		my $thickness_m = ( $immodpg->{_thickness_mEntry} )->get();

		if ( looks_like_number($thickness_m) ) {

			my $thickness_increment_m =
			  ( $immodpg->{_thickness_increment_mEntry} )->get();
			my $new_thickness_m = $thickness_m + $thickness_increment_m;
			_set_control( 'thickness_m', $new_thickness_m );
			$new_thickness_m = _get_control('thickness_m');

			$immodpg->{_thickness_m_prior}   = $immodpg->{_thickness_m_current};
			$immodpg->{_thickness_m_current} = $new_thickness_m;

			$immodpg->{_thickness_mEntry}->delete( 0, 'end' );
			$immodpg->{_thickness_mEntry}->insert( 0, $new_thickness_m );

#				print("immodpg, set_thickness_m_plus, set new _thickness_m= $new_thickness_m\n");
			_check_thickness_m();    #todo
			_update_thickness_m();

			$immodpg->{_is_thickness_m_changed_in_gui} = $yes;

			if ( $immodpg->{_is_thickness_m_changed_in_gui} eq $yes ) {

	 # for fortran program to read
	 # print("immodpg, set_thickness_m_plus, _thickness_m is changed: $yes \n");

				#				    _set_thickness_m( $immodpg->{_thickness_m_current} );
				_set_option($thickness_m_plus_opt);
				_set_change($yes);

#	print("immodpg, set_thickness_m_plus,option:$_thickness_m_plus_opt\n");
# print("immodpg, set_thickness_m_plus, dz=$immodpg->{_thickness_m_current}\n");

			}
			else {

#				print("immodpg, set_thickness_m_plus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
#				print("immodpg, set_thickness_m_plus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");

			 #	negative cases are reset by fortran program
			 #	and so eliminate need to read locked files
			 #	while use of locked files helps most of the time
			 #	creation and deletion of locked files in perl are not
			 #	failsafe
			 #
			 #	print("immodpg, set_thickness_m_plus, same _thickness_m NADA\n");
			}

		}
		else {
			print(
				"immodpg, set_thickness_m_plus, _thickness_m value missing\n");

#			print("immodpg, set_thickness_m_plus, _thickness_mEntry=$immodpg->{_thickness_mEntry}\n");
#			print("immodpg, set_thickness_m_plus, thickness_increment_m=$immodpg->{_thickness_increment_m}\n");
		}

	}
	else {
		print(
"immodpg, set_thickness_m_plus, missing widget or thickness_increment_m\n"
		);

lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN

	}
	else {
		print("immodpg, set_change, missing values\n");
	}
	return ();

}    # sub

=head2 sub set_clip_control
value adjusts to current
clip value in use

=cut

sub set_clip_control {

	my ( $self, $control_clip ) = @_;

	my $result;

	if ( length($control_clip)
		&& $control_clip > 0 )
	{

		$immodpg->{_control_clip} = $control_clip;

 #		print("immodpg,set_clip_control, control_clip=$immodpg->{_control_clip}\n");

	}
	elsif ( not( length($control_clip) ) ) {

		# print("immodpg,_set_clip_control, empty string\n");
		$immodpg->{_control_clip} = $control_clip;

	}
	else {
		print("immodpg,set_clip_control, missing value\n");
	}

	return ();
}

=head2 sub set_option
Verify another lock file does not exist and
only then:

Create another lock file
while change file is written
that prevents fortran file from reading.
Then, delete the lock file
Avoids crash between asynchronous 
reading (fortran) and
writing (Perl) of files

=cut

sub set_option {

	my ( $self, $option ) = @_;

	if ( looks_like_number($option)
		&& $immodpg->{_option_file} ne $empty_string )
	{

=head2 instantiate classes

=cut

		my $files   = manage_files_by2->new();
		my $control = control->new();

=head2 Define local
variables

=cut		

		my @X;
		my $option_file = $immodpg->{_option_file};

		my $test            = $no;
		my $outbound        = $IMMODPG_INVISIBLE . '/' . $option_file;
		my $outbound_locked = $outbound . '_locked';

		for ( my $i = 0 ; $test eq $no ; $i++ ) {

			if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
				
				my $format = $var_immodpg->{_format_string};
				$X[0] = $empty_string;
				$files->write_1col_aref( \@X, \$outbound_locked, \$format );

				$X[0] = $option;
				$format = $var_immodpg->{_format_integer};

#				print("immodpg,set_option,option=$option\n");
				$files->write_1col_aref( \@X, \$outbound, \$format );

				unlink($outbound_locked);

				$test = $yes;
			}    # if
		}    # for

	}
	elsif ( $immodpg->{_is_option_changed} eq $no ) {

		# NADA
	}
	else {
		print("immodpg, set_option, unexpected answer\n");
	}

	return ();
}

=head2 sub smute 


=cut

sub smute {

	my ( $self, $smute ) = @_;
	if ($smute) {

		$immodpg->{_smute} = $smute;
		$immodpg->{_note}  = $immodpg->{_note} . ' smute=' . $immodpg->{_smute};
		$immodpg->{_Step}  = $immodpg->{_Step} . ' smute=' . $immodpg->{_smute};

	}
	else {
		print("immodpg, smute, missing smute,\n");
	}
}

=head2 sub sscale 


=cut

sub sscale {

	my ( $self, $sscale ) = @_;
	if ($sscale) {

		$immodpg->{_sscale} = $sscale;
		$immodpg->{_note} =
		  $immodpg->{_note} . ' sscale=' . $immodpg->{_sscale};
		$immodpg->{_Step} =
		  $immodpg->{_Step} . ' sscale=' . $immodpg->{_sscale};

	}
	else {
		print("immodpg, sscale, missing sscale,\n");
	}
}

=head2 sub set_thickness_m

When you enter or leave,
check what the current thickness_m value is
compared to former thickness_m values

thickness_m value is updated in immodpg.for 
through a message in file="thickness_m"
($_set_thickness_m)

=cut

sub set_thickness_m {

	my ($self) = @_;

	if ( looks_like_number( $immodpg->{_thickness_m_current} ) ) {

		_set_control( 'thickness_m', $immodpg->{_thickness_m_current} );
		$immodpg->{_thickness_m_current} = _get_control('thickness_m');

		_check_thickness_m();
		_update_thickness_m();

		if ( length( $immodpg->{_is_thickness_m_changed_in_gui} )
			&& $immodpg->{_is_thickness_m_changed_in_gui} eq $yes )
		{

		   # for fortran program to read
		   # print("immodpg, set_thickness_m, thickness_m is changed: $yes \n");

			_set_thickness_m( $immodpg->{_thickness_m_current} );
			_set_option($change_thickness_m_opt);
			_set_change($yes);

		}
		else {

			#			negative cases are reset by fortran program
			#			and so eliminate need to read locked files
			#			while use of locked files helps most of the time
			#			creation and deletion of locked files in perl are not
			#			failsafe

			# print("immodpg, set_thickness_m, same thickness_m NADA\n");
		}

	}
	else {
		print("immodpg, set_thickness_m, _thickness_m value missing\n");
		print(
			"immodpg, set_thickness_m, thickness_m=$immodpg->{_thickness_m}\n");
	}
}

=head2 sub set_thickness_increment_m
When you enter or leave
check what the current thickness_increment_m value is
compared to former thickness_increment_m values

thickness_increment_m value is updated in immodpg.for 
through a message in file= "thickness_increment_m"
(&_set_thickness_increment_m)

=cut

sub set_thickness_increment_m {

	my ($self) = @_;

	# print("immodpg, set_thickness_increment_m, self, $self\n");

	if ( length( $immodpg->{_thickness_increment_mEntry} ) ) {

		$immodpg->{_thickness_increment_m_current} =
		  ( $immodpg->{_thickness_increment_mEntry} )->get();
		_set_control( 'thickness_increment_m',

( run in 2.119 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )