libCEED/tests/t209-elemrestriction-f.f90 at deafd6bcebd096048d138fb8fd8b23ebd3a55514 · CEED/libCEED · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
!-----------------------------------------------------------------------
      program test

      include 'ceedf.h'

      integer ceed,err
      integer mult
      integer r
      integer i
      integer*8 moffset

      integer ne
      parameter(ne=3)

      integer*4 ind(4*ne)
      real*8 mm(3*ne+1)
      integer offset
      real*8 diff

      character arg*32

      call getarg(1,arg)
      call ceedinit(trim(arg)//char(0),ceed,err)

      call ceedvectorcreate(ceed,3*ne+1,mult,err)
      call ceedvectorsetvalue(mult,0.d0,err);

      do i=1,ne
        ind(4*i-3)=3*i-3
        ind(4*i-2)=3*i-2
        ind(4*i-1)=3*i-1
        ind(4*i-0)=3*i-0
      enddo
      call ceedelemrestrictioncreate(ceed,ne,4,3*ne+1,1,ceed_mem_host,&
     & ceed_use_pointer,ind,r,err)

      call ceedelemrestrictiongetmultiplicity(r,mult,err)

      call ceedvectorgetarrayread(mult,ceed_mem_host,mm,moffset,err)
      do i=1,3*ne+1
        if(i > 1 .and. i < 3*ne+1 .and. mod(i-1,3)==0) then
          offset = 1
        else
          offset = 0
        endif
        diff=1+offset-mm(i+moffset)
        if (abs(diff) > 1.0D-15) then
          write(*,*) 'Error in multiplicity vector: mult(',i,')=',mm(i+moffset)
        endif
      enddo
      call ceedvectorrestorearrayread(mult,mm,moffset,err)

      call ceedvectordestroy(mult,err)
      call ceedelemrestrictiondestroy(r,err)
      call ceeddestroy(ceed,err)

      end
!-----------------------------------------------------------------------