File Coverage

blib/lib/Sim/OPT/Morph.pm
Criterion Covered Total %
statement 77 2479 3.1
branch 2 614 0.3
condition 0 120 0.0
subroutine 24 72 33.3
pod 0 49 0.0
total 103 3334 3.0


line stmt bran cond sub pod time code
1             package Sim::OPT::Morph;
2             # Copyright (C) 2008-2014 by Gian Luca Brunetti and Politecnico di Milano.
3             # This is the module Sim::OPT::Morph of Sim::OPT, a program for detailed metadesign managing parametric explorations through the ESP-r building performance simulation platform and performing optimization by block coordinate descent.
4             # This is free software. You can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2.
5              
6 1     1   16 use v5.14;
  1         3  
7 1     1   5 use Exporter;
  1         2  
  1         53  
8 1     1   4 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
  1         2  
  1         95  
9 1     1   5 use Math::Trig;
  1         2  
  1         242  
10 1     1   7 use Math::Round;
  1         2  
  1         109  
11 1     1   8 use List::Util qw[ min max reduce shuffle];
  1         2  
  1         102  
12 1     1   6 use List::MoreUtils qw(uniq);
  1         2  
  1         9  
13 1     1   437 use List::AllUtils qw(sum);
  1         2  
  1         60  
14 1     1   6 use Statistics::Basic qw(:all);
  1         1  
  1         43  
15 1     1   690 use Set::Intersection;
  1         2  
  1         64  
16 1     1   5 use List::Compare;
  1         1  
  1         25  
17 1     1   5 use IO::Tee;
  1         1  
  1         53  
18 1     1   6 use Data::Dumper;
  1         2  
  1         68  
19 1     1   7 use Sim::OPT;
  1         1  
  1         47  
20 1     1   628 use Sim::OPT::Sim;
  1         3  
  1         52  
21 1     1   5 use Sim::OPT::Retrieve;
  1         2  
  1         44  
22 1     1   3 use Sim::OPT::Report;
  1         2  
  1         36  
23 1     1   4 use Sim::OPT::Descend;
  1         2  
  1         35  
24 1     1   3 use Sim::OPT::Takechance;
  1         1  
  1         35  
25             #$Data::Dumper::Indent = 0;
26             #$Data::Dumper::Useqq = 1;
27             #$Data::Dumper::Terse = 1;
28 1     1   4 use Data::Dump qw(dump);
  1         1  
  1         35  
29 1     1   4 use feature 'say';
  1         1  
  1         73  
30              
31 1     1   4 no strict;
  1         79  
  1         25  
32 1     1   4 no warnings;
  1         1  
  1         31292  
33              
34             @ISA = qw(Exporter); # our @adamkISA = qw(Exporter);
35             #%EXPORT_TAGS = ( DEFAULT => [qw( &opt &prepare )]); # our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
36             #@EXPORT_OK = qw(); # our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
37              
38             @EXPORT = qw(
39             morph translate translate_surfaces_simple translate_surfaces rotate_surface translate_vertices shift_vertices rotate
40             rotatez make_generic_change reassign_construction change_thickness obs_modify bring_obstructions_back
41             recalculateish daylightcalc daylightcalc_other change_config checkfile change_climate recalculatenet apply_constraints
42             reshape_windows warp constrain_geometry read_geometry read_geo_constraints apply_geo_constraints vary_controls
43             calc_newctl checkfile constrain_controls read_controls read_control_constraints apply_loopcontrol_changes
44             apply_flowcontrol_changes constrain_obstructions read_obstructions read_obs_constraints apply_obs_constraints
45             vary_net read_net apply_node_changes
46             apply_component_changes constrain_net read_net_constraints propagate_constraints
47             ); # our @EXPORT = qw( );
48              
49             $VERSION = '0.40.11'; # our $VERSION = '';
50              
51              
52              
53             sub morph
54             {
55 0     0 0 0 my $swap = shift; #say $tee "swapINMORPH: " . dump($swap);
56 0         0 my %dat = %$swap;
57 0         0 my @instances = @{ $dat{instances} }; #say "scalar(\@instances): " . scalar(@instances);
  0         0  
58 0         0 my $countcase = $dat{countcase}; #say "dump(\$countcase): " . dump($countcase); # IT WILL BE SHADOWED. CUT ZZZ
59 0         0 my $countblock = $dat{countblock}; #say "dump(\$countblock): " . dump($countblock); # IT WILL BE SHADOWED. CUT ZZZ
60 0         0 my %dirfiles = %{ $dat{dirfiles} }; #say "dump(\%dirfiles): " . dump(%dirfiles);
  0         0  
61            
62 0         0 $configfile = $main::configfile; #say "dump(\$configfile): " . dump($configfile);
63 0         0 @sweeps = @main::sweeps; #say "dump(\@sweeps): " . dump(@sweeps);
64 0         0 @varinumbers = @main::varinumbers; #say "dump(\@varinumbers): " . dump(@varinumbers);
65 0         0 @mediumiters = @main::mediumiters;
66 0         0 @rootnames = @main::rootnames; #say "dump(\@rootnames): " . dump(@rootnames);
67 0         0 %vals = %main::vals; #say "dump(\%vals): " . dump(%vals);
68            
69 0         0 $mypath = $main::mypath; #say $tee "dumpINMORPH(\$mypath): " . dump($mypath);
70 0         0 $exeonfiles = $main::exeonfiles; #say $tee "dumpINMORPH(\$exeonfiles): " . dump($exeonfiles);
71 0         0 $generatechance = $main::generatechance;
72 0         0 $file = $main::file;
73 0         0 $preventsim = $main::preventsim;
74 0         0 $fileconfig = $main::fileconfig; #say $tee "dumpINMORPH(\$fileconfig): " . dump($fileconfig); # NOW GLOBAL. TO MAKE IT PRIVATE, FIX PASSING OF PARAMETERS IN CONTRAINTS PROPAGATION SECONDARY SUBROUTINES
75 0         0 $outfile = $main::outfile;
76 0         0 $toshell = $main::toshell;
77 0         0 $report = $main::report;
78 0         0 $simnetwork = $main::simnetwork;
79            
80 0         0 $tee = new IO::Tee(\*STDOUT, ">>$toshell"); # GLOBAL ZZZ
81            
82 0 0       0 open ( OUTFILE, ">>$outfile" ) or die "Can't open $outfile: $!";
83 0 0       0 open ( TOSHELL, ">>$toshell" ) or die "Can't open $toshell: $!";
84 0         0 say $tee "\n# Now in Sim::OPT::Morph.\n";
85            
86 0         0 %dowhat = %main::dowhat;
87              
88 0         0 @themereports = @main::themereports; #say "dumpINMORPH(\@themereports): " . dump(@themereports);
89 0         0 @simtitles = @main::simtitles; #say "dumpINMORPH(\@simtitles): " . dump(@simtitles);
90 0         0 @reporttitles = @main::reporttitles;
91 0         0 @simdata = @main::simdata;
92 0         0 @retrievedata = @main::retrievedata;
93 0         0 @keepcolumns = @main::keepcolumns;
94 0         0 @weights = @main::weights;
95 0         0 @weightsaim = @main::weightsaim;
96 0         0 @varthemes_report = @main::varthemes_report;
97 0         0 @varthemes_variations = @vmain::arthemes_variations;
98 0         0 @varthemes_steps = @main::varthemes_steps;
99 0         0 @rankdata = @main::rankdata; # CUT ZZZ
100 0         0 @rankcolumn = @main::rankcolumn;
101 0         0 @reporttempsdata = @main::reporttempsdata;
102 0         0 @reportcomfortdata = @main::reportcomfortdata;
103 0         0 @reportradiationenteringdata = @main::reportradiationenteringdata;
104 0         0 @report_loadsortemps = @main::report_loadsortemps;
105 0         0 @files_to_filter = @main::files_to_filter;
106 0         0 @filter_reports = @main::filter_reports;
107 0         0 @base_columns = @main::base_columns;
108 0         0 @maketabledata = @main::maketabledata;
109 0         0 @filter_columns = @main::filter_columns;
110            
111 0         0 my @simcases = @{ $dirfiles{simcases} }; #say "dump(\@simcases): " . dump(@simcases);
  0         0  
112 0         0 my @simstruct = @{ $dirfiles{simstruct} }; #say "dump(\@simstruct): " . dump(@simstruct);
  0         0  
113 0         0 my @morphcases = @{ $dirfiles{morphcases} };
  0         0  
114 0         0 my @morphstruct = @{ $dirfiles{morphstruct} };
  0         0  
115 0         0 my @retcases = @{ $dirfiles{retcases} };
  0         0  
116 0         0 my @retstruct = @{ $dirfiles{retstruct} };
  0         0  
117 0         0 my @repcases = @{ $dirfiles{repcases} };
  0         0  
118 0         0 my @repstruct = @{ $dirfiles{repstruct} };
  0         0  
119 0         0 my @mergecases = @{ $dirfiles{mergecases} };
  0         0  
120 0         0 my @mergestruct = @{ $dirfiles{mergestruct} };
  0         0  
121 0         0 my @descendcases = @{ $dirfiles{descendcases} };
  0         0  
122 0         0 my @descendstruct = @{ $dirfiles{descendstruct} };
  0         0  
123            
124 0         0 my $morphlist = $dirfiles{morphlist}; #say "dump(\$dat{morphlist}): " . dump($dat{morphlist});
125 0         0 my $morphblock = $dirfiles{morphblock};
126 0         0 my $simlist = $dirfiles{simlist}; #say "dump(\$simlist): " . dump($simlist);
127 0         0 my $simblock = $dirfiles{simblock};
128 0         0 my $retlist = $dirfiles{retlist};
129 0         0 my $retblock = $dirfiles{retblock};
130 0         0 my $replist = $dirfiles{replist};
131 0         0 my $repblock = $dirfiles{repblock};
132 0         0 my $descendlist = $dirfiles{descendlist};
133 0         0 my $descendblock = $dirfiles{descendblock};
134            
135 0 0       0 if ( not ( $exeonfiles ) ) { $exeonfiles = "y"; }
  0         0  
136 0 0       0 if ( not ( $preventsim ) ) { $preventsim = "n"; }
  0         0  
137 0 0       0 if ( not ( $report ) ) { $report = "$mypath/$file-report.txt"; }
  0         0  
138            
139             #my $getpars = shift;
140             #eval( $getpars );
141              
142             #if ( fileno (MORPHLIST)
143            
144 0         0 $countinstance = 1;
145 0         0 foreach my $instance (@instances)
146             {
147 0         0 my %d = %{$instance};
  0         0  
148 0         0 my $countcase = $d{countcase}; say $tee "#dump(\$countcase): " . dump($countcase);
  0         0  
149 0         0 my $countblock = $d{countblock}; say $tee "#dump(\$countblock): " . dump($countblock);
  0         0  
150 0         0 my @miditers = @{ $d{miditers} }; say $tee "#MORPH dump(\@miditers): " . dump(@miditers);
  0         0  
  0         0  
151 0         0 my @winneritems = @{ $d{winneritems} }; say $tee "#dumpIN( \@winneritems) " . dump(@winneritems);
  0         0  
  0         0  
152 0         0 my $countvar = $d{countvar}; say $tee "#dump(\$countvar): " . dump($countvar);
  0         0  
153 0         0 my $countstep = $d{countstep}; say $tee "#dump(\$countstep): " . dump($countstep);
  0         0  
154 0         0 my $to = $d{to}; #say $tee "dump(\$to): " . dump($to);
155 0         0 my $origin = $d{origin}; say $tee "#dump(\$origin): " . dump($origin);
  0         0  
156 0         0 my @uplift = @{ $d{uplift} }; say $tee "#dump(\@uplift): " . dump(@uplift);
  0         0  
  0         0  
157             #eval($getparshere);
158            
159 0         0 my $rootname = Sim::OPT::getrootname(\@rootnames, $countcase); say $tee "#dump(\$rootname): " . dump($rootname);
  0         0  
160 0         0 my @blockelts = Sim::OPT::getblockelts(\@sweeps, $countcase, $countblock); say $tee "#dumpIN( \@blockelts) " . dump(@blockelts);
  0         0  
161 0         0 my @blocks = Sim::OPT::getblocks(\@sweeps, $countcase); say $tee "#dumpIN( \@blocks) " . dump(@blocks);
  0         0  
162 0         0 my $toitem = Sim::OPT::getitem(\@winneritems, $countcase, $countblock); say $tee "#dump(\$toitem): " . dump($toitem);
  0         0  
163 0         0 my $from = Sim::OPT::getline($toitem); say $tee "#dumpIN(\$from): " . dump($from);
  0         0  
164 0         0 my %varnums = Sim::OPT::getcase(\@varinumbers, $countcase); say $tee "#dumpIN---(\%varnums): " . dump(%varnums);
  0         0  
165 0         0 my %mids = Sim::OPT::getcase(\@miditers, $countcase); say $tee "#dumpIN---(\%mids): " . dump(%mids);
  0         0  
166             #eval($getfly);
167            
168 0         0 my $stepsvar = Sim::OPT::getstepsvar($countvar, $countcase, \@varinumbers); #say $tee "#dump(\$stepsvar): " . dump($stepsvar);
169 0         0 my $varnumber = $countvar; #say $tee "#dump---(\$varnumber): " . dump($varnumber) . "\n\n"; # LEGACY VARIABLE
170            
171 0         0 my $countcaseplus1 = ( $countcase + 1);
172 0         0 my $countblockplus1 = ( $countblock + 1);
173            
174             #@totblockelts = (@totblockelts, @blockelts); # @blockelts
175             #@totblockelts = uniq(@totblockelts);
176             #@totblockelts = sort(@totblockelts);
177             #if ( $countvar == $#blockelts )
178             #{
179             # $$general_variables[0] = "n";
180             #} # THIS TELLS THAT IF THE SEARCH IS ENDING (LAST SUBSEARCH CYCLE) GENERATION OF CASES HAS TO BE TURNED OFF
181             ####### OLD. $stepsvar = ${ "varnums{$countvar}" . "$varnumber" };
182            
183 0         0 my @applytype = @{ $vals{$countvar}{applytype} }; #say "dump(\@applytype): " . dump(@applytype);
  0         0  
184 0         0 my $general_variables = $vals{$countvar}{general_variables}; #say "dump(\$general_variables): " . dump($general_variables);
185 0         0 my @generic_change = @{$vals{$countvar}{generic_change} };
  0         0  
186 0         0 my $rotate = $vals{$countvar}{rotate};
187 0         0 my $rotatez = $vals{$countvar}{rotatez};
188 0         0 my $translate = $vals{$countvar}{translate}; #say "dump(\$translate): " . dump($translate);
189 0         0 my $translate_surface_simple = $vals{$countvar}{translate_surface_simple};
190 0         0 my $translate_surface = $vals{$countvar}{translate_surface};
191 0         0 my $keep_obstructions = $vals{$countvar}{keep_obstructions};
192 0         0 my $shift_vertices = $vals{$countvar}{shift_vertices};
193 0         0 my $construction_reassignment = $vals{$countvar}{construction_reassignment};
194 0         0 my $thickness_change = $vals{$countvar}{thickness_change};
195 0         0 my $recalculateish = $vals{$countvar}{recalculateish};
196 0         0 my @recalculatenet = @{ $vals{$countvar}{recalculatenet} };
  0         0  
197 0         0 my $obs_modify = $vals{$countvar}{obs_modify};
198 0         0 my $netcomponentchange = $vals{$countvar}{netcomponentchange};
199 0         0 my $changecontrol = $vals{$countvar}{changecontrol};
200 0         0 my @apply_constraints = @{ $vals{$countvar}{apply_constraints} }; # NOW SUPERSEDED BY @constrain_geometry
  0         0  
201 0         0 my $rotate_surface = $vals{$countvar}{rotate_surface};
202 0         0 my @reshape_windows = @{ $vals{$countvar}{reshape_windows} };
  0         0  
203 0         0 my @apply_netconstraints = @{ $vals{$countvar}{apply_netconstraints} };
  0         0  
204 0         0 my @apply_windowconstraints = @{ $vals{$countvar}{apply_windowconstraints} };
  0         0  
205 0         0 my @translate_vertices = @{ $vals{$countvar}{translate_vertices} };
  0         0  
206 0         0 my $warp = $vals{$countvar}{warp};
207 0         0 my @daylightcalc = @{ $vals{$countvar}{daylightcalc} };
  0         0  
208 0         0 my @change_config = @{ $vals{$countvar}{change_config} };
  0         0  
209 0         0 my @constrain_geometry = @{ $vals{$countvar}{constrain_geometry} };
  0         0  
210 0         0 my @vary_controls = @{ $vals{$countvar}{vary_controls} };
  0         0  
211 0         0 my @constrain_controls = @{ $vals{$countvar}{constrain_controls} };
  0         0  
212 0         0 my @constrain_obstructions = @{ $vals{$countvar}{constrain_obstructions} };
  0         0  
213 0         0 my @get_obstructions = @{ $vals{$countvar}{get_obstructions} };
  0         0  
214 0         0 my $checkfile = $vals{$countvar}{checkfile};
215 0         0 my @vary_net = @{ $vals{$countvar}{vary_net} };
  0         0  
216 0         0 my @constrain_net = @{ $vals{$countvar}{constrain_net} };
  0         0  
217 0         0 my @propagate_constraints = @{ $vals{$countvar}{propagate_constraints} };
  0         0  
218 0         0 my @change_climate = @{ $vals{$countvar}{change_climate} };
  0         0  
219 0         0 my $skip = $vals{$countvar}{skip};
220 0         0 my $constrain = $vals{$countvar}{constrain};
221            
222 0         0 my ( @cases_to_sim, @files_to_convert );
223 0         0 my ( @obs, @node, @component, @loopcontrol, @flowcontrol ); # THINGS globsAL AS REGARDS TO COUNTER ZONE CYCLES
224 0         0 my ( @myobs, @mynode, @mycomponent, @myloopcontrol, @myflowcontrol); # THINGS LOCAL AS REGARDS TO COUNTER ZONE CYCLES
225 0         0 my ( @tempv, @tempobs, @tempnode, @tempcomponent, @temploopcontrol, @tempflowcontrol); # THINGS LOCAL AS REGARDS TO COUNTER ZONE CYCLES
226 0         0 my ( @v_, @doobs, @donode, @docomponent, @doloopcontrol, @doflowcontrol); # THINGS LOCAL AS REGARDS TO COUNTER ZONE CYCLES
227            
228 0         0 my $generate = $$general_variables[0];
229 0         0 my $sequencer = $$general_variables[1];
230 0         0 my $dffile = "df-$file.txt";
231            
232             #my $toshellmorph = "$toshell" . "-1morph.txt";
233             #my $outfilemorph = "$outfile" . "-1morph.txt";
234            
235             #open ( TOSHELL, ">>$toshellmorph" );
236             #open ( OUTFILE, ">>$outfilemorph" );
237            
238 0 0 0     0 if ( ( $countblock == 0 ) and ( $countstep == 1 ) )
239             {
240 0 0       0 if (not ( -e "$origin" ) )
241             {
242 0 0       0 if ($exeonfiles eq "y")
243             {
244 0         0 print `cp -R $mypath/$file $from`; #say "FROM: $from";
245             }
246 0         0 say TOSHELL "cp -R $mypath/$file $from\n";
247             }
248             }
249            
250             #if ( fileno (RETLIST) )
251             #if (not (-e $morphlist ) )
252             #{
253             # if ( $countblock == 0 )
254             # {
255 0         0 open ( MORPHLIST, ">>$morphlist"); # or die;
256             # }
257             # else
258             # {
259             # open ( MORPHLIST, ">>$morphlist"); # or die;
260             # }
261             #}
262            
263             #if ( fileno (MORPHBLOCK) )
264             #if (not (-e $morphblock ) )
265             #{
266             # if ( $countblock == 0 )
267             # {
268 0         0 open (MORPHBLOCK, ">>$morphblock");# or die;
269             # }
270             # else
271             # {
272             # open (MORPHBLOCK, ">>$morphblock");# or die;
273             # }
274             #}
275              
276 0         0 push ( @{ $morphstruct[$countcase][$countblock] }, $to );
  0         0  
277 0         0 print MORPHBLOCK "$to\n";
278 0 0       0 if ( not ( $to ~~ @morphcases ) )
279             {
280             #say "HERE2. MORPHCASES.";
281 0         0 push ( @morphcases, $to );
282 0         0 print MORPHLIST "$to\n";
283 0         0 say TOSHELL "from: $from, origin: $origin, to: $to";
284              
285             #my $from = "$case_to_sim";
286             #my $almost_to = $from;
287             #$almost_to =~ s/$varnumber-\d+/$varnumber-$countstep/ ;
288             #if ( ( $generate eq "n" )
289             # and ( ( $sequencer eq "y" ) or ( $sequencer eq "last" ) ) )
290             #{
291             # if ( $almost_to =~ m/§$/ ) { $to = "$almost_to" ; }
292             # else
293             # {
294             # #$to = "$case_to_sim$varnumber-$countstep§";
295             # $to = "$almost_to" . "§";
296             # }
297             #}
298             #elsif ( ( $generate eq "y" ) and ( $sequencer eq "n" ) )
299             #{
300             # if ( $almost_to =~ m/_$/ ) { $to = "$almost_to" ; }
301             # else
302             # {
303             # $to = "$case_to_sim$varnumber-$countstep" . "_";
304             # $to = "$almost_to" . "_";
305             # if ( $countstep == $stepsvar )
306             # {
307             # if ($exeonfiles eq "y") { print `chmod -R 777 $from\n`; }
308             # print TOSHELL "chmod -R 777 $from\n\n";
309             # }
310             # }
311             #}
312             #elsif ( ( $generate eq "y" ) and ( $sequencer eq "y" ) )
313             #{
314             # #$to = "$case_to_sim$varnumber-$countstep" . "£";
315             # $to = "$almost_to" . "£";
316             #}
317             #elsif ( ( $generate eq "y" ) and ( $sequencer eq "last" ) )
318             #{
319             # if ( $almost_to =~ m/£$/ ) { $to = "$almost_to" ; }
320             # else
321             # {
322             # #$to = "$case_to_sim$varnumber-$countstep" . "£";
323             # $to = "$almost_to" . "£";
324             # #if ( $countstep == $stepsvar )
325             # #{
326             # # if ($exeonfiles eq "y") { print `chmod -R 777 $from\n`; }
327             # # print TOSHELL "chmod -R 777 $from\n\n";
328             # #}
329             # }
330             #}
331             #elsif ( ( $generate eq "n" ) and ( $sequencer eq "n" ) )
332             #{
333             # $almost_to =~ s/[_|£]$// ;
334             # #$to = "$case_to_sim$varnumber-$countstep";
335             # $to = "$almost_to";
336             #}
337            
338 0 0 0     0 if
339             #(
340             #( $generate eq "y" )
341             #and ( $countstep == $stepsvar )
342             #and ( ( $sequencer eq "n" ) or ( $sequencer eq "last" ) )
343             #and ( ($skip ne "") and ($skipask ne "yes") )
344             #and
345             ( ( not (-e $to) ) and ( not ( eval $skip->[ $countop ] ) ) )
346             #)
347             {
348             #say TOSHELL "HERE2A. MAIN. ";
349            
350 0 0       0 if ($exeonfiles eq "y")
351             {
352 0         0 print `cp -R $origin $to\n`;
353             }
354 0         0 print TOSHELL "cp -R $origin $to\n\n";
355             #say "HERE2B";
356            
357 0         0 $countop = 0; # "$countop" IS THE COUNTER OF THE OPEATIONS
358 0         0 foreach my $op (@applytype) # "$op" MEANS OPERATION
359             {
360              
361 0         0 my $modification_type = $applytype[$countop][0];
362 0 0 0     0 if ( ( $applytype[$countop][1] ne $applytype[$countop][2] ) and ( $modification_type ne "changeconfig" ) )
363             {
364 0 0       0 if ($exeonfiles eq "y")
365             {
366 0         0 print `cp -f $to/zones/$applytype[$countop][1] $to/zones/$applytype[$countop][2]\n`;
367             }
368 0         0 print TOSHELL "cp -f $to/zones/$applytype[$countop][1] $to/zones/$applytype[$countop][2]\n\n";
369 0 0       0 if ($exeonfiles eq "y")
370             {
371 0         0 print `cp -f $to/cfg/$applytype[$countop][1] $to/cfg/$applytype[$countop][2]\n`;
372             } # ORDINARILY, THIS PART CAN BE REMOVED
373 0         0 print TOSHELL "cp -f $to/cfg/$applytype[$countop][1] $to/cfg/$applytype[$countop][2]\n\n";
374             }# ORDINARILY, THIS PART CAN BE REMOVED
375 0 0 0     0 if ( ( $applytype[$countop][1] ne $applytype[$countop][2] ) and ( $modification_type eq "changeconfig" ) )
376             {
377 0 0       0 if ($exeonfiles eq "y")
378             {
379 0         0 print `cp -f $to/cfg/$applytype[$countop][1] $to/cfg/$applytype[$countop][2]\n`;
380             }
381 0         0 print TOSHELL "cp -f $to/cfg/$applytype[$countop][1] $to/cfg/$applytype[$countop][2]\n\n";
382             } # ORDINARILY, THIS PART CAN BE REMOVED
383              
384            
385 0         0 print `cd $to`;
386 0         0 print TOSHELL "cd $to\n\n";
387            
388 0 0 0     0 if ( ( $stepsvar > 1) and ( not ( eval $skip) ) )
389             {
390             sub dothings
391             { # THIS CONTAINS FUNCTIONS THAT APPLY CONSTRAINTS AND UPDATE CALCULATIONS.
392             #if ( $get_obstructions[$countop][0] eq "y" )
393             #{
394             # get_obstructions # THIS IS TO MEMORIZE OBSTRUCTIONS.
395             # # THEY WILL BE SAVED IN A TEMPORARY FILE.
396             # ($to, $fileconfig, $stepsvar, $countop,
397             # $countstep, $exeonfiles, \@applytype, \@get_obstructions, $configfile, $countvar, $fileconfig );
398             #}
399 0     0 0 0 my ( $whatdone ) = @_;
400 0 0 0     0 if ( ( $propagate_constraints[$countop] ) and ( not ( $whatdone eq "done_constraint_propagation" ) ) )
401             {
402 0         0 &propagate_constraints
403             ($to, $stepsvar, $countop,
404             $countstep, \@applytype, \@propagate_constraints, $countvar, $fileconfig );
405             }
406 0 0 0     0 if ( ( $constrain_geometry[$countop] ) and ( not ( $whatdone eq "done_geo_constraint" ) ) )
407             {
408 0         0 @v_ = constrain_geometry
409             ( $to, $stepsvar, $countop,
410             $countstep, \@applytype, \@constrain_geometry, $countvar, $fileconfig, \@v_ );
411             }
412 0 0 0     0 if ( ( $constrain_controls[$countop] ) and ( not ( $whatdone eq "done_constrol_constraint" ) ) )
413             {
414 0         0 &constrain_controls
415             ( $to, $stepsvar, $countop,
416             $countstep, \@applytype, \@constrain_controls, $countvar, $fileconfig );
417             }
418 0 0 0     0 if ( ( $constrain_net[$countop] ) and ( not ( $whatdone eq "done_net_constraint" ) ) )
419             {
420 0         0 &constrain_net( $to, $stepsvar, $countop,
421             $countstep, \@applytype, \@constrain_net, $to_do, $countvar, $fileconfig );
422             }
423 0 0 0     0 if ( ( $constrain_obstructions[$countop] ) and ( not ( $whatdone eq "done_obs_constraint" ) ) )
424             {
425 0         0 &constrain_obstructions
426             ( $to, $stepsvar, $countop,
427             $countstep, \@applytype, \@constrain_obstructions, $to_do, $countvar, $fileconfig );
428             }
429 0 0       0 if ( $$keep_obstructions[$countop] )
430             {
431 0         0 &bring_obstructions_back( $to, $stepsvar, $countop,
432             $countstep, \@applytype, $keep_obstructions, $countvar, $fileconfig );
433             }
434 0 0       0 if ( $apply_constraints[$countop] )
435             {
436 0         0 &apply_constraints
437             ( $to, $stepsvar, $countop,
438             $countstep, \@applytype, \@apply_constraints, $countvar, $fileconfig );
439             }
440 0 0       0 if ( $recalculatenet[$countop] )
441             {
442 0         0 &recalculatenet
443             ( $to, $stepsvar, $countop,
444             $countstep, \@applytype, \@recalculatenet, $countvar, $fileconfig );
445             }
446 0 0       0 if ( $recalculateish eq "y" )
447             {
448 0         0 &recalculateish
449             ( $to, $stepsvar, $countop,
450             $countstep, \@applytype, \@recalculateish, $countvar, $fileconfig );
451             }
452 0 0       0 if ( $daylightcalc[0] eq "y" )
453             {
454 0         0 &daylightcalc
455             ( $to, $stepsvar, $countop,
456             $countstep, \@applytype, $filedf, \@daylightcalc, $countvar, $fileconfig );
457             }
458             } # END SUB DOTHINGS
459              
460 0 0       0 if ( $modification_type eq "generic_change" )#
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
461             {
462 0         0 &make_generic_change
463             ($to, $stepsvar, $countop, $countstep,
464             \@applytype, $generic_change, $countvar, $fileconfig );
465 0         0 &dothings;
466             } #
467             elsif ( $modification_type eq "surface_translation_simple" )
468             {
469 0         0 &translate_surfaces_simple
470             ($to, $stepsvar, $countop, $countstep,
471             \@applytype, $translate_surface_simple, $countvar, $fileconfig );
472 0         0 &dothings;
473             }
474             elsif ( $modification_type eq "surface_translation" )
475             {
476 0         0 &translate_surfaces
477             ($to, $stepsvar, $countop, $countstep,
478             \@applytype, $translate_surface, $countvar, $fileconfig );
479 0         0 &dothings;
480             }
481             elsif ( $modification_type eq "surface_rotation" ) #
482             {
483 0         0 &rotate_surface
484             ($to, $stepsvar, $countop, $countstep,
485             \@applytype, $rotate_surface, $countvar, $fileconfig );
486 0         0 &dothings;
487             }
488             elsif ( $modification_type eq "vertices_shift" )
489             {
490 0         0 &shift_vertices
491             ($to, $stepsvar, $countop, $countstep,
492             \@applytype, $shift_vertices, $countvar, $fileconfig );
493 0         0 &dothings;
494             }
495             elsif ( $modification_type eq "vertex_translation" )
496             {
497 0         0 &translate_vertices
498             ($to, $stepsvar, $countop, $countstep,
499             \@applytype, \@translate_vertices, $countvar, $fileconfig );
500 0         0 &dothings;
501             }
502             elsif ( $modification_type eq "construction_reassignment" )
503             {
504 0         0 &reassign_construction
505             ($to, $stepsvar, $countop, $countstep,
506             \@applytype, $construction_reassignment, $countvar, $fileconfig );
507 0         0 &dothings;
508             }
509             elsif ( $modification_type eq "rotation" )
510             {
511 0         0 &rotate
512             ($to, $stepsvar, $countop, $countstep,
513             \@applytype, $rotate, $countvar, $fileconfig );
514 0         0 &dothings;
515             }
516             elsif ( $modification_type eq "translation" )
517             {
518 0         0 &translate
519             ($to, $stepsvar, $countop, $countstep,
520             \@applytype, $translate, $countvar, $fileconfig );
521 0         0 &dothings;
522             }
523             elsif ( $modification_type eq "thickness_change" )
524             {
525 0         0 &change_thickness
526             ($to, $stepsvar, $countop, $countstep,
527             \@applytype, $thickness_change, $countvar, $fileconfig );
528 0         0 &dothings;
529             }
530             elsif ( $modification_type eq "rotationz" )
531             {
532 0         0 &rotatez
533             ($to, $stepsvar, $countop, $countstep,
534             \@applytype, $rotatez, $countvar, $fileconfig );
535 0         0 &dothings;
536             }
537             elsif ( $modification_type eq "change_config" )
538             {
539 0         0 &change_config
540             ($to, $stepsvar, $countop, $countstep,
541             \@applytype, \@change_config, $countvar, $fileconfig );
542 0         0 &dothings;
543             }
544             elsif ( $modification_type eq "window_reshapement" )
545             {
546 0         0 &reshape_windows
547             ($to, $stepsvar, $countop, $countstep,
548             \@applytype, \@reshape_windows, $countvar, $fileconfig );
549 0         0 &dothings;
550             }
551             elsif ( $modification_type eq "obs_modification" ) # REWRITE FOR NEW GEO FILE?
552             {
553 0         0 &obs_modify
554             ($to, $stepsvar, $countop, $countstep,
555             \@applytype, $obs_modify, $countvar, $fileconfig );
556 0         0 &dothings;
557             }
558             elsif ( $modification_type eq "warping" )
559             {
560 0         0 &warp
561             ($to, $stepsvar, $countop, $countstep,
562             \@applytype, $warp, $countvar, $fileconfig );
563 0         0 &dothings;
564             }
565             elsif ( $modification_type eq "vary_controls" )
566             {
567 0         0 &vary_controls
568             ($to, $stepsvar, $countop, $countstep,
569             \@applytype, \@vary_controls, $countvar, $fileconfig );
570 0         0 &dothings;
571             }
572             elsif ( $modification_type eq "vary_net" )
573             {
574 0         0 &vary_net
575             ($to, $stepsvar, $countop, $countstep,
576             \@applytype, \@vary_net, $countvar, $fileconfig );
577 0         0 &dothings;
578             }
579             elsif ( $modification_type eq "change_climate" )
580             {
581 0         0 &change_climate
582             ($to, $stepsvar, $countop, $countstep,
583             \@applytype, \@change_climate, $countvar, $fileconfig );
584 0         0 &dothings;
585             }
586             elsif ( $modification_type eq "vary_controls" )
587             {
588 0         0 &dothings( "done_control_constraint" );
589             }
590             elsif ( $modification_type eq "constrain_geometry" )
591             {
592 0         0 &dothings( "done_geo_constraint" );
593             }
594             elsif ( $modification_type eq "vary_net" )
595             {
596 0         0 &dothings( "done_net_constraint" );
597             }
598             elsif ( $modification_type eq "constrain_obstructions" )
599             {
600 0         0 &dothings( "done_obs_constraint" );
601             }
602             elsif ( $modification_type eq "propagate_constraints" )
603             {
604 0         0 &dothings( "done_constraint_propagation" );
605             }
606             }
607 0         0 $countop++;
608 0         0 print `cd $mypath`;
609 0         0 print TOSHELL "cd $mypath\n\n";
610             }
611             }
612             #else
613             #{
614             # if ($exeonfiles eq "y") { print `cp -R $origin $to\n`; }
615             # print TOSHELL "cp -R $origin $to\n\n";
616             #}
617             #push(@morphed, $to);
618             }
619 0         0 close MORPHLIST;
620 0         0 close MORPHBLOCK;
621 0         0 $countinstance++;
622             }
623 0         0 close TOSHELL;
624 0         0 close OUTFILE;
625 0         0 return (\@morphcases, \@morphsruct);
626             } # END SUB morph
627              
628              
629             sub translate
630             {
631 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $translate, $countvar, $fileconfig ) = @_;
632 0         0 my @applytype = @$swap;
633 0         0 my $zone_letter = $applytype[$countop][3];
634            
635 0         0 say "Translating zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
636 0         0 say TOSHELL "#Translating zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
637              
638 0 0       0 if ( $stepsvar > 1 )
639             {
640 0         0 my $yes_or_no_translate_obstructions = "$$translate[$countop][0]";
641 0         0 my $yes_or_no_update_radiation = $$translate[$countop][1];
642 0         0 my $configfile = $$translate[$countop][3];
643 0 0       0 if ( $yes_or_no_update_radiation eq "y" )
644             {
645 0         0 $yes_or_no_update_radiation = "a";
646             }
647             else
648             {
649 0         0 $yes_or_no_update_radiation = "c";
650             }
651              
652 0         0 my @coordinates_for_movement = @{ $$translate[$countop][1] };
  0         0  
653 0         0 my $x_end = $coordinates_for_movement[0];
654 0         0 my $y_end = $coordinates_for_movement[1];
655 0         0 my $z_end = $coordinates_for_movement[2];
656 0         0 my $x_swingtranslate = ( 2 * $x_end );
657 0         0 my $y_swingtranslate = ( 2 * $y_end );
658 0         0 my $z_swingtranslate = ( 2 * $z_end );
659 0         0 my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
660 0         0 my $x_movement = (- ( $x_end - ( $x_pace * ( $countstep - 1 ) ) ));
661 0         0 my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
662 0         0 my $y_movement = (- ( $y_end - ( $y_pace * ( $countstep - 1 ) ) ));
663 0         0 my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
664 0         0 my $z_movement = (- ( $z_end - ( $z_pace * ( $countstep - 1 ) ) ));
665              
666 0         0 my $printthis =
667             "prj -file $to/cfg/$fileconfig -mode script<
668              
669             m
670             c
671             a
672             $zone_letter
673             i
674             e
675             $x_movement $y_movement $z_movement
676             y
677             $yes_or_no_translate_obstructions
678             -
679             y
680             c
681             -
682             -
683             -
684             -
685             -
686             -
687             -
688             -
689             -
690             YYY
691             ";
692              
693 0 0       0 if ($exeonfiles eq "y")
694             {
695 0         0 print `$printthis`;
696             }
697 0         0 print TOSHELL
698             "#Translating zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.\"
699             $printthis
700             ";
701             }
702             } # end sub translate
703              
704             my $countcycles_transl_surfs = 0;
705              
706              
707             sub translate_surfaces
708             {
709 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $translate_surface, $countvar, $fileconfig ) = @_;
710 0         0 say TOSHELL "got \$to : " . dump($to); say TOSHELL "got \$stepsvar : " . dump($stepsvar);
  0         0  
