Added this very peculiar set of testing routines--
authorOrion Lawlor <olawlor@acm.org>
Tue, 2 Sep 2003 22:39:12 +0000 (22:39 +0000)
committerOrion Lawlor <olawlor@acm.org>
Tue, 2 Sep 2003 22:39:12 +0000 (22:39 +0000)
the ".tst" files are written in a bizarre dialect
that can be preprocessed into either C++ (using the
c_tst.h header) or f90 (using the f90_tst.h header).

The advantage to doing this is that we can write only
one set of testing code, and it automatically works for
C as well as F90, and is guaranteed to work the same way.
This should help prevent the common occurrence where one
or the other language binding is broken.

13 files changed:
tests/fem/megafem/Makefile [new file with mode: 0644]
tests/fem/megafem/c_tst.h [new file with mode: 0644]
tests/fem/megafem/ctests.C [new file with mode: 0644]
tests/fem/megafem/ctests.h [new file with mode: 0644]
tests/fem/megafem/f90_tst.h [new file with mode: 0644]
tests/fem/megafem/ftestMod.F90 [new file with mode: 0644]
tests/fem/megafem/ftests.F90 [new file with mode: 0644]
tests/fem/megafem/ftests_fallback.C [new file with mode: 0644]
tests/fem/megafem/pgm.C [new file with mode: 0644]
tests/fem/megafem/test.tst [new file with mode: 0644]
tests/fem/megafem/test_assert.tst [new file with mode: 0644]
tests/fem/megafem/test_globals.tst [new file with mode: 0644]
tests/fem/megafem/test_idxl_get.tst [new file with mode: 0644]

