xref: /libCEED/tests/t302-basis-f.f90 (revision b300f92cd69fddd8b3fece5386974f44cfbd7310)
18980d4a7Sjeremylt!-----------------------------------------------------------------------
28980d4a7Sjeremylt      program test
38980d4a7Sjeremylt
48980d4a7Sjeremylt      include 'ceedf.h'
58980d4a7Sjeremylt
68980d4a7Sjeremylt      integer ceed,err
752bfb9bbSJeremy L Thompson      integer b
8*b300f92cSjeremylt      real*8 collograd1d(16), collograd1d2(36)
98980d4a7Sjeremylt
108980d4a7Sjeremylt      character arg*32
118980d4a7Sjeremylt
128980d4a7Sjeremylt      call getarg(1,arg)
1352bfb9bbSJeremy L Thompson
148980d4a7Sjeremylt      call ceedinit(trim(arg)//char(0),ceed,err)
158980d4a7Sjeremylt
1652bfb9bbSJeremy L Thompson!     Already collocated, GetCollocatedGrad will return grad1d
1752bfb9bbSJeremy L Thompson      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss_lobatto,b,&
18c8b9fe72Sjeremylt     & err)
19*b300f92cSjeremylt      call ceedbasisgetcollocatedgrad(b,collograd1d,err)
2052bfb9bbSJeremy L Thompson      call ceedbasisview(b,err)
2152bfb9bbSJeremy L Thompson      do i=1,16
22*b300f92cSjeremylt        if (abs(collograd1d(i))<1.0D-14) then
23*b300f92cSjeremylt          collograd1d(i) = 0
2452bfb9bbSJeremy L Thompson        endif
2552bfb9bbSJeremy L Thompson      enddo
2652bfb9bbSJeremy L Thompson      do i=0,3
2752bfb9bbSJeremy L Thompson        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')&
28*b300f92cSjeremylt     &   'collograd[',i,']:',(collograd1d(j+4*i),j=1,4)
2952bfb9bbSJeremy L Thompson      call flush(6)
3052bfb9bbSJeremy L Thompson      enddo
3152bfb9bbSJeremy L Thompson      call ceedbasisdestroy(b,err)
328980d4a7Sjeremylt
3352bfb9bbSJeremy L Thompson!     Q = P, not already collocated
3452bfb9bbSJeremy L Thompson      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss,b,err)
35*b300f92cSjeremylt      call ceedbasisgetcollocatedgrad(b,collograd1d,err)
3652bfb9bbSJeremy L Thompson      call ceedbasisview(b,err)
3752bfb9bbSJeremy L Thompson      do i=1,16
38*b300f92cSjeremylt        if (abs(collograd1d(i))<1.0D-14) then
39a2546046Sjeremylt! LCOV_EXCL_START
40*b300f92cSjeremylt          collograd1d(i) = 0
41de996c55Sjeremylt! LCOV_EXCL_STOP
428980d4a7Sjeremylt        endif
438980d4a7Sjeremylt      enddo
4452bfb9bbSJeremy L Thompson      do i=0,3
4552bfb9bbSJeremy L Thompson        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')&
46*b300f92cSjeremylt     &   'collograd[',i,']:',(collograd1d(j+4*i),j=1,4)
4752bfb9bbSJeremy L Thompson      call flush(6)
4852bfb9bbSJeremy L Thompson      enddo
4952bfb9bbSJeremy L Thompson      call ceedbasisdestroy(b,err)
508980d4a7Sjeremylt
5152bfb9bbSJeremy L Thompson!     Q = P + 2, not already collocated
5252bfb9bbSJeremy L Thompson      call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,ceed_gauss,b,err)
53*b300f92cSjeremylt      call ceedbasisgetcollocatedgrad(b,collograd1d2,err)
5452bfb9bbSJeremy L Thompson      call ceedbasisview(b,err)
5552bfb9bbSJeremy L Thompson      do i=1,36
56*b300f92cSjeremylt        if (abs(collograd1d2(i))<1.0D-14) then
5752bfb9bbSJeremy L Thompson! LCOV_EXCL_START
58*b300f92cSjeremylt          collograd1d2(i) = 0
5952bfb9bbSJeremy L Thompson! LCOV_EXCL_STOP
6052bfb9bbSJeremy L Thompson        endif
6152bfb9bbSJeremy L Thompson      enddo
6252bfb9bbSJeremy L Thompson      do i=0,5
6352bfb9bbSJeremy L Thompson        write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')&
64*b300f92cSjeremylt     &   'collograd[',i,']:',(collograd1d2(j+6*i),j=1,6)
6552bfb9bbSJeremy L Thompson      call flush(6)
6652bfb9bbSJeremy L Thompson      enddo
6752bfb9bbSJeremy L Thompson      call ceedbasisdestroy(b,err)
6852bfb9bbSJeremy L Thompson
698980d4a7Sjeremylt      call ceeddestroy(ceed,err)
7052bfb9bbSJeremy L Thompson
718980d4a7Sjeremylt      end
728980d4a7Sjeremylt!-----------------------------------------------------------------------
73