711 0         0 say TOSHELL "got \$countop : " . dump($countop); say TOSHELL "got \$countstep : " . dump($countstep);
  0         0  
712 0         0 say TOSHELL "got \$swap : " . dump($swap); say TOSHELL "got \$translate_surface : " . dump($translate_surface);
  0         0  
713 0         0 say TOSHELL "got \$countvar : " . dump($countvar); say TOSHELL "got \$fileconfig : " . dump($fileconfig);
  0         0  
714            
715 0         0 my @applytype = @$swap; say TOSHELL "got \@applytype : " . dump(@applytype);
  0         0  
716 0         0 my $zone_letter = $applytype[$countop][3]; say TOSHELL "got \$zone_letter : " . dump($zone_letter);
  0         0  
717            
718 0         0 say "Translating surfaces for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
719              
720 0         0 my $transform_type = $$translate_surface[$countop][0]; say TOSHELL "got \$transform_type : " . dump($transform_type);
  0         0  
721 0         0 my @surfs_to_transl = @{ $translate_surface->[$countop][1] }; say TOSHELL "got \@surfs_to_transl : " . dump(@surfs_to_transl);
  0         0  
  0         0  
722 0         0 my @ends_movs = @{ $translate_surface->[$countop][2] }; say TOSHELL "got \@ends_movs : " . dump(@ends_movs); # end points of the movements.
  0         0  
  0         0  
723 0         0 my $yes_or_no_update_radiation = $$translate_surface[$countop][3]; say TOSHELL "got \$yes_or_no_update_radiation : " . dump($yes_or_no_update_radiation);
  0         0  
724 0         0 my @transform_coordinates = @{ $translate_surface->[$countop][4] }; say TOSHELL "got \@transform_coordinates : " . dump(@transform_coordinates);
  0         0  
  0         0  
725 0         0 my $countsurface = 0;
726 0         0 my ( $end_mov, $mov_surf, $pace, $movement, $surface_letter_constrainedarea, $movement_constrainedarea, $pace, $swing_surf, $movement );
727              
728 0         0 foreach my $surface_letter (@surfs_to_transl)
729 0         0 { say TOSHELL "got \$surface_letter : " . dump($surface_letter);
730 0         0 say TOSHELL "got \$stepsvar : " . dump($stepsvar);
731 0 0       0 if ( $stepsvar > 1 )
732             {
733 0         0 say TOSHELL "got \$transform_type : " . dump($transform_type);
734 0 0       0 if ($transform_type eq "a")
    0          
735             {
736 0         0 $end_mov = $ends_movs[$countsurface]; say TOSHELL "got \$end_mov : " . dump($end_mov); say TOSHELL "got \$countstep : " . dump($countstep);
  0         0  
  0         0  
737 0 0       0 if ( ref ( $end_mov ) )
738             {
739 0         0 my $min = $end_mov->[0]; say TOSHELL "FROM REF got \$min : " . dump($min);
  0         0  
740 0         0 my $max = $end_mov->[1]; say TOSHELL "FROM REF got \$max : " . dump($max);
  0         0  
741 0         0 $swing_surf = ( $max - $min ); say TOSHELL "FROM REF got \$swing_surf : " . dump($swing_surf);
  0         0  
742 0         0 $end_mov = ( $swing_surf / 2 ); say TOSHELL "FROM REF got \$end_mov : " . dump($end_mov);
  0         0  
743             }
744             else
745             {
746 0         0 $swing_surf = $end_mov * 2; say TOSHELL "got \$swing_surf : " . dump($swing_surf);
  0         0  
747             }
748            
749 0         0 $pace = ( $swing_surf / ( $stepsvar - 1 ) ); say TOSHELL "got \$pace : " . dump($pace);
  0         0  
750 0         0 say TOSHELL "got \$end_mov : " . dump($end_mov); say TOSHELL "got \$countstep : " . dump($countstep);
  0         0  
751 0         0 $movement = ( - ( ($end_mov) -( $pace * ( $countstep - 1 ) ) ) ); say TOSHELL "RESULT: got \$movement : " . dump($movement);
  0         0  
752            
753 0         0 my $printthis =
754             "prj -file $to/cfg/$fileconfig -mode script<
755              
756             m
757             c
758             a
759             $zone_letter
760             e
761             >
762             $surface_letter
763             $transform_type
764             $movement
765             y
766             -
767             -
768             y
769             c
770             -
771             -
772             -
773             -
774             -
775             -
776             -
777             -
778             YYY
779             ";
780 0 0       0 if ($exeonfiles eq "y")
781             {
782 0         0 print `$printthis`;
783             }
784 0         0 print TOSHELL "
785             #Translating surfaces for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance
786             $printthis";
787              
788 0         0 $countsurface++;
789 0         0 $countcycles_transl_surfs++;
790             }
791             elsif ($transform_type eq "b")
792             {
793 0         0 my @coordinates_for_movement = @{ $transform_coordinates[$countsurface] };
  0         0  
794 0         0 my $x_end = $coordinates_for_movement[0];
795 0         0 my $y_end = $coordinates_for_movement[1];
796 0         0 my $z_end = $coordinates_for_movement[2];
797 0         0 my $x_swingtranslate = ( 2 * $x_end );
798 0         0 my $y_swingtranslate = ( 2 * $y_end );
799 0         0 my $z_swingtranslate = ( 2 * $z_end );
800 0         0 my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
801 0         0 my $x_movement = (- ( $x_end - ( $x_pace * ( $countstep - 1 ) ) ));
802 0         0 my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
803 0         0 my $y_movement = (- ( $y_end - ( $y_pace * ( $countstep - 1 ) ) ));
804 0         0 my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
805 0         0 my $z_movement = (- ( $z_end - ( $z_pace * ( $countstep - 1 ) ) ));
806              
807 0         0 my $printthis =
808             "prj -file $to/cfg/$fileconfig -mode script<
809              
810             m
811             c
812             a
813             $zone_letter
814             e
815             >
816             $surface_letter
817             $transform_type
818             $x_movement $y_movement $z_movement
819             y
820             -
821             -
822             y
823             c
824             -
825             -
826             -
827             -
828             -
829             -
830             -
831             -
832             YYY
833             ";
834              
835 0 0       0 if ($exeonfiles eq "y")
836             {
837 0         0 print `$printthis`;
838             }
839              
840 0         0 print TOSHELL "
841             #Translating surfaces for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance
842             $printthis";
843              
844 0         0 $countsurface++;
845 0         0 $countcycles_transl_surfs++;
846             }
847             }
848             }
849             } # END SUB translate_surfaces
850              
851              
852             sub rotate_surface
853             {
854 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $applytyperef, $rotate_surface, $countvar, $fileconfig ) = @_;
855            
856 0         0 my @applytype = @$applytyperef;
857 0         0 my $zone_letter = $applytype[$countop][3];
858            
859 0         0 say "Rotating surfaces for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
860            
861 0         0 my @surfs_to_rotate = @{ $rotate_surface->[$countop][0] };
  0         0  
862 0         0 my @vertices_numbers = @{ $rotate_surface->[$countop][1] };
  0         0  
863 0         0 my @swingrotations = @{ $rotate_surface->[$countop][2] };
  0         0  
864 0         0 my @yes_or_no_apply_to_others = @{ $rotate_surface->[$countop][3] };
  0         0  
865 0         0 my $configfile = $$rotate_surface[$countop][4];
866 0         0 my ( $swingrotate, $pacerotate, $rotation_degrees, $vertex_number, $yes_or_no_apply );
867              
868 0         0 my $countrotate = 0;
869 0         0 foreach my $surface_letter (@surfs_to_rotate)
870             {
871 0         0 $swingrotate = $swingrotations[$countrotate];
872              
873 0 0       0 if ( ref ( $swingrotate ) )
874             {
875 0         0 my $min = $end_mov_>[0];
876 0         0 my $max = $end_mov->[1];
877 0         0 $swingrotate = ( $max - $min );
878             }
879             else
880             {
881 0         0 $swingrotate = $end_mov * 2;
882             }
883              
884 0         0 $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
885 0         0 $rotation_degrees = ( ( $swingrotate / 2 ) - ( $pacerotate * ( $countstep - 1 ) )) ;
886 0         0 $vertex_number = $vertices_numbers[$countrotate];
887 0         0 $yes_or_no_apply = $yes_or_no_apply_to_others[$countrotate];
888 0 0 0     0 if ( ( $swingrotate != 0 ) and ( $stepsvar > 1 ) and ( $yes_or_no_rotate_surfs eq "y" ) )
      0        
889             {
890 0         0 my $printthis =
891             "prj -file $to/cfg/$fileconfig -mode script<
892              
893             m
894             c
895             a
896             $zone_letter
897             e
898             >
899             $surface_letter
900             c
901             $vertex_number
902             $rotation_degrees
903             $yes_or_no_apply
904             -
905             -
906             y
907             c
908             -
909             -
910             -
911             -
912             -
913             -
914             -
915             -
916             YYY
917             ";
918 0 0       0 if ($exeonfiles eq "y")
919             {
920 0         0 print `$printthis`;
921             }
922              
923 0         0 print TOSHELL "
924             Rotating surfaces for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance
925             $printthis";
926             }
927 0         0 $countrotate++;
928             }
929             } # END SUB rotate_surface
930              
931              
932             sub translate_vertices # TO BE RE-TESTED.
933             {
934 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig) = @_;
935 0         0 my @applytype = @$swap;
936 0         0 my $zone_letter = $applytype[$countop][3];
937 0         0 my @translate_vertices = @$swap2;
938 0         0 say "Translating vertices for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
939 0         0 my @v;
940 0         0 my @verts_to_transl = @{ $translate_vertices[$countop][0] };
  0         0  
941 0         0 my @transform_coordinates = @{ $translate_vertices[$countop][1] };
  0         0  
942 0         0 my @sourcefiles = @{ $translate_vertices[$countop][2] };
  0         0  
943 0         0 my @longmenus = @{ $translate_vertices[$countop][3] };
  0         0  
944            
945 0         0 my $sourcefile = $sourcefiles[ $countops ];
946 0         0 my $longmenu = $longmenus[ $countops ];
947 0         0 my $sourceaddress = "$mypath/$file$sourcefile";
948            
949 0 0       0 open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
950 0         0 my @lines = ;
951 0         0 close SOURCEFILE;
952            
953 0         0 my $countlines = 0;
954 0         0 my $countvert = 0;
955              
956 0         0 my @vertex_letters;
957 0 0       0 if ($longmenu eq "y")
958             {
959 0         0 @vertex_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
960             "n", "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv",
961             "0\nb\nw", "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd",
962             "0\nb\ne","0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni",
963             "0\nb\n0\nb\nj","0\nb\n0\nb\nk","0\nb\n0\nb\nl","0\nb\n0\nb\nm","0\nb\n0\nb\nn",
964             "0\nb\n0\nb\no","0\nb\n0\nb\np","0\nb\n0\nb\nq","0\nb\n0\nb\nr","0\nb\n0\nb\ns",
965             "0\nb\n0\nb\nt");
966             }
967             else
968             {
969 0         0 @vertex_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
970             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
971             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
972             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
973             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
974             }
975              
976 0         0 foreach my $line (@lines)
977             {
978 0         0 $line =~ s/^\s+//;
979 0         0 my @rowelements = split(/\s+|,/, $line);
980 0 0       0 if ($rowelements[0] eq "*vertex" )
981             {
982 0 0       0 if ($countvert == 0)
983             {
984 0         0 push (@v, [ "vertices of $sourceaddress" ]);
985 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ], $vertexletters[$countvert] );
986             }
987              
988 0 0       0 if ($countvert > 0)
989             {
990 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3], $vertexletters[$countvert] ] );
991             }
992 0         0 $countvert++;
993             }
994 0         0 $countlines++;
995             }
996              
997 0         0 my $countvertex = 0;
998 0         0 foreach my $vertex_letter (@vertex_letters)
999             {
1000 0         0 my ( $x_swingtranslate, $y_swingtranslate, $z_swingtranslate );
1001 0         0 my @base_coordinates = @{ $transform_coordinates[ $countvertex ] };
  0         0  
1002            
1003 0         0 my $x_end = $base_coordinates[0];
1004 0 0       0 if ( ref ( $x_end ) )
1005             {
1006 0         0 my $min = $x_end->[0];
1007 0         0 my $max = $x_end->[1];
1008 0         0 $x_swingtranslate = ( $max - $min );
1009             }
1010             else
1011             {
1012 0         0 $x_swingtranslate = ( 2 * $x_end );
1013             }
1014              
1015 0         0 my $y_end = $base_coordinates[1];
1016 0 0       0 if ( ref ( $y_end ) )
1017             {
1018 0         0 my $min = $y_end->[0];
1019 0         0 my $max = $y_end->[1];
1020 0         0 $y_swingtranslate = ( $max - $min );
1021             }
1022             else
1023             {
1024 0         0 $y_swingtranslate = ( 2 * $y_end );
1025             }
1026            
1027 0         0 my $z_end = $base_coordinates[2];
1028 0 0       0 if ( ref ( $z_end ) )
1029             {
1030 0         0 my $min = $z_end->[0];
1031 0         0 my $max = $z_end->[1];
1032 0         0 $z_swingtranslate = ( $max - $min );
1033             }
1034             else
1035             {
1036 0         0 $z_swingtranslate = ( 2 * $z_end );
1037             }
1038            
1039 0         0 my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1040 0         0 my $x_movement = (- ( $x_end - ( $x_pace * ( $countstep - 1 ) ) ));
1041 0         0 my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
1042 0         0 my $y_movement = (- ( $y_end - ( $y_pace * ( $countstep - 1 ) ) ));
1043 0         0 my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
1044 0         0 my $z_movement = (- ( $z_end - ( $z_pace * ( $countstep - 1 ) ) ));
1045 0         0 my $printthis =
1046             "prj -file $to/cfg/$fileconfig -mode script<
1047              
1048             m
1049             c
1050             a
1051             $zone_letter
1052             d
1053             $vertex_letter
1054             $x_movement $y_movement $z_movement
1055             -
1056             y
1057             -
1058             y
1059             c
1060             -
1061             -
1062             -
1063             -
1064             -
1065             -
1066             -
1067             -
1068             -
1069             YYY
1070             ";
1071 0 0       0 if ($exeonfiles eq "y")
1072             {
1073 0         0 print `$printthis`;
1074             }
1075              
1076 0         0 print TOSHELL "
1077             #Translating vertices for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1078             $printthis";
1079 0         0 $countvertex++;
1080             }
1081 0         0 $countops++;
1082             } # END SUB translate_vertices
1083              
1084              
1085             sub shift_vertices
1086             {
1087 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $shift_vertices, $countvar, $fileconfig ) = @_;
1088            
1089 0         0 my @applytype = @$swap;
1090 0         0 my $zone_letter = $applytype[$countop][3];
1091            
1092 0         0 say "Shifting vertices for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1093              
1094 0         0 my ( $pace, $movement );
1095 0         0 my $movementtype = $$shift_vertices[$countop][0];
1096 0         0 my @pairs_of_vertices = @{ $$shift_vertices[$countop][1] };
  0         0  
1097 0         0 my @shift_swings = @{ $$shift_vertices[$countop][2] };
  0         0  
