File Coverage

blib/lib/Sim/OPTS.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package Sim::OPTS;
2             # Copyright (C) 2008-2014 by Gian Luca Brunetti and Politecnico di Milano.
3             # This is OPTS, 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
5             # as published by the Free Software Foundation, version 2.
6              
7 1     1   19479 use v5.14; # use v5.20;
  1         3  
  1         44  
8 1     1   7 use Exporter;
  1         1  
  1         68  
9 1     1   15 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
  1         6  
  1         78  
10 1     1   1193 use Math::Trig;
  1         17463  
  1         143  
11 1     1   12 use List::Util qw[ min max reduce shuffle];
  1         3  
  1         122  
12 1     1   603 use List::MoreUtils;
  1         1074  
  1         46  
13 1     1   221 use List::AllUtils qw(sum);
  0            
  0            
14             use Statistics::Basic qw(:all);
15             use Set::Intersection;
16             use List::Compare;
17             use Data::Dumper;
18             $Data::Dumper::Indent = 0;
19             $Data::Dumper::Useqq = 1;
20             $Data::Dumper::Terse = 1;
21              
22             #use feature qw(postderef); # no warnings qw(experimental::postderef);
23             use feature 'say';
24             no strict;
25             no warnings;
26              
27             @ISA = qw(Exporter); # our @adamkISA = qw(Exporter);
28             %EXPORT_TAGS = ( DEFAULT => [qw( &opts &prepare )]); # our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
29             @EXPORT_OK = qw(); # our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
30             @EXPORT = qw( opts prepare ); # our @EXPORT = qw( );
31             $VERSION = '0.36.16.11'; # our $VERSION = '';
32             $ABSTRACT = 'Sim::OPTS it a tool for detailed metadesign. It manages parametric explorations through the ESP-r building performance simulation platform and performs optimization by block coordinate descent.';
33              
34             #################################################################################
35             #################################################################################
36             # BEGINNING OF OPTS
37            
38             sub opts
39             {
40             my ( $filenew, $winnerline, $loserline, $configfile, $morphfile, $simlistfile, $sortmerged, @totvarnumbers, @uplift, @downlift, $fileuplift, $filedownlift, @varnumbers, @newvarnumbers, @newblockelts, $countvar, @seedfiles );
41             sub start
42             {
43             ###########################################
44             print "THIS IS OPTS.
45             Copyright by Gian Luca Brunetti and Politecnico di Milano, 2008-14.
46             DAStU Department, Polytechnic of Milan
47              
48             -------------------
49              
50             To use OPTS, an OPTS configuration file and a target ESP-r model should have been prepared.
51             Please insert the name of a configuration file (Unix path):\n";
52             ###########################################
53             $configfile = ;
54             chomp $configfile;
55             if (-e $configfile ) { ; }
56             else { &start; }
57             }
58             &start;
59              
60             # eval `cat $configfile`; # The file where the program data are
61             require $configfile; # The file where the program data are ZZZ# PROBLEM HERE, MISSING
62             if (-e $casegroupfile) { require $casegroupfile; }
63              
64             # use Sim::OPTS::morph; # use Sim::OPTS::sim; # HERE THE FUNCTIONS "sim" and "retrieve" are. # use Sim::OPTS::report; # use Sim::OPTS::format;
65              
66             ###########################################################################################
67             # BEGINNING OF THE OPTS PROGRAM.
68              
69             print "OPTS - IS - RUNNING.
70             -------------------\n";
71             if ($outfile) { open ( OUTFILE, ">$outfile" ) or die "Can't open $outfile: $!"; }
72             if ($toshell) { open ( TOSHELL, ">$toshell" ) or die "Can't open $toshell: $!"; }
73             if ($reportfile) { open ( REPORTFILE, ">./$reportfile" ) or die "Can't open $reportfile: $!" };
74             if ($outfilewrite) { open ( OUTFILEWRITE, ">./$outfilewrite" ) or die "Can't open $outfilewrite: $!" };
75             unless (-e "$mypath/models") { `mkdir $mypath/models`; }
76             unless (-e "$mypath/models") { print TOSHELL "mkdir $mypath/models\n\n"; }
77            
78             if (-e "./SIM/OPTS/prepare.pm")
79             {
80             eval `cat ./SIM/OPTS/prepare.pm`;
81             }
82              
83             #################################################################################
84             #################################################################################
85             sub exec
86             {
87             my $swap = shift;
88             my @varnumbers = @$swap;
89             my $countblock = shift;
90             my $countcase = shift;
91             my $swap = shift;
92             my @newvarnumbers = @$swap;
93             my $swap = shift;
94             my @uplift = @$swap;
95             my $swap = shift;
96             my @downlift = @$swap;
97             my $swap = shift;
98             my @blocks = @$swap;
99             my $swap = shift;
100             my @blockelts = @$swap;
101             my $swap = shift;
102             my @newblockelts = @$swap;
103             my $swap = shift;
104             my @overlap = @$swap;
105            
106             $morphfile = "$mypath/$file-morphfile-$countcase-$countblock";
107             $simlistfile = "$mypath/$file-simlist-$countcase-$countblock";
108            
109             open (MORPHFILE, ">$morphfile") or die;
110            
111             @totvarnumbers = (@totvarnumbers, @varnumbers);
112             @totvarnumbers = uniq(@totvarnumbers);
113             @totvarnumbers = sort(@totvarnumbers);
114              
115             sub morph
116             {
117             my $to = shift;
118             my $mypath = shift;
119             my $file = shift;
120             my $filenew = shift;
121             my $swap = shift;
122             my @dowhat = @$swap;
123             my $swap = shift;
124             my @simdata = @$swap;
125             my $simnetwork = shift;
126             my $swap = shift;
127             my @simtitles = @$swap;
128             my $preventsim = shift;
129             my $exeonfiles = shift;
130             my $fileconfig = shift;
131             my $swap = shift;
132             my @themereports = @$swap;
133             my $swap = shift;
134             my @reporttitles = @$swap;
135             my $swap = shift;
136             my @retrievedata = @$swap;
137             my $swap = shift;
138             my @varnumbers = @$swap;
139             my $countblock = shift;
140             my $countcase = shift;
141            
142             say OUTFILE "\nHERE 2 ";
143             $countvar = 0;
144             foreach $varnumber (@varnumbers)
145             {
146             my @casemorphed;
147             say OUTFILE "\nHERE 3 ";
148            
149             if ( $countvar == $#varnumbers )
150             {
151             $$general_variables[0] = "n";
152             } # THIS TELLS THAT IF THE SEARCH IS ENDING (LAST SUBSEARCH CYCLE) GENERATION OF CASES HAS TO BE TURNED OFF
153            
154             $stepsvar = ${ "stepsvar" . "$varnumber" };
155             @applytype = @{ "applytype" . "$varnumber" };
156             @generic_change = @{ "generic_change" . "$varnumber" };
157             $rotate = ${ "rotate" . "$varnumber" };
158             $rotatez = ${ "rotatez" . "$varnumber" };
159             $general_variables = ${ "general_variables" . "$varnumber" };
160             $translate = ${ "translate" . "$varnumber" };
161             $translate_surface_simple = ${ "translate_surface_simple" . "$varnumber" };
162             $translate_surface = ${ "translate_surface" . "$varnumber" };
163             $keep_obstructions = ${ "keep_obstructions" . "$varnumber" };
164             $shift_vertexes = ${ "shift_vertexes" . "$varnumber" };
165             $construction_reassignment = ${ "construction_reassignment" . "$varnumber" };
166             $thickness_change = ${ "thickness_change" . "$varnumber" };
167             $recalculateish = ${ "recalculateish" . "$varnumber" };
168             @recalculatenet = @{ "recalculatenet" . "$varnumber" };
169             $obs_modify = ${ "obs_modify" . "$varnumber" };
170             $netcomponentchange = ${ "netcomponentchang" . "$varnumber" };
171             $changecontrol = ${ "changecontrol" . "$varnumber" };
172             @apply_constraints = @{ "apply_constraints" . "$varnumber" }; # NOW SUPERSEDED BY @constrain_geometry
173             $rotate_surface = ${ "rotate_surface" . "$varnumber" };
174             @reshape_windows = @{ "reshape_windows" . "$varnumber" };
175             @apply_netconstraints = @{ "apply_netconstraints" . "$varnumber" };
176             @apply_windowconstraints = @{ "apply_windowconstraints" . "$varnumber" };
177             @translate_vertexes = @{ "translate_vertexes" . "$varnumber" };
178             $warp = ${ "warp" . "$varnumber" };
179             @daylightcalc = @{ "daylightcalc" . "$varnumber" };
180             @change_config = @{ "change_config" . "$varnumber" };
181             @constrain_geometry = @{ "constrain_geometry" . "$varnumber" };
182             @vary_controls = @{ "vary_controls" . "$varnumber" };
183             @constrain_controls = @{ "constrain_controls" . "$varnumber" };
184             @constrain_geometry = @{ "constrain_geometry" . "$varnumber" };
185             @constrain_obstructions = @{ "constrain_obstructions" . "$varnumber" };
186             @get_obstructions = @{ "get_obstructions" . "$varnumber" };
187             @pin_obstructions = @{ "pin_obstructions" . "$varnumber" };
188             $checkfile = ${ "checkfile" . "$varnumber" };
189             @vary_net = @{ "vary_net" . "$varnumber" };
190             @constrain_net = @{ "constrain_net" . "$varnumber" };
191             @propagate_constraints = @{ "propagate_constraints" . "$varnumber" };
192             @change_climate = @{ "change_climate" . "$varnumber" };
193             $skip = ${ "skip" . "$varnumber" };
194             $constrain = ${ "constrain" . "$varnumber" };
195             my @cases_to_sim;
196             my @files_to_convert;
197             my (@v, @obs, @node, @component, @loopcontrol, @flowcontrol); # THINGS GLOBAL AS REGARDS COUNTER ZONE CYCLES
198             my (@myv, @myobs, @mynode, @mycomponent, @myloopcontrol, @myflowcontrol); # THINGS LOCAL AS REGARDS COUNTER ZONE CYCLES
199             my (@tempv, @tempobs, @tempnode, @tempcomponent, @temploopcontrol, @tempflowcontrol); # THINGS LOCAL AS REGARDS COUNTER ZONE CYCLES
200             my (@dov, @doobs, @donode, @docomponent, @doloopcontrol, @doflowcontrol); # THINGS LOCAL AS REGARDS COUNTER ZONE CYCLES
201            
202             my $generate = $$general_variables[0];
203             my $sequencer = $$general_variables[1];
204             my $dffile = "df-$file.txt";
205             if ( eval $skip) { $skipask = "yes"; }
206            
207             if ( ( $countvar == 0 ) and ( $countblock == 1 ) and ( $countcase == 0 ) )
208             {
209             if ($exeonfiles eq "y") { `cp -r $mypath/$file $filenew`; }
210             print TOSHELL "cp -r $mypath/$file $filenew\n\n";
211             }
212              
213             @cases_to_sim = grep -d, <$mypath/models/$file*_>;
214              
215             foreach $case_to_sim (@cases_to_sim)
216             {
217             say OUTFILE "\nHERE 4 ";
218            
219             $counterstep = 1;
220            
221             while ( $counterstep <= $stepsvar )
222             {
223             my $from = "$case_to_sim";
224             my $almost_to = $from;
225             $almost_to =~ s/$varnumber-\d+/$varnumber-$counterstep/ ;
226            
227             if ( ( $generate eq "n" )
228             and ( ( $sequencer eq "y" ) or ( $sequencer eq "last" ) ) )
229             {
230             if ( $almost_to =~ m/§$/ ) { $to = "$almost_to" ; }
231             else
232             {
233             #$to = "$case_to_sim$varnumber-$counterstep§";
234             $to = "$almost_to" . "§";
235             }
236             }
237             elsif ( ( $generate eq "y" ) and ( $sequencer eq "n" ) )
238             {
239             if ( $almost_to =~ m/_$/ ) { $to = "$almost_to" ; }
240             else
241             {
242             #$to = "$case_to_sim$varnumber-$counterstep" . "_";
243             $to = "$almost_to" . "_";
244             #if ( $counterstep == $stepsvar )
245             #{
246             # if ($exeonfiles eq "y") { print `chmod -R 777 $from\n`; }
247             # print TOSHELL "chmod -R 777 $from\n\n";
248             #}
249             }
250             }
251             elsif ( ( $generate eq "y" ) and ( $sequencer eq "y" ) )
252             {
253             #$to = "$case_to_sim$varnumber-$counterstep" . "£";
254             $to = "$almost_to" . "£";
255             }
256             elsif ( ( $generate eq "y" ) and ( $sequencer eq "last" ) )
257             {
258             if ( $almost_to =~ m/£$/ ) { $to = "$almost_to" ; }
259             else
260             {
261             #$to = "$case_to_sim$varnumber-$counterstep" . "£";
262             $to = "$almost_to" . "£";
263             #if ( $counterstep == $stepsvar )
264             #{
265             # if ($exeonfiles eq "y") { print `chmod -R 777 $from\n`; }
266             # print TOSHELL "chmod -R 777 $from\n\n";
267             #}
268             }
269             }
270             elsif ( ( $generate eq "n" ) and ( $sequencer eq "n" ) )
271             {
272             $almost_to =~ s/[_|£]$// ;
273             #$to = "$case_to_sim$varnumber-$counterstep";
274             $to = "$almost_to";
275             }
276            
277             if ( ($countvar == $#varnumbers) and ( ($skip ne "") and ($skipask ne "yes") ) )
278             {
279             $to =~ s/_$//;
280             print MORPHFILE "$to\n";
281             }
282            
283             # say OUTFILE "\nHERE AFTER ";
284            
285             { # BLOCK
286             if ( ( $generate eq "y" )
287             and ( $counterstep == $stepsvar )
288             and ( ( $sequencer eq "n" ) or ( $sequencer eq "last" ) )
289             and ( ($skip ne "") and ($skipask ne "yes") )
290             )
291             {
292             unless (-e $to)
293             {
294             if ($exeonfiles eq "y") { `cp -R $from $to\n`; }
295             print TOSHELL "cp -R $from $to\n\n";
296             #if ($exeonfiles eq "y") { print `chmod -R 777 $to\n`; }
297             #print TOSHELL "chmod -R 777 $to\n\n";
298             }
299             }
300             else
301             {
302             unless (-e $to)
303             {
304            
305             if ($exeonfiles eq "y") { `cp -R $from $to\n`; }
306             print TOSHELL "cp -R $from $to\n\n";
307             #if ($exeonfiles eq "y") { print `chmod -R 777 $to\n`; }
308             #print TOSHELL "chmod -R 777 $to\n\n";
309             }
310             }
311             }
312            
313             push(@morphed, $to);
314            
315             $counterzone = 0;
316            
317             foreach my $zone (@applytype)
318             {
319             my $modification_type = $applytype[$counterzone][0];
320             if ( ( $applytype[$counterzone][1] ne $applytype[$counterzone][2] )
321             and ( $modification_type ne "changeconfig" ) )
322             {
323             if ($exeonfiles eq "y")
324             {
325             `cp -f $to/zones/$applytype[$counterzone][1] $to/zones/$applytype[$counterzone][2]\n`;
326             }
327             print TOSHELL
328             "cp -f $to/zones/$applytype[$counterzone][1] $to/zones/$applytype[$counterzone][2]\n\n";
329             if ($exeonfiles eq "y")
330             {
331             `cp -f $to/cfg/$applytype[$counterzone][1] $to/cfg/$applytype[$counterzone][2]\n`;
332             } # ORDINARILY, YOU MAY REMOVE THIS PART
333             print TOSHELL
334             "cp -f $to/cfg/$applytype[$counterzone][1] $to/cfg/$applytype[$counterzone][2]\n\n";
335             # ORDINARILY, YOU MAY REMOVE THIS PART
336             }
337             if (
338             (
339             $applytype[$counterzone][1] ne $applytype[$counterzone][2]
340             )
341             and ( $modification_type eq "changeconfig" )
342             )
343             {
344             if ($exeonfiles eq "y")
345             {
346             `cp -f $to/cfg/$applytype[$counterzone][1] $to/cfg/$applytype[$counterzone][2]\n`;
347             }
348             print TOSHELL
349             "cp -f $to/cfg/$applytype[$counterzone][1] $to/cfg/$applytype[$counterzone][2]\n\n";
350             # ORDINARILY, REMOVE THIS LINE
351             }
352             print CASELIST "$to\n";
353            
354            
355             #########################################################################################
356             #########################################################################################
357             #########################################################################################
358              
359             # HERE FOLLOWS THE CONTENT OF THE FILE "morph.pm", which has been merged here
360             # TO AVOID COMPLICATIONS WITH THE PERL MODULE INSTALLATION.
361              
362             ##############################################################################
363             sub translate
364             {
365             my $to = shift;
366             my $fileconfig = shift;
367             my $stepsvar = shift;
368             my $counterzone = shift;
369             my $counterstep = shift;
370             my $exeonfiles = shift;
371             my $swap = shift;
372             my @applytype = @$swap;
373             my $zone_letter = $applytype[$counterzone][3];
374             my $translate = shift;
375              
376             if ( $stepsvar > 1 )
377             {
378             my $yes_or_no_translation = "$$translate[$counterzone][0]";
379             my $yes_or_no_translate_obstructions = "$$translate[$counterzone][1]";
380             my $yes_or_no_update_radiation = $$translate[$counterzone][3];
381             my $configfile = $$translate[$counterzone][4];
382             if ( $yes_or_no_update_radiation eq "y" )
383             {
384             $yes_or_no_update_radiation = "a";
385             } elsif ( $yes_or_no_update_radiation eq "n" )
386             {
387             $yes_or_no_update_radiation = "c";
388             }
389             if ( $yes_or_no_translation eq "y" )
390             {
391             my @coordinates_for_movement = @{ $$translate[$counterzone][2] };
392             my $x_end = $coordinates_for_movement[0];
393             my $y_end = $coordinates_for_movement[1];
394             my $z_end = $coordinates_for_movement[2];
395             my $x_swingtranslate = ( 2 * $x_end );
396             my $y_swingtranslate = ( 2 * $y_end );
397             my $z_swingtranslate = ( 2 * $z_end );
398             my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
399             my $x_movement = (- ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) ));
400             my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
401             my $y_movement = (- ( $y_end - ( $y_pace * ( $counterstep - 1 ) ) ));
402             my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
403             my $z_movement = (- ( $z_end - ( $z_pace * ( $counterstep - 1 ) ) ));
404              
405             my $printthis =
406             "prj -file $to/cfg/$fileconfig -mode script<
407              
408             m
409             c
410             a
411             $zone_letter
412             i
413             e
414             $x_movement $y_movement $z_movement
415             y
416             $yes_or_no_translate_obstructions
417             -
418             y
419             c
420             -
421             -
422             -
423             -
424             -
425             -
426             -
427             -
428             -
429             YYY
430             ";
431              
432             if ($exeonfiles eq "y")
433             {
434             print `$printthis`;
435             }
436             print TOSHELL $printthis;
437             }
438             }
439             } # end sub translate
440              
441              
442             my $countercycles_transl_surfs = 0;
443             #############################################################################
444              
445              
446             #############################################################################
447             sub translate_surfaces_simple # THIS IS VERSION 1, THE OLD ONE. DISMISSED? IN DOUBT, DO NOT USE IT.
448             {
449             my $to = shift;
450             my $fileconfig = shift;
451             my $stepsvar = shift;
452             my $counterzone = shift;
453             my $counterstep = shift;
454             my $exeonfiles = shift;
455             my $swap = shift;
456             my @applytype = @$swap;
457             my $zone_letter = $applytype[$counterzone][3];
458             my $translate_surface_simple = shift;
459              
460              
461             my $yes_or_no_transl_surfs =
462             $$translate_surface_simple[$counterzone][0];
463             my @surfs_to_transl =
464             @{ $translate_surface_simple->[$counterzone][1] };
465             my @ends_movs =
466             @{ $translate_surface_simple->[$counterzone][2]
467             }; # end points of the movements.
468             my $yes_or_no_update_radiation =
469             $$translate_surface_simple[$counterzone][3];
470             my $firstedge_constrainedarea = $$translate_surface_simple[$counterzone][4][0];
471             my $secondedge_constrainedarea = $$translate_surface_simple[$counterzone][4][1];
472             my $constrainedarea = ($firstedge_constrainedarea * $secondedge_constrainedarea);
473             my @swings_surfs = map { $_ * 2 } @ends_movs;
474             my @surfs_to_transl_constrainedarea =
475             @{ $translate_surface_simple->[$counterzone][5] };
476             my $countersurface = 0;
477             my $end_mov;
478             my $mov_surf;
479             my $pace;
480             my $movement;
481             my $surface_letter_constrainedarea;
482             my $movement_constrainedarea;
483              
484             if ( $yes_or_no_transl_surfs eq "y" )
485             {
486             foreach my $surface_letter (@surfs_to_transl)
487             {
488             if ( $stepsvar > 1 )
489             {
490             $end_mov = $ends_movs[$countersurface];
491             $swing_surf = $end_mov * 2;
492             $pace = ( $swing_surf / ( $stepsvar - 1 ) );
493             $movement =
494             ( - ( ($end_mov) -
495             ( $pace * ( $counterstep - 1 ) ) ) );
496             $surface_letter_constrainedarea = $surfs_to_transl_constrainedarea[$countersurface];
497             $movement_constrainedarea =
498             ( ( ( $constrainedarea / ( $firstedge_constrainedarea + ( 2 * $movement ) ) ) - $secondedge_constrainedarea) /2);
499              
500             my $printthis =
501             "prj -file $to/cfg/$fileconfig -mode script<
502              
503             m
504             c
505             a
506             $zone_letter
507             e
508             >
509             $surface_letter
510             a
511             $movement
512             y
513             -
514             -
515             y
516             c
517             -
518             -
519             -
520             -
521             -
522             -
523             -
524             -
525             YYY\n\n";
526             if ($exeonfiles eq "y")
527             {
528             print `$printthis`;
529             }
530             print TOSHELL $printthis;
531              
532             my $printthis =
533             "prj -file $to/cfg/$fileconfig -mode script<
534              
535             m
536             c
537             a
538             $zone_letter
539             e
540             >
541             $surface_letter_constrainedarea
542             a
543             $movement_constrainedarea
544             y
545             -
546             -
547             y
548             c
549             -
550             -
551             -
552             -
553             -
554             -
555             -
556             -
557             -
558             YYY
559             ";
560             if ($exeonfiles eq "y")
561             {
562             print `$printthis`;
563             }
564             print TOSHELL $printthis;
565              
566             $countersurface++;
567             $countercycles_transl_surfs++;
568             }
569             }
570             }
571             } # end sub translate_surfaces_simple
572             ######################################################################
573              
574              
575             ######################################################################
576             sub translate_surfaces
577             {
578             my $to = shift;
579             my $fileconfig = shift;
580             my $stepsvar = shift;
581             my $counterzone = shift;
582             my $counterstep = shift;
583             my $exeonfiles = shift;
584             my $swap = shift;
585             my @applytype = @$swap;
586             my $zone_letter = $applytype[$counterzone][3];
587             my $translate_surface = shift;
588              
589             my $yes_or_no_transl_surfs = $$translate_surface[$counterzone][0];
590             my $transform_type = $$translate_surface[$counterzone][1];
591             my @surfs_to_transl = @{ $translate_surface->[$counterzone][2] };
592             my @ends_movs = @{ $translate_surface->[$counterzone][3] }; # end points of the movements.
593             my $yes_or_no_update_radiation = $$translate_surface[$counterzone][4];
594             my @transform_coordinates = @{ $translate_surface->[$counterzone][5] };
595             my $countersurface = 0;
596             my $end_mov;
597             my $mov_surf;
598             my $pace;
599             my $movement;
600             my $surface_letter_constrainedarea;
601             my $movement_constrainedarea;
602              
603             if ( $yes_or_no_transl_surfs eq "y" )
604             {
605             foreach my $surface_letter (@surfs_to_transl)
606             {
607             if ( $stepsvar > 1 )
608             {
609             if ($transform_type eq "a")
610             {
611             $end_mov = $ends_movs[$countersurface];
612             $swing_surf = $end_mov * 2;
613             $pace = ( $swing_surf / ( $stepsvar - 1 ) );
614             $movement = ( - ( ($end_mov) -( $pace * ( $counterstep - 1 ) ) ) );
615            
616             my $printthis =
617             "prj -file $to/cfg/$fileconfig -mode script<
618              
619             m
620             c
621             a
622             $zone_letter
623             e
624             >
625             $surface_letter
626             $transform_type
627             $movement
628             y
629             -
630             -
631             y
632             c
633             -
634             -
635             -
636             -
637             -
638             -
639             -
640             -
641             YYY
642             ";
643              
644             if ($exeonfiles eq "y") {
645             print `$printthis`;
646             }
647             print TOSHELL $printthis;
648              
649             $countersurface++;
650             $countercycles_transl_surfs++;
651             }
652             elsif ($transform_type eq "b")
653             {
654             my @coordinates_for_movement =
655             @{ $transform_coordinates[$countersurface] };
656             my $x_end = $coordinates_for_movement[0];
657             my $y_end = $coordinates_for_movement[1];
658             my $z_end = $coordinates_for_movement[2];
659             my $x_swingtranslate = ( 2 * $x_end );
660             my $y_swingtranslate = ( 2 * $y_end );
661             my $z_swingtranslate = ( 2 * $z_end );
662             my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
663             my $x_movement = (- ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) ));
664             my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
665             my $y_movement = (- ( $y_end - ( $y_pace * ( $counterstep - 1 ) ) ));
666             my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
667             my $z_movement = (- ( $z_end - ( $z_pace * ( $counterstep - 1 ) ) ));
668              
669             my $printthis =
670             "prj -file $to/cfg/$fileconfig -mode script<
671              
672             m
673             c
674             a
675             $zone_letter
676             e
677             >
678             $surface_letter
679             $transform_type
680             $x_movement $y_movement $z_movement
681             y
682             -
683             -
684             y
685             c
686             -
687             -
688             -
689             -
690             -
691             -
692             -
693             -
694             YYY
695             ";
696              
697             if ($exeonfiles eq "y")
698             {
699             print `$printthis`;
700             }
701              
702             print TOSHELL $printthis;
703              
704             $countersurface++;
705             $countercycles_transl_surfs++;
706             }
707             }
708             }
709             }
710             } # END SUB translate_surfaces
711             ##############################################################################
712              
713              
714             ##############################################################################
715             sub rotate_surface
716             {
717             my $to = shift;
718             my $fileconfig = shift;
719             my $stepsvar = shift;
720             my $counterzone = shift;
721             my $counterstep = shift;
722             my $exeonfiles = shift;
723             my $swap = shift;
724             my @applytype = @$swap;
725             my $zone_letter = $applytype[$counterzone][3];
726             my $rotate_surface = shift;
727              
728             my $yes_or_no_rotate_surfs = $$rotate_surface[$counterzone][0];
729             my @surfs_to_rotate = @{ $rotate_surface->[$counterzone][1] };
730             my @vertexes_numbers = @{ $rotate_surface->[$counterzone][2] };
731             my @swingrotations = @{ $rotate_surface->[$counterzone][3] };
732             my @yes_or_no_apply_to_others = @{ $rotate_surface->[$counterzone][4] };
733             my $configfile = $$rotate_surface[$counterzone][5];
734              
735             if ( $yes_or_no_rotate_surfs eq "y" )
736             {
737             my $counterrotate = 0;
738             foreach my $surface_letter (@surfs_to_rotate)
739             {
740             $swingrotate = $swingrotations[$counterrotate];
741             $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
742             $rotation_degrees =
743             ( ( $swingrotate / 2 ) - ( $pacerotate * ( $counterstep - 1 ) )) ;
744             $vertex_number = $vertexes_numbers[$counterrotate];
745             $yes_or_no_apply = $yes_or_no_apply_to_others[$counterrotate];
746             if ( ( $swingrotate != 0 ) and ( $stepsvar > 1 ) and ( $yes_or_no_rotate_surfs eq "y" ) )
747             {
748             my $printthis =
749             "prj -file $to/cfg/$fileconfig -mode script<
750              
751             m
752             c
753             a
754             $zone_letter
755             e
756             >
757             $surface_letter
758             c
759             $vertex_number
760             $rotation_degrees
761             $yes_or_no_apply
762             -
763             -
764             y
765             c
766             -
767             -
768             -
769             -
770             -
771             -
772             -
773             -
774             YYY
775             ";
776             if ($exeonfiles eq "y")
777             {
778             print `$printthis`;
779             }
780              
781             print TOSHELL $printthis;
782             }
783             $counterrotate++;
784             }
785             }
786             } # END SUB rotate_surface
787             ##############################################################################
788              
789              
790              
791             ##############################################################################
792             sub translate_vertexes #STILL UNFINISHED, NOT WORKING. PROBABLY ALMOST FINISHED. The reference to @base_coordinates is not working.
793             {
794             my $to = shift;
795             my $fileconfig = shift;
796             my $stepsvar = shift;
797             my $counterzone = shift;
798             my $counterstep = shift;
799             my $exeonfiles = shift;
800             my $swap = shift;
801             my @applytype = @$swap;
802             my $zone_letter = $applytype[$counterzone][3];
803             my $swap2 = shift;
804             my @translate_vertexes = @$swap2;
805              
806              
807              
808              
809              
810             my @v;
811             my @verts_to_transl = @{ $translate_vertexes[$counterzone][0] };
812             my @transform_coordinates = @{ $translate_vertexes[$counterzone][1] };
813             my @sourcefiles = @{ $translate_vertexes[$counterzone][2] };
814             my @targetfiles = @{ $translate_vertexes[$counterzone][3] };
815             my @configfiles = @{ $translate_vertexes[$counterzone][4] };
816             my @longmenus = @{ $translate_vertexes[$counterzone][5] };
817             $counteroperations = 0;
818             foreach my $sourcefile ( @sourcefiles)
819             {
820             my $targetfile = $targetfiles[ $counteroperations ];
821             my $configfile = $configfiles[ $counteroperations ];
822             my $longmenu = $longmenus[ $counteroperations ];
823             my $sourceaddress = "$mypath/$file$sourcefile";
824             my $targetaddress = "$mypath/$file$targetfile";
825             my $configaddress = "$to/opts/$configfile";
826             checkfile($sourceaddress, $targetaddress);
827              
828             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
829             my @lines = ;
830             close SOURCEFILE;
831            
832             my $counterlines = 0;
833             my $countervert = 0;
834              
835             my @vertex_letters;
836             if ($longmenu eq "y")
837             {
838             @vertex_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
839             "n", "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv",
840             "0\nb\nw", "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd",
841             "0\nb\ne","0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni",
842             "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",
843             "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",
844             "0\nb\n0\nb\nt");
845             }
846             else
847             {
848             @vertex_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
849             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
850             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
851             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
852             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
853             }
854              
855             foreach my $line (@lines)
856             {
857             $line =~ s/^\s+//;
858             my @rowelements = split(/\s+|,/, $line);
859             if ($rowelements[0] eq "*vertex" )
860             {
861             if ($countervert == 0)
862             {
863             push (@v, [ "vertexes of $sourceaddress" ]);
864             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ], $vertexletters[$countervert] );
865             }
866              
867             if ($countervert > 0)
868             {
869             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3], $vertexletters[$countervert] ] );
870             }
871             $countervert++;
872             }
873             $counterlines++;
874             }
875              
876             if (-e $configaddress)
877             {
878             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
879             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
880              
881             my $countervertex = 0;
882            
883             foreach my $vertex_letter (@vertex_letters)
884             {
885             if ($countervertex > 0)
886             {
887             if ($vertex_letter eq $v[$countervertex][3])
888             {
889             my @base_coordinates = @{ $transform_coordinates[$countervertex] };
890             my $x_end = $base_coordinates[0];
891             my $y_end = $base_coordinates[1];
892             my $z_end = $base_coordinates[2];
893             my $x_swingtranslate = ( 2 * $x_end );
894             my $y_swingtranslate = ( 2 * $y_end );
895             my $z_swingtranslate = ( 2 * $z_end );
896             my $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
897             my $x_movement = (- ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) ));
898             my $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
899             my $y_movement = (- ( $y_end - ( $y_pace * ( $counterstep - 1 ) ) ));
900             my $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
901             my $z_movement = (- ( $z_end - ( $z_pace * ( $counterstep - 1 ) ) ));
902             my $printthis =
903             "prj -file $to/cfg/$fileconfig -mode script<
904              
905             m
906             c
907             a
908             $zone_letter
909             d
910             $vertex_letter
911             $x_movement $y_movement $z_movement
912             -
913             y
914             -
915             y
916             c
917             -
918             -
919             -
920             -
921             -
922             -
923             -
924             -
925             -
926             YYY
927             ";
928             if ($exeonfiles eq "y")
929             {
930             print `$printthis`;
931             }
932              
933             print TOSHELL $printthis;
934             }
935             }
936             $countervertex++;
937             }
938             }
939             $counteroperations++;
940             }
941             } # END SUB translate_vertexes
942              
943              
944             ##############################################################################
945             sub shift_vertexes
946             {
947             my $to = shift;
948             my $fileconfig = shift;
949             my $stepsvar = shift;
950             my $counterzone = shift;
951             my $counterstep = shift;
952             my $exeonfiles = shift;
953             my $swap = shift;
954             my @applytype = @$swap;
955             my $zone_letter = $applytype[$counterzone][3];
956             my $shift_vertexes = shift;
957              
958              
959             my $pace;
960             my $movement;
961             my $yes_or_no_shift_vertexes = $$shift_vertexes[$counterzone][0];
962             my $movementtype = $$shift_vertexes[$counterzone][1];
963             my @pairs_of_vertexes = @{ $$shift_vertexes[$counterzone][2] };
964             my @shift_swings = @{ $$shift_vertexes[$counterzone][3] };
965             my $yes_or_no_radiation_update = $$shift_vertexes[$counterzone][4];
966             my $configfile = $$shift_vertexes[$counterzone][5];
967              
968             if ( $stepsvar > 1 )
969             {
970             if ( $yes_or_no_shift_vertexes eq "y" )
971             {
972              
973             my $counterthis = 0;
974             if ($movementtype eq "j")
975             {
976             foreach my $shift_swing (@shift_swings)
977             {
978             $pace = ( $shift_swing / ( $stepsvar - 1 ) );
979             $movement_or_vertex =
980             ( ( ($shift_swing) / 2 ) - ( $pace * ( $counterstep - 1 ) ) );
981             $vertex1 = $pairs_of_vertexes[ 0 + ( 2 * $counterthis ) ];
982             $vertex2 = $pairs_of_vertexes[ 1 + ( 2 * $counterthis ) ];
983            
984             my $printthis =
985             "prj -file $to/cfg/$fileconfig -mode script<
986              
987             m
988             c
989             a
990             $zone_letter
991             d
992             ^
993             $movementtype
994             $vertex1
995             $vertex2
996             -
997             $movement_or_vertex
998             y
999             -
1000             y
1001             -
1002             y
1003             -
1004             -
1005             -
1006             -
1007             -
1008             -
1009             -
1010             -
1011             YYY
1012             ";
1013             if ($exeonfiles eq "y")
1014             {
1015             print `$printthis`;
1016             }
1017             print TOSHELL $printthis;
1018              
1019             $counterthis++;
1020             }
1021             }
1022             elsif ($movementtype eq "h")
1023             {
1024             foreach my $shift_swing (@shift_swings)
1025             {
1026             my $printthis =
1027             "prj -file $to/cfg/$fileconfig -mode script<
1028              
1029             m
1030             c
1031             a
1032             $zone_letter
1033             d
1034             ^
1035             $movementtype
1036             $vertex1
1037             $vertex2
1038             -
1039             $movement_or_vertex
1040             -
1041             y
1042             n
1043             n
1044             n
1045             -
1046             y
1047             -
1048             y
1049             -
1050             -
1051             -
1052             -
1053             -
1054             -
1055             -
1056             -
1057             YYY
1058             ";
1059             if ($exeonfiles eq "y")
1060             {
1061             print `$printthis`;
1062             }
1063             print TOSHELL $printthis;
1064             }
1065             }
1066             }
1067             }
1068             } # END SUB shift_vertexes
1069              
1070              
1071             sub rotate # generic zone rotation
1072             {
1073             my $to = shift;
1074             my $fileconfig = shift;
1075             my $stepsvar = shift;
1076             my $counterzone = shift;
1077             my $counterstep = shift;
1078             my $exeonfiles = shift;
1079             my $swap = shift;
1080             my @applytype = @$swap;
1081             my $zone_letter = $applytype[$counterzone][3];
1082             my $rotate = shift;
1083              
1084              
1085             my $rotation_degrees;
1086             my $yes_or_no_rotation = "$$rotate[$counterzone][0]";
1087             my $yes_or_no_rotate_obstructions =
1088             "$$rotate[$counterzone][1]";
1089             my $swingrotate = $$rotate[$counterzone][2];
1090             my $yes_or_no_update_radiation =
1091             $$rotate[$counterzone][3];
1092             my $base_vertex = $$rotate[$counterzone][4];
1093             my $configfile = $$rotate[$counterzone][5];
1094             my $pacerotate;
1095             my $counter_rotate = 0;
1096             if ( ( $swingrotate != 0 )
1097             and ( $stepsvar > 1 )
1098             and ( $yes_or_no_rotation eq "y" ) )
1099             {
1100             $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
1101             $rotation_degrees =
1102             ( ( $swingrotate / 2 ) -
1103             ( $pacerotate * ( $counterstep - 1 ) ) );
1104              
1105             my $printthis =
1106             "prj -file $to/cfg/$fileconfig -mode script<
1107              
1108              
1109             m
1110             c
1111             a
1112             $zone_letter
1113             i
1114             b
1115             $rotation_degrees
1116             $base_vertex
1117             -
1118             $yes_or_no_rotate_obstructions
1119             -
1120             y
1121             c
1122             -
1123             y
1124             -
1125             -
1126             -
1127             -
1128             -
1129             -
1130             -
1131             -
1132             YYY
1133             ";
1134             if ($exeonfiles eq "y")
1135             {
1136             print `$printthis`;
1137             }
1138             print TOSHELL $printthis;
1139             }
1140             } # END SUB rotate
1141             ##############################################################################
1142              
1143              
1144             ##############################################################################
1145             sub rotatez # PUT THE ROTATION POINT AT POINT 0, 0, 0. I HAVE NOT YET MADE THE FUNCTION GENERIC ENOUGH.
1146             {
1147             my $to = shift;
1148             my $fileconfig = shift;
1149             my $stepsvar = shift;
1150             my $counterzone = shift;
1151             my $counterstep = shift;
1152             my $exeonfiles = shift;
1153             my $swap = shift;
1154             my @applytype = @$swap;
1155             my $zone_letter = $applytype[$counterzone][3];
1156             my $rotatez = shift;
1157              
1158              
1159             my $yes_or_no_rotation = "$$rotatez[0]";
1160             my @centerpoints = @{$$rotatez[1]};
1161             my $centerpointsx = $centerpoints[0];
1162             my $centerpointsy = $centerpoints[1];
1163             my $centerpointsz = $centerpoints[2];
1164             my $plane_of_rotation = "$$rotatez[2]";
1165             my $infile = "$to/zones/$applytype[$counterzone][2]";
1166             my $infile2 = "$to/cfg/$applytype[$counterzone][2]";
1167             my $outfile = "erase";
1168             my $outfile2 = "$to/zones/$applytype[$counterzone][2]eraseobtained";
1169             open(INFILE, "$infile") or die "Can't open infile $infile: $!\n";
1170             open(OUTFILE2, ">>$outfile2") or die "Can't open outfile2 $outfile2: $!\n";
1171             my @lines = ;
1172             close(INFILE);
1173             my $counterline = 0;
1174             my $countercases=0;
1175             my @vertexes;
1176             my $swingrotate = $$rotatez[3];
1177             my $alreadyrotation = $$rotatez[4];
1178             my $rotatexy = $$rotatez[5];
1179             my $swingrotatexy = $$rotatez[6];
1180             my $pacerotate;
1181             my $counter_rotate = 0;
1182             my $linenew;
1183             my $linenew2;
1184             my @rowprovv;
1185             my @rowprovv2;
1186             my @row;
1187             my @row2;
1188             if ( $stepsvar > 1 and ( $yes_or_no_rotation eq "y" ) )
1189             {
1190             foreach $line (@lines)
1191             {#
1192             {
1193             $linenew = $line;
1194             $linenew =~ s/\:\s/\:/g ;
1195             @rowprovv = split(/\s+/, $linenew);
1196             $rowprovv[0] =~ s/\:\,/\:/g ;
1197             @row = split(/\,/, $rowprovv[0]);
1198             if ($row[0] eq "*vertex")
1199             { push (@vertexes, [$row[1], $row[2], $row[3]] ) }
1200             }
1201             $counterline = $counterline +1;
1202             }
1203              
1204             foreach $vertex (@vertexes)
1205             {
1206             print OUTFILE "vanilla ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
1207             }
1208             foreach $vertex (@vertexes)
1209             {
1210             ${$vertex}[0] = (${$vertex}[0] - $centerpointsx);
1211             ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
1212             ${$vertex}[1] = (${$vertex}[1] - $centerpointsy);
1213             ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
1214             ${$vertex}[2] = (${$vertex}[2] - $centerpointsz);
1215             ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
1216             print OUTFILE "aftersum ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
1217             }
1218              
1219             my $anglealready = deg2rad(-$alreadyrotation);
1220             foreach $vertex (@vertexes)
1221             {
1222             my $x_new = cos($anglealready)*${$vertex}[0] - sin($anglealready)*${$vertex}[1];
1223             my $y_new = sin($anglealready)*${$vertex}[0] + cos($anglealready)*${$vertex}[1];
1224             ${$vertex}[0] = $x_new; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
1225             ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
1226             print OUTFILE "afterfirstrotation ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
1227             }
1228              
1229             $pacerotate = ( $swingrotate / ( $stepsvar - 1) );
1230             $rotation_degrees = - ( ($swingrotate / 2) - ($pacerotate * ($counterstep -1) ) );
1231             my $angle = deg2rad($rotation_degrees);
1232             foreach $vertex (@vertexes)
1233             {
1234             my $y_new = cos($angle)*${$vertex}[1] - sin($angle)*${$vertex}[2];
1235             my $z_new = sin($angle)*${$vertex}[1] + cos($angle)*${$vertex}[2];
1236             ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
1237             ${$vertex}[2] = $z_new; ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
1238             ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
1239             print OUTFILE "aftersincos ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
1240             }
1241              
1242             my $angleback = deg2rad($alreadyrotation);
1243             foreach $vertex (@vertexes)
1244             {
1245             my $x_new = cos($angleback)*${$vertex}[0] - sin($angleback)*${$vertex}[1];
1246             my $y_new = sin($angleback)*${$vertex}[0] + cos($angleback)*${$vertex}[1];
1247             ${$vertex}[0] = $x_new; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
1248             ${$vertex}[1] = $y_new; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
1249             print OUTFILE "afterrotationback ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";ctl type
1250             }
1251              
1252             foreach $vertex (@vertexes)
1253             {
1254             ${$vertex}[0] = ${$vertex}[0] + $centerpointsx; ${$vertex}[0] = sprintf("%.5f", ${$vertex}[0]);
1255             ${$vertex}[1] = ${$vertex}[1] + $centerpointsy; ${$vertex}[1] = sprintf("%.5f", ${$vertex}[1]);
1256             ${$vertex}[2] = ${$vertex}[2] + $centerpointsz; ${$vertex}[2] = sprintf("%.5f", ${$vertex}[2]);
1257             print OUTFILE "after final substraction ${$vertex}[0], ${$vertex}[1], ${$vertex}[2]\n";
1258             }
1259              
1260             my $counterwrite = -1;
1261             my $counterwriteand1;
1262             foreach $line (@lines)
1263             {#
1264              
1265             $linenew2 = $line;
1266             $linenew2 =~ s/\:\s/\:/g ;
1267             my @rowprovv2 = split(/\s+/, $linenew2);
1268             $rowprovv2[0] =~ s/\:\,/\:/g ;
1269             @row2 = split(/\,/, $rowprovv2[0]);
1270             $counterwriteright = ($counterwrite - 5);
1271             $counterwriteand1 = ($counterwrite + 1);
1272             if ($row2[0] eq "*vertex")
1273             {
1274             if ( $counterwrite == - 1) { $counterwrite = 0 }
1275             print OUTFILE2
1276             "*vertex"."\,"."${$vertexes[$counterwrite]}[0]"."\,"."${$vertexes[$counterwrite]}[1]"."\,"."${$vertexes[$counterwrite]}[2]"." # "."$counterwriteand1\n";
1277             }
1278             else
1279             {
1280             print OUTFILE2 "$line";
1281             }
1282             if ( $counterwrite > ( - 1 ) ) { $counterwrite++; }
1283             }
1284              
1285             close(OUTFILE);
1286             if ($exeonfiles eq "y") { print `chmod 777 $infile`; }
1287             print TOSHELL "chmod -R 777 $infile\n";
1288             if ($exeonfiles eq "y") { print `chmod 777 $infile2`; }
1289             print TOSHELL "chmod -R 777 $infile2\n";
1290             if ($exeonfiles eq "y") { print `rm $infile`; }
1291             print TOSHELL "rm $infile\n";
1292             if ($exeonfiles eq "y") { print `chmod 777 $outfile2`; }
1293             print TOSHELL "chmod 777 $outfile2\n";
1294             if ($exeonfiles eq "y") { print `cp $outfile2 $infile`; }
1295             print TOSHELL "cp $outfile2 $infile\n";
1296             if ($exeonfiles eq "y") { print `cp $outfile2 $infile2`; }
1297             print TOSHELL "cp $outfile2 $infile2\n";
1298             }
1299             } # END SUB rotatez
1300             ##############################################################################
1301              
1302              
1303             ##############################################################################
1304             sub make_generic_change # WITH THIS FUNCTION YOU TARGET PORTIONS OF A FILE AND YOU CHANGE THEM.
1305             {
1306             my $to = shift;
1307             my $fileconfig = shift;
1308             my $stepsvar = shift;
1309             my $counterzone = shift;
1310             my $counterstep = shift;
1311             my $exeonfiles = shift;
1312             my $swap = shift;
1313             my @applytype = @$swap;
1314             my $zone_letter = $applytype[$counterzone][3];
1315             my $swap2 = shift;
1316             my @generic_change = @$swap2;
1317              
1318              
1319             my $infile = "$to/zones/$applytype[$counterzone][2]";
1320             my $outfile = "$to/zones/$applytype[$counterzone][2]provv";
1321             open( INFILE, "$infile" ) or die "Can't open $infile 2: $!\n";
1322             open( OUTFILE, ">$outfile" ) or die "Can't open $outfile: $!\n";
1323             my @lines = ;
1324             close(INFILE);
1325             my $counterline = 0;
1326             my $countercases = 0;
1327              
1328             foreach $line (@lines)
1329             { #
1330             $linetochange = ( $generic_change[$counterzone][$countercases][1] );
1331             if ( $counterline == ( $linetochange - 1 ) )
1332             { #
1333             $linetochange = ( $generic_change[$counterzone][$counter_conditions][$countercases][1] );
1334             $cases = $#{ generic_change->[$counterzone][$counter_conditions] };
1335             $swing1 = $generic_change[$counterzone][$countercases][2][2];
1336             $swing2 = $generic_change[$counterzone][$countercases][3][2];
1337             $swing3 = $generic_change[$counterzone][$countercases][4][2];
1338             if ( ( $stepsvar > 1 )
1339             and ( $tiepacestofirst eq "n" ) )
1340             {
1341             $pace1 = ( $swing1 / ( $stepsvar - 1 ) );
1342             $pace2 = ( $swing2 / ( $stepsvar - 1 ) );
1343             $pace3 = ( $swing3 / ( $stepsvar - 1 ) );
1344             } elsif ( ( $stepsvar > 1 )
1345             and ( $tiepacestofirst eq "y" ) )
1346             {
1347             $pace1 = ( $swing1 / ( $stepsvar - 1 ) );
1348             $pace2 = ( $swing2 / ( $stepsvar - 1 ) );
1349             $pace3 = ( $swing3 / ( $stepsvar - 1 ) );
1350             } elsif ( $stepsvar == 1 )
1351             {
1352             $pace1 = 0;
1353             $pace2 = 0;
1354             $pace3 = 0;
1355             }
1356             $digits1 = $generic_change[$counterzone][$countercases][2][3];
1357             $digits2 = $generic_change[$counterzone][$countercases][3][3];
1358             $digits3 = $generic_change[$counterzone][$countercases][4][3];
1359             $begin_read_column1 = $generic_change[$counterzone][$countercases][2][0] - 1;
1360             $begin_read_column2 = $generic_change[$counterzone][$countercases][3][0] - 1;
1361             $begin_read_column3 = $generic_change[$counterzone][$countercases][4][0] - 1;
1362             $length_read_string1 = $generic_change[$counterzone][$countercases][2][1] + 1;
1363             $length_read_string2 = $generic_change[$counterzone][$countercases][3][1] + 1;
1364             $length_read_string3 = $generic_change[$counterzone][$countercases][4][1] + 1;
1365             ########## COMPLETE HERE ->
1366             $numbertype = "f"; #floating
1367             $to_substitute1 =
1368             substr( $line, $begin_read_column1, $length_read_string1 );
1369             $substitute_provv1 = ( $to_substitute1 - ( $swing1 / 2 ) + ( $pace1 * $counterstep ) );
1370             $substitute1 = sprintf( "%.$digits1$numbertype", $substitute_provv1 );
1371             $to_substitute2 = substr( $line, $begin_read_column2, $length_read_string2 );
1372             $substitute_provv2 = ( $to_substitute2 - ( $swing2 / 2 ) + ( $pace2 * $counterstep ) );
1373             $substitute2 = sprintf( "%.$digits2$numbertype", $substitute_provv2 );
1374             $to_substitute3 = substr( $line, $begin_read_column3, $length_read_string3 );
1375             $substitute_provv3 = ( $to_substitute3 - ( $swing3 / 2 ) + ( $pace3 * $counterstep ) );
1376             $substitute3 = sprintf( "%.$digits3$numbertype", $substitute_provv3 );
1377              
1378             if ( $substitute1 >= 0 )
1379             {
1380             $begin_write_column1 = $generic_change[$counterzone][$countercases][2][0];
1381             $length_write_string1 = $generic_change[$counterzone][$countercases][2][1];
1382             } else
1383             {
1384             $begin_write_column1 = $generic_change[$counterzone][$countercases][2][0] - 1;
1385             $length_write_string1 = $generic_change[$counterzone][$countercases][2][1] + 1;
1386             }
1387             if ( $substitute2 >= 0 )
1388             {
1389             $begin_write_column2 = $generic_change[$counterzone][$countercases][3][0];
1390             $length_write_string2 = $generic_change[$counterzone][$countercases][3][1];
1391             } else
1392             {
1393             $begin_write_column2 =$generic_change[$counterzone][$countercases][3][0] - 1;
1394             $length_write_string2 = $generic_change[$counterzone][$countercases][3][1] + 1;
1395             }
1396             if ( $substitute3 >= 0 )
1397             {
1398             $begin_write_column3 = $generic_change[$counterzone][$countercases][4][0];
1399             $length_write_string3 = $generic_change[$counterzone][$countercases][4][1];
1400             } else
1401             {
1402             $begin_write_column3 = $generic_change[$counterzone][$countercases][4][0] - 1;
1403             $length_write_string3 = $generic_change[$counterzone][$countercases][4][1] + 1;
1404             }
1405             substr( $line, $begin_write_column1, $length_write_string1, $substitute1 );
1406             substr( $line, $begin_write_column2, $length_write_string2, $substitute2 );
1407             substr( $line, $begin_write_column3, $length_write_string3, $substitute3 );
1408             print OUTFILE "$line";
1409             $countercases = $countercases + 1;
1410             } else
1411             {
1412             print OUTFILE "$line";
1413             }
1414             $counterline = $counterline + 1;
1415             }
1416             close(OUTFILE);
1417             if ($exeonfiles eq "y") { print `chmod -R 755 $infile`; }
1418             print TOSHELL "chmod -R 755 $infile\n";
1419             if ($exeonfiles eq "y") { print `chmod -R 755 $outfile`; }
1420             print TOSHELL
1421             "chmod -R 755 $outfile\n";
1422             if ($exeonfiles eq "y") { print `cp -f $outfile $infile`; }
1423             print TOSHELL
1424             "cp -f $outfile $infile\n";
1425             } # END SUB generic_change
1426             ##############################################################################
1427              
1428              
1429             ##############################################################################
1430             sub reassign_construction
1431             {
1432             my $to = shift;
1433             my $fileconfig = shift;
1434             my $stepsvar = shift;
1435             my $counterzone = shift;
1436             my $counterstep = shift;
1437             my $exeonfiles = shift;
1438             my $swap = shift;
1439             my @applytype = @$swap;
1440             my $zone_letter = $applytype[$counterzone][3];
1441             my $construction_reassignment = shift;
1442              
1443              
1444             my $yes_or_no_reassign_construction = $$construction_reassignment[$counterzone][0];
1445             if ( $yes_or_no_reassign_construction eq "y" )
1446             {
1447             my @surfaces_to_reassign =
1448             @{ $construction_reassignment->[$counterzone][1]
1449             };
1450             my @constructions_to_choose =
1451             @{ $construction_reassignment->[$counterzone][2] };
1452             my $configfile = $$construction_reassignment[$counterzone][3];
1453             my $surface_letter;
1454             my $counter = 0;
1455             my @reassign_constructions;
1456              
1457             foreach $surface_to_reassign (@surfaces_to_reassign)
1458             {
1459             $construction_to_choose = $constructions_to_choose[$counter][$counterstep];
1460            
1461             my $printthis =
1462             "prj -file $to/cfg/$fileconfig -mode script<
1463              
1464             m
1465             c
1466             a
1467             $zone_letter
1468             f
1469             $surface_to_reassign
1470             e
1471             n
1472             y
1473             $construction_to_choose
1474             -
1475             -
1476             -
1477             -
1478             y
1479             y
1480             -
1481             -
1482             -
1483             -
1484             -
1485             -
1486             -
1487             -
1488             YYY
1489             ";
1490             if ($exeonfiles eq "y")
1491             {
1492             print `$printthis`;
1493             }
1494              
1495             print TOSHELL $printthis;
1496             $counter++;
1497             }
1498             }
1499             } # END SUB reassign_construction
1500             ##############################################################################
1501              
1502              
1503             ##############################################################################
1504             sub change_thickness
1505             {
1506             my $to = shift;
1507             my $fileconfig = shift;
1508             my $stepsvar = shift;
1509             my $counterzone = shift;
1510             my $counterstep = shift;
1511             my $exeonfiles = shift;
1512             my $swap = shift;
1513             my @applytype = @$swap;
1514             my $zone_letter = $applytype[$counterzone][3];
1515             my $thickness_change = shift;
1516              
1517              
1518             my $yes_or_no_change_thickness = $$thickness_change[$counterzone][0];
1519             my @entries_to_change = @{ $$thickness_change[$counterzone][1] };
1520             my @groups_of_strata_to_change = @{ $$thickness_change[$counterzone][2] };
1521             my @groups_of_couples_of_min_max_values = @{ $$thickness_change[$counterzone][3] };
1522             my $configfile = $$thickness_change[$counterzone][4];
1523             my $thiscounter = 0;
1524             my $entry_to_change;
1525             my $counterstrata;
1526             my @strata_to_change;
1527             my $stratum_to_change;
1528             my @min_max_values;
1529             my $min;
1530             my $max;
1531             my $change_stratum;
1532             my @change_strata;
1533             my $enter_change_entry;
1534             my @change_entries;
1535             my $swing;
1536             my $pace;
1537             my $thickness;
1538             my @change_entries_with_thicknesses;
1539              
1540             if ( $stepsvar > 1 )
1541             {
1542             foreach $entry_to_change (@entries_to_change)
1543             {
1544             @strata_to_change =
1545             @{ $groups_of_strata_to_change[$thiscounter]
1546             };
1547             $counterstrata = 0;
1548             foreach $stratum_to_change (@strata_to_change)
1549             {
1550             @min_max_values =
1551             @{ $groups_of_couples_of_min_max_values[$thiscounter][$counterstrata] };
1552             $min = $min_max_values[0];
1553             $max = $min_max_values[1];
1554             $swing = $max - $min;
1555             $pace = ( $swing / ( $stepsvar - 1 ) );
1556             $thickness = $min + ( $pace * ( $counterstep - 1 ) );
1557              
1558             my $printthis =
1559             "prj -file $to/cfg/$fileconfig -mode script<
1560             b
1561             e
1562             a
1563             $entry_to_change
1564             $stratum_to_change
1565             n
1566             $thickness
1567             -
1568             -
1569             y
1570             y
1571             -
1572             y
1573             y
1574             -
1575             -
1576             -
1577             -
1578             -
1579             YYY
1580             ";
1581             if ($exeonfiles eq "y")
1582             {
1583             print `$printthis`;
1584             }
1585             print TOSHELL $printthis;
1586             $counterstrata++;
1587             }
1588             $thiscounter++;
1589             }
1590             $" = " ";
1591             if ($exeonfiles eq "y") { print `$enter_esp$go_to_construction_database@change_entries_with_thicknesses$exit_construction_database_and_esp`; }
1592             print TOSHELL "$enter_esp$go_to_construction_database@change_entries_with_thicknesses$exit_construction_database_and_esp\n";
1593             }
1594             } # END sub change_thickness
1595             ##############################################################################
1596              
1597              
1598             ##############################################################################
1599             sub obs_modify
1600             {
1601             if ( $stepsvar > 1 )
1602             {
1603             my $to = shift;
1604             my $fileconfig = shift;
1605             my $stepsvar = shift;
1606             my $counterzone = shift;
1607             my $counterstep = shift;
1608             my $exeonfiles = shift;
1609             my $swap = shift;
1610             my @applytype = @$swap;
1611             my $zone_letter = $applytype[$counterzone][3];
1612             my $obs_modify = shift;
1613              
1614              
1615             my @obs_letters = @{ $$obs_modify[$counterzone][0] };
1616             my $modification_type = $$obs_modify[$counterzone][1];
1617             my @values = @{ $$obs_modify[$counterzone][2] };
1618             my @base = @{ $$obs_modify[$counterzone][3] };
1619             my $configfile = $$obs_modify[$counterzone][4];
1620             my $xz_resolution = $$obs_modify[$counterzone][5];
1621             my $countobs = 0;
1622             my $x_end;
1623             my $y_end;
1624             my $z_end;
1625             my $x_base;
1626             my $y_base;
1627             my $z_base;
1628             my $end_value;
1629             my $base_value;
1630             my $x_swingtranslate;
1631             my $y_swingtranslate;
1632             my $z_swingtranslate;
1633             my $x_pace;
1634             my $x_value;
1635             my $y_pace;
1636             my $y_value;
1637             my $z_pace;
1638             my $z_value;
1639             if ( ($modification_type eq "a") or ($modification_type eq "b"))
1640             {
1641             $x_end = $values[0];
1642             $y_end = $values[1];
1643             $z_end = $values[2];
1644             $x_base = $base[0];
1645             $y_base = $base[1];
1646             $z_base = $base[2];
1647             $x_swingtranslate = ( 2 * $x_end );
1648             $y_swingtranslate = ( 2 * $y_end );
1649             $z_swingtranslate = ( 2 * $z_end );
1650             $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1651             $x_value = ($x_base + ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) ));
1652             $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
1653             $y_value = ($y_base + ( $y_end - ( $y_pace * ( $counterstep - 1 ) ) ));
1654             $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
1655             $z_value = ($z_base + ( $z_end - ( $z_pace * ( $counterstep - 1 ) ) ));
1656              
1657             my $printthis =
1658             "prj -file $to/cfg/$fileconfig -mode script<
1659              
1660             m
1661             c
1662             a
1663             $zone_letter
1664             h
1665             a
1666             $obs_letter
1667             $modification_type
1668             a
1669             $x_value $y_value $z_value
1670             -
1671             -
1672             c
1673             -
1674             c
1675             -
1676             -
1677             -
1678             -
1679             -
1680             -
1681             -
1682             -
1683             YYY
1684             ";
1685             foreach my $obs_letter (@obs_letters)
1686             {
1687             if ($exeonfiles eq "y")
1688             {
1689             print `$printthis`;
1690             }
1691             print TOSHELL $printthis;
1692             $countobs++;
1693             }
1694             }
1695              
1696             if ( ($modification_type eq "c") or ($modification_type eq "d"))
1697             {
1698             $x_end = $values[0];
1699             $x_base = $base[0];
1700             $x_swingtranslate = ( 2 * $x_end );
1701             $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1702             $x_value = ($x_base + ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) ));
1703              
1704             foreach my $obs_letter (@obs_letters)
1705             {
1706             my $printthis =
1707             "prj -file $to/cfg/$fileconfig -mode script<
1708              
1709             m
1710             c
1711             a
1712             $zone_letter
1713             h
1714             a
1715             $obs_letter
1716             $modification_type
1717             $x_value
1718             -
1719             -
1720             c
1721             -
1722             c
1723             -
1724             -
1725             -
1726             -
1727             -
1728             -
1729             -
1730             -
1731             YYY
1732             ";
1733             if ($exeonfiles eq "y")
1734             {
1735             print `$printthis`;
1736             }
1737             print TOSHELL $printthis;
1738             $countobs++;
1739             }
1740             }
1741              
1742             if ($modification_type eq "g")
1743             {
1744             foreach my $obs_letter (@obs_letters)
1745             {
1746             my $count = 0;
1747             foreach my $x_value (@values)
1748             {
1749             if ($count < $stepsvar)
1750             {
1751             my $printthis =
1752             "prj -file $to/cfg/$fileconfig -mode script<
1753              
1754             m
1755             c
1756             a
1757             $zone_letter
1758             h
1759             a
1760             $obs_letter
1761             $modification_type
1762             $x_value
1763             -
1764             -
1765             -
1766             -
1767             -
1768             -
1769             -
1770             -
1771             -
1772             -
1773             -
1774             -
1775             -
1776             -
1777             YYY
1778             ";
1779             if ($exeonfiles eq "y")
1780             {
1781             print `$printthis`;
1782             }
1783             print TOSHELL $printthis;
1784             $countobs++;
1785             $count++;
1786             }
1787             }
1788             }
1789             }
1790              
1791             if ($modification_type eq "h")
1792             {
1793             $x_end = $values[0];
1794             $x_base = $base[0];
1795             $x_swingtranslate = ( $x_base - $x_end );
1796             $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1797             $x_value = ($x_base - ( $x_pace * ( $counterstep - 1 ) ));
1798              
1799             foreach my $obs_letter (@obs_letters)
1800             {
1801             my $printthis =
1802             "prj -file $to/cfg/$fileconfig -mode script<
1803              
1804             m
1805             c
1806             a
1807             $zone_letter
1808             h
1809             a
1810             $obs_letter
1811             $modification_type
1812             $x_value
1813             -
1814             -
1815             -
1816             -
1817             -
1818             -
1819             -
1820             -
1821             -
1822             -
1823             -
1824             -
1825             -
1826             -
1827             YYY
1828             ";
1829             if ($exeonfiles eq "y")
1830             {
1831             print `$printthis`;
1832             }
1833             print TOSHELL $printthis;
1834             $countobs++;
1835             }
1836             }
1837              
1838             if ($modification_type eq "t")
1839             {
1840             my $modification_type = "~";
1841             my $what_todo = $base[0];
1842             $x_end = $values[0];
1843             $y_end = $values[1];
1844             $z_end = $values[2];
1845             $x_swingtranslate = ( 2 * $x_end );
1846             $y_swingtranslate = ( 2 * $y_end );
1847             $z_swingtranslate = ( 2 * $z_end );
1848             $x_pace = ( $x_swingtranslate / ( $stepsvar - 1 ) );
1849             $x_value = ( $x_end - ( $x_pace * ( $counterstep - 1 ) ) );
1850             $y_pace = ( $y_swingtranslate / ( $stepsvar - 1 ) );
1851             $y_value = ( $y_end - ( $y_pace * ( $counterstep - 1 ) ) );
1852             $z_pace = ( $z_swingtranslate / ( $stepsvar - 1 ) );
1853             $z_value = ( $z_end - ( $z_pace * ( $counterstep - 1 ) ) );
1854              
1855             foreach my $obs_letter (@obs_letters)
1856             {
1857             my $printthis =
1858             "prj -file $to/cfg/$fileconfig -mode script<
1859              
1860             m
1861             c
1862             a
1863             $zone_letter
1864             h
1865             a
1866             $modification_type
1867             $what_todo
1868             $obs_letter
1869             -
1870             $x_value $y_value $z_value
1871             -
1872             c
1873             -
1874             c
1875             -
1876             -
1877             -
1878             -
1879             -
1880             -
1881             -
1882             -
1883             YYY
1884             ";
1885             if ($exeonfiles eq "y")
1886             {
1887             print `$printthis`;
1888             }
1889             print TOSHELL $printthis;
1890             $countobs++;
1891             }
1892             }
1893              
1894             #NOW THE XZ GRID RESOLUTION WILL BE PUT TO THE SPECIFIED VALUE
1895             my $printthis = #THIS IS WHAT HAPPEN INSIDE SUB KEEP_SOME_OBSTRUCTIONS
1896             "prj -file $to/cfg/$fileconfig -mode script<
1897              
1898              
1899             m
1900             c
1901             a
1902             $zone_letter
1903             h
1904             a
1905             a
1906             $xz_resolution
1907             -
1908             c
1909             -
1910             c
1911             -
1912             -
1913             -
1914             -
1915             -
1916             -
1917             -
1918             YYY
1919             ";
1920             if ($exeonfiles eq "y")
1921             {
1922             print `$printthis`;
1923             }
1924             print TOSHELL $printthis;
1925             }
1926             } # END SUB obs_modify. FIX THE INDENTATION.
1927             ##############################################################################
1928              
1929              
1930             ##############################################################################
1931             sub bring_obstructions_back # TO BE REWRITTEN BETTER
1932             {
1933             my $to = shift;
1934             my $fileconfig = shift;
1935             my $stepsvar = shift;
1936             my $counterzone = shift;
1937             my $counterstep = shift;
1938             my $exeonfiles = shift;
1939             my $swap = shift;
1940             my @applytype = @$swap;
1941             my $zone_letter = $applytype[$counterzone][3];
1942             my $keep_obstructions = shift;
1943              
1944              
1945             my $yes_or_no_keep_some_obstructions = $$keep_obstructions[$counterzone][0];
1946             my $yes_or_no_update_radiation_provv = $$keep_obstructions[$counterzone][2];
1947             my $yes_or_no_update_radiation;
1948             my $configfile = $$keep_obstructions[$counterzone][3];
1949             my $xz_resolution = $$keep_obstructions[$counterzone][4];
1950             if ( $yes_or_no_update_radiation_provv eq "y" )
1951             {
1952             $yes_or_no_update_radiation = "a";
1953             } else
1954             {
1955             $yes_or_no_update_radiation = "c";
1956             }
1957             if ( $yes_or_no_keep_some_obstructions eq "y" )
1958             {
1959             my @group_of_obstructions_to_keep = @{ $$keep_obstructions[$counterzone][1] };
1960             my $keep_obs_counter = 0;
1961             my @obstruction_to_keep;
1962             foreach (@group_of_obstructions_to_keep)
1963             {
1964             @obstruction_to_keep =
1965             @{ $group_of_obstructions_to_keep[$keep_obs_counter] };
1966             my $obstruction_letter =
1967             "$obstruction_to_keep[0]";
1968             my $rotation_z = "$obstruction_to_keep[1]";
1969             my $rotation_y = "$obstruction_to_keep[2]"; # NOT YET IMPLEMENTED
1970             my $x_origin = "$obstruction_to_keep[3]";
1971             my $y_origin = "$obstruction_to_keep[4]";
1972             my $z_origin = "$obstruction_to_keep[5]";
1973             # $rotation_degrees used here is absolute, not local.
1974             # This is dangerous and it has to change.
1975              
1976             my $printthis =
1977             "prj -file $to/cfg/$fileconfig -mode script<
1978              
1979              
1980             m
1981             c
1982             a
1983             $zone_letter
1984             h
1985             a
1986             $obstruction_letter
1987             a
1988             a
1989             $x_origin $y_origin $z_origin
1990             c
1991             $rotation_z
1992             -
1993             -
1994             c
1995             -
1996             c
1997             -
1998             -
1999             -
2000             -
2001             -
2002             -
2003             -
2004             YYY
2005             ";
2006             if ($exeonfiles eq "y")
2007             {
2008             print `$printthis`;
2009             }
2010             print TOSHELL $printthis;
2011             $keep_obs_counter++;
2012             }
2013              
2014             # NOW THE XZ GRID RESOLUTION WILL BE PUT TO THE SPECIFIED VALUE
2015             my $printthis =
2016             "
2017             ";
2018             if ($exeonfiles eq "y")
2019             {
2020             print `$printthis`;
2021             }
2022             print TOSHELL $printthis;
2023             }
2024             } # END SUB bring_obstructions_back
2025             ##################################################################
2026              
2027              
2028             ##################################################################
2029             sub recalculateish
2030             {
2031             my $to = shift;
2032             my $fileconfig = shift;
2033             my $stepsvar = shift;
2034             my $counterzone = shift;
2035             my $counterstep = shift;
2036             my $exeonfiles = shift;
2037             my $swap = shift;
2038             my @applytype = @$swap;
2039              
2040              
2041             my $zone_letter = $applytype[$counterzone][3];
2042              
2043             my $printthis =
2044             "
2045             ";
2046             if ($exeonfiles eq "y")
2047             {
2048             print `$printthis`;
2049             }
2050              
2051             print TOSHELL $printthis;
2052             } #END SUB RECALCULATEISH
2053             ##############################################################################
2054              
2055              
2056              
2057             ##############################################################################
2058             sub daylightcalc # IT WORKS ONLY IF THE RAD DIRECTORY IS EMPTY
2059             {
2060             my $to = shift;
2061             my $fileconfig = shift;
2062             my $stepsvar = shift;
2063             my $counterzone = shift;
2064             my $counterstep = shift;
2065             my $exeonfiles = shift;
2066             my $swap = shift;
2067             my @applytype = @$swap;
2068             my $zone_letter = $applytype[$counterzone][3];
2069             my $filedf = shift;
2070             my $swap = shift;
2071             my @daylightcalc = @$swap;
2072              
2073              
2074             my $yes_or_no_daylightcalc = $daylightcalc[0];
2075             my $zone = $daylightcalc[1];
2076             my $surface = $daylightcalc[2];
2077             my $where = $daylightcalc[3];
2078             my $edge = $daylightcalc[4];
2079             my $distance = $daylightcalc[5];
2080             my $density = $daylightcalc[6];
2081             my $accuracy = $daylightcalc[7];
2082             my $filedf = $daylightcalc[8];
2083             my $pathdf = "$to/rad/$filedf";
2084              
2085             my $printthis =
2086             "
2087             cd $to/cfg/
2088             e2r -file $to/cfg/$fileconfig -mode script<
2089              
2090             a
2091              
2092             a
2093             d
2094             $zone
2095             -
2096             $surface
2097             $distance
2098             $where
2099             $edge
2100             -
2101             $density
2102             y
2103             $accuracy
2104             a
2105             -
2106             -
2107             -
2108             -
2109             -
2110             YYY
2111             \n\n
2112             cd $mypath
2113             ";
2114             if ($exeonfiles eq "y")
2115             {
2116             print `$printthis`;
2117             }
2118              
2119             print TOSHELL $printthis;
2120              
2121             open( RADFILE, $pathdf) or die "Can't open $pathdf: $!\n";
2122             my @linesrad = ;
2123             close RADFILE;
2124             my @dfs;
2125             my $dfaverage;
2126             my $sum = 0;
2127             foreach my $linerad (@linesrad)
2128             {
2129             $linerad =~ s/^\s+//;
2130             my @rowelements = split(/\s+|,/, $linerad);
2131             push (@dfs, $rowelements[-1]);
2132             }
2133             foreach my $df (@dfs)
2134             {
2135             $sum = ($sum + $df);
2136             }
2137             $dfaverage = ( $sum / scalar(@dfs) );
2138              
2139             open( DFFILE, ">>$dffile" ) or die "Can't open $dffile: $!";
2140             print DFFILE "$dfaverage\n";
2141             close DFFILE;
2142              
2143             } # END SUB dayligjtcalc
2144             ##############################################################################
2145              
2146              
2147             ##############################################################################
2148             sub daylightcalc_other # NOT USED. THE DIFFERENCE WITH THE ABOVE IS THAT IS WORKS IF THE RAD DIRECTORY IS NOT EMPTY.
2149             {
2150             my $to = shift;
2151             my $fileconfig = shift;
2152             my $stepsvar = shift;
2153             my $counterzone = shift;
2154             my $counterstep = shift;
2155             my $exeonfiles = shift;
2156             my $swap = shift;
2157             my @applytype = @$swap;
2158             my $zone_letter = $applytype[$counterzone][3];
2159             my $filedf = shift;
2160             my $swap = shift;
2161             my @daylightcalc = @$swap;
2162              
2163              
2164             my $yes_or_no_daylightcalc = $daylightcalc[0];
2165             my $zone = $daylightcalc[1];
2166             my $surface = $daylightcalc[2];
2167             my $where = $daylightcalc[3];
2168             my $edge = $daylightcalc[4];
2169             my $distance = $daylightcalc[5];
2170             my $density = $daylightcalc[6];
2171             my $accuracy = $daylightcalc[7];
2172             my $filedf = $daylightcalc[8];
2173             my $pathdf = "$to/rad/$filedf";
2174            
2175             my $printthis =
2176             "
2177             cd $to/cfg/
2178             e2r -file $to/cfg/$fileconfig -mode script<
2179             a
2180              
2181             d
2182              
2183             g
2184             -
2185             e
2186             d
2187              
2188              
2189              
2190             y
2191             -
2192             g
2193             y
2194             $zone
2195             -
2196             $surface
2197             $distance
2198             $where
2199             $edge
2200             -
2201             $density
2202              
2203             i
2204             $accuracy
2205             y
2206             a
2207             a
2208             -
2209             -
2210             YYY
2211             \n\n
2212             cd $mypath
2213             ";
2214             if ($exeonfiles eq "y")
2215             {
2216             print `$printthis`;
2217             }
2218              
2219             print TOSHELL $printthis;
2220              
2221             open( RADFILE, $pathdf) or die "Can't open $pathdf: $!\n";
2222             my @linesrad = ;
2223             close RADFILE;
2224             my @dfs;
2225             my $dfaverage;
2226             my $sum = 0;
2227             foreach my $linerad (@linesrad)
2228             {
2229             $linerad =~ s/^\s+//;
2230             my @rowelements = split(/\s+|,/, $linerad);
2231             push (@dfs, $rowelements[-1]);
2232             }
2233             foreach my $df (@dfs)
2234             {
2235             $sum = ($sum + $df);
2236             }
2237             $dfaverage = ( $sum / scalar(@dfs) );
2238              
2239             open( DFFILE, ">>$dffile" ) or die "Can't open $dffile: $!";
2240             print DFFILE "$dfaverage\n";
2241             close DFFILE;
2242              
2243             } # END SUB daylightcalc
2244             ##############################################################################
2245              
2246              
2247             sub change_config
2248             {
2249             my $to = shift;
2250             my $fileconfig = shift;
2251             my $stepsvar = shift;
2252             my $counterzone = shift;
2253             my $counterstep = shift;
2254             my $exeonfiles = shift;
2255             my $swap = shift;
2256             my @applytype = @$swap;
2257             my $zone_letter = $applytype[$counterzone][3];
2258             my $swap2 = shift;
2259             my @change_config = @$swap2;
2260              
2261              
2262             my @change_conf = @{$change_config[$countezone]};
2263             my @original_configfiles = @{$change_conf[0]};
2264             my @new_configfiles = @{$change_conf[1]};
2265             my $counterconfig = 0;
2266             my $original_configfile = $original_configfiles[$counterstep-1];
2267             my $new_configfile = $new_configfiles[$counterstep-1];
2268             if ( $new_configfile ne $original_configfile )
2269             {
2270             if ($exeonfiles eq "y") { `cp -f $to/$new_configfile $to/$original_configfile\n`; }
2271             print TOSHELL "cp -f $to/$new_configfile $to/$original_configfile\n";
2272             }
2273             $counterconfig++;
2274             } # END SUB copy_config
2275              
2276              
2277             sub checkfile # THIS FUNCTION DOES WHAT IS DONE BY THE PREVIOUS ONE, BUT BETTER.
2278             {
2279             # THIS CHECKS IF A SOURCE FILE MUST BE SUBSTITUTED BY ANOTHER ONE BEFORE THE TRANSFORMATIONS BEGIN.
2280             # IT HAS TO BE CALLED WITH: checkfile($sourceaddress, $targetaddress);
2281             my $sourceaddress = shift;
2282             my $targetaddress = shift;
2283              
2284              
2285             unless ( ($sourceaddress eq "" ) or ( $targetaddress eq "" ))
2286             {
2287             print OUTFILE "TARGETFILE IN FUNCTION: $targetaddress\n";
2288             if ( $sourceaddress ne $targetaddress )
2289             {
2290             if ($exeonfiles eq "y")
2291             {
2292             print
2293             `cp -f $sourceaddress $targetaddress\n`;
2294             }
2295             print TOSHELL
2296             "cp -f $sourceaddress $targetaddress\n\n";
2297             }
2298             }
2299             } # END SUB checkfile
2300              
2301              
2302             sub change_climate ### THIS SIMPLE SCRIPT HAS TO BE DEBUGGED. WHY DOES IT BLOCK ITSELF IF PRINTED TO THE SHELL?
2303             { # THIS FUNCTION CHANGES THE CLIMATE FILES.
2304             my $to = shift;
2305             my $fileconfig = shift;
2306             my $stepsvar = shift;
2307             my $counterzone = shift;
2308             my $counterstep = shift;
2309             my $exeonfiles = shift;
2310             my $swap = shift;
2311             my @applytype = @$swap;
2312             my $zone_letter = $applytype[$counterzone][3];
2313             my $swap = shift;
2314             my @change_climate = @$swap;
2315              
2316              
2317             my @climates = @{$change_climate[$counterzone]};
2318             my $climate = $climates[$counterstep-1];
2319              
2320             my $printthis =
2321             "prj -file $to/cfg/$fileconfig -mode script<
2322              
2323             b
2324             a
2325             b
2326             $climate
2327             a
2328             -
2329             -
2330             y
2331             n
2332             -
2333             -
2334             ZZZ
2335             \n
2336             ";
2337             if ($exeonfiles eq "y")
2338             {
2339             print `$printthis`;
2340             }
2341             print TOSHELL $printthis;
2342             }
2343              
2344              
2345             ##############################################################################
2346             # THIS FUNCTION HAS BEEN OUTDATED BY THOSE FOR CONSTRAINING THE NETS, BELOW
2347             sub recalculatenet
2348             {
2349             my $to = shift;
2350             my $fileconfig = shift;
2351             my $stepsvar = shift;
2352             my $counterzone = shift;
2353             my $counterstep = shift;
2354             my $exeonfiles = shift;
2355             my $swap = shift;
2356             my @applytype = @$swap;
2357             my $zone_letter = $applytype[$counterzone][3];
2358             my $swap2 = shift;
2359             my @recalculatenet = @$swap2;
2360              
2361              
2362             my $filenet = $recalculatenet[1];
2363             my $infilenet = "$mypath/$file/nets/$filenet";
2364             my @nodezone_data = @{$recalculatenet[2]};
2365             my @nodesdata = @{$recalculatenet[3]};
2366             my $geosourcefile = $recalculatenet[4];
2367             my $configfile = $recalculatenet[5];
2368             my $y_or_n_reassign_cp = $recalculatenet[6];
2369             my $y_or_n_detect_obs = $recalculatenet[7];
2370             my @crackwidths = @{$recalculatenet[9]};
2371              
2372             my @obstaclesdata;
2373             my $counterlines = 0;
2374             my $counternode = 0;
2375             my @differences;
2376             my @ratios;
2377             my $sourceaddress = "$to$geosourcefile";
2378             my $configaddress = "$to/opts/$configfile";
2379             open( SOURCEFILE, $sourceaddress ) or die "Can't open $geosourcefile 2: $!\n";
2380             my @linesgeo = ;
2381             close SOURCEFILE;
2382             my $countervert = 0;
2383             my $counterobs = 0;
2384             my $zone;
2385             my @rowelements;
2386             my $line;
2387             my @node;
2388             my @component;
2389             my @v;
2390             my @obs;
2391             my @obspoints;
2392             my @obstructionpoint;
2393             my $xlenght;
2394             my $ylenght;
2395             my $truedistance;
2396             my $heightdifference;
2397              
2398             foreach my $line (@linesgeo)
2399             {
2400             $line =~ s/^\s+//;
2401              
2402             my @rowelements = split(/\s+|,/, $line);
2403             if ($rowelements[0] eq "*vertex" )
2404             {
2405             if ($countervert == 0)
2406             {
2407             push (@v, [ "vertexes of $sourceaddress" ]);
2408             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2409             }
2410              
2411             if ($countervert > 0)
2412             {
2413             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2414             }
2415             $countervert++;
2416             }
2417             elsif ($rowelements[0] eq "*obs" )
2418             {
2419             push (@obs, [ $rowelements[1], $rowelements[2], $rowelements[3], $rowelements[4],
2420             $rowelements[5], $rowelements[6], $rowelements[7], $rowelements[8], $rowelements[9], $rowelements[10] ] );
2421             $counterobs++;
2422             }
2423             $counterlines++;
2424             }
2425              
2426             if ( $y_or_n_detect_obs eq "y") ### THIS HAS YET TO BE DONE AND WORK.
2427             {
2428             foreach my $ob (@obs)
2429             {
2430             push (@obspoints , [ $$ob[0], $$ob[1],$$ob[5] ] );
2431             push (@obspoints , [ ($$ob[0] + ( $$ob[3] / 2) ), ( $$ob[1] + ( $$ob[4] / 2 ) ) , $$ob[5] ] );
2432             push (@obspoints , [ ($$ob[0] + $$ob[3]), ( $$ob[1] + $$ob[4] ) , $$ob[5] ] );
2433             }
2434             }
2435              
2436             else {@obspoints = @{$recalculatenet[8]};}
2437             my @winpoints;
2438             my @windowpoints;
2439             my @windimsfront;
2440             my @windimseast;
2441             my @windimsback;
2442             my @windimswest;
2443             my $jointfront,
2444             my $jointeast;
2445             my $jointback;
2446             my $jointwest;
2447             my @windsims;
2448             my @windareas;
2449             my @jointlenghts;
2450             my $windimxfront;
2451             my $windimyfront;
2452             my $windimxback;
2453             my $windimyback;
2454             my $windimxeast;
2455             my $windimyeast;
2456             my $windimxwest;
2457             my $windimywest;
2458              
2459             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
2460             # FOR PROPAGATION OF CONSTRAINTS
2461              
2462             if ($y_or_n_reassign_cp == "y")
2463             {
2464             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2465             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2466             }
2467              
2468              
2469              
2470             open( INFILENET, $infilenet ) or die "Can't open $infilenet 2: $!\n";
2471             my @linesnet = ;
2472             close INFILENET;
2473              
2474             my @letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s",
2475             "t", "u", "v", "w", "x", "y", "z");
2476             my $counternode = 0;
2477             my $interfaceletter;
2478             my $calcpressurecoefficient;
2479             my $nodetype;
2480             my $nodeletter;
2481             my $mode;
2482             my $counterlines = 0;
2483             my $counteropening = 0;
2484             my $countercrack = 0;
2485             my $counterthing = 0;
2486             my $counterjoint = 0;
2487             foreach my $line (@linesnet)
2488             {
2489             $line =~ s/^\s+//;
2490             @rowelements = split(/\s+/, $line);
2491              
2492             if ($rowelements[0] eq "Node") { $mode = "nodemode"; }
2493             if ($rowelements[0] eq "Component") { $mode = "componentmode"; }
2494             if ( ( $mode eq "nodemode" ) and ($counterlines > 1) and ($counterlines < (2 + scalar(@nodesdata) ) ) )
2495             {
2496             $counternode = ($counterlines - 2);
2497             $zone = $nodesdata[$counternode][0];
2498             $interfaceletter = $nodesdata[$counternode][1];
2499             $calcpressurecoefficient = $nodesdata[$counternode][2];
2500             $nodetype = $rowelements[2];
2501             $nodeletter = $letters[$counternode];
2502              
2503             if ( $nodetype eq "0")
2504             {
2505             my $printthis =
2506             "prj -file $to/cfg/$fileconfig -mode script<
2507              
2508              
2509             m
2510             e
2511             c
2512              
2513             n
2514             c
2515             $nodeletter
2516              
2517             a
2518             a
2519             y
2520             $zone
2521              
2522              
2523             a
2524              
2525             -
2526             -
2527             y
2528              
2529             y
2530             -
2531             -
2532             -
2533             -
2534             -
2535             -
2536             -
2537             -
2538             YYY
2539             ";
2540             if ($exeonfiles eq "y")
2541             {
2542             print `$printthis`;
2543             }
2544              
2545             print TOSHELL $printthis;
2546             $counternode++;
2547             }
2548             elsif ( $nodetype eq "3")
2549             {
2550             if ($y_or_n_reassign_cp == "y")
2551             {
2552             my $printthis =
2553             "prj -file $to/cfg/$fileconfig -mode script<
2554              
2555              
2556             m
2557             e
2558             c
2559              
2560             n
2561             c
2562             $nodeletter
2563              
2564             a
2565             e
2566             $zone
2567             $interfaceletter
2568             $calcpressurecoefficient
2569             y
2570              
2571              
2572             -
2573             -
2574             y
2575              
2576             y
2577             -
2578             -
2579             -
2580             -
2581             -
2582             -
2583             -
2584             -
2585             YYY
2586             ";
2587             if ($exeonfiles eq "y")
2588             {
2589             print `printthis`;
2590             }
2591              
2592             print TOSHELL $printthis;
2593             $counternode++;
2594             }
2595             }
2596             }
2597              
2598             my @node_letters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p",
2599             "q", "r", "s", "t", "u", "v", "w", "x", "y", "z");
2600             if ( ($mode eq "componentmode") and ( $line =~ "opening"))
2601             {
2602             my $printthis =
2603             "prj -file $to/cfg/$fileconfig -mode script<
2604              
2605              
2606             m
2607             e
2608             c
2609              
2610             n
2611             d
2612             $node_letters[$counterthing]
2613              
2614             k
2615             -
2616             $windareas[$counteropening]
2617             -
2618             -
2619             y
2620              
2621             y
2622             -
2623             -
2624             -
2625             -
2626             -
2627             -
2628             -
2629             YYY
2630             ";
2631             if ($exeonfiles eq "y")
2632             {
2633             print `$printthis`;
2634             }
2635              
2636             print TOSHELL $printthis;
2637              
2638             $counteropening++;
2639             $counterthing++;
2640             }
2641             elsif ( ($mode eq "componentmode") and ( $line =~ "crack "))
2642             {
2643             MY $printthis =
2644             "prj -file $to/cfg/$fileconfig -mode script<
2645              
2646              
2647             m
2648             e
2649             c
2650              
2651             n
2652             d
2653             $node_letters[$counterthing]
2654              
2655             l
2656             -
2657             $crackwidths[$counterjoint] $jointlenghts[$counterjoint]
2658             -
2659             -
2660             y
2661              
2662             y
2663             -
2664             -
2665             -
2666             -
2667             -
2668             -
2669             -
2670             YYY
2671             ";
2672             if ($exeonfiles eq "y")
2673             {
2674             print `$printthis`;
2675             }
2676              
2677             print TOSHELL $printthis;
2678              
2679             $countercrack++;
2680             $counterthing++;
2681             $counterjoint++;
2682             }
2683             $counterlines++;
2684             }
2685             } # END SUB recalculatenet
2686             ##############################################################################
2687              
2688              
2689             ##############################################################################
2690             sub apply_constraints
2691             {
2692             my $to = shift;
2693             my $fileconfig = shift;
2694             my $stepsvar = shift;
2695             my $counterzone = shift;
2696             my $counterstep = shift;
2697             my $exeonfiles = shift;
2698             my $swap = shift;
2699             my @applytype = @$swap;
2700             my $zone_letter = $applytype[$counterzone][3];
2701             my $swap2 = shift;
2702             my @apply_constraints = @$swap2;
2703              
2704              
2705             my $value_reshape;
2706             my $ybasewall;
2707             my $ybasewindow;
2708             my @v;
2709              
2710             foreach my $group_operations ( @apply_constraints )
2711             {
2712             my @group = @{$group_operations};
2713             my $yes_or_no_apply_constraints = $group[0];
2714              
2715             my @sourcefiles = @{$group[1]};
2716             my @targetfiles = @{$group[2]};
2717             my @configfiles = @{$group[3]};
2718             my @basevalues = @{$group[4]};
2719             my @swingvalues = @{$group[5]};
2720             my @work_values = @{$group[6]};
2721             my $longmenu = $group[7];
2722             my $basevalue;
2723             my $targetfile;
2724             my $configfile;
2725             my $swingvalue;
2726             my $sourceaddress;
2727             my $targetaddress;
2728             my $configaddress;
2729             my $countoperations = 0;
2730              
2731             foreach $sourcefile ( @sourcefiles )
2732             {
2733             $basevalue = $basevalues[$countoperations];
2734             $sourcefile = $sourcefiles[$countoperations];
2735             $targetfile = $targetfiles[$countoperations];
2736             $configfile = $configfiles[$countoperations];
2737             $swingvalue = $swingvalues[$countoperations];
2738             $sourceaddress = "$to$sourcefile";
2739             $targetaddress = "$to$targetfile";
2740             $configaddress = "$to/opts/$configfile";
2741             $longmenu = $longmenus[$countoperations];
2742             checkfile($sourceaddress, $targetaddress);
2743              
2744             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
2745             my @lines = ;
2746             close SOURCEFILE;
2747             my $counterlines = 0;
2748             my $countervert = 0;
2749             foreach my $line (@lines)
2750             {
2751             $line =~ s/^\s+//;
2752             my @rowelements = split(/\s+|,/, $line);
2753             if ($rowelements[0] eq "*vertex" )
2754             {
2755             if ($countervert == 0)
2756             {
2757             push (@v, [ "vertexes of $sourceaddress" ]);
2758             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2759             }
2760              
2761             if ($countervert > 0)
2762             {
2763             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2764             }
2765             $countervert++;
2766             }
2767             $counterlines++;
2768             }
2769              
2770             my @vertexletters;
2771             if ($longmenu eq "y")
2772             {
2773             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
2774             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
2775             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
2776             "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",
2777             "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",
2778             "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");
2779             }
2780             else
2781             {
2782             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2783             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
2784             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
2785             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
2786             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
2787             }
2788              
2789             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
2790             # FOR PROPAGATION OF CONSTRAINTS
2791              
2792             if (-e $configaddress)
2793             {
2794             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2795             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2796              
2797             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
2798             # FOR PROPAGATION OF CONSTRAINTS
2799              
2800              
2801             my $countervertex = 0;
2802             foreach (@v)
2803             {
2804             if ($countervertex > 0)
2805             {
2806             my $vertexletter = $vertexletters[$countervertex-1];
2807             if ($vertexletter ~~ @work_values)
2808             {
2809             my $printthis =
2810             "prj -file $to/cfg/$fileconfig -mode script<
2811              
2812             m
2813             c
2814             a
2815             $zone_letter
2816             d
2817             $vertexletter
2818             $v[$countervertex][0] $v[$countervertex][1] $v[$countervertex][2]
2819             -
2820             y
2821             -
2822             y
2823             c
2824             -
2825             -
2826             -
2827             -
2828             -
2829             -
2830             -
2831             -
2832             -
2833             YYY
2834             ";
2835             if ($exeonfiles eq "y")
2836             {
2837             print `$printthis`;
2838             }
2839              
2840             print TOSHELL $printthis;
2841             }
2842             }
2843             $countervertex++;
2844             }
2845             }
2846             $countoperations++;
2847             }
2848             }
2849             } # END SUB apply_constraints
2850             ##############################################################################
2851              
2852              
2853             ##############################################################################
2854             sub reshape_windows # IT APPLIES CONSTRAINTS
2855             {
2856             my $to = shift;
2857             my $fileconfig = shift;
2858             my $stepsvar = shift;
2859             my $counterzone = shift;
2860             my $counterstep = shift;
2861             my $exeonfiles = shift;
2862             my $swap = shift;
2863             my @applytype = @$swap;
2864             my $zone_letter = $applytype[$counterzone][3];
2865             my $swap2 = shift;
2866             my @reshape_windows = @$swap2;
2867              
2868              
2869             my @work_letters ;
2870             my @v;
2871              
2872             foreach my $group_operations ( @{$reshape_windows[$counterzone]} )
2873             {
2874             my @group = @{$group_operations};
2875             my @sourcefiles = @{$group[0]};
2876             my @targetfiles = @{$group[1]};
2877             my @configfiles = @{$group[2]};
2878             my @basevalues = @{$group[3]};
2879             my @swingvalues = @{$group[4]};
2880             my @work_letters = @{$group[5]};
2881             my @longmenus = @{$group[6]};
2882              
2883             my $countoperations = 0;
2884             foreach $sourcefile ( @sourcefiles )
2885             {
2886             my $basevalue = $basevalues[$countoperations];
2887             my $sourcefile = $sourcefiles[$countoperations];
2888             my $targetfile = $targetfiles[$countoperations];
2889             my $configfile = $configfiles[$countoperations];
2890             my $swingvalue = $swingvalues[$countoperations];
2891             my $longmenu = $longmenus[$countoperations];
2892             my $sourceaddress = "$to$sourcefile";
2893             my $targetaddress = "$to$targetfile";
2894             my $configaddress = "$to/opts/$configfile";
2895             my $totalswing = ( 2 * $swingvalue );
2896             my $pace = ( $totalswing / ( $stepsvar - 1 ) );
2897             checkfile($sourceaddress, $targetaddress);
2898            
2899             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
2900             my @lines = ;
2901             close SOURCEFILE;
2902              
2903             my $counterlines = 0;
2904             my $countervert = 0;
2905             foreach my $line (@lines)
2906             {
2907             $line =~ s/^\s+//;
2908              
2909             my @rowelements = split(/\s+|,/, $line);
2910             if ($rowelements[0] eq "*vertex" )
2911             {
2912             if ($countervert == 0)
2913             {
2914             push (@v, [ "vertexes of $sourceaddress", [], [] ]);
2915             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2916             }
2917              
2918             if ($countervert > 0)
2919             {
2920             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
2921             }
2922              
2923             $countervert++;
2924             }
2925             $counterlines++;
2926             }
2927              
2928             my @vertexletters;
2929             if ($longmenu eq "y")
2930             {
2931             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2932             "n", "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv",
2933             "0\nb\nw", "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd",
2934             "0\nb\ne","0\nb\n0\nb\nf","0\nb\n0\nb\ng","0\nb\n0\nb\nh","0\nb\n0\nb\ni",
2935             "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",
2936             "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",
2937             "0\nb\n0\nb\nt");
2938             }
2939             else
2940             {
2941             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
2942             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
2943             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
2944             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
2945             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
2946             }
2947              
2948             $value_reshape_window = ( ( $basevalue - $swingvalue) + ( $pace * ( $counterstep - 1 )) );
2949              
2950             if (-e $configaddress)
2951             {
2952              
2953             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
2954             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
2955              
2956             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
2957             # FOR PROPAGATION OF CONSTRAINTS
2958              
2959             my $countervertex = 0;
2960              
2961             foreach (@v)
2962             {
2963             if ($countervertex > 0)
2964             {
2965             my $vertexletter = $vertexletters[$countervertex];
2966             if ($vertexletter ~~ @work_letters)
2967             {
2968             my $printthis =
2969             "prj -file $to/cfg/$fileconfig -mode script<
2970              
2971             m
2972             c
2973             a
2974             $zone_letter
2975             d
2976             $vertexletter
2977             $v[$countervertex+1][0] $v[$countervertex+1][1] $v[$countervertex+1][2]
2978             -
2979             y
2980             -
2981             y
2982             c
2983             -
2984             -
2985             -
2986             -
2987             -
2988             -
2989             -
2990             -
2991             -
2992             YYY
2993             ";
2994             if ($exeonfiles eq "y")
2995             {
2996             print `$printthis`;
2997             }
2998              
2999             print TOSHELL $printthis;
3000             }
3001             }
3002             $countervertex++;
3003             }
3004             }
3005             $countoperations++;
3006             }
3007              
3008             }
3009             } # END SUB reshape_windows
3010             ##############################################################################
3011              
3012              
3013             sub warp #
3014             {
3015             my $to = shift;
3016             my $fileconfig = shift;
3017             my $stepsvar = shift;
3018             my $counterzone = shift;
3019             my $counterstep = shift;
3020             my $exeonfiles = shift;
3021             my $swap = shift;
3022             my @applytype = @$swap;
3023             my $zone_letter = $applytype[$counterzone][3];
3024             my $warp = shift;
3025              
3026              
3027             my $yes_or_no_warp = $$warp[$counterzone][0];
3028             my @surfs_to_warp = @{ $warp->[$counterzone][1] };
3029             my @vertexes_numbers = @{ $warp->[$counterzone][2] };
3030             my @swingrotations = @{ $warp->[$counterzone][3] };
3031             my @yes_or_no_apply_to_others = @{ $warp->[$counterzone][4] };
3032             my $configfilename = $$warp[$counterzone][5];
3033             my $configfile = $to."/opts/".$configfilename;
3034             my @pairs_of_vertexes = @{ $warp->[$counterzone][6] }; # @pairs_of_vertexes defining axes
3035             my @windows_to_reallign = @{ $warp->[$counterzone][7] };
3036             my $sourcefilename = $$warp[$counterzone][8];
3037             my $sourcefile = $to.$sourcefilename;
3038             my $longmenu = $$warp[$counterzone][9];
3039             if ( $yes_or_no_warp eq "y" )
3040             {
3041             my $counterrotate = 0;
3042             foreach my $surface_letter (@surfs_to_warp)
3043             {
3044             $swingrotate = $swingrotations[$counterrotate];
3045             $pacerotate = ( $swingrotate / ( $stepsvar - 1 ) );
3046             $rotation_degrees = ( ( $swingrotate / 2 ) - ( $pacerotate * ( $counterstep - 1 ) )) ;
3047             $vertex_number = $vertexes_numbers[$counterrotate];
3048             $yes_or_no_apply = $yes_or_no_apply_to_others[$counterrotate];
3049             if ( ( $swingrotate != 0 ) and ( $stepsvar > 1 ) and ( $yes_or_no_warp eq "y" ) )
3050             {
3051             my $printthis =
3052             "prj -file $to/cfg/$fileconfig -mode script<
3053              
3054             m
3055             c
3056             a
3057             $zone_letter
3058             e
3059             >
3060             $surface_letter
3061             c
3062             $vertex_number
3063             $rotation_degrees
3064             $yes_or_no_apply
3065             -
3066             -
3067             y
3068             c
3069             -
3070             -
3071             -
3072             -
3073             -
3074             -
3075             -
3076             -
3077             YYY
3078             ";
3079             if ($exeonfiles eq "y")
3080             {
3081             print `$printthis`;
3082             }
3083             print TOSHELL $printthis;
3084             }
3085             $counterrotate++;
3086             }
3087              
3088             # THIS SECTION READS THE CONFIG FILE FOR DIMENSIONS
3089             open( SOURCEFILE, $sourcefile ) or die "Can't open $sourcefile: $!\n";
3090             my @lines = ;
3091             close SOURCEFILE;
3092             my $counterlines = 0;
3093             my $countervert = 0;
3094             foreach my $line (@lines)
3095             {
3096             $line =~ s/^\s+//;
3097            
3098             my @rowelements = split(/\s+|,/, $line);
3099             if ($rowelements[0] eq "*vertex" )
3100             {
3101             if ($countervert == 0)
3102             {
3103             push (@v, [ "vertexes of $sourceaddress" ]);
3104             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3105             }
3106              
3107             if ($countervert > 0)
3108             {
3109             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3110             }
3111             $countervert++;
3112             }
3113             $counterlines++;
3114             }
3115              
3116              
3117             my @vertexletters;
3118             if ($longmenu eq "y")
3119             {
3120             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3121             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
3122             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
3123             "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",
3124             "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",
3125             "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");
3126             }
3127             else
3128             {
3129             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3130             "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx", "0\ny",
3131             "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng","0\n0\nh",
3132             "0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no","0\n0\np",
3133             "0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
3134             }
3135              
3136              
3137             if (-e $configfile)
3138             {
3139             eval `cat $configfile`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED
3140             # AND PROPAGATED.
3141              
3142             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
3143             # FOR PROPAGATION OF CONSTRAINTS
3144              
3145             }
3146             # THIS SECTION SHIFTS THE VERTEX TO LET THE BASE SURFACE AREA UNCHANGED AFTER THE WARPING.
3147              
3148             my $counterthis = 0;
3149             $number_of_moves = ( (scalar(@pairs_of_vertexes)) /2 ) ;
3150             foreach my $pair_of_vertexes (@pairs_of_vertexes)
3151             {
3152             if ($counterthis < $number_of_moves)
3153             {
3154             $vertex1 = $pairs_of_vertexes[ 0 + ( 2 * $counterthis ) ];
3155             $vertex2 = $pairs_of_vertexes[ 1 + ( 2 * $counterthis ) ];
3156              
3157             my $printthis =
3158             "prj -file $to/cfg/$fileconfig -mode script<
3159              
3160             m
3161             c
3162             a
3163             $zone_letter
3164             d
3165             ^
3166             j
3167             $vertex1
3168             $vertex2
3169             -
3170             $addedlength
3171             y
3172             -
3173             y
3174             -
3175             y
3176             -
3177             -
3178             -
3179             -
3180             -
3181             -
3182             -
3183             -
3184             YYY
3185             ";
3186             if ($exeonfiles eq "y")
3187             {
3188             print `$printthis`;
3189             }
3190             print TOSHELL $printthis;
3191             }
3192             $counterthis++;
3193             }
3194             }
3195             } # END SUB warp
3196             ##############################################################################
3197              
3198              
3199             ##############################################################################
3200             ##############################################################################
3201             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING GEOMETRY
3202              
3203             sub constrain_geometry # IT APPLIES CONSTRAINTS TO ZONE GEOMETRY
3204             {
3205             # IT CONSTRAIN GEOMETRY FILES. IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
3206             # constrain_geometry($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $exeonfiles, \@applytype, \@constrain_geometry);
3207             # constrain_geometry($to, $fileconfig, $stepsvar, $counterzone,
3208             # $counterstep, $exeonfiles, \@applytype, \@constrain_geometry, $to_do);
3209             my $to = shift;
3210             my $fileconfig = shift;
3211             my $stepsvar = shift;
3212             my $counterzone = shift;
3213             my $counterstep = shift;
3214             my $exeonfiles = shift;
3215             my $swap = shift;
3216             my @applytype = @$swap;
3217             my $zone_letter = $applytype[$counterzone][3];
3218             my $swap = shift;
3219             my @constrain_geometry = @$swap;
3220             my $to_do = shift;
3221              
3222              
3223             # print OUTFILE "YOUCALLED!\n\n";
3224             # print OUTFILE "HERE: \@constrain_geometry:" . Dumper(@constrain_geometry) . "\n\n";
3225             if ($longmenu eq "y")
3226             {
3227             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
3228             "o", "p", "0\nb\nq", "0\nb\nr", "0\nb\ns", "0\nb\nt", "0\nb\nu", "0\nb\nv", "0\nb\nw",
3229             "0\nb\nx", "0\nb\ny", "0\nb\nz", "0\nb\na", "0\nb\nb","0\nb\nc","0\nb\nd","0\nb\ne",
3230             "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",
3231             "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",
3232             "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");
3233             }
3234             else
3235             {
3236             @vertexletters = ("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m",
3237             "n", "o", "p", "0\nq", "0\nr", "0\ns", "0\nt", "0\nu", "0\nv", "0\nw", "0\nx",
3238             "0\ny", "0\nz", "0\na", "0\nb","0\n0\nc","0\n0\nd","0\n0\ne","0\n0\nf","0\n0\ng",
3239             "0\n0\nh","0\n0\ni","0\n0\nj","0\n0\nk","0\n0\nl","0\n0\nm","0\n0\nn","0\n0\no",
3240             "0\n0\np","0\n0\nq","0\n0\nr","0\n0\ns","0\n0\nt");
3241             }
3242              
3243             foreach my $elm (@constrain_geometry)
3244             {
3245             my @group = @{$elm};
3246             # print OUTFILE "INSIDE: \@constrain_geometry:" . Dumper(@constrain_geometry) . "\n\n";
3247             # print OUTFILE "INSIDE: \@group:" . Dumper(@group) . "\n\n";
3248             my $zone_letter = $group[1];
3249             my $sourcefile = $group[2];
3250             my $targetfile = $group[3];
3251             my $configfile = $group[4];
3252             my $sourceaddress = "$to$sourcefile";
3253             my $targetaddress = "$to$targetfile";
3254             my @work_letters = @{$group[5]};
3255             my $longmenus = $group[6];
3256              
3257             # print OUTFILE "VARIABLES: \$to:$to, \$fileconfig:$fileconfig, \$stepsvar:$stepsvar, \$counterzone:$counterzone, \$counterstep:$counterstep, \$exeonfiles:$exeonfiles,
3258             # \$zone_letter:$zone_letter, \$sourceaddress:$sourceaddress, \$targetaddress:$targetaddress, \$longmenus:$longmenus, \@work_letters, " . Dumper(@work_letters) . "\n\n";
3259              
3260             unless ($to_do eq "justwrite")
3261             {
3262             checkfile($sourceaddress, $targetaddress);
3263             read_geometry($to, $sourcefile, $targetfile, $configfile, \@work_letters, $longmenus);
3264             read_geo_constraints($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $configaddress, \@v, \@tempv);
3265             }
3266              
3267             unless ($to_do eq "justread")
3268             {
3269             apply_geo_constraints(\@dov, \@vertexletters, \@work_letters, $exeonfiles, $zone_letter, $toshell, $outfile, $configfile, \@tempv);
3270             }
3271             # print OUTFILE "\@v: " . Dumper(@v) . "\n\n";
3272             }
3273             } # END SUB constrain_geometry
3274              
3275              
3276             sub read_geometry
3277             {
3278             # THIS READS GEOMETRY FILES. # IT HAS TO BE CALLED WITH:
3279             # read_geometry($to, $sourcefile, $targetfile, $configfiles, \@work_letters, $longmenus);
3280             my $to = shift;
3281             my $sourcefile = shift;
3282             my $targetfile = shift;
3283             my $configfile = shift;
3284             my $swap = shift;
3285             my @work_letters = @$swap;
3286             my $longmenus = shift;
3287             my $sourceaddress = "$to$sourcefile";
3288             my $targetaddress = "$to$targetfile";
3289             my $configaddress = "$to$configfile";
3290            
3291             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile 2: $!\n";
3292             my @lines = ;
3293             close SOURCEFILE;
3294              
3295             my $counterlines = 0;
3296             my $countervert = 0;
3297             foreach my $line (@lines)
3298             {
3299             $line =~ s/^\s+//;
3300              
3301             my @rowelements = split(/\s+|,/, $line);
3302             if ($rowelements[0] eq "*vertex" )
3303             {
3304             push (@v, [ $rowelements[1], $rowelements[2], $rowelements[3] ] );
3305             $countervert++;
3306             }
3307             $counterlines++;
3308             }
3309             @dov = @v;
3310             } # END SUB read_geometry
3311              
3312              
3313             sub read_geo_constraints
3314             {
3315             # THIS FILE IS FOR OPTS TO READ GEOMETRY USER-IMPOSED CONSTRAINTS.
3316             # IT IS CALLED WITH: read_geo_constraints($configaddress);
3317             # THIS MAKES AVAILABLE THE VERTEXES IN THE GEOMETRY FILES TO THE USER FOR MANIPULATION, IN THE FOLLOWING FORM:
3318             # $v[$counterzone][$number][$x], $v[$counterzone][$number][$y], $v[$counterzone][$number][$z]. EXAMPLE: $v[0][4][$x] = 1.
3319             # OR: @v[0][4][$x] = @v[0][4][$y]. OR EVEN: @v[1][4][$x] = @v[0][3][$z].
3320             # The $counterzone that is actuated is always the last, the one which is active.
3321             # It would have therefore no sense writing $v[0][4][$x] = $v[1][2][$y].
3322             # Differentent $counterzones can be referred to the same zone. Different $counterzones just number mutations in series.
3323             # ALSO, IT MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
3324             # AND THE STEPS THE MODEL HAVE TO FOLLOW.
3325             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
3326             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
3327             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
3328             # $counterzone, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
3329             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $counterzone WILL CONTAIN ONE OR MORE ITERATION STEPS.
3330             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
3331             # THE OTHER ARE APPLIED TO THE SAME ZONE.
3332             # $counterstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
3333             my $to = shift;
3334             my $fileconfig = shift;
3335             my $stepsvar = shift;
3336             my $counterzone = shift;
3337             my $counterstep = shift;
3338             my $configaddress = shift;
3339             my $swap = shift;
3340             my @myv = @$swap;
3341             @tempv = @myv;
3342              
3343             my $x = 0;
3344             my $y = 1;
3345             my $z = 2;
3346             unshift (@myv, [ "vertexes of $sourceaddress. \$counterzone: $counterzone ", [], [] ]);
3347              
3348             if (-e $configaddress)
3349             {
3350             push (@v, [@myv]); #
3351             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED.
3352              
3353             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
3354             # FOR PROPAGATION OF CONSTRAINTS
3355              
3356             @dov = @{$v[$#v]}; #
3357             shift (@dov); #
3358             }
3359             } # END SUB read_geo_constraints
3360              
3361              
3362             sub apply_geo_constraints
3363             {
3364             # IT APPLY USER-IMPOSED CONSTRAINTS TO A GEOMETRY FILES VIA SHELL
3365             # IT HAS TO BE CALLED WITH:
3366             # apply_geo_constraints(\@v, \@vertexletters, \@work_letters, \$exeonfiles, \$zone_letter);
3367             my $swap = shift;
3368             my @v = @$swap;
3369             my $swap = shift;
3370             my @vertexletters = @$swap;
3371              
3372             my $swap = shift;
3373             my @work_letters = @$swap;
3374              
3375             my $exeonfiles = shift;
3376             my $zone_letter = shift;
3377             my $toshell = shift;
3378             my $outfile = shift;
3379             my $configfile = shift;
3380             my $swap = shift;
3381             my @tempv = @$swap;
3382              
3383              
3384             my $countervertex = 0;
3385              
3386             foreach my $v (@v)
3387             {
3388             my $vertexletter = $vertexletters[$countervertex];
3389             if
3390             (
3391             (
3392             (@work_letters eq "") or ($vertexletter ~~ @work_letters)
3393             )
3394             and
3395             (
3396             not ( @{$v[$countervertex]} ~~ @{$tempv[$countervertex]} )
3397             )
3398             )
3399             {
3400             my $printthis =
3401             "prj -file $to/cfg/$fileconfig -mode script<
3402              
3403             m
3404             c
3405             a
3406             $zone_letter
3407             d
3408             $vertexletter
3409             $v[$countervertex+1][0] $v[$countervertex+1][1] $v[$countervertex+1][2]
3410             -
3411             y
3412             -
3413             y
3414             c
3415             -
3416             -
3417             -
3418             -
3419             -
3420             -
3421             -
3422             -
3423             -
3424             YYY
3425             ";
3426             if ($exeonfiles eq "y")
3427             {
3428             print `$printthis`;
3429             }
3430              
3431             print TOSHELL $printthis;
3432             }
3433             $countervertex++;
3434             }
3435              
3436             } # END SUB apply_geo_constraints
3437              
3438             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING GEOMETRY
3439             ##############################################################################
3440             ##############################################################################
3441              
3442              
3443              
3444             ##############################################################################
3445             ##############################################################################
3446             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING CONTROLS
3447              
3448             sub vary_controls
3449             { # IT IS CALLED FROM THE MAIN FILE
3450             my $to = shift;
3451             my $fileconfig = shift;
3452             my $stepsvar = shift;
3453             my $counterzone = shift;
3454             my $counterstep = shift;
3455             my $exeonfiles = shift;
3456             my $swap = shift;
3457             my @applytype = @$swap;
3458             my $zone_letter = $applytype[$counterzone][3];
3459             my $swap = shift;
3460             my @vary_controls = @$swap;
3461              
3462              
3463             my $semaphore_zone;
3464             my $semaphore_dataloop;
3465             my $semaphore_massflow;
3466             my $counter_controlmass = -1;
3467             my $semaphore_setpoint;
3468             my $counterline = 0;
3469             my $doline;
3470             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
3471             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
3472             my $loop_hour = 2; # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
3473             # BUT ARE THE ONES USED IN THE OPTS CONSTRAINTS FILES.
3474             my $max_heating_power = 3;
3475             my $min_heating_power = 4;
3476             my $max_cooling_power = 5,
3477             my $min_cooling_power = 6;
3478             my $heating_setpoint = 7;
3479             my $cooling_setpoint = 8;
3480             my $flow_hour = 2;
3481             my $flow_setpoint = 3;
3482             my $flow_onoff = 4;
3483             my $flow_fraction = 5;
3484             my $loop_letter;
3485             my $loopcontrol_letter;
3486              
3487             my @group = @{$vary_controls[$counterzone]};
3488             my $sourcefile = $group[0];
3489             my $targetfile = $group[1];
3490             my $configfile = $group[2];
3491             my @buildbulk = @{$group[3]};
3492             my @flowbulk = @{$group[4]};
3493             my $countbuild = 0;
3494             my $countflow = 0;
3495              
3496             my $countcontrol = 0;
3497             my $sourceaddress = "$to$sourcefile";
3498             my $targetaddress = "$to$targetfile";
3499             my $configaddress = "$to$configfile";
3500              
3501             #@loopcontrol; # DON'T PUT "my" HERE.
3502             #@flowcontrol; # DON'T PUT "my" HERE.
3503             #@new_loopcontrols; # DON'T PUT "my" HERE.
3504             #@new_flowcontrols; # DON'T PUT "my" HERE.
3505             my @groupzone_letters;
3506             my @zone_period_letters;
3507             my @flow_letters;
3508             my @fileloopbulk;
3509             my @fileflowbulk;
3510              
3511             checkfile($sourceaddress, $targetaddress);
3512              
3513             if ($counterstep == 1)
3514             {
3515             read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3516             }
3517              
3518              
3519             calc_newctl($to, $fileconfig, $stepsvar, $counterzone, $counterstep, \@buildbulk,
3520             \@flowbulk, \@loopcontrol, \@flowcontrol);
3521              
3522              
3523              
3524             sub calc_newctl
3525             { # TO BE CALLED WITH: calc_newcontrols($to, $fileconfig, $stepsvar, $counterzone, $counterstep, \@buildbulk, \@flowbulk, \@loopcontrol, \@flowcontrol);
3526             # THIS COMPUTES CHANGES TO BE MADE TO CONTROLS BEFORE PROPAGATION OF CONSTRAINTS
3527             my $to = shift;
3528             my $fileconfig = shift;
3529             my $stepsvar = shift;
3530             my $counterzone = shift;
3531             my $counterstep = shift;
3532             my $swap = shift;
3533             my @buildbulk = @$swap;
3534             my $swap = shift;
3535             my @flowbulk = @$swap;
3536             my $swap = shift;
3537             my @loopcontrol = @$swap;
3538             my $swap = shift;
3539             my @flowcontrol = @$swap;
3540              
3541             my @new_loop_hours;
3542             my @new_max_heating_powers;
3543             my @new_min_heating_powers;
3544             my @new_max_cooling_powers;
3545             my @new_min_cooling_powers;
3546             my @new_heating_setpoints;
3547             my @new_cooling_setpoints;
3548             my @new_flow_hours;
3549             my @new_flow_setpoints;
3550             my @new_flow_onoffs;
3551             my @new_flow_fractions;
3552              
3553             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE CALCULATED.
3554             if ($stepsvar == 0) {$stepsvar = 1;}
3555             if ($stepsvar > 1)
3556             {
3557             foreach $each_buildbulk (@buildbulk)
3558             {
3559             my @askloop = @{$each_buildbulk};
3560             my $new_loop_letter = $askloop[0];
3561             my $new_loopcontrol_letter = $askloop[1];
3562             my $swing_loop_hour = $askloop[2];
3563             my $swing_max_heating_power = $askloop[3];
3564             my $swing_min_heating_power = $askloop[4];
3565             my $swing_max_cooling_power = $askloop[5];
3566             my $swing_min_cooling_power = $askloop[6];
3567             my $swing_heating_setpoint = $askloop[7];
3568             my $swing_cooling_setpoint = $askloop[8];
3569              
3570             my $countloop = 0; #IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
3571             foreach $each_loop (@loopcontrol) # THIS DISTRIBUTES THIS NESTED DATA STRUCTURES IN A FLAT MODE TO PAIR THE INPUT FILE, USER DEFINED ONE.
3572             {
3573             my $countcontrol = 0;
3574             @thisloop = @{$each_loop};
3575             # my $letterfile = $letters[$countloop];
3576             foreach $lp (@thisloop)
3577             {
3578             my @control = @{$lp};
3579             # my $letterfilecontrol = $period_letters[$countcontrol];
3580             $loop_letter = $loopcontrol[$countloop][$countcontrol][0];
3581             $loopcontrol_letter = $loopcontrol[$countloop][$countcontrol][1];
3582             if ( ( $new_loop_letter eq $loop_letter ) and ($new_loopcontrol_letter eq $loopcontrol_letter ) )
3583             {
3584             # print OUTFILE "YES!: \n\n\n";
3585             $loop_hour__ = $loopcontrol[$countloop][$countcontrol][$loop_hour];
3586             $max_heating_power__ = $loopcontrol[$countloop][$countcontrol][$max_heating_power];
3587             $min_heating_power__ = $loopcontrol[$countloop][$countcontrol][$min_heating_power];
3588             $max_cooling_power__ = $loopcontrol[$countloop][$countcontrol][$max_cooling_power];
3589             $min_cooling_power__ = $loopcontrol[$countloop][$countcontrol][$min_cooling_power];
3590             $heating_setpoint__ = $loopcontrol[$countloop][$countcontrol][$heating_setpoint];
3591             $cooling_setpoint__ = $loopcontrol[$countloop][$countcontrol][$cooling_setpoint];
3592             }
3593             $countcontrol++;
3594             }
3595             $countloop++;
3596             }
3597              
3598             my $pace_loop_hour = ( $swing_loop_hour / ($stepsvar - 1) );
3599             my $floorvalue_loop_hour = ($loop_hour__ - ($swing_loop_hour / 2) );
3600             my $new_loop_hour = $floorvalue_loop_hour + ($counterstep * $pace_loop_hour);
3601              
3602             my $pace_max_heating_power = ( $swing_max_heating_power / ($stepsvar - 1) );
3603             my $floorvalue_max_heating_power = ($max_heating_power__ - ($swing_max_heating_power / 2) );
3604             my $new_max_heating_power = $floorvalue_max_heating_power + ($counterstep * $pace_max_heating_power);
3605              
3606             my $pace_min_heating_power = ( $swing_min_heating_power / ($stepsvar - 1) );
3607             my $floorvalue_min_heating_power = ($min_heating_power__ - ($swing_min_heating_power / 2) );
3608             my $new_min_heating_power = $floorvalue_min_heating_power + ($counterstep * $pace_min_heating_power);
3609              
3610             my $pace_max_cooling_power = ( $swing_max_cooling_power / ($stepsvar - 1) );
3611             my $floorvalue_max_cooling_power = ($max_cooling_power__ - ($swing_max_cooling_power / 2) );
3612             my $new_max_cooling_power = $floorvalue_max_cooling_power + ($counterstep * $pace_max_cooling_power);
3613              
3614             my $pace_min_cooling_power = ( $swing_min_cooling_power / ($stepsvar - 1) );
3615             my $floorvalue_min_cooling_power = ($min_cooling_power__ - ($swing_min_cooling_power / 2) );
3616             my $new_min_cooling_power = $floorvalue_min_cooling_power + ($counterstep * $pace_min_cooling_power);
3617              
3618             my $pace_heating_setpoint = ( $swing_heating_setpoint / ($stepsvar - 1) );
3619             my $floorvalue_heating_setpoint = ($heating_setpoint__ - ($swing_heating_setpoint / 2) );
3620             my $new_heating_setpoint = $floorvalue_heating_setpoint + ($counterstep * $pace_heating_setpoint);
3621              
3622             my $pace_cooling_setpoint = ( $swing_cooling_setpoint / ($stepsvar - 1) );
3623             my $floorvalue_cooling_setpoint = ($cooling_setpoint__ - ($swing_cooling_setpoint / 2) );
3624             my $new_cooling_setpoint = $floorvalue_cooling_setpoint + ($counterstep * $pace_cooling_setpoint);
3625              
3626             $new_loop_hour = sprintf("%.2f", $new_loop_hour);
3627             $new_max_heating_power = sprintf("%.2f", $new_max_heating_power);
3628             $new_min_heating_power = sprintf("%.2f", $new_min_heating_power);
3629             $new_max_cooling_power = sprintf("%.2f", $new_max_cooling_power);
3630             $new_min_cooling_power = sprintf("%.2f", $new_min_cooling_power);
3631             $new_heating_setpoint = sprintf("%.2f", $new_heating_setpoint);
3632             $new_cooling_setpoint = sprintf("%.2f", $new_cooling_setpoint);
3633              
3634             push(@new_loopcontrols,
3635             [ $new_loop_letter, $new_loopcontrol_letter, $new_loop_hour,
3636             $new_max_heating_power, $new_min_heating_power, $new_max_cooling_power,
3637             $new_min_cooling_power, $new_heating_setpoint, $new_cooling_setpoint ] );
3638             }
3639              
3640             my $countflow = 0;
3641              
3642             foreach my $elm (@flowbulk)
3643             {
3644             my @askflow = @{$elm};
3645             my $new_flow_letter = $askflow[0];
3646             my $new_flowcontrol_letter = $askflow[1];
3647             my $swing_flow_hour = $askflow[2];
3648             my $swing_flow_setpoint = $askflow[3];
3649             my $swing_flow_onoff = $askflow[4];
3650             if ( $swing_flow_onoff eq "ON") { $swing_flow_onoff = 1; }
3651             elsif ( $swing_flow_onoff eq "OFF") { $swing_flow_onoff = -1; }
3652             my $swing_flow_fraction = $askflow[5];
3653              
3654             my $countflow = 0; # IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
3655             foreach $each_flow (@flowcontrol) # THIS DISTRIBUTES THOSE NESTED DATA STRUCTURES IN A FLAT MODE TO PAIR THE INPUT FILE, USER DEFINED ONE.
3656             {
3657             my $countcontrol = 0;
3658             @thisflow = @{$each_flow};
3659             # my $letterfile = $letters[$countflow];
3660             foreach $elm (@thisflow)
3661             {
3662             my @control = @{$elm};
3663             # my $letterfilecontrol = $period_letters[$countcontrol];
3664             $flow_letter = $flowcontrol[$countflow][$countcontrol][0];
3665             $flowcontrol_letter = $flowcontrol[$countflow][$countcontrol][1];
3666             if ( ( $new_flow_letter eq $flow_letter ) and ($new_flowcontrol_letter eq $flowcontrol_letter ) )
3667             {
3668             $flow_hour__ = $flowcontrol[$countflow][$countcontrol][$flow_hour];
3669             $flow_setpoint__ = $flowcontrol[$countflow][$countcontrol][$flow_setpoint];
3670             $flow_onoff__ = $flowcontrol[$countflow][$countcontrol][$flow_onoff];
3671             if ( $flow_onoff__ eq "ON") { $flow_onoff__ = 1; }
3672             elsif ( $flow_onoff__ eq "OFF") { $flow_onoff__ = -1; }
3673             $flow_fraction__ = $flowcontrol[$countflow][$countcontrol][$flow_fraction];
3674             }
3675             $countcontrol++;
3676             }
3677             $countflow++;
3678             }
3679            
3680             my $pace_flow_hour = ( $swing_flow_hour / ($stepsvar - 1) );
3681             my $floorvalue_flow_hour = ($flow_hour__ - ($swing_flow_hour / 2) );
3682             my $new_flow_hour = $floorvalue_flow_hour + ($counterstep * $pace_flow_hour);
3683              
3684             my $pace_flow_setpoint = ( $swing_flow_setpoint / ($stepsvar - 1) );
3685             my $floorvalue_flow_setpoint = ($flow_setpoint__ - ($swing_flow_setpoint / 2) );
3686             my $new_flow_setpoint = $floorvalue_flow_setpoint + ($counterstep * $pace_flow_setpoint);
3687              
3688             my $pace_flow_onoff = ( $swing_flow_onoff / ($stepsvar - 1) );
3689             my $floorvalue_flow_onoff = ($flow_onoff__ - ($swing_flow_onoff / 2) );
3690             my $new_flow_onoff = $floorvalue_flow_onoff + ($counterstep * $pace_flow_onoff);
3691              
3692             my $pace_flow_fraction = ( $swing_flow_fraction / ($stepsvar - 1) );
3693             my $floorvalue_flow_fraction = ($flow_fraction__ - ($swing_flow_fraction / 2) );
3694             my $new_flow_fraction = $floorvalue_flow_fraction + ($counterstep * $pace_flow_fraction);
3695              
3696             $new_flow_hour = sprintf("%.2f", $new_flow_hour);
3697             $new_flow_setpoint = sprintf("%.2f", $new_flow_setpoint);
3698             $new_flow_onoff = sprintf("%.2f", $new_flow_onoff);
3699             $new_flow_fraction = sprintf("%.2f", $new_flow_fraction);
3700              
3701             push(@new_flowcontrols,
3702             [ $new_flow_letter, $new_flowcontrol_letter, $new_flow_hour, $new_flow_setpoint, $new_flow_onoff, $new_flow_fraction ] );
3703             }
3704             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE APPLIED TO THE MODELS THROUGH ESP-r.
3705             # FIRST, HERE THEY ARE APPLIED TO THE ZONE CONTROLS, THEN TO THE FLOW CONTROLS
3706             }
3707             } # END SUB calc_newcontrols
3708              
3709             print OUTFILE "\@new_loopcontrols: " . Dumper(@new_loopcontrols) . "\n\n";
3710              
3711             apply_loopcontrol_changes($exeonfiles, \@new_loopcontrols);
3712             apply_flowcontrol_changes($exeonfiles, \@new_flowcontrols);
3713              
3714             } # END SUB vary_controls.
3715              
3716              
3717             sub constrain_controls
3718             { # IT READS CONTROL USER-IMPOSED CONSTRAINTS
3719             my $to = shift;
3720             my $fileconfig = shift;
3721             my $stepsvar = shift;
3722             my $counterzone = shift;
3723             my $counterstep = shift;
3724             my $exeonfiles = shift;
3725             my $swap = shift;
3726             my @applytype = @$swap;
3727             my $zone_letter = $applytype[$counterzone][3];
3728             my $swap = shift;
3729             my @constrain_controls = @$swap;
3730             my $to_do = shift;
3731              
3732              
3733             my $elm = $constrain_controls[$counterzone];
3734             my @group = @{$elm};
3735             my $sourcefile = $group[2];
3736             my $targetfile = $group[3];
3737             my $configfile = $group[4];
3738             my $sourceaddress = "$to$sourcefile";
3739             my $targetaddress = "$to$targetfile";
3740             my $configaddress = "$to$configfile";
3741             #@loopcontrol; @flowcontrol; @new_loopcontrols; @new_flowcontrols; # DON'T PUT "my" HERE. THEY ARE GLOBAL!!!
3742             my $semaphore_zone;
3743             my $semaphore_dataloop;
3744             my $semaphore_massflow;
3745             my $counter_controlmass = -1;
3746             my $semaphore_setpoint;
3747             my $counterline = 0;
3748             my $doline;
3749             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
3750             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
3751             my $loop_hour = 2; # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
3752             # BUT ARE THE ONES USED IN THE OPTS CONSTRAINTS FILES.
3753             my $max_heating_power = 3;
3754             my $min_heating_power = 4;
3755             my $max_cooling_power = 5,
3756             my $min_cooling_power = 6;
3757             my $heating_setpoint = 7;
3758             my $cooling_setpoint = 8;
3759             my $flow_hour = 2;
3760             my $flow_setpoint = 3;
3761             my $flow_onoff = 4;
3762             my $flow_fraction = 5;
3763             my $loop_letter;
3764             my $loopcontrol_letter;
3765             my $countbuild = 0;
3766             my $countflow = 0;
3767             my $countcontrol = 0;
3768              
3769             my @groupzone_letters;
3770             my @zone_period_letters;
3771             my @flow_letters;
3772             my @fileloopbulk;
3773             my @fileflowbulk;
3774              
3775             unless ($to_do eq "justwrite")
3776             {
3777             if ($counterstep == 1)
3778             {
3779             print OUTFILE "THIS\n";
3780             checkfile($sourceaddress, $targetaddress);
3781             read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3782             read_control_constraints($to, $fileconfig, $stepsvar,
3783             $counterzone, $counterstep, $configaddress, \@loopcontrol, \@flowcontrol, \@temploopcontrol, \@tempflowcontrol);
3784             }
3785             }
3786              
3787             unless ($to_do eq "justread")
3788             {
3789             print OUTFILE "THAT\n";
3790             apply_loopcontrol_changes($exeonfiles, \@new_loopcontrol, \@temploopcontrol);
3791             apply_flowcontrol_changes($exeonfiles, \@new_flowcontrol, \@tempflowcontrol);
3792             }
3793              
3794             } # END SUB constrain_controls.
3795              
3796              
3797             sub read_controls
3798             { # TO BE CALLED WITH: read_controls($sourceaddress, $targetaddress, \@letters, \@period_letters);
3799             # THIS MAKES THE CONTROL CONFIGURATION FILE BE READ AND THE NEEDED VALUES ACQUIRED.
3800             # NOTICE THAT CURRENTLY ONLY THE "basic control law" IS SUPPORTED.
3801              
3802             my $sourceaddress = shift;
3803             my $targetaddress = shift;
3804             # checkfile($sourceaddress, $targetaddress); # THIS HAS TO BE _FIXED!_
3805             my $swap = shift;
3806             my @letters = @$swap;
3807             my $swap = shift;
3808             my @period_letters = @$swap;
3809              
3810              
3811             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourceaddress: $!\n";
3812             my @lines = ;
3813             close SOURCEFILE;
3814             my $counterlines = 0;
3815             my $countloop = -1;
3816             my $countloopcontrol;
3817             my $countflow = -1;
3818             my $countflowcontrol = -1;
3819             my $semaphore_building;
3820             my $semaphore_loop;
3821             my $loop_hour;
3822             my $semaphore_loopcontrol;
3823             my $semaphore_massflow;
3824             my $flow_hour;
3825             my $semaphore_flow;
3826             my $semaphore_flowcontrol;
3827             my $loop_letter;
3828             my $loopcontrol_letter;
3829             my $flow_letter;
3830             my $flowcontrol_letter;
3831              
3832             foreach my $line (@lines)
3833             {
3834             if ( $line =~ /Control function/ )
3835             {
3836             $semaphore_loop = "yes";
3837             $countloopcontrol = -1;
3838             $countloop++;
3839             $loop_letter = $letters[$countloop];
3840             }
3841             if ( ($line =~ /ctl type, law/ ) )
3842             {
3843             $countloopcontrol++;
3844             my @row = split(/\s+/, $line);
3845             $loop_hour = $row[3];
3846             $semaphore_loopcontrol = "yes";
3847             $loopcontrol_letter = $period_letters[$countloopcontrol];
3848             }
3849              
3850             if ( ($semaphore_loop eq "yes") and ($semaphore_loopcontrol eq "yes") and ($line =~ /No. of data items/ ) )
3851             {
3852             $doline = $counterlines + 1;
3853             }
3854              
3855             if ( ($semaphore_loop eq "yes" ) and ($semaphore_loopcontrol eq "yes") and ($counterlines == $doline) )
3856             {
3857             my @row = split(/\s+/, $line);
3858             my $max_heating_power = $row[1];
3859             my $min_heating_power = $row[2];
3860             my $max_cooling_power = $row[3];
3861             my $min_cooling_power = $row[4];
3862             my $heating_setpoint = $row[5];
3863             my $cooling_setpoint = $row[6];
3864              
3865             push(@{$loopcontrol[$countloop][$countloopcontrol]},
3866             $loop_letter, $loopcontrol_letter, $loop_hour,
3867             $max_heating_power, $min_heating_power, $max_cooling_power,
3868             $min_cooling_power, $heating_setpoint, $cooling_setpoint );
3869              
3870             $semaphore_loopcontrol = "no";
3871             $doline = "";
3872             }
3873              
3874             if ($line =~ /Control mass/ )
3875             {
3876             $semaphore_flow = "yes";
3877             $countflowcontrol = -1;
3878             $countflow++;
3879             $flow_letter = $letters[$countflow];
3880             }
3881             if ( ($line =~ /ctl type \(/ ) )
3882             {
3883             $countflowcontrol++;
3884             my @row = split(/\s+/, $line);
3885             $flow_hour = $row[3];
3886             $semaphore_flowcontrol = "yes";
3887             $flowcontrol_letter = $period_letters[$countflowcontrol];
3888             }
3889              
3890             if ( ($semaphore_flow eq "yes") and ($semaphore_flowcontrol eq "yes") and ($line =~ /No. of data items/ ) )
3891             {
3892             $doline = $counterlines + 1;
3893             }
3894              
3895             if ( ($semaphore_flow eq "yes" ) and ($semaphore_flowcontrol eq "yes") and ($counterlines == $doline) )
3896             {
3897             my @row = split(/\s+/, $line);
3898             my $flow_setpoint = $row[1];
3899             my $flow_onoff = $row[2];
3900             my $flow_fraction = $row[3];
3901             push(@{$flowcontrol[$countflow][$countflowcontrol]},
3902             $flow_letter, $flowcontrol_letter, $flow_hour, $flow_setpoint, $flow_onoff, $flow_fraction);
3903             $semaphore_flowcontrol = "no";
3904             $doline = "";
3905             }
3906             $counterlines++;
3907             }
3908             } # END SUB read_controls.
3909              
3910              
3911             sub read_control_constraints
3912             {
3913             # #!/usr/bin/perl
3914             # THIS FILE CAN CONTAIN USER-IMPOSED CONSTRAINTS FOR CONTROLS TO BE READ BY OPTS.
3915             # THE FOLLOWING VALUES CAN BE ADDRESSED IN THE OPTS CONSTRAINTS CONFIGURATION FILE,
3916             # SET BY THE PRESENT FUNCTION:
3917             # 1) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$loop_hour]
3918             # Where $countloop and $countloopcontrol has to be set to a specified number in the OPTS file for constraints.
3919             # 2) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$max_heating_power] # Same as above.
3920             # 3) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$min_heating_power] # Same as above.
3921             # 4) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$max_cooling_power] # Same as above.
3922             # 5) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$min_cooling_power] # Same as above.
3923             # 6) $loopcontrol[$counterzone][$countloop][$countloopcontrol][heating_setpoint] # Same as above.
3924             # 7) $loopcontrol[$counterzone][$countloop][$countloopcontrol][cooling_setpoint] # Same as above.
3925             # 8) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_hour]
3926             # Where $countflow and $countflowcontrol has to be set to a specified number in the OPTS file for constraints.
3927             # 9) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_setpoint] # Same as above.
3928             # 10) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_onoff] # Same as above.
3929             # 11) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_fraction] # Same as above.
3930             # EXAMPLE : $flowcontrol[0][1][2][$flow_fraction] = 0.7
3931             # OTHER EXAMPLE: $flowcontrol[2][1][2][$flow_fraction] = $flowcontrol[0][2][1][$flow_fraction]
3932             # The $counterzone that is actuated is always the last, the one which is active.
3933             # It would have therefore no sense writing $flowcontrol[1][1][2][$flow_fraction] = $flowcontrol[3][2][1][$flow_fraction].
3934             # Differentent $counterzones can be referred to the same zone. Different $counterzones just number mutations in series.
3935             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
3936             # AND THE STEPS THE MODEL HAS TO FOLLOW.
3937             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
3938             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
3939             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
3940             # $counterzone, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
3941             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $counterzone WILL CONTAIN ONE OR MORE ITERATION STEPS.
3942             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
3943             # THE OTHER ARE APPLIED TO THE SAME ZONE.
3944             # $counterstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
3945             my $to = shift;
3946             my $fileconfig = shift;
3947             my $stepsvar = shift;
3948             my $counterzone = shift;
3949             my $counterstep = shift;
3950             my $configaddress = shift;
3951             my $swap = shift;
3952             @loopcontrol = @$swap;
3953             my $swap = shift;
3954             @flowcontrol = @$swap;
3955             my $swap = shift;
3956             @temploopcontrol = @$swap;
3957             my $swap = shift;
3958             @tempflowcontrol = @$swap;
3959              
3960             if (-e $configaddress) # TEST THIS, DDD
3961             { # THIS APPLIES CONSTRAINST, THE FLATTEN THE HIERARCHICAL STRUCTURE OF THE RESULTS,
3962             # TO BE PREPARED THEN FOR BEING APPLIED TO CHANGE PROCEDURES. IT HAS TO BE TESTED.
3963             push (@loopcontrol, [@myloopcontrol]); #
3964             push (@flowcontrol, [@myflowcontrol]); #
3965              
3966             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
3967             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
3968              
3969             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
3970             # FOR PROPAGATION OF CONSTRAINTS
3971              
3972             @doloopcontrol = @{$loopcontrol[$#loopcontrol]}; #
3973             @doflowcontrol = @{$flowcontrol[$#flowcontrol]}; #
3974              
3975             shift (@doloopcontrol);
3976             shift (@doflowcontrol);
3977              
3978             sub flatten_loopcontrol_constraints
3979             {
3980             my @looptemp = @doloopcontrol;
3981             @new_loopcontrol = "";
3982             foreach my $elm (@looptemp)
3983             {
3984             my @loop = @{$elm};
3985             foreach my $elm (@loop)
3986             {
3987             my @loop = @{$elm};
3988             push (@new_loopcontrol, [@loop]);
3989             }
3990             }
3991             }
3992             flatten_loopcontrol_constraints;
3993              
3994             sub flatten_flowcontrol_constraints
3995             {
3996             my @flowtemp = @doflowcontrol;
3997             @new_flowcontrol = "";
3998             foreach my $elm (@flowtemp)
3999             {
4000             my @flow = @{$elm};
4001             foreach my $elm (@flow)
4002             {
4003             my @loop = @{$elm};
4004             push (@new_flowcontrol, [@flow]);
4005             }
4006             }
4007             }
4008             flatten_flowcontrol_constraints;
4009              
4010             shift @new_loopcontrol;
4011             shift @new_flowcontrol;
4012             }
4013             } # END SUB read_control_constraints
4014              
4015              
4016             sub apply_loopcontrol_changes
4017             { # TO BE CALLED WITH: apply_loopcontrol_changes($exeonfiles, \@new_loopcontrol);
4018             # THIS APPLIES CHANGES TO LOOPS IN CONTROLS (ZONES)
4019             my $exeonfiles = shift;
4020             my $swap = shift;
4021             my @new_loop_ctls = @$swap;
4022             my $swap = shift;
4023             my @temploopcontrol = @$swap;
4024             my $counterloop = 0;
4025              
4026             foreach my $elm (@new_loop_ctls)
4027             {
4028             my @loop = @{$elm};
4029             $new_loop_letter = $loop[0];
4030             $new_loopcontrol_letter = $loop[1];
4031             $new_loop_hour = $loop[2];
4032             $new_max_heating_power = $loop[3];
4033             $new_min_heating_power = $loop[4];
4034             $new_max_cooling_power = $loop[5];
4035             $new_min_cooling_power = $loop[6];
4036             $new_heating_setpoint = $loop[7];
4037             $new_cooling_setpoint = $loop[8];
4038             unless ( @{$new_loop_ctls[$counterloop]} ~~ @{$temploopcontrol[$counterloop]} )
4039             {
4040             my $printthis =
4041             "prj -file $to/cfg/$fileconfig -mode script<
4042              
4043             m
4044             j
4045              
4046             $new_loop_letter
4047             c
4048             $new_loopcontrol_letter
4049             1
4050             $new_loop_hour
4051             b
4052             $new_max_heating_power
4053             c
4054             $new_min_heating_power
4055             d
4056             $new_max_cooling_power
4057             e
4058             $new_min_cooling_power
4059             f
4060             $new_heating_setpoint
4061             g
4062             $new_cooling_setpoint
4063             -
4064             y
4065             -
4066             -
4067             -
4068             n
4069             d
4070              
4071             -
4072             y
4073             y
4074             -
4075             -
4076             YYY
4077             ";
4078             if ($exeonfiles eq "y")
4079             {
4080             print `$printthis`;
4081             }
4082             print TOSHELL $printthis;
4083             }
4084             $counterloop++;
4085             }
4086             } # END SUB apply_loopcontrol_changes();
4087              
4088              
4089              
4090              
4091             sub apply_flowcontrol_changes
4092             { # THIS HAS TO BE CALLED WITH: apply_flowcontrol_changes($exeonfiles, \@new_flowcontrols);
4093             # # THIS APPLIES CHANGES TO NETS IN CONTROLS
4094             my $exeonfiles = shift;
4095             my $swap = shift;
4096             my @new_flowcontrols = @$swap;
4097             my $swap = shift;
4098             my @tempflowcontrol = @$swap;
4099             my $counterflow = 0;
4100              
4101             foreach my $elm (@new_flowcontrols)
4102             {
4103             my @flow = @{$elm};
4104             $flow_letter = $flow[0];
4105             $flowcontrol_letter = $flow[1];
4106             $new_flow_hour = $flow[2];
4107             $new_flow_setpoint = $flow[3];
4108             $new_flow_onoff = $flow[4];
4109             $new_flow_fraction = $flow[5];
4110             unless ( @{$new_flowcontrols[$counterflow]} ~~ @{$tempflowcontrol[$counterflow]} )
4111             {
4112             my $printthis =
4113             "prj -file $to/cfg/$fileconfig -mode script<
4114              
4115             m
4116             l
4117              
4118             $flow_letter
4119             c
4120             $flowcontrol_letter
4121             a
4122             $new_flow_hour
4123             $new_flow_setpoint $new_flow_onoff $new_flow_fraction
4124             -
4125             -
4126             -
4127             y
4128             y
4129             -
4130             -
4131             YYY
4132             ";
4133             if ($exeonfiles eq "y") # if ($exeonfiles eq "y")
4134             {
4135             print `$printthis`;
4136             }
4137              
4138             print TOSHELL $printthis;
4139             }
4140             $counterflow++;
4141             }
4142             } # END SUB apply_flowcontrol_changes;
4143              
4144             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING CONTROLS
4145             ##############################################################################
4146             ##############################################################################
4147              
4148              
4149              
4150              
4151              
4152             ##############################################################################
4153             ##############################################################################
4154             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING OBSTRUCTIONS
4155              
4156             sub constrain_obstructions # IT APPLIES CONSTRAINTS TO OBSTRUCTIONS
4157             {
4158             # THIS CONSTRAINS OBSTRUCTION FILES. IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
4159             # constrain_obstruction($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $exeonfiles, \@applytype, \@constrain_obstructions);
4160             my $to = shift;
4161             my $fileconfig = shift;
4162             my $stepsvar = shift;
4163             my $counterzone = shift;
4164             my $counterstep = shift;
4165             my $exeonfiles = shift;
4166             my $swap = shift;
4167             my @applytype = @$swap;
4168             my $zone_letter = $applytype[$counterzone][3];
4169             my $swap2 = shift;
4170             my @constrain_obstructions = @$swap2;
4171             my $to_do = shift;
4172              
4173              
4174             my @work_letters;
4175             #@obs; # GLOBAL!
4176              
4177             foreach my $elm (@constrain_obstructions)
4178             {
4179             my @group = @{$elm};
4180             my $zone_letter = $group[1];
4181             my $sourcefile = $group[2];
4182             my $targetfile = $group[3];
4183             my $configfile = $group[4];
4184             my $sourceaddress = "$to$sourcefile";
4185             my $targetaddress = "$to$targetfile";
4186             my $configaddress = "$to$configfile";
4187             my @work_letters = @{$group[5]};
4188             my $actonmaterials = $group[6];
4189              
4190             unless ($to_do eq "justwrite")
4191             {
4192             checkfile($sourceaddress, $targetaddress);
4193             read_obstructions($to, $sourceaddress, $targetaddress, $configaddress, \@work_letters, $actonmaterials, $exeonfiles);
4194             read_obs_constraints($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $configaddress, $actonmaterials, $exeonfiles, \@tempobs); # IT WORKS ON THE VARIABLE @obs, WHICH IS GLOBAL.
4195             }
4196              
4197             unless ($to_do eq "justread")
4198             {
4199             apply_obs_constraints(\@doobs, \@obs_letters, \@work_letters, $exeonfiles, $zone_letter, $actonmaterials, $exeonfiles, \@tempobs);
4200             }
4201             }
4202             } # END SUB constrain_obstructions
4203              
4204              
4205             sub read_obstructions
4206             {
4207             # THIS READS GEOMETRY FILES. # IT HAS TO BE CALLED WITH:
4208             # read_geometry($to, $sourcefile, $targetfile, $configfiles, \@work_letters, $longmenus);
4209             my $to = shift;
4210             my $sourceaddress = shift;
4211             my $targetaddress = shift;
4212             my $configaddress = shift;
4213             my $swap = shift;
4214             @work_letters = @$swap;
4215             my $actonmaterials = shift;
4216             my $exeonfiles = shift;
4217              
4218            
4219             open( SOURCEFILE, $sourceaddress) or die "Can't open $sourceaddress: $!\n";
4220             my @lines = ;
4221             close SOURCEFILE;
4222              
4223             my $counter = 0;
4224             foreach my $line (@lines)
4225             {
4226             #$line =~ s/^\s+//;
4227             if ( $line =~ m/\*obs/ )
4228             {
4229             unless ( $line =~ m/\*obs =/ )
4230             {
4231             $counter++;
4232             }
4233             }
4234             }
4235              
4236             if ( $counter > 21 )
4237             {
4238             @obs_letters = ("e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
4239             "o", "0\nb\nf", "0\nb\ng", "0\nb\nh", "0\nb\ni", "0\nb\nj", "0\nb\nk", "0\nb\nm",
4240             "0\nb\nn", "0\nb\no", "0\nb\n0\nb\nf","0\nb\n0\nb\ng",
4241             "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",
4242             "0\nb\n0\nb\nm","0\nb\n0\nb\nn","0\nb\n0\nb\no","0\nb\n0\nb\n0\nb\nf",
4243             "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",
4244             "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",
4245             "0\nb\n0\nb\n0\nb\no");
4246             }
4247             else
4248             {
4249             @obs_letters = ("e", "f", "g", "h", "i", "j", "k", "l", "m",
4250             "n", "o", "0\nf", "0\ng", "0\nh", "0\ni", "0\nj", "0\nk", "0\nl",
4251             "0\nm", "0\nn", "0\no");
4252             }
4253              
4254             my $counter = 0;
4255             foreach my $line (@lines)
4256             {
4257             if ( $line =~ m/\*obs/ )
4258             {
4259             unless ( $line =~ m/\*obs =/ )
4260             {
4261             #$line =~ s/^\s+//;
4262             my @rowelements = split(/,/, $line);
4263             push (@obs, [ $rowelements[1], $rowelements[2], $rowelements[3],
4264             $rowelements[4], $rowelements[5], $rowelements[6],
4265             $rowelements[7], $rowelements[8], $rowelements[9],
4266             $rowelements[10], $rowelements[11], $rowelements[12], $obs_letters[$counter] ] );
4267             $counter++;
4268             }
4269             }
4270             }
4271             } # END SUB read_obstructions
4272              
4273              
4274             sub read_obs_constraints
4275             {
4276             # THE VARIABLE @obs REGARDS OBSTRUCTION USER-IMPOSED CONSTRAINTS
4277             # THIS CONSTRAINT CONFIGURATION FILE MAKES AVAILABLE TO THE USER THE FOLLOWING VARIABLES:
4278             # $obs[$counterzone][$obs_number][$x], $obs[$counterzone][$obs_number][$y], $obs[$counterzone][$obs_number][$y]
4279             # $obs[$counterzone][$obs_number][$width], $obs[$counterzone][$obs_number][$depth], $obs[$counterzone][$obs_number][$height]
4280             # $obs[$counterzone][$obs_number][$z_rotation], $obs[$counterzone][$obs_number][$y_rotation],
4281             # $obs[$counterzone][$obs_number][$tilt], $obs[$counterzone][$obs_number][$opacity], $obs[$counterzone][$obs_number][$material],
4282             # EXAMPLE: $obs[0][2][$x] = 2. THIS MEANS: AT COUNTERZONE 0, COORDINATE x OF OBSTRUCTION HAS TO BE SET TO 2.
4283             # OTHER EXAMPLE: $obs[0][2][$x] = $obs[2][2][$y].
4284             # The $counterzone that is actuated is always the last, the one which is active.
4285             # There would be therefore no sense in writing $obs[0][4][$x] = $obs[1][2][$y].
4286             # Differentent $counterzones can be referred to the same zone. Different $counterzones just number mutations in series.
4287             # NOTE THAT THE MATERIAL TO BE SPECIFIED IS A MATERIAL LETTER, BETWEEN QUOTES. EXAMPLE: $obs[1][$material] = "a".
4288             # $tilt IS PRESENTLY UNUSED.
4289             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
4290             # AND THE STEPS THE MODEL HAVE TO FOLLOW.
4291             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
4292             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
4293             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
4294             # $counterzone, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
4295             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $counterzone WILL CONTAIN ONE OR MORE ITERATION STEPS.
4296             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
4297             # THE OTHER ARE APPLIED TO THE SAME ZONE.
4298             # $counterstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
4299             my $to = shift;
4300             my $fileconfig = shift;
4301             my $stepsvar = shift;
4302             my $counterzone = shift;
4303             my $counterstep = shift;
4304             my $configaddress = shift;
4305             my $actonmaterials = shift;
4306             my $exeonfiles = shift;
4307             my $swap = shift;
4308             @tempobs = @$swap;
4309              
4310             my $obs_letter = 13;
4311             my $x = 1;
4312             my $y = 2;
4313             my $z = 3;
4314             my $width = 4;
4315             my $depth = 5;
4316             my $height = 6;
4317             my $z_rotation = 7;
4318             my $y_rotation = 8;
4319             my $tilt = 9; # UNUSED
4320             my $opacity = 10;
4321             my $name = 11; # NOT TO BE CHANGED
4322             my $material = 12;
4323             if (-e $configaddress)
4324             {
4325             unshift (@obs, []);
4326             push (@obs, [@myobs]); #
4327             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS IS EVALUATED.
4328              
4329             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
4330             # FOR PROPAGATION OF CONSTRAINTS
4331              
4332             @doobs = @{$obs[$#obs]}; #
4333             shift @doobs;
4334             }
4335             } # END SUB read_geo_constraints
4336              
4337              
4338             sub apply_obs_constraints
4339             {
4340             # IT APPLY USER-IMPOSED CONSTRAINTS TO A GEOMETRY FILES VIA SHELL
4341             # IT HAS TO BE CALLED WITH:
4342             # apply_geo_constraints(\@obs, \@obsletters, \@work_letters, \$exeonfiles, \$zone_letter, $actonmaterials);
4343             my $swap = shift;
4344             my @obs = @$swap;
4345             my $swap = shift;
4346             my @obs_letters = @$swap;
4347             my $swap = shift;
4348             my @work_letters = @$swap;
4349             my $exeonfiles = shift;
4350             my $zone_letter = shift;
4351             #print OUTFILE "ZONE LETTER: $zone_letter\n\n";
4352             my $actonmaterials = shift;
4353             my $exeonfiles = shift;
4354             my $swap = shift;
4355             my @tempobs = @$swap;
4356              
4357              
4358             my $counterobs = 0;
4359             print OUTFILE "OBS_LETTERS IN APPLY" . Dumper(@obs_letters) . "\n\n";
4360             foreach my $ob (@obs)
4361             {
4362             my $obs_letter = $obs_letters[$counterobs];
4363             if ( ( @work_letters eq "") or ($obs_letter ~~ @work_letters))
4364             {
4365             my @obstr = @{$ob};
4366             my $x = $obstr[0];
4367             my $y = $obstr[1];
4368             my $z = $obstr[2];
4369             my $width = $obs[3];
4370             my $depth = $obs[4];
4371             my $height = $obs[5];
4372             my $z_rotation = $obs[6];
4373             my $y_rotation = $obs[7];
4374             my $tilt = $obs[8];
4375             my $opacity = $obs[9];
4376             my $name = $obs[10];
4377             my $material = $obs[11];
4378             unless
4379             (
4380             ( @{$obs[$counterobs]} ~~ @{$tempobs[$counterobs]} )
4381             )
4382             {
4383             my $printthis =
4384             "prj -file $to/cfg/$fileconfig -mode script<
4385              
4386             m
4387             c
4388             a
4389             $zone_letter
4390             h
4391             a
4392             $obs_letter
4393             a
4394             a
4395             $x $y $z
4396             b
4397             $width $depth $height
4398             c
4399             $z_rotation
4400             d
4401             $y_rotation
4402             e # HERE THE DATUM IS STILL UNUSED. WHEN IT WILL, A LINE MUST BE ADDED WITH THE VARIABLE $tilt.
4403             h
4404             $opacity
4405             -
4406             -
4407             c
4408             -
4409             c
4410             -
4411             -
4412             -
4413             -
4414             YYY
4415             ";
4416             if ($exeonfiles eq "y")
4417             {
4418             print `$printthis`;
4419             }
4420              
4421             print TOSHELL $printthis;
4422             }
4423              
4424             my $obs_letter = $obs_letters[$counterobs];
4425             if ($obs_letter ~~ @work_letters)
4426             {
4427             if ($actonmaterials eq "y")
4428             {
4429             my $printthis =
4430             "prj -file $to/cfg/$fileconfig -mode script<
4431              
4432             m
4433             c
4434             a
4435             $zone_letter
4436             h
4437             a
4438             $obs_letter
4439             g
4440             $material
4441             -
4442             -
4443             -
4444             c
4445             -
4446             c
4447             -
4448             -
4449             -
4450             -
4451             YYY
4452             ";
4453             if ($exeonfiles eq "y")
4454             {
4455             print `$printthis`;
4456             }
4457              
4458             print TOSHELL $printthis;
4459             }
4460             }
4461             }
4462             $counterobs++;
4463             }
4464             } # END SUB apply_obs_constraints
4465              
4466              
4467             ############################################################## BEGINNING OF GROUP GET AND PIN OBSTRUCTIONS
4468             sub get_obstructions # IT APPLIES CONSTRAINTS TO ZONE GEOMETRY. TO DO. STILL UNUSED.
4469             # THE SAME FUNCTIONALITIES CAN BE OBTAINED, WITH MORE WORK, BY SPECIFYING APPROPRIATE SETTINGS IN THE OPTS CONFIG FILE.
4470             {
4471             # THIS CONSTRAINS OBSTRUCTION FILES. IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
4472             # constrain_obstruction($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $exeonfiles, \@applytype, \@constrain_obstructions);
4473             my $to = shift;
4474             my $fileconfig = shift;
4475             my $stepsvar = shift;
4476             my $counterzone = shift;
4477             my $counterstep = shift;
4478             my $exeonfiles = shift;
4479             my $swap = shift;
4480             my @applytype = @$swap;
4481             my $zone_letter = $applytype[$counterzone][3];
4482             my $swap2 = shift;
4483             my @get_obstructions = @$swap2;
4484              
4485              
4486             my @work_letters ;
4487             @obs; # GLOBAL!
4488             foreach my $elm (@constrain_obstructions)
4489             {
4490             my @group = @{$elm};
4491             my $zone_letter = $group[1];
4492             my $sourcefile = $group[2];
4493             my $targetfile = $group[3];
4494             my $sourceaddress = "$to$sourcefile";
4495             my $targetaddress = "$to$targetfile";
4496             my $temp = $group[4];
4497             my @work_letters = @{$group[5]};
4498             my @obs_letters;
4499             checkfile($sourceaddress, $targetaddress);
4500             read_obstructions($to, $sourceaddress, $targetaddress, $configaddress, \@work_letters);
4501             write_temporary(\@obs, \@obs_letters, \@work_letters, $exeonfiles, $zone_letter, $temp);
4502             }
4503             } # END SUB constrain_obstructions
4504              
4505              
4506             sub write_temporary
4507             {
4508             # IT APPLY USER-IMPOSED CONSTRAINTS TO A GEOMETRY FILES VIA SHELL. TO DO. STILL UNUSED. ZZZ
4509             # IT HAS TO BE CALLED WITH:
4510             # apply_geo_constraints(\obs, \@obsletters, \@work_letters, \$exeonfiles, \$zone_letter, $actonmaterials);
4511             my $swap = shift;
4512             my @obs = @$swap;
4513             my $swap = shift;
4514             my @obs_letters = @$swap;
4515             my $swap = shift;
4516             my @work_letters = @$swap;
4517             my $exeonfiles = shift;
4518             my $zone_letter = shift;
4519             my $temp = shift;
4520             my $toshell = shift;
4521             my $outfile = shift;
4522             my $configfile = shift;
4523              
4524              
4525              
4526              
4527             open( SOURCEFILE, ">$temp" ) or die "Can't open $temp: $!\n";
4528             my $counterobs = 0;
4529              
4530             foreach my $ob (@obs)
4531             {
4532             my $obs_letter = $obs_letters[$counterobs];
4533             if ($obs_letter ~~ @work_letters)
4534             {
4535             my @obs = @{$ob};
4536             print SOURCEFILE . "*obs $obs[1] $obs[2] $obs[3] $obs[4] $obs[5] $obs[6] $obs[7] $obs[8] $obs[10] $obs[11] $obs[12] $obs_letter\n";
4537             }
4538             $counterobs++;
4539             close SOURCEFILE;
4540             }
4541             } # END SUB write_temporary
4542              
4543              
4544             sub pin_obstructions # TO DO. ZZZ
4545             {
4546             # THIS CONSTRAINS OBSTRUCTION FILES. TO DO. STILL UNUSED. ZZZ
4547             # IT HAS TO BE CALLED FROM THE MAIN FILE WITH:
4548             # constrain_obstruction($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $exeonfiles, \@applytype, \@pin_obstructions);
4549             my $to = shift;
4550             my $fileconfig = shift;
4551             my $stepsvar = shift;
4552             my $counterzone = shift;
4553             my $counterstep = shift;
4554             my $exeonfiles = shift;
4555             my $swap = shift;
4556             my @applytype = @$swap;
4557             my $zone_letter = $applytype[$counterzone][3];
4558             my $swap = shift;
4559             my @pin_obstructions = @$swap;
4560              
4561              
4562             my @work_letters ;
4563             my @obs;
4564             my @newobs;
4565             foreach my $elm (@pin_obstructions)
4566             {
4567             my @group = @{$elm};
4568             my $zone_letter = $group[1];
4569             my $sourcefile = $group[2];
4570             my $targetfile = $group[3];
4571             my $sourceaddress = "$to$sourcefile";
4572             my $targetaddress = "$to$targetfile";
4573             my $temp = $group[4];
4574             my @obs_letters;
4575             checkfile($sourceaddress, $targetaddress);
4576              
4577             open( SOURCEFILE, $temp ) or die "Can't open $temp: $!\n";
4578             my @rows = < SOURCEFILE >;
4579             foreach my $line (@rows)
4580             {
4581             my @elts = split(/\s+|,/, $line);
4582             push (@newobs, [ $elts[1], $elts[2], $elts[3], $elts[4], $elts[5], $elts[6], $elts[7], $elts[8], $elts[9], $elts[10], $elts[11], $elts[12], $elts[13] ] );
4583             }
4584             apply_pin_obstructions($to, $fileconfig,$stepsvar, $counterzone, $counterstep, $exeonfiles, \@newobs );
4585             }
4586             } # END SUB pin_obstructions
4587              
4588              
4589             sub apply_pin_obstructions # TO DO. STILL UNUSED. ZZZ
4590             {
4591             # IT APPLY USER-IMPOSED CONSTRAINTS TO A GEOMETRY FILES VIA SHELL
4592             # IT HAS TO BE CALLED WITH:
4593             # apply_pin_obstructions( $to, $fileconfig,$stepsvar, $counterzone, $counterstep, $exeonfiles, \@obs );
4594             my $to = shift;
4595             my $fileconfig = shift;
4596             my $stepsvar = shift;
4597             my $counterzone = shift;
4598             my $counterstep = shift;
4599             my $exeonfiles = shift;
4600             my $swap = shift;
4601             my @obs = @$swap;
4602              
4603              
4604             my $counterobs = 0;
4605             foreach my $ob (@obs)
4606             {
4607             my @obs = @{$ob};
4608             my $x = $obs[1];
4609             my $y = $obs[2];
4610             my $z = $obs[3];
4611             my $width = $obs[4];
4612             my $depth = $obs[5];
4613             my $height = $obs[6];
4614             my $z_rotation = $obs[7];
4615             my $y_rotation = $obs[8];
4616             my $tilt = $obs[9];
4617             my $opacity = $obs[10];
4618             my $name = $obs[11];
4619             my $material = $obs[12];
4620             my $obs_letter = $obs[13];
4621              
4622             my $printthis =
4623             "prj -file $to/cfg/$fileconfig -mode script<
4624              
4625             m
4626             c
4627             a
4628             $zone_letter
4629             h
4630             a
4631             $obs_letter
4632             a
4633             a
4634             $x $y $z
4635             b
4636             $width $depth $height
4637             c
4638             $z_rotation
4639             d
4640             $y_rotation
4641             e # HERE THE DATUM IS STILL UNUSED. WHEN IT WILL, A LINE MUST BE ADDED WITH THE VARIABLE $tilt.
4642             h
4643             $opacity
4644             -
4645             -
4646             c
4647             -
4648             c
4649             -
4650             -
4651             -
4652             -
4653             YYY
4654             ";
4655             if ($exeonfiles eq "y")
4656             {
4657             print `$printthis`;
4658             }
4659              
4660             print TOSHELL $printthis;
4661             }
4662             $countervertex++;
4663             } # END SUB apply_pin_obstructions
4664             ############################################################## END OF GROUP GET AND PIN OBSTRUCTIONS
4665              
4666              
4667             ##############################################################################
4668             ##############################################################################
4669             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING OBSTRUCTIONS
4670              
4671              
4672              
4673             ##############################################################################
4674             ##############################################################################
4675             # BEGINNING OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING THE MASS-FLOW NETWORKS
4676              
4677             sub vary_net
4678             { # IT IS CALLED FROM THE MAIN FILE
4679             my $to = shift;
4680             my $fileconfig = shift;
4681             my $stepsvar = shift;
4682             my $counterzone = shift;
4683             my $counterstep = shift;
4684             my $exeonfiles = shift;
4685             my $swap = shift;
4686             my @applytype = @$swap;
4687             my $zone_letter = $applytype[$counterzone][3];
4688             my $swap = shift;
4689             my @vary_net = @$swap;
4690              
4691             my $activezone = $applytype[$counterzone][3];
4692             my ($semaphore_node, $semaphore_component, $node_letter);
4693             my $counter_component = -1;
4694             my $counterline = 0;
4695             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
4696             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
4697             # NOTE: THE FOLLOWING VARIABLE NAMES ARE SHADOWED IN THE FOREACH LOOP BELOW,
4698             # BUT ARE THE ONES USED IN THE OPTS CONSTRAINTS FILES.
4699              
4700             my @group = @{$vary_net[$counterzone]};
4701             my $sourcefile = $group[0];
4702             my $targetfile = $group[1];
4703             my $configfile = $group[2];
4704             my @nodebulk = @{$group[3]};
4705             my @componentbulk = @{$group[4]};
4706             my $countnode = 0;
4707             my $countcomponent = 0;
4708              
4709             my $sourceaddress = "$to$sourcefile";
4710             my $targetaddress = "$to$targetfile";
4711             my $configaddress = "$to$configfile";
4712              
4713             #@node; @component; # PLURAL. DON'T PUT "my" HERE!
4714             #@new_nodes; @new_components; # DON'T PUT "my" HERE.
4715              
4716             my @flow_letters;
4717              
4718             checkfile($sourceaddress, $targetaddress);
4719              
4720             if ($counterstep == 1)
4721             {
4722             read_net($sourceaddress, $targetaddress, \@node_letters, \@component_letters);
4723             }
4724              
4725             sub calc_newnet
4726             { # TO BE CALLED WITH: calc_newnet($to, $fileconfig, $stepsvar, $counterzone, $counterstep, \@nodebulk, \@componentbulk, \@node_, \@component);
4727             # THIS COMPUTES CHANGES TO BE MADE TO CONTROLS BEFORE PROPAGATION OF CONSTRAINTS
4728             my $to = shift;
4729             my $fileconfig = shift;
4730             my $stepsvar = shift;
4731             my $counterzone = shift;
4732             my $counterstep = shift;
4733             my $swap = shift;
4734             my @nodebulk = @$swap;
4735             my $swap = shift;
4736             my @componentbulk = @$swap;
4737             my $swap = shift;
4738             my @node = @$swap; # PLURAL
4739             my $swap = shift;
4740             my @component = @$swap; # PLURAL
4741             my $toshell = shift;
4742             my $outfile = shift;
4743             my $configfile = shift;
4744              
4745             my @new_volumes_or_surfaces;
4746             my @node_heights_or_cps;
4747             my @new_azimuths;
4748             my @boundary_heights;
4749              
4750             # HERE THE MODIFICATIONS TO BE EXECUTED ON EACH PARAMETERS ARE CALCULATED.
4751             if ($stepsvar == 0) {$stepsvar = 1;}
4752             if ($stepsvar > 1)
4753             {
4754             foreach $each_nodebulk (@nodebulk)
4755             {
4756             my @asknode = @{$each_nodebulk};
4757             my $new_node_letter = $asknode[0];
4758             my $new_fluid = $asknode[1];
4759             my $new_type = $asknode[2];
4760             my $new_zone = $activezone;
4761             my $swing_height = $asknode[3];
4762             my $swing_data_2 = $asknode[4];
4763             my $new_surface = $asknode[5];
4764             my @askcp = @{$asknode[6]};
4765             my ($height__, $data_2__, $data_1__, $new_cp);
4766             my $countnode = 0; #IT IS FOR THE FOLLOWING FOREACH. LEAVE IT ATTACHED TO IT.
4767             foreach $each_node (@node)
4768             {
4769             @node_ = @{$each_node};
4770             my $node_letter = $node_[0];
4771             if ( $new_node_letter eq $node_letter )
4772             {
4773             $height__ = $node_[3];
4774             $data_2__ = $node_[4];
4775             $data_1__ = $node_[5];
4776             $new_cp = $askcp[$counterstep-1];
4777             }
4778             $countnode++;
4779             }
4780             my $height = ( $swing_height / ($stepsvar - 1) );
4781             my $floorvalue_height = ($height__ - ($swing_height / 2) );
4782             my $new_height = $floorvalue_height + ($counterstep * $pace_height);
4783             $new_height = sprintf("%.3f", $height);
4784             if ($swing_height == 0) { $new_height = ""; }
4785              
4786             my $pace_data_2 = ( $swing_data_2 / ($stepsvar - 1) );
4787             my $floorvalue_data_2 = ($data_2__ - ($swing_data_2 / 2) );
4788             my $new_data_2 = $floorvalue_data_2 + ($counterstep * $pace_data_2);
4789             $new_data_2 = sprintf("%.3f", $new_data_2);
4790             if ($swing_data_2 == 0) { $new_data_2 = ""; }
4791              
4792             my $pace_data_1 = ( $swing_data_1 / ($stepsvar - 1) ); # UNUSED
4793             my $floorvalue_data_1 = ($data_1__ - ($swing_data_1 / 2) );
4794             my $new_data_1 = $floorvalue_data_1 + ($counterstep * $pace_data_1);
4795             $new_data_1 = sprintf("%.3f", $new_data_1);
4796             if ($swing_data_1 == 0) { $new_data_1 = ""; }
4797              
4798             push(@new_nodes,
4799             [ $new_node_letter, $new_fluid, $new_type, $new_zone, $new_height, $new_data_2, $new_surface, $new_cp ] );
4800             }
4801              
4802             foreach $each_componentbulk (@componentbulk)
4803             {
4804             my @askcomponent = @{$each_componentbulk};
4805             my $new_component_letter = $askcomponent[0];
4806              
4807             my $new_type = $askcomponent[1];
4808             my $swing_data_1 = $askcomponent[2];
4809             my $swing_data_2 = $askcomponent[3];
4810             my $swing_data_3 = $askcomponent[4];
4811             my $swing_data_4 = $askcomponent[5];
4812             my $component_letter;
4813             my $countcomponent = 0; #IT IS FOR THE FOLLOWING FOREACH.
4814             my ($new_type, $data_1__, $data_2__, $data_3__, $data_4__ );
4815             foreach $each_component (@component) # PLURAL
4816             {
4817             @component_ = @{$each_component};
4818             $component_letter = $component_letters[$countcomponent];
4819             if ( $new_component_letter eq $component_letter )
4820             {
4821             $new_component_letter = $component_[0];
4822             $new_fluid = $component_[1];
4823             $new_type = $component_[2];
4824             $data_1__ = $component_[3];
4825             $data_2__ = $component_[4];
4826             $data_3__ = $component_[5];
4827             $data_4__ = $component_[6];
4828             }
4829             $countcomponent++;
4830             }
4831              
4832             my $pace_data_1 = ( $swing_data_1 / ($stepsvar - 1) );
4833             my $floorvalue_data_1 = ($data_1__ - ($swing_data_1 / 2) );
4834             my $new_data_1 = $floorvalue_data_1 + ($counterstep * $pace_data_1);
4835             if ($swing_data_1 == 0) { $new_data_1 = ""; }
4836              
4837             my $pace_data_2 = ( $swing_data_2 / ($stepsvar - 1) );
4838             my $floorvalue_data_2 = ($data_2__ - ($swing_data_2 / 2) );
4839             my $new_data_2 = $floorvalue_data_2 + ($counterstep * $pace_data_2);
4840             if ($swing_data_2 == 0) { $new_data_2 = ""; }
4841              
4842             my $pace_data_3 = ( $swing_data_3 / ($stepsvar - 1) );
4843             my $floorvalue_data_3 = ($data_3__ - ($swing_data_3 / 2) );
4844             my $new_data_3 = $floorvalue_data_3 + ($counterstep * $pace_data_3 );
4845             if ($swing_data_3 == 0) { $new_data_3 = ""; }
4846              
4847             my $pace_data_4 = ( $swing_data_4 / ($stepsvar - 1) );
4848             my $floorvalue_data_4 = ($data_4__ - ($swing_data_4 / 2) );
4849             my $new_data_4 = $floorvalue_data_4 + ($counterstep * $pace_data_4 );
4850             if ($swing_data_4 == 0) { $new_data_4 = ""; }
4851              
4852             $new_data_1 = sprintf("%.3f", $new_data_1);
4853             $new_data_2 = sprintf("%.3f", $new_data_2);
4854             $new_data_3 = sprintf("%.3f", $new_data_3);
4855             $new_data_4 = sprintf("%.3f", $new_data_4);
4856             $new_data_4 = sprintf("%.3f", $new_data_4);
4857              
4858             push(@new_components, [ $new_component_letter, $new_fluid, $new_type, $new_data_1, $new_data_2, $new_data_3, $new_data_4 ] );
4859             }
4860             }
4861             } # END SUB calc_newnet
4862              
4863             calc_newnet($to, $fileconfig, $stepsvar, $counterzone, $counterstep, \@nodebulk, \@componentbulk, \@node, \@component); # PLURAL
4864              
4865             apply_node_changes($exeonfiles, \@new_nodes);
4866             apply_component_changes($exeonfiles, \@new_components);
4867              
4868             } # END SUB vary_net.
4869              
4870              
4871             sub read_net
4872             {
4873             my $sourceaddress = shift;
4874             my $targetaddress = shift;
4875             # checkfile($sourceaddress, $targetaddress); # THIS HAS TO BE _FIXED!_
4876             my $swap = shift;
4877             my @node_letters = @$swap;
4878             my $swap = shift;
4879             my @component_letters = @$swap;
4880              
4881             open( SOURCEFILE, $sourceaddress ) or die "Can't open $sourcefile : $!\n";
4882             my @lines = ;
4883             close SOURCEFILE;
4884             my $counterlines = 0;
4885             my $countnode = -1;
4886             my $countcomponent = -1;
4887             my $countcomp = 0;
4888             my $semaphore_node = "no";
4889             my $semaphore_component = "no";
4890             my $semaphore_connection = "no";
4891             my ($component_letter, $type, $data_1, $data_2, $data_3, $data_4);
4892             foreach my $line (@lines)
4893             {
4894             if ( $line =~ m/Fld. Type/ )
4895             {
4896             $semaphore_node = "yes";
4897             }
4898             if ( $semaphore_node eq "yes" )
4899             {
4900             $countnode++;
4901             }
4902             if ( $line =~ m/Type C\+ L\+/ )
4903             {
4904             $semaphore_component = "yes";
4905             $semaphore_node = "no";
4906             }
4907              
4908              
4909              
4910             if ( ($semaphore_node eq "yes") and ( $semaphore_component eq "no" ) and ( $countnode >= 0))
4911             {
4912             $line =~ s/^\s+//;
4913             my @row = split(/\s+/, $line);
4914             my $node_letter = $node_letters[$countnode];
4915             my $fluid = $row[1];
4916             my $type = $row[2];
4917             my $height = $row[3];
4918             my $data_2 = $row[6]; # volume or azimuth
4919             my $data_1 = $row[5]; #surface
4920             push(@node, [ $node_letter, $fluid, $type, $height, $data_2, $data_1 ] ); # PLURAL
4921             }
4922              
4923             if ( $semaphore_component eq "yes" )
4924             {
4925             $countcomponent++;
4926             }
4927              
4928             if ( $line =~ m/\+Node/ )
4929             {
4930             $semaphore_connection = "yes";
4931             $semaphore_component = "no";
4932             $semaphore_node = "no";
4933             }
4934              
4935             if ( ($semaphore_component eq "yes") and ( $semaphore_connection eq "no" ) and ( $countcomponent > 0))
4936             {
4937             $line =~ s/^\s+//;
4938             my @row = split(/\s+/, $line);
4939             if ($countcomponent % 2 == 1) # $number is odd
4940             {
4941             $component_letter = $component_letters[$countcomp];
4942             $fluid = $row[0];
4943             $type = $row[1];
4944             if ($type eq "110") { $type = "k";}
4945             if ($type eq "120") { $type = "l";}
4946             if ($type eq "130") { $type = "m";}
4947             $countcomp++;
4948             }
4949             else # $number is even
4950             {
4951             $data_1 = $row[1];
4952             $data_2 = $row[2];
4953             $data_3 = $row[3];
4954             $data_4 = $row[4];
4955             push( @component, [ $component_letter, $fluid, $type, $data_1, $data_2, $data_3, $data_4 ] ); # PLURAL
4956             }
4957              
4958             }
4959              
4960             $counterlines++;
4961             }
4962             } # END SUB read_controls.
4963              
4964              
4965             sub apply_node_changes
4966             { # TO BE CALLED WITH: apply_node_changes($exeonfiles, \@new_nodes);
4967             # THIS APPLIES CHANGES TO NODES IN NETS
4968             my $exeonfiles = shift;
4969             my $swap = shift;
4970             my @new_nodes = @$swap;
4971             my $swap = shift;
4972             my @tempnodes = @$swap;
4973              
4974              
4975             my $counternode = 0;
4976             foreach my $elm (@new_nodes)
4977             {
4978             my @node_ = @{$elm};
4979             my $new_node_letter = $node_[0];
4980             my $new_fluid = $node_[1];
4981             my $new_type = $node_[2];
4982             my $new_zone = $node_[3];
4983             my $new_height = $node_[4];
4984             my $new_data_2 = $node_[5];
4985             my $new_surface = $node_[6];
4986             my $new_cp = $node_[7];
4987              
4988             unless ( @{$new_nodes[$counternode]} ~~ @{$tempnodes[$counternode]} )
4989             {
4990             if ($new_type eq "a" ) # IF NODES ARE INTERNAL
4991             {
4992             my $printthis =
4993             "prj -file $to/cfg/$fileconfig -mode script<
4994              
4995             m
4996             e
4997             c
4998              
4999             n
5000             c
5001             $new_node_letter
5002              
5003             $new_fluid
5004             $new_type
5005             y
5006             $new_zone
5007             $new_data_2
5008             $new_height
5009             a
5010              
5011             -
5012             -
5013             y
5014              
5015             y
5016             -
5017             -
5018             YYY
5019             ";
5020             if ($exeonfiles eq "y")
5021             {
5022             print `$printthis`;
5023             }
5024             print TOSHELL $printthis;
5025             }
5026              
5027             if ($new_type eq "e" ) # IF NODES ARE BOUNDARY ONES, WIND-INDUCED
5028             {
5029             my $printthis =
5030             "prj -file $to/cfg/$fileconfig -mode script<
5031              
5032             m
5033             e
5034             c
5035              
5036             n
5037             c
5038             $new_node_letter
5039              
5040             $new_fluid
5041             $new_type
5042             $new_zone
5043             $new_surface
5044             $new_cp
5045             y
5046             $new_data_2
5047             $new_height
5048             -
5049             -
5050             y
5051              
5052             y
5053             -
5054             -
5055             YYY
5056             ";
5057             if ($exeonfiles eq "y")
5058             {
5059             print `$printthis`;
5060             }
5061             print TOSHELL $printthis;
5062             }
5063             }
5064             $counternode++;
5065             }
5066             } # END SUB apply_node_changes;
5067              
5068              
5069              
5070             sub apply_component_changes
5071             { # TO BE CALLED WITH: apply_component_changes($exeonfiles, \@new_components);
5072             # THIS APPLIES CHANGES TO COMPONENTS IN NETS
5073             my $exeonfiles = shift;
5074             my $swap = shift;
5075             my @new_components = @$swap; # [ $new_component_letter, $new_type, $new_data_1, $new_data_2, $new_data_3, $new_data_4 ]
5076             my $swap = shift;
5077             my @tempcomponents = @$swap;
5078              
5079             my $countercomponent = 0;
5080             foreach my $elm (@new_components)
5081             {
5082             my @component_ = @{$elm};
5083             my $new_component_letter = $component_[0];
5084             my $new_fluid = $component_[1];
5085             my $new_type = $component_[2];
5086             my $new_data_1 = $component_[3];
5087             my $new_data_2 = $component_[4];
5088             my $new_data_3 = $component_[5];
5089             my $new_data_4 = $component_[6];
5090              
5091             unless
5092             ( @{$new_components[$countercomponents]} ~~ @{$tempcomponents[$countercomponents]} )
5093             {
5094             if ($new_type eq "k" ) # IF THE COMPONENT IS A GENERIC OPENING
5095             {
5096             my $printthis =
5097             "prj -file $to/cfg/$fileconfig -mode script<
5098              
5099             m
5100             e
5101             c
5102              
5103             n
5104             d
5105             $new_component_letter
5106             $new_fluid
5107             $new_type
5108             -
5109             $new_data_1
5110             -
5111             -
5112             y
5113              
5114             y
5115             -
5116             -
5117             YYY
5118             ";
5119             if ($exeonfiles eq "y")
5120             {
5121             print `$printthis`;
5122             }
5123             print TOSHELL $printthis;
5124             }
5125              
5126             if ($new_type eq "l" ) # IF THE COMPONENT IS A CRACK
5127             {
5128             my $printthis =
5129             "prj -file $to/cfg/$fileconfig -mode script<
5130              
5131             m
5132             e
5133             c
5134              
5135             n
5136             d
5137             $new_component_letter
5138             $new_fluid
5139             $new_type
5140             -
5141             $new_data_1 $new_data_2
5142             -
5143             -
5144             y
5145              
5146             y
5147             -
5148             -
5149             YYY
5150             ";
5151             if ($exeonfiles eq "y")
5152             {
5153             print `$printthis`;
5154             }
5155             print TOSHELL $printthis;
5156             }
5157              
5158             if ($new_type eq "m" ) # IF THE COMPONENT IS A DOOR
5159             {
5160             my $printthis =
5161             "prj -file $to/cfg/$fileconfig -mode script<
5162              
5163             m
5164             e
5165             c
5166              
5167             n
5168             d
5169             $new_component_letter
5170             $new_fluid
5171             $new_type
5172             -
5173             $new_data_1 $new_data_2 $new_data_3 $new_data_4
5174             -
5175             -
5176             y
5177              
5178             y
5179             -
5180             -
5181             YYY
5182             ";
5183             if ($exeonfiles eq "y")
5184             {
5185             print `$printthis`;
5186             }
5187             print TOSHELL $printthis;
5188             }
5189             }
5190             $countercomponent++;
5191             }
5192             } # END SUB apply_component_changes;
5193              
5194              
5195             sub constrain_net
5196             { # IT ALLOWS TO MANIPULATE USER-IMPOSED CONSTRAINTS REGARDING NETS
5197             my $to = shift;
5198             my $fileconfig = shift;
5199             my $stepsvar = shift;
5200             my $counterzone = shift;
5201             my $counterstep = shift;
5202             my $exeonfiles = shift;
5203             my $swap = shift;
5204             my @applytype = @$swap;
5205             my $zone_letter = $applytype[$counterzone][3];
5206             my $swap = shift;
5207             my @constrain_net = @$swap;
5208             my $to_do = shift;
5209              
5210              
5211             my $elm = $constrain_net[$counterzone];
5212             my @group = @{$elm};
5213             my $sourcefile = $group[2];
5214             my $targetfile = $group[3];
5215             my $configfile = $group[4];
5216             my $sourceaddress = "$to$sourcefile";
5217             my $targetaddress = "$to$targetfile";
5218             my $configaddress = "$to$configfile";
5219              
5220             my $node = 0;
5221             my $fluid = 1;
5222             my $type = 2;
5223             my $height = 3;
5224             my $volume = 4;
5225             my $volume = 4;
5226             my $azimuth = 4;
5227             my $component = 0;
5228             my $area = 3;
5229             my $width = 4;
5230             my $length = 5;
5231             my $door_width = 4;
5232             my $door_height = 5;
5233             my $door_nodeheight = 6;
5234             my $door_discharge = 7;
5235              
5236             my $activezone = $applytype[$counterzone][3];
5237             my ($semaphore_node, $semaphore_component, $node_letter);
5238             my $counter_component = -1;
5239             my $counterline = 0;
5240             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
5241             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
5242             my $countnode = 0;
5243             my $countcomponent = 0;
5244              
5245             #@node; @component; # PLURAL! DON'T PUT "MY" HERE. GLOBAL.
5246             #@new_nodes; @new_components; # DON'T PUT "my" HERE. THEY ARE GLOBAL!!!
5247              
5248             unless ($to_do eq "justwrite")
5249             {
5250             checkfile($sourceaddress, $targetaddress);
5251             if ($counterstep == 1)
5252             {
5253             read_net($sourceaddress, $targetaddress, \@node_letters, \@component_letters);
5254             read_net_constraints
5255             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $configaddress, \@node, \@component, \@tempnode, \@tempcomponent); # PLURAL
5256             }
5257             }
5258              
5259             unless ($to_do eq "justread")
5260             {
5261             apply_node_changes($exeonfiles, \@donode, \@tempnode); #PLURAL
5262             apply_component_changes($exeonfiles, \@docomponent, \@tempcomponent);
5263             }
5264             } # END SUB constrain_net.
5265              
5266             sub read_net_constraints
5267             {
5268             my $to = shift;
5269             my $fileconfig = shift;
5270             my $stepsvar = shift;
5271             my $counterzone = shift;
5272             my $counterstep = shift;
5273             my $configaddress = shift;
5274             my $swap = shift;
5275             @node = @$swap; # PLURAL
5276             my $swap = shift;
5277             @component = @$swap;
5278             my $swap = shift;
5279             @tempnode = @$swap;
5280             my $swap = shift;
5281             @tempcomponent = @$swap;
5282              
5283              
5284             unshift (@node, []); # PLURAL
5285             unshift (@component, []);
5286             if (-e $configaddress) # TEST THIS
5287             { # THIS APPLIES CONSTRAINST, THE FLATTEN THE HIERARCHICAL STRUCTURE OF THE RESULTS,
5288             # TO BE PREPARED THEN FOR BEING APPLIED TO CHANGE PROCEDURES. IT IS TO BE TESTED.
5289              
5290             push (@node, [@mynode]); #
5291             push (@component, [@mycomponent]); #
5292              
5293             eval `cat $configaddress`; # HERE AN EXTERNAL FILE FOR PROPAGATION OF CONSTRAINTS
5294             # IS EVALUATED, AND HERE BELOW CONSTRAINTS ARE PROPAGATED.
5295             # THIS FILE CAN CONTAIN USER-IMPOSED CONSTRAINTS FOR MASS-FLOW NETWORKS TO BE READ BY OPTS.
5296             # IT MAKES AVAILABLE VARIABLES REGARDING THE SETTING OF NODES IN A NETWORK.
5297             # CURRENTLY: INTERNAL UNKNOWN AIR NODES AND BOUNDARY WIND-CONCERNED NODES.
5298             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
5299             # CURRENTLY: WINDOWS, CRACKS, DOORS.
5300             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
5301             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
5302             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
5303             # $node[$counterzone][node_number][$node]. # EXAMPLE: $node[0][3][$node]. THIS IS THE LETTER OF THE THIRD NODE,
5304             # AT THE FIRST CONTERZONE (NUMBERING STARTS FROM 0)
5305             # $node[$counterzone][node_number][$type]
5306             # $node[$counterzone][node_number][$height]. # EXAMPLE: $node[0][3][$node]. THIS IS THE HEIGHT OF THE 3RD NODE AT THE FIRST COUNTERZONE
5307             # THEN IT MAKES AVAILABLE THE FOLLOWING VARIABLES REGARDING NODES:
5308             # $node[$counterzone][node_number][$volume] # REGARDING INTERNAL NODES
5309             # $node[$counterzone][node_number][$azimut] # REGARDING BOUNDARY NODES
5310             # THEN IT MAKE AVAILABLE THE FOLLOWING VARIABLES REGARDING COMPONENTS:
5311             # $node[$counterzone][node_number][$area] # REGARDING SIMPLE OPENINGS
5312             # $node[$counterzone][node_number][$width] # REGARDING CRACKS
5313             # $node[$counterzone][node_number][$length] # REGARDING CRACKS
5314             # $node[$counterzone][node_number][$door_width] # REGARDING DOORS
5315             # $node[$counterzone][node_number][$door_height] # REGARDING DOORS
5316             # $node[$counterzone][node_number][$door_nodeheight] # REGARDING DOORS
5317             # $node[$counterzone][node_number][$door_discharge] # REGARDING DOORS (DISCHARGE FACTOR)
5318             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS
5319             # AND THE STEPS THE MODEL HAVE TO FOLLOW.
5320             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
5321             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
5322             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
5323             # $counterzone, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
5324             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $counterzone WILL CONTAIN ONE OR MORE ITERATION STEPS.
5325             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
5326             # THE OTHER ARE APPLIED TO THE SAME ZONE.
5327             # $counterstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
5328             # The $counterzone that is actuated is always the last, the one which is active.
5329             # It would have therefore no sense writing $node[0][3][$node] = $node[1][3][$node].
5330             # Differentent $counterzones can be referred to the same zone. Different $counterzones just number mutations in series.
5331              
5332             if (-e $constrain) { eval "$constrain"; } # HERE THE INSTRUCTION WRITTEN IN THE OPTS CONFIGURATION FILE CAN BE SPEFICIED
5333             # FOR PROPAGATION OF CONSTRAINTS
5334              
5335             @donode = @{$node[$#node]}; #
5336             @docomponent = @{$component[$#component]}; #
5337              
5338             shift (@donode);
5339             shift (@docomponent);
5340             }
5341             } # END SUB read_net_constraints
5342              
5343             ##############################################################################
5344             ##############################################################################
5345             # END OF SECTION DEDICATED TO FUNCTIONS FOR CONSTRAINING MASS-FLOW NETWORKS
5346              
5347              
5348              
5349             ##############################################################################
5350             ##############################################################################
5351             # BEGINNING OF SECTION DEDICATED TO GENERIC FUNCTIONS FOR PROPAGATING CONSTRAINTS
5352              
5353             sub propagate_constraints
5354             {
5355             # THIS FUNCTION ALLOWS TO MANIPULATE COMPOUND USER-IMPOSED CONSTRAINTS.
5356             # IT COMPOUNDS ALL FOUR PRINCIPAL PROPAGATION TYPES. THAT MEANS THAT ONE COULD DO
5357             # ANY TYPE OF THE AVAILABLE PROPAGATIONS JUST USING THIS FUNCTION.
5358             # IT MAKES AVAILABLE TO THE USER THE FOLLOWING VARIABLES FOR MANIPULATION.
5359              
5360             # REGARDING GEOMETRY:
5361             # $v[$counterzone][$number][$x], $v[$counterzone][$number][$y], $v[$counterzone][$number][$z]. EXAMPLE: $v[0][4][$x] = 1.
5362             # OR: @v[0][4][$x] = @v[0][4][$y]. OR EVEN: @v[1][4][$x] = @v[0][3][$z].
5363              
5364             # REGARDING OBSTRUCTIONS:
5365             # $obs[$counterzone][$obs_number][$x], $obs[$counterzone][$obs_number][$y], $obs[$counterzone][$obs_number][$y]
5366             # $obs[$counterzone][$obs_number][$width], $obs[$counterzone][$obs_number][$depth], $obs[$counterzone][$obs_number][$height]
5367             # $obs[$counterzone][$obs_number][$z_rotation], $obs[$counterzone][$obs_number][$y_rotation],
5368             # $obs[$counterzone][$obs_number][$tilt], $obs[$counterzone][$obs_number][$opacity], $obs[$counterzone][$obs_number][$material],
5369             # EXAMPLE: $obs[0][2][$x] = 2. THIS MEANS: AT COUNTERZONE 0, COORDINATE x OF OBSTRUCTION HAS TO BE SET TO 2.
5370             # OTHER EXAMPLE: $obs[0][2][$x] = $obs[2][2][$y].
5371             # NOTE THAT THE MATERIAL TO BE SPECIFIED IS A MATERIAL LETTER, BETWEEN QUOTES! EXAMPLE: $obs[1][$material] = "a".
5372             # $tilt IS PRESENTLY UNUSED.
5373              
5374             # REGARDING MASS-FLOW NETWORKS:
5375             # @node and @component.
5376             # CURRENTLY: INTERNAL UNKNOWN AIR NODES AND BOUNDARY WIND-CONCERNED NODES.
5377             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
5378             # CURRENTLY: WINDOWS, CRACKS, DOORS.
5379             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
5380             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
5381             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
5382             # 1) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$loop_hour]
5383             # Where $countloop and $countloopcontrol has to be set to a specified number in the OPTS file for constraints.
5384             # 2) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$max_heating_power] # Same as above.
5385             # 3) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$min_heating_power] # Same as above.
5386             # 4) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$max_cooling_power] # Same as above.
5387             # 5) $loopcontrol[$counterzone][$countloop][$countloopcontrol][$min_cooling_power] # Same as above.
5388             # 6) $loopcontrol[$counterzone][$countloop][$countloopcontrol][heating_setpoint] # Same as above.
5389             # 7) $loopcontrol[$counterzone][$countloop][$countloopcontrol][cooling_setpoint] # Same as above.
5390             # 8) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_hour]
5391             # Where $countflow and $countflowcontrol has to be set to a specified number in the OPTS file for constraints.
5392             # 9) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_setpoint] # Same as above.
5393             # 10) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_onoff] # Same as above.
5394             # 11) $flowcontrol[$counterzone][$countflow][$countflowcontrol][$flow_fraction] # Same as above.
5395             # EXAMPLE : $flowcontrol[0][1][2][$flow_fraction] = 0.7
5396             # OTHER EXAMPLE: $flowcontrol[2][1][2][$flow_fraction] = $flowcontrol[0][2][1][$flow_fraction]
5397              
5398             # REGARDING CONTROLS:
5399             # IT MAKES AVAILABLE VARIABLES REGARDING COMPONENTS
5400             # CURRENTLY: WINDOWS, CRACKS, DOORS.
5401             # ALSO, THIS MAKES AVAILABLE TO THE USER INFORMATIONS ABOUT THE MORPHING STEP OF THE MODELS.
5402             # SPECIFICALLY, THE FOLLOWING VARIABLES WHICH REGARD BOTH INTERNAL AND BOUNDARY NODES.
5403             # NOTE THAT "node_number" IS THE NUMBER OF THE NODE IN THE ".afn" ESP-r FILE.
5404             # $node[$counterzone][node_number][$node]. # EXAMPLE: $node[0][3][$node]. THIS IS THE LETTER OF THE THIRD NODE,
5405             # AT THE FIRST CONTERZONE (NUMBERING STARTS FROM 0)
5406             # $node[$counterzone][node_number][$type]
5407             # $node[$counterzone][node_number][$height]. # EXAMPLE: $node[0][3][$node]. THIS IS THE HEIGHT OF THE 3RD NODE AT THE FIRST COUNTERZONE
5408             # THEN IT MAKES AVAILABLE THE FOLLOWING VARIABLES REGARDING NODES:
5409             # $node[$counterzone][node_number][$volume] # REGARDING INTERNAL NODES
5410             # $node[$counterzone][node_number][$azimut] # REGARDING BOUNDARY NODES
5411             # THEN IT MAKE AVAILABLE THE FOLLOWING VARIABLES REGARDING COMPONENTS:
5412             # $node[$counterzone][node_number][$area] # REGARDING SIMPLE OPENINGS
5413             # $node[$counterzone][node_number][$width] # REGARDING CRACKS
5414             # $node[$counterzone][node_number][$length] # REGARDING CRACKS
5415             # $node[$counterzone][node_number][$door_width] # REGARDING DOORS
5416             # $node[$counterzone][node_number][$door_height] # REGARDING DOORS
5417             # $node[$counterzone][node_number][$door_nodeheight] # REGARDING DOORS
5418             # $node[$counterzone][node_number][$door_discharge] # REGARDING DOORS (DISCHARGE FACTOR)
5419              
5420             # ALSO, THIS KIND OF FILE MAKES INFORMATION AVAILABLE ABOUT
5421             # THE MORPHING STEP OF THE MODELS AND THE STEPS THE MODEL HAVE TO FOLLOW.
5422             # THIS ALLOWS TO IMPOSE EQUALITY CONSTRAINTS TO THESE VARIABLES,
5423             # WHICH COULD ALSO BE COMBINED WITH THE FOLLOWING ONES:
5424             # $stepsvar, WHICH TELLS THE PROGRAM HOW MANY ITERATION STEPS IT HAS TO DO IN THE CURRENT MORPHING PHASE.
5425             # $counterzone, WHICH TELLS THE PROGRAM WHAT OPERATION IS BEING EXECUTED IN THE CHAIN OF OPERATIONS
5426             # THAT MAY BE EXECUTES AT EACH MORPHING PHASE. EACH $counterzone WILL CONTAIN ONE OR MORE ITERATION STEPS.
5427             # TYPICALLY, IT WILL BE USED FOR A ZONE, BUT NOTHING PREVENTS THAT SEVERAL OF THEM CHAINED ONE AFTER
5428             # THE OTHER ARE APPLIED TO THE SAME ZONE.
5429             # $counterstep, WHICH TELLS THE PROGRAM WHAT THE CURRENT ITERATION STEP IS.
5430              
5431             # The $counterzone that is actuated is always the last, the one which is active.
5432             # It would have therefore no sense writing for example @v[0][4][$x] = @v[1][2][$y], because $counterzone 0 is before than $counterzone 1.
5433             # Also, it would not have sense setting $counterzone 1 if the current $counterzone is already 2.
5434             # Differentent $counterzones can be referred to the same zone. Different $counterzones just number mutations in series.
5435              
5436             my $to = shift;
5437             my $fileconfig = shift;
5438             my $stepsvar = shift;
5439             my $counterzone = shift;
5440             my $counterstep = shift;
5441             my $exeonfiles = shift;
5442             my $swap = shift;
5443             my ($justread, $justwrite);
5444             my @applytype = @$swap;
5445             my $zone_letter = $applytype[$counterzone][3];
5446             my $swap = shift;
5447             my @propagate_constraints = @$swap;
5448              
5449              
5450             my $zone = $applytype[$counterzone][3];
5451             my $counter = 0;
5452             my @group = @{$propagate_constraints[$counterzone]};
5453             foreach my $elm (@group)
5454             {
5455             if ($counter > 0)
5456             {
5457             my @items = @{$elm};
5458             my $what_to_do = $items[0];
5459             my $sourcefile = $items[1];
5460             my $targetfile = $items[2];
5461             my $configfile = $items[3];
5462             if ($what_to_do eq "read_geo")
5463             {
5464             $to_do = "justread";
5465             my @vertex_letters = @{$items[4]};
5466             my $long_menus = $items[5];
5467             my @constrain_geometry = ( [ "", $zone, $sourcefile, $targetfile, $configfile , \@vertex_letters, $long_menus ] );
5468             constrain_geometry($to, $fileconfig, $stepsvar, $counterzone,
5469             $counterstep, $exeonfiles, \@applytype, \@constrain_geometry, $to_do);
5470              
5471             }
5472             if ($what_to_do eq "read_obs")
5473             {
5474             $to_do = "justread";
5475             my @obs_letters = @{$items[4]};
5476             my $act_on_materials = $items[5];
5477             my @constrain_obstructions = ( [ "", $applytype[$counterzone][3], $sourcefile, $targetfile, $configfile , \@obs_letters, $act_on_materials ] );
5478             constrain_obstructions($to, $fileconfig, $stepsvar, $counterzone,
5479             $counterstep, $exeonfiles, \@applytype, \@constrain_obstructions, $to_do);
5480             }
5481             if ($what_to_do eq "read_ctl")
5482             {
5483             $to_do = "justread";
5484             my @constrain_controls = ( [ "", $zone, $sourcefile, $targetfile, $configfile ] );
5485             constrain_controls($to, $fileconfig, $stepsvar, $counterzone,
5486             $counterstep, $exeonfiles, \@applytype, \@constrain_controls, $to_do);
5487             }
5488             if ($what_to_do eq "read_net")
5489             {
5490             $to_do = "justread";
5491             my @surfaces = @{$items[4]};
5492             my @cps = @{$items[5]};
5493             my @constrain_net = ( [ "", $zone, $sourcefile, $targetfile, $configfile , \@surfaces, \@cps ] );
5494             constrain_net($to, $fileconfig, $stepsvar, $counterzone,
5495             $counterstep, $exeonfiles, \@applytype, \@constrain_net, $to_do);
5496             }
5497              
5498             if ($what_to_do eq "write_geo")
5499             {
5500             $to_do = "justwrite";
5501             my @vertex_letters = @{$items[4]};
5502             my $long_menus = $items[5];
5503             my @constrain_geometry = ( [ "", $zone, $sourcefile, $targetfile, $configfile , \@vertex_letters, $long_menus ] );
5504             constrain_geometry($to, $fileconfig, $stepsvar, $counterzone,
5505             $counterstep, $exeonfiles, \@applytype, \@constrain_geometry, $to_do);
5506             }
5507             if ($what_to_do eq "write_obs")
5508             {
5509             $to_do = "justwrite";
5510             my @obs_letters = @{$items[4]};
5511             my $act_on_materials = $items[5];
5512             my @constrain_obstructions = ( [ "", $zone, $sourcefile, $targetfile, $configfile , \@obs_letters, $act_on_materials] );
5513             constrain_obstructions($to, $fileconfig, $stepsvar, $counterzone,
5514             $counterstep, $exeonfiles, \@applytype, \@constrain_obstructions, $to_do);
5515             }
5516             if ($what_to_do eq "write_ctl")
5517             {
5518             $to_do = "justwrite";
5519             my @constrain_controls = ( [ "", $zone, $sourcefile, $targetfile, $configfile ] );
5520             constrain_controls($to, $fileconfig, $stepsvar, $counterzone,
5521             $counterstep, $exeonfiles, \@applytype, \@constrain_controls, $to_do);
5522             }
5523             if ($what_to_do eq "write_net")
5524             {
5525             $to_do = "justwrite";
5526             my @surfaces = @{$items[4]};
5527             my @cps = @{$items[5]};
5528             my @constrain_net = ( [ "", $zone, $sourcefile, $targetfile, $configfile , \@surfaces, \@cps ] );
5529             constrain_net($to, $fileconfig, $stepsvar, $counterzone,
5530             $counterstep, $exeonfiles, \@applytype, \@constrain_net, $to_do);
5531             }
5532             }
5533             $counter++;
5534             }
5535             }
5536              
5537             ##############################################################################
5538             ##############################################################################
5539             # END OF SECTION DEDICATED TO GENERIC FUNCTIONS FOR PROPAGATING CONSTRAINTS
5540              
5541              
5542              
5543             # END OF THE CONTENT OF THE "opts_morph.pl" FILE.
5544             #########################################################################################
5545             #########################################################################################
5546             #########################################################################################
5547            
5548             my $yes_or_no_rotate_obstructions = "$$rotate[$counterzone][1]" ;
5549             # WHY $BRING_CONSTRUCTION_BACK DOES NOT WORK IF THESE TWO VARIABLES ARE PRIVATE?
5550             my $yes_or_no_keep_some_obstructions = "$$keep_obstructions[$counterzone][0]";
5551             print `cd $to`;
5552             print TOSHELL "cd $to\n\n";
5553              
5554             my $countercycles_transl_surfs = 0;
5555            
5556             eval `cat /home/luca/Sim-OPTS/stuff1.pl`; # ZZZZ HERE stuff1.pl
5557             if ( $stepsvar > 1)
5558             {
5559             sub dothings
5560             { # THIS CONTAINS FUNCTIONS THAT APPLY CONSTRAINTS AND UPDATE CALCULATIONS.
5561             #if ( $get_obstructions[$counterzone][0] eq "y" )
5562             #{
5563             # get_obstructions # THIS IS TO MEMORIZE OBSTRUCTIONS.
5564             # # THEY WILL BE SAVED IN A TEMPORARY FILE.
5565             # ($to, $fileconfig, $stepsvar, $counterzone,
5566             # $counterstep, $exeonfiles, \@applytype, \@get_obstructions);
5567             #}
5568             if ($propagate_constraints[$counterzone][0] eq "y")
5569             {
5570             &propagate_constraints
5571             ($to, $fileconfig, $stepsvar, $counterzone,
5572             $counterstep, $exeonfiles, \@applytype, \@propagate_constraints);
5573             }
5574             if ($apply_constraints[$counterzone][0] eq "y")
5575             {
5576             &apply_constraints
5577             ($to, $fileconfig, $stepsvar, $counterzone,
5578             $counterstep, $exeonfiles, \@applytype, \@constrain_geometry);
5579             }
5580             if ($constrain_geometry[$counterzone][0] eq "y")
5581             {
5582             &constrain_geometry
5583             ($to, $fileconfig, $stepsvar, $counterzone,
5584             $counterstep, $exeonfiles, \@applytype, \@constrain_geometry);
5585             }
5586             if ($constrain_controls[$counterzone][0] eq "y")
5587             {
5588             &constrain_controls
5589             ($to, $fileconfig, $stepsvar, $counterzone,
5590             $counterstep, $exeonfiles, \@applytype, \@constrain_controls);
5591             }
5592             if ($$keep_obstructions[$counterzone][0] eq "y") # TO BE SUPERSEDED BY get_obstructions AND pin_obstructions
5593             {
5594             &bring_obstructions_back($to, $fileconfig, $stepsvar, $counterzone,
5595             $counterstep, $exeonfiles, \@applytype, $keep_obstructions);
5596             }
5597             if ($constrain_net[$counterzone][0] eq "y")
5598             {
5599             &constrain_net($to, $fileconfig, $stepsvar, $counterzone,
5600             $counterstep, $exeonfiles, \@applytype, \@constrain_net, $to_do);
5601             }
5602             if ($recalculatenet[0] eq "y")
5603             {
5604             &recalculatenet
5605             ($to, $fileconfig, $stepsvar, $counterzone,
5606             $counterstep, $exeonfiles, \@applytype, \@recalculatenet);
5607             }
5608             if ($constrain_obstructions[$counterzone][0] eq "y")
5609             {
5610             &constrain_obstructions
5611             ($to, $fileconfig, $stepsvar, $counterzone,
5612             $counterstep, $exeonfiles, \@applytype, \@constrain_obstructions, $to_do);
5613             }
5614             #if ( $pin_obstructions[$counterzone][0] eq "y" )
5615             #{
5616             # pin_obstructions ($to, $fileconfig, $stepsvar, $counterzone,
5617             # $counterstep, $exeonfiles, \@applytype, $zone_letter, \@pin_obstructions);
5618             #}
5619             if ($recalculateish eq "y")
5620             {
5621             &recalculateish
5622             ($to, $fileconfig, $stepsvar, $counterzone,
5623             $counterstep, $exeonfiles, \@applytype, \@recalculateish);
5624             }
5625             if ($daylightcalc[0] eq "y")
5626             {
5627             &daylightcalc
5628             ($to, $fileconfig, $stepsvar, $counterzone,
5629             $counterstep, $exeonfiles, \@applytype, $filedf, \@daylightcalc);
5630             }
5631             } # END SUB DOTHINGS
5632            
5633             if ( $modification_type eq "generic_change" )#
5634             {
5635             &make_generic_change
5636             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep, $exeonfiles,
5637             \@applytype, $generic_change);
5638             &dothings;
5639             } #
5640             elsif ( $modification_type eq "surface_translation_simple" )
5641             {
5642             &translate_surfaces_simple
5643             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5644             $exeonfiles, \@applytype, $translate_surface_simple);
5645             &dothings;
5646             }
5647             elsif ( $modification_type eq "surface_translation" )
5648             {
5649             &translate_surfaces
5650             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5651             $exeonfiles, \@applytype, $translate_surface);
5652             &dothings;
5653             }
5654             elsif ( $modification_type eq "surface_rotation" ) #
5655             {
5656             &rotate_surface
5657             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5658             $exeonfiles, \@applytype, $rotate_surface);
5659             &dothings;
5660             }
5661             elsif ( $modification_type eq "vertexes_shift" )
5662             {
5663             &shift_vertexes
5664             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5665             $exeonfiles, \@applytype, $shift_vertexes);
5666             &dothings;
5667             }
5668             elsif ( $modification_type eq "vertex_translation" )
5669             {
5670             &translate_vertexes
5671             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5672             $exeonfiles, \@applytype, \@translate_vertexes);
5673             &dothings;
5674             }
5675             elsif ( $modification_type eq "construction_reassignment" )
5676             {
5677             &reassign_construction
5678             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5679             $exeonfiles, \@applytype, $construction_reassignment);
5680             &dothings;
5681             }
5682             elsif ( $modification_type eq "rotation" )
5683             {
5684             &rotate
5685             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5686             $exeonfiles, \@applytype, $rotate);
5687             &dothings;
5688             }
5689             elsif ( $modification_type eq "translation" )
5690             {
5691             &translate
5692             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5693             $exeonfiles, \@applytype, $translate, $toshell, $outfile, $configfile);
5694             &dothings;
5695             }
5696             elsif ( $modification_type eq "thickness_change" )
5697             {
5698             &change_thickness
5699             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5700             $exeonfiles, \@applytype, $thickness_change);
5701             &dothings;
5702             }
5703             elsif ( $modification_type eq "rotationz" )
5704             {
5705             &rotatez
5706             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5707             $exeonfiles, \@applytype, $rotatez);
5708             &dothings;
5709             }
5710             elsif ( $modification_type eq "change_config" )
5711             {
5712             &change_config
5713             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5714             $exeonfiles, \@applytype, \@change_config);
5715             &dothings;
5716             }
5717             elsif ( $modification_type eq "window_reshapement" )
5718             {
5719             &reshape_windows
5720             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5721             $exeonfiles, \@applytype, \@reshape_windows);
5722             &dothings;
5723             }
5724             elsif ( $modification_type eq "obs_modification" ) # REWRITE FOR NEW GEO FILE?
5725             {
5726             &obs_modify
5727             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5728             $exeonfiles, \@applytype, $obs_modify);
5729             &dothings;
5730             }
5731             elsif ( $modification_type eq "warping" )
5732             {
5733             &warp
5734             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5735             $exeonfiles, \@applytype, $warp);
5736             &dothings;
5737             }
5738             elsif ( $modification_type eq "vary_controls" )
5739             {
5740             &vary_controls
5741             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5742             $exeonfiles, \@applytype, \@vary_controls);
5743             &dothings;
5744             }
5745             elsif ( $modification_type eq "vary_net" )
5746             {
5747             &vary_net
5748             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5749             $exeonfiles, \@applytype, \@vary_net);
5750             &dothings;
5751             }
5752             elsif ( $modification_type eq "change_climate" )
5753             {
5754             &change_climate
5755             ($to, $fileconfig, $stepsvar, $counterzone, $counterstep,
5756             $exeonfiles, \@applytype, \@change_climate);
5757             &dothings;
5758             }
5759             elsif ( $modification_type eq "constrain_controls" )
5760             {
5761             &dothings;
5762             }
5763             #elsif ( $modification_type eq "get_obstructions" )
5764             #{
5765             # dothings;
5766             #}
5767             #elsif ( $modification_type eq "pin_obstructions" )
5768             #{
5769             # dothings;
5770             #}
5771             elsif ( $modification_type eq "constrain_geometry" )
5772             {
5773             &dothings;
5774             }
5775             elsif ( $modification_type eq "apply_constraints" )
5776             {
5777             &dothings;
5778             }
5779             elsif ( $modification_type eq "constrain_net" )
5780             {
5781             &dothings;
5782             }
5783             elsif ( $modification_type eq "propagate_net" )
5784             {
5785             &dothings;
5786             }
5787             elsif ( $modification_type eq "recalculatenet" )
5788             {
5789             &dothings;
5790             }
5791             elsif ( $modification_type eq "constrain_obstructions" )
5792             {
5793             &dothings;
5794             }
5795             elsif ( $modification_type eq "propagate_constraints" )
5796             {
5797             &dothings;
5798             }
5799             }
5800             $counterzone++;
5801             print `cd $mypath`;
5802             print TOSHELL "cd $mypath\n\n";
5803             }
5804             $counterstep++ ;
5805             }
5806             }
5807             if ($countvar == $#varnumbers)
5808             {
5809             my @files_to_erase = grep -d, <$mypath/models/$file*_>;
5810             foreach my $file (@files_to_erase)
5811             {
5812             if ($exeonfiles = "y") { print `rm -R $file`; }
5813             print TOSHELL "rm -R $file";
5814             }
5815             }
5816             $countvar++;
5817             }
5818             close MORPHFILE;
5819              
5820             close CASELIST;
5821             } # END SUB morph
5822             ##############################################################################
5823             ##############################################################################
5824             ##############################################################################
5825              
5826             # BEGINNING OF SUB SIM
5827             ##############################################################################
5828             ##############################################################################
5829             ##############################################################################
5830              
5831             # HERE FOLLOWES THE CONTENT OF THE "sim.pm" FILE, WHICH HAS BEEN MERGED HERE
5832             # TO AVOID COMPLICATIONS WITH THE PERL MODULE INSTALLATION.
5833              
5834             # HERE FOLLOWS THE "sim" FUNCTION, CALLED FROM THE MAIN PROGRAM FILE.
5835             # IT ALSO RETRIEVES RESULTS. THE TWO OPERATIONS ARE CONTROLLED SEPARATELY
5836             # FROM THE OPTS CONFIGURATION FILE.
5837              
5838             #____________________________________________________________________________
5839             # Activate or deactivate the following function calls depending from your needs
5840             sub sim # This function launch the simulations in ESP-r
5841             {
5842             my $to = shift;
5843             my $mypath = shift;
5844             my $file = shift;
5845             my $filenew = shift;
5846             my $swap = shift;
5847             my @dowhat = @$swap;
5848             my $swap = shift;
5849             my @simdata = @$swap;
5850             my $simnetwork = shift;
5851             my $swap = shift;
5852             my @simtitles = @$swap;
5853             my $preventsim = shift;
5854             my $exeonfiles = shift;
5855             my $fileconfig = shift;
5856             my $swap = shift;
5857             my @themereports = @$swap;
5858             my $swap = shift;
5859             my @reporttitles = @$swap;
5860             my $swap = shift;
5861             my @retrievedata = @$swap;
5862              
5863             my $countersimmax = ( ( $#simdata + 1 ) / 4 );
5864             open(MORPHFILE, $morphfile) or die "Can't open $morphfile $!";
5865             #@dirs_to_simulate = grep -d, <$mypath/$filenew*>;
5866             @dirs_to_simulate = ;
5867             close MORPHFILE;
5868             print OUTFILE "\$morphfile: $morphfile. \@dirs_to_simulate: " . Dumper(@dirs_to_simulate) . "\n";
5869             my @ress;
5870             my @flfs;
5871              
5872             open (SIMLIST, ">$simlistfile") or die;
5873              
5874             my $countdir = 0;
5875             foreach my $dir_to_simulate (@dirs_to_simulate)
5876             {
5877             chomp($dir_to_simulate);
5878             my $countersim = 0;
5879             foreach my $date_to_sim (@simtitles)
5880             {
5881             my $simdataref = $simdata[$countersim];
5882             my @simdata = @{$simdataref};
5883            
5884             unless ( $preventsim eq "y")
5885             {
5886             my $resfile = "$dir_to_simulate-$date_to_sim.res";
5887             my $flfile = "$dir_to_simulate-$date_to_sim.fl";
5888             push (@ress, $resfile);
5889             push (@flfs, $flfile);
5890            
5891             unless (-e $resfile )
5892             {
5893             if ( $simnetwork eq "n" )
5894             {
5895             my $printthis =
5896             "bps -file $dir_to_simulate/cfg/$fileconfig -mode script<
5897              
5898             c
5899             $resfile
5900             $simdata[0 + (4*$countersim)]
5901             $simdata[1 + (4*$countersim)]
5902             $simdata[2 + (4*$countersim)]
5903             $simdata[3 + (4*$countersim)]
5904             s
5905             $simnetwork
5906             Results for $dir_to_simulate-$date_to_sim
5907             y
5908             y
5909             -
5910             -
5911             -
5912             -
5913             -
5914             -
5915             -
5916             XXX
5917             ";
5918             if ($exeonfiles eq "y")
5919             {
5920             print `$printthis`;
5921             }
5922             print TOSHELL $printthis;
5923             print SIMLIST "$resfile\n";
5924             }
5925            
5926             if ( $simnetwork eq "y" )
5927             {
5928             my $printthis =
5929             "bps -file $dir_to_simulate/cfg/$fileconfig -mode script<
5930              
5931             c
5932             $resfile
5933             $flfile
5934             $simdata[0 + (4*$countersim)]
5935             $simdata[1 + (4*$countersim)]
5936             $simdata[2 + (4*$countersim)]
5937             $simdata[3 + (4*$countersim)]
5938             s
5939             $simnetwork
5940             Results for $dir_to_simulate-$dates_to_sim
5941             y
5942             y
5943             -
5944             -
5945             -
5946             -
5947             -
5948             -
5949             -
5950             XXX
5951             ";
5952             if ($exeonfiles eq "y")
5953             {
5954             print `$printthis`;
5955             }
5956             print TOSHELL $printthis;
5957             print SIMLIST "$resfile\n";
5958             print OUTFILE "TWO, $resfile\n";
5959             }
5960             }
5961             }
5962             $countersim++;
5963             }
5964             $countdir++;
5965             }
5966              
5967             close SIMLIST;
5968             } # END SUB sim;
5969              
5970             # END OF THE CONTENT OF THE "opts_sim.pl" FILE.
5971             ##############################################################################
5972             ##############################################################################
5973             ##############################################################################
5974              
5975              
5976              
5977             # BEGINNING OF SUB RETRIEVE
5978             ##############################################################################
5979             ##############################################################################
5980             ##############################################################################
5981             sub retrieve
5982             {
5983             my $to = shift;
5984             my $mypath = shift;
5985             my $file = shift;
5986             my $filenew = shift;
5987             my $swap = shift;
5988             my @dowhat = @$swap;
5989             my $swap = shift;
5990             my @simdata = @$swap;
5991             my $simnetwork = shift;
5992             my $swap = shift;
5993             my @simtitles = @$swap;
5994             my $preventsim = shift;
5995             my $exeonfiles = shift;
5996             my $fileconfig = shift;
5997             my $swap = shift;
5998             my @themereports = @$swap;
5999             my $swap = shift;
6000             my @reporttitles = @$swap;
6001             my $swap = shift;
6002             my @retrievedata = @$swap;
6003              
6004             unless (-e "$mypath/results")
6005             {
6006             print `mkdir $mypath/results`;
6007             print TOSHELL "mkdir $mypath/results\n\n";
6008             }
6009              
6010             sub retrieve_temperatures_results
6011             {
6012             my $result = shift;
6013             my $resfile = shift;
6014             my $swap = shift;
6015             my @retrievedatatemps = @$swap;
6016             my $reporttitle = shift;
6017             my $stripcheck = shift;
6018             my $theme = shift;
6019             #my $existingfile = "$resfile-$theme.grt";
6020             #if (-e $existingfile) { print `chmod 777 $existingfile\n`;}
6021             #print TOSHELL "chmod 777 $existingfile\n";
6022             #if (-e $existingfile) { print `rm $existingfile\n` ;}
6023             #print TOSHELL "rm $existingfile\n";
6024             #if ($exeonfiles eq "y") { print `rm -f $existingfile*par\n`; }
6025             #print TOSHELL "rm -f $existingfile*par\n";
6026              
6027             unless (-e "$result-$reporttitle-$theme.grt-")
6028             {
6029             my $printthis =
6030             "res -file $resfile -mode script<
6031              
6032             3
6033             $retrievedatatemps[0]
6034             $retrievedatatemps[1]
6035             $retrievedatatemps[2]
6036             c
6037             g
6038             a
6039             a
6040             b
6041             a
6042             b
6043             e
6044             b
6045             f
6046             >
6047             a
6048             $result-$reporttitle-$theme.grt
6049             Simulation results $result-$reporttitle-$theme
6050             !
6051             -
6052             -
6053             -
6054             -
6055             -
6056             -
6057             -
6058             -
6059             YYY
6060             ";
6061             if ($exeonfiles eq "y")
6062             {
6063             print `$printthis`;
6064             }
6065             print TOSHELL $printthis;
6066             #if (-e $existingfile) { print `rm -f $existingfile*par`;}
6067             #print TOSHELL "rm -f $existingfile*par\n";
6068             }
6069             }
6070              
6071             sub retrieve_comfort_results
6072             {
6073             my $result = shift;
6074             my $resfile = shift;
6075             my $swap = shift;
6076             my @retrievedatacomf = @$swap;
6077             my $reporttitle = shift;
6078             my $stripcheck = shift;
6079             my $theme = shift;
6080             #my $existingfile = "$resfile-$theme.grt";
6081             #if (-e $existingfile) { print `chmod 777 $existingfile\n`;}
6082             #print TOSHELL "chmod 777 $existingfile\n";
6083             #if (-e $existingfile) { print `rm $existingfile\n` ;}
6084             #print TOSHELL "rm $existingfile\n";
6085             #if ($exeonfiles eq "y") { print `rm -f $existingfile*par\n`;}
6086             #print TOSHELL "rm -f $existingfile*par\n";
6087              
6088             unless (-e "$result-$reporttitle-$theme.grt-")
6089             {
6090             my $printthis =
6091             "res -file $resfile -mode script<
6092              
6093             3
6094             $retrievedatacomf[0]
6095             $retrievedatacomf[1]
6096             $retrievedatacomf[2]
6097             c
6098             g
6099             c
6100             a
6101              
6102             b
6103              
6104              
6105             a
6106             >
6107             a
6108             $result-$reporttitle-$theme.grt
6109             Simulation results $result-$reporttitle-$theme
6110             !
6111             -
6112             -
6113             -
6114             -
6115             -
6116             -
6117             -
6118             -
6119             ZZZ
6120             ";
6121             if ($exeonfiles eq "y")
6122             {
6123             print `$printthis`;
6124             }
6125             print TOSHELL $printthis;
6126             #if (-e $existingfile) { `rm -f $existingfile*par\n`;}
6127             #print TOSHELL "rm -f $existingfile*par\n";
6128             }
6129             }
6130              
6131             sub retrieve_loads_results
6132             {
6133             my $result = shift;
6134             my $resfile = shift;
6135             my $swap = shift;
6136             my @retrievedataloads = @$swap;
6137             my $reporttitle = shift;
6138             my $stripcheck = shift;
6139             my $theme = shift;
6140             #my $existingfile = "$resfile-$theme.grt";
6141             #if (-e $existingfile) { `chmod 777 $existingfile\n`;}
6142             #print TOSHELL "chmod 777 $existingfile\n";
6143             #if (-e $existingfile) { `rm $existingfile\n` ;}
6144             #print TOSHELL "rm $existingfile\n";
6145              
6146             unless (-e "$result-$reporttitle-$theme.grt-")
6147             {
6148             my $printthis =
6149             "res -file $resfile -mode script<
6150              
6151             3
6152             $retrievedataloads[0]
6153             $retrievedataloads[1]
6154             $retrievedataloads[2]
6155             d
6156             >
6157             a
6158             $result-$reporttitle-$theme.grt
6159             Simulation results $result-$reporttitle-$theme
6160             l
6161             a
6162              
6163             -
6164             -
6165             -
6166             -
6167             -
6168             -
6169             -
6170             TTT
6171             ";
6172             if ($exeonfiles eq "y")
6173             {
6174             print `$printthis`;
6175             }
6176             print TOSHELL $printthis;
6177              
6178             print RETRIEVELIST "$result-$reporttitle-$theme.grt ";
6179             if ($stripcheck)
6180             {
6181             open (CHECKDATUM, "$result-$reporttitle-$theme.grt") or die;
6182             open (STRIPPED, ">$result-$reporttitle-$theme.grt-") or die;
6183             my @lines = ;
6184             foreach my $line (@lines)
6185             {
6186             $line =~ s/^\s+//;
6187             @lineelms = split(/\s+|,/, $line);
6188             if ($lineelms[0] eq $stripcheck)
6189             {
6190             print STRIPPED "$line";
6191             }
6192             }
6193             close STRIPPED;
6194             close CHECKDATUM;
6195             }
6196             }
6197             }
6198              
6199             sub retrieve_temps_stats
6200             {
6201             my $result = shift;
6202             my $resfile = shift;
6203             my $swap = shift;
6204             my @retrievedatatempsstats = @$swap;
6205             my $reporttitle = shift;
6206             my $stripcheck = shift;
6207             my $theme = shift;
6208             #my $existingfile = "$resfile-$theme.grt";
6209             #if (-e $existingfile) { `chmod 777 $existingfile\n`; }
6210             #print TOSHELL "chmod 777 $existingfile\n";
6211             #if (-e $existingfile) { `rm $existingfile\n` ;}
6212             #print TOSHELL "rm $existingfile\n";
6213             #if (-e $existingfile) { `rm -f $existingfile*par\n`;}
6214             #print TOSHELL "rm -f $existingfile*par\n";
6215              
6216             unless (-e "$result-$reporttitle-$theme.grt-")
6217             {
6218             my $printthis =
6219             "res -file $resfile -mode script<
6220              
6221             3
6222             $retrievedatatempsstats[0]
6223             $retrievedatatempsstats[1]
6224             $retrievedatatempsstats[2]
6225             d
6226             >
6227             a
6228             $result-$reporttitle-$theme.grt
6229             Simulation results $result-$reporttitle-$theme.grt
6230             m
6231             -
6232             -
6233             -
6234             -
6235             -
6236             TTT
6237             ";
6238              
6239             if ($exeonfiles eq "y")
6240             {
6241             print `$printthis`;
6242             print OUTFILE "CALLED RETRIEVE TEMPS STATS\n";
6243             print OUTFILE "\$resfile: $resfile, \$retrievedataloads[0]: $retrievedataloads[0], \$retrievedataloads[1]: $retrievedataloads[1], \$retrievedataloads[2]:$retrievedataloads[2]\n";
6244             print OUTFILE "\$reporttitle: $reporttitle, \$theme: $theme\n";
6245             print OUTFILE "\$resfile-\$reporttitle-\$theme: $resfile-$reporttitle-$theme";
6246             }
6247             print TOSHELL $printthis;
6248              
6249             #if ($exeonfiles eq "y") { print `rm -f $existingfile*par\n`;}
6250             #print TOSHELL "rm -f $existingfile*par\n";
6251             print RETRIEVELIST "$resfile-$reporttitle-$theme.grt ";
6252             if ($stripcheck)
6253             {
6254             open (CHECKDATUM, "$result-$reporttitle-$theme.grt") or die;
6255             open (STRIPPED, ">$result-$reporttitle-$theme.grt-") or die;
6256             my @lines = ;
6257             foreach my $line (@lines)
6258             {
6259             $line =~ s/^\s+//;
6260             @lineelms = split(/\s+|,/, $line);
6261             if ($lineelms[0] eq $stripcheck)
6262             {
6263             print STRIPPED "$line";
6264             }
6265             }
6266             close STRIPPED;
6267             close CHECKDATUM;
6268             }
6269             }
6270             }
6271              
6272             open (OPENSIMS, "$simlistfile") or die;
6273             my @sims = ;
6274             # print OUTFILE "SIMS: " . Dumper(@sims) . "\n";
6275             close OPENSIMS;
6276            
6277             my $countertheme = 0;
6278             foreach my $themereportref (@themereports)
6279             {
6280             # print OUTFILE "SIMS: \n";
6281             my @themereports = @{$themereportref};
6282             my $reporttitlesref = $reporttitles[$countertheme];
6283             my @reporttitles = @{$reporttitlesref};
6284             my $retrievedatarefsdeep = $retrievedata[$countertheme];
6285             my @retrievedatarefs = @{$retrievedatarefsdeep};
6286             my $stripcheckref = $stripchecks[$countertheme];
6287             my @stripckecks = @{$stripcheckref};
6288            
6289             my $countreport = 0;
6290             foreach my $reporttitle (@reporttitles)
6291             {
6292             # print OUTFILE "SIMS: \n";
6293             my $theme = $themereports[$countreport];
6294             my $retrieveref = $retrievedatarefs[$countreport];
6295             my $stripcheck = $stripckecks[$countreport];
6296             my @retrievedata = @{$retrieveref};
6297             my $countersim = 0;
6298             foreach my $sim (@sims)
6299             {
6300             chomp($sim);
6301             my $targetprov = $sim;
6302             $targetprov =~ s/$mypath\/models\///;
6303             my $result = "$mypath" . "/results/$targetprov";
6304              
6305             if ( $theme eq "temps" ) { &retrieve_temperatures_results($result, $sim, \@retrievedata, $reporttitle, $stripcheck, $theme); }
6306             if ( $theme eq "comfort" ) { &retrieve_comfort_results($result, $sim, \@retrievedata, $reporttitle, $stripcheck, $theme); }
6307             if ( $theme eq "loads" ) { &retrieve_loads_results($result, $sim, \@retrievedata, $reporttitle, $stripcheck, $theme); }
6308             if ( $theme eq "tempsstats" ) { &retrieve_temps_stats($result, $sim, \@retrievedata, $reporttitle, $stripcheck, $theme); }
6309             print OUTFILE "\$sim: $sim, \$result: $result, \@retrievedata: @retrievedata, \$reporttitle: $reporttitle, \$stripcheck: $stripcheck, \$theme: $theme\n";
6310             $countersim++;
6311             }
6312             $countreport++;
6313             }
6314             $countertheme++;
6315             }
6316             print `rm -f ./results/*.grt`;
6317             print TOSHELL "rm -f ./results/*.grt\n";
6318             print `rm -f ./results/*.par`;
6319             print TOSHELL "rm -f ./results/*.par\n";
6320             } # END SUB RETRIEVE
6321            
6322             ##############################################################################
6323             ##############################################################################
6324             ##############################################################################
6325             # END SUB RETRIEVE
6326              
6327             sub report { ; } # NO MORE USED # This function retrieved the results of interest from the text file created by the "retrieve" function
6328              
6329             # BEGINNING OF SUB MERGE_REPORTS
6330             ##############################################################################
6331             ##############################################################################
6332             ##############################################################################
6333             sub merge_reports # Self-explaining
6334             {
6335             my $to = shift;
6336             my $mypath = shift;
6337             my $file = shift;
6338             my $filenew = shift;
6339             my $swap = shift;
6340             my @dowhat = @$swap;
6341             my $swap = shift;
6342             my @simdata = @$swap;
6343             my $simnetwork = shift;
6344             my $swap = shift;
6345             my @simtitles = @$swap;
6346             my $preventsim = shift;
6347             my $exeonfiles = shift;
6348             my $fileconfig = shift;
6349             my $swap = shift;
6350             my @themereports = @$swap;
6351             my $swap = shift;
6352             my @reporttitles = @$swap;
6353             my $swap = shift;
6354             my @retrievedata = @$swap;
6355             my $toshell = shift;
6356             my $outfile = shift;
6357             my $configfile = shift;
6358             my $swap = shift;
6359             my @rankdata = @$swap;
6360             my $swap = shift;
6361             my @rankcolumn = @$swap;
6362             my $swap = shift;
6363             my @reporttempsdata = @$swap;
6364             my $swap = shift;
6365             my @reportcomfortdata = @$swap;
6366             my $swap = shift;
6367             my @reportradiationenteringdata = @$swap;
6368             my $stripcheck = shift;
6369             my @columns_to_report = @{ $reporttempsdata[1] };
6370             my $number_of_columns_to_report = scalar(@columns_to_report);
6371             my $counterlines;
6372             my $number_of_dates_to_merge = scalar(@simtitles);
6373             my @dates = @simtitles;
6374             my $mergefile = "$mypath/$file-merge-$countcase-$countblock";
6375              
6376             sub merge
6377             {
6378             open (MERGEFILE, ">$mergefile") or die;
6379             open (FILECASELIST, "$simlistfile") or die;
6380             my @lines = ;
6381             close FILECASELIST;
6382             my $counterline = 1;
6383             foreach my $line (@lines)
6384             {
6385             chomp($line);
6386             my $morphcase = "$line";
6387             my $reportcase = $morphcase;
6388             $reportcase =~ s/\/models/\/results/;
6389             print MERGEFILE "CASE$counterline ";
6390             my $counterouter = 0;
6391             foreach my $themeref (@themereports)
6392             {
6393             my $counterinner = 0;
6394             my @themes = @{$themeref};
6395             foreach my $theme (@themes)
6396             {
6397             my $simtitle = $simtitles[$counterouter];
6398             my $reporttitle = $reporttitles[$counterouter][$counterinner];
6399             #print OUTFILE "FILE: $file, SIMTITLE: $simtitle, REPORTTITLE!: $reporttitle, THEME: $theme\n";
6400             my $case = "$reportcase-$reporttitle-$theme.grt-";
6401             #print OUTFILE "\$case $case\n";
6402             #if (-e $case) { print OUTFILE "IT EXISTS!\n"; }
6403             #print OUTFILE "$case\n";
6404             open(OPENTEMP, $case) or die;
6405             my @linez = ;
6406             close OPENTEMP;
6407             chomp($linez[0]);
6408             print MERGEFILE "$case $linez[0] ";
6409             $counterinner++;
6410             }
6411             $counterouter++;
6412             }
6413             print MERGEFILE "\n";
6414             $counterline++;
6415             }
6416             close MERGEFILE;
6417             }
6418             &merge();
6419              
6420             my $cleanfile = "$mergefile-clean";
6421             my $selectmerged = "$cleanfile-select";
6422             sub cleanselect
6423             { # CLEANS THE MERGED FILE AND SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE
6424             open ( MERGEFILE, $mergefile) or die;
6425             my @lines = ;
6426             close MERGEFILE;
6427             open ( CLEANMERGED, ">$cleanfile") or die;
6428             foreach my $line (@lines)
6429             {
6430             $line =~ s/\n/°/g;
6431             $line =~ s/\s+/,/g;
6432             $line =~ s/°/\n/g;
6433             print CLEANMERGED "$line";
6434             }
6435             close CLEANMERGED;
6436             # END. CLEANS THE MERGED FILE
6437            
6438             #SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE
6439             open (CLEANMERGED, $cleanfile) or die;
6440             my @lines = ;
6441             close CLEANMERGED;
6442             open (SELECTMERGED, ">$selectmerged") or die;
6443            
6444            
6445             foreach my $line (@lines)
6446             {
6447             my @elts = split(/\s+|,/, $line);
6448             my $counterouter = 0;
6449             foreach my $elmref (@keepcolumns)
6450             {
6451             my @cols = @{$elmref};
6452             my $counterinner = 0;
6453             foreach my $elm (@cols)
6454             {
6455             print SELECTMERGED "$elts[$elm]";
6456             if ( ( $counterouter < $#keepcolumns ) or ( $counterinner < $#cols) )
6457             {
6458             print SELECTMERGED ",";
6459             }
6460             else {print SELECTMERGED "\n";}
6461             $counterinner++;
6462             }
6463             $counterouter++;
6464             }
6465             }
6466             close SELECTMERGED;
6467             } # END. CLEANS THE MERGED FILE AND SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE
6468             &cleanselect();
6469            
6470             my $weight = "$selectmerged-weight"; # THIS WILL HOST PARTIALLY SCALED VALUES, MADE POSITIVE AND WITH A CELING OF 1
6471             sub weight
6472             {
6473             open (SELECTMERGED, $selectmerged) or die;
6474             my @lines = ;
6475             close SELECTMERGED;
6476             # print OUTFILE "FIRST LINE: $lines[0]\n";
6477             my $counterline = 0;
6478             open (WEIGHT, ">$weight") or die;
6479            
6480             my @containerone;
6481             foreach my $line (@lines)
6482             {
6483             $line =~ s/^[\n]//;
6484             #print OUTFILE "I SPLIT\n";
6485             my @elts = split(/\s+|,/, $line);
6486             my $countcol = 0;
6487             my $countel = 0;
6488             foreach my $elt (@elts)
6489             {
6490             #print OUTFILE "I CHECK\n";
6491             if ( odd($countel) )
6492             {
6493             # print OUTFILE "I PUSH\n";
6494             push ( @{$containerone[$countcol]}, $elt);
6495             #print OUTFILE "ELT: $elt\n";
6496             $countcol++;
6497             }
6498             $countel++;
6499             }
6500             }
6501             #print OUTFILE "CONTAINERONE " . Dumper(@containerone) . "\n";
6502            
6503             my @containertwo;
6504             my @containerthree;
6505             $countcolm = 0;
6506             my @optimals;
6507             foreach my $colref (@containerone)
6508             {
6509             my @column = @{$colref}; # DEREFERENCE
6510            
6511             if ( $weights[$countcolm] < 0 ) # TURNS EVERYTHING POSITIVE
6512             {
6513             foreach $el (@column)
6514             {
6515             $el = ($el * -1);
6516             }
6517             }
6518            
6519             if ( max(@column) != 0) # FILLS THE UNTRACTABLE VALUES
6520             {
6521             push (@maxes, max(@column));
6522             }
6523             else
6524             {
6525             push (@maxes, "NOTHING1");
6526             }
6527            
6528             #print OUTFILE "MAXES: " . Dumper(@maxes) . "\n";
6529             #print OUTFILE "DUMPCOLUMN: " . Dumper(@column) . "\n";
6530            
6531             foreach my $el (@column)
6532             {
6533             my $eltrans;
6534             if ( $maxes[$countcolm] != 0 )
6535             {
6536             #print OUTFILE "\$weights[\$countcolm]: $weights[$countcolm]\n";
6537             $eltrans = ( $el / $maxes[$countcolm] ) ;
6538             }
6539             else
6540             {
6541             $eltrans = "NOTHING2" ;
6542             }
6543             push ( @{$containertwo[$countcolm]}, $eltrans) ;
6544             #print OUTFILE "ELTRANS: $eltrans\n";
6545             }
6546             $countcolm++;
6547             }
6548             #print OUTFILE "CONTAINERTWO " . Dumper(@containertwo) . "\n";
6549            
6550             my $countline = 0;
6551             foreach my $line (@lines)
6552             {
6553             $line =~ s/^[\n]//;
6554             my @elts = split(/\s+|,/, $line);
6555             my $countcolm = 0;
6556             foreach $eltref (@containertwo)
6557             {
6558             my @col = @{$eltref};
6559             my $max = max(@col);
6560             #print OUTFILE "MAX: $max\n";
6561             my $min = min(@col);
6562             #print OUTFILE "MIN: $min\n";
6563             my $floordistance = ($max - $min);
6564             my $range = ( $min / $max);
6565             my $el = $col[$countline];
6566             my $rescaledel;
6567             if ( $floordistance != 0 )
6568             {
6569             $rescaledel = ( ( $el - $min ) / $floordistance ) ;
6570             }
6571             else
6572             {
6573             $rescaledel = 1;
6574             }
6575             if ( $weightsaim[$countcolm] < 0)
6576             {
6577             $rescaledel = ( 1 - $rescaledel);
6578             }
6579             push (@elts, $rescaledel);
6580             $countcolm++;
6581             }
6582            
6583             $countline++;
6584            
6585             my $counter = 0;
6586             foreach my $el (@elts)
6587             {
6588             print WEIGHT "$el";
6589             if ($counter < $#elts)
6590             {
6591             print WEIGHT ",";
6592             }
6593             else
6594             {
6595             print WEIGHT "\n";
6596             }
6597             $containerthree[$counterline][$counter] = $el;
6598             $counter++;
6599             }
6600             $counterline++;
6601             }
6602             close WEIGHT;
6603             #print OUTFILE "CONTAINERTHREE: " . Dumper(@containerthree) . "\n";
6604             }
6605             &weight(); #
6606            
6607             my $weighttwo = "$selectmerged-weighttwo"; # THIS WILL HOST PARTIALLY SCALED VALUES, MADE POSITIVE AND WITH A CELING OF 1
6608             sub weighttwo
6609             {
6610             open (WEIGHT, $weight) or die;
6611             my @lines = ;
6612             close WEIGHT;
6613             open (WEIGHTTWO, ">$weighttwo") or die;
6614             my $counterline;
6615             foreach my $line (@lines)
6616             {
6617             $line =~ s/^[\n]//;
6618             my @elts = split(/\s+|,/, $line);
6619             my $counterelt = 0;
6620             my $counterin = 0;
6621             my $sum = 0;
6622             my $avg;
6623             my $numberels = scalar(@keepcolumns);
6624             foreach my $elt (@elts)
6625             {
6626             my $newelt;
6627             if ($counterelt > ( $#elts - $numberels ))
6628             {
6629             #print OUTFILE "ELT: $elt\n";
6630             $newelt = ( $elt * abs($weights[$counterin]) );
6631             # print OUTFILE "ABS" . abs($weights[$counterin]) . "\n";
6632             # print OUTFILE "NEWELT: $newelt\n";
6633             $sum = ( $sum + $newelt ) ;
6634             # print OUTFILE "SUM: $sum\n";
6635             $counterin++;
6636             }
6637             $counterelt++;
6638             }
6639             $avg = ($sum / scalar(@keepcolumns) );
6640             push ( @elts, $avg);
6641            
6642             my $counter = 0;
6643             foreach my $elt (@elts)
6644             {
6645             print WEIGHTTWO "$elt";
6646             if ($counter < $#elts)
6647             {
6648             print WEIGHTTWO ",";
6649             }
6650             else
6651             {
6652             print WEIGHTTWO "\n";
6653             }
6654             $counter++;
6655             }
6656             $counterline++
6657             }
6658             }
6659             &weighttwo();
6660              
6661             $sortmerged = "$mergefile-sortmerged";
6662             sub sortmerged
6663             {
6664             open (WEIGHTTWO, $weighttwo) or die;
6665             open (SORTMERGED, ">$sortmerged") or die;
6666             my @lines = ;
6667             close WEIGHTTWO;
6668             my $line = $lines[0];
6669             $line =~ s/^[\n]//;
6670             my @eltstemp = split(/\s+|,/, $line);
6671             my $numberelts = scalar(@eltstemp);
6672             if ($numberelts > 0) { print SORTMERGED `sort -n -k$numberelts,$numberelts -t , $weighttwo`; }
6673             # print SORTMERGED `sort -n -k$numberelts -n $weighttwo`;
6674             close SORTMERGED;
6675             }
6676             &sortmerged();
6677             } # END SUB merge_reports
6678              
6679             #################################################################
6680             #################################################################
6681             #################################################################
6682             # END OF SUB MERGE_REPORTS
6683            
6684             if (-e "./SIM/OPTS/convertandfilter.pl")
6685             {
6686             eval `cat ./SIM/OPTS/convertandfilter.pl`;
6687             }
6688              
6689             if (-e "./SIM/OPTS/maketable.pl")
6690             {
6691             eval `cat ./SIM/OPTS/maketable.pl`;
6692             }
6693            
6694             # END OF THE CONTENT OF THE "opts_format.pl" FILE.
6695             ##############################################################################
6696             ##############################################################################
6697             ##############################################################################
6698            
6699            
6700             # BEGINNING OF SUB TAKEOPTIMA
6701             #################################################################
6702             #################################################################
6703             #################################################################
6704             sub takeoptima
6705             {
6706             $fileuplift = "$file-uplift-$countcase-$countblock";
6707             open(UPLIFT, ">$fileuplift") or die;
6708             my $to = shift;
6709             my $mypath = shift;
6710             my $file = shift;
6711             my $filenew = shift;
6712             my $sortmerged = shift;
6713             my (@winnerarray_tested, @winnerarray_nontested, @winnerarray, @nontested, @provcontainer);
6714             @uplift = ();
6715             @downlift = ();
6716            
6717             open (SORTMERGED, $sortmerged) or die;
6718             say OUTFILE "\$sortmerged: $sortmerged";
6719             my @lines = ;
6720             close SORTMERGED;
6721            
6722             my $winnerentry = $lines[0];
6723             chomp $winnerentry;
6724             say OUTFILE "\$winnerentry: $winnerentry";
6725             my @winnerelts = split(/\s+|,/, $winnerentry);
6726             my $winnerline = $winnerelts[0];
6727            
6728             say OUTFILE "YESHERE TAKEOPTIMA 1 ";
6729            
6730             foreach my $var (@totvarnumbers)
6731             {
6732             if ( $winnerline =~ /($var-\d+)/ )
6733             {
6734             my $fragment = $1;
6735             say OUTFILE "\$fragment: $fragment";
6736             push (@winnerarray_tested, $fragment);
6737             }
6738             }
6739            
6740             foreach my $elt (@varn)
6741             {
6742             unless ( $elt ~~ @totvarnumbers)
6743             {
6744             push (@nontested, $elt);
6745             }
6746             }
6747             @nontested = uniq(@nontested);
6748             @nontested = sort(@nontested);
6749            
6750             foreach my $el ( @nontested )
6751             {
6752             my $item = "$el-" . "$midvalues[$el]";
6753             push(@winnerarray_nontested, $item);
6754             }
6755             @winnerarray = (@winnerarray_tested, @winnerarray_nontested);
6756             @winnerarray = uniq(@winnerarray);
6757             @winnerarray = sort(@winnerarray);
6758            
6759             $winnermodel = "$filenew"; #BEGINNING
6760             $count = 0;
6761             foreach $elt (@winnerarray)
6762             {
6763             unless ($count == $#winnerarray)
6764             {
6765             $winnermodel = "$winnermodel" . "$elt" . "_";
6766             }
6767             else
6768             {
6769             $winnermodel = "$winnermodel" . "$elt";
6770             }
6771             $count++;
6772             }
6773            
6774             unless ( ($countvar == $#varnumbers) and ($countblock == $#blocks) )
6775             {
6776             if (@overlap)
6777             {
6778             my @nonoverlap;
6779             foreach my $elm (@varn)
6780             {
6781             unless ( $elm ~~ @overlap)
6782             {
6783             push ( @nonoverlap, $elm);
6784             }
6785             }
6786            
6787             my @present;
6788             foreach my $elt (@nonoverlap)
6789             {
6790             if ( $winnermodel =~ /($elt-\d+)/ )
6791             {
6792             push(@present, $1);
6793             }
6794             }
6795            
6796             my @extraneous;
6797             foreach my $el (@nonoverlap)
6798             {
6799             my $stepsvarthat = ${ "stepsvar" . "$el" };
6800             my $step = 1;
6801             while ( $step <= $stepsvarthat )
6802             {
6803             my $item = "$el" . "-" . "$step";
6804             unless ( $item ~~ @present )
6805             {
6806             push(@extraneous, $item);
6807             }
6808             $step++;
6809             }
6810             }
6811            
6812             open(MORPHFILE, "$morphfile") or die;
6813             my @models = ;
6814             close MORPHFILE;
6815            
6816             foreach my $model (@models)
6817             {
6818             chomp($model);
6819             my $counter = 0;
6820             foreach my $elt (@extraneous)
6821             {
6822             if( $model =~ /$elt/ )
6823             {
6824             $counter++;
6825             }
6826             }
6827             if ($counter == 0)
6828             {
6829             push(@seedfiles, $model);
6830             }
6831             }
6832             }
6833             else
6834             {
6835             push(@seedfiles, $winnermodel);
6836             }
6837             }
6838            
6839             @seedfiles = uniq(@seedfiles);
6840             @seedfiles = sort(@seedfiles);
6841             foreach my $seed (@seedfiles)
6842             {
6843             my $touchfile = $seed;
6844             $touchfile =~ s/_+$//;
6845             $touchfile = "$touchfile" . "_";
6846             push(@uplift, $touchfile);
6847             unless (-e "$touchfile")
6848             {
6849             if ( $exeonfiles eq "y" ) { print `cp -r $seed $touchfile` ; }
6850             print TOSHELL "cp -r $seed $touchfile\n\n";
6851             #if ( $exeonfiles eq "y" ) { print `mv -f $seed $touchfile` ; }
6852             #print TOSHELL "mv -f $seed $touchfile\n\n";
6853             }
6854             else
6855             {
6856             #if ( $exeonfiles eq "y" ) { print `rm -R $seed` ; }
6857             #print TOSHELL "rm -R $seed\n\n";
6858             }
6859             }
6860            
6861             foreach my $elt ( @uplift )
6862             {
6863             print UPLIFT "$elt\n";
6864             }
6865             close UPLIFT;
6866             }
6867              
6868             ###################################################################
6869             #################################################################
6870             #################################################################
6871             # END OF SUB TAKEOPTIMA
6872            
6873              
6874             sub rank_reports { ; } # ERASED
6875              
6876             if ( $dowhat[0] eq "y" )
6877             {
6878             { &morph( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6879             \@simtitles, $preventsim, $exeonfiles, $fileconfig,
6880             \@themereports, \@reporttitles, \@retrievedata, \@varnumbers, $countblock, $countcase); }
6881             }
6882              
6883             if ( $dowhat[1] eq "y" )
6884             {
6885             &sim( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6886             \@simtitles, $preventsim, $exeonfiles, $fileconfig,
6887             \@themereports, \@reporttitles, \@retrievedata);
6888             }
6889            
6890             if ( $dowhat[2] eq "y" )
6891             {
6892             &retrieve( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6893             \@simtitles, $preventsim, $exeonfiles, $fileconfig,
6894             \@themereports, \@reporttitles, \@retrievedata );
6895             }
6896            
6897             if ( $dowhat[4] eq "y" )
6898             {
6899             &report( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6900             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6901             \@rankdata, \@rankcolumn, \@reporttempsdata,
6902             \@reportcomfortdata, \@reportradiationenteringdata, $stripcheck ); }
6903              
6904             if ( $dowhat[5] eq "y" )
6905             { &merge_reports( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6906             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6907             \@rankdata, \@rankcolumn, \@reporttempsdata,
6908             \@reportcomfortdata, \@reportradiationenteringdata, $stripcheck );
6909             }
6910              
6911             if ( $dowhat[6] eq "y" )
6912             {
6913             &convert_report( \@varthemes_variations, \@varthemes_steps, $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6914             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6915             \@rankdata, \@rankcolumn, \@reporttempsdata,
6916             \@reportcomfortdata, \@reportradiationenteringdata, $stripcheck ); # NAMES VARIABLES IN REPORTS
6917             }
6918             if ( $dowhat[10] eq "y" )
6919             {
6920             &takeoptima( $to, $mypath, $file, $filenew, $sortmerged); # CHECK THE WINNING CASE AND USES IT FOR BLOCK SEARCH IF POSSIBLE
6921             }
6922             if ( $dowhat[7] eq "y" )
6923             {
6924             &filter_reports( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6925             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6926             \@rankdata, \@rankcolumn, \@reporttempsdata, \@reportcomfortdata,
6927             \@reportradiationenteringdata, $stripcheck ); # FILTERS ALREADY CONVERTED REPORTS
6928             }
6929             if ( $dowhat[8] eq "y" )
6930             {
6931             &convert_filtered_reports( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6932             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6933             \@rankdata, \@rankcolumn, \@reporttempsdata, \@reportcomfortdata,
6934             \@reportradiationenteringdata, $stripcheck ); # CONVERTS ALREADY FILTERED REPORTS
6935             }
6936             if ( $dowhat[9] eq "y" )
6937             {
6938             &maketable( $to, $mypath, $file, $filenew, \@dowhat, \@simdata, $simnetwork,
6939             \@simtitles, $preventsim, $exeonfiles, $fileconfig, \@themereports, \@reporttitles, \@retrievedata,
6940             \@rankdata, \@rankcolumn, \@reporttempsdata,
6941             \@reportcomfortdata, \@reportradiationenteringdata, $stripcheck ); # CONVERTS TO TABLE ALREADY FILTERED REPORTS
6942             }
6943             } # END SUB exec
6944             ###########################################################################################
6945             ###########################################################################################
6946             ###########################################################################################
6947              
6948             ###########################################################################################
6949             ###########################################################################################
6950             # BELOW IS THE PART OF THE PROGRAM THAT LAUNCHES OPTS.
6951            
6952            
6953             # HERE IS A SPACE FOR GENERAL FUNCTIONS USED BY THE PROGRAM
6954             ###########################################################
6955             ###########################################################
6956              
6957             sub odd
6958             {
6959             my $number = shift;
6960             return !even ($number);
6961             }
6962              
6963             sub even
6964             {
6965             my $number = abs shift;
6966             return 1 if $number == 0;
6967             return odd ($number - 1);
6968             }
6969              
6970             sub _mean_ { return @_ ? sum(@_) / @_ : 0 }
6971              
6972             ###########################################################
6973             ###########################################################
6974             # END OF THE SPACE FOR GENERAL FUNCTIONS
6975            
6976              
6977            
6978             ##########################################################################################
6979             ##########################################################################################
6980             # BEGINNING OF THE INSTRUCTIONS THAT LAUNCH OPTS AT EACH SUBSPACE SEARCH CYCLE.
6981            
6982             if ( ( (-e $casefile) and (-e $chancefile) ) or ( (-e $caseseed) and (-e $chanceseed) ) )
6983             {
6984             eval "$casefile"; # THIS BRINGS @casedata AND MAYBE @casegroup (OR PRODUCES IT).
6985             eval "$chancefile"; # THIS BRINGS @chanceseries.
6986             my @cancelineelms;
6987             my $countcase = 0;
6988             if ( $generatechance eq "n" )
6989             {
6990             my $countcase = 0;
6991             foreach my $case (@casegroup) # in $casefile there may be a @casegroup. If not, it is fabricated from @casedescription and @chancefile
6992             {
6993             my @blockrefs = @{$case};
6994             my $countblock = 1;
6995             my (@varnumbers, @newvarnumbers, @chance, @newchance);
6996            
6997             foreach my $blockref (@blockrefs)
6998             {
6999             my @overlap;
7000             @varnumbers = @{$varn[$countcase][$countblock-1]};
7001             my $number_of_variables = scalar(@varnumbers); $parameters = $number_of_variables;
7002             my @blockelts = @{$blockref};
7003             $blockelts[0] = ( $blockelts[0] + $number_of_variables );
7004             my @newblockelts = @{$blockref[$countblock]};
7005             $newblockelts[0] = ( $newblockelts[0] + $number_of_variables );
7006              
7007             sub def_filenew
7008             {
7009             $filenew = "$mypath/models/$file" . "_";
7010             my $counterfn = 0;
7011             foreach my $el (@varn)
7012             {
7013             $filenew = "$filenew" . "$varn[$counterfn]" . "-" . "$midvalues[$countblock]" . "_" ;
7014             $counterfn++;
7015             }
7016             }
7017             if ($countblock == 1)
7018             {
7019             &def_filenew;
7020             @uplift = ($filenew);
7021             @downlift = ($filenew);
7022             }
7023            
7024             foreach my $el (@varnumbers)
7025             {
7026             foreach my $elt (@newvarnumbers)
7027             {
7028             if ( $el eq $elt)
7029             {
7030             push (@overlap, $el);
7031             }
7032             }
7033             }
7034             @overlap = sort(@overlap);
7035             &exec(\@varnumbers, $countblock, $countcase, \@newvarnumbers, \@uplift, \@downlift, \@blocks, \@blockelts, \@newblockelts, \@overlap);
7036             $countblock++;
7037             }
7038             $countcase++;
7039             }
7040            
7041            
7042            
7043            
7044            
7045            
7046            
7047            
7048             elsif ( $generatechance eq "y" )
7049             {
7050             my $countcase = 0;
7051             foreach my $case (@caseseed) # in $casefile there may be a @casegroup. If not, it is fabricated from @casedescription and @chancefile
7052             {
7053             my @blockrefs = @{$case};
7054            
7055             my $countblock = 1;
7056             my (@varnumbers, @newvarnumbers, @chance, @newchance);
7057            
7058            
7059             ################################
7060             #>
7061             $countblocks = 0;
7062            
7063             $iter = $iters[$countcase];
7064             my $countfirstline = 0;
7065             my $totalsize;
7066             my $totaloverlapsize;
7067             my $totalnetsize;
7068             my @localcommonances;
7069             my @commonanceratios;
7070            
7071             my $commonalityflow;
7072             my $recombinationflow,
7073             my $informationflow;
7074              
7075             my $totalcommonalityflow;
7076             my $totalrecombinationflow;
7077             my $totalinformationflow;
7078              
7079             my $cumulativecommonalityflow;
7080             my $cumulativerecombinationflow;
7081             my $cumulativeinformationflow;
7082            
7083             my $localcommonalityflow;
7084             my $localrecombinationflow;
7085             my $localinformationflow;
7086            
7087              
7088             my $addcommonalityflow;
7089             my $addrecombinationflow;
7090             my $addinformationflow;
7091            
7092            
7093             my $remembercommonalityflow;
7094             my $rememberrecombinationflow;
7095             my $rememberinformationflow;
7096              
7097             my $cumulativecommonalityflow;
7098             my $cumulativerecombinationflow;
7099             my $cumulativeinformationflow;
7100            
7101             my $localrecombinationratio;
7102            
7103             my $heritageleft;
7104             my $heritagecentre;
7105             my $heritageright;
7106             my $previousblock;
7107            
7108             my $flatoverlapage;
7109             my $rootexpoverlapage;
7110             my $expoverlapage;
7111             my $flatweightedoverlapage;
7112             my $expweightedoverlapage;
7113             my $overlap;
7114             my $iruif;
7115             my @commonalities;
7116             my @commonalitiespe;
7117             my @recombinations;
7118             my @informations;
7119            
7120             my $stdcommonality;
7121             my $stdrecombination;
7122             my $stdinformation;
7123            
7124             my $stdfatminus;
7125             my $stdshadow;
7126            
7127             my $localrecombinalityminusratio;
7128             my $localrecombinalityratio;
7129             my $localrenewalratio;
7130            
7131             my $recombinalityminusflow;
7132             my $recombinalityflow;
7133             my $renewalflow;
7134            
7135             my $cumulativerecombinalityminusflow;#
7136             my $totalrecombinalityminusflow;#
7137             my $cumulativerecombinalityflow;#
7138             my $totalrecombinalityflow;#
7139             my $cumulativerenewalflow;#
7140             my $totalrenewalflow;#
7141            
7142             my $infminusflow;
7143             my $cumulativeinfminusflow;
7144             my $totalinfminusflow;
7145            
7146             my $infflow;
7147             my $cumulativeinfflow;
7148             my $totalinfflow;
7149            
7150             my $infoflow;
7151             my $cumulativeinfoflow;
7152             my $totalinfoflow;
7153            
7154             my @groupminus;
7155             my @unionminus;
7156             my $refreshmentminus;
7157            
7158             my @group;
7159             my @union;
7160             my $refreshment;
7161            
7162             my @basketminusnow;
7163             my @unionminus;
7164             my $n_basketminus;
7165             my $n_unionminus;
7166            
7167             my @basketnow;
7168             my @union;
7169             my $n_basket;
7170             my $n_union;
7171            
7172             my $recombination_ratio;
7173            
7174             my $proportionhike;
7175            
7176             my $iruifflow;
7177             my $cumulativeiruif;
7178             my $totaliruif;
7179            
7180             my ($commonalityflowproduct, $commonalityflowenhanced, $commonalityflowproductenhanced);
7181             my ($cumulativecommonalityflowproduct, $cumulativecommonalityflowenhanced, $cumulativecommonalityflowproductenhanced);
7182              
7183             my @basketageexport;
7184             my $averageageexport;
7185             my $cumulativeage;
7186             my $refreshratio;
7187            
7188             my $flowratio;
7189             my $cumulativeflowratio;
7190              
7191             my $flowageratio;
7192             my $cumulativeflowageratio;
7193              
7194             my $shadowexport;
7195            
7196             my $modiflow;
7197             my $cumulativemodiflow;
7198             my $cumulativehike;
7199             my $cumulativerefreshment;
7200             my $reshmentperformance;
7201             my $reshmentsize;
7202             my $cumulativerefreshmentperformance;
7203             my $refreshmentvolume;
7204             my $IRUIF;
7205             my $mmIRUIF;
7206             my @basketlast;
7207             my @newbasket;
7208             my $averageage;
7209             my @valuebasket;
7210             my $roofopsvalue = 10;
7211             my $otherIRUIF;
7212             my $othermmIRUIF;
7213             my @otherbasket;
7214             my @basketcount;
7215             my @finalbasket;
7216             my @mmbasketresult;
7217             my @mmbasketregen;
7218             my $mmresult;
7219             my $mmregen;
7220             my ($sumnovelty,$lastindicator,$IRUIFnovelty,$IRUIFlastindicator,$IRUIFnoveltysquare,$IRUIFlastindicatorsquare,$IRUIFnoveltycube,$IRUIFlastindicatorcube);
7221             my @pastjump;
7222             my @pastbunch;
7223             my @resbunches;
7224             my @scores;
7225             my $score;
7226            
7227             #>
7228             ######################à
7229            
7230             foreach my $blockref (@blockrefs)
7231             {
7232             my @overlap;
7233             @varnumbers = @{$varn[$countcase][$countblock-1]};
7234             push (@chancelineelms, [ @varnumbers, @varnumbers, @varnumbers ]); # THIS SHOULD BE USEFUL SOONER OR LATER
7235             my $number_of_variables = scalar(@varnumbers); $parameters = $number_of_variables;
7236             my @blockelts = @{$blockref};
7237             foreach (@blockelts)
7238             {
7239             $blockelts[0] = ( $blockelts[0] + $number_of_variables );
7240             }
7241            
7242             my $countertwo = 1;
7243             while ($countertwo <= 3)
7244             {
7245            
7246             my $counterone = 1;
7247             my @pos;
7248             while ($counterone <= $number_of_variables)
7249             {
7250             push (@pos, $counterone);
7251             $counterone++;
7252             }
7253             $countertwo++;
7254             }
7255            
7256             my @current_chanceseedgroup = @{$chancedata[$countcase]};
7257             my @current_chanceseed = @{$current_chanceseedgroup[0]}:
7258            
7259             my @current_chancedata = @{$chancedata[$countcase]};
7260             my $number_ofseedblocks = scalar(@blockelts);
7261             my $block_length = $current_chancedata[0];
7262             my $block_overlap = $current_chancedata[1];
7263             my $number_ofsweeps = $current_chancedata[2];
7264              
7265             my $totalblock_num = ( $number_ofblocks * $number_of_sweeps );
7266             my $number_ofblockstobuild = ( $totalblock_num - $number_ofseedblocks );
7267            
7268             my @wasteblockelts = @blockelts;
7269             my $countbuild = 1;
7270             while ($countbuild <= $number_ofblockstobuild)
7271             {
7272             my @chanceproduct = shuffle(@current_chanceseed)
7273             my $beginning = int(rand(@$block_length) + $number_of_variables);
7274             my @candidateblock_toadd = ($beginninng, $block_length);
7275             my @blockelts_totest = push ( @wasteblockelts, [ @candidateblock_toadd ] );
7276             my @iters = scalar(@blockelts_totest);
7277            
7278            
7279            
7280            
7281            
7282             #############################################
7283             #>
7284            
7285             my @blk = @{$blockref};
7286             my $attachment = $blk[0];
7287             my $activeblock = $blk[1];
7288             my $zoneend = $blk[3];
7289             my $pastattachment;
7290             my $pastactiveblock;
7291             my $pastzoneend;
7292             my $viewsize = $activeblock;
7293            
7294             #print "\@blk:@blk\n";
7295              
7296             my @zoneoverlaps;
7297             my @meanoverlaps;
7298             my @zoneoverlapsize;
7299             my @meanoverlapsize;
7300             my $roofops = 1;
7301             my $countops = $roofops;
7302             my $counter = 0;
7303             while ($countops > 0)
7304             {
7305             my @pastblk = @{$blockrefs[$countblocks - $countops]};
7306             if ($countblocks == 0) { @pastblk = ""; }
7307            
7308             #print "\@pastblk:@pastblk\n";
7309             $pastattachment = $pastblk[0];
7310             $pastactiveblock = $pastblk[2];
7311             $pastzoneend = $pastblk[3];
7312             my @presentslice = @pos[ $attachment..($attachment+$activeblock-1) ];
7313             my @pastslice = @pos[ $pastattachment..($pastattachment+$pastactiveblock-1) ];
7314             my $lc = List::Compare->new(\@presentslice, \@pastslice);
7315             my @intersection = $lc->get_intersection;
7316             my $localoverlap = scalar(@intersection);
7317             push (@meanoverlapsize, $localoverlap);
7318             my $overlapsum = 0;
7319             for ( @meanoverlapsize ) { $overlapsum += $_; }
7320             $overlap = $overlapsum ;
7321             if ($countblocks == 0) { $overlap = 0; }
7322             # print "overlap: $overlap\n\n";
7323             $countops--;
7324             $counter++;
7325             }
7326            
7327             $gohere = "yes";
7328             if ($gohere eq "yes")
7329             {
7330             my $roofops = 2;
7331             my $countops = $roofops;
7332             my $counter = 0;
7333             my @zoneoverlaps;
7334             my @meanoverlaps;
7335             my @zoneoverlapsize;
7336             my @meanoverlapsize;
7337             my @basketminus;
7338             while ($countops > 1)
7339             {
7340             my @pastblk = @{$blockrefs[$countblocks - $countops]};
7341             $pastattachment = $pastblk[0];
7342             $pastactiveblock = $pastblk[2];
7343             $pastzoneend = $pastblk[3];
7344             my @presentslice = @pos[ $attachment..($attachment+$activeblock-1) ];
7345             my @pastslice = @pos[ $pastattachment..($pastattachment+$pastactiveblock-1) ];
7346             my $lc = List::Compare->new(\@presentslice, \@pastslice);
7347             my @intersection = $lc->get_intersection;
7348             push (@basketminus, @intersection);
7349             #print "\@basketminus:@basket\n";
7350             $stdfatminus = stddev(@basket);
7351             my $localoverlap = scalar(@intersection);
7352             my $localoverlapsize = $localoverlap; # STEPS HAS TO BE MADE MORE GENERAL, FOR DIVERSE BLOCK SIZES IN A SEARCH.
7353             push (@meanoverlapsize, $localoverlap);
7354             my $overlapsum = 0;
7355             for ( @meanoverlapsize ) { $overlapsum += $_; }
7356             $overlapminus = ($overlapsum );
7357             @basketminusnow = @basketminus;
7358             $countops--;
7359             $counter++;
7360             }
7361             }
7362             @unionminus = uniq(@basketminusnow);
7363             $n_basketminus = scalar(@basketminusnow);
7364             $n_unionminus = scalar (@unionminus);
7365             if ( $n_unionminus == 0) {$n_unionminus = 1;};
7366             if ( $n_basketminus == 0) {$n_basketminus = 1;};
7367             $refreshmentminus = ( ( $n_unionminus / $n_basketminus ) );
7368             #print REPORTFILE "\@basketminusnow:@basketminusnow, \@unionminus:@unionminus,\$refreshmentminus:$refreshmentminus\n";
7369              
7370             $goheretoo = "yes";
7371             if ($goheretoo eq "yes")
7372             {
7373             my @zoneoverlaps;
7374             my @meanoverlaps;
7375             my @zoneoverlapsize;
7376             my @meanoverlapsize;
7377             my @zoneoverlapweightedsize;
7378             my @meanoverlapweightedsize;
7379             #my $roofops = $activeblock; ########## TAKE CARE!!!!!
7380             # my $roofops = $parameters / 2;
7381             my $roofops = $roofopsvalue;
7382             # my $roofops = $activeblock;
7383             # my $roofops = $parameters;
7384             my $countops = 1;
7385             my $flatoverlapsum;
7386             my $expoverlapsum;
7387             my $flatweightedoverlapsum;
7388             my $expweightedoverlapsum;
7389             my $counter = 0;
7390             my $countage = $roofops;
7391             my @basket;
7392            
7393             my @basketage;
7394             my $averageage;
7395             my @freshbasket;
7396             @basketnow;
7397             while ($countops < $roofops)
7398             {
7399             my @pastblk = @{$blockrefs[$countblocks - $countops]};
7400             $pastattachment = $pastblk[0];
7401             $pastactiveblock = $pastblk[2];
7402             $pastzoneend = $pastblk[3];
7403             #my @presentslice = @pos[ $attachment..($attachment+$activeblock-1) ];
7404             #foreach my $int (@presentslice) { $int = "$int" . "-" . "$countops"; }
7405             my @pastslice = @pos[ $pastattachment..($pastattachment+$pastactiveblock-1) ];
7406             my @otherslice = @pastslice;
7407             foreach my $int (@pastslice) { $int = "$int" . "-" . "$countops"; }
7408             #my $lc = List::Compare->new(\@presentslice, \@pastslice);
7409             #my @intersection = $lc->get_intersection;
7410             #my @newintersection = @intersection;
7411             #if ($countops == $roofops) {push (@basket, @presentslice, @pastslice);}
7412             if ($countops <= $roofops) {push (@basket, @pastslice);}
7413             if ($countops <= $roofops) {push (@otherbasket, @otherslice);}
7414             @newbasket = @basket;
7415            
7416            
7417             @basketnow = @newbasket;
7418             @activeblk = @presentslice;
7419            
7420             $countops++;
7421             $counter++;
7422             $countage--;
7423             }
7424             }
7425            
7426            
7427             my @integralslice = @pos[10..19];
7428             my @valuebasket;
7429             foreach my $el (@integralslice)
7430             {
7431             my @freshbasket;
7432             foreach my $elm (@basketnow)
7433             {
7434             my $elmo = $elm;
7435             $elmo =~ s/(.*)-(.*)/$1/;
7436             if ($el eq $elmo)
7437             {
7438             push (@freshbasket, $elm);
7439             }
7440             }
7441             @freshbasket = sort(@freshbasket);
7442             #print "freshbasket:@freshbasket\n";
7443            
7444             my $winelm = $freshbasket[0];
7445             # print "winelm: $winelm\n";
7446             push (@valuebasket,$winelm);
7447            
7448             foreach my $elt (@integralslice)
7449             {
7450             foreach my $elem (@valuebasket)
7451             {
7452             unless ($elem eq "")
7453             {
7454             my $elmo = $elem;
7455             $elmo =~ s/(.*)-(.*)/$1/;
7456             #print "sequence:$countcase,\$countblocks:$countblocks,\@valuebasket:@valuebasket,elmo:$elmo,n\n";
7457             if ($elmo ~~ @integralslice)
7458             {
7459             #print "there's $elmo\n";
7460             }
7461             else
7462             {
7463             #print "there isn't $elmo\n";
7464             if ($countblocks > $roofops){ my $eltinsert = "$elmo" . "-" . "$roofops";}
7465             else { my $eltinsert = "$elmo" . "-" . "$countblocks";}
7466             push (@valuebasket, $eltinsert);
7467             }
7468             }
7469             }
7470             }
7471            
7472             }
7473            
7474            
7475            
7476            
7477            
7478             #print "valuebasket: @valuebasket\n";
7479            
7480             my $sumvalues = 0;
7481             my @finalbasket;
7482             foreach my $el (@valuebasket)
7483             {
7484             my $elmo = $el;
7485             $elmo =~ s/(.*)-(.*)/$2/;
7486             $sumvalues = $sumvalues + $elmo;
7487             push (@finalbasket, $elmo);
7488            
7489             }
7490            
7491            
7492             my $sizeloop = max(@finalbasket);
7493            
7494              
7495             my @presentjump;
7496             my @presentbunch;
7497             my @resbunch;
7498             if ($countblocks > 1)
7499             {
7500             my @pastblk = @{$blockrefs[$countblocks - 1]};
7501             my @presentblk = @{$blockrefs[$countblocks]};
7502             my $pastattachment = $pastblk[0];
7503             my $pastactiveblock = $pastblk[2];
7504             my $pastzoneend = $pastblk[3];
7505             my @pastslice = @pos[ $pastattachment..($pastattachment+$pastactiveblock-1) ];
7506             my @presentslice = @pos[ $attachment..($attachment+$activeblock-1) ];
7507              
7508             my $counter = 0;
7509             foreach my $presentelm (@presentslice)
7510             {
7511             my $pastelm = $pastslice[$counter];
7512             my $joint = "$pastelm" . "-" . "$presentelm";
7513             push (@resbunch, $joint);
7514             $counter++;
7515             }
7516            
7517             push (@resbunches, [@resbunch]);
7518             my @presentbunch = @{$resbunches[0]};
7519             my $countthis = 0;
7520             foreach my $elm (@resbunches)
7521             {
7522             unless ($countthis == 0)
7523             {
7524             my @pastbunch = @{$elm};
7525             my $lc = List::Compare->new(\@presentbunch, \@pastbunch);
7526             my @intersection = $lc->get_intersection;
7527            
7528             push ( @scores, scalar(@intersection));
7529             #print "presentbunch:@presentbunch, pastbunch:@pastbunch, intersection:@intersection, \nscores:@scores\n\n";
7530             }
7531             $countthis++;
7532             }
7533             #print "scores; @scores\n";
7534             $score = max(@scores);
7535             #print "scalarpresentjump: " . scalar(@presentjump) . "\n";
7536             my $newoccurrences = $activeblock - $score;
7537             $novelty = $newoccurrences / $number_of_variables ; # NSM, Novelty of the Search Move
7538             # my $novelty = ($steps ** $newoccurrences) / ($steps ** $number_of_variables );
7539              
7540             }
7541            
7542             my $averageage = ($sumvalues / $parameters);
7543            
7544             my $n1_averageage = 1 / $averageage; # FSW, Freshness of the Search Wake
7545            
7546            
7547             my $lastindicator = ($n1_averageage * $novelty); # URR, Usefulness of Recursive Recombination
7548             # my $lastindicator = ($n1_averageage * $sumnovelty ) ** ( 1 / 2 );
7549            
7550             my $stddev = stddev(@finalbasket);
7551            
7552             if ($stddev == 0) {$stddev = 0.0001;}
7553            
7554             my $n1_stddev = 1 / $stddev;
7555            
7556             my $mix = $averageage * $stddev;
7557            
7558             $result = 1 / $mix;
7559            
7560             push (@mmbasketresult, $result);
7561             # if (scalar(@mmbasketresult) > 10) { shift @basketresult; }
7562             $mmresult = mean(@mmbasketresult);
7563            
7564             $regen = $n1_averageage;
7565            
7566             push (@mmbasketregen, $regen);
7567             # if (scalar(@mmbasketregen) > 10) { shift @basketregen; }
7568             $mmregen = mean(@mmbasketregen);
7569            
7570            
7571             #$averageagesize = ($steps ** $sumvalues) / ($steps ** $parameters);
7572            
7573             #$n1_averageagesize = 1 / $averageagesize;
7574            
7575             #$otheraverageage = $steps ** $averageage;
7576            
7577             #$otheraverageage = $averageage ** 2;
7578            
7579             #$otheraverageage3 = $averageage ** 3;
7580             #$otheraverageage4 = $averageage ** 4;
7581            
7582            
7583             #$otheraverageage = ( ( ($steps ** $sumvalues) / ($steps ** $roofopsvalue) ) ** (1/2));
7584             # print "averageage: $averageage\n";
7585              
7586             #$hikefactor = 1 / $averageage;
7587             #$otherhikefactor = 1 / $otheraverageage;
7588            
7589            
7590             #foreach my $elm (@integralslice)
7591             #{
7592             # my $count = 0;
7593             # foreach my $elt (@otherbasket)
7594             # {
7595             # if ($elm eq $elt)
7596             # {
7597             # $count++;
7598             # }
7599             # }
7600             # push (@basketcount, $count);
7601             #}
7602            
7603             #$stdcount = stddev(@basketcount);
7604             #$stdcountsize = ($steps ** $stcount);
7605            
7606             #$downfactor = $stdcountsize * $averageagesize;
7607             #$otherhikefactor = 1 / $downfactor;
7608            
7609            
7610             #$otherhikefactor3 = 1 / $otheraverageage3;
7611             #$otherhikefactor4 = 1 / $otheraverageage4;
7612             print "sequence:$countcase,\$countblocks:$countblocks,\@valuebasket:@valuebasket,\@finalbasket:@finalbasket,averageage:$averageage,\$stddev:$stddev,\$mix:$mix,\$result:$result,\$mixsize:$mixsize,\$regen:$regen,\$score:$score,novelty:$novelty,\$lastindicator:$lastindicator\n\n";
7613            
7614             print REPORTFILE "sequence:$countcase,\$countblocks:$countblocks,\@valuebasket:@valuebasket,\@finalbasket:@finalbasket,averageage:$averageage,\$stddev:$stddev,\$mix:$mix,\$result:$result,\$mixsize:$mixsize,\$regen:$regen,\$score:$score,\$novelty:$novelty,\$lastindicator:$lastindicator\n\n";
7615             # print REPORTFILE "sequence:$countcase,\@basketnow:@basketnow,\@union:@union,\$refreshment:$refreshment,\@shadowexport,@shadowexport,\@unionage:@unionage,\$refreshment:$refreshment,\$refreshmentage:$refreshmentage,\$proportionhike:$proportionhike,\$hike:$hike,\@basketageexport:@basketageexport,\$averageageexport:$averageageexport\n\n";
7616             # print REPORTFILE "sequence:$countcase,\@basketnow:@basketnow,\@basketageexport:@basketageexport,\$averageageexport:$averageageexport,\$stdage:$stdage\n\n";
7617            
7618            
7619            
7620             #print REPORTFILE "\$countbundlesgroup,\$countcase,\$countblocks,\$overlapsize,\$localsize,\$localnetsize,\$totalsize,\$totaloverlapsize,\$totalnetsize,\$commonalityratio,\$commonality_volume,\$commonalityflow,\$overlap,\$overlapsize,\$overlapminus,\$overlapminussize,\$flatoverlapage,\$rootflatoverlapage,\$expoverlapage,\$rootexpoverlapage,\$flatoverlapage,\$rootflatoverlapage,\$expoverlapage,\$rootexpoverlapage\n";
7621             #print REPORTFILE "$countbundlesgroup,$countcase,$countblocks,$overlapsize,$localsize,$localnetsize,$totalsize,$totaloverlapsize,$totalnetsize,$commonalityratio,$commonality_volume,$commonalityflow,$overlap,$overlapsize,$overlapminus,$overlapminussize, $flatoverlapage, $rootflatoverlapage, $expoverlapage, $rootexpoverlapage,$flatoverlapage, $rootflatoverlapage, $expoverlapage, $rootexpoverlapage\n";
7622            
7623             # END CALCULATION OF THE LOCAL SEARCH AGE.
7624             #################################################################################################################
7625             #################################################################################################################
7626              
7627             $averageagesize = ($steps ** $averageageexport);
7628              
7629             @centrebefores;
7630             @centreafters;
7631             $varsnum = ( $activeblock + $zoneend);
7632             $limit = ($attachment + $activeblock + $zoneend);
7633             $countafter = 0;
7634             $counterrank = 0;
7635             $leftcounter = $attachment;
7636             $rightcounter = ($attachment + $activeblock);
7637             $countblock = 0;
7638            
7639             $countfirstline = 0;
7640            
7641             if ($countblocks > 0) {$antesize = ( $steps ** $pastactiveblock );}
7642             $postsize = ( $steps ** $activeblock );
7643             $localsize = $postsize + $antesize;
7644             if ($countblocks == 0)
7645             {
7646             $localsize = $postsize;
7647             $localsizeproduct = $postsize;
7648             }
7649             $localsizeproduct = $postsize * $antesize;
7650            
7651             $overlapsize = ($steps ** $overlap);
7652             if ($overlap == 0) {$overlapsize = 1;}
7653            
7654             if ( ( $countcase == 0) and ($countblocks == 0) )
7655             {
7656             print OUTFILEWRITE "\$countcase,\$countblocks,\$attachment,\$activeblock,\$zoneend,\$pastattachment,\$pastactiveblock,\$pastzoneend,\$antesize,\$postsize,\$overlap,\$overlapsize,\$overlapminus,\$overlapminussize,\$overlapsum,\$overlapsumsize,\$localsize,\$localnetsize,\$totalsize,\$totaloverlapsize,\$totalnetsize,\$commonalityratio,\$commonality_volume,\$commonalityflow,\$recombinationflow,\$informationflow,\$cumulativecommonalityflow,\$cumulativerecombinationflow,\$cumulativeinformationflow,\$totalcommonalityflow,\$totalrecombinationflow,\$totalinformationflow,\$addcommonalityflow,\$addrecombinationflow,\$addinformationflow,\$recombinalityminusflow,\$cumulativerecombinalityminusflow,\$totalrecombinalityminusflow,\$recombinalityflow,\$cumulativerecombinalityflow,\$totalrecombinalityflow,\$renewalflow,\$cumulativerenewalflow,\$totalrenewalflow,\$infoflow,\$cumulativeinfoflow,\$totalinfoflow,\$refreshmentminus,\$recombination_ratio,\$proportionhike,\$hike,\$refreshment,\$infflow,\$cumulativeinfflow,\$totalinfflow,\$iruiflow,\$cumulativeiruif,\$totaliruif,\$averageageexport,\$cumulativeage,\$stdage,\$refreshratio,\$averageagesize,\$flowratio,\$cumulativeflowratio,\$flowageratio,\$cumulativeflowageratio,\$modiflow,\$cumulativemodiflow,\$refreshmentsize,\$refreshmentperformance,\$cumulativerefreshmentperformance,\$refreshmentvolume,\$IRUIF,\$mmIRUIF,\$IRUIFvolume,\$mmIRUIFvolume,\$hikefactor,\$otherIRUIF,\$othermmIRUIF,\$otherIRUIFvolume,\$othermmIRUIFvolume,\$averageage,\$steddev,\$mix,\$result,\$mixsize,\$regen,\$n1_averageage,\$n1_stddev,\$n1_averageagesize,\$mmresult,\$mmregen,\$novelty,\$lastindicator,\$IRUIFnovelty,\$IRUIFlastindicator,\$IRUIFnoveltysquare,\$IRUIFlastindicatorsquare,\$IRUIFnoveltycube,\$IRUIFlastindicatorcube";
7657             }
7658            
7659             if ($countblocks == 0)
7660             {
7661             $antesize = 0;
7662             $overlap = 0;
7663             $overlapsize = 0;
7664             $overlapminus = 0;
7665             $overlapminussize = 0;
7666             }
7667             if ($overlapminussize == 0) {$overlapminussize = 1;}
7668             if ($overlapsize == 0){$overlapsize = 1;}
7669             if ($totaloverlapsize == 0){$totaloverlapsize = 1;}
7670             $overlapminussize = ($steps ** $overlapminus);
7671             $overlapsum = ($overlapsize /$overlapminussize );
7672             $overlapsumsize = ($steps ** $overlapsum);
7673             if ($counterblocks == 0) {$overlapsumsize = 1;}
7674            
7675             #if ($overlapminus == 0) {$overlapminus = 1;}
7676             $localnetsizeproduct = ( $localsizeproduct - $overlapsize );
7677             if ($localnetsizeproduct == 0) {$localnetsizeproduct = 1;}
7678            
7679             if ($totalsize == 0){$totalsize = 1;}
7680             $localnetsize = ( $localsize - $overlapsize );
7681             if ($localnetsize == 0) {$localnetsize = 1;}
7682             $totalsize = $totalsize + $postsize;
7683            
7684             $totaloverlapsize = $totaloverlapsize + $overlapsize;
7685             $totalnetsize = ($totalsize - $totaloverlapsize);
7686             if ($totalnetsize == 0) { $localcommonalityratio = 0; }
7687            
7688             $refreshratio = $overlapsize/$overlapminussize;
7689            
7690             if ($countblocks == 0)
7691             {
7692              
7693             $localcommonalityratio = 1; #
7694            
7695             # $localrecombinationratio = 1;
7696            
7697             $localrecombinationratio = 1; #
7698            
7699             $localiruifratio = 1; # THIS IS THE COMMONALITY OF THE SHADOW AT TIME STEP - 2.
7700            
7701             # $localrecombinationratio = 1; #
7702            
7703             # $localrecombinationratio = 1; #
7704            
7705             $localrenewalratio = 1; #
7706            
7707             $localinfminusratio = 1; #
7708             $localinfratio = 1; #
7709            
7710            
7711            
7712             $localrecombinalityminusratio = 1; #
7713             $localrecombinalityratio = 1; #
7714            
7715             $localcommonalityratioenhanced = 1;
7716             $localcommonalityratioproduct = 1;
7717             $localcommonalityratioproductenhanced = 1;
7718              
7719             }
7720             elsif ($countblocks > 0)
7721             {
7722             $localcommonalityratio = ( $overlapsize/ ( ( $antesize * $postsize) ** (1/2))); #
7723            
7724             # $localrecombinationratio = (($localcommonalityratio * $hike) ** (1/2));
7725            
7726             $localrecombinationratio = ( $overlapminussize / $overlapsize / ( ( $antesize * $postsize) ** (1/2)) ); #
7727            
7728             $localiruifratio = ( $overlapminussize / ( ( $antesize * $postsize) ** (1/2)) ); # THIS IS THE COMMONALITY OF THE SHADOW AT TIME STEP - 2.
7729            
7730             # $localrecombinationratio = ( (( $flatoverlapagesize * $proportionhike) ) / ( ( $antesize * $postsize) ** (1/2)) ); #
7731            
7732             # $localrecombinationratio = ( ($proportionhike * $overlapminussize ) / ( ( $antesize * $postsize) ** (1/2)) ); #
7733            
7734             $localrenewalratio = ( $overlapminussize / ( ( $antesize * $postsize) ** (1/2)) ); #
7735            
7736             $localinfminusratio = ( $overlapsize * $refreshmentminus / ( ( $antesize * $postsize) ** (1/2)) ); #
7737             $localinfratio = ( $overlapsize * $refreshment / ( ( $antesize * $postsize) ** (1/2)) ); #
7738            
7739            
7740             $localrecombinalityminusratio = ( $overlapsize * $stdfatminus / ( ( $antesize * $postsize) ** (1/2)) ); #
7741             $localrecombinalityratio = ( $overlapsize * $stdshadow / ( ( $antesize * $postsize) ** (1/2)) ); #
7742            
7743             $localcommonalityratioenhanced = ( $overlapsumsize / ( $localnetsize / 2) );
7744             $localcommonalityratioproduct = ( ( $overlapsize **2 ) / $localnetsizeproduct );
7745             $localcommonalityratioproductenhanced = ( ( $overlapsumsize **2 ) / $localnetsizeproduct );
7746              
7747             }
7748              
7749             if ($totalnetsize > 0)
7750             {
7751             $commonalityratio = ( $totaloverlapsize / $totalnetsize );
7752             }
7753             $commonality_volume = ($totalnetsize * $commonalityratio);#
7754            
7755            
7756            
7757             if ($countblocks == 0)
7758             {
7759             $commonalityflow = $postsize ** (1/3) ;#
7760             $recombinationflow = $postsize ** (1/3) ;#
7761             $informationflow = (($commonalityflow * $recombinationflow) ** (1/3));
7762             $renewalflow = $postsize ** (1/3) ;#
7763            
7764             $infminusflow = $postsize ** (1/3) ;#
7765             $infflow = $postsize ** (1/3) ;#
7766            
7767             $iruiflow = $postsize ** (1/3) ;
7768            
7769             $recombinalityminusflow = $postsize ** (1/3) ;#
7770             $recombinalityflow = $postsize ** (1/3) ;#
7771            
7772             $commonalityflowproduct = $postsize ** (1/3) ;
7773             $commonalityflowenhanced = $postsize ** (1/3) ;
7774             $commonalityflowproductenhanced = $postsize ** (1/3) ;
7775             }
7776             elsif ($countblocks > 0)
7777             {
7778             $commonalityflow = ( $commonalityflow * $localcommonalityratio * $postsize) ** (1/3) ;# CF, Commonality Flow
7779             # $commonalityflow = ( $commonalityflow * (($localcommonalityratio * $postsize) ** (1/3))) ;#
7780             $recombinationflow = ( $recombinationflow * (($localrecombinationratio * $postsize) ** (1/3))) ;#
7781             $informationflow = (($commonalityflow * $recombinationflow) ** (1/3));
7782             $renewalflow = ( $renewalflow * (($localrenewalratio * $postsize) ** (1/3))) ;#
7783            
7784             $infminusflow = ( $infminusflow * (($localinfminusratio * $postsize) ** (1/3))) ;#
7785             $infflow = ( $infflow * (($localinfratio * $postsize) ** (1/3)) );#
7786            
7787             $iruiflow = ( $iruifflow * (($localiruifratio * $postsize) ** (1/3)));
7788            
7789             $recombinalityminusflow = ( $recombinalityminusflow * (($localrecombinalityminusratio * $postsize) ** (1/3)));#
7790             $recombinalityflow = ( $recombinalityflow * (($localrecombinalityratio * $postsize) ** (1/3))) ;#
7791            
7792             $commonalityflowproduct = ( $commonalityflowproduct * (($localcommonalityratioproduct * $postsize ) ** (1/3)));
7793             $commonalityflowenhanced = ( $commonalityflowenhanced * (($postsize * $localcommonalityratioenhanced ) ** (1/3))) ;
7794             $commonalityflowproductenhanced = ( $commonalityflowproductenhanced * (($localcommonalityratioproductenhanced * $postsize ) ** (1/3)));
7795             }
7796            
7797              
7798             $infoflow = ( ($commonalityflow * $recombinationflow ) ** ( 1 / 2 ) );
7799            
7800             $recombination_ratio = ( $flatoverlapage / $overlapsize );
7801              
7802             $flowratio = $iruifflow / $commonalityflow;
7803              
7804             # $flowageratio = 1 / $flatoverlapagesize;
7805              
7806             $modiflow = ( ($commonalityflow * $hike ) ** ( 1 / 2 ) );
7807            
7808             $cumulativemodiflow = $cumulativemodiflow + $modiflow;
7809              
7810             $cumulativehike = $cumulativehike + $hike;
7811             # if ($countblocks == 0) { $cumulativerefreshment = 1; }
7812             $refreshnmentsize = (steps ** $refreshnment);
7813             $cumulativerefreshment = $cumulativerefreshment + $refreshmentsize;
7814             $cumulativerefreshmentperformance = $cumulativerefreshmentperformance + $refreshmentperformance;
7815              
7816             $refreshmentvolume = $cumulativerefreshmentperformance * $totalnetsize;
7817              
7818            
7819            
7820             # if ($cumulativeflowageratio == 0) {$cumulativeflowageratio = 1;}
7821             # $cumulativeflowageratio = ( ($cumulativeflowageratio * $flowageratio) ** (1/2));
7822             $cumulativeflowageratio = $cumulativeflowageratio + $flowageratio;
7823              
7824            
7825             if ($countblocks > 0) {$addcommonalityflow = $addcommonalityflow + abs($commonalityflow - $remembercommonalityflow);}
7826             if ($countblocks > 0) {$addrecombinationflow = $addrecombinationflow + abs($recombinationflow - $rememberrecombinationflow);}
7827             if ($countblocks > 0) {$addinformationflow = $addinformationflow + abs($informationflow - $rememberinformationflow);}
7828            
7829             $remembercommonalityflow = $commonalityflow;
7830             $rememberrecombinationflow = $recombinationflow;
7831             $rememberinformationflow = $informationflow;
7832            
7833             push (@commonalities, $commonalityflow);#
7834             push (@recombinations, $recombinationflow);#
7835             push (@informations,$informationflow);
7836             $stdcommonality = stddev(@commonalities);#
7837             $stdrecombination = stddev(@recombinations);#
7838             $stdinformation = stddev(@informations);#
7839            
7840             $cumulativecommonalityflow = ($cumulativecommonalityflow + $commonalityflow ); # CCF, Cumulative Commonality FLow
7841            
7842             $IRUIF = $IRUIF + ( $totalnetsize * ( $n1_averageage ) );
7843             $IRUIFnovelty = $IRUIFnovelty + ( $totalnetsize * ( $novelty ) );
7844             $IRUIFlastindicator = $IRUIFlastindicator + ( $totalnetsize * ( $lastindicator ) );
7845             $IRUIFnoveltysquare = $IRUIFnoveltysquare + ( $totalnetsize * ( ( $novelty ) ** 2 ));
7846             $IRUIFlastindicatorsquare = $IRUIFlastindicatorsquare + ( $totalnetsize * ( ( $lastindicator ) ** 2 ) ); # IRUIF, Indicator of Recursive Usefulness of the Information Flow
7847             $IRUIFnoveltycube = $IRUIFnoveltycube + ( $totalnetsize * ( ( $novelty ) ** 3 ));
7848             $IRUIFlastindicatorcube = $IRUIFlastindicatorcube + ( $totalnetsize * ( ( $lastindicator ) ** 3 ) );
7849             $IRUIFvolume = $IRUIF * $totalnetsize;
7850             $mmIRUIF = $mmIRUIF + ( $commonalityflow * ($mmresult ** 2 ) );
7851             $mmIRUIFvolume = $mmIRUIF * $totalnetsize;
7852             $otherIRUIF = $otherIRUIF + ( $totalnetsize * ($n1_averageage ** 2 ) );
7853             $otherIRUIFvolume = $otherIRUIF * $totalnetsize;
7854             $othermmIRUIF = $othermmIRUIF + ( $commonalityflow * ($result ** 3 ) );
7855             $othermmIRUIFvolume = $othermmIRUIF * $totalnetsize;
7856              
7857             $totalcommonalityflow = $cumulativecommonalityflow * $totalnetsize;#
7858            
7859             $cumulativeiruif = ($cumulativeiruif + $iruifflow ); # THIS IS THE
7860             $totaliruif = $cumulativeiruif * $totalnetsize;
7861              
7862             $cumulativeflowratio = $cumulativeflowratio + $flowratio;
7863            
7864             $cumulativerecombinationflow = ($cumulativerecombinationflow + $recombinationflow );#
7865             $totalrecombinationflow = $cumulativerecombinationflow * $totalnetsize;#
7866             $cumulativeinformationflow = ($cumulativeinformationflow + $informationflow );#
7867             $totalinformationflow = $cumulativeinformationflow * $totalnetsize;#
7868             $cumulativerenewalflow = ( $cumulativerenewalflow + $renewalflow );#
7869             $totalrenewalflow = $cumulativerenewalflow * $totalnetsize;#
7870            
7871             $cumulativeinfflow = ( $cumulativeinfflow + $infflow );#
7872             $totalinfflow = $cumulativeinfflow * $totalnetsize;#
7873            
7874             $cumulativeinfminusflow = ( $cumulativeinfminusflow + $infminusflow );#
7875             $totalinfoflow = $cumulativeinfoflow * $totalnetsize;#
7876            
7877             $cumulativeinfoflow = ( $cumulativeinfoflow + $infoflow );#
7878             $totalinfoflow = $cumulativeinfoflow * $totalnetsize;#
7879            
7880            
7881            
7882            
7883             $cumulativerecombinalityminusflow = ($cumulativerecombinalityminusflow + $recombinalityminusflow );#
7884             $totalrecombinalityminusflow = $cumulativerecombinalityminusflow * $totalnetsize;#
7885             $cumulativerecombinalityflow = ($cumulativerecombinalityflow + $recombinalityflow );#
7886             $totalrecombinalityflow = $cumulativerecombinalityflow * $totalnetsize;#
7887            
7888             $cumulativecommonalityflowproduct = $cumulativecommonalityflowproduct + $commonalityflowproduct;
7889             $cumulativecommonalityflowenhanced = $cumulativecommonalityflowenhanced + $commonalityflowenhanced;
7890             $cumulativecommonalityflowproductenhanced = $cumulativecommonalityflowproductenhanced + $commonalityflowproductenhanced;
7891            
7892             if ($countblocks == 0) { print OUTFILEWRITE "\n"; }
7893             print OUTFILEWRITE "$countcase,$countblocks,$attachment,$activeblock,$zoneend,$pastattachment,$pastactiveblock,$pastzoneend,$antesize,$postsize,$overlap,$overlapsize,$overlapminus,$overlapminussize,$overlapsum,$overlapsumsize,$localsize,$localnetsize,$totalsize,$totaloverlapsize,$totalnetsize,$commonalityratio,$commonality_volume,$commonalityflow,$recombinationflow,$informationflow,$cumulativecommonalityflow,$cumulativerecombinationflow,$cumulativeinformationflow,$totalcommonalityflow,$totalrecombinationflow,$totalinformationflow,$addcommonalityflow,$addrecombinationflow,$addinformationflow,$recombinalityminusflow,$cumulativerecombinalityminusflow,$totalrecombinalityminusflow,$recombinalityflow,$cumulativerecombinalityflow,$totalrecombinalityflow,$renewalflow,$cumulativerenewalflow,$totalrenewalflow,$infoflow,$cumulativeinfoflow,$totalinfoflow,$refreshmentminus,$recombination_ratio,$proportionhike,$hike,$refreshment,$infflow,$cumulativeinfflow,$totalinfflow,$iruiflow,$cumulativeiruif,$totaliruif,$averageageexport,$cumulativeage,$stdage,$refreshratio,$averageagesize,$flowratio,$cumulativeflowratio,$flowageratio,$cumulativeflowageratio,$modiflow,$cumulativemodiflow,$refreshmentsize,$refreshmentperformance,$cumulativerefreshmentperformance,$refreshmentvolume,$IRUIF,$mmIRUIF,$IRUIFvolume,$mmIRUIFvolume,$hikefactor,$otherIRUIF,$othermmIRUIF,$otherIRUIFvolume,$othermmIRUIFvolume,$averageage,$steddev,$mix,$result,$mixsize,$regen,$n1_averageage,$n1_stddev,$n1_averageagesize,$mmresult,$mmregen,$novelty,$lastindicator,$IRUIFnovelty,$IRUIFlastindicator,$IRUIFnoveltysquare,$IRUIFlastindicatorsquare,$IRUIFnoveltycube,$IRUIFlastindicatorcube\n";
7894              
7895             $countblocks++;
7896            
7897             #>
7898             ####################################################
7899            
7900            
7901            
7902            
7903             $countbuild++;
7904             }
7905            
7906            
7907             my @blockelts = @{$blockref};
7908             $blockelts[0] = ( $blockelts[0] + $number_of_variables );
7909             my @newblockelts = @{$blocks[$countblock]};
7910             $newblockelts[0] = ( $newblockelts[0] + $number_of_variables );
7911            
7912             sub def_filenew
7913             {
7914             $filenew = "$mypath/models/$file" . "_";
7915             my $counterfn = 0;
7916             foreach my $el (@varn)
7917             {
7918             $filenew = "$filenew" . "$varn[$counterfn]" . "-" . "$midvalues[$countblock]" . "_" ;
7919             $counterfn++;
7920             }
7921             }
7922             if ($countblock == 1)
7923             {
7924             &def_filenew;
7925             @uplift = ($filenew);
7926             @downlift = ($filenew);
7927             }
7928            
7929             foreach my $el (@varnumbers)
7930             {
7931             foreach my $elt (@newvarnumbers)
7932             {
7933             if ( $el eq $elt)
7934             {
7935             push (@overlap, $el);
7936             }
7937             }
7938             }
7939             @overlap = sort(@overlap);
7940             &exec(\@varnumbers, $countblock, $countcase, \@newvarnumbers, \@uplift, \@downlift, \@blocks, \@blockelts, \@newblockelts, \@overlap);
7941             $countblock++;
7942             }
7943             $countcase++;
7944             }
7945             }
7946            
7947            
7948            
7949            
7950            
7951            
7952            
7953             }
7954             else
7955             {
7956             die;
7957             }
7958             }
7959             else
7960             {
7961             die; # &exec;
7962             #print OUTFILE "I CALL EXEC AND \@VARNUMBERS IS: " . Dumper(@varnumbers) . "\n";
7963             }
7964              
7965             # END OF THE INSTRUCTIONS LAUNCHING OPTS.
7966             ##########################################################################################
7967             ##########################################################################################
7968              
7969             close(OUTFILE);
7970             close(TOSHELL);
7971             close (OUTFILEWRITE);
7972             close ( REPORTFILE);
7973             exit;
7974              
7975             } # END OF SUB OPTS
7976             #############################################################################
7977             #############################################################################
7978             #############################################################################
7979              
7980             1;
7981             __END__