package main_config ;

sub get_commands
{
    my $key = "" ;
    my $word ;
    my %c_line = () ;
    my @arg_char = () ;
    foreach $word ( @_ )
    {
	@arg_char = split( '', $word ) ;
#	print "word: $word \n" ; 
	if ( length($word) <= 0 ) { next ; }
	if ( $word !~ m"[a-zA-F]" ) { } #print "word: $word is a number\n" ; }
	else 
	{ 
#	    print "word: $word is a NON-number\n" ; 

	    if ( $arg_char[0] eq '-' ) 
	    {
		if ( $arg_char[1] eq "-" ) 
		{
		    my $num = scalar(@arg_char) - 1;
		    $key = join ( "", @arg_char[2 .. $num] );
		    push ( @{$c_line{$key}}, ' ' ) ; 
		}
		else
		{
		    $key = $arg_char[1] ; 
		    push ( @{$c_line{$key}}, ' ' ) ; 
		}
		next ;
	    }
	}

	if ( $key ne '' ) 
	{ 
	    $key = lc ( $key ) ; 
#	print "$key: \n" ;
	    my $tmp = join ( '', @{$c_line{$key}} ) ; 
	    if ( $tmp eq ' ' ) { delete $c_line{$key} ; }
	    push ( @{$c_line{$key}}, $word ); 
	}
    }
    return ( %c_line ) ;
}

sub read_main_config_file 
{  
    my $file_name = $_[0] ;
    my $key ;
    my @words = () ;
    my $np_line = 0; 
    my %whole_file = () ;
    open ( TXT, $file_name ) || die "READ FILE OPEN ERROR: >$file_name< \n" ; 
#    print " read para_file: >$file_name<\n" ;
    my $nc ;
while(<TXT>)
{
    chomp ;
    my $line = $_ ;
    my @values = () ;
    my $value ;
    $nc = length($line) ;
#    print " $nc.) > $line \n" ;
    if ( $nc > 0 ) 
    {
	@words = split( "=", $line ) ;
	$key = substr( $words[0], 8, length($words[0]) ) ;
#	print " $key " ;
#	@values = split( " ", substr ($words[1], 1,-1) ) ;
	my @chars = split ( "", $words[1] ) ;
	shift ( @chars ) ; pop( @chars ) ;
#	$words[1] =~ s/\"//g ; $words[1] =~ s/\'//g ;
	$words[1] = join ("", @chars ) ;
	@values = split( " ", $words[1] ) ;
	foreach $value ( @values )
	{
#	print " :: $value " ;
	    push ( @{$whole_file{$key}}, $value ) ; 
	}
#	print " \n" ;
    }
}
close(TXT) ;
#print " read >$file_name< done. \n" ;
#print "read_main_config segm:", @{$whole_file{"SG_LIST"}}, "\n" ;
return ( %whole_file ) ;
}


sub write_main_config_file
{
    my $file_name = shift (@_)  ;
    my %save_list = @_ ;

    my $key ;
    my $value ;

#    print "WRITE>>>> $file_name topp \n" ;
#    print "write MAIN conf file {", $file_name, ": ", join(" ", @{$save_list{"SG_LIST"}}), "}\n" ;

    if ( !-f $file_name ) { goto WRITEIT }
    my %my_test = read_main_config_file ( $file_name ) ; 

    foreach $key ( sort keys (%save_list) )
    {
#	print "WRITE> TEST key $key \n";
	if ( !exists($my_test{$key}  ) ) { goto WRITEIT } 
	my $xx ; 
	if ( scalar(@{$save_list{$key}}) > 0 ) 
	{
	    if ( scalar(@{$save_list{$key}}) != scalar(@{$my_test{$key}}) ) { goto WRITEIT } 
	    for ( $xx = 0; $xx < scalar( @{$save_list{$key}} ) ; $xx++ )
	    {
#		print "WRITE> TEST scalar $xx {", scalar(@{$save_list{$key}}), " - ", scalar(@{$my_test{$key}}), "} \n";
		my $m1 =  ${$save_list{$key}}[$xx] ;
		my $m2 =  ${$my_test{$key}}[$xx] ;
#		print "WRITE> TEST $xx $key", $m1, " ne ", $m2, "\n";
		if ( ${$save_list{$key}}[$xx] ne ${$my_test{$key}}[$xx] ) { goto WRITEIT }  
	    }
	}
    }

#    print "WRITE>>>> $file_name NO WRITE \n" ;
    return ;
WRITEIT:
    if ( -f $file_name ) 
    { 
	my $back = join ('', $file_name, ".old" ) ; 
	if ( -f $back )
	{
	my $back2 = join ('', $file_name, ".old2" ) ; 
	system ( "mv  $back $back2" ) ; 
	}
	system ( "mv  $file_name $back" ) ; 
    }
#    print "WRITE>>>> $file_name TO WRITE \n" ;
    open( LIT, "> $file_name" )  || die "WRITE FILE OPEN ERROR: >$file_name< \n" ; 
    foreach $key ( sort keys  (%save_list) ) 
    {
	if ( exists($save_list{$key}) )
	{
	    if ( scalar( @{$save_list{$key}}) > 0 )
	    {   
#	print "MY_MAIN $key= TEST LENGHT ", length( @{$save_list{$key}}),"\n"; # , " @{$save_list{$key}} \n\n";
#	print "MY_MAIN $key= @{$save_list{$key}}  \n"; # , " @{$save_list{$key}} \n\n";
		my $val = join (' ', @{$save_list{$key}}) ;
		if ( !defined(  ${$save_list{$key}}[0] ) ) { print "$key value = >$val< \n" ; $val = "NONE" ; }
		my $line = join( '', "MY_MAIN_", $key, '="', $val, '"' ) ;
		print LIT "$line\n" ; 
	    }
	}
    else
    {	print ">>>>>>>>> $key IS EMPTY \n"; }
    }
    close (LIT) ;
}

sub write_get_diffr_data 
{ 
    my ( $fh, $in_sub, $CRYST ) = @_ ;
    my %my_main = %$in_sub ;
     print "crystals: $CRYST \n" ;
     print $my_main{"DFR_FORMAT"}[$CRYST],  "\n" ;
     print $my_main{"FILE_REFL"}[$CRYST], "\n" ;
#     print " MAIN_CONFIG_FILE_TEST> HERE I AM \n" ;
#    print $fh " MAIN_CONFIG_FILE_TEST> HERE I AM \n" ;


    my $STR ;
    my $MY_CRYST = $CRYST + 1 ;
    my @lines = ("\n! CRYSTAL FORM ", $MY_CRYST, "\n" ) ;
    @lines = ( @lines, "set vari FILE_CELL = ", ${$my_main{"FILE_CELL"}}[$CRYST], "\n" ) ;
    push( @lines, "set vari FILE_SYMM = " ) ; 
    push( @lines, join( '', '"?MAIN_SYMM:', ${$my_main{"FILE_SYMM"}}[$CRYST], '.symm"' ) );
    push( @lines, "\n") ;
    my $FILE_REFL =     ${$my_main{"FILE_REFL"}}[$CRYST] ;
    @lines = ( @lines, "set vari FILE_FOBS = ", $FILE_REFL, "\n" ) ;
    @lines = ( @lines, "set vari RESOL_MIN global real = ", ${$my_main{"DFR_RES_MIN"}}[$CRYST], "\n") ; 
    @lines = ( @lines, "set vari RESOL_MAX global real = ", ${$my_main{"DFR_RES_MAX"}}[$CRYST], "\n") ; 
# set vari RESOL_MIN global real = $RESOL_MIN 
# set vari RESOL_MAX global real = $RESOL_MAX 

    push( @lines, "\n") ;



    my @xx = split ('\.', $FILE_REFL) ; 
    my $file_ext = pop (@xx) ;
    if ( lc($file_ext) eq "mrc" or lc($file_ext) eq "xmap"  ) 
    {	    
	if (  lc($file_ext) eq "mrc" )
	{
	    push( @lines, "open unit 10 file $FILE_REFL unform rec 1024\n"  );
	    push( @lines, "read unit 10 map mrc init\n"  );
	    push( @lines, "clo uni 10\n"  );
#	    push( @lines, "read file $FILE_REFL map mrc init\n"  );
	}
	else
	{
	    push( @lines, "read file $FILE_REFL map xplor\n"  );
	}

	push( @lines, "read refl init " ) ;
	push( @lines, " format ", $my_main{"DFR_FORMAT"}[$CRYST] ) ;
	push( @lines, " limit " ) ; 
	@lines = ( @lines, $my_main{"DFR_LIMIT_H"}[$CRYST], " ", 
		   $my_main{"DFR_LIMIT_K"}[$CRYST], " ", $my_main{"DFR_LIMIT_L"}[$CRYST] ) ; 
	push( @lines, " \\ \n" ) ;
	push( @lines, "   reso RESOL_MIN RESOL_MAX cryst $MY_CRYST\n") ;
	push( @lines, "\n") ;

	push( @lines, "refl key WORK_REFL sele all end\n") ;
	push( @lines, "refl show KEY WORK_REFL\n") ;
	push( @lines, "	      \n") ;
	push( @lines, "set vari THE_MAP = MAP_LAST\n") ;
	push( @lines, "show vari THE_MAP\n") ;
	push( @lines, "make map THE_MAP rescale\n") ;
	push( @lines, "make map THE_MAP + 1 init from THE_MAP real full cell\n") ;
	push( @lines, "make map THE_MAP + 1 from THE_MAP copy\n") ;
	push( @lines, "show map THE_MAP + 1\n") ;
	push( @lines, "four map THE_MAP + 1\n") ;
	push( @lines, "dele map THE_MAP + 1\n") ;
	push( @lines, "refl move fcalc fobs\n") ;
	push( @lines, "make map THE_MAP from 0 auto_grid 5 init zero real cell \n") ;
	push( @lines, "make map THE_MAP conv complex\n") ;
	push( @lines, "refl move fobs fwork\n") ;
	push( @lines, "refl fill-map THE_MAP sele defined end\n") ;
	push( @lines, "four map THE_MAP back \n") ;
	push( @lines, "make map THE_MAP rescale \n") ;
    }
    else
    {
	push( @lines, "read file FILE_CELL cell cryst $MY_CRYST\n") ;
	push( @lines, "read file FILE_SYMM symm cryst $MY_CRYST\n" ) ;

	push( @lines, "read file FILE_FOBS refl init " ) ;
	push( @lines, " format ", $my_main{"DFR_FORMAT"}[$CRYST] ) ;

	my $my_form = $my_main{"DFR_FORMAT"}[$CRYST] ;
	if ( uc($my_form) eq "MAP" ) 
	{
	    my $nmb = int ( $my_main{"DFR_LIMIT_H"}[$CRYST] ) ;
	    print "nmb >$nmb<",$my_main{"DFR_LIMIT_H"}[$CRYST], "> <$CRYST>", @{$my_main{"DFR_LIMIT_H"}}, "<\n" ;
	    if ( $nmb < 0 ) 
	    {
		push( @lines, " $nmb $nmb $nmb " ) ;
		$nmb = -$nmb  ;
		push( @lines, " $nmb $nmb $nmb " ) ;
	    }
	}

	push( @lines, " limit " ) ; 
	@lines = ( @lines, $my_main{"DFR_LIMIT_H"}[$CRYST], " ", 
		   $my_main{"DFR_LIMIT_K"}[$CRYST], " ", $my_main{"DFR_LIMIT_L"}[$CRYST] ) ; 
	push( @lines, " \\" ) ;
	push( @lines, "\n") ;
	push( @lines, "   reso RESOL_MIN RESOL_MAX friedel ") ;

	if ( $my_main{"CRYST_DATA"}[$CRYST] eq "BRAGG" )
	{ push( @lines, " re_read ") ; }
	push( @lines, " data ", $my_main{"CRYST_DATA"}[$CRYST] ) ;

	push( @lines, " cryst $MY_CRYST\n") ;
	push( @lines, "\n") ;
    
	if ( $my_main{"DFR_RFREE"}[0] eq "ON" )
	{
	    push( @lines, "set vari IRESULT_0 global = -1 \n" ) ;
	    push( @lines, "refl show key TEST\n" ) ;
	    push( @lines, "if ( IRESULT_0 .le. 0 ) then \n" ) ;
	    push( @lines, "refl key TEST sele random 20 1 end \n" ) ;
	    push( @lines, "end_if\n" ) ;
	    push( @lines, "refl key TEST sele defined .a TEST end \n" ) ;
	    push( @lines, "refl key WORK_REFL sele defined .a .not TEST end\n" ) ;
	}
	else
	{
	    push( @lines, "refl key TEST sele .n all end \n" ) ;
	    push( @lines, "refl key WORK_REFL sele defined end \n" ) ;
	}
    }
#    my $line; my $II ;
#    $II = 0 ;
#foreach $line ( @lines )
#{
#    $II++ ;
#    print "$II >$line<\n" ;
#}

print $fh @lines ;
} 