1098 0         0 my $yes_or_no_radiation_update = $$shift_vertices[$countop][3];
1099 0         0 my $configfile = $$shift_vertices[$countop][4];
1100            
1101 0 0       0 if ( $stepsvar > 1 )
1102             {
1103 0         0 my $countthis = 0;
1104 0 0       0 if ($movementtype eq "j")
    0          
1105             {
1106 0         0 foreach my $shift_swing (@shift_swings)
1107             {
1108            
1109 0 0       0 if ( ref ( $shift_swing ) )
1110             {
1111 0         0 my $min = $shift_swing->[0];
1112 0         0 my $max = $shift_swing->[1];
1113 0         0 $shift_swing = ( $max - $min );
1114             }
1115             else
1116             {
1117             ;
1118             }
1119            
1120 0         0 $pace = ( $shift_swing / ( $stepsvar - 1 ) );
1121 0         0 $movement_or_vertex = ( ( ($shift_swing) / 2 ) - ( $pace * ( $countstep - 1 ) ) );
1122 0         0 $vertex1 = $pairs_of_vertices[ 0 + ( 2 * $countthis ) ];
1123 0         0 $vertex2 = $pairs_of_vertices[ 1 + ( 2 * $countthis ) ];
1124            
1125 0         0 my $printthis =
1126             "prj -file $to/cfg/$fileconfig -mode script<
1127              
1128             m
1129             c
1130             a
1131             $zone_letter
1132             d
1133             ^
1134             $movementtype
1135             $vertex1
1136             $vertex2
1137             -
1138             $movement_or_vertex
1139             y
1140             -
1141             y
1142             -
1143             y
1144             -
1145             -
1146             -
1147             -
1148             -
1149             -
1150             -
1151             -
1152             YYY
1153             ";
1154 0 0       0 if ($exeonfiles eq "y")
1155             {
1156 0         0 print `$printthis`;
1157             }
1158 0         0 print TOSHELL "
1159             #Shifting vertices for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1160             $printthis";
1161              
1162 0         0 $countthis++;
1163             }
1164             }
1165             elsif ($movementtype eq "h")
1166             {
1167 0         0 foreach my $shift_swing (@shift_swings)
1168             {
1169 0         0 my $printthis =
1170             "prj -file $to/cfg/$fileconfig -mode script<
1171              
1172             m
1173             c
1174             a
1175             $zone_letter
1176             d
1177             ^
1178             $movementtype
1179             $vertex1
1180             $vertex2
1181             -
1182             $movement_or_vertex
1183             -
1184             y
1185             n
1186             n
1187             n
1188             -
1189             y
1190             -
1191             y
1192             -
1193             -
1194             -
1195             -
1196             -
1197             -
1198             -
1199             -
1200             YYY
1201             ";
1202 0 0       0 if ($exeonfiles eq "y")
1203             {
1204 0         0 print `$printthis`;
1205             }
1206 0         0 print TOSHELL "
1207             #Shifting vertices for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1208             $printthis";
1209             }
1210             }
1211             }
1212             } # END SUB shift_vertices
1213              
1214              
1215             sub rotate # generic zone rotation
1216             {
1217 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $rotate, $countvar, $fileconfig ) = @_;
1218            
1219 0         0 my @applytype = @$swap;
1220 0         0 my $zone_letter = $applytype[$countop][3];
1221            
1222 0         0 say "Rotating zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1223              
1224 0         0 my $rotation_degrees;
1225 0         0 my $swingrotate = $$rotate[$countop][0];
1226            
1227 0 0       0 if ( ref ( $swingrotate ) )
1228             {
1229 0         0 my $min = $swingrotate->[0];
1230 0         0 my $max = $swingrotate->[1];
1231 0         0 $swingrotate = ( $max - $min );
1232             }
1233            
1234 0         0 my $yes_or_no_update_radiation = $$rotate[$countop][1];
1235 0         0 my $base_vertex = $$rotate[$countop][2];
1236 0         0 my $configfile = $$rotate[$countop][3];
1237 0         0 my $pacerotate;
1238 0         0 my $count_rotate = 0;
1239 0 0 0     0 if ( ( $swingrotate != 0 ) and ( $stepsvar > 1 ) )
1240             {
1241 0         0 $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
1242 0         0 $rotation_degrees = ( ( $swingrotate / 2 ) - ( $pacerotate * ( $countstep - 1 ) ) );
1243              
1244 0         0 my $printthis =
1245             "prj -file $to/cfg/$fileconfig -mode script<
1246              
1247              
1248             m
1249             c
1250             a
1251             $zone_letter
1252             i
1253             b
1254             $rotation_degrees
1255             $base_vertex
1256             -
1257             $yes_or_no_rotate_obstructions
1258             -
1259             y
1260             c
1261             -
1262             y
1263             -
1264             -
1265             -
1266             -
1267             -
1268             -
1269             -
1270             -
1271             YYY
1272             ";
1273              
1274 0 0       0 if ($exeonfiles eq "y")
1275             {
1276 0         0 print `$printthis`;
1277             }
1278 0         0 print TOSHELL
1279             "
1280             #Rotating zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1281             $printthis
1282             ";
1283             }
1284             } # END SUB rotate
1285              
1286              
1287             sub rotatez # PUT THE ROTATION POINT AT POINT 0, 0, 0. I HAVE NOT YET MADE THE FUNCTION GENERIC ENOUGH.
1288             {
1289 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $rotatez, $countvar, $fileconfig ) = @_;
1290            
1291 0         0 my @applytype = @$swap;
1292 0         0 my $zone_letter = $applytype[$countop][3];
1293            
1294 0         0 say "Rotating zones on the vertical plane for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1295              
1296 0         0 my @centerpoints = @{$$rotatez[0]};
  0         0  
1297 0         0 my $centerpointsx = $centerpoints[0];
1298 0         0 my $centerpointsy = $centerpoints[1];
1299 0         0 my $centerpointsz = $centerpoints[2];
1300 0         0 my $plane_of_rotation = "$$rotatez[1]";
1301 0         0 my $infile = "$to/zones/$applytype[$countop][2]";
1302 0         0 my $infile2 = "$to/cfg/$applytype[$countop][2]";
1303 0         0 my $outfilemorph = "erase";
1304 0         0 my $outfile2 = "$to/zones/$applytype[$countop][2]eraseobtained";
1305 0 0       0 open(INFILE, "$infile") or die "Can't open infile $infile: $!\n";
1306 0 0       0 open($_outfile_2, ">>$outfile2") or die "Can't open outfile2 $outfile2: $!\n";
1307 0         0 my @lines = ;
1308 0         0 close(INFILE);
1309 0         0 my $countline = 0;
1310 0         0 my $countcases = 0;
1311 0         0 my @vertices;
1312 0         0 my $swingrotate = $$rotatez[2];
1313 0         0 my $alreadyrotation = $$rotatez[3];
1314 0         0 my $rotatexy = $$rotatez[4];
1315 0         0 my $swingrotatexy = $$rotatez[5];
1316            
1317 0 0       0 if ( ref ( $swingrotate ) )
1318             {
1319 0         0 my $min = $swingrotate->[0];
1320 0         0 my $max = $swingrotate->[1];
1321 0         0 $swingrotatexy = ( $max - $min );
1322             }
1323             else { ; }
1324            
1325 0 0       0 if ( ref ( $swingrotate ) )
1326             {
1327 0         0 my $min = $swingrotate->[0];
1328 0         0 my $max = $swingrotate->[1];
1329 0         0 $swingrotatexy = ( $max - $min );
1330             }
1331             else { ; }
1332            
1333 0         0 my ( $pacerotate, $linenew, $linenew2 );
1334 0         0 my $count_rotate = 0;
1335 0         0 my ( @rowprovv, @rowprovv2, @row, @row2 );
1336 0 0       0 if ( $stepsvar > 1 )
1337             {
1338 0         0 foreach my $line (@lines)
1339             {#
1340             {
1341 0         0 $linenew = $line;
  0         0  
1342 0         0 $linenew =~ s/\:\s/\:/g ;
1343 0         0 @rowprovv = split(/\s+/, $linenew);
1344 0         0 $rowprovv[0] =~ s/\:\,/\:/g ;
1345 0         0 @row = split(/\,/, $rowprovv[0]);
1346 0 0       0 if ($row[0] eq "*vertex")
1347 0         0 { push (@vertices, [$row[1], $row[2], $row[3]] ) }
1348             }
1349 0         0 $countline = $countline +1;
1350             }
1351              
1352 0         0 foreach $vertex (@vertices)
1353             {
1354 0         0 print $_outfile_ "vanilla ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
  0         0  
  0         0  
  0         0  
1355             }
1356 0         0 foreach $vertex (@vertices)
1357             {
1358 0         0 ${$vertex}[0] = (${$vertex}[0] - $centerpointsx);
  0         0  
  0         0  
1359 0         0 ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
  0         0  
  0         0  
1360 0         0 ${$vertex}[1] = (${$vertex}[1] - $centerpointsy);
  0         0  
  0         0  
1361 0         0 ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
  0         0  
  0         0  
1362 0         0 ${$vertex}[2] = (${$vertex}[2] - $centerpointsz);
  0         0  
  0         0  
1363 0         0 ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
  0         0  
  0         0  
1364 0         0 print $_outfile_ "aftersum ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
  0         0  
  0         0  
  0         0  
1365             }
1366              
1367 0         0 my $anglealready = deg2rad(-$alreadyrotation);
1368 0         0 foreach $vertex (@vertices)
1369             {
1370 0         0 my $x_new = cos($anglealready)*${$vertex}[0] - sin($anglealready)*${$vertex}[1];
  0         0  
  0         0  
1371 0         0 my $y_new = sin($anglealready)*${$vertex}[0] + cos($anglealready)*${$vertex}[1];
  0         0  
  0         0  
1372 0         0 ${$vertex}[0] = $x_new; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
  0         0  
  0         0  
  0         0  
  0         0  
1373 0         0 ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
  0         0  
  0         0  
  0         0  
  0         0  
1374 0         0 print $_outfile_ "afterfirstrotation ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
  0         0  
  0         0  
  0         0  
1375             }
1376              
1377 0         0 $pacerotate = ( $swingrotate / ( $stepsvar - 1) );
1378 0         0 $rotation_degrees = - ( ($swingrotate / 2) - ($pacerotate * ($countstep -1) ) );
1379 0         0 my $angle = deg2rad($rotation_degrees);
1380 0         0 foreach $vertex (@vertices)
1381             {
1382 0         0 my $y_new = cos($angle)*${$vertex}[1] - sin($angle)*${$vertex}[2];
  0         0  
  0         0  
1383 0         0 my $z_new = sin($angle)*${$vertex}[1] + cos($angle)*${$vertex}[2];
  0         0  
  0         0  
1384 0         0 ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
  0         0  
  0         0  
  0         0  
  0         0  
1385 0         0 ${$vertex}[2] = $z_new; ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
  0         0  
  0         0  
  0         0  
  0         0  
1386 0         0 ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
  0         0  
  0         0  
1387 0         0 print $_outfile_ "aftersincos ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
  0         0  
  0         0  
  0         0  
1388             }
1389              
1390 0         0 my $angleback = deg2rad($alreadyrotation);
1391 0         0 foreach $vertex (@vertices)
1392             {
1393 0         0 my $x_new = cos($angleback)*${$vertex}[0] - sin($angleback)*${$vertex}[1];
  0         0  
  0         0  
1394 0         0 my $y_new = sin($angleback)*${$vertex}[0] + cos($angleback)*${$vertex}[1];
  0         0  
  0         0  
1395 0         0 ${$vertex}[0] = $x_new; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
  0         0  
  0         0  
  0         0  
  0         0  
1396 0         0 ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
  0         0  
  0         0  
  0         0  
  0         0  
1397 0         0 print $_outfile_ "afterrotationback ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";ctl type
  0         0  
  0         0  
  0         0  
  0         0  
1398             }
1399              
1400 0         0 foreach $vertex (@vertices)
1401             {
1402 0         0 ${$vertex}[0] = ${$vertex}[0] + $centerpointsx; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1403 0         0 ${$vertex}[1] = ${$vertex}[1] + $centerpointsy; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1404 0         0 ${$vertex}[2] = ${$vertex}[2] + $centerpointsz; ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
1405 0         0 print $_outfile_ "after final substraction ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
  0         0  
  0         0  
  0         0  
1406             }
1407              
1408 0         0 my $countwrite = -1;
1409 0         0 my $countwriteand1;
1410 0         0 foreach $line (@lines)
1411             {#
1412              
1413 0         0 $linenew2 = $line;
1414 0         0 $linenew2 =~ s/\:\s/\:/g ;
1415 0         0 my @rowprovv2 = split(/\s+/, $linenew2);
1416 0         0 $rowprovv2[0] =~ s/\:\,/\:/g ;
1417 0         0 @row2 = split(/\,/, $rowprovv2[0]);
1418 0         0 $countwriteright = ($countwrite - 5);
1419 0         0 $countwriteand1 = ($countwrite + 1);
1420 0 0       0 if ($row2[0] eq "*vertex")
1421             {
1422 0 0       0 if ( $countwrite == - 1) { $countwrite = 0 }
  0         0  
1423 0         0 print $_outfile_2
1424 0         0 "*vertex"."\,"."${$vertices[$countwrite]}[0]"."\,"."${$vertices[$countwrite]}[1]"."\,"."${$vertices[$countwrite]}[2]"." # "."$countwriteand1\n";
  0         0  
  0         0  
1425             }
1426             else
1427             {
1428 0         0 print $_outfile_2 "$line";
1429             }
1430 0 0       0 if ( $countwrite > ( - 1 ) ) { $countwrite++; }
  0         0  
1431             }
1432              
1433 0         0 close($_outfile_);
1434 0 0       0 if ($exeonfiles eq "y") { print `chmod 777 $infile`; }
  0         0  
1435 0         0 print TOSHELL "chmod -R 777 $infile\n";
1436 0 0       0 if ($exeonfiles eq "y") { print `chmod 777 $infile2`; }
  0         0  
1437 0         0 print TOSHELL "chmod -R 777 $infile2\n";
1438 0 0       0 if ($exeonfiles eq "y") { print `rm $infile`; }
  0         0  
1439 0         0 print TOSHELL "rm $infile\n";
1440 0 0       0 if ($exeonfiles eq "y") { print `chmod 777 $outfile2`; }
  0         0  
1441 0         0 print TOSHELL "chmod 777 $outfile2\n";
1442 0 0       0 if ($exeonfiles eq "y") { print `cp $outfile2 $infile`; }
  0         0  
1443 0         0 print TOSHELL "cp $outfile2 $infile\n";
1444 0 0       0 if ($exeonfiles eq "y") { print `cp $outfile2 $infile2`; }
  0         0  
1445 0         0 print TOSHELL "cp $outfile2 $infile2\n";
1446             }
1447             } # END SUB rotatez
1448              
1449              
1450             sub reassign_construction
1451             {
1452 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $construction_reassignment, $countvar, $fileconfig ) = @_;
1453            
1454 0         0 my @applytype = @$swap;
1455 0         0 my $zone_letter = $applytype[$countop][3];
1456            
1457 0         0 say "Reassign construction solutions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1458              
1459 0         0 my @surfaces_to_reassign = @{ $construction_reassignment->[$countop][0] };
  0         0  
1460 0         0 my @constructions_to_choose = @{ $construction_reassignment->[$countop][1] };
  0         0  
1461 0         0 my $configfile = $$construction_reassignment[$countop][2];
1462 0         0 my $surface_letter;
1463 0         0 my $count = 0;
1464 0         0 my @reassign_constructions;
1465              
1466 0         0 foreach $surface_to_reassign (@surfaces_to_reassign)
1467             {
1468 0         0 $construction_to_choose = $constructions_to_choose[$count][$countstep];
1469            
1470 0         0 my $printthis =
1471             "prj -file $to/cfg/$fileconfig -mode script<
1472              
1473             m
1474             c
1475             a
1476             $zone_letter
1477             f
1478             $surface_to_reassign
1479             e
1480             n
1481             y
1482             $construction_to_choose
1483             -
1484             -
1485             -
1486             -
1487             y
1488             y
1489             -
1490             -
1491             -
1492             -
1493             -
1494             -
1495             -
1496             -
1497             YYY
1498             ";
1499 0 0       0 if ($exeonfiles eq "y")
1500             {
1501 0         0 print `$printthis`;
1502             }
1503              
1504 0         0 print TOSHELL "
1505             #Reassign construction solutions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1506             $printthis";
1507 0         0 $count++;
1508             }
1509              
1510             } # END SUB reassign_construction
1511              
1512            
1513             sub change_thickness
1514             {
1515 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $thickness_change, $countvar, $fileconfig ) = @_;
1516 0         0 my @applytype = @$swap;
1517 0         0 my $zone_letter = $applytype[$countop][3];
1518            
1519 0         0 say "Changing thicknesses in construction layer for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1520              
1521 0         0 my @entries_to_change = @{ $$thickness_change[$countop][0] };
  0         0  
1522 0         0 my @groups_of_strata_to_change = @{ $$thickness_change[$countop][1] };
  0         0  
1523 0         0 my @groups_of_couples_of_min_max_values = @{ $$thickness_change[$countop][2] };
  0         0  
