18980d4a7Sjeremylt!----------------------------------------------------------------------- 28980d4a7Sjeremylt program test 31f9a83abSJed Brown implicit none 4*ec3da8bcSJed Brown include 'ceed/fortran.h' 58980d4a7Sjeremylt 61f9a83abSJed Brown integer ceed,err,i,j 752bfb9bbSJeremy L Thompson integer b 8b300f92cSjeremylt 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) 19b300f92cSjeremylt call ceedbasisgetcollocatedgrad(b,collograd1d,err) 2052bfb9bbSJeremy L Thompson do i=1,16 21b300f92cSjeremylt if (abs(collograd1d(i))<1.0D-14) then 22b300f92cSjeremylt collograd1d(i) = 0 2352bfb9bbSJeremy L Thompson endif 2452bfb9bbSJeremy L Thompson enddo 2552bfb9bbSJeremy L Thompson do i=0,3 2652bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 27b300f92cSjeremylt & 'collograd[',i,']:',(collograd1d(j+4*i),j=1,4) 2852bfb9bbSJeremy L Thompson call flush(6) 2952bfb9bbSJeremy L Thompson enddo 3052bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 318980d4a7Sjeremylt 3252bfb9bbSJeremy L Thompson! Q = P, not already collocated 3352bfb9bbSJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss,b,err) 34b300f92cSjeremylt call ceedbasisgetcollocatedgrad(b,collograd1d,err) 3552bfb9bbSJeremy L Thompson do i=1,16 36b300f92cSjeremylt if (abs(collograd1d(i))<1.0D-14) then 37a2546046Sjeremylt! LCOV_EXCL_START 38b300f92cSjeremylt collograd1d(i) = 0 39de996c55Sjeremylt! LCOV_EXCL_STOP 408980d4a7Sjeremylt endif 418980d4a7Sjeremylt enddo 4252bfb9bbSJeremy L Thompson do i=0,3 4352bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 44b300f92cSjeremylt & 'collograd[',i,']:',(collograd1d(j+4*i),j=1,4) 4552bfb9bbSJeremy L Thompson call flush(6) 4652bfb9bbSJeremy L Thompson enddo 4752bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 488980d4a7Sjeremylt 4952bfb9bbSJeremy L Thompson! Q = P + 2, not already collocated 5052bfb9bbSJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,ceed_gauss,b,err) 51b300f92cSjeremylt call ceedbasisgetcollocatedgrad(b,collograd1d2,err) 5252bfb9bbSJeremy L Thompson do i=1,36 53b300f92cSjeremylt if (abs(collograd1d2(i))<1.0D-14) then 5452bfb9bbSJeremy L Thompson! LCOV_EXCL_START 55b300f92cSjeremylt collograd1d2(i) = 0 5652bfb9bbSJeremy L Thompson! LCOV_EXCL_STOP 5752bfb9bbSJeremy L Thompson endif 5852bfb9bbSJeremy L Thompson enddo 5952bfb9bbSJeremy L Thompson do i=0,5 6052bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 61b300f92cSjeremylt & 'collograd[',i,']:',(collograd1d2(j+6*i),j=1,6) 6252bfb9bbSJeremy L Thompson call flush(6) 6352bfb9bbSJeremy L Thompson enddo 6452bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 6552bfb9bbSJeremy L Thompson 668980d4a7Sjeremylt call ceeddestroy(ceed,err) 6752bfb9bbSJeremy L Thompson 688980d4a7Sjeremylt end 698980d4a7Sjeremylt!----------------------------------------------------------------------- 70