sub vec_prod
{
    my @u = ( @_[0..2]) ;
    my @v = ( @_[3..5]) ;
    my @z = () ;
    $z[0]=$u[1]*$v[2]-$u[2]*$v[1] ;
    $z[1]=$u[2]*$v[0]-$u[0]*$v[2] ;
    $z[2]=$u[0]*$v[1]-$u[1]*$v[0] ;
#    print @u, ' x ', @v, ' x ', @z, "\n";
    return ( @z ) ;
}

sub sc_prod
{
    my @u = ( @_[0..2]) ;
    my $v = ( $_[3]) ;
    my @z = () ;
    $z[0]=$u[1]*$v ;
    $z[1]=$u[2]*$v ;
    $z[2]=$u[0]*$v ;
#    print @u, ' x ', $v, ' x ', @z, "\n";
    return ( @z ) ;
}

sub read_pdb_file 
{
    my ( $PDB_FILE ) = @_ ;
    my @pdb_records = () ;

print "reading PDB file \"$PDB_FILE\" \n" ;
open ( PDB,  "< $PDB_FILE" ) || print "main_config.pm::read_pdb_file> FILE OPEN ERROR: >$PDB_FILE< \n" ;

while (<PDB> ) { push(@pdb_records, $_) ; } close ( PDB ) ;

    my $line;
    my $sub_line ;
    my $group ;
    my @words;
    my @unit_cell ;
    my @space_group ;
    foreach $line ( @pdb_records )
    {
	if ( substr($line, 0,5) eq "CRYST" ) 
	{
	    chomp ($line) ;
#	print "[$line]\n" ;
	    $sub_line = substr( $line, 6,49 ) ;
#	print " SUBLINE: { 23456789 23456789 23456789 234567 234567 234567} \n" ;
#	print " SUBLINE: {$sub_line} \n" ;
	    @words = () ;
#	@words = split (" ", $sub_line ) ;
	    my $I = 0 ; my $a ;
	    $a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
	    $a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
	    $a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
	    $a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 7 ; 
	    $a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 7 ; 
	    $a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; 
	    @unit_cell = @words ; 
	    print "UNIT CELL: ", join(" | ", @unit_cell), "\n" ;
	    $sub_line = substr( $line, 55,12 ) ;
#	    print " SUBLINE: {$sub_line} \n" ;
	    @words = split (" ", $sub_line ) ; 
# while ( $words[0] eq " " ) { print "x",  shift (@words) , "\n" ; };
	    $group = join( '', shift(@words), shift(@words) ) ; 
	    $group = join( '_', $group, @words ) ; $group = lc ($group) ;
	    @space_group = ( $group ) ;
	    print "SPACE GROUP: $group \n" ;
	    last ;
	}
    }

    my @secondary_helix ;
    my @secondary_beta ;
    my $ihel = -9999 ;
    foreach $line ( @pdb_records )
    {
	if ( substr($line, 0,5) eq "HELIX" ) 
	{
	    chomp ($line) ;
#	    print "[$line]\n" ;
	    @words = () ;
	    @words = split (" ", $line ) ;
	    if ( $words[5] == $ihel ) { $words[5]++ ;  $words[5]++ }
	    if ( $words[5] == $ihel + 1 ) { $words[5]++ }
#	    print("---> helix:", $words[4],  $words[5], $words[8], "\n") ;
	    push(@secondary_helix,   $words[4],  $words[5], $words[8]) ;
	    $ihel = $words[8] ;
#	    print " SUBLINE: helix {", $my_pair, "} \n" ;
	}
	if ( substr($line, 0,5) eq "SHEET" ) 
	{
	    chomp ($line) ;
#	    print "[$line]\n" ;
	    @words = () ;
	    @words = split (" ", $line ) ;
#	    print( "beta:", $words[5],  $words[6], $words[9]-1, "\n" ) ;
	    push(@secondary_beta, $words[5],  $words[6], $words[9]-1) ;
	}
    }

    my %my_segm = () ;
    my %my_mult = () ;
    my %chain_ids = () ;
    my %my_mult_chain = () ;
    my %my_resids = () ;
    my $nat = 0 ;
    my $seg_name = "1   " ; my $res_name ; my $seq_id ; my $chain_id ; my $mult_conf ; my $atom_name ;
    my $line_id ;
    my $line_id_old = "" ;
    my $nres = -1 ;
    my @atom_list = () ;
    my @atom_el_list = () ;
    my @my_sequ = () ;
    my $nn = 0 ;
    my @xyz_list = () ;
    my @b_list = () ;
    my @w_list = () ;
    my $b; my $w ;
    
 foreach $line ( @pdb_records )
 {
 #    if ( substr($line, 1,4) ne "    " ) { $sub_line = substr( $line, 72,4 ) ; print $sub_line, "\n" ; }
     $nn++ ;
     if ( substr( $line, 0,5 ) eq "MODEL" )
     {
 	my $I ;
 	my @words = split( " ", $line ) ;
 	my @chrs = split ("", $words[1] ) ;
 	for ( $I = @chrs; $I < 4 ; $I++ ) { push(@chrs, " " ) ; }
 	$seg_name = join("", @chrs) ;
 	$line_id_old = "" ;
 #	print $nn, " MODEL LINE{", $line, "}", scalar(@words), "-", $seg_name, "-\n" ;
     }
     if ( substr( $line, 0,5 ) eq "ENDMDL" ) 
     {
  	$seg_name = "" ;
 	$line_id_old = "" ;
 #	print $nn, " model LINE{", $line, "}", "-", $seg_name, "-\n" ;
     }
 
     if ( substr( $line, 0,3 ) eq "TER") { $line_id_old = "" ; }

      if ( substr( $line, 0,4 ) eq "ATOM" || substr( $line, 0,6 ) eq "HETATM" )
      { 
  	if ( length($line) >= 75 ) 
  	{ my $chrt = substr( $line, 72,4 ) ; $seg_name = $chrt if ( $chrt ne "    " ) ; }
  #	if ( $seg_name eq "    " ) { print "TEST SEG NAME {", $seg_name, "}\n" };
  #	if ( $seg_name eq "" ) { print "test SEG NAME {", $seg_name, "}\n" };
  	$my_segm{$seg_name} = "DONE" ; 
  	$res_name = substr( $line, 17,4 ) ; $my_resids{$res_name} = "DONE" ; 
  
  	$seq_id = substr( $line, 22,5 ) ; 
  	$chain_id = substr( $line, 21,1 ) ; 
	$chain_ids{$chain_id} = "ON" ;
  	$line_id = join("^", $res_name, $seq_id, $chain_id, $seg_name) ;
#	print "$nres, line_id: <$line_id> \n" ;
  	$mult_conf = substr( $line, 16,1 ) ; 
  	my $mult_flag = "OFF" ;
  	if ( $mult_conf eq " " ) 
  	{
  	    if (  substr( $line, 12,1 ) eq " " )
  	    { $atom_name = substr( $line, 13,4 ) ; }
  	    else
  	    { $atom_name = substr( $line, 12,4 ) ; }
  	}

  	else
  	{ 
  #	    print "{", substr( $line, 16,1 ), "} ", $line; 
  	    if (  substr( $line, 12,1 ) eq " " )
  	    {
  		$atom_name = substr( $line, 13,4 ) ; 
  		if ( substr( $atom_name, 0, 1 ) ne "H" ) 
  		{ 
  		    push( @{$my_mult{$mult_conf}}, $seg_name ) ; 
  		    ${$my_mult_chain{$mult_conf}}{$chain_id} = "ON" ; 
  		    $mult_flag = "ON" ;
#		    print " 1 {", @{$my_mult{$mult_conf}}, "} {", $seg_name, "}\n"; 
  #		    print "{", substr( $atom_name, 0,1 ), "} ", $line; 
  		}
  	    }
  	    else
  	    {
  		$atom_name = substr( $line, 12,4 ) ; 
  		push( @{$my_mult{$mult_conf}}, $seg_name ) ; 
		${$my_mult_chain{$mult_conf}}{$chain_id} = "ON" ; 
#		print " 2 {", @{$my_mult{$mult_conf}}, "} {", $seg_name, "}\n"; 
  		$mult_flag = "ON" ;
  #		print " ne H{", substr( $atom_name, 0,1 ), "} \n"; 
  	    }
  	}
  	my @xyz = () ;
# one lowered in Garching 15. march
  	$xyz[0] = substr( $line, 30,8 ) ;
  	$xyz[1] = substr( $line, 38,8 ) ;
  	$xyz[2] = substr( $line, 46,8 ) ;
	if ( substr( $line, 55,6 ) eq "      " ) { $w = 0.0 ; }
	else { $w = substr( $line, 55,6 ) ; }
	if ( substr( $line, 61,6 ) eq "      " ) { $b = 0.0 ; }
	else { $b = substr( $line, 61,6 ) ; }

#  	print " xyz", @xyz, $xyz[0] + $xyz[1] + $xyz[2], "\n" ;
  	push( @xyz_list, @xyz) ;
  	push( @atom_list, $atom_name) ;
  	push( @atom_el_list, substr( $line, 76, 2 ) );
  	push( @b_list, $b) ;
  	push( @w_list, $w) ;
  	my @achrs = split( "", $atom_name ) ;
  	if ($achrs[0] =~ m/[0-9]/ ) { push( @achrs, $achrs[0]) ; shift ( @achrs ) ; }
  
  	if ( $line_id ne $line_id_old )
  	{
  	    $nres++ ;
  	    $my_sequ[$nres]{"seq_id"} = $seq_id ; 
  	    $my_sequ[$nres]{"res_name"} = $res_name ; 
  	    $my_sequ[$nres]{"chain_id"} = $chain_id ; 
  	    $my_sequ[$nres]{"seg_name"} = $seg_name ; 
  	    $my_sequ[$nres]{"mult_flag"} = "OFF" ; 
#	    print "$nres, line_id: <$line_id> >$seg_name< \n" ;
  	    $line_id_old = $line_id ;
  	}
	$my_sequ[$nres]{"atom_end"} = $nat ; 
  	$nat++ ;
  	if ( $mult_flag eq "ON" ) { $my_sequ[$nres-1]{"mult_flag"} = "ON" ; }
     }
 }

#    print " $nat LAST_LINE_PDB> ", $pdb_records[$#pdb_records], "\n", 	$atom_list[$#atom_list], "\n";

 my @my_resid_list = () ;
 
 foreach $sub_line ( sort keys ( %my_resids ) )
 { 
 # print " residues: {", $sub_line, "}\n" ; 
     push ( @my_resid_list, $sub_line ) ; 
 }
 
 my @my_segm_list = () ;
 my @chras = qw ( A B C D E F G H I J K L M N ) ;
 my $nmm = 0 ;
 my @mult_key_list ;
 foreach $key ( sort keys ( %my_mult ) )
 { 
     print " in multiple conf loop: {", $key, " - ", @chras, "}\n" ; 
     if ( $key ne " " )
     {  
 	if ( uc($key) ne uc($chras[$nmm]) ) { push (@mult_key_list, $key ) ; }
 	else { 	print " $nmm multiple conf: {", $key, " - ", $chras[$nmm], "}\n" ; }
 	$nmm++ ; 
     } 
 }
 
 foreach $key ( @mult_key_list )
 { 
     print " unstandard multiple conf. $nmm delete: {", $key, "}\n" ; 
     delete $my_mult{$key} ; 
 }
 $nmm = 0 ;
 foreach $key ( sort keys ( %my_mult ) )
 { 
     if ( $key ne " " )
     {  
 	$nmm++ ; 
     } 
 }
 
 
 my $nsg = 0 ; foreach $sub_line ( keys ( %my_segm ) ) { $nsg++ ; }
 
 if ( $nmm == 0 )
 {
     foreach $sub_line ( sort keys ( %my_segm ) )
     { 
#	print " segment names: {", $sub_line, "}\n" ;
#	print " SUBLINE {", $sub_line, "}", scalar(@my_segm_list ), " \n" ; 
 	
 	push ( @my_segm_list, $sub_line ) ; 
     }
 }
 else
 {
     print " multiple conformations : $nmm \n" ; 
     if ( $nsg == 1 && $my_segm{"1   "} eq "DONE" )
     {
#	print " ONE SEGMENT: only \n" ; 
# 	foreach $sub_line ( sort keys ( %chain_ids ) )
# 	{ 
#	    if ( $sub_line ne " " )
#	    { push ( @my_segm_list, join('',$sub_line, "1" ) ) ; }  
#	}

 	foreach $sub_line ( sort keys ( %my_mult_chain ) )
 	{ 

#	    if ( $sub_line eq "A" ) { next ; }
	    if ( $sub_line ne " " )
	    {
#		print "each subline>$sub_line<\n" ;
		foreach $ch ( sort keys ( %{$my_mult_chain{$sub_line}} ) )
		{ 
#		    my $nm = ord($sub_line) - ord("A") + ord("1") ;
		    my $nm = ord($sub_line) ;
		    my $cnm = chr($nm) ;
#		    print " base $nm >$ch< anepdnix >$cnm<\n" ;
		    push ( @my_segm_list, join('', $ch, $cnm ) ) ; 
		}
#		print $sub_line, ">". join(" ", @my_segm_list ) , "\n" ;
	    }  
	}
     }
     else
     {
#	print " ONE SEGMENT: else \n" ; 
 
 	my $ss ;
 	my $sm ;
 	foreach $sub_line ( sort keys ( %my_segm ) )
 	{ 
#	    print " SUBLINE {", $sub_line, "}", scalar(@my_segm_list ), " \n" ; 
 	    my @chrs ; 
 	    my $sm_found = 0 ;
 	    foreach $key ( sort keys ( %my_mult ) )
 	    { 
 		foreach $sm ( @{$my_mult{$key}} )
 		{ 
#		print "}", $sub_line, "{ does match: {", $sm, "}\n" ;
 		    if ( $sub_line eq $sm )
 		    {
 			@chrs = split("", $sub_line ) ;
 			if ( $key ne " " )
 			{ 
 			    $chrs[3] = $key ; 
 			    $ss = join(" ", @chrs ) ; $ss =~ s/ //g ;
 			    push ( @my_segm_list, $ss ) ; 
#			    print " segment names: {", $ss, "} multi: {", $sm, "}\n" ;
			    $sm_found++ ;
 			}
 		    }
 		}
 	    }
	    if ( $sm_found == 0 ) 
	    {
		push ( @my_segm_list, $sub_line ) ; 
#		print " segment names: {", $sub_line, "}\n" ;
	    }
 	}
     }
 }
 
 if ( scalar( @my_segm_list ) == 1 && ( $my_segm_list[0] eq "    " || $my_segm_list[0] eq "" ) ) 
 { 
     $my_segm_list[0] = "1   " ;
#     print " push 1 on segm list\n";
 }
 
    $nn = 0 ;
    foreach $key ( keys ( %my_mult ) ) { $nn++ } ;
 
    if ( $nn == scalar( @my_segm_list ) ) {  push ( @my_segm_list, "1   " ) ; }
 
#    print " my segm list:::", join(" ", @my_segm_list), "\n" ;
 
 #push ( @my_segm_list, ("XXX " , "Y YY") ) ;
    my %segs = () ;
    foreach $key ( @my_segm_list ) { $segs{$key} = "Y" ; }
    @my_segm_list = () ;
    foreach $key ( keys ( %segs ) ) { push( @my_segm_list, $key ) ; }
 
    print "main_config::read_pdb> my segm list:::", join(" ", @my_segm_list), "\n" ;
    return ( \@my_segm_list, \@my_resid_list, \@my_sequ, 
	     \@unit_cell, 
	     \@space_group, 
	     \@atom_list, \@xyz_list, \@w_list, \@b_list, \@atom_el_list, \@secondary_helix, \@secondary_beta ) ;
}

