xref: /libCEED/tests/t209-elemrestriction-f.f90 (revision 014ec18d8ea934e4fc0f69a8c06ffce36a53ff2a)
1!-----------------------------------------------------------------------
2      program test
3
4      include 'ceedf.h'
5
6      integer ceed,err
7      integer mult
8      integer r
9      integer i
10      integer*8 moffset
11
12      integer ne
13      parameter(ne=3)
14
15      integer*4 ind(4*ne)
16      real*8 mm(3*ne+1)
17      integer offset
18      real*8 diff
19
20      character arg*32
21
22      call getarg(1,arg)
23      call ceedinit(trim(arg)//char(0),ceed,err)
24
25      call ceedvectorcreate(ceed,3*ne+1,mult,err)
26      call ceedvectorsetvalue(mult,0.d0,err);
27
28      do i=1,ne
29        ind(4*i-3)=3*i-3
30        ind(4*i-2)=3*i-2
31        ind(4*i-1)=3*i-1
32        ind(4*i-0)=3*i-0
33      enddo
34      call ceedelemrestrictioncreate(ceed,ne,4,1,1,3*ne+1,ceed_mem_host,&
35     & ceed_use_pointer,ind,r,err)
36
37      call ceedelemrestrictiongetmultiplicity(r,mult,err)
38
39      call ceedvectorgetarrayread(mult,ceed_mem_host,mm,moffset,err)
40      do i=1,3*ne+1
41        if(i > 1 .and. i < 3*ne+1 .and. mod(i-1,3)==0) then
42          offset = 1
43        else
44          offset = 0
45        endif
46        diff=1+offset-mm(i+moffset)
47        if (abs(diff) > 1.0D-15) then
48! LCOV_EXCL_START
49          write(*,*) 'Error in multiplicity vector: mult(',i,')=',mm(i+moffset)
50! LCOV_EXCL_STOP
51        endif
52      enddo
53      call ceedvectorrestorearrayread(mult,mm,moffset,err)
54
55      call ceedvectordestroy(mult,err)
56      call ceedelemrestrictiondestroy(r,err)
57      call ceeddestroy(ceed,err)
58
59      end
60!-----------------------------------------------------------------------
61