diff --git a/tests/fem/megafem/Makefile b/tests/fem/megafem/Makefile
new file mode 100644 (file)
index 0000000..46cfecb
--- /dev/null
@@ -0,0 +1,44 @@
+CHARMC=../../../../bin/charmc $(OPTS) 
+OBJS=pgm.o ctests.o 
+FOBJS=$(OBJS) ftests.o
+COBJS=$(OBJS) ftests_fallback.o
+
+all: pgm 
+
+pgm: $(COBJS)
+       $(CHARMC) -o pgm $(COBJS) -language ampi -module fem
+
+fpgm: $(FOBJS)
+       $(CHARMC) -o pgm $(FOBJS) -language ampif -module fem
+
+pgm.o: pgm.C
+       $(CHARMC) -c pgm.C
+
+ctests.o: ctests.C *.tst
+       $(CHARMC) -c ctests.C
+
+ftests.o: ftests.F90 *.tst
+       $(CHARMC) -c ftests.F90 -o $@
+
+ftests_fallback.o: ftests_fallback.C
+       $(CHARMC) -c ftests_fallback.C -o $@
+
+clean:
+       rm -f pgm fpgm *.o *.MOD *.mod charmrun
+
+test: pgm
+       ./charmrun ./pgm +p1 +vp1
+       ./charmrun ./pgm +p1 +vp2
+       ./charmrun ./pgm +p2 +vp1
+       ./charmrun ./pgm +p2 +vp2
+       ./charmrun ./pgm +p2 +vp3
+       ./charmrun ./pgm +p2 +vp4
+       -@rm -f fem_mesh_vp3_*
+       ./charmrun ./pgm +vp3 -write
+       ./charmrun ./pgm +vp3 -read
+       rm -f fem_mesh_vp3_*
+
+test-mig:
+       rm -fr pgm pgm.o
+       make OPTS="-DENABLE_MIG=1 -memory isomalloc -balancer RandCentLB" pgm
+       ./charmrun ./pgm +p2
diff --git a/tests/fem/megafem/c_tst.h b/tests/fem/megafem/c_tst.h
new file mode 100644 (file)
index 0000000..c8e6602
--- /dev/null
@@ -0,0 +1,95 @@
+/* Bizarre header to create ".tst" source code that
+   can be compiled as either Fortran *or* C++.
+   Include this header to preprocess the code into C++.
+   
+   Orion Sky Lawlor, olawlor@acm.org, 2003/7/22
+*/
+#define TST_C 1 /* This is a C test */
+#define IDXBASE 0 /* C arrays start at zero */
+
+#define C(x) /* Comment field: empty, preprocessed away */
+#define CALL /* empty, C doesn't have a CALL keyword. */
+
+#define INTEGER int
+#define SINGLE float
+#define DOUBLE double
+#define PRECISION /* empty, use like DOUBLE PRECISION x */
+#define STRING const char *
+
+#define CREATE_TYPE(typeName) class typeName { public:
+#define END_TYPE };
+#define TYPE_POINTER(typeName) typeName &
+#define TYPE(typeName) typeName
+
+/* A zero-based array that can be indexed using Fortran-
+   style round braces, like arr(i). */
+template <class T>
+class F90styleArray {
+       CkVec<T> sto;
+public:
+       void resize(int sz) {sto.resize(sz);}
+       T &operator()(int i) {
+               if (i<0 || i>=sto.size()) CkAbort("F90style array out-of-bounds!");
+               return sto[i];
+       }
+       operator T *() {return &sto[0];}
+};
+#define DECLARE_ARRAY(type,var) F90styleArray<type> var
+#define ALLOCATE_ARRAY(var,size) var.resize(size)
+#define DEALLOCATE(var) /* empty, destructor does work */
+
+/* A zero-based array that can be indexed using Fortran-
+   style 2D round braces, like arr(i,j). Stored in row-major
+   order, with arr(i,j) and arr(i+1,j) contiguous. */
+template <class T,int n>
+class F90styleArray2D {
+       F90styleArray<T> sto;
+public:
+       void resize(int sz) { sto.resize(n*sz);}
+       T &operator()(int i,int j) {
+               if (i<0 || i>=n) CkAbort("F90style2d array out-of-bounds!\n");
+               return sto[i+j*n];
+       }
+       operator T *() {return sto;}
+};
+#define DECLARE_ARRAY2D(type,var,nearSize) F90styleArray2D<type,nearSize> var
+#define ALLOCATE_ARRAY2D(var,nearSize,size) var.resize(size)
+
+
+/* Declare subroutines with various numbers of arguments */
+#define SUBROUTINE0(name) \
+void name() {
+
+#define SUBROUTINE1(name, t1,a1) \
+void name(t1 a1) {
+
+#define SUBROUTINE2(name, t1,a1, t2,a2) \
+void name(t1 a1, t2 a2) {
+
+#define SUBROUTINE3(name, t1,a1, t2,a2, t3,a3) \
+void name(t1 a1, t2 a2, t3 a3) {
+
+#define SUBROUTINE4(name, t1,a1, t2,a2, t3,a3, t4,a4) \
+void name(t1 a1, t2 a2, t3 a3, t4 a4) {
+
+#define SUBROUTINE5(name, t1,a1, t2,a2, t3,a3, t4,a4, t5,a5) \
+void name(t1 a1, t2 a2, t3 a3, t4 a4, t5 a5) {
+
+#define END } /* close subroutine */
+
+/* Loop the value of variable from 0..upper-1 */
+#define FOR(variable,upper) \
+       for (variable=0;variable<upper;variable++) {
+#define END_FOR }
+
+#define IF if
+#define THEN {
+#define ELSE } else {
+#define END_IF }
+
+#define _AND_ &&
+#define _OR_ ||
+#define _NE_ !=
+#define ADDR & /* Address-of operation */
+#define v . /* Extract-member-of-structure operation */
+
diff --git a/tests/fem/megafem/ctests.C b/tests/fem/megafem/ctests.C
new file mode 100644 (file)
index 0000000..c226024
--- /dev/null
@@ -0,0 +1,11 @@
+/* Compiles all the .tst files as C++ */
+#include "mpi.h"
+#include "fem.h"
+#include "charm++.h"
+#include "ctests.h"
+
+#include "c_tst.h"
+#include "test_globals.tst"
+
+#include "test.tst"
+
diff --git a/tests/fem/megafem/ctests.h b/tests/fem/megafem/ctests.h
new file mode 100644 (file)
index 0000000..628c61c
--- /dev/null
@@ -0,0 +1,11 @@
+/*
+FEM Test routines: external interface
+*/
+#include "charm-api.h"
+
+CDECL void RUN_Test(void);
+FDECL void FTN_NAME(RUN_TEST,run_test)(void);
+
+CDECL void RUN_Abort(int v);
+FDECL void FTN_NAME(RUN_ABORT,run_abort)(int *v);
+
diff --git a/tests/fem/megafem/f90_tst.h b/tests/fem/megafem/f90_tst.h
new file mode 100644 (file)
index 0000000..823a5af
--- /dev/null
@@ -0,0 +1,66 @@
+#define C(x)
+C ( Bizarre header to create ".tst" source code that )
+C ( can be compiled as either Fortran *or* C. )
+C ( Include this header to preprocess the code into F90. )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/22 )
+#define TST_F90 1  C( We are building for fortran)
+#define IDXBASE 1  C(Fortran arrays start at 1)
+
+#define STRING CHARACTER(LEN=*) 
+
+#define CREATE_TYPE(typeName) TYPE typeName 
+#define TYPE_POINTER(typeName) TYPE(typeName)
+C ( TYPE(name) is unmodified )
+#define END_TYPE END TYPE
+
+#define DECLARE_ARRAY(type,var) type, POINTER :: var(:)
+#define ALLOCATE_ARRAY(var,size) ALLOCATE(var(size))
+
+#define DECLARE_ARRAY2D(type,var,nearSize) type, POINTER :: var(:,:)
+#define ALLOCATE_ARRAY2D(var,nearSize,size) ALLOCATE(var(nearSize,size))
+
+C ( Declare subroutines with various numbers of arguments )
+#define SUBROUTINE0(name) \
+SUBROUTINE name;\
+   TST_F90_USE; IMPLICIT NONE;
+
+#define SUBROUTINE1(name, t1,a1) \
+SUBROUTINE name(a1);\
+   TST_F90_USE;\
+   IMPLICIT NONE;\
+   t1 a1;
+
+#define SUBROUTINE2(name, t1,a1, t2,a2) \
+SUBROUTINE name(a1,a2); \
+   TST_F90_USE; IMPLICIT NONE; \
+   t1 a1; t2 a2;
+
+#define SUBROUTINE3(name, t1,a1, t2,a2, t3,a3) \
+SUBROUTINE name(a1,a2,a3); \
+   TST_F90_USE; IMPLICIT NONE; \
+   t1 a1; t2 a2; t3 a3;
+
+#define SUBROUTINE4(name, t1,a1, t2,a2, t3,a3, t4,a4) \
+SUBROUTINE name(a1,a2,a3,a4); \
+   TST_F90_USE; IMPLICIT NONE; \
+   t1 a1; t2 a2; t3 a3; t4 a4;
+
+#define SUBROUTINE5(name, t1,a1, t2,a2, t3,a3, t4,a4, t5,a5) \
+SUBROUTINE name(a1,a2,a3,a4,a5); \
+   TST_F90_USE; IMPLICIT NONE; \
+   t1 a1; t2 a2; t3 a3; t4 a4; t5 a5;
+
+
+C ( Loop the value of variable from 1..upper )
+#define FOR(variable,upper) \
+    DO variable=1,upper
+#define END_FOR END DO
+
+C ( "IF (condition) THEN" is unmodified )
+#define END_IF END IF
+
+#define _AND_ .AND.
+#define _OR_ .OR.
+#define _NE_ .NE.
+#define ADDR 
+#define v %
diff --git a/tests/fem/megafem/ftestMod.F90 b/tests/fem/megafem/ftestMod.F90
new file mode 100644 (file)
index 0000000..774fa87
--- /dev/null
@@ -0,0 +1,7 @@
+MODULE ftestMod
+  include 'mpif.h'
+  include 'femf.h'
+#include "f90_tst.h"
+#include "test_globals.tst"
+END MODULE
+
diff --git a/tests/fem/megafem/ftests.F90 b/tests/fem/megafem/ftests.F90
new file mode 100644 (file)
index 0000000..6c5ff28
--- /dev/null
@@ -0,0 +1,7 @@
+#include "ftestMod.F90"
+
+#define TST_F90_USE USE ftestMod
+
+#include "f90_tst.h"
+
+#include "test.tst"
diff --git a/tests/fem/megafem/ftests_fallback.C b/tests/fem/megafem/ftests_fallback.C
new file mode 100644 (file)
index 0000000..567cd56
--- /dev/null
@@ -0,0 +1,11 @@
+/**
+ Fallback implementation of ftests.F90,
+ used when no F90 compiler is available.
+*/
+#include "charm++.h" /* for CkPrintf */
+#include "charm-api.h" /* for FTN_NAME */
+
+FDECL void FTN_NAME(RUN_TEST,run_test)(void) {
+       CkPrintf("   ftests_fallback.C: no fortran compiler\n");
+}
+
diff --git a/tests/fem/megafem/pgm.C b/tests/fem/megafem/pgm.C
new file mode 100644 (file)
index 0000000..0a3b341
--- /dev/null
@@ -0,0 +1,29 @@
+/*
+Tester for FEM framework C/F90 routines. 
+*/
+#include "mpi.h"
+#include "fem.h"
+#include "tcharm.h"
+#include "ctests.h"
+
+CDECL void RUN_Abort(int v) {
+       CkError("FEM Test failed: %d\n",v);
+       CkAbort("FEM Test failed.\n");
+}
+FDECL void FTN_NAME(RUN_ABORT,run_abort)(int *v) {
+       RUN_Abort(*v);
+}
+
+int main(int argc,char **argv) {
+       MPI_Init(&argc,&argv);
+       FEM_Init(MPI_COMM_WORLD);
+       
+       CkPrintf("---- Running C++ FEM tests... -----\n");
+       RUN_Test();
+       
+       CkPrintf("---- Running F90 FEM tests... -----\n");
+       FTN_NAME(RUN_TEST,run_test)();
+       
+       return 0;
+}
+
diff --git a/tests/fem/megafem/test.tst b/tests/fem/megafem/test.tst
new file mode 100644 (file)
index 0000000..ec55774
--- /dev/null
@@ -0,0 +1,173 @@
+C ( C/Fortran test driver: Overall driver )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/22 )
+
+
+C ( ------------------ Utility routines ------------------- )
+#include "test_assert.tst"
+
+C ( ------------------ Tests ------------------- )
+#include "test_idxl_get.tst"
+
+C ( ------------------ Mesh Creation ------------------- )
+
+C ( Allocate (uninitialized) memory for this mesh object )
+SUBROUTINE1(TST_mesh_allocate, TYPE_POINTER(mesh),m)
+  ALLOCATE_ARRAY2D(m v coord, NODE_COORDS, m v nNodes);
+  ALLOCATE_ARRAY2D(m v tri, TRI_NODES, m v nTri);
+  ALLOCATE_ARRAY2D(m v quad, QUAD_NODES, m v nQuad);
+END
+
+C ( Deallocate storage for this mesh object )
+SUBROUTINE1(TST_mesh_deallocate, TYPE_POINTER(mesh),m)
+  DEALLOCATE(m v coord);
+  DEALLOCATE(m v tri);
+  DEALLOCATE(m v quad);
+  CALL FEM_Mesh_deallocate(m v fem_mesh);
+END
+
+C ( Check (uninitialized) memory for this mesh object )
+SUBROUTINE1(TST_mesh_check, TYPE_POINTER(mesh),m)
+  INTEGER t,q,n;
+  FOR(t,m v nTri)
+    FOR(n,TRI_NODES)
+      CALL TST_assert_index_range(m v tri(n,t),m v nNodes);
+    END_FOR
+  END_FOR
+  FOR(q,m v nQuad)
+    FOR(n,QUAD_NODES)
+      CALL TST_assert_index_range(m v quad(n,q),m v nNodes);
+    END_FOR
+  END_FOR
+END
+
+C ( Create a dim x dim grid of 2d nodes connected by triangle-pairs. )
+SUBROUTINE2(TST_mesh_create, TYPE_POINTER(mesh),m, INTEGER,dim)
+  INTEGER x,y,quadRow,n,t,q;
+  m v fem_mesh = FEM_Mesh_allocate();
+  m v nNodes = dim*dim;
+  quadRow=dim/2;
+  m v nTri = 2*quadRow*(dim-1);
+  m v nQuad = (dim-1-quadRow)*(dim-1);
+  CALL TST_mesh_allocate(m);
+  n = IDXBASE;
+  t = IDXBASE;
+  q = IDXBASE;
+  FOR(y,dim) 
+    FOR(x,dim)
+      C ( Assign coordinates of this node )
+      m v coord(IDXBASE+0,n) = x*0.1;
+      m v coord(IDXBASE+1,n) = y*0.2;
+      IF (x -IDXBASE+1 < dim) THEN   C (skips the rightmost column of nodes)
+        IF (y -IDXBASE < quadRow) THEN
+          C ( Attach two triangles to this node )
+          m v tri(IDXBASE+0,t) = n;
+          m v tri(IDXBASE+1,t) = n+1;
+          m v tri(IDXBASE+2,t) = n+dim;
+          m v tri(IDXBASE+0,t+1) = n+1;
+          m v tri(IDXBASE+1,t+1) = n+dim+1;
+          m v tri(IDXBASE+2,t+1) = n+dim;
+          t = t+2;
+        ELSE
+          IF (y -IDXBASE+1 < dim) THEN    C (skips the bottom row of nodes)
+            C ( Attach a quad to this node )
+            m v quad(IDXBASE+0,q) = n;
+            m v quad(IDXBASE+1,q) = n+1;
+            m v quad(IDXBASE+2,q) = n+dim;
+            m v quad(IDXBASE+3,q) = n+dim+1;
+            q = q+1;
+          END_IF
+        END_IF
+      END_IF
+      n = n+1;
+    END_FOR 
+  END_FOR
+  CALL TST_assert_equal(n,m v nNodes+IDXBASE);
+  CALL TST_assert_equal(t,m v nTri+IDXBASE);
+  CALL TST_assert_equal(q,m v nQuad+IDXBASE);
+  CALL TST_mesh_check(m);
+END
+
+C ( Copy this mesh into the FEM framework )
+SUBROUTINE2(TST_mesh_set, TYPE_POINTER(mesh),m, INTEGER,ent)
+  INTEGER fem_mesh;
+  fem_mesh = m v fem_mesh;
+  CALL FEM_Mesh_data(fem_mesh,ent+FEM_NODE,FEM_DATA+0,m v coord, IDXBASE,m v nNodes,FEM_DOUBLE,NODE_COORDS);
+  CALL FEM_Mesh_data(fem_mesh,ent+FEM_ELEM+0,FEM_CONN,m v tri, IDXBASE,m v nTri,IDXL_INDEX_0+IDXBASE,TRI_NODES);
+  CALL FEM_Mesh_data(fem_mesh,ent+FEM_ELEM+1,FEM_CONN,m v quad, IDXBASE,m v nQuad,IDXL_INDEX_0+IDXBASE,QUAD_NODES);
+END
+
+C ( Extract this mesh from the FEM framework )
+SUBROUTINE3(TST_mesh_get, TYPE_POINTER(mesh),m, INTEGER,fem_mesh, INTEGER,ent)
+  m v fem_mesh = fem_mesh;
+  m v nNodes = FEM_Mesh_get_length(fem_mesh,ent+FEM_NODE);
+  m v nTri = FEM_Mesh_get_length(fem_mesh,ent+FEM_ELEM+0);
+  m v nQuad = FEM_Mesh_get_length(fem_mesh,ent+FEM_ELEM+1);
+  CALL TST_mesh_allocate(m);
+  CALL TST_mesh_set(m,ent); C( <- because "FEM_Mesh_data" works both ways )
+END
+
+C ( Prepare the FEM framework to partition these mesh ghosts )
+SUBROUTINE1(TST_mesh_ghostprep, TYPE_POINTER(mesh),m)
+  INTEGER i;
+  DECLARE_ARRAY(INTEGER,t); C( Triangle -> face mapping )
+  DECLARE_ARRAY(INTEGER,q); C( Quad -> face mapping )
+  ALLOCATE_ARRAY(t,6);
+  ALLOCATE_ARRAY(q,8);
+  i=IDXBASE;
+  t(i+0)=i+0; t(i+1)=i+1; 
+  t(i+2)=i+1; t(i+3)=i+2;
+  t(i+4)=i+2; t(i+5)=i+0;
+  
+  q(i+0)=i+0; q(i+1)=i+1; 
+  q(i+2)=i+1; q(i+3)=i+3;
+  q(i+4)=i+3; q(i+5)=i+2;
+  q(i+6)=i+2; q(i+7)=i+0;
+  
+C( CALL FEM_Mesh_set_default_write(m v fem_mesh); )
+  CALL FEM_Add_ghost_layer(2,1);
+  CALL FEM_Add_ghost_elem(0,3,t);
+  CALL FEM_Add_ghost_elem(1,4,q);
+END
+
+C ( ------------------ Driver ------------------- )
+C (Call all test routines)
+SUBROUTINE0(RUN_Test)
+  INTEGER i,j;
+  INTEGER serialMesh, fem_mesh;
+  INTEGER nodes, elements;
+  DECLARE_ARRAY2D(DOUBLE PRECISION,nodeCoord,2);
+  TYPE(global) g;
+  TYPE(mesh) sm; C( serial mesh )
+  g v comm=MPI_COMM_WORLD;
+  CALL MPI_Comm_rank(g v comm,ADDR g v myRank MPIERR);
+  CALL MPI_Comm_size(g v comm,ADDR g v commSize MPIERR);
+  CALL TST_assert_is_chunk(g, g v myRank);
+  
+  IF (g v myRank == 0) THEN
+    CALL FEM_Print("Creating mesh...");
+    serialMesh=FEM_Mesh_allocate();
+    CALL TST_mesh_create(sm, 4);
+    CALL TST_print_int("Serial mesh nodes",sm v nNodes);
+    CALL TST_mesh_ghostprep(sm);
+    CALL TST_mesh_set(sm,0);
+  END_IF
+  CALL FEM_Print("Splitting up mesh");
+  fem_mesh=FEM_Mesh_broadcast(sm v fem_mesh,0,g v comm);
+  IF (g v myRank == 0) THEN
+    CALL TST_mesh_deallocate(sm);
+  END_IF
+  CALL TST_mesh_get(g v m,fem_mesh,0);
+  CALL TST_print_int("Split mesh nodes",g v m v nNodes);
+  CALL TST_mesh_get(g v mg,fem_mesh,FEM_GHOST);
+  CALL TST_print_int("Split mesh ghost nodes",g v mg v nNodes);
+  
+  CALL FEM_Print("Running IDXL tests");
+  CALL TST_test_idxl(g,fem_mesh);
+  
+  
+  CALL TST_mesh_deallocate(g v m);
+  
+  CALL MPI_Barrier(g v comm MPIERR);
+END
+
+
diff --git a/tests/fem/megafem/test_assert.tst b/tests/fem/megafem/test_assert.tst
new file mode 100644 (file)
index 0000000..bc24100
--- /dev/null
@@ -0,0 +1,80 @@
+C ( C/Fortran test driver: Overall driver )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/22 )
+
+C ( C/Fortran test routines: assertations and test utilities )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/25 )
+
+C ( ------------------ Utility routines ------------------- )
+SUBROUTINE1(TST_assert_isnt_negative, INTEGER,val)
+  IF (val < 0) THEN
+    CALL RUN_Abort(val);
+  END_IF
+END
+SUBROUTINE1(TST_assert_is_index, INTEGER,val)
+  IF (val < IDXBASE) THEN
+    CALL RUN_Abort(val);
+  END_IF
+END
+SUBROUTINE3(TST_assert_range, INTEGER,val, INTEGER,l, INTEGER,h)
+  IF (val<l _OR_ val>=h) THEN
+    CALL RUN_Abort(val);
+  END_IF
+END
+SUBROUTINE2(TST_assert_index_range, INTEGER,val, INTEGER,m)
+  CALL TST_assert_range(val, IDXBASE,m+IDXBASE);
+END
+SUBROUTINE2(TST_assert_is_chunk, TYPE_POINTER(global),g, INTEGER,val)
+  CALL TST_assert_range(val,0,g v commSize);
+END
+SUBROUTINE2(TST_assert_equal, INTEGER,val, INTEGER,should)
+  IF (val _NE_ should) THEN
+    CALL RUN_Abort(val);
+  END_IF
+END
+
+#ifdef TST_C
+void TST_print_str(const char *desc) {
+       CkPrintf("[%d] %s\n",FEM_My_partition(),desc); 
+}
+void TST_print_str2(const char *desc,const char *desc2) {
+       CkPrintf("[%d] %s %s\n",FEM_My_partition(),desc,desc2); 
+}
+void TST_print_int(const char *desc,int i) { 
+       CkPrintf("[%d] %s: %d\n",FEM_My_partition(),desc,i); 
+}
+void TST_print_int2(const char *desc,int i,int j) { 
+       CkPrintf("[%d] %s: %d %d\n",FEM_My_partition(),desc,i,j); 
+}
+void TST_print_int3(const char *desc,int i,int j,int k) { 
+       CkPrintf("[%d] %s: %d %d %d\n",FEM_My_partition(),desc,i,j,k); 
+}
+#else /* Fortran */
+SUBROUTINE TST_print_str(desc)
+  TST_F90_USE; STRING :: desc;
+  write(*,*) '[',FEM_My_partition()-1,'] ',desc;
+END SUBROUTINE
+SUBROUTINE TST_print_str2(desc,desc2)
+  TST_F90_USE
+  CHARACTER(LEN=*) :: desc, desc2;
+  write(*,*) '[',FEM_My_partition()-1,'] ',desc,' ',desc2;
+END SUBROUTINE
+SUBROUTINE TST_print_int(desc,i)
+  TST_F90_USE
+  CHARACTER(LEN=*) :: desc; INTEGER i;
+  write(*,*) '[',FEM_My_partition()-1,'] ',desc,':',i;
+END SUBROUTINE
+SUBROUTINE TST_print_int2(desc,i,j)
+  TST_F90_USE
+  CHARACTER(LEN=*) :: desc; INTEGER i,j;
+  write(*,*) '[',FEM_My_partition()-1,'] ',desc,':',i,j;
+END SUBROUTINE
+SUBROUTINE TST_print_int3(desc,i,j,k)
+  TST_F90_USE
+  CHARACTER(LEN=*) :: desc; INTEGER i,j,k;
+  write(*,*) '[',FEM_My_partition()-1,'] ',desc,':',i,j,k;
+END SUBROUTINE
+#endif
+
+SUBROUTINE1(TST_status, STRING,routine)
+  CALL TST_print_str2("testing",routine);
+END
diff --git a/tests/fem/megafem/test_globals.tst b/tests/fem/megafem/test_globals.tst
new file mode 100644 (file)
index 0000000..0697cae
--- /dev/null
@@ -0,0 +1,40 @@
+C ( C/Fortran data structure declaration )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/23 )
+
+C ( Describes a (piece of a) FEM mesh )
+CREATE_TYPE(mesh)
+C ( FEM framework ID for this mesh )
+  INTEGER fem_mesh;
+
+C ( Entity type FEM_NODE. )
+  INTEGER nNodes, nGhostNode;
+#define NODE_COORDS 2
+  DECLARE_ARRAY2D(DOUBLE PRECISION,coord,NODE_COORDS);
+
+C ( Entity type FEM_ELEM+0: triangles. )
+  INTEGER nTri, nGhostTri;
+#define TRI_NODES 3
+  DECLARE_ARRAY2D(INTEGER,tri,TRI_NODES);
+  
+C ( Entity type FEM_ELEM+1: quads. )
+  INTEGER nQuad, nGhostQuad;
+#define QUAD_NODES 4
+  DECLARE_ARRAY2D(INTEGER,quad,QUAD_NODES);
+END_TYPE
+
+CREATE_TYPE(global)
+  INTEGER comm; C( MPI Communicator )
+  INTEGER myRank; C( my 0-based rank in the communicator )
+  INTEGER commSize; C( the size of the communicator )
+  TYPE(mesh) m; C( Testing mesh-- data )
+  TYPE(mesh) mg; C( Ghost nodes and elements on testing mesh )
+END_TYPE
+
+C( Error return type for MPI routines. )
+INTEGER mpierr;
+#if TST_F90 /* In f90, MPI routines take an "error" argument. */
+#  define MPIERR ,mpierr
+#else /* In C, MPI routines return their error. */
+#  define MPIERR 
+#endif
+
diff --git a/tests/fem/megafem/test_idxl_get.tst b/tests/fem/megafem/test_idxl_get.tst
new file mode 100644 (file)
index 0000000..e4964c9
--- /dev/null
@@ -0,0 +1,54 @@
+C ( C/Fortran test driver: IDXL routines )
+C ( Orion Sky Lawlor- olawlor@acm.org- 2003/7/22 )
+
+C (Test out the IDXL_Get routines on this IDXL_Side_t.)
+SUBROUTINE3(TST_test_idxl_side, TYPE_POINTER(global),g, INTEGER,s, INTEGER,n)
+  INTEGER nPartners, nShared;
+  INTEGER p; C (Partner number)
+  INTEGER pRank;
+  INTEGER i;
+  DECLARE_ARRAY(INTEGER,list);
+  CALL TST_status("IDXL_Get_*");
+  nPartners=IDXL_Get_partners(s);
+  CALL TST_assert_isnt_negative(nPartners);
+  C( CALL TST_print_int("IDXL Comm shared partners",nPartners); )
+  FOR(p,nPartners)
+    pRank=IDXL_Get_partner(s,p);
+    CALL TST_assert_is_chunk(g,pRank);
+    nShared=IDXL_Get_count(s,p);
+    C( CALL TST_print_int2("  IDXL Comm partner/nComm",pRank,nShared); )
+    ALLOCATE_ARRAY(list,nShared);
+    CALL IDXL_Get_list(s,p,list);
+    FOR(i,nShared)
+      CALL TST_assert_index_range(list(i),n);
+    END_FOR
+    DEALLOCATE(list)
+  END_FOR
+  CALL IDXL_Get_end(s);
+END
+
+C ( Test out the ghost communication for this entity type )
+SUBROUTINE3(TST_test_idxl_ghost, TYPE_POINTER(global),g, INTEGER,fem_mesh, INTEGER,ent)
+  INTEGER n,idxl;
+  idxl=FEM_Comm_ghost(fem_mesh,ent);
+  n=FEM_Mesh_get_length(fem_mesh,ent);
+  CALL TST_test_idxl_side(g,IDXL_Get_send(idxl),n);
+  n=FEM_Mesh_get_length(fem_mesh,FEM_GHOST+ent);
+  CALL TST_test_idxl_side(g,IDXL_Get_recv(idxl),n);
+END
+
+C (Test out the IDXL routines on this Mesh.)
+SUBROUTINE2(TST_test_idxl, TYPE_POINTER(global),g, INTEGER,fem_mesh)
+  INTEGER n,idxl;
+  CALL TST_status("FEM_Comm_*");
+C ( Test out shared nodes: )
+  idxl=FEM_Comm_shared(fem_mesh,FEM_NODE);
+  n=FEM_Mesh_get_length(fem_mesh,FEM_NODE);
+  CALL TST_test_idxl_side(g,IDXL_Get_send(idxl),n);
+
+C ( Test out each ghost element type: )
+  CALL TST_test_idxl_ghost(g,fem_mesh,FEM_NODE);
+  CALL TST_test_idxl_ghost(g,fem_mesh,FEM_ELEM+0);
+  CALL TST_test_idxl_ghost(g,fem_mesh,FEM_ELEM+1);
+END
+