xref: /libCEED/tests/t209-elemrestriction-f.f90 (revision fa9eac48825b2c0339cddc576d44c186940d4520)
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,3*ne+1,1,ceed_mem_host,&
35     & ceed_use_pointer,ind,r,err)
36
37      call ceedelemrestrictiongetmultiplicity(r,mult,ceed_notranspose,&
38     & err)
39
40      call ceedvectorgetarrayread(mult,ceed_mem_host,mm,moffset,err)
41      do i=1,3*ne+1
42        if(i > 1 .and. i < 3*ne+1 .and. mod(i-1,3)==0) then
43          offset = 1
44        else
45          offset = 0
46        endif
47        diff=1+offset-mm(i+moffset)
48        if (abs(diff) > 1.0D-15) then
49! LCOV_EXCL_START
50          write(*,*) 'Error in multiplicity vector: mult(',i,')=',mm(i+moffset)
51! LCOV_EXCL_STOP
52        endif
53      enddo
54      call ceedvectorrestorearrayread(mult,mm,moffset,err)
55
56      call ceedvectordestroy(mult,err)
57      call ceedelemrestrictiondestroy(r,err)
58      call ceeddestroy(ceed,err)
59
60      end
61!-----------------------------------------------------------------------
62