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