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