simopt: simultaneous optimization of rational functions in FORM

simopt.frm

#-
Off stats;

CF pow,log;
CF pow1,log1;
S x,n
S uuu;
Auto S ttt;

#procedure simopt(F,t1,t2,type,file)
  #define H "`F'simopt"
  #define u "uuu"
  #define t "ttt"
  #define tmp "`file'.tmp"
  .sort:simopt-begin;
  ExtraSymbols,array,`t1';
  CF `t2';
  G `H' = 0;
  id pow(x?!{0,},0) = 1;
  .sort:simopt-setup;
  #$n = 0;
  #do loop=1,1
    #$found = 0;
    Skip;
    NSkip `F';
    if ($found == 0);
      if (match(pow(x?$x,n?)));
        $found = 1;
        $n = $n + 1;
      elseif (match(log(x?$x)));
        $found = 1;
        $n = $n + 1;
      endif;
    endif;
    if ($found);
      id pow($x,n?) = pow1(`t'{`$n'+1},n);
      id log($x) = log1(`t'{`$n'+1});
    endif;
    ModuleOption noparallel;
    .sort:simopt-find-{`$n'+1};
    #if `$found'
      Skip;
      Drop `H';
      G `H' = `H' + `u'^`$n' * $x;
      ModuleOption noparallel;
      .sort:simopt-replace-`$n';
      #redefine loop "0"
    #endif
  #enddo
  Skip;
  NSkip `F',`H';
  id pow1(?a) = pow(?a);
  id log1(?a) = log(?a);
  B `u';
  .sort:simopt-conv;
  #optimize `H'
  #$m = `optimmaxvar_';
  Skip;
  NSkip `H';
  B `u';
  .sort:simopt-opt;
  Skip;
  NSkip `F';
  #do i=1,`$n'
    multiply replace_(`t'`i',`t2'(`i'));
  #enddo
  id pow(x?,n?pos_) = x^n;
  id pow(x?,n?neg_) = (1/x)^(-n);
  .sort:simopt-subs;
  #write <`tmp'> "%5O"
  #do i=1,`$n'
    #$u = `H'[`u'^`i'];
    #write <`tmp'> "      `t2'(`i')=%$", $u
  #enddo
  #optimize F
  #$m = max_($m,`optimmaxvar_');
  #write <`tmp'> "%5O"
  #write <`file'> "      `type' `t1'(`$m')"
  #write <`file'> "      `type' `t2'(`$n')"
  #write <`file'> "%f%", `tmp'
  #write <`file'> "      `F'=%E",`F'(`F')
  #remove <`tmp'>
  Drop `H';
  .sort:simopt-end;
#endprocedure

S x1,...,x9;

L F =
  + pow((x1+...+x9/2)^4,-4) * log((x1+...+x9)^4)^2
  + pow((x1+...+x9)^4,-5) * log((x1+...+x9)^4)^3
;
.sort

Format DoubleFortran;
Format nospaces;
Format O2,stats=on;
#call simopt(F,z1,z2,double precision,)

.end