App-SeismicUnixGui
view release on metacpan or search on metacpan
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=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
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $Vbot_upper_layer_file = $immodpg->{_Vbot_upper_layer_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vbot_upper_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] = $Vbot_upper_layer;
$format = $var_immodpg->{_format_real};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVbot_upper_layer_changed_in_gui} eq $no ) {
# NADA
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
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $Vincrement_file = $immodpg->{_Vincrement_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $Vincrement_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] = $Vincrement;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_isVincrement_changed_in_gui} eq $no ) {
# NADA
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=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");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=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
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $test = $yes;
my $change = $immodpg->{_change_file};
my $outbound = $IMMODPG_INVISIBLE . '/' . $change;
my $outbound_locked = $outbound . '_locked';
my $format = $var_immodpg->{_format_string};
my $count = 0;
my $max_counts = 1000;
for (
my $i = 0 ;
( $test eq $yes ) and ( $count < $max_counts ) ;
$i++
)
{
# print("1. immodpg,_set_change, in loop count=$count \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
# print("immodpg, _set_change, outbound_locked=$outbound_locked\n");
# print("immodpg, _set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# print("immodpg, _set_change, created empty locked file=$X[0]\n");
# print("immodpg, _set_change, outbound=$outbound\n");
# print("immodpg, _set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# do not overwrite a waiting change (= yes)
my $response_aref = $files->read_1col_aref( \$outbound );
my $ans = @{$response_aref}[0];
if ( $ans eq $yes ) {
# do not overwrite a waiting change (= yes)
# print("2. immodpg, _set_change, SKIP\n");
# print("immodpg, _set_change,do not overwrite change_file\n");
unlink($outbound_locked);
}
elsif ( $ans eq $no ) {
# overwrite change_file(=no) with no or yes
$X[0] = $yes_or_no;
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, _set_change, overwrite change file with $X[0]\n");
unlink($outbound_locked);
# print("3. immodpg, _set_change, delete locked file\n");
# print("4. immodpg, _set_change, yes_or_no=$X[0]\n");
$test = $no;
}
else {
print("immodpg, _set_change, unexpected result \n");
} # test change_file's content
}
else {
# print("immodpg,_set_change, locked change file\n");
$count++; # governor on finding an unlocked change_file
} # if unlocked file is missing and change_file is free
$count++; # governor on checking for a change_file = yes
} # for
}
else {
print("immodpg, _set_change, missing values\n");
}
return ();
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $clip_file = $immodpg->{_clip_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $clip_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] = $clip;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, _set_clip, output clip = $clip\n");
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_clip_changed_in_gui} eq $no ) {
# NADA
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $thickness_m_file = $immodpg->{_thickness_m_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $thickness_m_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] = $thickness_m;
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_thickness_m_changed_in_gui} eq $no ) {
# NADA
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
variables
=cut
my @X;
my $thickness_increment_m_file =
$immodpg->{_thickness_increment_m_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $thickness_increment_m_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] = $thickness_increment_m;
print("thickness_increment_m=$thickness_increment_m\n");
$format = $var_immodpg->{_format51f};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_layer_changed_in_gui} eq $no ) {
# NADA
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $layer_file = $immodpg->{_layer_file};
my $test = $no;
my $outbound = $IMMODPG_INVISIBLE . '/' . $layer_file;
my $outbound_locked = $outbound . '_locked';
for ( my $i = 0 ; $test eq $no ; $i++ ) {
# print("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] = $layer;
$format = $var_immodpg->{_format_integer};
$files->write_1col_aref( \@X, \$outbound, \$format );
unlink($outbound_locked);
$test = $yes;
} # if
} # for
}
elsif ( $immodpg->{_is_layer_changed_in_gui} eq $no ) {
# NADA
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 {
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
$immodpg->{_note} = $immodpg->{_note} . ' cdp=' . $immodpg->{_cdp};
$immodpg->{_Step} = $immodpg->{_Step} . ' cdp=' . $immodpg->{_cdp};
}
else {
print("immodpg, cdp, missing cdp,\n");
}
}
=head2 sub clean_trash
delete remaining locked files
reset default files as well
=cut
sub clean_trash {
my ($self) = @_;
use File::stat;
my $xk = xk->new();
my $files = manage_files_by2->new();
my ( $outbound_locked, $outbound );
my @X;
my $Vbot_file = $immodpg->{_Vbot_file};
my $VbotNtop_factor_file = $immodpg->{_VbotNtop_factor_file};
my $Vbot_upper_layer_file = $immodpg->{_Vbot_upper_layer_file};
my $Vincrement_file = $immodpg->{_Vincrement_file};
my $Vtop_file = $immodpg->{_Vtop_file};
my $Vtop_lower_layer_file = $immodpg->{_Vtop_lower_layer_file};
my $change_file = $immodpg->{_change_file};
my $clip_file = $immodpg->{_clip_file};
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# kill previous processes
$xk->set_process('immodpg1.1');
$xk->kill_process();
$xk->set_process('pgxwin_server');
# print("immodpg,exit: kill pgxwin_server\n");
$xk->kill_process();
# deleted lock files
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vbot_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $VbotNtop_factor_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $Vbot_upper_layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vincrement_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $Vtop_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $Vtop_lower_layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $change_file . '_locked';
# print("immodpg, clean_trash, delete $outbound_locked\n");
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $clip_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG . '/' . $immodpg_model . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $layer_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $option_file . '_locked';
unlink($outbound_locked);
$outbound_locked = $IMMODPG_INVISIBLE . '/' . $thickness_m_file . '_locked';
unlink($outbound_locked);
$outbound_locked =
$IMMODPG_INVISIBLE . '/' . $thickness_increment_m_file . '_locked';
unlink($outbound_locked);
# reset files to their default options
$outbound = $IMMODPG_INVISIBLE . '/' . $change_file;
unlink($outbound);
my $format = $var_immodpg->{_format_string};
$X[0] = $immodpg->{_change_default};
$files->write_1col_aref( \@X, \$outbound, \$format );
_fortran_layer( $immodpg->{_layer_default} );
_set_option( $immodpg->{_option_default} );
_set_change( $immodpg->{_change_default} );
# delete empty files (including surviving lock files)
# remove weird, locked files from the current directory
my $CD = `pwd`;
$files->set_directory($CD);
$files->clear_empty_files();
# remove weird lock files from the main directory
$files->set_directory($IMMODPG);
$files->clear_empty_files();
# remove weird lock files from the IMMODPG_INVISIBLE
$files->set_directory($IMMODPG_INVISIBLE);
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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 {
}
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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"
);
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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"
);
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
}
}
else {
# print("immodpg, setVtopNVbot_upper_layer_plus, Vtop or Vbot_upper_layer value missing NADA\n");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# print("immodpg, setVincrement, $immodpg->{_Vincrement_current}\n");
_setVincrement( $immodpg->{_Vincrement_current} );
_set_option($changeVincrement_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, setVincrement, same Vincrement NADA\n");
}
}
else {
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_set_option($changeVtop_opt);
_set_change($yes);
# print("immodpg, setVtop,option:$changeVtop_opt\n");
# print("immodpg, setVtop, 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, same Vtop NADA\n");
}
}
else {
print("immodpg, setVtop, _Vtop value missing\n");
print("immodpg, setVtop, Vtop=$immodpg->{_Vtop}\n");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_setVtop_lower_layer( $immodpg->{_Vtop_lower_layer_current} );
_set_option($Vtop_lower_layer_opt);
_set_change($yes);
# print("immodpg, setVtop_lower_layer,option:$Vtop_lower_layer_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, setVtop_lower_layer, same Vtop_lower_layer NADA\n");
}
}
else {
("immodpg, setVtop_lower_layer, missing widget\n");
}
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
_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");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
=head2 Define local
variables
=cut
my @X;
my $change = $immodpg->{_change_file};
my $test = $yes;
my $outbound = $IMMODPG_INVISIBLE . '/' . $change;
my $outbound_locked = $outbound . '_locked';
my $format = $var_immodpg->{_format_string};
my $count = 0;
my $max_counts = $var_immodpg->{_loop_limit};
for (
my $i = 0 ;
( $test eq $yes ) and ( $count < $max_counts ) ;
$i++
)
{
# print("1. immodpg,set_change, in loop count=$count \n");
if ( not( $files->does_file_exist( \$outbound_locked ) ) ) {
$X[0] = $empty_string;
$files->write_1col_aref( \@X, \$outbound_locked, \$format );
# print("immodpg, set_change, outbound_locked=$outbound_locked\n");
# print("immodpg, set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# print("immodpg, set_change, created empty locked file=$X[0]\n");
# print("immodpg, set_change, outbound=$outbound\n");
# print("immodpg, set_change, IMMODPG_INVISIBLE=$IMMODPG_INVISIBLE\n");
# do not overwrite a waiting change (= yes)
my $response_aref = $files->read_1col_aref( \$outbound );
my $ans = @{$response_aref}[0];
if ( $ans eq $yes ) {
# do not overwrite a waiting change (= yes)
# print("2. immodpg, set_change, SKIP\n");
# print("immodpg, set_change,do not overwrite change_file\n");
unlink($outbound_locked);
}
elsif ( $ans eq $no ) {
# overwrite change_file(=no) with no or yes
$X[0] = $yes_or_no;
$files->write_1col_aref( \@X, \$outbound, \$format );
# print("immodpg, set_change, overwrite change file with $X[0]\n");
unlink($outbound_locked);
# print("3. immodpg, set_change, delete locked file\n");
# print("4. immodpg, set_change, yes_or_no=$X[0]\n");
$test = $no;
}
else {
print("immodpg, set_change, unexpected result \n");
} # test change_file's content
}
else {
# print("immodpg,_set_change, locked change file\n");
$count++; # governor on finding an unlocked change_file
} # if unlocked file is missing and change_file is free
$count++; # governor on checking for a change_file = yes
} # for
}
else {
print("immodpg, set_change, missing values\n");
}
return ();
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++ ) {
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
}
lib/App/SeismicUnixGui/big_streams/immodpg.pm view on Meta::CPAN
# 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");
lib/App/SeismicUnixGui/big_streams/immodpg_global_constants.pm view on Meta::CPAN
package App::SeismicUnixGui::big_streams::immodpg_global_constants;
use Moose;
our $VERSION = '0.0.1';
=head private hash
similar names as the variables in immodpg.for
in the DICTIONARY ~ line 55
and also in moveNzoom.for
loop_limit: for searching for a locked_file
=cut
my @format;
$format[0] = '%-35s%1s%-20s';
$format[1] = '%-35s%1s%-20s';
$format[2] = '%-35s%1s%-20s';
$format[3] = '%-35s%1s%-20s';
$format[4] = '%-35s%1s%-20s';
lib/App/SeismicUnixGui/fortran/src/readVbotNtop_factor_file.f view on Meta::CPAN
subroutine readVbotNtop_factor_file(result,inbound)
implicit none
! read a VbotNtop_factor file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F7.1)"
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=31,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
read (31,format1) result
! print *, 'readVbotNtop_factor_file.f, result',result
close (unit=31)
else
! print *, 'readVbotNtop_factor_file.f, err_msg=',err_msg
! rest a little before trying again
! call sleep(1)
go to 10
end if
else
print *, 'readVbotNtop_factor_file.f,locked, try again,read =',ready
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'readVbotNtop_factor_file.f, err_messg=',err_msg
end if
! print *, 'readVbotNtop_factor_file, result',result
lib/App/SeismicUnixGui/fortran/src/readVbot_file.f view on Meta::CPAN
subroutine readVbot_file(result,inbound)
implicit none
! read a configuration file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F7.1)"
! print *, 'readVbot_file.f, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=29,file=trim(inbound),status='old',iostat=err_msg)
! + iostat=err_msgr)
! check whether file opens data file
if (err_msg.eq.0) then
read (29,format1) result
! print *, 'readVbot_file.f, result',result
close (unit=29)
else
print *, 'readVbot_file.f,locked, try again,read =',ready
! rest a little before trying again
! call sleep(1)
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'readVbot_file.f, err_messg=',err_msg
lib/App/SeismicUnixGui/fortran/src/readVbot_upper_file.f view on Meta::CPAN
subroutine readVbot_upper_file(result,inbound)
implicit none
! read a configuration file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F7.1)"
! print *, 'readVbot_upper_file.f, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=29,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
! print *, 'readVbot_upper_file.f'
read (29,format1) result
! print *, 'readVbot_upper_file.f, result',result
close (unit=29)
else
print *,'readVbot_upper_file.f,locked, try again,read =',ready
! rest a little before trying again
! call sleep(1)
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'readVbot_upper_file.f, err_messg=',err_msg
lib/App/SeismicUnixGui/fortran/src/readVincrement_file.f view on Meta::CPAN
subroutine readVincrement_file(result,inbound)
implicit none
! read a Vincrement file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F5.1)"
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=31,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
read (31,format1) result
print *, 'readVincrement_file.f, result',result
close (unit=31)
else
! print *, 'readVincrement_file.f, err_msg=',err_msg
! rest a little before trying again
! call sleep(1)
go to 10
end if
else
print *, 'readVincrement_file.f,locked, try again,read =',ready
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'readVincrement_file.f, err_messg=',err_msg
end if
! print *, 'readVincrement_file, result',result
lib/App/SeismicUnixGui/fortran/src/readVtop_file.f view on Meta::CPAN
subroutine readVtop_file(result,inbound)
implicit none
! read a configuration file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, counter, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F7.1)"
! print *, 'readVtop_file, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=31,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
read (31,format1) result
! print *, 'readVtop_file.f, result',result
close (unit=31)
else
print *, 'readVtop_file.f, err_msg=',err_msg
print *, 'readVtop_file.f, counter=',counter
! rest a little before trying again
call sleep(1)
go to 10
end if
else
print *, 'readVtop_file.f, locked, try again,read =',ready
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'readVtop_file.f, err_messg=',err_msg
end if
! print *, 'readVtop_file.f, result',result
lib/App/SeismicUnixGui/fortran/src/readVtop_lower_file.f view on Meta::CPAN
subroutine readVtop_lower_file(result,inbound)
implicit none
! read a configuration file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F7.1)"
! print *, 'readVtop_lower_file.f, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=31,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
! print *, 'readVtop_lower_file.f'
read (31,format1) result
! print *, 'readVtop_lower_file.f, result',result
close (unit=31)
else
! print *,'readVtop_lower_file.f,locked, try again,read =',ready
! rest a little before trying again
! call sleep(1)
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
! print *, 'readVtop_lower_file.f, err_messg=',err_msg
lib/App/SeismicUnixGui/fortran/src/read_bin_data.f view on Meta::CPAN
subroutine read_bin_data(inbound_bin,ntrmax,nsmax,ntr,ns,Amp)
implicit none
! read_bin_data reads a fortran-style binary seismic image
character (len=300) :: inbound_bin, inbound, inbound_locked
integer*4 :: ntrmax,nsmax,ntr,ns,k,i
real*4 :: Amp(ntrmax,nsmax)
integer :: err_msg, counter, ready
! trim end and adjustl start of empty spaces
inbound=trim(adjustl(inbound_bin))
! print *, 'read_bin_data, inbound_bin is:',inbound,'--'
! print *, 'read_bin_data, next line:'
inbound_locked=trim(inbound_bin)//"_locked"
! print *, 'read_bin_data, inbound_locked is:',trim(inbound_locked),&
! create a temporary, new, lock file
10 open(status='new',unit=31,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
20 open(UNIT=21,FILE=inbound_bin,STATUS='OLD',IOSTAT=err_msg, &
FORM='UNFORMATTED')
counter = counter +1
! =0 normal completion, not an error
! print *, 'L26.read_bin_data.f, err_msg=',err_msg
! check whether file opens data file
if (err_msg.eq.0) then
! print *, 'L30.read_bin_data.f,unlocked, err_msg=',err_msg
! read by columns: k
k=1
120 read (unit=21) (Amp(k,i), i=1,ns)
! i=1
! do
! print*,'k,i,ntr,ns,Amp(k,i)',k,i,ntr,ns,Amp(k,i)
! i = i+1
! if(i.GE.ns) go to 50
! enddo
lib/App/SeismicUnixGui/fortran/src/read_bin_data.f view on Meta::CPAN
else
print *, 'read_bin_data.f, err_msg=',err_msg
print *,'L53 read_bin_data.f, can not open bin file=',counter
! rest a little before trying again
! call sleep(1)
go to 10
end if
else
! print *, 'L61. read_bin_data.f,locked, try again,ready=',ready
! print *, '3.read_bin_data.f, err_messg=',err_msg
go to 10
end if
! remove lock file
11 close (status='delete',unit=31,iostat=err_msg)
! print *, '4.read_bin_data.f, err_messg=',err_msg
if (err_msg.ne.0) then
lib/App/SeismicUnixGui/fortran/src/read_clip_file.f view on Meta::CPAN
subroutine read_clip_file(result,inbound)
implicit none
! read a configuration file
real*4 :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_msg, counter, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(F5.1)"
! print *, 'read_clip_file, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=31,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
read (31,format1) result
! print *, 'read_clip_file.f, result',result
close (unit=31)
else
print *, 'read_clip_file.f, err_msg=',err_msg
! print *, 'read_clip_file.f, counter=',counter
! rest a little before trying again
call sleep(1)
go to 10
end if
else
! print *, 'read_clip_file.f, locked, try again,read =',ready
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
! print *, 'read_clip_file.f, err_messg=',err_msg
end if
! print *, 'read_clip_file, result',result
lib/App/SeismicUnixGui/fortran/src/read_immodpg_config.f view on Meta::CPAN
character (len=80) :: name, answer
character (len=30) :: format0,format1,format2,format3
character (len=30) :: format4,format5,format6
character (len=30) :: format7,format8,format9
character (len=30) :: format10,format11,format12,format13
character (len=30) :: format14,format15,format16,format17
character (len=30) :: format18,format19
character (len=5) :: equal,previous_model,new_model
character (len=5) :: pre_digitized_XT_pairs,data_traces
character (len=40) :: base_file
character (len=255):: inbound, inbound_locked
real :: min_t_s,max_t_s,min_x_m,max_x_m
real :: thickness_increment_m
real :: data_x_inc_m,source_depth_m,receiver_depth_m
real :: reducing_vel_mps,plot_min_x_m,plot_max_x_m
real :: plot_min_t_s,plot_max_t_s,VtopNbot_factor
real :: Vincrement_mps, clip, m2km
real*4 :: results(30)
integer*2 :: layer
integer :: err_msg, counter, ready
! in case definition in main is slightly different
! pre_digitized_XT_pairs = 'no'
! data_traces = 'no'
! previous_model = 'no'
! new_model = 'no'
! sum of first two character strings= 35
inbound_locked=trim(inbound)//"_locked"
format0= "(A14,21X,A1,1X,A)"
format1= "(A22,13X,A1,1X,A)"
format2= "(A11,24X,A1,1X,A)"
format3= "(A4,31X,A1,1X,F5.1)"
format4= "(A7,28X,A1,1X,F10.3)"
format5= "(A7,28X,A1,1X,F10.3)"
format6= "(A13,22X,A1,1X,F10.3)"
format7= "(A14,21X,A1,1X,F10.3)"
format8= "(A16,19X,A1,1X,F10.3)"
format9= format8
lib/App/SeismicUnixGui/fortran/src/read_immodpg_config.f view on Meta::CPAN
format15= "(A9,26X,A1,1X,A)"
format16= "(A5,30X,A1,1X,I2)"
format17= "(A15,20X,A1,1X,F10.3)"
format18= "(A14,21X,A1,1X,F10.3)"
format19= "(A21,14X,A1,1X,F10.3)"
m2km = .001;
! print*, 'read_immodpg_config.f, inbound is:', trim(inbound)
! create a temporary, new, lock file
10 open(status='new',unit=2,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=1,file=trim(inbound),status='old',iostat=err_msg)
! check whether file opens data file
if (err_msg.eq.0) then
read (1,format0) name,equal,base_file
base_file = trim(base_file)
lib/App/SeismicUnixGui/fortran/src/read_immodpg_config.f view on Meta::CPAN
! end if
else
! print *, 'read_immodpg_file.f, err_msg=',err_msg
! print *, 'read_immodpg_file.f, counter=',counter
! rest a little before trying again
! call sleep(1)
go to 10
end if
else
print *, 'read_immodpg_config.f,locked,try again,ready=',ready
! go to 10
end if
! remove lock file
11 close (status='delete',unit=2,iostat=err_msg)
if (err_msg.ne.0) then
go to 11
print *, 'read_immodpg_file.f, err_messg=',err_msg
end if
! print *, 'read_immodpg_file, result',result
lib/App/SeismicUnixGui/fortran/src/read_layer_file.f view on Meta::CPAN
subroutine read_layer_file(result,inbound)
implicit none
! read a configuration file
integer :: result
character (len=255) :: inbound, inbound_locked
character (len=30) :: format1
integer :: err_message, ready
inbound_locked=trim(inbound)//"_locked"
format1= "(I2)"
! print *, 'read_layer_file.f, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
! create a temporary, new, lock file
10 open(status='new',unit=30,file=inbound_locked,iostat=ready)
if (ready.eq.0) then
open(unit=29,file=trim(inbound),status='old',iostat=err_message)
! check whether file opens data file
if (err_message.eq.0) then
read (29,format1) result
! print *, 'read_layer_file.f, result',result
close (unit=29)
else
print *, 'read_layer_file.f,,locked, try again,read =',ready
! rest a little before trying again
! call sleep(1)
go to 10
end if
! remove lock file
11 close (status='delete',unit=30,iostat=err_message)
if (err_message.ne.0) then
go to 11
print *, 'read_layer_file.f, err_messg=',err_message
lib/App/SeismicUnixGui/fortran/src/read_option_file.f view on Meta::CPAN
subroutine read_option_file(result,inbound)
implicit none
! read option file with an integer number
character (len=30) :: format1
character (len=255) :: inbound, inbound_locked
integer :: err_message, counter, ready
integer :: result
inbound_locked=trim(inbound)//"_locked"
format1= "(I3)"
! print *, 'read_option_file, inbound is:', trim(inbound)
! in case inbound is of a different, but shorter length in main
! inbound=inbound
! open(unit=28,file=trim(inbound),status='old')
! read (28,format1) result
!! print *, 'read_option_file, result',result
! close (unit=28)
! create a temporary, new, lock file
10 open(status='new',unit=28,file=inbound_locked,iostat=ready)
! print *, 'read_option_file.f,inbound_locked iostat:',ready
! if (ready.eq.17) print *, 'locked, try again'
if (ready.eq.0) then
open(unit=29,file=trim(inbound),status='old',iostat=err_message)
! counter = counter +1
! check whether file opens data file
if (err_message.eq.0) then
read (29,format1) result
! print *, 'read_option_file.f, result',result
lib/App/SeismicUnixGui/fortran/src/read_option_file.f view on Meta::CPAN
else
! print *, 'read_option_file.f, err_message=',err_message
! print *, 'read_option_file.f, counter=',counter
! rest a little before trying again
! call sleep(1)
go to 10
end if
else
! print *, 'read_option_file.f,locked, try again,read =',ready
go to 10
end if
! remove lock file
11 close (status='delete',unit=28,iostat=err_message)
if (err_message.ne.0) then
go to 11
! print *, 'read_option_file.f, err_messg=',err_message
end if
end subroutine read_option_file
( run in 1.541 second using v1.01-cache-2.11-cpan-49f99fa48dc )