Added a test program in fortran90.
authorMilind Bhandarkar <milind@cs.uiuc.edu>
Tue, 8 Aug 2000 20:41:28 +0000 (20:41 +0000)
committerMilind Bhandarkar <milind@cs.uiuc.edu>
Tue, 8 Aug 2000 20:41:28 +0000 (20:41 +0000)
tests/fem/femtest/Makefile
tests/fem/femtest/fmesh.dat
tests/fem/femtest/fpgm.f90 [new file with mode: 0644]

index 5993627ce655cdac28924d20109f7ae329a42360..31d3e6aa791dff28f19e5db025ea6f944ba30b0a 100644 (file)
@@ -1,6 +1,6 @@
 CHARMC=../../../../bin/charmc $(OPTS) 
 
-all: pgm
+all: pgm fpgm
 
 pgm: pgm.o
        $(CHARMC) -o pgm pgm.o -language fem
@@ -8,5 +8,11 @@ pgm: pgm.o
 pgm.o: pgm.C
        $(CHARMC) -c pgm.C
 
+fpgm: fpgm.o
+       $(CHARMC) -o fpgm fpgm.o -language femf
+
+fpgm.o: fpgm.f90
+       $(CHARMC) -c fpgm.f90
+
 clean:
-       rm -f pgm *.o conv-host
+       rm -f pgm fpgm *.o conv-host
index 2b077a7da807ef2cab04c1db8b5bb3b821972363..dd3906d4aa0fc4b9a9800ad7ec940fd0ef92d1fd 100644 (file)
@@ -3,3 +3,4 @@
 2 3 5 6
 4 5 7 8
 5 6 8 9
+
diff --git a/tests/fem/femtest/fpgm.f90 b/tests/fem/femtest/fpgm.f90
new file mode 100644 (file)
index 0000000..afcd6ab
--- /dev/null
@@ -0,0 +1,99 @@
+subroutine init()
+implicit none
+include 'femf.h'
+
+  integer :: i, j, nelems, nnodes, ctype, esize
+  integer, dimension(:,:), allocatable:: conn
+
+  call FEM_Print('init called')
+  open(20, file='fmesh.dat')
+  read(20,*) nelems, nnodes, ctype
+  if (ctype .eq. FEM_TRIANGULAR) then
+    esize = 3
+  else 
+    if(ctype .eq. FEM_HEXAHEDRAL) then
+      esize = 8
+    else
+      esize = 4
+    endif
+  endif
+  allocate(conn(nelems, esize))
+  do i=1,nelems
+    read(20,*) (conn(i,j),j=1,esize)
+  enddo
+  close(20)
+  call FEM_Set_Mesh(nelems, nnodes, ctype, conn)
+end subroutine init
+
+subroutine driver(nnodes, nnums, nelems, enums, npere, conn)
+implicit none
+include 'femf.h'
+
+  integer  :: nnodes, nelems, npere
+  integer, dimension(nnodes) :: nnums
+  integer, dimension(nelems) :: enums
+  integer, dimension(nelems, npere) :: conn
+
+  integer :: i, j, fid
+  logical :: failed
+  double precision :: sum
+  double precision, dimension(nnodes) :: nodes
+  double precision, dimension(nelems) :: elements
+
+  !call FEM_Print_Partition()
+
+  nodes = 0.0
+  elements = 0.0
+  do i=1,nnodes
+    if (nnums(i) .eq. 1) nodes(i) = 1.0
+  enddo
+  fid = FEM_Create_Field(FEM_DOUBLE, 1, 0, offsetof(nodes(1),nodes(2)))
+  do i=1,nelems
+    do j=1,npere
+      elements(i) = elements(i) + nodes(conn(i,j))
+    enddo
+    elements(i) = elements(i)/npere
+  enddo
+  nodes = 0.0
+  do i=1,nelems
+    do j=1,npere
+      nodes(conn(i,j)) = nodes(conn(i,j)) + elements(i)
+    enddo
+  enddo
+  call FEM_Update_Field(fid, nodes(1))
+  failed = .FALSE.
+  do i=1,nnodes
+    if (nnums(i).eq.1 .or. nnums(i).eq.2 .or. &
+&       nnums(i).eq.4 .or. nnums(i).eq.5) then 
+      if(nodes(i) .ne. 0.25) failed = .TRUE.
+    else
+      if (nodes(i) .ne. 0.0) failed = .TRUE.
+    endif
+  enddo
+  if (failed) then
+    call FEM_Print('update_field test failed.')
+  else
+    call FEM_Print('update_field test passed.')
+  endif
+  sum = 0.0
+  call FEM_Reduce_Field(fid, nodes(1), sum, FEM_SUM)
+  if (sum .eq. 1.0) then
+    call FEM_Print('reduce_field test passed.')
+  else
+    call FEM_Print('reduce_field test failed.')
+  endif
+  sum = 1.0
+  call FEM_Reduce(fid, sum, sum, FEM_SUM)
+  if (sum .eq. FEM_Num_Partitions()) then
+    call FEM_Print('reduce test passed.')
+  else
+    call FEM_Print('reduce test failed.')
+  endif
+  call FEM_Done()
+end subroutine driver
+
+subroutine finalize()
+implicit none
+include 'femf.h'
+  call FEM_Print('finalize called')
+end subroutine