xref: /libCEED/tests/t209-elemrestriction-f.f90 (revision 874019bc89a44b0eae6b48d78442abcb0851055b)
11469ee4dSjeremylt!-----------------------------------------------------------------------
21469ee4dSjeremylt      program test
31f9a83abSJed Brown      implicit none
4*ec3da8bcSJed Brown      include 'ceed/fortran.h'
51469ee4dSjeremylt
61469ee4dSjeremylt      integer ceed,err
71469ee4dSjeremylt      integer mult
81469ee4dSjeremylt      integer r
91469ee4dSjeremylt      integer i
101469ee4dSjeremylt      integer*8 moffset
111469ee4dSjeremylt
121469ee4dSjeremylt      integer ne
131469ee4dSjeremylt      parameter(ne=3)
141469ee4dSjeremylt
151469ee4dSjeremylt      integer*4 ind(4*ne)
161469ee4dSjeremylt      real*8 mm(3*ne+1)
171469ee4dSjeremylt      integer offset
181469ee4dSjeremylt      real*8 diff
191469ee4dSjeremylt
201469ee4dSjeremylt      character arg*32
211469ee4dSjeremylt
221469ee4dSjeremylt      call getarg(1,arg)
231469ee4dSjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
241469ee4dSjeremylt
251469ee4dSjeremylt      call ceedvectorcreate(ceed,3*ne+1,mult,err)
261469ee4dSjeremylt      call ceedvectorsetvalue(mult,0.d0,err);
271469ee4dSjeremylt
281469ee4dSjeremylt      do i=1,ne
291469ee4dSjeremylt        ind(4*i-3)=3*i-3
301469ee4dSjeremylt        ind(4*i-2)=3*i-2
311469ee4dSjeremylt        ind(4*i-1)=3*i-1
321469ee4dSjeremylt        ind(4*i-0)=3*i-0
331469ee4dSjeremylt      enddo
34d979a051Sjeremylt      call ceedelemrestrictioncreate(ceed,ne,4,1,1,3*ne+1,ceed_mem_host,&
351469ee4dSjeremylt     & ceed_use_pointer,ind,r,err)
361469ee4dSjeremylt
37a8d32208Sjeremylt      call ceedelemrestrictiongetmultiplicity(r,mult,err)
381469ee4dSjeremylt
391469ee4dSjeremylt      call ceedvectorgetarrayread(mult,ceed_mem_host,mm,moffset,err)
401469ee4dSjeremylt      do i=1,3*ne+1
411469ee4dSjeremylt        if(i > 1 .and. i < 3*ne+1 .and. mod(i-1,3)==0) then
421469ee4dSjeremylt          offset = 1
431469ee4dSjeremylt        else
441469ee4dSjeremylt          offset = 0
451469ee4dSjeremylt        endif
461469ee4dSjeremylt        diff=1+offset-mm(i+moffset)
471469ee4dSjeremylt        if (abs(diff) > 1.0D-15) then
48a2546046Sjeremylt! LCOV_EXCL_START
491469ee4dSjeremylt          write(*,*) 'Error in multiplicity vector: mult(',i,')=',mm(i+moffset)
50de996c55Sjeremylt! LCOV_EXCL_STOP
511469ee4dSjeremylt        endif
521469ee4dSjeremylt      enddo
531469ee4dSjeremylt      call ceedvectorrestorearrayread(mult,mm,moffset,err)
541469ee4dSjeremylt
55deafd6bcSjeremylt      call ceedvectordestroy(mult,err)
561469ee4dSjeremylt      call ceedelemrestrictiondestroy(r,err)
571469ee4dSjeremylt      call ceeddestroy(ceed,err)
581469ee4dSjeremylt
591469ee4dSjeremylt      end
601469ee4dSjeremylt!-----------------------------------------------------------------------
61