# Program rules.tcl 

proc Tcl_rule {} {

###################################
# Procedure : Tcl_rule
# Arguments : 
#             irule - rule number
#             op - part of the used rule
#             sub_op - number of the model function
# Returns : 
#             OK , BAD
#            
####################################

   global irule op sub_op rule_trace
   global_name 
   global kp1 c_h2o c_h2
   global name date sconc kin_mode conversion_limit reaction_time 
   global minimal_concentration
   global phases_p_r phase_contacts phprop comp_edus in_phase phase
   global attrib_1 center_1 rule_1 
   global attrib_2 center_2 rule_2
   global attrib_3 center_3 rule_3
   global attrib_4 center_4 rule_4
   switch $irule { 

      # Regelkopf

      GLOBAL {
         switch $op {
         # Einstellungen der Reaktoren, Phasen, Kinetik
         INIT_RULES {
            set c_h2o 1.0
            set c_h2 1.0 
            set name ,nt_tria09.tcl"          
            putco name name
            set date 27.06.1997
            get temperature temp
            print ,temperature $temp"
            putco date date
            # reactors and phases
            set in_phase(0) 0
            set comp_edus(0) 1
            set phases_p_r {1,0}
            set phase_contacts(0) 0
            set phprop(0) ,$MONOMOLEC"
            putco phases_per_reactor phases_p_r
            putco phase_contacts phase_contacts
            putco phase_property phprop
            putco use_all_educts_together comp_edus
            putco input_phase_for_reactors in_phase
            set phase 1
            putco output_phase phase
            # kinetic 
            set sconc(0) 0.10
            set conversion_limit  0.0
            set reaction_time 10368.e3 
            set minimal_concentration 1.e-10
            set kin_mode(0) gear
            putco kinetic_model kin_mode
            putco conversion_limit conversion_limit 
            putco reaction_time reaction_time 
            putco minimal_concentration minimal_concentration 
            put start_conc sconc
            # give rule variables to kernel
            set kp1 0.0
            put reactivity kp1
            print ,test $test trace $trace"
            print ,INIT_RULES called"
            return OK
         }
         # Vorbehandlung der Ausgangsmaterialien
         PREP_ROOT {
            print ,PREP_ROOT called . ,
            return OK
         }
         # Vorbehandlung der Edukte
         PREP_EDUCT {
            print ,PREP_EDUCT called ."
            return OK
         }
         # Verteilungsfunktion
         DISTRIBFUNC {
                return OK
         }
         # Abschlußfunktion
         FINISH {
            return OK
         }
         default {
            return BAD
         }
      }
   }

   # Allgemein Hydrolyseregel

   RULE_1 {
      switch $op {
      # Definition des Namen, der Attribute und der RSS
      RULE_INFO {
         set rule_1 ,Allg. Hydrolyse"
         putco rule_name rule_1
         set attrib_1(0) NULL
         putco attributes attrib_1
         set center_1 {1,2,0,2,3,0,0}
         putco center_connectivity center_1
         set ff [net cpg init trained.knet test3-1+0.ctxeda]
         if {!$ff} {
            print ,Rule 1: error during the net initialization ,
         }
         return OK 
      }      
      # Überprüfung der Bedingungen für die RSS
      CONSTR {
         switch $sub_op {
         GLOBAL {
            return OK
         }
         # für das Eduktensemble
         0 {
            if {$trace>2} {
               print ,Rule 1: Checking total ensemble ,
               print ,trace=$trace"
            }
            set blt [prop E_N_ATOMS na]
            if {!$blt} {
               print ,error getting property E_N_ATOMS"
            }
            set blt [prop E_LAST_ATOM il]
            if {!$blt} {
               print ,error getting property E_LAST_ATOM ,
            }
            set sar 0
            for {set i 1} {$i<=$il} {incr i} {
               set blt [prop A_AROMATIC $i aromat]
               if {$blt} {
                  if {$aromat} {incr sar} 
               }
            } 
            set ar $sar
            if {$ar!=6&&$na>7} {return BAD}
            return OK
         }         
         # für das erste Atom in der RSS
         1 {
            if {$trace>2} {
               print ,Checking atom 1 rule 1 ,
            }
            set atom [center 1]
            set blt [prop A_ELEMENT $atom elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom"
            }
           if {$elem!=6&&$elem!=8&&$elem!=7&&$elem!=9&&$elem!=17&&$elem!=35&&$elem!=35&&$elem!=16} {return BAD}
           return OK
        }  
        # für das zweite Atom in der RSS
        2 {
           if {$trace>2} {
              print ,Checking atom 2 rule 1 ,
           }
           set atom [center 2]
           set blt [prop A_ELEMENT $atom elem]
           if {!$blt} {
              print ,error getting property A_ELEMENT $atom"
           }
           if {$elem!=6} {return BAD}
           return OK
        }
        3 {
           if {$trace>2} {
              print ,Checking atom 3 rule 1 ,
           }
           set atom1 [center 1]
           set atom2 [center 2]
           set atom3 [center 3]
           set blt [prop A_ELEMENT $atom1 elem1]
           if {!$blt} {
              print ,error getting property A_ELEMENT $atom1"
           }
           set blt [prop A_ELEMENT $atom2 elem2]
           if {!$blt} {
              print ,error getting property A_ELEMENT $atom2"
           }
           set blt [prop A_ELEMENT $atom3 elem3]
           if {!$blt} {
              print ,error getting property A_ELEMENT $atom1"
           }
           if {$elem3!=6&&$elem3!=8&&$elem3!=1&&$elem3!=16&&$elem3!=7} {return BAD}
           set blt [prop A_ENSIG $atom2 ensig2]
           if {!$blt} {
              print ,error getting property A_ENSIG $atom2"
           }
           set blt [prop A_NEIGHBORS $atom1 ng]
           if {!$blt} {
              print ,error getting property A_NEIGHBORS $atom1"
           }
           set ll [array size ng]
           set nhneigh1 0
           for {set i 0} {$i<$ll} {incr i} {
              set blt [prop A_ELEMENT $ng($i) j]
              if {!$blt} {
                 print ,error getting property A_ELEMENT $ng($i)"
              }
              if {$j!=1} {incr nhneigh1}
           } 
           set blt [prop B_BOORD $atom1 $atom2 bor1]
           if {!$blt} {
              print ,error getting property B_BOORD $atom1 $atom2"
           }
           set blt [prop B_BOORD $atom2 $atom3 bor2]
           if {!$blt} {
              print ,error getting property B_BOORD $atom2 $atom3"
           }
           set blt [prop A_AROMATIC $atom1 ar1]
           if {!$blt} {
              print ,error getting property A_AROMATIC $atom1"
           }
           set blt [prop A_AROMATIC $atom2 ar2]
           if {!$blt} {
              print ,error getting property A_AROMATIC $atom2"
           }
           if {$trace>3} {
              print ,Rule 1: e1=$elem1 e3=$elem3 ensig=$ensig2 bor1=$bor1 ar1=$ar1 ar2=$ar2 nhneigh1=$nhneigh1 ,
           }
           if {$elem1==7&&$elem3==6&&$ar2!=0} {return BAD}
           if {$elem1==8&&$bor1>1} {return BAD}
           if {$bor1==1&&$elem1==7&&$elem3==8&&$ensig2<10.1} {return BAD}
           if {$elem1==7&&$elem3==7&&$ar2!=0&&$nhneigh1>1} {return BAD}
           if {$elem1==6&&$elem2==6} {return BAD}
           if {$ar1!=0} {return BAD}
           if {$elem1==8&&$nhneigh1==1} {return BAD}
           if {$elem1==7&&$ar2==0&&$elem3!=8&&$elem3!=7} {return BAD}
           return OK
        }
        default {
           print ,illegal number of atoms"
           return BAD
        }  
        }
     }
     # Reaktionsfunktion mit Festlegung der reaktivität
     FUNC {
        # Eduktfunktion
        if {$trace>2} {
           print ,Rule 1: FUNC called ,
        }
        set atom1 [center 1]
        set atom2 [center 2]
        set atom3 [center 3]
        set ff [net cpg set educt]
        if {!$ff} {
           print ,Rule 1: net cpg set educt failed."
        }
        # Durchführung der Reaktion
        set h1 [new_atom 1 elsys]
        set h2 [new_atom 1 elsys]
        set o [new_atom 8 elsys]
        change_bond_order $atom2 $atom1 -1
        change_bond_order $h1 $o 1 
        change_bond_order $h2 $atom1 1
        change_bond_order $o $atom2 1
        # Produktfunktion
        set fff [net cpg set product]
        if {!$fff} {
           print ,net cpg set product failed."
        }
        if {$ff&&$fff} {
           set f1 [net cpg get R1]
           if {$f1} {
              set ar [array exist R1]
              if {$ar} {
                 set dim [array size R1]
                 for {set i 0} {$i<$dim} {incr i} {
                     print ,R1[$i]=$R1[$i]"
                 }
              } else {
                 print ,R1=$R1"
              }
           } else {
              print ,error getting the net result"
           }
        } else {
            print ,error setting the net values"
        }
        # Überprüfung, ob wirklich alles paßt
        set blt [prop A_ELEMENT $atom1 elem]
        if {!$blt} {
           print ,error getting property A_ELEMENT $atom1"
        }
        set blt [prop A_ELEMENT $atom3 elem3]
        if {!$blt} {
           print ,error getting property A_ELEMENT $atom3"
        }
        set blt [prop B_BOORD $atom1 $atom2 bor1]
        if {!$blt} {
           print ,error getting property B_BOORD $atom1 $atom2"
        }
        set blt [prop A_AROMATIC $atom2 ar2]
        if {!$blt} {
           print ,error getting property A_AROMATIC $atom2"
        }
        if {$elem==7&&$ar2==0&&$bor1==0&&$elem3!=8&&$elem3!=7} {return BAD}
        # konjugiere pi-Systeme
        set blt [prop A_ELECSYSS $atom2 esys2]
        if {!$blt} {
           print ,error getting property A_ELECSYSS $atom2"
        }
        set blt [prop A_ELECSYSS $o esyso]
        if {!$blt} {
           print ,error getting property A_ELECSYSS $o"
        }
        set picount1 0
        set dim [array size esys2]
        for {set i 0} {$i<$dim} {incr i} {
            set blt [prop EL_IS_SIGMA $esys2($i) is_sigma]
            if {!$blt} {
               print ,error getting property EL_IS_SIGMA $esys2($i)"
            }
            if {!$is_sigma} {
               set pis2 $esys2($i)
               incr picount1
            }
         }
         set picount2 0
         set dim [array size esyso]
         for {set i 0} {$i<$dim} {incr i} {
             set blt [prop EL_IS_SIGMA $esyso($i) is_sigma]
             if {!$blt} {
                print ,error getting property EL_IS_SIGMA $esyso($i)"
             }
             if {!$is_sigma} {
                set piso $esyso($i)
                incr picount2
             }
          }
          if {$picount1&&$picount2} {
             set blt [combine_elsys $pis2 $piso es_pi]
             if {!$blt} {
                print ,combine_elsys $pis2 $piso"
             }
             print ,combine c-o"
          }
          # the end
          set kp1 [expr 5.e-9*$c_h2o]
          set symmetry_factor [expr $symmetry_factor*2]
          if {$trace>2} {
             print ,symmetry_factor=$symmetry_factor"
          }
          return OK  
       } 
       default {
          return BAD
       }
       } 
   }  

   # Reaktionstyp der reduktiven Dealkylierung

   RULE_2 {
      switch $op {
      # Name, Attribute, RSS
      RULE_INFO {
         set rule_2 ,Reduktive Dealkylierung"
         putco rule_name rule_2
         set attrib_2(0) NULL
         putco attributes attrib_2
         set center_2 {1,2,0,0}
         putco center_connectivity center_2
         return OK
      }      
      # Bedingungen der RSS
      CONSTR {
         switch $sub_op {
         GLOBAL {
             return OK
         }
         0 {
            if {$trace>2} {
               print ,Checking total ensembles rule 2 ,
            }
            set blt [prop E_LAST_ATOM il]
            if {!$blt} {
               print ,error getting property E_LAST_ATOM ,
            }
            set sar 0
            for {set i 1} {$i<=$il} {incr i} {
               set blt [prop A_AROMATIC $i aromat]
               if {$blt} {
                  if {$aromat} {incr sar} 
               }
            } 
            set ar $sar
            if {$ar!=6} {return BAD}
            return OK
         }
         1 {
            if {$trace>2} {
               print ,Checking atom 1 rule 2"
            }
            set atom [center 1]
            set blt [prop A_ELEMENT $atom elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom"
            }
            if {$elem!=7} {return BAD}
            set blt [prop A_AROMATIC $atom ar]
            if {!$blt} {
               print ,error getting property A_AROMATIC $atom"
            }
            if {$ar!=0} {return BAD}
            return OK
         }  
         2 {
            if {$trace>2} {
               print ,Checking atom 2 rule 2"
            }
            set atom [center 2]
            set blt [prop A_ELEMENT $atom elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom"
            }
            if {$elem!=6} {return BAD}
            set blt [prop A_AROMATIC $atom ar]
            if {!$blt} {
               print ,error getting property A_AROMATIC $atom"
            }
            if {$ar!=0} {return BAD}
            return OK
         }
         default { 
            print ,illegal number of atoms"
         }  
         }
      }
      # Reaktionsfunktion
      FUNC {
         # Eduktfunktion
         if {$trace>2} {
            print ,FUNC called Rule 2"
         }
         # Durchführung der Reaktion
         set atom1 [center 1]
         set atom2 [center 2]
         set h1 [new_atom 1 elsys]
         set h2 [new_atom 1 elsys]
         change_bond_order $atom2 $atom1 -1
         change_bond_order $h1 $atom1 1
         change_bond_order $h2 $atom2 1
         # Produktfunktion
         set blt [prop A_NEIGHBORS $atom2 ng]
         if {!$blt} {
            print ,error getting property A_AROMATIC $atom"
         }
         set ll [array size ng]
         set nhneigh 0
         for {set i 0} {$i<$ll} {incr i} {
             set blt [prop A_ELEMENT $ng($i) j]
             if {!$blt} {
                print ,error getting property A_AROMATIC $atom"
             }
             if {$j!=1} {incr nhneigh}
          }
          set kp1 [expr $c_h2*4.42e-8*3./(2.+$nhneigh)]
          set symmetry_factor [expr $symmetry_factor*2]
          if {$trace>2} {
             print ,symmetry_factor=$symmetry_factor kp1=$kp1"
          }
          return OK  
       } 
       default {
          return BAD
       }
       }
    }

    # kombinierte Hydrolyse/Debarboxylierung für die Abbauprodukte der Cyanursäure

    RULE_4 {
       switch $op {
       # Name, Attribute, RSS
       RULE_INFO {
          set rule_4 ,Decarboxylierung"
          putco rule_name rule_4
          set attrib_4(0) NULL
          putco attributes attrib_4
          set center_4 {1,2,0,2,3,0,3,4,0,4,5,0,5,6,0,4,7,0,0}
          putco center_connectivity center_4
          return OK 
       }      
       # Bedingungen der RSS
       CONSTR {
          switch $sub_op {
          GLOBAL {
             return OK
          }
          0 {
             return OK
          }         
          1 {
             if {$trace>2} {
                print ,Checking atom 1 rule 4 ,
             }
             set atom [center 1]
             set blt [prop A_ELEMENT $atom elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom"
             }
             if {$elem!=7} {return BAD}
             return OK
          }  
          2 {
             if {$trace>2} {
                print ,Checking atom 2 rule 4 ,
             }
             set atom [center 2]
             set blt [prop A_ELEMENT $atom elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom"
             }
             if {$elem!=6} {return BAD}
             return OK
          }
          3 {
             if {$trace>2} {
                print ,Checking atom 3 rule 4 ,
             }
             set atom3 [center 3]
             set atom2 [center 2]
             set blt [prop A_ELEMENT $atom3 elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom3"
             }
             if {$elem!=7} {return BAD}
             set blt [prop B_BOORD $atom2 $atom3 bor2]
             if {!$blt} {
                print ,error getting property B_BOORD $atom2 $atom3"
                return BAD
             }
             if {$bor2<2} {return BAD}
             return OK
          }
          4 {
             if {$trace>2} {
                print ,Checking atom 4 rule 4 ,
             }
             set atom4 [center 4]
             set blt [prop A_ELEMENT $atom4 elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom4"
             }
             if {$elem!=6} {return BAD}
             return OK
          }
          5 {
             if {$trace>2} {
                print ,Checking atom 5 rule 4 ,
             }
             set atom5 [center 5]
             set blt [prop A_ELEMENT $atom5 elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom5"
             }
             if {$elem!=8} {return BAD}
             return OK
          }
          6 {
             if {$trace>2} {
                print ,Checking atom 6 rule 4 ,
             }
             set atom6 [center 6]
             set blt [prop A_ELEMENT $atom6 elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom6"
             }
             if {$elem!=1} {return BAD}
             return OK
          }
          7 {
             if {$trace>2} {
                print ,Checking atom 7 rule 4 ,
             }
             set atom4 [center 4]
             set atom7 [center 7]
             set blt [prop A_ELEMENT $atom7 elem]
             if {!$blt} {
                print ,error getting property A_ELEMENT $atom7"
             }
             if {$elem!=8} {return BAD}
             set blt [prop B_BOORD $atom4 $atom7 bor]
             if {!$blt} {
                print ,error getting property B_BOORD $atom4 $atom7"
                return BAD
             }
             if {$bor<2} {return BAD}
             return OK
          }
          default {
             print ,illegal number of atoms"
             return BAD
          }  
          }
      }
      # Reaktionsfunktion
      FUNC {
         # Eduktfunktion
         if {$trace>2} {
           print ,FUNC called Rule 4"
         }
         set c1 [center 1]
         set c2 [center 2]
         set c3 [center 3]
         set c4 [center 4]
         set c5 [center 5]
         set c6 [center 6]
         set c7 [center 7]
         # Durchführung der Reaktion
         set h1 [new_atom 1 elsys]
         set h2 [new_atom 1 elsys]
         set o [new_atom 8 elsys]
         change_bond_order $c5 $c6 -1 
         change_bond_order $c2 $c3 -2
         change_bond_order $c3 $c4 -1
         change_bond_order $c2 $o 2
         change_bond_order $c3 $h1 1
         change_bond_order $c3 $h2 1
         change_bond_order $c3 $c6 1
         change_bond_order $c4 $c5 1
         # Produktfunktion
         set kp1 [expr 1.e-5*$c_h2o]
         if {$trace>2} {
            print ,symmetry_factor=$symmetry_factor kp1=$kp1"
         }
         return OK  
      } 
      default {
         return BAD
      }
      } 
   }

   # Hydrolyse von Cyanursäure
  
   RULE_3 {
      switch $op {
      # Name, Attribute, RSS
      RULE_INFO {
         set rule_3 ,Hydrolyse von Cyanursaeure"
         putco rule_name rule_3
         set attrib_3(0) NULL
         putco attributes attrib_3
         set center_3 {1,2,0,2,3,0,3,4,0,0}
         putco center_connectivity center_3
         return OK 
      }      
      # Bedingungen der RSS
      CONSTR {
         switch $sub_op {
         GLOBAL {
            return OK
         }
         0 {
            if {$trace>2} {
               print ,Checking total ensemble rule 3"
            }
            # funktion ens_aromat
            set blt [prop E_LAST_ATOM il]
            if {!$blt} {
               print ,error getting property E_LAST_ATOM ,
            }
            set sar 0
            for {set i 1} {$i<=$il} {incr i} {
               set blt [prop A_AROMATIC $i aromat]
               if {$blt} {
                  if {$aromat} {incr sar} 
               }
            } 
            set ar $sar
            if {$ar!=6} {return BAD}
            return OK
         }         
         1 {
            if {$trace>2} {
               print ,Checking atom 1 rule 3 ,
            }
            set atom [center 1]
            set blt [prop A_ELEMENT $atom elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom"
            }
            if {$elem!=7} {return BAD}
            return OK
         }  
         2 {
            if {$trace>2} {
               print ,Checking atom 2 rule 3 ,
            }
            set atom2 [center 2]
            set atom1 [center 1]
            set blt [prop A_ELEMENT $atom2 elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom"
            }
            if {$elem!=6} {return BAD}
            set blt [prop B_BOORD $atom1 $atom2 bor1]
            if {!$blt} {
               print ,error getting property B_BOORD $atom1 $atom2"
            }
            set blt [prop A_ENSIG $atom2 esig]
            if {!$blt} {
               print ,error getting property A_ENSIG $atom2"
            }
            set blt [prop A_POLARIZ $atom2 apol]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom2"
            }
            # if {$bor1<2} {return BAD}
            if {$esig<11.44||$esig>11.46} {return BAD}
            if {$apol<5.9||$apol>6.1} {return BAD}
            return OK
         }
         3 {
            if {$trace>2} {
               print ,Checking atom 3 rule 3 ,
            }
            set atom3 [center 3]
            set blt [prop A_ELEMENT $atom3 elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom3"
            }
            if {$elem!=8} {return BAD}
            return OK
         }
         4 {
            if {$trace>2} {
               print ,Checking atom 4 rule 3 ,
            }
            set atom4 [center 4]
            set blt [prop A_ELEMENT $atom4 elem]
            if {!$blt} {
               print ,error getting property A_ELEMENT $atom3"
            }
            if {$elem!=1} {return BAD}
            return O
         }
         default {
            print ,illegal number of atoms"
            return BAD
         }  
         }
      }
      # Reaktionsfunktion
      FUNC {
         # Eduktfunktion
         if {$trace>2} {
            print ,FUNC called rule 3 ,
         }
         set atom1 [center 1]
         set atom2 [center 2]
         set atom3 [center 3]
         set atom4 [center 4]
         # Durchführung der Reaktion
         set h1 [new_atom 1 elsys]
         set h2 [new_atom 1 elsys]
         set o [new_atom 8 elsys]
         change_bond_order $h1 $o 1
         change_bond_order $atom1 $atom2 -2 
         change_bond_order $atom3 $atom4 -1
         change_bond_order $h2 $atom1 1
         change_bond_order $atom1 $atom4 1
         change_bond_order $o $atom2 1
         change_bond_order $atom2 $atom3 1
         # Produktfunktion
         set kp1 [expr 1.e-6*$c_h2o]
         if {$trace>2} {
            print ,symmetry_factor=$symmetry_factor kp1=$kp1"
         }
         return OK  
      } 
      default {
         return BAD
      }
      } 
   } 


 
   # end of the rules
   default {
      print ,illegal rule number"
      return BAD
   }                             
   }
}
                                                    

# Eine zweite Regelfuntkion

proc Test_rule {} {
   global_name
   print ,hier koennten weitere Regeln stehen"
   return BAD
}