# MIF 2.1
# MIF Test File: tclshapes.mif
# Description: Example illustrating use of Tcl script to
#              define geometric shapes.

set pi [expr {4*atan(1.0)}]
set mu0 [expr {4*$pi*1e-7}]

Parameter seed 1   ;# Set to an empty string to draw seed from system clock
RandomSeed $seed

Parameter shape ellipsoid ;# One of ellipsoid, ellipse, ramp, rectangle, random

switch -exact [string tolower $shape] {
   ellipsoid { set shapeproc Ellipsoid }
   ellipse   { set shapeproc Ellipse }
   ramp      { set shapeproc Ramp }
   rectangle { set shapeproc Rectangle }
   random    { set shapeproc RandomShape }
   default {
      error "Invalid shape \"$shape\"; should be one of\
            ellipsoid, ellipse, ramp, rectangle or random"
   }
}


Parameter xcount 64
Parameter ycount 31
Parameter zcount 30

set xcellsize 3e-9
set ycellsize 4e-9
set zcellsize 5e-9

# Shape procs
proc Ellipsoid { x y z } {
   set x [expr {2.*$x-1.}]
   set y [expr {2.*$y-1.}]
   set z [expr {2.*$z-1.}]
   if {$x*$x+$y*$y+$z*$z>=1} {
      return 1
   }
   if {$x>0.0} {
      return 2
   }
   return 3
}

proc Ellipse { x y z } {
   set x [expr {2.*$x-1.}]
   set y [expr {2.*$y-1.}]
   if {$x*$x+$y*$y>=1} {
      return 1
   }
   if {$x>0.0} {
      return 2
   }
   return 3
}

proc Ramp { x y z } {
   if { $z > $x } {
      return 1
   }
   if {$x>0.5} {
      return 2
   }
   return 3
}

proc Rectangle { x y z } {
   if {$x>0.5} {
      return 2
   }
   return 3
}

# NOTE: The RandomShape proc below is used by the Oxs_ScriptAtlas
#       to provide shape information for setting both exchange
#       coefficient A and saturation magnetization Ms.  We want
#       the shape to be the same for both, so we need to cache
#       return values from RandomShape so that each call on a
#       given point returns the same result.
global shapecache
catch {unset shapecache} ;# Insure first pass starts with a blank slate
proc RandomShape { x y z } {
   # Check to see if point (x,y,z) has been already assigned
   global xcellsize ycellsize zcellsize shapecache
   set ix [expr {int(floor($x/$xcellsize))}]
   set iy [expr {int(floor($y/$ycellsize))}]
   set iz [expr {int(floor($z/$zcellsize))}]
   set key "$ix,$iy,$iz"
   if {[info exists shapecache($key)]} {
      return $shapecache($key)
   }

   # Otherwise, new point
   set scale [expr {rand()}]
   if {$scale<0.25} {
      return [set shapecache($key) 1]
   }
   if {$scale<0.75} {
      return [set shapecache($key) 2]
   }
   return [set shapecache($key) 3]
}

Specify Oxs_ScriptAtlas:atlas [subst {
   xrange {0 [expr {$xcount*$xcellsize}]}
   yrange {0 [expr {$ycount*$ycellsize}]}
   zrange {0 [expr {$zcount*$zcellsize}]}
   regions {nonmagnetic magneticA magneticB }
   script $shapeproc
}]

Specify Oxs_RectangularMesh:mesh [subst {
   cellsize {$xcellsize $ycellsize $zcellsize}
   atlas :atlas
}]

set Ms 800e3
Specify Oxs_Exchange6Ngbr {
   default_A 0.0
   atlas :atlas
   A {
      magneticA magneticA 13e-12
      magneticA magneticB  2e-12
      magneticB magneticB  8e-12
   }
}

Specify Oxs_Demag {}

Specify Oxs_CGEvolve:evolve {}


proc Texture {} {
   set weight 0.25
   set tx [expr {2*rand()-1.0}]
   set ty [expr {2*rand()-1.0}]
   set tz [expr {2*rand()-1.0}]
   set x [expr {3*(1.0 + $weight*$tx)}]
   set y [expr {2*(1.0 + $weight*$ty)}]
   set z [expr {1.0 + $weight*$tz}]
   return [list $x $y $z]
}

Specify Oxs_MinDriver [subst {
 evolver :evolve
 stopping_mxHxm 0.1
 mesh :mesh
 Ms { Oxs_AtlasScalarField {
    atlas :atlas
    default_value 0.0
    values {
       magneticA $Ms
       magneticB [expr {0.5*$Ms}]
       nonmagnetic 0.0
    }
 }}
 m0 { Oxs_ScriptVectorField {
    script Texture
    script_args {}
    atlas :atlas
    norm 1.0
 }}
}]
