Merge pull request #8 from TimBellerby/pm0_4

Fixes to nhd statement

Author: TimBellerby

examples/jacobi.pmm

@@ -0,0 +1,21 @@
+/*
+An example of the use of the nhd statement to implement a stencil
+Solution of 2D heat equation by Jacobi iteration
+One boundary set to 1.0 - rest to 0.0
+*/
+tol=0.01
+for cell_pos in [1..10,1..10] {
+   chan var cell=0.0
+   over [0,]:cell=1.0
+   print(cell_pos++cell)
+   until invar err<tol {
+      old_cell=cell
+      nhd ortho[-1..1,-1..1] dcell of cell bounds EXCLUDED {
+             cell=(dcell[-1,0]+dcell[1,0]+dcell[0,-1]+dcell[0,1])/4.0
+      }
+      chan cell_err=abs(cell-old_cell)
+      err=reduce%($max,cell_err,0.0)
+      if cell_pos==[1,1]:print("err="++err)
+   }
+   print(cell_pos++"="++cell)
+}

examples/jacobi_cyclic_bounds.pmm

@@ -0,0 +1,22 @@
+/*
+An example of the use of the nhd statement to implement a stencil
+Solution of 2D heat equation by Jacobi iteration on a cylinder
+One boundary set to 1.0 with the opposite set to 0.0
+Boundaries along the other dimension are cyclic
+*/
+tol=0.01
+for cell_pos in [1..10,1..10] {
+   chan var cell=0.0
+   over [0,]:cell=1.0
+   print(cell_pos++cell)
+   until invar err<tol {
+      old_cell=cell
+      nhd ortho[-1..1,-1..1] dcell of cell bounds [EXCLUDED,CYCLE] {
+             cell=(dcell[-1,0]+dcell[1,0]+dcell[0,-1]+dcell[0,1])/4.0
+      }
+      chan cell_err=abs(cell-old_cell)
+      err=reduce%($max,cell_err,0.0)
+      if cell_pos==[1,1]:print("err="++err)
+   }
+   print(cell_pos++"="++cell)
+}

src/cfortran.f90

@@ -4977,9 +4977,18 @@ subroutine out_simple_scalar(g,str,l,n,x)
     character(len=*),intent(in):: str
     integer,intent(in):: l
     integer,intent(in),optional:: n,x
-    integer:: arg1
+    integer:: arg1,ve
+    ve=g%codes(l+comp_op_arg0)
     arg1=g%codes(l+comp_op_arg0+1)
-    if(.not.g_is_shared(g,arg1)) call gen_loop(g,l,.false.)
+    if(.not.g_is_shared(g,arg1)) then
+       call gen_loop(g,l,.false.)
+    else
+       ! Close and re-open if statements
+       if(g%last_ve/=ve) then
+          call gen_if_nest(g,g%last_ve,ve)
+          g%last_ve=ve
+       endif
+    endif
     if(g_kind(g,arg1)/=v_is_ctime_const) then
        call out_simple(g,str,l,n,x)
     endif