#!/usr/common/bin/perl

use strict ;

my $VERSION = '1.0' ;

=head1 NAME

ciudgsort - sort ciudg wave function output

=head1 DESCRIPTION

Sort by the square of the CI coefficients the electron
configurations in the wave function output of the
COLUMBUS ciudg program.

=head1 EXAMPLE

ciudgxform ciudgls | ciudgsort | less

=head1 README

This perl script is not robust with respect to output changes of ciudg.
Because this script only recognizes one line of a configuration,
it is best used with ciudgxform.
Example usage:
ciudgxform ciudgls | ciudgsort | less

=head1 PREREQUISITES

This script requires the C<strict> module.

=head1 COREQUISITES

None.

=head1 OSNAMES

Any.

=head1 SCRIPT CATEGORIES

CPAN/Unknown
Science/Quantum Chemistry

=head1 SEE ALSO

COLUMBUS
(http://www.itc.univie.ac.at/~hans/Columbus/columbus.html)

=head1 NOTES

=head2 Implementation

The program structure is that of a finite automaton.

=head2 Restrictions and Problems

This script is not robust with respect to output changes of ciudg.
Because this script only recognizes one line of a configuration,
it is best used with ciudgxform.

=head1 AUTHOR

Scott Brozell <brozell.1@osu.edu>

=head1 COPYRIGHT

Copyright (c) 2000 Scott Brozell. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.

=head1 DISCLAIMER

This software is distributed in the hope that it will be useful, but
is provided "AS IS" WITHOUT WARRANTY OF ANY KIND, either expressed or
implied, INCLUDING, without limitation, the implied warranties of
MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE.

The ENTIRE RISK as to the quality and performance of the software
IS WITH YOU (the holder of the software).  Should the software prove
defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
CORRECTION.

IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE,
MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO
ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even
if they arise from known or unknown flaws in the software).

=cut


print "Program CIUDG Sort:  Version $VERSION\n\n" ;

# skip to line, e.g.,
#  --- list of ci coefficients ( ctol =   1.00E-02 )  total energy( 1) =      -126.1280367625
my $start_of_wavefunction_output = 'list of ci coefficients' ;
while (<>) {
    print ;
    last if (/$start_of_wavefunction_output/) ;
}

# store configurations for sorting
# example configuration line:
#  z*  2  3       6  0.010995                        +-   +-   +-   +-   +-   +-   +-   +-   +-   +-
my $configuration_search_pattern = '^ [wxyz]' ;
# example end of wave function output line:
#  ci coefficient statistics:
my $end_of_wavefunction_output = 'ci coefficient statistics' ;
my @configs = () ;
while (<>) {
    if (/$configuration_search_pattern/) {
        push @configs, $_ ;
    }
    elsif (/$end_of_wavefunction_output/) {
        print sort by_ci_coefficient_squared @configs  ;
        print "\n" ;
        print ;
        @configs = () ;
    }
    else {
        print ;
    }
}


sub by_ci_coefficient_squared {
    my $ci_coefficient_field = 4 ;
    my @afields = split(' ', $a, $ci_coefficient_field + 2 ) ;
    my $aa = $afields[$ci_coefficient_field] * $afields[$ci_coefficient_field] ;
    my @bfields = split(' ', $b, 9) ;
    my $bb = $bfields[$ci_coefficient_field] * $bfields[$ci_coefficient_field] ;
   return $aa > $bb ? -1 : +1 ;
}