sub write_pdb_file 
{

     my ( $PDB_FILE, $i_segm_list, $i_resid_list, $i_sequ,
     $i_unit_cell, $i_space_group, $i_atom_list, $i_xyz_list, $i_w_list, $i_b_list, $i_atom_el_list, $i_sel_list )
     = @_ ;
 
     my     @my_segm_list = @$i_segm_list ;
     my     @my_resid_list = @$i_resid_list ;
     my     @my_atom_list = @$i_atom_list ;
     my     @my_atom_el_list = @$i_atom_el_list ;
     my     @my_sequ_list = @$i_sequ ;
     my     @my_unit_cell = @$i_unit_cell ;
     my     $my_space_group = @$i_space_group ;
     my     @my_xyz_list = @$i_xyz_list ;
     my     @my_w_list = @$i_w_list ;
     my     @my_b_list = @$i_b_list ;
     my     @my_sel_list = @$i_sel_list ;
     
     my @pdb_records ;
     
# \@my_resid_list, \@my_sequ, \@unit_cell, \@space_group, \@xyz_list, \@w_list, \@b_list ) ;
     
#     my @pdb_records = () ;
     
     my $x ;
     print "writing PDB file \"$PDB_FILE\" \n" ;
     $x = join(" ",  sort(@my_segm_list)) ; $x =~ s/  / /g ;
#     print "segm list: ", $x, "\n" ;
     $x = join(" ", sort(@my_resid_list)) ; $x =~ s/  / /g ;
     print "resi list: ", $x, "\n" ;
     print "sequ list: ", scalar (@my_sequ_list), "\n" ;
#     print "unit cell: ", join( " ", @my_unit_cell), "\n" ;
#     print "space group: ", @$my_space_group, "\n" ;
     my $line ;
     my $IRS ;
     my $IATOM_OLD = 0 ;
     for ( $IRS=0; $IRS < scalar (@my_sequ_list) ; $IRS++ )
     {
	 my $IATOM ;
#	print $IRS, " iatom:",  $my_sequ_list[$IRS]{"atom_end"}, "\n" ;
	 for ( $IATOM = $IATOM_OLD; $IATOM <= $my_sequ_list[$IRS]{"atom_end"}; $IATOM++ )
	 {
	     my $el_default = substr($my_atom_list[$IATOM], 0,1) ;
	     if ( !exists( $my_atom_el_list[$IATOM]) ) 
	     {  $my_atom_el_list[$IATOM] = $el_default ; }
#	     print " iatom:", $IATOM,  " - ", $my_sel_list[$IATOM] , "->", $my_sequ_list[$IRS]{"atom_end"},  " :el", $my_atom_el_list[$IATOM], "<",  $#my_atom_el_list, ">", $el_default, "<\n" ;
	     if ( $my_sel_list[$IATOM] == 0 ) { next ;}
	     $line = sprintf "ATOM  %5d %5s%4s%1s%5s   %8.3f%8.3f%8.3f%6.2f%6.2f      %4s%2s\n", 
	     $IATOM+1,  
	     $my_atom_list[$IATOM],
	     $my_sequ_list[$IRS]{"res_name"}, 
	     $my_sequ_list[$IRS]{"chain_id"}, 
	     $my_sequ_list[$IRS]{"seq_id"}, 
	     $my_xyz_list[$IATOM*3],$my_xyz_list[$IATOM*3+1], $my_xyz_list[$IATOM*3+2],
	     $my_w_list[$IATOM],
	     $my_b_list[$IATOM],
	     $my_sequ_list[$IRS]{"seg_name"},
	     $my_atom_el_list[$IATOM],
#		"\n" ;
	     ;
	     push ( @pdb_records, $line ) ;
	 }
	 $IATOM_OLD =  $my_sequ_list[$IRS]{"atom_end"}+1 ;
     }
#	) ;
     for ( $IATOM = 0; $IATOM <=  $#odb_records; $IATOM++ )
     {     print $pdb_records[$IATOM], "\n"; }
     open ( PDB,  "> $PDB_FILE" ) || die "FILE OPEN ERROR: >$PDB_FILE< \n" ;
     print PDB @pdb_records ;
     close ( PDB ) ;
}


# while (<PDB> ) { push(@pdb_records, $_) ; } close ( PDB ) ;

# my $line;
# my $sub_line ;
# my $group ;
# my @words;
#     my @unit_cell ;
#     my @space_group ;
# foreach $line ( @pdb_records )
# {
#     if ( substr($line, 0,5) eq "CRYST" ) 
#     {
# 	chomp ($line) ;
# #	print "[$line]\n" ;
# 	$sub_line = substr( $line, 6,49 ) ;
# #	print " SUBLINE: { 23456789 23456789 23456789 234567 234567 234567} \n" ;
# #	print " SUBLINE: {$sub_line} \n" ;
# 	@words = () ;
# #	@words = split (" ", $sub_line ) ;
# 	my $I = 0 ; my $a ;
# 	$a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
# 	$a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
# 	$a = substr($sub_line, $I, 9 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 9 ; 
# 	$a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 7 ; 
# 	$a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; $I = $I + 7 ; 
# 	$a = substr($sub_line, $I, 7 ); $a =~ s/ //g ; push( @words, $a ) ; 
# 	@unit_cell = @words ; 
# 	print "UNIT CELL:", join("|", @unit_cell), "\n" ;
# 	$sub_line = substr( $line, 55,12 ) ;
# #	print " SUBLINE: {$sub_line} \n" ;
# 	@words = split (" ", $sub_line ) ; 
# # while ( $words[0] eq " " ) { print "x",  shift (@words) , "\n" ; };
# 	$group = join( '', shift(@words), shift(@words) ) ; 
# 	$group = join( '_', $group, @words ) ; $group = lc ($group) ;
# 	@space_group = ( $group ) ;
# 	print "SPACE GROUP: $group \n" ;
# 	last ;
#     }
# }
# my %my_segm = () ;
# my %my_mult = () ;
# my %my_resids = () ;
# my $nat = 0 ;
# my $seg_name = "1   " ; my $res_name ; my $seq_id ; my $chain_id ; my $mult_conf ; my $atom_name ;
# my $line_id ;
# my $line_id_old = "" ;
# my $nres = 0 ;
# my @my_sequ = () ;
# my $nn = 0 ;
# my @xyz_list = () ;
# my @b_list = () ;
# my @w_list = () ;
# my $b; my $w ;

# foreach $line ( @pdb_records )
# {
# #    if ( substr($line, 1,4) ne "    " ) { $sub_line = substr( $line, 72,4 ) ; print $sub_line, "\n" ; }
#     $nn++ ;
#     if ( substr( $line, 0,5 ) eq "MODEL" )
#     {
# 	my $I ;
# 	my @words = split( " ", $line ) ;
# 	my @chrs = split ("", $words[1] ) ;
# 	for ( $I = @chrs; $I < 4 ; $I++ ) { push(@chrs, " " ) ; }
# 	$seg_name = join("", @chrs) ;
# 	$line_id_old = "" ;
# #	print $nn, " MODEL LINE{", $line, "}", scalar(@words), "-", $seg_name, "-\n" ;
#     }
#     if ( substr( $line, 0,5 ) eq "ENDMDL" ) 
#     {
#  	$seg_name = "" ;
# 	$line_id_old = "" ;
# #	print $nn, " model LINE{", $line, "}", "-", $seg_name, "-\n" ;
#     }

#     if ( substr( $line, 0,3 ) eq "TER") { $line_id_old = "" ; }

#     if ( substr( $line, 0,4 ) eq "ATOM" || substr( $line, 0,5 ) eq "HETAT" )
#     { 
# 	if ( length($line) >= 75 ) 
# 	{ my $chrt = substr( $line, 72,4 ) ; $seg_name = $chrt if ( $chrt ne "    " ) ; }
# #	if ( $seg_name eq "    " ) { print "TEST SEG NAME {", $seg_name, "}\n" };
# #	if ( $seg_name eq "" ) { print "test SEG NAME {", $seg_name, "}\n" };
# 	$my_segm{$seg_name} = "DONE" ; 
# 	$res_name = substr( $line, 17,4 ) ; $my_resids{$res_name} = "DONE" ; 

# 	$seq_id = substr( $line, 22,5 ) ; 
# 	$chain_id = substr( $line, 21,1 ) ; 
# 	$line_id = join("^", $res_name, $seq_id, $chain_id, $seg_name) ;

# 	$mult_conf = substr( $line, 16,1 ) ; 
# 	my $mult_flag = "OFF" ;
# 	if ( $mult_conf eq " " ) 
# 	{
# 	    if (  substr( $line, 12,1 ) eq " " )
# 	    { $atom_name = substr( $line, 13,4 ) ; }
# 	    else
# 	    { $atom_name = substr( $line, 12,4 ) ; }
# 	}
# 	else
# 	{ 
# #	    print "{", substr( $line, 16,1 ), "} ", $line; 
# 	    if (  substr( $line, 12,1 ) eq " " )
# 	    {
# 		$atom_name = substr( $line, 13,4 ) ; 
# 		if ( substr( $atom_name, 0, 1 ) ne "H" ) 
# 		{ 
# 		    push( @{$my_mult{$mult_conf}}, $seg_name ) ; 
# 		    $mult_flag = "ON" ;
# #		    print "{", substr( $atom_name, 0,1 ), "} ", $line; 
# 		}
# 	    }
# 	    else
# 	    {
# 		$atom_name = substr( $line, 12,4 ) ; 
# 		push( @{$my_mult{$mult_conf}}, $seg_name ) ; 
# 		$mult_flag = "ON" ;
# #		print " ne H{", substr( $atom_name, 0,1 ), "} \n"; 
# 	    }
# 	}
# 	my @xyz = () ;
# 	$xyz[0] = substr( $line, 31,8 ) ;
# 	$xyz[1] = substr( $line, 39,8 ) ;
# 	$xyz[2] = substr( $line, 47,8 ) ;
# 	$w = substr( $line, 55,6 ) ;
# 	$b = substr( $line, 61,6 ) ;
# #	print " xyz", @xyz, $xyz[0] + $xyz[1] + $xyz[2], "\n" ;
# 	push( @xyz_list, @xyz) ;
# 	push( @b_list, $b) ;
# 	push( @w_list, $w) ;
# 	my @achrs = split( "", $atom_name ) ;
# 	if ($achrs[0] =~ m/[0-9]/ ) { push( @achrs, $achrs[0]) ; shift ( @achrs ) ; }

# 	if ( $line_id ne $line_id_old )
# 	{

# 	    $my_sequ[$nres]{"seq_id"} = $seq_id ; 
# 	    $my_sequ[$nres]{"res_name"} = $res_name ; 
# 	    $my_sequ[$nres]{"chain_id"} = $chain_id ; 
# 	    $my_sequ[$nres]{"seg_name"} = $seg_name ; 
# 	    $my_sequ[$nres]{"atom_end"} = $nat ; 
# 	    $my_sequ[$nres]{"mult_flag"} = "OFF" ; 
# 	    $line_id_old = $line_id ;
# 	    $nres++ ;
# 	}
# 	if ( $mult_flag eq "ON" ) { $my_sequ[$nres-1]{"mult_flag"} = "ON" ; }
# 	$nat++ ;
#     }
# }


sub read_topology_files 
{
    my @TOP_FILE  = @_ ;
    my @top_records = () ;
    my %my_topo = () ;
    my %my_lib = () ;
    my @my_class ;
    my $FILE ;

    foreach $FILE ( @TOP_FILE ) 
    {

	print "reading TOPOLOGY file \"$FILE\" \n" ;
	open ( TOP,  "< $FILE" ) || print "read_topology_files> FILE OPEN ERROR: >$FILE< \n" ;

	while (<TOP> ) { push(@top_records, $_) ; } close ( TOP ) ;

    my $line;
    my @words;
    my $current ;
    my @res_atoms ;
    my @res_bonds ;
    my @res_dihes ;
    my @res_impros ;
    my @res_plans ;
    my @res_intes ;

    foreach $line ( @top_records )
    {
#	print $line ;
	@words = split(" ", $line ) ;
	chomp ( $line ) ;
	if ( @words gt 0 ) 
	{
	    if ( uc(substr($words[0], 0,4)) eq "RESI" || uc(substr($words[0], 0,4)) eq "MOLE"  ) 
	    {
#		print " residue ", $words[1], "\n" ;
		$my_topo{$words[1]} = $words[0] ;
		$current = $words[1] ;
		$my_lib{$current}{"kind"} = $words[0] ;
		$my_lib{$current}{"name"} = $words[1] ;
		@res_atoms = () ;
		@res_bonds = () ;
		@res_dihes = ()  ;
		@res_impros = ()  ;
		@res_plans = () ;
		@res_intes = () ;
	    }
	    elsif ( uc(substr($words[0], 0,4)) eq "CLAS" ) { push( @my_class, $line)  }
	    elsif ( uc(substr($words[0], 0,4)) eq "ATOM" ) { push( @res_atoms, $line) ; }
	    elsif ( uc(substr($words[0], 0,4)) eq "BOND" ) { push( @res_bonds, split(" ", $line)) ;  }
	    elsif ( uc(substr($words[0], 0,4)) eq "DIHE" ) { push( @res_dihes, split(" ", $line))  }
	    elsif ( uc(substr($words[0], 0,4)) eq "IMPR" ) { push( @res_impros, split(" ", $line))  }
	    elsif ( uc(substr($words[0], 0,4)) eq "PLAN" ) { push( @res_plans, $line)  }
	    elsif ( uc(substr($words[0], 0,4)) eq "INTE" ) { push( @res_intes, $line)  }
	    elsif ( uc(substr($words[0], 0,5)) eq "GROUP" ) {  }
	    elsif ( uc(substr($words[0], 0,4)) eq "MASS" ) {  }
	    elsif ( uc(substr($words[0], 0,1)) eq "!" ) {  }
	    elsif ( uc(substr($words[0], 0,3)) eq "END" ) 
	    {  
		@{$my_lib{$current}{"atom"}} = @res_atoms ;
		@{$my_lib{$current}{"bond"}} = @res_bonds ;
		@{$my_lib{$current}{"dihe"}} = @res_dihes ;
		@{$my_lib{$current}{"impr"}} = @res_impros ;
		@{$my_lib{$current}{"plan"}} = @res_plans ;
		@{$my_lib{$current}{"inte"}} = @res_intes ;
#		print "read_topo> $current\n" ;
	    }
	    else
	    { print "main_config.pm> read_topo: UNKOWN KEYWORD>> $line<\n" ; }
	}
    }
    }
    return ( \%my_topo, \@my_class, \%my_lib ) ;
}


sub read_ctab_file 
{
    my ( $MY_FILE ) = @_ ;
    my @ctab_records = () ;

print "reading MAIN CTAB file \"$MY_FILE\" \n" ;
    open ( PDB,  "< $MY_FILE" ) || print "read_ctab_file> FILE OPEN ERROR: >$MY_FILE< \n"; 

while (<PDB> ) { push(@ctab_records, $_) ; } close ( PDB ) ;

    my $line;
    my $sub_line ;
    my $group ;
    my @words;
    my @my_ctab ;
    my $title = 0 ;
    foreach $line ( @ctab_records )
    {
	if ( substr($line, 0,2) eq "* " ) { $title = 1 ; next ; }
	if ( substr($line, 0,2) eq " *" ) { $title = 1 ; next ; }
	chomp ($line) ;
	if ( $title == 1 ) 
	{ $n_ctab = substr($line, 0, 7 ) ; $title = 3 ; next }
	else
	{	    
	    my $iatom =  substr($line, 0, 5 ) ;
	    my $leng = length ( $line ) ;
	    my $i = ( $leng - 30) / 6 ;
#	    print "$iatom $i [$line] <$leng >\n" ;
	    my @ct_line = () ;
	    for ( my $j = 0; $j < $i; $j++ ) 
	    { my $k = substr( $line, 30 + $j*6, 6 ) ;  $k =~ s/ //g ;
		  push( @ct_line, $k ) ; }
#	    print " $iatom |", join( " ", @ct_line), "|\n" ;
	    push ( @{$my_ctab[$iatom]}, @ct_line ) ;
	}
    }
    return ( \@my_ctab ) ;
}

sub create_re_image 
{
    my ( %my_main ) = @_ ;

    my %selections ;
    my $MACRO_FILE ="re_image.cmds" ;
    if ( !exists($my_main{"IMAGE_HYDRO"}) ) { $my_main{"IMAGE_HYDRO"}[0] = "OFF" ; }
    if ( !exists($my_main{"IMAGE_RADII_FRACTION"}) ) { $my_main{"IMAGE_RADII_FRACTION"}[0] = 0.3 ; }

    if ( !exists($my_main{"IMAGE_COLOR_START"} ) ) 
    { 
	if ( $my_main{"SG_NMOL"}[0] > 8 ) 
	{ push ( @{$my_main{"IMAGE_COLOR_START"}}, 144 ) }
	elsif( $my_main{"SG_NMOL"}[0] > 4 ) 
	{ push ( @{$my_main{"IMAGE_COLOR_START"}}, 150 ) ; }
	elsif( $my_main{"SG_NMOL"}[0] > 2 ) 
	{ push ( @{$my_main{"IMAGE_COLOR_START"}}, 152 ) ; }
	else
	{ push ( @{$my_main{"IMAGE_COLOR_START"}}, 160 ); }
    }
    if ( !exists($my_main{"IMAGE_COLOR_INCR"} ) ) 
    { 
	if ( $my_main{"SG_NMOL"}[0] > 8 ) 
	{ push ( @{$my_main{"IMAGE_COLOR_INCR"}}, 2 ) }
	else
	{ push ( @{$my_main{"IMAGE_COLOR_INCR"}}, 5 ) ; }
    }
    if ( !exists($my_main{"IMAGE_MY_FILE"} ) ) { @{$my_main{"IMAGE_MY_FILE"}} = ("OFF") ; }
    if ( !exists($my_main{"IMAGE_MY_FILE_NAME"} ) ) { @{$my_main{"IMAGE_MY_FILE_NAME"}} = ("--NONE--") ; }

    if ( !exists($my_main{"IMAGE_COLOR_1"} ) ) { @{$my_main{"IMAGE_COLOR_1"}} = ( 1,1,1 ) ; }
    if ( !exists($my_main{"IMAGE_COLOR_2"} ) ) { @{$my_main{"IMAGE_COLOR_2"}} = ( 0,1,1 ) ; }
    if ( !exists($my_main{"IMAGE_COLOR_3"} ) ) { @{$my_main{"IMAGE_COLOR_3"}} = ( 1,0,1 ) ; }
    if ( !exists($my_main{"IMAGE_COLOR_4"} ) ) { @{$my_main{"IMAGE_COLOR_4"}} = ( 1,1,0 ) ; }
    if ( !exists($my_main{"IMAGE_COLOR_5"} ) ) { @{$my_main{"IMAGE_COLOR_5"}} = ( 1,0.5,0.8 ) ; }
    if ( !exists($my_main{"IMAGE_COLOR_6"} ) ) { @{$my_main{"IMAGE_COLOR_6"}} = ( 0.5,1,0.8 ) ; }
    
    if ( !exists($my_main{"IMAGE_HELIX"} ) ) { @{$my_main{"IMAGE_HELIX"}} = ( "" ) ; }
    if ( !exists($my_main{"IMAGE_BETA"} ) )  { @{$my_main{"IMAGE_BETA"}} = ( "" ) ; }

    my $fract =  $my_main{"IMAGE_RADII_FRACTION"}[0] ;
    print " fraction{", $fract, "}\n" ;
    my $rad = "vdw" ;

    my $key ;
    my $nn = 0 ;
    foreach $key (keys %my_main ) 
    {
	if ( $key =~ "IMAGE_HASH" )
	{
	    $nn++ ;
	    my $value = join (" ", @{$my_main{$key}} ) ;
	    my @words = split ( "IMAGE_HASH_", $key ) ;
	    shift (@words) ;
	    my $name = join(" ", @words ) ;
	    @words = split ("_", $name ) ;
	    my $kind = pop ( @words ) ;
	    my $select = join ( "_", @words ) ;
#	    print " HASH: $select $kind value = {", $value, "}\n" ;
	    $selections{$select}{$kind} = $value ;
	}
    }
    
    if ( $nn == 0 ) 
    {
	my $word ;
	%selections = () ;
	foreach $word ( @{$my_main{"SG_LIST"}} ) 
	{
	    my $sel_id = join( "_", "seg", $word ) ;
	    my $sel = join( " ", "segm name", $word ) ;
#	    print "segment list ", $word, "\n" ;
	    $selections{$sel_id}{"NAME"} = "seg" ;
	    $selections{$sel_id}{"SELECTION"} = $sel ;
	    $selections{$sel_id}{"ONOF"} = "OFF" ;
	    $selections{$sel_id}{"ATOM"} = "NONE" ;
	    $selections{$sel_id}{"BOND"} = "LINE" ;
	    $selections{$sel_id}{"RIBBON"} = "NONE" ;
	    $selections{$sel_id}{"SURFACE"} = "NONE" ;
	    $selections{$sel_id}{"STYLE"} = "WEIGHT" ;
	}
    }
    
    
    my $ICOLOR = ${$my_main{"IMAGE_COLOR_START"}}[0] ;
    my $ICOLOR_INCREM = ${$my_main{"IMAGE_COLOR_INCR"}}[0];
    my $hydrogen_flag ;
    if ( $my_main{"IMAGE_HYDRO"}[0] eq "ON" ) 
    { $hydrogen_flag = 1 ; } else { $hydrogen_flag = 0 ; }
#    print "main_config> hydrogen ", $hydrogen_flag, " ",  @{$my_main{"IMAGE_HYDRO"}}, "\n" ;
    my $chain_memory_flag ;
    if ( $my_main{"IMAGE_CHAIN"}[0] eq "ON" ) 
    { $chain_memory_flag = 1 ; } else { $chain_memory_flag = 0 ; }
#print "main_config> ", $chain_memory_flag, " ",  @{$my_main{"IMAGE_CHAIN"}}, "\n" ;




my $sel_id ;
print "creating \"$MACRO_FILE\" \n" ;
if ( -f $MACRO_FILE ) 
{ 
    my $back = join ('', $MACRO_FILE, ".old" ) ; 
    system ( "mv  $MACRO_FILE $back" ) ; 
}
#print " image :<", @{$my_main{"IMAGE_MY_FILE"}}, ">\n" ;
open ( MACRO,  "> $MACRO_FILE" ) || die "FILE OPEN ERROR: >$MACRO_FILE< \n" ;
if ( ${$my_main{"IMAGE_MY_FILE"}}[0] eq "ON" )
{
    my $my_file = $my_main{"IMAGE_MY_FILE_NAME"}[0] ;
#print " image file:<", $my_file, ">\n" ;
    if ( $my_file eq "--NONE--" ) { print " create_re_image> WARNING undefined re_image file $my_file\n" ; }
#    print << "END_OF_TEXT" ;
    print MACRO << "END_OF_TEXT" ;
subroutine char SEGMENTS
  image erase
delete atom sele segm name #* end
key image sele .not all end
< $my_file 
return
END_OF_TEXT
close(MACRO) ;
exit ;
}


print MACRO << "END_OF_TEXT" ;
subroutine char SEGMENTS

delete atom sele segm name #* end
key image sele .not all end

if ( MIN_TETHER .eq. "ON" ) then
  key my_tether sele active end
else
  image from CHAIN_TRACE
end_if

  image erase
END_OF_TEXT

    print MACRO "vlt\n" ;
printf MACRO ( " color 33 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_1"}} );
printf MACRO ( " color 34 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_2"}} );
printf MACRO ( " color 35 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_3"}} );
printf MACRO ( " color 36 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_4"}} );
printf MACRO ( " color 37 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_5"}} );
printf MACRO ( " color 38 red %4.2f green %4.2f blue %4.2f \n",  @{$my_main{"IMAGE_COLOR_6"}} );
    print MACRO "exit\n" ;