1524 0         0 my $configfile = $$thickness_change[$countop][3];
1525 0         0 my $thiscount = 0;
1526 0         0 my ( $entry_to_change, $countstrata, $stratum_to_change, $min, $max, $change_stratum, $enter_change_entry, $swing, $pace, $thickness );
1527 0         0 my ( @strata_to_change, @min_max_values , @change_strata, @change_entries, @change_entries_with_thicknesses );
1528              
1529 0 0       0 if ( $stepsvar > 1 )
1530             {
1531 0         0 foreach $entry_to_change (@entries_to_change)
1532             {
1533 0         0 @strata_to_change = @{ $groups_of_strata_to_change[$thiscount] };
  0         0  
1534 0         0 $countstrata = 0;
1535 0         0 foreach $stratum_to_change (@strata_to_change)
1536             {
1537 0         0 @min_max_values = @{ $groups_of_couples_of_min_max_values[$thiscount][$countstrata] };
  0         0  
1538 0         0 $min = $min_max_values[0];
1539 0         0 $max = $min_max_values[1];
1540 0         0 $swing = $max - $min;
1541 0         0 $pace = ( $swing / ( $stepsvar - 1 ) );
1542 0         0 $thickness = $min + ( $pace * ( $countstep - 1 ) );
1543              
1544 0         0 my $printthis =
1545             "prj -file $to/cfg/$fileconfig -mode script<
1546             b
1547             e
1548             a
1549             $entry_to_change
1550             $stratum_to_change
1551             n
1552             $thickness
1553             -
1554             -
1555             y
1556             y
1557             -
1558             y
1559             y
1560             -
1561             -
1562             -
1563             -
1564             -
1565             YYY
1566             ";
1567 0 0       0 if ($exeonfiles eq "y")
1568             {
1569 0         0 print `$printthis`;
1570             }
1571 0         0 print TOSHELL "
1572             #Changing thicknesses in construction layer for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1573             $printthis";
1574 0         0 $countstrata++;
1575             }
1576 0         0 $thiscount++;
1577             }
1578 0         0 $" = " ";
1579 0 0       0 if ($exeonfiles eq "y") { print `$enter_esp$go_to_construction_database@change_entries_with_thicknesses$exit_construction_database_and_esp`; }
  0         0  
1580 0         0 print TOSHELL "$enter_esp$go_to_construction_database@change_entries_with_thicknesses$exit_construction_database_and_esp\n";
1581             }
1582             } # END sub change_thickness
1583              
1584              
1585             sub readgeofile
1586             { # THIS READS A GEO FILE TO GET THE DATA OF THE REQUESTED OBSTRUCTIONS
1587 0     0 0 0 my $geofile = $_[0]; #say "geofile: $geofile";
1588 0 0       0 open (GEOFILE, "$geofile") or die;
1589 0         0 my @lines = ;
1590 0         0 close GEOFILE;
1591              
1592 0         0 foreach my $line (@lines)
1593             {
1594 0         0 my @elts = split(/\s+|,/, $line); #say "elts: " . dump(@elts);
1595             #*obs,3.000,-1.500,6.000,0.010,1.500,3.000,0.000,1.00,left3,wall27 # block 3
1596 0 0       0 if ($elts[0] eq "\*obs")
1597             {
1598 0         0 push ( @obsdata, [ @elts ] );
1599             }
1600             }
1601 0         0 return ( @obsdata );
1602             }
1603              
1604              
1605             sub obs_modify
1606             {
1607 0 0   0 0 0 if ( $stepsvar > 1 )
1608             {
1609 0         0 my ( $to, $stepsvar, $countop, $countstep, $swap, $obs_modify, $countvar, $fileconfig ) = @_;
1610 0         0 my @applytype = @$swap;
1611 0         0 my $zone_letter = $applytype[$countop][3];
1612 0         0 say "Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
1613              
1614 0         0 my @obs_letters = @{ $$obs_modify[$countop][0] };
  0         0  
1615 0         0 my $modification_type = $$obs_modify[$countop][1];
1616 0         0 my @values = @{ $$obs_modify[$countop][2] };
  0         0  
1617 0         0 my @base = @{ $$obs_modify[$countop][3] };
  0         0  
1618 0         0 my $configfile = $$obs_modify[$countop][4];
1619 0         0 my $xz_resolution = $$obs_modify[$countop][5];
1620 0         0 my $countobs = 0;
1621 0         0 my ( $x_end, $y_end, $z_end, $x_base, $y_base, $z_base, $end_value, $base_value, $x_swingtranslate,
1622             $y_swingtranslate, $z_swingtranslate, $x_pace, $x_value, $y_pace, $y_value, $z_pace, $z_value );
1623 0 0 0     0 if ( ($modification_type eq "a") or ($modification_type eq "b"))
1624             {
1625 0         0 $x_end = $values[0];
1626 0 0       0 if ( ref ( $x_end ) )
1627             {
1628 0         0 my $min = $x_end->[0];
1629 0         0 my $max = $x_end->[1];
1630 0         0 $x_swingtranslate = ( $max - $min );
1631             }
1632             else
1633             {
1634 0         0 $x_swingtranslate = ( 2 * $x_end );
1635             }
1636 0         0 $x_base = $base[0];
1637            
1638 0         0 $y_end = $values[1];
1639 0 0       0 if ( ref ( $y_end ) )
1640             {
1641 0         0 my $min = $y_end->[0];
1642 0         0 my $max = $y_end->[1];
1643 0         0 $y_swingtranslate = ( $max - $min );
1644             }
1645             else
1646             {
1647 0         0 $y_swingtranslate = ( 2 * $y_end );
1648             }
1649 0         0 $y_base = $base[1];
1650            
1651 0         0 $z_end = $values[2];
1652 0 0       0 if ( ref ( $z_end ) )
1653             {
1654 0         0 my $min = $z_end->[0];
1655 0         0 my $max = $z_end->[1];
1656 0         0 $z_swingtranslate = ( $max - $min );
1657             }
1658             else
1659             {
1660 0         0 $z_swingtranslate = ( 2 * $z_end );
1661             }
1662 0         0 $z_base = $base[2];
1663              
1664 0         0 $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1665 0         0 $x_value = ($x_base + ( $x_end - ( $x_pace * ( $countstep - 1 ) ) ));
1666 0         0 $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
1667 0         0 $y_value = ($y_base + ( $y_end - ( $y_pace * ( $countstep - 1 ) ) ));
1668 0         0 $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
1669 0         0 $z_value = ($z_base + ( $z_end - ( $z_pace * ( $countstep - 1 ) ) ));
1670              
1671 0         0 my $printthis =
1672             "prj -file $to/cfg/$fileconfig -mode script<
1673              
1674             m
1675             c
1676             a
1677             $zone_letter
1678             h
1679             a
1680             $obs_letter
1681             $modification_type
1682             a
1683             $x_value $y_value $z_value
1684             -
1685             -
1686             c
1687             -
1688             c
1689             -
1690             -
1691             -
1692             -
1693             -
1694             -
1695             -
1696             -
1697             YYY
1698             ";
1699 0         0 foreach my $obs_letter (@obs_letters)
1700             {
1701 0 0       0 if ($exeonfiles eq "y")
1702             {
1703 0         0 print `$printthis`;
1704             }
1705 0         0 print TOSHELL "
1706             #Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1707             $printthis";
1708 0         0 $countobs++;
1709             }
1710             }
1711              
1712 0 0 0     0 if ( ($modification_type eq "c") or ($modification_type eq "d"))
1713             {
1714 0         0 $x_end = $values[0];
1715            
1716 0 0       0 if ( ref ( $x_end ) )
1717             {
1718 0         0 my $min = $x_end->[0];
1719 0         0 my $max = $x_end->[1];
1720 0         0 $x_swingtranslate = ( $max - $min );
1721             }
1722             else
1723             {
1724 0         0 $x_swingtranslate = ( 2 * $x_end );
1725             }
1726            
1727 0         0 $x_base = $base[0];
1728 0         0 $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1729 0         0 $x_value = ($x_base + ( $x_end - ( $x_pace * ( $countstep - 1 ) ) ));
1730              
1731 0         0 foreach my $obs_letter (@obs_letters)
1732             {
1733 0         0 my $printthis =
1734             "prj -file $to/cfg/$fileconfig -mode script<
1735              
1736             m
1737             c
1738             a
1739             $zone_letter
1740             h
1741             a
1742             $obs_letter
1743             $modification_type
1744             $x_value
1745             -
1746             -
1747             c
1748             -
1749             c
1750             -
1751             -
1752             -
1753             -
1754             -
1755             -
1756             -
1757             -
1758             YYY
1759             ";
1760 0 0       0 if ($exeonfiles eq "y")
1761             {
1762 0         0 print `$printthis`;
1763             }
1764 0         0 print TOSHELL "
1765             #Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1766             $printthis";
1767 0         0 $countobs++;
1768             }
1769             }
1770              
1771 0 0       0 if ($modification_type eq "g")
1772             {
1773 0         0 foreach my $obs_letter (@obs_letters)
1774             {
1775 0         0 my $count = 0;
1776 0         0 foreach my $x_value (@values)
1777             {
1778 0 0       0 if ($count < $stepsvar)
1779             {
1780 0         0 my $printthis =
1781             "prj -file $to/cfg/$fileconfig -mode script<
1782              
1783             m
1784             c
1785             a
1786             $zone_letter
1787             h
1788             a
1789             $obs_letter
1790             $modification_type
1791             $x_value
1792             -
1793             -
1794             -
1795             -
1796             -
1797             -
1798             -
1799             -
1800             -
1801             -
1802             -
1803             -
1804             -
1805             -
1806             YYY
1807             ";
1808 0 0       0 if ($exeonfiles eq "y")
1809             {
1810 0         0 print `$printthis`;
1811             }
1812 0         0 print TOSHELL "
1813             Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1814             $printthis";
1815 0         0 $countobs++;
1816 0         0 $count++;
1817             }
1818             }
1819             }
1820             }
1821              
1822 0 0       0 if ($modification_type eq "h")
1823             {
1824 0         0 $x_end = $values[0];
1825 0         0 $x_base = $base[0];
1826            
1827 0 0       0 if ( ref ( $x_end ) )
1828             {
1829 0         0 my $min = $x_end->[0];
1830 0         0 my $max = $x_end->[1];
1831 0         0 $x_end = ( $max - $min );
1832             }
1833             else
1834             {
1835             ;
1836             }
1837            
1838 0         0 $x_swingtranslate = ( $x_base - $x_end );
1839 0         0 $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1840 0         0 $x_value = ($x_base - ( $x_pace * ( $countstep - 1 ) ));
1841              
1842 0         0 foreach my $obs_letter (@obs_letters)
1843             {
1844 0         0 my $printthis =
1845             "prj -file $to/cfg/$fileconfig -mode script<
1846              
1847             m
1848             c
1849             a
1850             $zone_letter
1851             h
1852             a
1853             $obs_letter
1854             $modification_type
1855             $x_value
1856             -
1857             -
1858             -
1859             -
1860             -
1861             -
1862             -
1863             -
1864             -
1865             -
1866             -
1867             -
1868             -
1869             -
1870             YYY
1871             ";
1872 0 0       0 if ($exeonfiles eq "y")
1873             {
1874 0         0 print `$printthis`;
1875             }
1876 0         0 print TOSHELL $printthis;
1877 0         0 $countobs++;
1878             }
1879             }
1880              
1881 0 0       0 if ($modification_type eq "t")
1882             {
1883 0         0 my $modification_type = "~";
1884 0         0 my $what_todo = $base[0];
1885 0         0 $x_end = $values[0];
1886 0         0 $y_end = $values[1];
1887 0         0 $z_end = $values[2];
1888            
1889 0 0       0 if ( ref ( $x_end ) )
1890             {
1891 0         0 my $min = $x_end->[0];
1892 0         0 my $max = $x_end->[1];
1893 0         0 $x_swingtranslate = ( $max - $min );
1894             }
1895             else
1896             {
1897 0         0 $x_swingtranslate = ( 2 * $x_end );;
1898             }
1899            
1900 0 0       0 if ( ref ( $y_end ) )
1901             {
1902 0         0 my $min = $y_end->[0];
1903 0         0 my $max = $y_end->[1];
1904 0         0 $y_swingtranslate = ( $max - $min );
1905             }
1906             else
1907             {
1908 0         0 $y_swingtranslate = ( 2 * $y_end );;
1909             }
1910            
1911 0 0       0 if ( ref ( $z_end ) )
1912             {
1913 0         0 my $min = $z_end->[0];
1914 0         0 my $max = $z_end->[1];
1915 0         0 $z_swingtranslate = ( $max - $min );
1916             }
1917             else
1918             {
1919 0         0 $z_swingtranslate = ( 2 * $z_end );;
1920             }
1921            
1922 0         0 $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1923 0         0 $x_value = ( $x_end - ( $x_pace * ( $countstep - 1 ) ) );
1924 0         0 $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
1925 0         0 $y_value = ( $y_end - ( $y_pace * ( $countstep - 1 ) ) );
1926 0         0 $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
1927 0         0 $z_value = ( $z_end - ( $z_pace * ( $countstep - 1 ) ) );
1928              
1929 0         0 foreach my $obs_letter (@obs_letters)
1930             {
1931 0         0 my $printthis =
1932             "prj -file $to/cfg/$fileconfig -mode script<
1933              
1934             m
1935             c
1936             a
1937             $zone_letter
1938             h
1939             a
1940             $modification_type
1941             $what_todo
1942             $obs_letter
1943             -
1944             $x_value $y_value $z_value
1945             -
1946             c
1947             -
1948             c
1949             -
1950             -
1951             -
1952             -
1953             -
1954             -
1955             -
1956             -
1957             YYY
1958             ";
1959 0 0       0 if ($exeonfiles eq "y")
1960             {
1961 0         0 print `$printthis`;
1962             }
1963 0         0 print TOSHELL "
1964             Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
1965             $printthis";
1966 0         0 $countobs++;
1967             }
1968             }
1969              
1970             #NOW THE XZ GRID RESOLUTION WILL BE PUT TO THE SPECIFIED VALUE
1971 0         0 my $printthis = #THIS IS WHAT HAPPEN INSIDE SUB KEEP_SOME_OBSTRUCTIONS
1972             "prj -file $to/cfg/$fileconfig -mode script<
1973              
1974              
1975             m
1976             c
1977             a
1978             $zone_letter
1979             h
1980             a
1981             a
1982             $xz_resolution
1983             -
1984             c
1985             -
1986             c
1987             -
1988             -
1989             -
1990             -
1991             -
1992             -
1993             -
1994             YYY
1995             ";
1996 0 0       0 if ($exeonfiles eq "y")
1997             {
1998 0         0 print `$printthis`;
1999             }
2000 0         0 print TOSHELL "
2001             Modifying obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2002             $printthis";
2003             }
2004             } # END SUB obs_modify.
2005              
2006              
2007             sub bring_obstructions_back
2008             {
2009 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $keep_obstructions, $countvar, $fileconfig ) = @_;
2010 0         0 my @applytype = @$swap;
2011 0         0 my $geofile = $applytype[$countop][1];
2012 0         0 my $zone_letter = $applytype[$countop][3];
2013 0         0 my $ref = $$keep_obstructions[$countop];
2014 0         0 my %keepobs = %$ref;
2015 0         0 my $what = $keepobs{what};
2016 0         0 my $tempname = $keepobs{tempname};
2017 0         0 my $obsnumbersref = $keepobs{obsnumbers};
2018 0         0 my @obsnumbers = @$obsnumbersref;
2019            
2020 0         0 say "Keeping some obstructions in positions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2021              
2022 0 0       0 if ( $what eq "read" )
2023             {
2024 0         0 `cp -f $geofile $tempname`;
2025             }
2026            
2027 0 0       0 if ( $what eq "write" )
2028             {
2029 0 0       0 open (GEOFILE, "$geofile") or die;
2030 0         0 my @geolines = ;
2031 0         0 close GEOFILE;
2032 0         0 `mv -f $geofile $geofile.tmp `;
2033            
2034 0         0 open (TEMPFILE, "$tempname");
2035 0         0 my @templines = ;
2036 0         0 close TEMPFILE;
2037            
2038 0         0 my ( @tempobs );
2039              
2040 0         0 foreach my $line (@templines)
2041             {
2042 0         0 my @elts = split(/\s+|,/, $line); #say "elts: " . dump(@elts);
2043             #*obs,3.000,-1.500,6.000,0.010,1.500,3.000,0.000,1.00,left3,wall27 # block 3
2044 0 0 0     0 if ( ( $elts[0] eq "\*obs" ) and ( $elts[13] ~~ @obsnumbers ) )
2045             {
2046 0         0 push ( @tempobs, $line );
2047             }
2048             }
2049            
2050 0 0       0 open ( GEOFILE, ">$geofile" ) or die;
2051 0         0 my $countline = 0;
2052 0         0 foreach my $line ( @geolines )
2053             {
2054 0         0 my @elts = split(/\s+|,/, $line); #say "elts: " . dump(@elts);
2055            
2056 0 0 0     0 if ( ( $elts[0] eq "\*obs" ) and ( $elts[13] ~~ @obsnumbers ) )
2057             {
2058 0         0 print GEOFILE $templines[ $countline ];
2059             }
2060             else
2061             {
2062 0         0 print GEOFILE $line;
2063             }
2064 0         0 $countline++,
2065             }
2066 0         0 close GEOFILE;
2067             }
2068             } # END SUB bring_obstructions_back
2069              
2070              
2071             sub recalculateish
2072             {
2073 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $countvar, $fileconfig ) = @_;
2074            
2075 0         0 my @applytype = @$swap;
2076            
2077 0         0 say "Updating the insolation calculations for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2078              
2079 0         0 my $zone_letter = $applytype[$countop][3];
2080              
2081 0         0 my $printthis =
2082             "prj -file $to/cfg/$fileconfig -mode script<
2083              
2084             m
2085             c
2086             f
2087             *
2088             a
2089             a
2090             -
2091             -
2092             -
2093             -
2094             -
2095             -
2096             YYY
2097             ";
2098 0 0       0 if ($exeonfiles eq "y")
2099             {
2100 0         0 print `$printthis`;
2101             }
2102              
2103 0         0 print TOSHELL "
2104             #Updating the insolation calculations for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2105             $printthis";
2106             } #END SUB RECALCULATEISH
2107            
2108              
2109             sub ifempty
2110             {
2111 0     0 0 0 my ( $dir, $d ) = @_;
2112 0 0       0 opendir($d, $dir) or die;
2113 0 0       0 return ( scalar( grep{ $_ ne "." and $_ ne ".." } readdir($d)) == 0 );
  0         0  
2114             }
2115              
2116            
2117             sub daylightcalc # IT WORKS ONLY IF THE "RAD" DIRECTORY IS EMPTY
2118             {
2119 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $filedf, $swap2, $countvar, $fileconfig ) = @_;
2120            
2121 0         0 my @applytype = @$swap;
2122 0         0 my $zone_letter = $applytype[$countop][3];
2123 0         0 my @daylightcalc = @$swap2;
2124            
2125 0         0 say "Performing daylight calculations through Radiance for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2126              
2127 0         0 my $zone = $daylightcalc[0];
2128 0         0 my $surface = $daylightcalc[1];
2129 0         0 my $where = $daylightcalc[2];
2130 0         0 my $edge = $daylightcalc[3];
2131 0         0 my $distance = $daylightcalc[4];
2132 0         0 my $density = $daylightcalc[5];
2133 0         0 my $accuracy = $daylightcalc[6];
2134 0         0 my $filedf = $daylightcalc[7];
2135 0         0 my $pathdf = "$to/rad/$filedf";
2136 0         0 my $printthis;
2137            
2138 0 0       0 if ( not ( ifempty ( "$to/rad/" ) ) )
2139             {
2140 0         0 $printthis =
2141             "
2142             cd $to/cfg/
2143             e2r -file $to/cfg/$fileconfig -mode script<
2144             a
2145              
2146             d
2147              
2148             g
2149             -
2150             e
2151             d
2152              
2153              
2154              
2155             y
2156             -
2157             g
2158             y
2159             $zone
2160             -
2161             $surface
2162             $distance
2163             $where
2164             $edge
2165             -
2166             $density
2167              
2168             i
2169             $accuracy
2170             y
2171             a
2172             a
2173             -
2174             -
2175             YYY
2176             \n\n
2177             cd $mypath
2178             ";
2179             }
2180            
2181 0 0       0 if ( ifempty ( "$to/rad/" ) )
2182             {
2183 0         0 $printthis =
2184             "
2185             cd $to/cfg/
2186             e2r -file $to/cfg/$fileconfig -mode script<
2187              
2188             a
2189              
2190             a
2191             d
2192             $zone
2193             -
2194             $surface
2195             $distance
2196             $where
2197             $edge
2198             -
2199             $density
2200             y
2201             $accuracy
2202             a
2203             -
2204             -
2205             -
2206             -
2207             -
2208             YYY
2209             \n\n
2210             cd $mypath
2211             ";
2212             }
2213            
2214 0 0       0 if ($exeonfiles eq "y")
2215             {
2216 0         0 print `$printthis`;
2217             }
2218              
2219 0         0 print TOSHELL "
2220             #Performing daylight calculations through Radiance for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2221             $printthis";
2222              
2223 0 0       0 open( RADFILE, $pathdf) or die "Can't open $pathdf: $!\n";
2224 0         0 my @linesrad = ;
2225 0         0 close RADFILE;
2226 0         0 my @dfs;
2227             my $dfaverage;
2228 0         0 my $sum = 0;
2229 0         0 foreach my $linerad (@linesrad)
2230             {
2231 0         0 $linerad =~ s/^\s+//;
2232 0         0 my @rowelements = split(/\s+|,/, $linerad);
2233 0         0 push (@dfs, $rowelements[-1]);
2234             }
2235 0         0 foreach my $df (@dfs)
2236             {
2237 0         0 $sum = ($sum + $df);
2238             }
2239 0         0 $dfaverage = ( $sum / scalar(@dfs) );
2240              
2241 0 0       0 open( DFFILE, ">>$dffile" ) or die "Can't open $dffile: $!";
2242 0         0 print DFFILE "$dfaverage\n";
2243 0         0 close DFFILE;
2244              
2245             } # END SUB daylightcalc
2246              
2247              
2248            
2249             sub change_config
2250             {
2251 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
2252            
2253 0         0 my @applytype = @$swap;
2254 0         0 my $zone_letter = $applytype[$countop][3];
2255 0         0 my @change_config = @$swap2;
2256            
2257 0         0 say "Substituting a configuration file for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2258              
2259 0         0 my @change_conf = @{$change_config[$countezone]};
  0         0  
2260 0         0 my @original_configfiles = @{$change_conf[0]};
  0         0  
2261 0         0 my @new_configfiles = @{$change_conf[1]};
  0         0  
2262 0         0 my $countconfig = 0;
2263 0         0 my $original_configfile = $original_configfiles[$countstep-1];
2264 0         0 my $new_configfile = $new_configfiles[$countstep-1];
2265 0 0       0 if ( $new_configfile ne $original_configfile )
2266             {
2267 0 0       0 if ($exeonfiles eq "y") { print `cp -f $to/$new_configfile $to/$original_configfile\n`; }
  0         0  
2268 0         0 print TOSHELL "cp -f $to/$new_configfile $to/$original_configfile\n";
2269             }
2270 0         0 $countconfig++;
2271             } # END SUB copy_config
2272              
2273              
2274             sub checkfile # THIS CHECKS IF A SOURCE FILE MUST BE SUBSTITUTED BY ANOTHER ONE.
2275             {
2276 0     0 0 0 my ( $sourceaddress, $targetaddress ) = @_;
2277              
2278 0 0 0     0 unless ( ($sourceaddress eq "" ) or ( $targetaddress eq "" ))
2279             {
2280 0         0 print $_outfile_ "TARGETFILE IN FUNCTION: $targetaddress\n";
2281 0 0       0 if ( $sourceaddress ne $targetaddress )
2282             {
2283 0 0       0 if ($exeonfiles eq "y")
2284             {
2285 0         0 print
2286             `cp -f $sourceaddress $targetaddress\n`;
2287             }
2288 0         0 print TOSHELL
2289             "cp -f $sourceaddress $targetaddress\n\n";
2290             }
2291             }
2292             } # END SUB checkfile
2293              
2294              
2295             sub change_climate ### THIS SIMPLE SCRIPT HAS TO BE DEBUGGED. WHY DOES IT BLOCK ITSELF IF PRINTED TO THE SHELL?
2296             { # THIS FUNCTION CHANGES THE CLIMATE FILES.
2297 0     0 0 0 my $to = shift;
2298 0         0 my $stepsvar = shift;
2299 0         0 my $countop = shift;
2300 0         0 my $countstep = shift;
2301 0         0 my $swap = shift;
2302 0         0 my @applytype = @$swap;
2303 0         0 my $zone_letter = $applytype[$countop][3];
2304 0         0 my $change_climate = shift;
2305 0         0 my $countvar = shift;
2306 0         0 my $fileconfig = shift;
2307            
2308 0         0 say "Substituting climate database for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2309              
2310 0         0 my @climates = @{$change_climate[$countop]};
  0         0  
2311 0         0 my $climate = $climates[$countstep-1];
2312 0 0       0 open ( FILECONFIG, $fileconfig ) or die;
2313 0         0 print TOSHELL "opening $fileconfig for reading\n";
2314 0         0 my @lines = ;
2315 0         0 my ( $oldfile, $climatefolder );
2316 0         0 foreach my $line ( @lines )
2317             {
2318 0 0       0 if ( $line =~ /^\*clm/ )
2319             {
2320 0         0 my @row = split ( /\s+/ , $line );
2321 0         0 $climatefile = $row[1]
2322             }
2323 0         0 ( $climatefolder, $oldfile ) = /(.+\/)(\w+)/ ;
2324 0         0 $line =~ s/$oldfile$/$climate/;
2325            
2326 0         0 my $tempfileconfig = $fileconfig . ".temp";
2327 0 0       0 open ( TEMPFILECONFIG, ">$tempfileconfig" ) or die;
2328 0         0 print TOSHELL "opening $tempfileconfig for printing\n";
2329 0         0 print TEMPFILECONFIG $line;
2330             }
2331 0         0 close FILECONFIG;
2332 0         0 close TEMPFILECONFIG;
2333 0         0 `cp -R -f $tempfileconfig $fileconfig\n`;
2334 0         0 print TOSHELL "cp -R -f $tempfileconfig $fileconfig\n";
2335              
2336 0         0 print TOSHELL "
2337             #Substituting a configuration file with climate updated for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2338             $printthis";
2339             }
2340              
2341            
2342             sub recalculatenet # THIS FUNCTION HAS BEEN OUTDATED BY THOSE FOR CONSTRAINING THE NETS, BELOW, BUT WORKS AND IS SIMPLER
2343             {
2344 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
2345            
2346 0         0 my @applytype = @$swap;
2347 0         0 my $zone_letter = $applytype[$countop][3];
2348 0         0 my @recalculatenet = @$swap2;
2349            
2350 0         0 say "Adequating the ventilation network for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2351            
2352 0         0 my $filenet = $recalculatenet[0];
2353 0         0 my $infilenet = "$mypath/$file/nets/$filenet";
2354 0         0 my @nodezone_data_tot = @{$recalculatenet[1]}; ################
  0         0  
2355 0         0 my @nodesdata_tot = @{$recalculatenet[2]}; ###############
  0         0  
2356 0         0 my $geosourcefilesref = $recalculatenet[3]; ###################
2357 0         0 my $configaddress = $recalculatenet[4]; # FILE FOR PROPAGATION OF CONSTRAINTS
2358 0         0 my $y_or_n_reassign_cp = $recalculatenet[5];
2359 0         0 my $y_or_n_detect_obs = $recalculatenet[6];
2360 0         0 my @crackwidths = @{$recalculatenet[8]};
  0         0  
2361            
2362 0         0 my @geosourcefiles = @$geosourcefilesref; ##################
2363            
2364 0         0 my ( @geos, @genobs, @genobspoints );
2365            
2366 0         0 my $countgeo = 0;
2367 0         0 foreach my $nodezone_dataref ( @nodezone_data_tot )
2368             {
2369            
2370 0         0 my ( @obstaclesdata, @differences, @ratios );
2371 0         0 my $countlines = 0;
2372 0         0 my $countnode = 0;
2373 0         0 my $geosourcefile = $geosourcefiles->[ $countgeo ];
2374 0         0 my $sourceaddress = "$to$geosourcefile";
2375 0 0       0 open( SOURCEFILE, $sourceaddress ) or die "Can't open $geosourcefile 2: $!\n";
2376 0         0 my @linesgeo = ;
2377 0         0 close SOURCEFILE;
2378 0         0 my $countvert = 0;
2379 0         0 my $countobs = 0;
2380 0         0 my ( $zone, $line, $xlenght, $ylenght, $truedistance, $heightdifference );
2381 0         0 my ( @rowelements, @node, @component, @v, @obs, @obspoints, @obstructionpoint );
2382            
2383 0         0 foreach my $line (@linesgeo)
2384             {
2385 0         0 $line =~ s/^\s+//;
2386              
2387 0         0 my @rowelements = split(/\s+|,/, $line);
2388 0 0       0 if ($rowelements[0] eq "*vertex" )
    0          
2389             {
2390 0 0       0 if ($countvert == 0)
2391             {
2392 0         0 push (@v, [ "vertices_of_$sourceaddress" ]);
2393 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2394             }
2395              
2396 0 0       0 if ($countvert > 0)
2397             {
2398 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2399             }
2400 0         0 $countvert++;
2401             }
2402             elsif ($rowelements[0] eq "*obs" )
2403             {
2404 0         0 push (@obs, [ $rowelements[1], $rowelements[2], $rowelements[3], $rowelements[4],
2405             $rowelements[5], $rowelements[6], $rowelements[7], $rowelements[8], $rowelements[9], $rowelements[10] ] );
2406 0         0 $countobs++;
2407             }
2408 0         0 $countlines++;
2409             }
2410              
2411             #if ( $y_or_n_detect_obs eq "y") ### THIS HAS YET TO BE DONE AND WORK.
2412             #{
2413             # foreach my $ob (@obs)
2414             # {
2415             # push (@obspoints , [ $$ob[0], $$ob[1],$$ob[5] ] );
2416             # push (@obspoints , [ ($$ob[0] + ( $$ob[3] / 2) ), ( $$ob[1] + ( $$ob[4] / 2 ) ) , $$ob[5] ] );
2417             # push (@obspoints , [ ($$ob[0] + $$ob[3]), ( $$ob[1] + $$ob[4] ) , $$ob[5] ] );
2418             # }
2419             #}
2420             #else
2421             #{
2422 0         0 @obspoints = @{$recalculatenet[7]};
  0         0  
2423             #}
2424 0         0 push ( @geos, [ @v ] );
2425 0         0 push ( @genobs, [ @obs ] );
2426 0         0 push ( @genobspoints, [ @genobs ] );
2427 0         0 $countgeo++;
2428             }
2429            
2430 0         0 my ( @winpoints, @windowpoints, @windimsfront, @windimseast, @windimsback, @windimswest, @windsims, @windareas, @jointlenghts );
2431 0         0 my ( $jointfront, $jointeast, $jointback, $jointwest, $windimxfront, $windimyfront,
2432             $windimxback, $windimyback, $windimxeast, $windimyeast, $windimxwest, $windimywest );
2433              
2434 0 0       0 if ($constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
2435             # FOR PROPAGATION OF CONSTRAINTS
2436              
2437 0 0       0 if ($y_or_n_reassign_cp == "y")
2438             {
2439 0         0 eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2440             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2441             # vertices CAN BE CALLED BY NAME with $geo[ $zonenumber ][ ]
2442             # x, y or z CAN BE CALLED WITH THE NUMBERS 0, 1 or 2: EXAMPLE: $genobs[ $zonenumber ][ $vertexnumber ][ 0, 1 or 2 ]
2443             # ZONENUMBER DERIVES FROM $countop.
2444             # OBSTRUCTION CAN BE CALLED WITH $genobs[ $zonenumber ][ $obstruction_number ]
2445             # REMEMBER TO ASSIGN THE $height IN THE CONFIGURATION FILE.
2446             # UNLESS, ESP-r WILL ASSIGN THAT FOR YOU AND THIS IS NOT ALWAYS WHAT YOU WANT.
2447             }
2448              
2449              
2450 0 0       0 open( INFILENET, $infilenet ) or die "Can't open $infilenet 2: $!\n";
2451 0         0 my @linesnet = ;
2452 0         0 close INFILENET;
2453              
2454 0         0 my @letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s",
2455             "t", "u", "v", "w", "x", "y", "z");
2456            
2457 0         0 my $countnode = 0;
2458 0         0 my ( $interfaceletter, $calcpressurecoefficient, $nodetype, $nodeletter, $mode );
2459 0         0 my $countlines = 0;
2460 0         0 my $countopening = 0;
2461 0         0 my $countcrack = 0;
2462 0         0 my $countthing = 0;
2463 0         0 my $countjoint = 0;
2464 0         0 foreach my $line (@linesnet)
2465             {
2466 0         0 $line =~ s/^\s+//;
2467 0         0 @rowelements = split(/\s+/, $line);
2468              
2469 0 0       0 if ($rowelements[0] eq "Node") { $mode = "nodemode"; }
  0         0  
2470 0 0       0 if ($rowelements[0] eq "Component") { $mode = "componentmode"; }
  0         0  
2471 0 0 0     0 if ( ( $mode eq "nodemode" ) and ($countlines > 1) and ($countlines < (2 + scalar(@nodesdata) ) ) )
      0        
2472             {
2473 0         0 $countnode = ($countlines - 2);
2474 0         0 $zone = $nodesdata[$countnode][0];
2475 0         0 $interfaceletter = $nodesdata[$countnode][1];
2476 0         0 $calcpressurecoefficient = $nodesdata[$countnode][2];
2477 0         0 $nodetype = $rowelements[2];
2478 0         0 $nodeletter = $letters[$countnode];
2479              
2480 0 0       0 if ( $nodetype eq "0")
    0          
2481             {
2482 0         0 my $printthis =
2483             "prj -file $to/cfg/$fileconfig -mode script<
2484              
2485              
2486             m
2487             e
2488             c
2489              
2490             n
2491             c
2492             $nodeletter
2493              
2494             a
2495             a
2496             y
2497             $zone
2498              
2499             $height
2500             a
2501              
2502             -
2503             -
2504             y
2505              
2506             y
2507             -
2508             -
2509             -
2510             -
2511             -
2512             -
2513             -
2514             -
2515             YYY
2516             ";
2517 0 0       0 if ($exeonfiles eq "y")
2518             {
2519 0         0 print `$printthis`;
2520             }
2521              
2522 0         0 print TOSHELL "
2523             #Adequating the ventilation network for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2524             $printthis";
2525 0         0 $countnode++;
2526             }
2527             elsif ( $nodetype eq "3")
2528             {
2529 0 0       0 if ($y_or_n_reassign_cp == "y")
2530             {
2531 0         0 my $printthis =
2532             "prj -file $to/cfg/$fileconfig -mode script<
2533              
2534              
2535             m
2536             e
2537             c
2538              
2539             n
2540             c
2541             $nodeletter
2542              
2543             a
2544             e
2545             $zone
2546             $interfaceletter
2547             $calcpressurecoefficient
2548             y
2549              
2550             $height
2551             -
2552             -
2553             y
2554              
2555             y
2556             -
2557             -
2558             -
2559             -
2560             -
2561             -
2562             -
2563             -
2564             YYY
2565             ";
2566 0 0       0 if ($exeonfiles eq "y")
2567             {
2568 0         0 print `printthis`;
2569             }
2570              
2571 0         0 print TOSHELL "
2572             #Adequating the ventilation network for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2573             $printthis";
2574 0         0 $countnode++;
2575             }
2576             }
2577             }
2578              
2579 0         0 my @node_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p",
2580             "q", "r", "s", "t", "u", "v", "w", "x", "y", "z");
2581 0 0 0     0 if ( ($mode eq "componentmode") and ( $line =~ "opening"))
    0 0        
2582             {
2583 0         0 my $printthis =
2584             "prj -file $to/cfg/$fileconfig -mode script<
2585              
2586              
2587             m
2588             e
2589             c
2590              
2591             n
2592             d
2593             $node_letters[$countthing]
2594              
2595             k
2596             -
2597             $windareas[$countopening]
2598             -
2599             -
2600             y
2601              
2602             y
2603             -
2604             -
2605             -
2606             -
2607             -
2608             -
2609             -
2610             YYY
2611             ";
2612 0 0       0 if ($exeonfiles eq "y")
2613             {
2614 0         0 print `$printthis`;
2615             }
2616              
2617 0         0 print TOSHELL "
2618             #Adequating the ventilation network for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2619             $printthis";
2620              
2621 0         0 $countopening++;
2622 0         0 $countthing++;
2623             }
2624             elsif ( ($mode eq "componentmode") and ( $line =~ "crack "))
2625             {
2626 0         0 MY $printthis =
2627             "prj -file $to/cfg/$fileconfig -mode script<
2628              
2629              
2630             m
2631             e
2632             c
2633              
2634             n
2635             d
2636             $node_letters[$countthing]
2637              
2638             l
2639             -
2640             $crackwidths[$countjoint] $jointlenghts[$countjoint]
2641             -
2642             -
2643             y
2644              
2645             y
2646             -
2647             -
2648             -
2649             -
2650             -
2651             -
2652             -
2653             YYY
2654             ";
2655 0 0       0 if ($exeonfiles eq "y")
2656             {
2657 0         0 print `$printthis`;
2658             }
2659              
2660 0         0 print TOSHELL $printthis;
2661              
2662 0         0 $countcrack++;
2663 0         0 $countthing++;
2664 0         0 $countjoint++;
2665             }
2666 0         0 $countlines++;
2667             }
2668             } # END SUB recalculatenet
2669              
2670              
2671              
2672             sub apply_constraints
2673             {
2674 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
2675            
2676 0         0 my @applytype = @$swap;
2677 0         0 my $zone_letter = $applytype[$countop][3];
2678 0         0 my @apply_constraints = @$swap2;
2679              
2680 0         0 my ( $value_reshape, $ybasewall, $ybasewindow );
2681 0         0 my @v;
2682            
2683 0         0 say "Propagating geometry constraints for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2684              
2685 0         0 foreach my $group_operations ( @apply_constraints )
2686             {
2687 0         0 my @group = @{$group_operations};
  0         0  
2688              
2689 0         0 my @sourcefiles = @{$group[0]};
  0         0  
2690 0         0 my @targetfiles = @{$group[1]};
  0         0  
2691 0         0 my @configfiles = @{$group[2]};
  0         0  
2692 0         0 my @basevalues = @{$group[3]};
  0         0  
2693 0         0 my @swingvalues = @{$group[4]};
  0         0  
2694 0         0 my @work_values = @{$group[5]};
  0         0  
2695 0         0 my $longmenu = $group[6];
2696 0         0 my ( $basevalue, $targetfile, $configfile, $swingvalue, $sourceaddress, $targetaddress, $configaddress );
2697 0         0 my $countops = 0;
2698              
2699 0         0 foreach $sourcefile ( @sourcefiles )
2700             {
2701 0         0 $basevalue = $basevalues[$countops];
2702 0         0 $sourcefile = $sourcefiles[$countops];
2703 0         0 $targetfile = $targetfiles[$countops];
2704 0         0 $configfile = $configfiles[$countops];
2705 0         0 $swingvalue = $swingvalues[$countops];
2706 0         0 $sourceaddress = "$to$sourcefile";
2707 0         0 $targetaddress = "$to$targetfile";
2708 0         0 $configaddress = "$to/opts/$configfile";
2709 0         0 $longmenu = $longmenus[$countops];
2710 0         0 checkfile($sourceaddress, $targetaddress);
2711            
2712 0 0       0 if ( ref ( $swingvalue ) )
2713             {
2714 0         0 my $min = $swingvalue->[0];
2715 0         0 my $max = $swingvalue->[1];
2716 0         0 $swingvalue = ( $max - $min );
2717             }
2718             else
2719             {
2720             ;
2721             }
2722            
2723              
2724 0 0       0 open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
2725 0         0 my @lines = ;
2726 0         0 close SOURCEFILE;
2727 0         0 my $countlines = 0;
2728 0         0 my $countvert = 0;
2729 0         0 foreach my $line (@lines)
2730             {
2731 0         0 $line =~ s/^\s+//;
2732 0         0 my @rowelements = split(/\s+|,/, $line);
2733 0 0       0 if ($rowelements[0] eq "*vertex" )
2734             {
2735 0 0       0 if ($countvert == 0)
2736             {
2737 0         0 push (@v, [ "vertices of $sourceaddress" ]);
2738 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2739             }
2740              
2741 0 0       0 if ($countvert > 0)
2742             {
2743 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2744             }
2745 0         0 $countvert++;
2746             }
2747 0         0 $countlines++;
2748             }
2749              
2750 0         0 my @vertexletters;
2751 0 0       0 if ($longmenu eq "y")
2752             {
2753 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
2754             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
2755             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
2756             "0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni","0\nb\n0\nb\nj",
2757             "0\nb\n0\nb\nk","0\nb\n0\nb\nl","0\nb\n0\nb\nm","0\nb\n0\nb\nn","0\nb\n0\nb\no",
2758             "0\nb\n0\nb\np","0\nb\n0\nb\nq","0\nb\n0\nb\nr","0\nb\n0\nb\ns","0\nb\n0\nb\nt");
2759             }
2760             else
2761             {
2762 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2763             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
2764             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
2765             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
2766             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
2767             }
2768              
2769 0 0       0 if ($constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
2770             # FOR PROPAGATION OF CONSTRAINTS
2771              
2772 0 0       0 if (-e $configaddress)
2773             {
2774 0         0 eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2775             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2776              
2777 0 0       0 if ($constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
2778             # FOR PROPAGATION OF CONSTRAINTS
2779              
2780              
2781 0         0 my $countvertex = 0;
2782 0         0 foreach (@v)
2783             {
2784 0 0       0 if ($countvertex > 0)
2785             {
2786 0         0 my $vertexletter = $vertexletters[$countvertex-1];
2787 0 0       0 if ($vertexletter ~~ @work_values)
2788             {
2789 0         0 my $printthis =
2790             "prj -file $to/cfg/$fileconfig -mode script<
2791              
2792             m
2793             c
2794             a
2795             $zone_letter
2796             d
2797             $vertexletter
2798             $v[$countvertex][0] $v[$countvertex][1] $v[$countvertex][2]
2799             -
2800             y
2801             -
2802             y
2803             c
2804             -
2805             -
2806             -
2807             -
2808             -
2809             -
2810             -
2811             -
2812             -
2813             YYY
2814             ";
2815 0 0       0 if ($exeonfiles eq "y")
2816             {
2817 0         0 print `$printthis`;
2818             }
2819              
2820 0         0 print TOSHELL "
2821             #Propagating geometry constraints for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2822             $printthis";
2823             }
2824             }
2825 0         0 $countvertex++;
2826             }
2827             }
2828 0         0 $countops++;
2829             }
2830             }
2831             } # END SUB apply_constraints
2832              
2833              
2834              
2835             sub reshape_windows # IT APPLIES CONSTRAINTS
2836             {
2837 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
2838            
2839 0         0 my @applytype = @$swap;
2840 0         0 my $zone_letter = $applytype[$countop][3];
2841 0         0 my @reshape_windows = @$swap2;
2842            
2843 0         0 say "Reshaping windows for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
2844              
2845 0         0 my ( @work_letters, @v );
2846              
2847 0         0 foreach my $group_operations ( @{$reshape_windows[$countop]} )
  0         0  
2848             {
2849 0         0 my @group = @{$group_operations};
  0         0  
2850 0         0 my @sourcefiles = @{$group[0]};
  0         0  
2851 0         0 my @targetfiles = @{$group[1]};
  0         0  
2852 0         0 my @configfiles = @{$group[2]};
  0         0  
2853 0         0 my @basevalues = @{$group[3]};
  0         0  
2854 0         0 my @swingvalues = @{$group[4]};
  0         0  
2855 0         0 my @work_letters = @{$group[5]};
  0         0  
2856 0         0 my @longmenus = @{$group[6]};
  0         0  
2857              
2858 0         0 my $countops = 0;
2859 0         0 foreach $sourcefile ( @sourcefiles )
2860             {
2861 0         0 my $basevalue = $basevalues[$countops];
2862 0         0 my $sourcefile = $sourcefiles[$countops];
2863 0         0 my $targetfile = $targetfiles[$countops];
2864 0         0 my $configfile = $configfiles[$countops];
2865 0         0 my $swingvalue = $swingvalues[$countops];
2866 0         0 my $longmenu = $longmenus[$countops];
2867 0         0 my $sourceaddress = "$to$sourcefile";
2868 0         0 my $targetaddress = "$to$targetfile";
2869 0         0 my $configaddress = "$to/opts/$configfile";
2870 0         0 my $totalswing;
2871 0 0       0 unless ( ref ( $swingvalue ) )
2872             {
2873 0         0 $totalswing = ( 2 * $swingvalue );
2874             }
2875            
2876 0 0       0 if ( ref ( $swingvalue ) )
2877             {
2878 0         0 my $min = $swingvalue->[0];
2879 0         0 my $max = $swingvalue->[1];
2880 0         0 $totalswing = ( $max - $min );
2881             }
2882            
2883 0         0 my $pace = ( $totalswing / ( $stepsvar - 1 ) );
2884 0         0 checkfile($sourceaddress, $targetaddress);
2885            
2886 0 0       0 open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
2887 0         0 my @lines = ;
2888 0         0 close SOURCEFILE;
2889              
2890 0         0 my $countlines = 0;
2891 0         0 my $countvert = 0;
2892 0         0 foreach my $line (@lines)
2893             {
2894 0         0 $line =~ s/^\s+//;
2895              
2896 0         0 my @rowelements = split(/\s+|,/, $line);
2897 0 0       0 if ($rowelements[0] eq "*vertex" )
2898             {
2899 0 0       0 if ($countvert == 0)
2900             {
2901 0         0 push (@v, [ "vertices of $sourceaddress", [], [] ]);
2902 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2903             }
2904              
2905 0 0       0 if ($countvert > 0)
2906             {
2907 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2908             }
2909              
2910 0         0 $countvert++;
2911             }
2912 0         0 $countlines++;
2913             }
2914              
2915 0         0 my @vertexletters;
2916 0 0       0 if ($longmenu eq "y")
2917             {
2918 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2919             "n", "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv",
2920             "0\nb\nw", "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd",
2921             "0\nb\ne","0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni",
2922             "0\nb\n0\nb\nj","0\nb\n0\nb\nk","0\nb\n0\nb\nl","0\nb\n0\nb\nm","0\nb\n0\nb\nn",
2923             "0\nb\n0\nb\no","0\nb\n0\nb\np","0\nb\n0\nb\nq","0\nb\n0\nb\nr","0\nb\n0\nb\ns",
2924             "0\nb\n0\nb\nt");
2925             }
2926             else
2927             {
2928 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2929             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
2930             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
2931             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
2932             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
2933             }
2934              
2935 0         0 $value_reshape_window = ( ( $basevalue - $swingvalue) + ( $pace * ( $countstep - 1 )) );
2936              
2937 0 0       0 if (-e $configaddress)
2938             {
2939              
2940 0         0 eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2941             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2942              
2943 0 0       0 if (-e $constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
2944             # FOR PROPAGATION OF CONSTRAINTS
2945              
2946 0         0 my $countvertex = 0;
2947              
2948 0         0 foreach (@v)
2949             {
2950 0 0       0 if ($countvertex > 0)
2951             {
2952 0         0 my $vertexletter = $vertexletters[$countvertex];
2953 0 0       0 if ($vertexletter ~~ @work_letters)
2954             {
2955 0         0 my $printthis =
2956             "prj -file $to/cfg/$fileconfig -mode script<
2957              
2958             m
2959             c
2960             a
2961             $zone_letter
2962             d
2963             $vertexletter
2964             $v[$countvertex+1][0] $v[$countvertex+1][1] $v[$countvertex+1][2]
2965             -
2966             y
2967             -
2968             y
2969             c
2970             -
2971             -
2972             -
2973             -
2974             -
2975             -
2976             -
2977             -
2978             -
2979             YYY
2980             ";
2981 0 0       0 if ($exeonfiles eq "y")
2982             {
2983 0         0 print `$printthis`;
2984             }
2985              
2986 0         0 print TOSHELL "
2987             #Reshaping windows for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
2988             $printthis";
2989             }
2990             }
2991 0         0 $countvertex++;
2992             }
2993             }
2994 0         0 $countops++;
2995             }
2996              
2997             }
2998             } # END SUB reshape_windows
2999              
3000              
3001             sub warp #
3002             {
3003 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $warp, $countvar, $fileconfig ) = @_;
3004            
3005 0         0 my @applytype = @$swap;
3006 0         0 my $zone_letter = $applytype[$countop][3];
3007            
3008 0         0 say "Warping zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
3009              
3010 0         0 my @surfs_to_warp = @{ $warp->[$countop][0] };
  0         0  
3011 0         0 my @vertices_numbers = @{ $warp->[$countop][1] };
  0         0  
3012 0         0 my @swingrotations = @{ $warp->[$countop][2] };
  0         0  
3013 0         0 my @yes_or_no_apply_to_others = @{ $warp->[$countop][3] };
  0         0  
3014 0         0 my $configfilename = $$warp[$countop][4];
3015 0         0 my $configfile = $to."/opts/".$configfilename;
3016 0         0 my @pairs_of_vertices = @{ $warp->[$countop][5] }; # @pairs_of_vertices defining axes
  0         0  
3017 0         0 my @windows_to_reallign = @{ $warp->[$countop][6] };
  0         0  
3018 0         0 my $sourcefilename = $$warp[$countop][7];
3019 0         0 my $sourcefile = $to.$sourcefilename;
3020 0         0 my $longmenu = $$warp[$countop][8];
3021 0         0 my $countrotate = 0;
3022 0         0 foreach my $surface_letter (@surfs_to_warp)
3023             {
3024 0         0 $swingrotate = $swingrotations[$countrotate];
3025            
3026 0 0       0 if ( ref ( $swingrotate ) )
3027             {
3028 0         0 my $min = $swingrotate->[0];
3029 0         0 my $max = $swingrotate->[1];
3030 0         0 $swingrotate = ( $max - $min );
3031             }
3032            
3033 0         0 $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
3034 0         0 $rotation_degrees = ( ( $swingrotate / 2 ) - ( $pacerotate * ( $countstep - 1 ) )) ;
3035 0         0 $vertex_number = $vertices_numbers[$countrotate];
3036 0         0 $yes_or_no_apply = $yes_or_no_apply_to_others[$countrotate];
3037 0 0 0     0 if ( ( $swingrotate != 0 ) and ( $stepsvar > 1 ) and ( $yes_or_no_warp eq "y" ) )
      0        
3038             {
3039 0         0 my $printthis =
3040             "prj -file $to/cfg/$fileconfig -mode script<
3041              
3042             m
3043             c
3044             a
3045             $zone_letter
3046             e
3047             >
3048             $surface_letter
3049             c
3050             $vertex_number
3051             $rotation_degrees
3052             $yes_or_no_apply
3053             -
3054             -
3055             y
3056             c
3057             -
3058             -
3059             -
3060             -
3061             -
3062             -
3063             -
3064             -
3065             YYY
3066             ";
3067 0 0       0 if ($exeonfiles eq "y")
3068             {
3069 0         0 print `$printthis`;
3070             }
3071 0         0 print TOSHELL "
3072             #Warping zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
3073             $printthis";
3074             }
3075 0         0 $countrotate++;
3076             }
3077              
3078             # THIS SECTION READS THE CONFIG FILE FOR DIMENSIONS
3079 0 0       0 open( SOURCEFILE, $sourcefile ) or die "Can't open $sourcefile: $!\n";
3080 0         0 my @lines = ;
3081 0         0 close SOURCEFILE;
3082 0         0 my $countlines = 0;
3083 0         0 my $countvert = 0;
3084 0         0 foreach my $line (@lines)
3085             {
3086 0         0 $line =~ s/^\s+//;
3087            
3088 0         0 my @rowelements = split(/\s+|,/, $line);
3089 0 0       0 if ($rowelements[0] eq "*vertex" )
3090             {
3091 0 0       0 if ($countvert == 0)
3092             {
3093 0         0 push (@v, [ "vertices of $sourceaddress" ]);
3094 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3095             }
3096              
3097 0 0       0 if ($countvert > 0)
3098             {
3099 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3100             }
3101 0         0 $countvert++;
3102             }
3103 0         0 $countlines++;
3104             }
3105              
3106              
3107 0         0 my @vertexletters;
3108 0 0       0 if ($longmenu eq "y")
3109             {
3110 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3111             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
3112             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
3113             "0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni","0\nb\n0\nb\nj",
3114             "0\nb\n0\nb\nk","0\nb\n0\nb\nl","0\nb\n0\nb\nm","0\nb\n0\nb\nn","0\nb\n0\nb\no",
3115             "0\nb\n0\nb\np","0\nb\n0\nb\nq","0\nb\n0\nb\nr","0\nb\n0\nb\ns","0\nb\n0\nb\nt");
3116             }
3117             else
3118             {
3119 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3120             "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx", "0\ny",
3121             "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng","0\n0\nh",
3122             "0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no","0\n0\np",
3123             "0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
3124             }
3125              
3126              
3127 0 0       0 if (-e $configfile)
3128             {
3129 0         0 eval `cat $configfile`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED
3130             # AND PROPAGATED.
3131              
3132 0 0       0 if (-e $constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
3133             # FOR PROPAGATION OF CONSTRAINTS
3134              
3135             }
3136             # THIS SECTION SHIFTS THE VERTEX TO LET THE BASE SURFACE AREA UNCHANGED AFTER THE WARPING.
3137              
3138 0         0 my $countthis = 0;
3139 0         0 $number_of_moves = ( (scalar(@pairs_of_vertices)) /2 ) ;
3140 0         0 foreach my $pair_of_vertices (@pairs_of_vertices)
3141             {
3142 0 0       0 if ($countthis < $number_of_moves)
3143             {
3144 0         0 $vertex1 = $pairs_of_vertices[ 0 + ( 2 * $countthis ) ];
3145 0         0 $vertex2 = $pairs_of_vertices[ 1 + ( 2 * $countthis ) ];
3146              
3147 0         0 my $printthis =
3148             "prj -file $to/cfg/$fileconfig -mode script<
3149              
3150             m
3151             c
3152             a
3153             $zone_letter
3154             d
3155             ^
3156             j
3157             $vertex1
3158             $vertex2
3159             -
3160             $addedlength
3161             y
3162             -
3163             y
3164             -
3165             y
3166             -
3167             -
3168             -
3169             -
3170             -
3171             -
3172             -
3173             -
3174             YYY
3175             ";
3176 0 0       0 if ($exeonfiles eq "y")
3177             {
3178 0         0 print `$printthis`;
3179             }
3180 0         0 print TOSHELL "
3181             #Warping zones for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.
3182             $printthis";
3183             }
3184 0         0 $countthis++;
3185             }
3186             } # END SUB warp
3187              
3188              
3189             ##############################################################################
3190             # BEGINNING OF THE SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING GEOMETRY
3191             sub constrain_geometry # IT APPLIES CONSTRAINTS TO ZONE GEOMETRY
3192             {
3193             # IT CONSTRAINS GEOMETRY FILES. IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
3194             # constrain_geometry($to, $fileconfig, $stepsvar, $countop, $countstep, $exeonfiles, \@applytype, \@constrain_geometry);
3195             # constrain_geometry($to, $fileconfig, $stepsvar, $countop,
3196             # $countstep, $exeonfiles, \@applytype, \@constrain_geometry, $to_do);
3197 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $applytyperef, $constrain_geometryref, $to_do, $countvar, $fileconfig, $v_ref ) = @_;
3198            
3199 0         0 my @applytype = @$applytyperef;
3200 0         0 my $zone_letter = $applytype[$countop][3];
3201 0         0 my @constrain_geometry = @$constrain_geometryref;
3202 0         0 my @v_ = @$v_ref;
3203            
3204 0         0 say "Propagating constraints on geometry for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
3205              
3206 0         0 foreach my $elm (@constrain_geometry)
3207             {
3208 0         0 my @group = @{$elm};
  0         0  
3209 0         0 my $sourcefile = $group[0];
3210 0         0 my $targetfile = $group[1];
3211 0         0 my $configfile = $group[2];
3212 0         0 my @work_letters = @{$group[3]};
  0         0  
3213 0         0 my $longmenus = $group[4];
3214 0         0 my @swings__ = @{ $group[5] };
  0         0  
3215 0         0 my $askop = $group[6];
3216 0 0       0 unless ( $askop ) { $askop = 0; }
  0         0  
3217            
3218 0         0 my $sourceaddress = "$to$sourcefile";
3219 0         0 my $targetaddress = "$to$targetfile";
3220 0         0 my $configaddress = "$to$configfile";
3221            
3222 0         0 my ( @v, @vertexletters, @work_items, @swings, @paces );
3223            
3224 0         0 foreach ( @swings__ )
3225             {
3226 0 0       0 if ( ref ( $_ ) )
3227             {
3228 0         0 $_ = ( $_->[0] - $_->[1] );
3229             }
3230             else
3231             {
3232 0         0 $_ = ( $_ * 2 );
3233             }
3234 0         0 push ( @swings, $_ );
3235             }
3236            
3237 0         0 foreach ( @swings )
3238             {
3239 0         0 my $pace = ( $_ / ( $stepsvar - 1 ) );
3240 0         0 push ( @paces, $pace );
3241             }
3242              
3243 0 0       0 if ($longmenu eq "y")
3244             {
3245 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3246             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
3247             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
3248             "0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni","0\nb\n0\nb\nj",
3249             "0\nb\n0\nb\nk","0\nb\n0\nb\nl","0\nb\n0\nb\nm","0\nb\n0\nb\nn","0\nb\n0\nb\no",
3250             "0\nb\n0\nb\np","0\nb\n0\nb\nq","0\nb\n0\nb\nr","0\nb\n0\nb\ns","0\nb\n0\nb\nt");
3251             }
3252             else
3253             {
3254 0         0 @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
3255             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
3256             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
3257             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
3258             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
3259             }
3260            
3261 0 0       0 unless ($to_do eq "justwrite")
3262             {
3263 0         0 checkfile($sourceaddress, $targetaddress);
3264 0         0 @v = read_geometry( $sourceaddress );
3265 0         0 @v_ = read_geo_constraints( $to, $fileconfig, $stepsvar, $countop, $countstep, $configaddress, \@v, $countvar, \@swings, \@paces, \@v_ );
3266             }
3267              
3268 0 0       0 unless ($to_do eq "justread")
3269             {
3270 0         0 apply_geo_constraints( \@v_, \@vertexletters, \@work_letters, $exeonfiles, $zone_letter, $askop );
3271             } # print $_outfile_ "\@v: " . Dumper(@v) . "\n\n";
3272             }
3273             } # END SUB constrain_geometry
3274              
3275              
3276             sub read_geometry # THIS READS GEOMETRY FILES TO GET THE VERTICES.
3277             {
3278 0     0 0 0 my ( $sourceaddress ) = @_;
3279            
3280 0 0       0 open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
3281 0         0 my @lines = ;
3282 0         0 close SOURCEFILE;
3283              
3284 0         0 my $countlines = 0;
3285 0         0 my $countvert = 0;
3286 0         0 foreach my $line (@lines)
3287             {
3288 0         0 $line =~ s/^\s+//;
3289              
3290 0         0 my @rowelements = split(/\s+|,/, $line);
3291 0 0       0 if ($rowelements[0] eq "*vertex" )
3292             {
3293 0         0 push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3294 0         0 $countvert++;
3295             }
3296 0         0 $countlines++;
3297             }
3298 0         0 return( @v );
3299             } # END SUB read_geometry
3300              
3301              
3302             sub read_geo_constraints # THIS READ GEOMETRY CONSTRAINTS.
3303             {
3304             # THIS MAKES THE vertices IN THE GEOMETRY FILES AVAILABLE TO THE USER FOR MANIPULATION, IN THE FOLLOWING FORM:
3305             # $v_[$countop][$number][$x], $v_[$countop][$number][$y], $v_[$countop][$number][$z].
3306             # EXAMPLE: $v_[0][4][$x] = 1. OR: @v_[0][4][$x] = @v_[0][4][$y]. OR: @v_[1][4][$x] = @v_[0][3][$z].
3307             # $countops number mutations in series. The $countop that is actuated is always the last, the one which is active.
3308             # So it is more safe to read everything that may be needed before giving instruction to activate propagation of constraints.
3309             # PROPAGATION OF CONSTRAINTS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THE SPECIED VARIABLES.
3310             # THE FOLLOWING VARIABLES ARE ALSO ALWAYS AVAILABLE:
3311             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
3312             # $countop, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS. THE NUMBER COUNT STARTS FROM 0.
3313             # $countstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
3314             # $countvar, WHICH TELLS THE PROGRAM WHAT NUMBER OF DESIGN PARAMETER THE PROGRAM IS WORKING AT.
3315 0     0 0 0 my ( $to, $fileconfig, $stepsvar, $countop, $countstep, $configaddress, $vref, $countvar, $swingsref, $pacesref, $v_ref ) = @_;
3316            
3317 0         0 my @myv = @$vref;
3318 0         0 my @swings = @$swingsref;
3319 0         0 my @paces = @$pacesref;
3320 0         0 my @v_ = @v_ref;
3321              
3322 0         0 my $x = 0;
3323 0         0 my $y = 1;
3324 0         0 my $z = 2;
3325 0         0 unshift (@myv, [ "vertices of $sourceaddress. \$countop: $countop ", [], [] ]);
3326              
3327 0 0       0 if (-e $configaddress)
3328             {
3329 0         0 push ( @v_, [ @myv ]); #
3330 0         0 eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED.
3331              
3332 0 0       0 if ( -e $constrain ) { eval ( $constrain ); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0         0  
3333             # FOR PROPAGATION OF CONSTRAINTS
3334 0         0 shift ( @{ $v_[$countop]} ); #
  0         0  
3335             }
3336 0         0 return ( @v_ );
3337             } # END SUB read_geo_constraints
3338              
3339              
3340             sub apply_geo_constraints
3341             {
3342 0     0 0 0 my ( $v_ref, $vertexlettersref, $work_lettersref, $exeonfiles, $zone_letter, $askop ) = @_;
3343            
3344 0         0 my @v_ = @$v_ref;
3345 0         0 my @vertexletters = @$vertexlettersref;
3346 0         0 my @work_letters = @$work_lettersref;
3347 0         0 my @v = @{ $v_[ $askop ] };
  0         0  
3348              
3349 0         0 my $countvertex = 0;
3350 0         0 foreach my $v (@v)
3351             {
3352 0         0 my $vertexletter = $vertexletters[$countvertex];
3353            
3354 0 0 0     0 if ( (@work_letters eq "") or ($vertexletter ~~ @work_letters) )
3355             {
3356 0         0 my $printthis =
3357             "prj -file $to/cfg/$fileconfig -mode script<
3358              
3359             m
3360             c
3361             a
3362             $zone_letter
3363             d
3364             $vertexletter
3365             $v[$countvertex+1][0] $v[$countvertex+1][1] $v[$countvertex+1][2]
3366             -
3367             y
3368             -
3369             y
3370             c
3371             -
3372             -
3373             -
3374             -
3375             -
3376             -
3377             -
3378             -
3379             -
3380             YYY
3381             ";
3382 0 0       0 if ($exeonfiles eq "y")
3383             {
3384 0         0 print `$printthis`;
3385             }
3386              
3387 0         0 print TOSHELL $printthis;
3388             }
3389 0         0 $countvertex++;
3390             }
3391              
3392             } # END SUB apply_geo_constraints
3393             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING GEOMETRY
3394             ##############################################################################
3395              
3396              
3397             ##############################################################################
3398             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING CONTROLS
3399             sub vary_controls
3400             { # IT IS CALLED FROM THE MAIN FILE
3401 0     0 0 0 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
3402            
3403 0         0 my @applytype = @$swap;
3404 0         0 my $zone_letter = $applytype[$countop][3];
3405 0         0 my @vary_controls = @$swap2;
3406            
3407 0         0 say "Propagating constraints on controls for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
3408              
3409 0         0 my ( $semaphore_zone, $semaphore_dataloop, $semaphore_massflow, $semaphore_setpoint, $doline );
3410 0         0 my $count_controlmass = -1;
3411 0         0 my $countline = 0;
3412 0         0 my @letters = ("e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "z"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
3413 0         0 my @period_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
3414 0         0 my $loop_hour = 2; # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
3415             # BUT ARE THE ONES USED IN THE OPT CONSTRAINTS FILES.
3416 0         0 my $max_heating_power = 3;
3417 0         0 my $min_heating_power = 4;
3418 0         0 my $max_cooling_power = 5,
3419             my $min_cooling_power = 6;
3420 0         0 my $heating_setpoint = 7;
3421 0         0 my $cooling_setpoint = 8;
3422 0         0 my $flow_hour = 2;
3423 0         0 my $flow_setpoint = 3;
3424 0         0 my $flow_onoff = 4;
3425 0         0 my $flow_fraction = 5;
3426 0         0 my $loop_letter;
3427             my $loopcontrol_letter;
3428              
3429 0         0 my @group = @{$vary_controls[$countop]};
  0         0  
3430 0         0 my $sourcefile = $group[0];
3431 0         0 my $targetfile = $group[1];
3432 0         0 my $configfile = $group[2];
3433 0         0 my @buildbulk = @{$group[3]};
  0         0  
3434 0         0 my @flowbulk = @{$group[4]};
  0         0  
3435            
3436 0         0 my $countbuild = 0;
3437 0         0 my $countflow = 0;
3438              
3439 0         0 my $countcontrol = 0;
3440 0         0 my $sourceaddress = "$to$sourcefile";
3441 0         0 my $targetaddress = "$to$targetfile";
3442 0         0 my $configaddress = "$to$configfile";
3443              
3444             #@loopcontrol; # DON'T PUT "my" HERE.
3445             #@flowcontrol; # DON'T PUT "my" HERE.
3446             #@new_loopcontrols; # DON'T PUT "my" HERE.
3447             #@new_flowcontrols; # DON'T PUT "my" HERE.
3448 0         0 my ( @groupzone_letters, @zone_period_letters, @flow_letters, @fileloopbulk, @fileflowbulk );
3449              
3450 0         0 checkfile($sourceaddress, $targetaddress);
3451              
3452 0 0       0 if ($countstep == 1)
3453             {
3454 0         0 read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3455             }
3456              
3457              
3458             sub calc_newctl
3459             { # TO BE CALLED WITH: calc_newcontrols($to, $fileconfig, $stepsvar, $countop, $countstep, \@buildbulk, \@flowbulk, \@loopcontrol, \@flowcontrol);
3460             # THIS COMPUTES CHANGES TO BE MADE TO CONTROLS BEFORE PROPAGATION OF CONSTRAINTS
3461 1     1 0 2 my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $swap3, $swap4, $countvar, $fileconfig ) = @_;
3462            
3463 1         2 my @buildbulk = @$swap;
3464 1         2 my @flowbulk = @$swap2;
3465 1         2 my @loopcontrol = @$swap3;
3466 1         2 my @flowcontrol = @$swap4;
3467              
3468 1         1 my ( @new_loop_hours, @new_max_heating_powers, @new_min_heating_powers, @new_max_cooling_powers, @new_min_cooling_powers, @new_heating_setpoints,
3469             @new_cooling_setpoints, @new_flow_hours, @new_flow_setpoints, @new_flow_onoffs, @new_flow_fractions );
3470              
3471             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE CALCULATED.
3472 1 50       7 if ($stepsvar == 0) {$stepsvar = 1;}
  1         2  
3473 1 50       4 if ($stepsvar > 1)
3474             {
3475 0           foreach $each_buildbulk (@buildbulk)
3476             {
3477 0           my @askloop = @{$each_buildbulk};
  0            
3478 0           my $new_loop_letter = $askloop[0];
3479 0           my $new_loopcontrol_letter = $askloop[1];
3480 0           my $swing_loop_hour = $askloop[2];
3481 0           my $swing_max_heating_power = $askloop[3];
3482 0           my $swing_min_heating_power = $askloop[4];
3483 0           my $swing_max_cooling_power = $askloop[5];
3484 0           my $swing_min_cooling_power = $askloop[6];
3485 0           my $swing_heating_setpoint = $askloop[7];
3486 0           my $swing_cooling_setpoint = $askloop[8];
3487              
3488 0           my $countloop = 0; #IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
3489 0           foreach $each_loop (@loopcontrol) # THIS DISTRIBUTES THIS NESTED DATA STRUCTURES IN A FLAT MODE TO PAIR THE INPUT FILE, USER DEFINED ONE.
3490             {
3491 0           my $countcontrol = 0;
3492 0           @thisloop = @{$each_loop};
  0            
3493             # my $letterfile = $letters[$countloop];
3494 0           foreach $lp (@thisloop)
3495             {
3496 0           my @control = @{$lp};
  0            
3497             # my $letterfilecontrol = $period_letters[$countcontrol];
3498 0           $loop_letter = $loopcontrol[$countloop][$countcontrol][0];
3499 0           $loopcontrol_letter = $loopcontrol[$countloop][$countcontrol][1];
3500 0 0 0       if ( ( $new_loop_letter eq $loop_letter ) and ($new_loopcontrol_letter eq $loopcontrol_letter ) )
3501             {
3502             # print $_outfile_ "YES!: \n\n\n";
3503 0           $loop_hour__ = $loopcontrol[$countloop][$countcontrol][$loop_hour];
3504 0           $max_heating_power__ = $loopcontrol[$countloop][$countcontrol][$max_heating_power];
3505 0           $min_heating_power__ = $loopcontrol[$countloop][$countcontrol][$min_heating_power];
3506 0           $max_cooling_power__ = $loopcontrol[$countloop][$countcontrol][$max_cooling_power];
3507 0           $min_cooling_power__ = $loopcontrol[$countloop][$countcontrol][$min_cooling_power];
3508 0           $heating_setpoint__ = $loopcontrol[$countloop][$countcontrol][$heating_setpoint];
3509 0           $cooling_setpoint__ = $loopcontrol[$countloop][$countcontrol][$cooling_setpoint];
3510             }
3511 0           $countcontrol++;
3512             }
3513 0           $countloop++;
3514             }
3515              
3516 0           my $pace_loop_hour = ( $swing_loop_hour / ($stepsvar - 1) );
3517 0           my $floorvalue_loop_hour = ($loop_hour__ - ($swing_loop_hour / 2) );
3518 0           my $new_loop_hour = $floorvalue_loop_hour + ($countstep * $pace_loop_hour);
3519              
3520 0           my $pace_max_heating_power = ( $swing_max_heating_power / ($stepsvar - 1) );
3521 0           my $floorvalue_max_heating_power = ($max_heating_power__ - ($swing_max_heating_power / 2) );
3522 0           my $new_max_heating_power = $floorvalue_max_heating_power + ($countstep * $pace_max_heating_power);
3523              
3524 0           my $pace_min_heating_power = ( $swing_min_heating_power / ($stepsvar - 1) );
3525 0           my $floorvalue_min_heating_power = ($min_heating_power__ - ($swing_min_heating_power / 2) );
3526 0           my $new_min_heating_power = $floorvalue_min_heating_power + ($countstep * $pace_min_heating_power);
3527              
3528 0           my $pace_max_cooling_power = ( $swing_max_cooling_power / ($stepsvar - 1) );
3529 0           my $floorvalue_max_cooling_power = ($max_cooling_power__ - ($swing_max_cooling_power / 2) );
3530 0           my $new_max_cooling_power = $floorvalue_max_cooling_power + ($countstep * $pace_max_cooling_power);
3531              
3532 0           my $pace_min_cooling_power = ( $swing_min_cooling_power / ($stepsvar - 1) );
3533 0           my $floorvalue_min_cooling_power = ($min_cooling_power__ - ($swing_min_cooling_power / 2) );
3534 0           my $new_min_cooling_power = $floorvalue_min_cooling_power + ($countstep * $pace_min_cooling_power);
3535              
3536 0           my $pace_heating_setpoint = ( $swing_heating_setpoint / ($stepsvar - 1) );
3537 0           my $floorvalue_heating_setpoint = ($heating_setpoint__ - ($swing_heating_setpoint / 2) );
3538 0           my $new_heating_setpoint = $floorvalue_heating_setpoint + ($countstep * $pace_heating_setpoint);
3539              
3540 0           my $pace_cooling_setpoint = ( $swing_cooling_setpoint / ($stepsvar - 1) );
3541 0           my $floorvalue_cooling_setpoint = ($cooling_setpoint__ - ($swing_cooling_setpoint / 2) );
3542 0           my $new_cooling_setpoint = $floorvalue_cooling_setpoint + ($countstep * $pace_cooling_setpoint);
3543              
3544 0           $new_loop_hour = sprintf("%.2f", $new_loop_hour);
3545 0           $new_max_heating_power = sprintf("%.2f", $new_max_heating_power);
3546 0           $new_min_heating_power = sprintf("%.2f", $new_min_heating_power);
3547 0           $new_max_cooling_power = sprintf("%.2f", $new_max_cooling_power);
3548 0           $new_min_cooling_power = sprintf("%.2f", $new_min_cooling_power);
3549 0           $new_heating_setpoint = sprintf("%.2f", $new_heating_setpoint);
3550 0           $new_cooling_setpoint = sprintf("%.2f", $new_cooling_setpoint);
3551              
3552 0           push(@new_loopcontrols,
3553             [ $new_loop_letter, $new_loopcontrol_letter, $new_loop_hour,
3554             $new_max_heating_power, $new_min_heating_power, $new_max_cooling_power,
3555             $new_min_cooling_power, $new_heating_setpoint, $new_cooling_setpoint ] );
3556             }
3557              
3558 0           my $countflow = 0;
3559              
3560 0           foreach my $elm (@flowbulk)
3561             {
3562 0           my @askflow = @{$elm};
  0            
3563 0           my $new_flow_letter = $askflow[0];
3564 0           my $new_flowcontrol_letter = $askflow[1];
3565 0           my $swing_flow_hour = $askflow[2];
3566 0           my $swing_flow_setpoint = $askflow[3];
3567 0           my $swing_flow_onoff = $askflow[4];
3568 0 0         if ( $swing_flow_onoff eq "ON") { $swing_flow_onoff = 1; }
  0 0          
3569 0           elsif ( $swing_flow_onoff eq "OFF") { $swing_flow_onoff = -1; }
3570 0           my $swing_flow_fraction = $askflow[5];
3571              
3572 0           my $countflow = 0; # IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
3573 0           foreach $each_flow (@flowcontrol) # THIS DISTRIBUTES THOSE NESTED DATA STRUCTURES IN A FLAT MODE TO PAIR THE INPUT FILE, USER DEFINED ONE.
3574             {
3575 0           my $countcontrol = 0;
3576 0           @thisflow = @{$each_flow};
  0            
3577             # my $letterfile = $letters[$countflow];
3578 0           foreach $elm (@thisflow)
3579             {
3580 0           my @control = @{$elm};
  0            
3581             # my $letterfilecontrol = $period_letters[$countcontrol];
3582 0           $flow_letter = $flowcontrol[$countflow][$countcontrol][0];
3583 0           $flowcontrol_letter = $flowcontrol[$countflow][$countcontrol][1];
3584 0 0 0       if ( ( $new_flow_letter eq $flow_letter ) and ($new_flowcontrol_letter eq $flowcontrol_letter ) )
3585             {
3586 0           $flow_hour__ = $flowcontrol[$countflow][$countcontrol][$flow_hour];
3587 0           $flow_setpoint__ = $flowcontrol[$countflow][$countcontrol][$flow_setpoint];
3588 0           $flow_onoff__ = $flowcontrol[$countflow][$countcontrol][$flow_onoff];
3589 0 0         if ( $flow_onoff__ eq "ON") { $flow_onoff__ = 1; }
  0 0          
3590 0           elsif ( $flow_onoff__ eq "OFF") { $flow_onoff__ = -1; }
3591 0           $flow_fraction__ = $flowcontrol[$countflow][$countcontrol][$flow_fraction];
3592             }
3593 0           $countcontrol++;
3594             }
3595 0           $countflow++;
3596             }
3597            
3598 0           my $pace_flow_hour = ( $swing_flow_hour / ($stepsvar - 1) );
3599 0           my $floorvalue_flow_hour = ($flow_hour__ - ($swing_flow_hour / 2) );
3600 0           my $new_flow_hour = $floorvalue_flow_hour + ($countstep * $pace_flow_hour);
3601              
3602 0           my $pace_flow_setpoint = ( $swing_flow_setpoint / ($stepsvar - 1) );
3603 0           my $floorvalue_flow_setpoint = ($flow_setpoint__ - ($swing_flow_setpoint / 2) );
3604 0           my $new_flow_setpoint = $floorvalue_flow_setpoint + ($countstep * $pace_flow_setpoint);
3605              
3606 0           my $pace_flow_onoff = ( $swing_flow_onoff / ($stepsvar - 1) );
3607 0           my $floorvalue_flow_onoff = ($flow_onoff__ - ($swing_flow_onoff / 2) );
3608 0           my $new_flow_onoff = $floorvalue_flow_onoff + ($countstep * $pace_flow_onoff);
3609              
3610 0           my $pace_flow_fraction = ( $swing_flow_fraction / ($stepsvar - 1) );
3611 0           my $floorvalue_flow_fraction = ($flow_fraction__ - ($swing_flow_fraction / 2) );
3612 0           my $new_flow_fraction = $floorvalue_flow_fraction + ($countstep * $pace_flow_fraction);
3613              
3614 0           $new_flow_hour = sprintf("%.2f", $new_flow_hour);
3615 0           $new_flow_setpoint = sprintf("%.2f", $new_flow_setpoint);
3616 0           $new_flow_onoff = sprintf("%.2f", $new_flow_onoff);
3617 0           $new_flow_fraction = sprintf("%.2f", $new_flow_fraction);
3618              
3619 0           push(@new_flowcontrols,
3620             [ $new_flow_letter, $new_flowcontrol_letter, $new_flow_hour, $new_flow_setpoint, $new_flow_onoff, $new_flow_fraction ] );
3621             }
3622             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE APPLIED TO THE MODELS THROUGH ESP-r.
3623             # FIRST, HERE THEY ARE APPLIED TO THE ZONE CONTROLS, THEN TO THE FLOW CONTROLS
3624             }
3625             } # END SUB calc_newcontrols
3626              
3627 0         0 print $_outfile_ "\@new_loopcontrols: " . Dumper(@new_loopcontrols) . "\n\n";
3628              
3629 0         0 apply_loopcontrol_changes(\@new_loopcontrols);
3630 0         0 apply_flowcontrol_changes(\@new_flowcontrols);
3631              
3632             } # END SUB vary_controls.
3633              
3634              
3635             calc_newctl($to, $stepsvar, $countop, $countstep, \@buildbulk,
3636             \@flowbulk, \@loopcontrol, \@flowcontrol, $countvar, $fileconfig );
3637              
3638              
3639             sub constrain_controls
3640             { # IT READS CONTROL USER-IMPOSED CONSTRAINTS
3641 0     0 0   my ( $to, $filecon, $countop, $countstep, $swap, $swap2, $to_do, $countvar, $fileconfig ) = @_;
3642            
3643 0           my $zone_letter = $applytype[$countop][3];
3644 0           my @applytype = @$swap;
3645 0           my @constrain_controls = @$swap2;
3646              
3647 0           my $elm = $constrain_controls[$countop];
3648 0           my @group = @{$elm};
  0            
3649 0           my $sourcefile = $group[0];
3650 0           my $targetfile = $group[1];
3651 0           my $configfile = $group[2];
3652 0           my @sentletters = @{ $group[3] };
  0            
3653 0           my @sentperiod_letters = @{ $group[4] };
  0            
3654            
3655 0           my $sourceaddress = "$to$sourcefile";
3656 0           my $targetaddress = "$to$targetfile";
3657 0           my $configaddress = "$to$configfile";
3658             #@loopcontrol; @flowcontrol; @new_loopcontrols; @new_flowcontrols; # DON'T PUT "my" HERE. THEY ARE globsAL!!!
3659 0           my ( $semaphore_zone, $semaphore_dataloop, $semaphore_massflow, $semaphore_setpoint, $doline );
3660 0           my $count_controlmass = -1;
3661 0           my $countline = 0;
3662            
3663 0           my @letters;
3664 0 0         if (@sentletters) { @letters = @sentletters; }
  0            
3665             else
3666             {
3667 0           @letters = ("e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "z"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
3668             }
3669            
3670 0           my @period_letters;
3671 0 0         if (@sentperiod_letters) { @period_letters = @sentperiod_letters; }
  0            
3672             else
3673             {
3674 0           @period_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
3675             }
3676            
3677 0           my $loop_hour = 2; # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
3678             # BUT ARE THE ONES USED IN THE OPT CONSTRAINTS FILES.
3679 0           my $max_heating_power = 3;
3680 0           my $min_heating_power = 4;
3681 0           my $max_cooling_power = 5,
3682             my $min_cooling_power = 6;
3683 0           my $heating_setpoint = 7;
3684 0           my $cooling_setpoint = 8;
3685 0           my $flow_hour = 2;
3686 0           my $flow_setpoint = 3;
3687 0           my $flow_onoff = 4;
3688 0           my $flow_fraction = 5;
3689 0           my ( $loop_letter, $loopcontrol_letter );
3690 0           my $countbuild = 0;
3691 0           my $countflow = 0;
3692 0           my $countcontrol = 0;
3693              
3694 0           my ( @groupzone_letters, @zone_period_letters, @flow_letters, @fileloopbulk, @fileflowbulk );
3695              
3696 0 0         unless ($to_do eq "justwrite")
3697             {
3698 0 0         if ($countstep == 1)
3699             {
3700 0           print $_outfile_ "THIS\n";
3701 0           checkfile($sourceaddress, $targetaddress);
3702 0           read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3703 0           read_control_constraints($to, $stepsvar,
3704             $countop, $countstep, $configaddress, \@loopcontrol, \@flowcontrol, \@temploopcontrol, \@tempflowcontrol, $countvar, $fileconfig );
3705             }
3706             }
3707              
3708 0 0         unless ($to_do eq "justread")
3709             {
3710 0           print $_outfile_ "THAT\n";
3711 0           apply_loopcontrol_changes( \@new_loopcontrol, \@temploopcontrol);
3712 0           apply_flowcontrol_changes(\@new_flowcontrol, \@tempflowcontrol);
3713             }
3714              
3715             } # END SUB constrain_controls.
3716              
3717              
3718             sub read_controls
3719             { # TO BE CALLED WITH: read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3720             # THIS MAKES THE CONTROL CONFIGURATION FILE BE READ AND THE NEEDED VALUES ACQUIRED.
3721             # NOTICE THAT CURRENTLY ONLY THE "basic control law" IS SUPPORTED.
3722              
3723 0     0 0   my ( $sourceaddress, $targetaddress, $swap, $swap2, $countvar ) = @_;
3724            
3725 0           my @letters = @$swap;
3726 0           my @period_letters = @$swap2;
3727              
3728 0 0         open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourceaddress: $!\n";
3729 0           my @lines = ;
3730 0           close SOURCEFILE;
3731 0           my $countlines = 0;
3732 0           my $countloop = -1;
3733 0           my $countflow = -1;
3734 0           my $countflowcontrol = -1;
3735 0           my ( $countloopcontrol, $semaphore_building, $semaphore_loop, $loop_hour, $semaphore_loopcontrol, $semaphore_massflow,
3736             $flow_hour, $semaphore_flow, $semaphore_flowcontrol, $loop_letter, $loopcontrol_letter, $flow_letter, $flowcontrol_letter );
3737              
3738 0           foreach my $line (@lines)
3739             {
3740 0 0         if ( $line =~ /Control function/ )
3741             {
3742 0           $semaphore_loop = "yes";
3743 0           $countloopcontrol = -1;
3744 0           $countloop++;
3745 0           $loop_letter = $letters[$countloop];
3746             }
3747 0 0         if ( ($line =~ /ctl type, law/ ) )
3748             {
3749 0           $countloopcontrol++;
3750 0           my @row = split(/\s+/, $line);
3751 0           $loop_hour = $row[3];
3752 0           $semaphore_loopcontrol = "yes";
3753 0           $loopcontrol_letter = $period_letters[$countloopcontrol];
3754             }
3755              
3756 0 0 0       if ( ($semaphore_loop eq "yes") and ($semaphore_loopcontrol eq "yes") and ($line =~ /No. of data items/ ) )
      0        
3757             {
3758 0           $doline = $countlines + 1;
3759             }
3760              
3761 0 0 0       if ( ($semaphore_loop eq "yes" ) and ($semaphore_loopcontrol eq "yes") and ($countlines == $doline) )
      0        
3762             {
3763 0           my @row = split(/\s+/, $line);
3764 0           my $max_heating_power = $row[1];
3765 0           my $min_heating_power = $row[2];
3766 0           my $max_cooling_power = $row[3];
3767 0           my $min_cooling_power = $row[4];
3768 0           my $heating_setpoint = $row[5];
3769 0           my $cooling_setpoint = $row[6];
3770              
3771 0           push(@{$loopcontrol[$countloop][$countloopcontrol]},
  0            
3772             $loop_letter, $loopcontrol_letter, $loop_hour,
3773             $max_heating_power, $min_heating_power, $max_cooling_power,
3774             $min_cooling_power, $heating_setpoint, $cooling_setpoint );
3775              
3776 0           $semaphore_loopcontrol = "no";
3777 0           $doline = "";
3778             }
3779              
3780 0 0         if ($line =~ /Control mass/ )
3781             {
3782 0           $semaphore_flow = "yes";
3783 0           $countflowcontrol = -1;
3784 0           $countflow++;
3785 0           $flow_letter = $letters[$countflow];
3786             }
3787 0 0         if ( ($line =~ /ctl type \(/ ) )
3788             {
3789 0           $countflowcontrol++;
3790 0           my @row = split(/\s+/, $line);
3791 0           $flow_hour = $row[3];
3792 0           $semaphore_flowcontrol = "yes";
3793 0           $flowcontrol_letter = $period_letters[$countflowcontrol];
3794             }
3795              
3796 0 0 0       if ( ($semaphore_flow eq "yes") and ($semaphore_flowcontrol eq "yes") and ($line =~ /No. of data items/ ) )
      0        
3797             {
3798 0           $doline = $countlines + 1;
3799             }
3800              
3801 0 0 0       if ( ($semaphore_flow eq "yes" ) and ($semaphore_flowcontrol eq "yes") and ($countlines == $doline) )
      0        
3802             {
3803 0           my @row = split(/\s+/, $line);
3804 0           my $flow_setpoint = $row[1];
3805 0           my $flow_onoff = $row[2];
3806 0           my $flow_fraction = $row[3];
3807 0           push(@{$flowcontrol[$countflow][$countflowcontrol]},
  0            
3808             $flow_letter, $flowcontrol_letter, $flow_hour, $flow_setpoint, $flow_onoff, $flow_fraction);
3809 0           $semaphore_flowcontrol = "no";
3810 0           $doline = "";
3811             }
3812 0           $countlines++;
3813             }
3814             } # END SUB read_controls.
3815              
3816              
3817             sub read_control_constraints
3818             {
3819             # #!/usr/bin/perl
3820             # THIS FILE CAN CONTAIN USER-IMPOSED CONSTRAINTS FOR CONTROLS TO BE READ BY OPT.
3821             # THE FOLLOWING VALUES CAN BE ADDRESSED IN THE OPT CONSTRAINTS CONFIGURATION FILE,
3822             # SET BY THE PRESENT FUNCTION:
3823             # 1) $loopcontrol[$countop][$countloop][$countloopcontrol][$loop_hour]
3824             # Where $countloop and $countloopcontrol has to be set to a specified number in the OPT file for constraints.
3825             # 2) $loopcontrol[$countop][$countloop][$countloopcontrol][$max_heating_power] # Same as above.
3826             # 3) $loopcontrol[$countop][$countloop][$countloopcontrol][$min_heating_power] # Same as above.
3827             # 4) $loopcontrol[$countop][$countloop][$countloopcontrol][$max_cooling_power] # Same as above.
3828             # 5) $loopcontrol[$countop][$countloop][$countloopcontrol][$min_cooling_power] # Same as above.
3829             # 6) $loopcontrol[$countop][$countloop][$countloopcontrol][heating_setpoint] # Same as above.
3830             # 7) $loopcontrol[$countop][$countloop][$countloopcontrol][cooling_setpoint] # Same as above.
3831             # 8) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_hour]
3832             # Where $countflow and $countflowcontrol has to be set to a specified number in the OPT file for constraints.
3833             # 9) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_setpoint] # Same as above.
3834             # 10) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_onoff] # Same as above.
3835             # 11) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_fraction] # Same as above.
3836             # EXAMPLE : $flowcontrol[0][1][2][$flow_fraction] = 0.7
3837             # OTHER EXAMPLE: $flowcontrol[2][1][2][$flow_fraction] = $flowcontrol[0][2][1][$flow_fraction]
3838             # The $countop that is actuated is always the last, the one which is active.
3839             # It would have therefore no sense writing $flowcontrol[1][1][2][$flow_fraction] = $flowcontrol[3][2][1][$flow_fraction].
3840             # Differentent $countops can be referred to the same zone. Different $countops just number mutations in series.
3841             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
3842             # AND THE STEPS THE MODEL HAS TO FOLLOW.
3843             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
3844             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
3845             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
3846             # $countop, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS.
3847             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $countop WILL CONTAIN ONE OR MORE ITERATION STEPS.
3848             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
3849             # THE OTHER ARE APPLIED TO THE SAME ZONE. THE NUMBER COUNT STARTS FROM 0.
3850             # $countstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
3851             # $countvar, WHICH TELLS THE PROGRAM WHAT NUMBER OF DESIGN PARAMETER THE PROGRAM IS WORKING AT.
3852            
3853 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $swap3, $swap4, $countvar, $fileconfig ) = @_;
3854            
3855 0           @loopcontrol = @$swap;
3856 0           @flowcontrol = @$swap2;
3857 0           @temploopcontrol = @$swap3;
3858 0           @tempflowcontrol = @$swap4;
3859              
3860 0 0         if (-e $configaddress) # TEST THIS, DDD
3861             { # THIS APPLIES CONSTRAINST, THE FLATTEN THE HIERARCHICAL STRUCTURE OF THE RESULTS,
3862             # TO BE PREPARED THEN FOR BEING APPLIED TO CHANGE PROCEDURES. IT HAS TO BE TESTED.
3863 0           push (@loopcontrol, [@myloopcontrol]); #
3864 0           push (@flowcontrol, [@myflowcontrol]); #
3865              
3866 0           eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
3867             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
3868              
3869 0 0         if (-e $constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0            
3870             # FOR PROPAGATION OF CONSTRAINTS
3871              
3872 0           @doloopcontrol = @{$loopcontrol[$#loopcontrol]}; #
  0            
3873 0           @doflowcontrol = @{$flowcontrol[$#flowcontrol]}; #
  0            
3874              
3875 0           shift (@doloopcontrol);
3876 0           shift (@doflowcontrol);
3877              
3878             sub flatten_loopcontrol_constraints
3879             {
3880 0     0 0   my @looptemp = @doloopcontrol;
3881 0           @new_loopcontrol = "";
3882 0           foreach my $elm (@looptemp)
3883             {
3884 0           my @loop = @{$elm};
  0            
3885 0           foreach my $elm (@loop)
3886             {
3887 0           my @loop = @{$elm};
  0            
3888 0           push (@new_loopcontrol, [@loop]);
3889             }
3890             }
3891             }
3892 0           flatten_loopcontrol_constraints;
3893              
3894             sub flatten_flowcontrol_constraints
3895             {
3896 0     0 0   my @flowtemp = @doflowcontrol;
3897 0           @new_flowcontrol = "";
3898 0           foreach my $elm (@flowtemp)
3899             {
3900 0           my @flow = @{$elm};
  0            
3901 0           foreach my $elm (@flow)
3902             {
3903 0           my @loop = @{$elm};
  0            
3904 0           push (@new_flowcontrol, [@flow]);
3905             }
3906             }
3907             }
3908 0           flatten_flowcontrol_constraints;
3909              
3910 0           shift @new_loopcontrol;
3911 0           shift @new_flowcontrol;
3912             }
3913             } # END SUB read_control_constraints
3914              
3915              
3916             sub apply_loopcontrol_changes
3917             { # TO BE CALLED WITH: apply_loopcontrol_changes($exeonfiles, \@new_loopcontrol);
3918             # THIS APPLIES CHANGES TO LOOPS IN CONTROLS (ZONES)
3919 0     0 0   my ( $swap, $swap2, $countvar ) = @_;
3920            
3921 0           my @new_loop_ctls = @$swap;
3922 0           my @temploopcontrol = @$swap2;
3923            
3924 0           my $countloop = 0;
3925              
3926 0           foreach my $elm (@new_loop_ctls)
3927             {
3928 0           my @loop = @{$elm};
  0            
3929 0           $new_loop_letter = $loop[0];
3930 0           $new_loopcontrol_letter = $loop[1];
3931 0           $new_loop_hour = $loop[2];
3932 0           $new_max_heating_power = $loop[3];
3933 0           $new_min_heating_power = $loop[4];
3934 0           $new_max_cooling_power = $loop[5];
3935 0           $new_min_cooling_power = $loop[6];
3936 0           $new_heating_setpoint = $loop[7];
3937 0           $new_cooling_setpoint = $loop[8];
3938 0 0         unless ( @{$new_loop_ctls[$countloop]} ~~ @{$temploopcontrol[$countloop]} )
  0            
  0            
3939             {
3940 0           my $printthis =
3941             "prj -file $to/cfg/$fileconfig -mode script<
3942              
3943             m
3944             j
3945              
3946             $new_loop_letter
3947             c
3948             $new_loopcontrol_letter
3949             1
3950             $new_loop_hour
3951             b
3952             $new_max_heating_power
3953             c
3954             $new_min_heating_power
3955             d
3956             $new_max_cooling_power
3957             e
3958             $new_min_cooling_power
3959             f
3960             $new_heating_setpoint
3961             g
3962             $new_cooling_setpoint
3963             -
3964             y
3965             -
3966             -
3967             -
3968             n
3969             d
3970              
3971             -
3972             y
3973             y
3974             -
3975             -
3976             YYY
3977             ";
3978 0 0         if ($exeonfiles eq "y")
3979             {
3980 0           print `$printthis`;
3981             }
3982 0           print TOSHELL $printthis;
3983             }
3984 0           $countloop++;
3985             }
3986             } # END SUB apply_loopcontrol_changes();
3987              
3988              
3989             sub apply_flowcontrol_changes
3990             { # THIS HAS TO BE CALLED WITH: apply_flowcontrol_changes($exeonfiles, \@new_flowcontrols);
3991             # # THIS APPLIES CHANGES TO NETS IN CONTROLS
3992 0     0 0   my ( $swap, $swap2, $countvar ) = @_;
3993            
3994 0           my $countflow = 0;
3995 0           my @new_flowcontrols = @$swap;
3996 0           my @tempflowcontrol = @$swap2;
3997              
3998 0           foreach my $elm (@new_flowcontrols)
3999             {
4000 0           my @flow = @{$elm};
  0            
4001 0           $flow_letter = $flow[0];
4002 0           $flowcontrol_letter = $flow[1];
4003 0           $new_flow_hour = $flow[2];
4004 0           $new_flow_setpoint = $flow[3];
4005 0           $new_flow_onoff = $flow[4];
4006 0           $new_flow_fraction = $flow[5];
4007 0 0         unless ( @{$new_flowcontrols[$countflow]} ~~ @{$tempflowcontrol[$countflow]} )
  0            
  0            
4008             {
4009 0           my $printthis =
4010             "prj -file $to/cfg/$fileconfig -mode script<
4011              
4012             m
4013             l
4014              
4015             $flow_letter
4016             c
4017             $flowcontrol_letter
4018             a
4019             $new_flow_hour
4020             $new_flow_setpoint $new_flow_onoff $new_flow_fraction
4021             -
4022             -
4023             -
4024             y
4025             y
4026             -
4027             -
4028             YYY
4029             ";
4030 0 0         if ($exeonfiles eq "y") # if ($exeonfiles eq "y")
4031             {
4032 0           print `$printthis`;
4033             }
4034              
4035 0           print TOSHELL $printthis;
4036             }
4037 0           $countflow++;
4038             }
4039             } # END SUB apply_flowcontrol_changes;
4040             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING CONTROLS
4041             ##############################################################################
4042              
4043              
4044             ##############################################################################
4045             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING OBSTRUCTIONS
4046             sub constrain_obstructions # IT APPLIES CONSTRAINTS TO OBSTRUCTIONS
4047             {
4048             # THIS CONSTRAINS OBSTRUCTION FILES. IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
4049             # constrain_obstruction($to, $fileconfig, $stepsvar, $countop, $countstep, $exeonfiles, \@applytype, \@constrain_obstructions);
4050 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $to_do, $countvar, $fileconfig ) = @_;
4051            
4052 0           my @applytype = @$swap;
4053 0           my $zone_letter = $applytype[$countop][3];
4054 0           my @constrain_obstructions = @$swap2;
4055            
4056 0           say "Propagating constraints on obstructions for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
4057              
4058 0           my @work_letters;
4059             #@obs; # globsAL!
4060              
4061 0           foreach my $elm (@constrain_obstructions)
4062             {
4063 0           my @group = @{$elm};
  0            
4064 0           my $zone_letter = $group[0];
4065 0           my $sourcefile = $group[1];
4066 0           my $targetfile = $group[2];
4067 0           my $configfile_ = $group[3];
4068 0           my $sourceaddress = "$to$sourcefile";
4069 0           my $targetaddress = "$to$targetfile";
4070 0           my $configaddress = "$to$configfile";
4071 0           my @work_letters = @{$group[4]};
  0            
4072 0           my $actonmaterials = $group[5];
4073 0           my @sentobs_letters = @{$group[6]};
  0            
4074            
4075 0 0         unless ($to_do eq "justwrite")
4076             {
4077 0           checkfile($sourceaddress, $targetaddress);
4078 0           read_obstructions($to, $sourceaddress, $targetaddress, $configaddress, \@work_letters, $actonmaterials, $countvar, \@sentobs_letters);
4079 0           read_obs_constraints($to, $stepsvar, $countop, $countstep, $configaddress, $actonmaterials, \@tempobs, $countvar, $fileconfig ); # IT WORKS ON THE VARIABLE @obs, WHICH IS globsAL.
4080             }
4081              
4082 0 0         unless ($to_do eq "justread")
4083             {
4084 0           apply_obs_constraints(\@doobs, \@obs_letters, \@work_letters, $zone_letter, $actonmaterials, \@tempobs);
4085             }
4086             }
4087             } # END SUB constrain_obstructions
4088              
4089              
4090             sub read_obstructions
4091             {
4092             # THIS READS GEOMETRY FILES. # IT HAS TO BE CALLED WITH:
4093             # read_obstructions($to, $sourcefile, $targetfile, $configfiles, \@work_letters, $actonmaterials, $countvar);
4094 0     0 0   my ( $to, $sourceaddress, $targetaddress, $configaddress, $swap, $actonmaterials, $countvar, $swap2 ) = @_;
4095            
4096 0           my @obs_letters;
4097            
4098 0           my @work_letters = @$swap;
4099 0           my @sentobs_letters = @$swap2;
4100            
4101 0 0         open( SOURCEFILE, $sourceaddress) or die "Can't open $sourceaddress: $!\n";
4102 0           my @lines = ;
4103 0           close SOURCEFILE;
4104              
4105 0           my $count = 0;
4106 0           foreach my $line (@lines)
4107             {
4108             #$line =~ s/^\s+//;
4109 0 0         if ( $line =~ m/\*obs/ )
4110             {
4111 0 0         unless ( $line =~ m/\*obs =/ )
4112             {
4113 0           $count++;
4114             }
4115             }
4116             }
4117            
4118 0 0         if (@sentobs_letters)
4119             {
4120 0           @obs_letters = @sentobs_letters;
4121             }
4122             else
4123             {
4124 0 0         if ( $count > 21 )
4125             {
4126 0           @obs_letters = ("e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
4127             "o", "0\nb\nf", "0\nb\ng", "0\nb\nh", "0\nb\ni", "0\nb\nj", "0\nb\nk", "0\nb\nm",
4128             "0\nb\nn", "0\nb\no", "0\nb\n0\nb\nf","0\nb\n0\nb\ng",
4129             "0\nb\n0\nb\nh","0\nb\n0\nb\ni","0\nb\n0\nb\nj","0\nb\n0\nb\nk","0\nb\n0\nb\nl",
4130             "0\nb\n0\nb\nm","0\nb\n0\nb\nn","0\nb\n0\nb\no","0\nb\n0\nb\n0\nb\nf",
4131             "0\nb\n0\nb\n0\nb\ng","0\nb\n0\nb\n0\nb\nh","0\nb\n0\nb\n0\nb\ni","0\nb\n0\nb\n0\nb\nj",
4132             "0\nb\n0\nb\n0\nb\nk","0\nb\n0\nb\n0\nb\nl","0\nb\n0\nb\n0\nb\nm","0\nb\n0\nb\n0\nb\nn",
4133             "0\nb\n0\nb\n0\nb\no");
4134             }
4135             else
4136             {
4137 0           @obs_letters = ("e", "f", "g", "h", "i", "j", "k", "l", "m",
4138             "n", "o", "0\nf", "0\ng", "0\nh", "0\ni", "0\nj", "0\nk", "0\nl",
4139             "0\nm", "0\nn", "0\no");
4140             }
4141             }
4142              
4143 0           my $count = 0;
4144 0           foreach my $line (@lines)
4145             {
4146 0 0         if ( $line =~ m/\*obs/ )
4147             {
4148 0 0         unless ( $line =~ m/\*obs =/ )
4149             {
4150             #$line =~ s/^\s+//;
4151 0           my @rowelements = split(/,/, $line);
4152 0           push (@obs, [ $rowelements[1], $rowelements[2], $rowelements[3],
4153             $rowelements[4], $rowelements[5], $rowelements[6],
4154             $rowelements[7], $rowelements[8], $rowelements[9],
4155             $rowelements[10], $rowelements[11], $rowelements[12], $obs_letters[$count] ] );
4156 0           $count++;
4157             }
4158             }
4159             }
4160             } # END SUB read_obstructions
4161              
4162              
4163             sub read_obs_constraints
4164             {
4165             # THE VARIABLE @obs REGARDS OBSTRUCTION USER-IMPOSED CONSTRAINTS
4166             # THIS CONSTRAINT CONFIGURATION FILE MAKES AVAILABLE TO THE USER THE FOLLOWING VARIABLES:
4167             # $obs[$countop][$obs_number][$x], $obs[$countop][$obs_number][$y], $obs[$countop][$obs_number][$y]
4168             # $obs[$countop][$obs_number][$width], $obs[$countop][$obs_number][$depth], $obs[$countop][$obs_number][$height]
4169             # $obs[$countop][$obs_number][$z_rotation], $obs[$countop][$obs_number][$y_rotation],
4170             # $obs[$countop][$obs_number][$tilt], $obs[$countop][$obs_number][$opacity], $obs[$countop][$obs_number][$material],
4171             # EXAMPLE: $obs[0][2][$x] = 2. THIS MEANS: AT COUNTERZONE 0, COORDINATE x OF OBSTRUCTION HAS TO BE SET TO 2.
4172             # OTHER EXAMPLE: $obs[0][2][$x] = $obs[2][2][$y].
4173             # The $countop that is actuated is always the last, the one which is active.
4174             # There would be therefore no sense in writing $obs[0][4][$x] = $obs[1][2][$y].
4175             # Differentent $countops can be referred to the same zone. Different $countops just number mutations in series.
4176             # NOTE THAT THE MATERIAL TO BE SPECIFIED IS A MATERIAL LETTER, BETWEEN QUOTES. EXAMPLE: $obs[1][$material] = "a".
4177             # $tilt IS PRESENTLY UNUSED.
4178             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
4179             # AND THE STEPS THE MODEL HAVE TO FOLLOW.
4180             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
4181             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
4182             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
4183             # $countop, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
4184             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $countop WILL CONTAIN ONE OR MORE ITERATION STEPS.
4185             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
4186             # THE OTHER ARE APPLIED TO THE SAME ZONE. THE NUMBER COUNT STARTS FROM 0.
4187             # $countstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
4188             # $countvar, WHICH TELLS THE PROGRAM WHAT NUMBER OF DESIGN PARAMETER THE PROGRAM IS WORKING AT.
4189 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $configaddress, $actonmaterials, $swap, $countvar, $fileconfig ) = @_;
4190            
4191 0           @tempobs = @$swap;
4192              
4193 0           my $obs_letter = 13;
4194 0           my $x = 1;
4195 0           my $y = 2;
4196 0           my $z = 3;
4197 0           my $width = 4;
4198 0           my $depth = 5;
4199 0           my $height = 6;
4200 0           my $z_rotation = 7;
4201 0           my $y_rotation = 8;
4202 0           my $tilt = 9; # UNUSED
4203 0           my $opacity = 10;
4204 0           my $name = 11; # NOT TO BE CHANGED
4205 0           my $material = 12;
4206 0 0         if (-e $configaddress)
4207             {
4208 0           unshift (@obs, []);
4209 0           push (@obs, [@myobs]); #
4210 0           eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED.
4211              
4212 0 0         if (-e $constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0            
4213             # FOR PROPAGATION OF CONSTRAINTS
4214              
4215 0           @doobs = @{$obs[$#obs]}; #
  0            
4216 0           shift @doobs;
4217             }
4218             } # END SUB read_geo_constraints
4219              
4220              
4221             sub apply_obs_constraints
4222             {
4223             # IT APPLY USER-IMPOSED CONSTRAINTS TO A GEOMETRY FILES VIA SHELL
4224             # IT HAS TO BE CALLED WITH:
4225             # apply_geo_constraints(\@obs, \@obsletters, \@work_letters, \$exeonfiles, \$zone_letter, $actonmaterials);
4226 0     0 0   my ( $swap, $swap2, $swap3, $zone_letter, $actonmaterials, $swap4, $countvar ) = @_;
4227            
4228 0           my @obs = @$swap;
4229 0           my @obs_letters = @$swap2;
4230 0           my @work_letters = @$swap3;
4231 0           my @tempobs = @$swap4;
4232            
4233              
4234 0           my $countobs = 0;
4235 0           print $_outfile_ "OBS_LETTERS IN APPLY" . Dumper(@obs_letters) . "\n\n";
4236 0           foreach my $ob (@obs)
4237             {
4238 0           my $obs_letter = $obs_letters[$countobs];
4239 0 0 0       if ( ( @work_letters eq "") or ($obs_letter ~~ @work_letters))
4240             {
4241 0           my @obstr = @{$ob};
  0            
4242 0           my $x = $obstr[0];
4243 0           my $y = $obstr[1];
4244 0           my $z = $obstr[2];
4245 0           my $width = $obs[3];
4246 0           my $depth = $obs[4];
4247 0           my $height = $obs[5];
4248 0           my $z_rotation = $obs[6];
4249 0           my $y_rotation = $obs[7];
4250 0           my $tilt = $obs[8];
4251 0           my $opacity = $obs[9];
4252 0           my $name = $obs[10];
4253 0           my $material = $obs[11];
4254 0 0         unless
4255             (
4256 0           ( @{$obs[$countobs]} ~~ @{$tempobs[$countobs]} )
  0            
4257             )
4258             {
4259 0           my $printthis =
4260             "prj -file $to/cfg/$fileconfig -mode script<
4261              
4262             m
4263             c
4264             a
4265             $zone_letter
4266             h
4267             a
4268             $obs_letter
4269             a
4270             a
4271             $x $y $z
4272             b
4273             $width $depth $height
4274             c
4275             $z_rotation
4276             d
4277             $y_rotation
4278             e # HERE THE DATUM IS STILL UNUSED. WHEN IT WILL, A LINE MUST BE ADDED WITH THE VARIABLE $tilt.
4279             h
4280             $opacity
4281             -
4282             -
4283             c
4284             -
4285             c
4286             -
4287             -
4288             -
4289             -
4290             YYY
4291             ";
4292 0 0         if ($exeonfiles eq "y")
4293             {
4294 0           print `$printthis`;
4295             }
4296              
4297 0           print TOSHELL $printthis;
4298             }
4299              
4300 0           my $obs_letter = $obs_letters[$countobs];
4301 0 0         if ($obs_letter ~~ @work_letters)
4302             {
4303 0 0         if ($actonmaterials eq "y")
4304             {
4305 0           my $printthis =
4306             "prj -file $to/cfg/$fileconfig -mode script<
4307              
4308             m
4309             c
4310             a
4311             $zone_letter
4312             h
4313             a
4314             $obs_letter
4315             g
4316             $material
4317             -
4318             -
4319             -
4320             c
4321             -
4322             c
4323             -
4324             -
4325             -
4326             -
4327             YYY
4328             ";
4329 0 0         if ($exeonfiles eq "y")
4330             {
4331 0           print `$printthis`;
4332             }
4333              
4334 0           print TOSHELL $printthis;
4335             }
4336             }
4337             }
4338 0           $countobs++;
4339             }
4340             } # END SUB apply_obs_constraints
4341             ##############################################################################
4342             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING OBSTRUCTIONS
4343              
4344              
4345             ##############################################################################
4346             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING THE MASS-FLOW NETWORKS
4347             sub vary_net
4348             { # IT IS CALLED FROM THE MAIN FILE
4349 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $countvar, $fileconfig ) = @_;
4350            
4351 0           my @applytype = @$swap;
4352 0           my $zone_letter = $applytype[$countop][3];
4353 0           my @vary_net = @$swap2;
4354            
4355 0           say "Propagating constraints on networks for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
4356              
4357 0           my $activezone = $applytype[$countop][3];
4358 0           my ($semaphore_node, $semaphore_component, $node_letter);
4359 0           my $count_component = -1;
4360 0           my $countline = 0;
4361 0           my @node_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
4362 0           my @component_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
4363             # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
4364             # BUT ARE THE ONES USED IN THE OPT CONSTRAINTS FILES.
4365              
4366 0           my @group = @{$vary_net[$countop]};
  0            
4367 0           my $sourcefile = $group[0];
4368 0           my $targetfile = $group[1];
4369 0           my $configfile = $group[2];
4370 0           my @nodebulk = @{$group[3]};
  0            
4371 0           my @componentbulk = @{$group[4]};
  0            
4372 0           my $countnode = 0;
4373 0           my $countcomponent = 0;
4374              
4375 0           my $sourceaddress = "$to$sourcefile";
4376 0           my $targetaddress = "$to$targetfile";
4377 0           my $configaddress = "$to$configfile";
4378              
4379             #@node; @component; # PLURAL. DON'T PUT "my" HERE!
4380             #@new_nodes; @new_components; # DON'T PUT "my" HERE.
4381              
4382 0           my @flow_letters;
4383              
4384 0           checkfile($sourceaddress, $targetaddress);
4385              
4386 0 0         if ($countstep == 1)
4387             {
4388 0           read_net($sourceaddress, $targetaddress, \@node_letters, \@component_letters);
4389             }
4390              
4391             sub calc_newnet
4392             { # TO BE CALLED WITH: calc_newnet($to, $fileconfig, $stepsvar, $countop, $countstep, \@nodebulk, \@componentbulk, \@node_, \@component);
4393             # THIS COMPUTES CHANGES TO BE MADE TO CONTROLS BEFORE PROPAGATION OF CONSTRAINTS
4394 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $swap3, $swap4, $countvar, $fileconfig ) = @_;
4395            
4396 0           my @nodebulk = @$swap;
4397 0           my @componentbulk = @$swap2;
4398 0           my @node = @$swap3; # PLURAL
4399 0           my @component = @$swap4; # PLURAL
4400            
4401 0           my ( @new_volumes_or_surfaces, @node_heights_or_cps, @new_azimuths, @boundary_heights );
4402              
4403             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE CALCULATED.
4404 0 0         if ($stepsvar == 0) {$stepsvar = 1;}
  0            
4405 0 0         if ($stepsvar > 1)
4406             {
4407 0           foreach $each_nodebulk (@nodebulk)
4408             {
4409 0           my @asknode = @{$each_nodebulk};
  0            
4410 0           my $new_node_letter = $asknode[0];
4411 0           my $new_fluid = $asknode[1];
4412 0           my $new_type = $asknode[2];
4413 0           my $new_zone = $activezone;
4414 0           my $swing_height = $asknode[3];
4415 0           my $swing_data_2 = $asknode[4];
4416 0           my $new_surface = $asknode[5];
4417 0           my @askcp = @{$asknode[6]};
  0            
4418 0           my ($height__, $data_2__, $data_1__, $new_cp);
4419 0           my $countnode = 0; #IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
4420 0           foreach $each_node (@node)
4421             {
4422 0           @node_ = @{$each_node};
  0            
4423 0           my $node_letter = $node_[0];
4424 0 0         if ( $new_node_letter eq $node_letter )
4425             {
4426 0           $height__ = $node_[3];
4427 0           $data_2__ = $node_[4];
4428 0           $data_1__ = $node_[5];
4429 0           $new_cp = $askcp[$countstep-1];
4430             }
4431 0           $countnode++;
4432             }
4433 0           my $height = ( $swing_height / ($stepsvar - 1) );
4434 0           my $floorvalue_height = ($height__ - ($swing_height / 2) );
4435 0           my $new_height = $floorvalue_height + ($countstep * $pace_height);
4436 0           $new_height = sprintf("%.3f", $height);
4437 0 0         if ($swing_height == 0) { $new_height = ""; }
  0            
4438              
4439 0           my $pace_data_2 = ( $swing_data_2 / ($stepsvar - 1) );
4440 0           my $floorvalue_data_2 = ($data_2__ - ($swing_data_2 / 2) );
4441 0           my $new_data_2 = $floorvalue_data_2 + ($countstep * $pace_data_2);
4442 0           $new_data_2 = sprintf("%.3f", $new_data_2);
4443 0 0         if ($swing_data_2 == 0) { $new_data_2 = ""; }
  0            
4444              
4445 0           my $pace_data_1 = ( $swing_data_1 / ($stepsvar - 1) ); # UNUSED
4446 0           my $floorvalue_data_1 = ($data_1__ - ($swing_data_1 / 2) );
4447 0           my $new_data_1 = $floorvalue_data_1 + ($countstep * $pace_data_1);
4448 0           $new_data_1 = sprintf("%.3f", $new_data_1);
4449 0 0         if ($swing_data_1 == 0) { $new_data_1 = ""; }
  0            
4450              
4451 0           push(@new_nodes,
4452             [ $new_node_letter, $new_fluid, $new_type, $new_zone, $new_height, $new_data_2, $new_surface, $new_cp ] );
4453             }
4454              
4455 0           foreach $each_componentbulk (@componentbulk)
4456             {
4457 0           my @askcomponent = @{$each_componentbulk};
  0            
4458 0           my $new_component_letter = $askcomponent[0];
4459              
4460 0           my $new_type = $askcomponent[1];
4461 0           my $swing_data_1 = $askcomponent[2];
4462 0           my $swing_data_2 = $askcomponent[3];
4463 0           my $swing_data_3 = $askcomponent[4];
4464 0           my $swing_data_4 = $askcomponent[5];
4465 0           my $component_letter;
4466 0           my $countcomponent = 0; #IT IS FOR THE FOLLOWING FOREACH.
4467 0           my ($new_type, $data_1__, $data_2__, $data_3__, $data_4__ );
4468 0           foreach $each_component (@component) # PLURAL
4469             {
4470 0           @component_ = @{$each_component};
  0            
4471 0           $component_letter = $component_letters[$countcomponent];
4472 0 0         if ( $new_component_letter eq $component_letter )
4473             {
4474 0           $new_component_letter = $component_[0];
4475 0           $new_fluid = $component_[1];
4476 0           $new_type = $component_[2];
4477 0           $data_1__ = $component_[3];
4478 0           $data_2__ = $component_[4];
4479 0           $data_3__ = $component_[5];
4480 0           $data_4__ = $component_[6];
4481             }
4482 0           $countcomponent++;
4483             }
4484              
4485 0           my $pace_data_1 = ( $swing_data_1 / ($stepsvar - 1) );
4486 0           my $floorvalue_data_1 = ($data_1__ - ($swing_data_1 / 2) );
4487 0           my $new_data_1 = $floorvalue_data_1 + ($countstep * $pace_data_1);
4488 0 0         if ($swing_data_1 == 0) { $new_data_1 = ""; }
  0            
4489              
4490 0           my $pace_data_2 = ( $swing_data_2 / ($stepsvar - 1) );
4491 0           my $floorvalue_data_2 = ($data_2__ - ($swing_data_2 / 2) );
4492 0           my $new_data_2 = $floorvalue_data_2 + ($countstep * $pace_data_2);
4493 0 0         if ($swing_data_2 == 0) { $new_data_2 = ""; }
  0            
4494              
4495 0           my $pace_data_3 = ( $swing_data_3 / ($stepsvar - 1) );
4496 0           my $floorvalue_data_3 = ($data_3__ - ($swing_data_3 / 2) );
4497 0           my $new_data_3 = $floorvalue_data_3 + ($countstep * $pace_data_3 );
4498 0 0         if ($swing_data_3 == 0) { $new_data_3 = ""; }
  0            
4499              
4500 0           my $pace_data_4 = ( $swing_data_4 / ($stepsvar - 1) );
4501 0           my $floorvalue_data_4 = ($data_4__ - ($swing_data_4 / 2) );
4502 0           my $new_data_4 = $floorvalue_data_4 + ($countstep * $pace_data_4 );
4503 0 0         if ($swing_data_4 == 0) { $new_data_4 = ""; }
  0            
4504              
4505 0           $new_data_1 = sprintf("%.3f", $new_data_1);
4506 0           $new_data_2 = sprintf("%.3f", $new_data_2);
4507 0           $new_data_3 = sprintf("%.3f", $new_data_3);
4508 0           $new_data_4 = sprintf("%.3f", $new_data_4);
4509 0           $new_data_4 = sprintf("%.3f", $new_data_4);
4510              
4511 0           push(@new_components, [ $new_component_letter, $new_fluid, $new_type, $new_data_1, $new_data_2, $new_data_3, $new_data_4 ] );
4512             }
4513             }
4514             } # END SUB calc_newnet
4515              
4516 0           calc_newnet($to, $stepsvar, $countop, $countstep, \@nodebulk, \@componentbulk, \@node, \@component, $countvar, $fileconfig ); # PLURAL
4517              
4518 0           apply_node_changes(\@new_nodes);
4519 0           apply_component_changes(\@new_components);
4520              
4521             } # END SUB vary_net.
4522              
4523              
4524             sub read_net
4525             {
4526 0     0 0   my ( $sourceaddress, $targetaddress, $swap, $swap2, $countvar ) = @_;
4527            
4528             # checkfile($sourceaddress, $targetaddress); # THIS HAS TO BE _FIXED!_
4529 0           my @node_letters = @$swap;
4530 0           my @component_letters = @$swap2;
4531              
4532 0 0         open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile : $!\n";
4533 0           my @lines = ;
4534 0           close SOURCEFILE;
4535 0           my $countlines = 0;
4536 0           my $countnode = -1;
4537 0           my $countcomponent = -1;
4538 0           my $countcomp = 0;
4539 0           my $semaphore_node = "no";
4540 0           my $semaphore_component = "no";
4541 0           my $semaphore_connection = "no";
4542 0           my ($component_letter, $type, $data_1, $data_2, $data_3, $data_4);
4543 0           foreach my $line (@lines)
4544             {
4545 0 0         if ( $line =~ m/Fld. Type/ )
4546             {
4547 0           $semaphore_node = "yes";
4548             }
4549 0 0         if ( $semaphore_node eq "yes" )
4550             {
4551 0           $countnode++;
4552             }
4553 0 0         if ( $line =~ m/Type C\+ L\+/ )
4554             {
4555 0           $semaphore_component = "yes";
4556 0           $semaphore_node = "no";
4557             }
4558              
4559              
4560              
4561 0 0 0       if ( ($semaphore_node eq "yes") and ( $semaphore_component eq "no" ) and ( $countnode >= 0))
      0        
4562             {
4563 0           $line =~ s/^\s+//;
4564 0           my @row = split(/\s+/, $line);
4565 0           my $node_letter = $node_letters[$countnode];
4566 0           my $fluid = $row[1];
4567 0           my $type = $row[2];
4568 0           my $height = $row[3];
4569 0           my $data_2 = $row[6]; # volume or azimuth
4570 0           my $data_1 = $row[5]; #surface
4571 0           push(@node, [ $node_letter, $fluid, $type, $height, $data_2, $data_1 ] ); # PLURAL
4572             }
4573              
4574 0 0         if ( $semaphore_component eq "yes" )
4575             {
4576 0           $countcomponent++;
4577             }
4578              
4579 0 0         if ( $line =~ m/\+Node/ )
4580             {
4581 0           $semaphore_connection = "yes";
4582 0           $semaphore_component = "no";
4583 0           $semaphore_node = "no";
4584             }
4585              
4586 0 0 0       if ( ($semaphore_component eq "yes") and ( $semaphore_connection eq "no" ) and ( $countcomponent > 0))
      0        
4587             {
4588 0           $line =~ s/^\s+//;
4589 0           my @row = split(/\s+/, $line);
4590 0 0         if ($countcomponent % 2 == 1) # $number is odd
4591             {
4592 0           $component_letter = $component_letters[$countcomp];
4593 0           $fluid = $row[0];
4594 0           $type = $row[1];
4595 0 0         if ($type eq "110") { $type = "k";}
  0            
4596 0 0         if ($type eq "120") { $type = "l";}
  0            
4597 0 0         if ($type eq "130") { $type = "m";}
  0            
4598 0           $countcomp++;
4599             }
4600             else # $number is even
4601             {
4602 0           $data_1 = $row[1];
4603 0           $data_2 = $row[2];
4604 0           $data_3 = $row[3];
4605 0           $data_4 = $row[4];
4606 0           push( @component, [ $component_letter, $fluid, $type, $data_1, $data_2, $data_3, $data_4 ] ); # PLURAL
4607             }
4608              
4609             }
4610              
4611 0           $countlines++;
4612             }
4613             } # END SUB read_controls.
4614              
4615              
4616             sub apply_node_changes
4617             { # TO BE CALLED WITH: apply_node_changes($exeonfiles, \@new_nodes);
4618             # THIS APPLIES CHANGES TO NODES IN NETS
4619 0     0 0   my ( $swap, $swap2, $countvar ) = @_;
4620            
4621 0           my @new_nodes = @$swap;
4622 0           my @tempnodes = @$swap2;
4623              
4624 0           my $countnode = 0;
4625 0           foreach my $elm (@new_nodes)
4626             {
4627 0           my @node_ = @{$elm};
  0            
4628 0           my $new_node_letter = $node_[0];
4629 0           my $new_fluid = $node_[1];
4630 0           my $new_type = $node_[2];
4631 0           my $new_zone = $node_[3];
4632 0           my $new_height = $node_[4];
4633 0           my $new_data_2 = $node_[5];
4634 0           my $new_surface = $node_[6];
4635 0           my $new_cp = $node_[7];
4636              
4637 0 0         unless ( @{$new_nodes[$countnode]} ~~ @{$tempnodes[$countnode]} )
  0            
  0            
4638             {
4639 0 0         if ($new_type eq "a" ) # IF NODES ARE INTERNAL
4640             {
4641 0           my $printthis =
4642             "prj -file $to/cfg/$fileconfig -mode script<
4643              
4644             m
4645             e
4646             c
4647              
4648             n
4649             c
4650             $new_node_letter
4651              
4652             $new_fluid
4653             $new_type
4654             y
4655             $new_zone
4656             $new_data_2
4657             $new_height
4658             a
4659              
4660             -
4661             -
4662             y
4663              
4664             y
4665             -
4666             -
4667             YYY
4668             ";
4669 0 0         if ($exeonfiles eq "y")
4670             {
4671 0           print `$printthis`;
4672             }
4673 0           print TOSHELL $printthis;
4674             }
4675              
4676 0 0         if ($new_type eq "e" ) # IF NODES ARE BOUNDARY ONES, WIND-INDUCED
4677             {
4678 0           my $printthis =
4679             "prj -file $to/cfg/$fileconfig -mode script<
4680              
4681             m
4682             e
4683             c
4684              
4685             n
4686             c
4687             $new_node_letter
4688              
4689             $new_fluid
4690             $new_type
4691             $new_zone
4692             $new_surface
4693             $new_cp
4694             y
4695             $new_data_2
4696             $new_height
4697             -
4698             -
4699             y
4700              
4701             y
4702             -
4703             -
4704             YYY
4705             ";
4706 0 0         if ($exeonfiles eq "y")
4707             {
4708 0           print `$printthis`;
4709             }
4710 0           print TOSHELL $printthis;
4711             }
4712             }
4713 0           $countnode++;
4714             }
4715             } # END SUB apply_node_changes;
4716              
4717              
4718             sub apply_component_changes
4719             { # TO BE CALLED WITH: apply_component_changes($exeonfiles, \@new_components);
4720             # THIS APPLIES CHANGES TO COMPONENTS IN NETS
4721 0     0 0   my ( $swap, $swap2, $countvar ) = @_;
4722            
4723 0           my @new_components = @$swap; # [ $new_component_letter, $new_type, $new_data_1, $new_data_2, $new_data_3, $new_data_4 ]
4724 0           my @tempcomponents = @$swap2;
4725              
4726 0           my $countcomponent = 0;
4727 0           foreach my $elm (@new_components)
4728             {
4729 0           my @component_ = @{$elm};
  0            
4730 0           my $new_component_letter = $component_[0];
4731 0           my $new_fluid = $component_[1];
4732 0           my $new_type = $component_[2];
4733 0           my $new_data_1 = $component_[3];
4734 0           my $new_data_2 = $component_[4];
4735 0           my $new_data_3 = $component_[5];
4736 0           my $new_data_4 = $component_[6];
4737              
4738 0 0         unless
4739 0           ( @{$new_components[$countcomponents]} ~~ @{$tempcomponents[$countcomponents]} )
  0            
4740             {
4741 0 0         if ($new_type eq "k" ) # IF THE COMPONENT IS A GENERIC OPENING
4742             {
4743 0           my $printthis =
4744             "prj -file $to/cfg/$fileconfig -mode script<
4745              
4746             m
4747             e
4748             c
4749              
4750             n
4751             d
4752             $new_component_letter
4753             $new_fluid
4754             $new_type
4755             -
4756             $new_data_1
4757             -
4758             -
4759             y
4760              
4761             y
4762             -
4763             -
4764             YYY
4765             ";
4766 0 0         if ($exeonfiles eq "y")
4767             {
4768 0           print `$printthis`;
4769             }
4770 0           print TOSHELL $printthis;
4771             }
4772              
4773 0 0         if ($new_type eq "l" ) # IF THE COMPONENT IS A CRACK
4774             {
4775 0           my $printthis =
4776             "prj -file $to/cfg/$fileconfig -mode script<
4777              
4778             m
4779             e
4780             c
4781              
4782             n
4783             d
4784             $new_component_letter
4785             $new_fluid
4786             $new_type
4787             -
4788             $new_data_1 $new_data_2
4789             -
4790             -
4791             y
4792              
4793             y
4794             -
4795             -
4796             YYY
4797             ";
4798 0 0         if ($exeonfiles eq "y")
4799             {
4800 0           print `$printthis`;
4801             }
4802 0           print TOSHELL $printthis;
4803             }
4804              
4805 0 0         if ($new_type eq "m" ) # IF THE COMPONENT IS A DOOR
4806             {
4807 0           my $printthis =
4808             "prj -file $to/cfg/$fileconfig -mode script<
4809              
4810             m
4811             e
4812             c
4813              
4814             n
4815             d
4816             $new_component_letter
4817             $new_fluid
4818             $new_type
4819             -
4820             $new_data_1 $new_data_2 $new_data_3 $new_data_4
4821             -
4822             -
4823             y
4824              
4825             y
4826             -
4827             -
4828             YYY
4829             ";
4830 0 0         if ($exeonfiles eq "y")
4831             {
4832 0           print `$printthis`;
4833             }
4834 0           print TOSHELL "$printthis";
4835             }
4836             }
4837 0           $countcomponent++;
4838             }
4839             } # END SUB apply_component_changes;
4840              
4841              
4842             sub constrain_net
4843             { # IT ALLOWS TO MANIPULATE USER-IMPOSED CONSTRAINTS REGARDING NETS
4844 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $swap2, $to_do, $countvar, $fileconfig ) = @_;
4845            
4846 0           my @applytype = @$swap;
4847 0           my $zone_letter = $applytype[$countop][3];
4848 0           my @constrain_net = @$swap2;
4849              
4850 0           my $elm = $constrain_net[$countop];
4851 0           my @group = @{$elm};
  0            
4852 0           my $sourcefile = $group[0];
4853 0           my $targetfile = $group[1];
4854 0           my $configfile = $group[2];
4855 0           my @nodebulk = @{$group[3]};
  0            
4856 0           my @componentbulk = @{$group[4]};
  0            
4857 0           my $sourceaddress = "$to$sourcefile";
4858 0           my $targetaddress = "$to$targetfile";
4859 0           my $configaddress = "$to$configfile";
4860              
4861 0           my $node = 0;
4862 0           my $fluid = 1;
4863 0           my $type = 2;
4864 0           my $height = 3;
4865 0           my $volume = 4;
4866 0           my $volume = 4;
4867 0           my $azimuth = 4;
4868 0           my $component = 0;
4869 0           my $area = 3;
4870 0           my $width = 4;
4871 0           my $length = 5;
4872 0           my $door_width = 4;
4873 0           my $door_height = 5;
4874 0           my $door_nodeheight = 6;
4875 0           my $door_discharge = 7;
4876              
4877 0           my $activezone = $applytype[$countop][3];
4878 0           my ($semaphore_node, $semaphore_component, $node_letter);
4879 0           my $count_component = -1;
4880 0           my $countline = 0;
4881 0           my @node_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
4882 0           my @component_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "l", "m", "n", "o", "p", "q", "r", "s"); # CHECK IF THE LAST LETTERS ARE CORRECT, ZZZ
4883 0           my $countnode = 0;
4884 0           my $countcomponent = 0;
4885              
4886             #@node; @component; # PLURAL! DON'T PUT "MY" HERE. globsAL.
4887             #@new_nodes; @new_components; # DON'T PUT "my" HERE. THEY ARE globsAL!!!
4888              
4889 0 0         unless ($to_do eq "justwrite")
4890             {
4891 0           checkfile($sourceaddress, $targetaddress);
4892 0 0         if ($countstep == 1)
4893             {
4894 0           read_net($sourceaddress, $targetaddress, \@node_letters, \@component_letters);
4895 0           read_net_constraints
4896             ($to, $stepsvar, $countop, $countstep, $configaddress, \@node, \@component, \@tempnode, \@tempcomponent, $countvar, $fileconfig ); # PLURAL
4897             }
4898             }
4899              
4900 0 0         unless ($to_do eq "justread")
4901             {
4902 0           apply_node_changes(\@donode, \@tempnode); #PLURAL
4903 0           apply_component_changes(\@docomponent, \@tempcomponent);
4904             }
4905             } # END SUB constrain_net.
4906              
4907              
4908             sub read_net_constraints
4909             {
4910 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $configaddress, $swap, $swap2, $swap3, $swap4, $countvar, $fileconfig ) = @_;
4911            
4912 0           @node = @$swap; # PLURAL
4913 0           @component = @$swap2;
4914 0           @tempnode = @$swap3;
4915 0           @tempcomponent = @$swap4;
4916              
4917 0           unshift (@node, []); # PLURAL
4918 0           unshift (@component, []);
4919 0 0         if (-e $configaddress) # TEST THIS
4920             { # THIS APPLIES CONSTRAINST, THE FLATTEN THE HIERARCHICAL STRUCTURE OF THE RESULTS,
4921             # TO BE PREPARED THEN FOR BEING APPLIED TO CHANGE PROCEDURES. IT IS TO BE TESTED.
4922              
4923 0           push (@node, [@mynode]); #
4924 0           push (@component, [@mycomponent]); #
4925              
4926 0           eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
4927             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
4928             # THIS FILE CAN CONTAIN USER-IMPOSED CONSTRAINTS FOR MASS-FLOW NETWORKS TO BE READ BY OPT.
4929             # IT MAKES AVAILABLE VARIABLES REGARDING THE SETTING OF NODES IN A NETWORK.
4930             # CURRENTLY: INTERNAL UNKNOWN AIR NODES AND BOUNDARY WIND-CONCERNED NODES.
4931             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
4932             # CURRENTLY: WINDOWS, CRACKS, DOORS.
4933             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
4934             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
4935             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
4936             # $node[$countop][node_number][$node]. # EXAMPLE: $node[0][3][$node]. THIS IS THE LETTER OF THE THIRD NODE,
4937             # AT THE FIRST CONTERZONE (NUMBERING STARTS FROM 0)
4938             # $node[$countop][node_number][$type]
4939             # $node[$countop][node_number][$height]. # EXAMPLE: $node[0][3][$node]. THIS IS THE HEIGHT OF THE 3RD NODE AT THE FIRST COUNTERZONE
4940             # THEN IT MAKES AVAILABLE THE FOLLOWING VARIABLES REGARDING NODES:
4941             # $node[$countop][node_number][$volume] # REGARDING INTERNAL NODES
4942             # $node[$countop][node_number][$azimut] # REGARDING BOUNDARY NODES
4943             # THEN IT MAKE AVAILABLE THE FOLLOWING VARIABLES REGARDING COMPONENTS:
4944             # $node[$countop][node_number][$area] # REGARDING SIMPLE OPENINGS
4945             # $node[$countop][node_number][$width] # REGARDING CRACKS
4946             # $node[$countop][node_number][$length] # REGARDING CRACKS
4947             # $node[$countop][node_number][$door_width] # REGARDING DOORS
4948             # $node[$countop][node_number][$door_height] # REGARDING DOORS
4949             # $node[$countop][node_number][$door_nodeheight] # REGARDING DOORS
4950             # $node[$countop][node_number][$door_discharge] # REGARDING DOORS (DISCHARGE FACTOR)
4951             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
4952             # AND THE STEPS THE MODEL HAVE TO FOLLOW.
4953             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
4954             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING VARIABLES
4955             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
4956             # $countop, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
4957             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $countop WILL CONTAIN ONE OR MORE ITERATION STEPS.
4958             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
4959             # THE OTHER ARE APPLIED TO THE SAME ZONE. THE NUMBER COUNT STARTS FROM 0.
4960             # $countstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
4961             # $countvar, WHICH TELLS THE PROGRAM WHAT NUMBER OF DESIGN PARAMETER THE PROGRAM IS WORKING AT.
4962             # The $countop that is actuated is always the last, the one which is active.
4963             # It would have therefore no sense writing $node[0][3][$node] = $node[1][3][$node].
4964             # Differentent $countops can be referred to the same zone. Different $countops just number mutations in series.
4965              
4966 0 0         if (-e $constrain) { eval ($constrain); } # HERE THE INSTRUCTION WRITTEN IN THE OPT CONFIGURATION FILE CAN BE SPEFICIED
  0            
4967             # FOR PROPAGATION OF CONSTRAINTS
4968              
4969 0           @donode = @{$node[$#node]}; #
  0            
4970 0           @docomponent = @{$component[$#component]}; #
  0            
4971              
4972 0           shift (@donode);
4973 0           shift (@docomponent);
4974             }
4975             } # END SUB read_net_constraints
4976             ##############################################################################
4977             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING MASS-FLOW NETWORKS
4978              
4979              
4980              
4981             ##############################################################################
4982             # BEGINNING OF SECTION DEDICATED TO GENERIC FUNCTIONS FOR PROPAGATING CONSTRAINTS
4983             sub propagate_constraints
4984             {
4985             # THIS FUNCTION ALLOWS TO MANIPULATE COMPOUND USER-IMPOSED CONSTRAINTS.
4986             # IT COMPOUNDS ALL FOUR PRINCIPAL PROPAGATION TYPES. THAT MEANS THAT ONE COULD DO
4987             # ANY TYPE OF THE AVAILABLE PROPAGATIONS JUST USING THIS FUNCTION.
4988             # IT MAKES AVAILABLE TO THE USER THE FOLLOWING VARIABLES FOR MANIPULATION.
4989              
4990             # REGARDING GEOMETRY:
4991             # $v[$countop][$number][$x], $v[$countop][$number][$y], $v[$countop][$number][$z]. EXAMPLE: $v[0][4][$x] = 1.
4992             # OR: @v[0][4][$x] = @v[0][4][$y]. OR EVEN: @v[1][4][$x] = @v[0][3][$z].
4993              
4994             # REGARDING OBSTRUCTIONS:
4995             # $obs[$countop][$obs_number][$x], $obs[$countop][$obs_number][$y], $obs[$countop][$obs_number][$y]
4996             # $obs[$countop][$obs_number][$width], $obs[$countop][$obs_number][$depth], $obs[$countop][$obs_number][$height]
4997             # $obs[$countop][$obs_number][$z_rotation], $obs[$countop][$obs_number][$y_rotation],
4998             # $obs[$countop][$obs_number][$tilt], $obs[$countop][$obs_number][$opacity], $obs[$countop][$obs_number][$material],
4999             # EXAMPLE: $obs[0][2][$x] = 2. THIS MEANS: AT COUNTERZONE 0, COORDINATE x OF OBSTRUCTION HAS TO BE SET TO 2.
5000             # OTHER EXAMPLE: $obs[0][2][$x] = $obs[2][2][$y].
5001             # NOTE THAT THE MATERIAL TO BE SPECIFIED IS A MATERIAL LETTER, BETWEEN QUOTES! EXAMPLE: $obs[1][$material] = "a".
5002             # $tilt IS PRESENTLY UNUSED.
5003              
5004             # REGARDING MASS-FLOW NETWORKS:
5005             # @node and @component.
5006             # CURRENTLY: INTERNAL UNKNOWN AIR NODES AND BOUNDARY WIND-CONCERNED NODES.
5007             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
5008             # CURRENTLY: WINDOWS, CRACKS, DOORS.
5009             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
5010             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
5011             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
5012             # 1) $loopcontrol[$countop][$countloop][$countloopcontrol][$loop_hour]
5013             # Where $countloop and $countloopcontrol has to be set to a specified number in the OPT file for constraints.
5014             # 2) $loopcontrol[$countop][$countloop][$countloopcontrol][$max_heating_power] # Same as above.
5015             # 3) $loopcontrol[$countop][$countloop][$countloopcontrol][$min_heating_power] # Same as above.
5016             # 4) $loopcontrol[$countop][$countloop][$countloopcontrol][$max_cooling_power] # Same as above.
5017             # 5) $loopcontrol[$countop][$countloop][$countloopcontrol][$min_cooling_power] # Same as above.
5018             # 6) $loopcontrol[$countop][$countloop][$countloopcontrol][heating_setpoint] # Same as above.
5019             # 7) $loopcontrol[$countop][$countloop][$countloopcontrol][cooling_setpoint] # Same as above.
5020             # 8) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_hour]
5021             # Where $countflow and $countflowcontrol has to be set to a specified number in the OPT file for constraints.
5022             # 9) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_setpoint] # Same as above.
5023             # 10) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_onoff] # Same as above.
5024             # 11) $flowcontrol[$countop][$countflow][$countflowcontrol][$flow_fraction] # Same as above.
5025             # EXAMPLE : $flowcontrol[0][1][2][$flow_fraction] = 0.7
5026             # OTHER EXAMPLE: $flowcontrol[2][1][2][$flow_fraction] = $flowcontrol[0][2][1][$flow_fraction]
5027              
5028             # REGARDING CONTROLS:
5029             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
5030             # CURRENTLY: WINDOWS, CRACKS, DOORS.
5031             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
5032             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
5033             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
5034             # $node[$countop][node_number][$node]. # EXAMPLE: $node[0][3][$node]. THIS IS THE LETTER OF THE THIRD NODE,
5035             # AT THE FIRST CONTERZONE (NUMBERING STARTS FROM 0)
5036             # $node[$countop][node_number][$type]
5037             # $node[$countop][node_number][$height]. # EXAMPLE: $node[0][3][$node]. THIS IS THE HEIGHT OF THE 3RD NODE AT THE FIRST COUNTERZONE
5038             # THEN IT MAKES AVAILABLE THE FOLLOWING VARIABLES REGARDING NODES:
5039             # $node[$countop][node_number][$volume] # REGARDING INTERNAL NODES
5040             # $node[$countop][node_number][$azimut] # REGARDING BOUNDARY NODES
5041             # THEN IT MAKE AVAILABLE THE FOLLOWING VARIABLES REGARDING COMPONENTS:
5042             # $node[$countop][node_number][$area] # REGARDING SIMPLE OPENINGS
5043             # $node[$countop][node_number][$width] # REGARDING CRACKS
5044             # $node[$countop][node_number][$length] # REGARDING CRACKS
5045             # $node[$countop][node_number][$door_width] # REGARDING DOORS
5046             # $node[$countop][node_number][$door_height] # REGARDING DOORS
5047             # $node[$countop][node_number][$door_nodeheight] # REGARDING DOORS
5048             # $node[$countop][node_number][$door_discharge] # REGARDING DOORS (DISCHARGE FACTOR)
5049              
5050             # ALSO, THIS KIND OF FILE MAKES INFORMATION AVAILABLE ABOUT
5051             # THE MORPHING STEP OF THE MODELS AND THE STEPS THE MODEL HAVE TO FOLLOW.
5052             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
5053             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
5054             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
5055             # $countop, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
5056             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $countop WILL CONTAIN ONE OR MORE ITERATION STEPS.
5057             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
5058             # THE OTHER ARE APPLIED TO THE SAME ZONE. THE NUMBER COUNT STARTS FROM 0.
5059             # $countstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
5060             # $countvar, WHICH TELLS THE PROGRAM WHAT NUMBER OF DESIGN PARAMETER THE PROGRAM IS WORKING AT.
5061              
5062             # The $countop that is actuated is always the last, the one which is active.
5063             # Differentent $countops can be referred to the same zone. Different $countops just number mutations in series.
5064             # So referral to different time steps when needed has to be explicitly specified in the files in which the criteria
5065             # for propagation of constraints are written.
5066              
5067 0     0 0   my ( $to, $stepsvar, $countop, $countstep, $swap, $justread, $justwrite, $swap2, $countvar, $fileconfig ) = @_;
5068 0           my @applytype = @$swap;
5069 0           my $zone_letter = $applytype[$countop][3];
5070 0           my @propagate_constraints = @$swap2;
5071 0           say "Propagating constraints on multiple databases " . ($countcase + 1) . ", block " . ($countblock + 1) . ", parameter $countvar at iteration $countstep. Instance $countinstance.";
5072 0           my $zone = $applytype[$countop][3];
5073 0           my $count = 0;
5074 0           my @group = @{$propagate_constraints[$countop]};
  0            
5075 0           foreach my $elm (@group)
5076             {
5077 0 0         if ($count > 0)
5078             {
5079 0           my @items = @{$elm};
  0            
5080 0           my $what_to_do = $items[0];
5081 0           my $sourcefile = $items[1];
5082 0           my $targetfile = $items[2];
5083 0           my $configfile = $items[3];
5084 0           my $askop = $items[6];
5085 0 0         if ($what_to_do eq "read_geo")
    0          
    0          
    0          
    0          
    0          
    0          
    0          
5086             {
5087 0           $to_do = "justread";
5088 0           my @vertex_letters = @{$items[4]};
  0            
5089 0           my $long_menus = $items[5];
5090 0           my @constrain_geometry = ( [ $zone, $sourcefile, $targetfile, $configfile , \@vertex_letters, $long_menus ] );
5091 0           constrain_geometry( $to, $fileconfig, $stepsvar, $countop, $countstep,
5092             $exeonfiles, \@applytype, \@constrain_geometry, $to_do, $countvar, $fileconfig );
5093             }
5094             elsif ($what_to_do eq "read_obs")
5095             {
5096 0           $to_do = "justread";
5097 0           my @obs_letters = @{$items[4]};
  0            
5098 0           my $act_on_materials = $items[5];
5099 0           my @constrain_obstructions = ( [ $applytype[$countop][3], $sourcefile, $targetfile, $configfile , \@obs_letters, $act_on_materials ] );
5100 0           constrain_obstructions( $to, $stepsvar, $countop,
5101             $countstep, \@applytype, \@constrain_obstructions, $to_do, $countvar, $fileconfig );
5102             }
5103             elsif ($what_to_do eq "read_ctl")
5104             {
5105 0           $to_do = "justread";
5106 0           my @constrain_controls = ( [ $zone, $sourcefile, $targetfile, $configfile ] );
5107 0           constrain_controls( $to, $stepsvar, $countop,
5108             $countstep, \@applytype, \@constrain_controls, $to_do, $countvar, $fileconfig );
5109             }
5110             elsif ($what_to_do eq "read_net")
5111             {
5112 0           $to_do = "justread";
5113 0           my @surfaces = @{$items[4]};
  0            
5114 0           my @cps = @{$items[5]};
  0            
5115 0           my @constrain_net = ( [ $zone, $sourcefile, $targetfile, $configfile , \@surfaces, \@cps ] );
5116 0           constrain_net( $to, $stepsvar, $countop,
5117             $countstep, \@applytype, \@constrain_net, $to_do, $countvar, $fileconfig );
5118             }
5119              
5120             elsif ($what_to_do eq "write_geo")
5121             {
5122 0           $to_do = "justwrite";
5123 0           my @vertex_letters = @{$items[4]};
  0            
5124 0           my $long_menus = $items[5];
5125 0           my @constrain_geometry = ( [ $zone, $sourcefile, $targetfile, $configfile , \@vertex_letters, $long_menus, $askop ] );
5126 0           constrain_geometry( $to, $stepsvar, $countop,
5127             $countstep, \@applytype, \@constrain_geometry, $to_do, $countvar, $fileconfig );
5128             }
5129             elsif ($what_to_do eq "write_obs")
5130             {
5131 0           $to_do = "justwrite";
5132 0           my @obs_letters = @{$items[4]};
  0            
5133 0           my $act_on_materials = $items[5];
5134 0           my @constrain_obstructions = ( [ $zone, $sourcefile, $targetfile, $configfile , \@obs_letters, $act_on_materials] );
5135 0           constrain_obstructions( $to, $stepsvar, $countop,
5136             $countstep, \@applytype, \@constrain_obstructions, $to_do, $countvar, $fileconfig );
5137             }
5138             elsif ($what_to_do eq "write_ctl")
5139             {
5140 0           $to_do = "justwrite";
5141 0           my @constrain_controls = ( [ $zone, $sourcefile, $targetfile, $configfile ] );
5142 0           constrain_controls( $to, $stepsvar, $countop,
5143             $countstep, \@applytype, \@constrain_controls, $to_do, $countvar, $fileconfig );
5144             }
5145             elsif ($what_to_do eq "write_net")
5146             {
5147 0           $to_do = "justwrite";
5148 0           my @surfaces = @{$items[4]};
  0            
5149 0           my @cps = @{$items[5]};
  0            
5150 0           my @constrain_net = ( [ $zone, $sourcefile, $targetfile, $configfile , \@surfaces, \@cps ] );
5151 0           constrain_net( $to, $stepsvar, $countop,
5152             $countstep, \@applytype, \@constrain_net, $to_do, $countvar, $fileconfig );
5153             }
5154             }
5155 0           $count++;
5156             }
5157             }
5158             ###########################################################################
5159             # END OF SECTION DEDICATED TO GENERIC FUNCTIONS FOR PROPAGATING CONSTRAINTS
5160              
5161             1;