my @hlx =  @{$my_main{"IMAGE_HELIX"}}  ;
print "helix:", @hlx, "\n" ;

my $sgm_old = "----" ;
while ( $#hlx > 0 )
    {
	my $sgm = shift ( @hlx ) ;
	if ( $sgm_old ne $sgm )
	{ 
	    print MACRO " set sec assign sele chain name $sgm end coil\n" ;
	    $sgm_old = $sgm ;
	}
	my $sq1 = shift ( @hlx ) ;
	my $sq2 = shift ( @hlx ) ;
	print MACRO " set sec assign sele chain name $sgm .a seq $sq1 : $sq2 end alpha\n" ;
    }

my @bt = @{$my_main{"IMAGE_BETA"}} ;
while ( $#bt > 0)
    {
	my $sgm = shift ( @bt ) ;
	my $sq1 = shift ( @bt ) ;
	my $sq2 = shift ( @bt ) ;
	print MACRO " set sec assign sele chain name $sgm .a seq $sq1 : $sq2 end beta\n" ;
    }

print " chain memory falg: $chain_memory_flag \n" ;
if ( $chain_memory_flag == 1 ) 
{
print MACRO << "END_OF_DATA" ;

if ( MIN_TETHER .ne. "ON" ) then
echo "------------->>>  erase CHAIN TRACE "
image erase CHAIN_TRACE
image group name CHAIN_TRACE
image sele atom name CA C N .a segm name WORK_SEGM end col 1 bond
ima from 
image erase

end_if

END_OF_DATA
}

foreach $sel_id ( sort keys %selections )
{

#    print "sel ID>", $sel_id, "\n" ;
#" atom:", $selections{$sel_id}{"ATOM"}, 
#    " bond: ", $selections{$sel_id}{"BOND"}, "<\n" ;

    if ( $sel_id eq "" ) { next ; }
    if ( $selections{$sel_id}{"ONOF"} eq "OFF" ) { next ; }
#    print $sel_id, "ssel_id:{", $sel_id, "}\n" ;
    print MACRO 
	"\n image group name ", $sel_id, "\n" ;
    print MACRO 
	"key display select ", $selections{$sel_id}{"SELECTION"}, " end\n" ;
if ( $hydrogen_flag == 0 )
{
    print MACRO 
	"key display select display .a .not atom name H* end\n" ;
}

print MACRO << "END_OF_TEXT" ;

if ( MIN_TETHER .eq. ON ) then
key display sele display .and. .not. my_tether end
end_if

END_OF_TEXT

# style = ATOM WEIGHT
if ( $selections{$sel_id}{"STYLE"} eq "AUTO" )
{
    print MACRO "set color \n";
    print MACRO	" sele display end = $ICOLOR\n" ;
    print MACRO "exit\n\n" ;
}
# style = ATOM WEIGHT
elsif ( $selections{$sel_id}{"STYLE"} eq "WEIGHT" )
{
    print MACRO "set color \n";
    print MACRO
	" sele display .a .n weigh 0.01 1.1 end = 200\n",
	" sele display .a \\ \n", 
	"     atom name H* .a .n by bond weigh 0.01 1.1 end = 200\n";
    print MACRO
	" sele display .a weigh 0.01 1.1 end = $ICOLOR\n",
	" sele display .a \\ \n", 
	"     atom name H* .a by bond weigh 0.01 1.1 end = $ICOLOR\n" ;
    print MACRO "exit\n\n" ;

    print MACRO << "END_OF_TEXT" ;
 set vari NN int atom sele display .a weigh 1.0 1.1 end 
 if ( NN .gt. 0 ) then 
  set color 
  sele display .a weigh 0.01 0.99 end = $ICOLOR - 15 
  sele display .a \\ 
     atom name H* .a by bond weigh 0.01 0.99 end = $ICOLOR - 15
  exit
 end_if
END_OF_TEXT
}
# style = ATOM TYPES
elsif ( $selections{$sel_id}{"STYLE"} eq "TYPES" )
{
    print MACRO 
	"set color \n";
    print MACRO << "END_OF_TEXT" ;
sele display end default
sele display .a atom name C* end = $ICOLOR
END_OF_TEXT
print MACRO "exit\n\n" ;
}
# style  N2C
elsif ( $selections{$sel_id}{"STYLE"} eq "N2C" )
{
    print MACRO 
	"set color \n";
    print MACRO 
	" sele display end residue 128 255 6 \n" ;
print MACRO "exit\n\n" ;
}
# style  N2C
elsif ( $selections{$sel_id}{"STYLE"} eq "SECONDARY" )
{
    print MACRO << "END_OF_TEXT" ;
 set color
 sele display .a sec alpha end col 110
 sele display .a sec beta end col 220
END_OF_TEXT
print MACRO "exit\n\n" ;
}
elsif ( $selections{$sel_id}{"STYLE"} eq "RESIDUE" )
{
    print MACRO "set color \n";
    print MACRO << "END_OF_TEXT" ;
sele display  .a resi name GLY ILE VAL LEU ALA PRO MET end = 32
sele display  .a resi name ASP GLU end = 110
sele display  .a resi name LYS ARG end = 240
sele display  .a resi name TYR PHE TRP HIS* end = 200
sele display  .a resi name SER THR ASN GLN end = 220
sele display  .a resi name CYS end = 160
END_OF_TEXT
print MACRO "exit\n\n" ;
}
else
{
    print MACRO "set color \n";

if ( $selections{$sel_id}{"STYLE"} eq "WHITE" )
{  print MACRO 	" sele display end col 32 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "BLACK" )
{ print MACRO " sele display end col 0 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "VIOLET" )
{ print MACRO " sele display end col 90 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "RED" )
{ print MACRO " sele display end col 120 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "ORANGE" )
{ print MACRO " sele display end col 140 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "YELLOW" )
{ print MACRO " sele display end col 160 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "GREEN" )
{ print MACRO " sele display end col 200 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "CYAN" )
{ print MACRO " sele display end col 220 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "BLUE" )
{ print MACRO " sele display end col 244 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 1" )
{ print MACRO " sele display end col 33\n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 2" )
{ print MACRO " sele display end col 34 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 3" )
{ print MACRO " sele display end col 35 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 4" )
{ print MACRO " sele display end col 36 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 5" )
{ print MACRO " sele display end col 37 \n" ; }
elsif ( $selections{$sel_id}{"STYLE"} eq "COLOR 6" )
{ print MACRO " sele display end col 38 \n" ; }


print MACRO "exit\n\n" ;
}

# CHAINS

if ( $selections{$sel_id}{"RIBBON"} eq "STICK" )
{
    print MACRO << "END_OF_TEXT" ;


dele point sele display end ribbon
make poin from atom sele display .a atom name CA end ribb both ! heli ! strand !  both
set rib rad 0.3 \\
        dens 16 \\
        step 8 \\
        refine 1

image set
image sele display end poin ribb ( stick helix 1.5 0.3 strand 0.8 0.3 ) 
key image sele image .o ( display .a atom name CA ) end

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"RIBBON"} eq "LINE" )
{
    print MACRO << "END_OF_TEXT" ;

key xx_active sele active end
key active sele display end
 <?MAIN_CMDS:image_color_set.cmds
 <?MAIN_CMDS_NEW:image_do_rib_line.cmds 
key image sele image .o ( display .a atom name CA ) end
key active sele xx_active end
key xx_active drop

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"RIBBON"} eq "MAIN" )
{
    print MACRO << "END_OF_TEXT" ;

key xx_active sele active end
key active sele display end
 <?MAIN_CMDS:image_color_set.cmds
! make bond sele display .a .n resi name CA end from resi CA
! make bond sele display end from resi P
! dele bond sele atom name P .a bond range 10. 1000. end
dele bond sele atom name N CA C .a bond range 5. 1000. end
image sele display .a atom name N C CA P C3\' O3\' C4\' C5\' O5\' end set bond
dele bond sele display .a atom name CA end
dele bond sele display .a atom name P end

key image sele image .o ( display .a atom name CA P ) end
key active sele xx_active end
key xx_active drop

END_OF_TEXT
}

# SURFACE

if ( $selections{$sel_id}{"SURFACE"} eq "COLOR" )
{
    print MACRO << "END_OF_TEXT" ;

key xx_active sele active end
key active sele display end
 <?MAIN_CMDS:image_color_set.cmds
image select display end poin 3angle ! rgb
key image sele image .o ( display ) end
key active sele xx_active end
key xx_active drop

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"SURFACE"} eq "ATOM_RGB" )
{
    print MACRO << "END_OF_TEXT" ;

key xx_active sele active end
key active sele display end
 <?MAIN_CMDS:image_color_set.cmds
image select display end poin 3angle ( atom rgb )
key image sele image .o ( display ) end
key active sele xx_active end
key xx_active drop

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"SURFACE"} eq "POINT_RGB" )
{
    print MACRO << "END_OF_TEXT" ;

key xx_active sele active end
key active sele display end
 <?MAIN_CMDS:image_color_set.cmds
image select display end poin 3angle ( point rgb )
key image sele image .o ( display ) end
key active sele xx_active end
key xx_active drop

END_OF_TEXT
}

# ATOMS
if ( $selections{$sel_id}{"ATOM"} eq "NONE" )
{
#print " sel id: {", $sel_id, "++", $selections{$sel_id}{"ATOM"}, "}\n" ;
}
elsif ( $selections{$sel_id}{"ATOM"} eq "BALL" )
{
    if ( exists($selections{$sel_id}{"RADII"} ) ) { $rad = $selections{$sel_id}{"RADII"} ; }
#    my $fract =  $my_main{"IMAGE_RADII_FRACTION"}[0] ;
#    print " image radii fraction: $fract \n" ;
    print MACRO << "END_OF_TEXT" ;
set rad sele display end $rad
scal $fract sele display end rad
image sele display end set atom ball

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"ATOM"} eq "NAME" )
{
    print MACRO << "END_OF_TEXT" ;

image sele display end set atom name

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"ATOM"} eq "CLASS" )
{
    print MACRO << "END_OF_TEXT" ;
image sele display end set atom class

END_OF_TEXT
}
elsif ( $selections{$sel_id}{"ATOM"} eq "CROSS" )
{
    print MACRO << "END_OF_TEXT" ;
image sele display end set atom cross

END_OF_TEXT
}
else
{
#print " NONE sel id: {", $sel_id, "++", $selections{$sel_id}{"ATOM"}, "}\n" ;
}

# BONDS

if ( $selections{$sel_id}{"BOND"} eq "LINE" )
{ 
if ( $fract != 1 ) 
{ 
    if ( exists($selections{$sel_id}{"RADII"} ) ) { $rad = $selections{$sel_id}{"RADII"} ; }
    print MACRO << "END_OF_TEXT" ;
set rad sele display end $rad
scal $fract sele display end rad
END_OF_TEXT
}
    print MACRO << "END_OF_TEXT" ;
image sele display end set bond line
image sele display .a .n by bond display end set atom cros
image sele display .a .n by bond all .a .n atom name O* end set atom ball
END_OF_TEXT
}
elsif ( $selections{$sel_id}{"BOND"} eq "STICK" )
{ 
#    my $fract =  $my_main{"IMAGE_RADII_FRACTION"}[0] ;
#    print " image radii fraction: $fract \n" ;
if ( $fract != 1 ) 
{ 
    if ( exists($selections{$sel_id}{"RADII"} ) ) { $rad = $selections{$sel_id}{"RADII"} ; }
    print MACRO << "END_OF_TEXT" ;
set rad sele display end $rad
scal $fract sele display end rad
END_OF_TEXT
}
    print MACRO << "END_OF_TEXT" ;
image sele display end set bond stick
image sele display .a .n by bond display end set atom cros
image sele display .a .n by bond all .a .n atom name O* end set atom ball

END_OF_TEXT
} 
elsif ( $selections{$sel_id}{"BOND"} eq "DISTANCE" )
{ 
#    my $fract =  $my_main{"IMAGE_RADII_FRACTION"}[0] ;
#    print " image radii fraction: $fract \n" ;
    print MACRO << "END_OF_TEXT" ;
image sele display end set bond distance

END_OF_TEXT
} 

$ICOLOR = $ICOLOR + $ICOLOR_INCREM ;

}
print MACRO << "END_OF_TEXT" ;

  image group name HBONDS
  image sele image end col 85 hbond
!  image sele t_anchor end col 200 atom cros
!  image sele t_anchor .o by pair t_anchor end col 200 pair 
  image group name MISCELLANEOUS

END_OF_TEXT

print MACRO << "END_OF_TEXT" ;

if ( MIN_TETHER .eq. ON ) then
  image from 
  image era
  image group name TETHER
  image col 160 sele by bond my_tether end bond
  key my_tether drop
end_if

key display drop
return

END_OF_TEXT

close(MACRO) ;
#exit;
}


sub list_regenerate
{
    my ( $event, $all_files, $list_files, $filter_file, $lb ) = @_ ;
    my $my_file ;
    @{$list_files} = () ;
    my @filter_list = split ( '\*', ${$filter_file} ) ;
    
    my $filter ;
    foreach $my_file ( sort( @{$all_files} ) )
    {
	my $done = "YES" ;
#	print " filter list:", $my_file ,"\n" ;
	foreach $filter ( @filter_list )
	{
#	    print " filter:", $filter , " - ", $filter_file, "\n" ;
	    if ( uc($my_file) !~ uc($filter) ) { $done = "NOT" }
	}
	if ( $done eq "YES" ) 
	{ 
	    push( @{$list_files}, $my_file ) ; 
#	    print " my file-> $my_file \n" ;
	}
    }
#     foreach $my_file ( sort( @{$all_files} ) )
#     {
# 	if ( uc($my_file) =~ uc(${$filter_file}) ) 
# 	{ 
# 	    push( @{$list_files}, $my_file ) ; 
# #	    print " INSIDE MATHC:", $my_file, "\n" ; 
# 	}
# 	else
# 	{ 
# #	    print " NO MATHC:", $my_file, " - for - ", $filter_file, "\n" ; 
# 	}
#     }
    ${$lb}->delete("0.0", 'end');
    ${$lb}->insert('end', @{$list_files} ) ;

}

sub make_ctab_link
{
    my ( $i1, $i2, @i_ctab ) = @_ ;

    if ( $i1 == $i2 ) { return ( @i_ctab) ;}

    my $II ;
    $found = "N" ;
#    print " main_cof:: make_ctab_link>", $i1, "  ", scalar(@{$i_ctab[$i1]}), "\n" ;
    my $TEST = scalar(@{$i_ctab[$i1]}) ;
    if ( $TEST > 0 )
    {
	for ( $II = 0; $II < scalar(@{$i_ctab[$i1]}) ; $II++ )
	{
	    if ( $i_ctab[$i1][$II] == $i2 ) { $found = "Y" ; last ; }
	}
    }
    if ( $found eq "N" ) { push ( @{$i_ctab[$i1]}, $i2 ) ; }
    
    $found = "N" ;
    $TEST = scalar(@{$i_ctab[$i2]}) ;
    if ( $TEST > 0 )
    {
	for ( $II = 0; $II < scalar(@{$i_ctab[$i2]}) ; $II++ )
	{
	    if ( $i_ctab[$i2][$II] == $i1 ) { $found = "Y" ; last ; }
	}
    }
    if ( $found eq "N" ) { push ( @{$i_ctab[$i2]}, $i1 ) ; }
    return ( @i_ctab ) ;
}

sub dele_ctab_link
{
    my ( $i1, $i2, @i_ctab ) = @_ ;

    if ( $i1 == $i2 ) { return ( @i_ctab) ;}

    my $II ;
    my @l_ctab = () ;

#    print " main_cof:: make_ctab_link>", $i1, "  ", scalar(@{$i_ctab[$i1]}), " $i2\n" ;
    for ( $II = 0; $II < scalar(@{$i_ctab[$i1]}) ; $II++ )
    {
	if ( $i_ctab[$i1][$II] != $i2 ) 
	{ push ( @l_ctab, $i_ctab[$i1][$II] ) }
    }
    @{$i_ctab[$i1]} = @l_ctab ;

    @l_ctab = () ;

    for ( $II = 0; $II < scalar(@{$i_ctab[$i2]}) ; $II++ )
    {
	if ( $i_ctab[$i2][$II] != $i1 ) 
	{ push ( @l_ctab, $i_ctab[$i2][$II] ) }
    }
    @{$i_ctab[$i2]} = @l_ctab ;

    return ( @i_ctab ) ;
}




sub read_jCE_file 

{
    my $INPUT_FILE = $_[0] ;
    my $line ;
    my @SEQ_INPUT_LINES ;
    my %seq_data ;
    my @id_list ;

    open ( TXT, $INPUT_FILE ) || die "READ FILE OPEN ERROR: >$INPUT_FILE< \n" ; 
    print " read alignment file: >$INPUT_FILE<\n" ;
    while(<TXT>)
    {
	chomp ;
	$line = $_ ;
	push ( @SEQ_INPUT_LINES, $line ) ;
    }
    close(TXT) ;

#if ( $#SEQ_INPUT_LINES <= 0 ) { print " EMPTY FILE: \n" ; exit }
#    print @SEQ_INPUT_LINES, "\n" ;
    my $data_flag = "N" ;
    my @line_array ;
    
#    while ( $data_flag eq "N" )
    until ( $data_flag eq "Alignment" ||  $#SEQ_INPUT_LINES < 0 )
    {
#	print " seq numb: $#SEQ_INPUT_LINES \n";
	$line = shift (@SEQ_INPUT_LINES ) ;
	@line_array = split( " ", $line ) ;
	if ( $#line_array >= 0 ) 
	{
	    print $#line_array, " file: >$line<\n" ;
	    $data_flag = $line_array[0] ; 
	}
    }
#    continue
#    { 
#	print "until  >",  $#line_array, "< $data_flag >\n" ; 
#    }
#    print "data: >$line< \n" ;
    my @words ;	    

    until ( $data_flag eq "X1" || $#SEQ_INPUT_LINES < 0 )
    {
	$line = shift (@SEQ_INPUT_LINES ) ;
	@words = split( " ", $line ) ;
	if ( $#words > 0 ) 
	{ 
	    $data_flag = $words[0] ; 
#	    print " data flag: >", $data_flag, "<\n" ;
	}

	@line_array = split( ":", $line ) ;
	if ( $#line_array < 0 ) { next ; }
	$id = $line_array[0] ;
	$id =~ s/ /_/g ;
	if ( $#line_array > 0 )
	{
	    if ( !exists($seq_data{$id} ) ) { print "push $id\n" ; push(@id_list, $id) ; }
	    my @chrs = split(" ", $line_array[1]) ;
	    if ( $#chrs >= 1 ) 
	    { 
		push ( @{$seq_data{$id}}, $chrs[1] ) ;
#		print $id, " d: >",$chrs[1],"< \n" ;
	    }

	}
    }
    my @matrix ;
    my @tran3 ;
#    print " data final flag: >", $data_flag, "-", $line, "<\n" ;
    $line =~ tr/\(\)+XYZorig=\*/          / ;
    @words = split (" ", $line ) ; shift(@words) ; $tran3[0] = pop ( @words) ; @{$matrix[0]} = @words ;
#    print " data final flag: >", $data_flag, "-", $line, "<\n" ;

    $line = shift (@SEQ_INPUT_LINES ) ;
    $line =~ tr/\(\)+XYZorig=\*/          / ;
    @words = split (" ", $line ) ; shift(@words) ; $tran3[1] = pop ( @words) ; @{$matrix[1]} = @words ;
#    print " data final flag: >", $data_flag, "-", $line, "<\n" ;

    $line = shift (@SEQ_INPUT_LINES ) ;
    $line =~ tr/\(\)+XYZorig=\*/          / ;
    @words = split (" ", $line ) ; shift(@words) ; $tran3[2] = pop ( @words) ; @{$matrix[2]} = @words ;
#    print " data final flag: >", $data_flag, "-", $line, "<\n" ;
    
#     print " set matrix 3 number -\n" ;
#     print join( " ", @{$matrix[0]}), " -\n" ;
#     print join( " ", @{$matrix[1]}), " -\n" ;
#     print join( " ", @{$matrix[2]}), "\n" ;
# 
#     print " set vari XTRAN global real = ", $tran3[0], "\n" ;
#     print " set vari YTRAN global real = ", $tran3[1], "\n" ;
#     print " set vari ZTRAN global real = ", $tran3[2], "\n" ;

#123456789_123456789_123456789_123456789_123456789_123456789_123456789_123456789_12345678
#     X1 = ( 0.994880)*Xorig + ( 0.002686)*Yorig + ( 0.101024)*Zorig + (  -37.570805)

return ( \%seq_data, \@id_list, \@matrix, \@tran3 ) ;
    
}

sub create_constrain_cryst_inter
{
    my $FH = shift(@_);
    my %my_main = @_ ;

    my $NCRYST = $my_main{"SG_NCRYST"}[0] ;
    print $FH "define init constr inter \n" ;
    my $CRYST ;
    for ( $CRYST = 0; $CRYST < $NCRYST ; $CRYST++ )
    {
	my $GROUP = join ( '', "SG_CRYST" , $CRYST+1 ) ;
	print $FH 
	    "set vari SEG_CRYST = \"", join(" ", @{$my_main{$GROUP}}), "\"\n",
	    "define constr inter \\\n",
	    "sele segm name SEG_CRYST end sele segm name SEG_CRYST end\n" ;
    }
    print $FH "\n" ;
}

sub create_constrain_composit_inter
{
    my $FH = shift(@_);
    my %my_main = @_ ;
    my $MEMBER ; my $NN_GROUP=0 ;
    my $FL_INIT = "init" ;
    if ( @{$my_main{"SG_NMOL"}}[0] > @{$my_main{"SG_NGROUP"}}[0] )
    {
	my ( $IGR, $GROUP, $STRATEGY );
	for ( $IGR = 1; $IGR <= @{$my_main{"SG_NGROUP"}}[0] ; $IGR++ )
	{
	    $GROUP= join ( '', "SG_GROUP" , $IGR ) ;
	    $STRATEGY = join ( '', "SG_GROUP" , $IGR, "_STRATEGY" ) ;
	    if ( $my_main{$STRATEGY}[0] eq "COMPOSIT" ) 
	    { 
#	print " COMPOSIT groups: $IGR, <$GROUP> \n" ;
		
		my $LINE = join (" ", @{$my_main{$GROUP}} ) ;
		print $FH " key outgr  sele .n segm name $LINE end\n" ;
		foreach $MEMBER ( @{$my_main{$GROUP}} )
		{
#	print " groups: $IGR, <$GROUP> $MEMBER\n" ;
		    print $FH 
			" define $FL_INIT constr inter \\\n",
			"sele segm name $MEMBER end sele segm name $MEMBER .o outgr end \n" ;
		    $FL_INIT = "" ;
		}
	    }
	    else
	    { 
		my $LINE = join (" ", @{$my_main{$GROUP}} ) ;
		print $FH 
		    " define $FL_INIT constr inter \\\n",
		    "sele segm name $LINE end \\\n",
                    "sele segm name WORK_SEGM end \n" ;
		    $FL_INIT = "" ;
	    }
	}
    }
    print $FH " key outgr drop\n" ;


# composit group occupancies

    print $FH "\n! defining COMPOSIT GROUPS by AUTO method \n" ;

    my $STRATEGY ;
    my $NCS_START = "FALSE" ;
    for ( $IGR = 1; $IGR <= $my_main{"SG_NGROUP"}[0] ; $IGR++ )
    {
	$GROUP= join ( '', "SG_GROUP" , $IGR ) ;
	$STRATEGY = join ( '', "SG_GROUP" , $IGR, "_STRATEGY" ) ;
	if ( $my_main{$STRATEGY}[0] ne "COMPOSIT" ) { next ; }
#    print " groups: $IGR, <$GROUP> \n" ;
	if ( $NCS_START eq "FALSE" )
	{ 
	    print $FH " define constr occ init\n" ;
	    $NCS_START = "TRUE" ;
	}
	print $FH " define constr occ \(auto \\\n" ;
	my @lines = () ;
	my $MEMBER ; my $NC = 0; 
	foreach $MEMBER ( @{$my_main{$GROUP}} )
	{
	    $NC++ ;
#	print " member: $MEMBER> ", $NC, scalar(@{$my_main{$GROUP}}), "\n" ;
	    if ( $NC < @{$my_main{$GROUP}} )
	    {
		print $FH "     sele segm name $MEMBER end \\\n" ;
	    }
	    else
	    {
		print $FH "     sele segm name $MEMBER end \)\n\n" ;
	    }
	}
    }
    if ( -e "define_occup_manual.com" ) 
    {
	print $FH "<define_occup_manual.com\n\n" ;
    }

}

1;