18980d4a7Sjeremylt!----------------------------------------------------------------------- 28980d4a7Sjeremylt program test 38980d4a7Sjeremylt 48980d4a7Sjeremylt include 'ceedf.h' 58980d4a7Sjeremylt 68980d4a7Sjeremylt integer ceed,err 7*52bfb9bbSJeremy L Thompson integer b 8*52bfb9bbSJeremy L Thompson real*8 colograd1d(16), colograd1d2(36) 98980d4a7Sjeremylt 108980d4a7Sjeremylt character arg*32 118980d4a7Sjeremylt 128980d4a7Sjeremylt call getarg(1,arg) 13*52bfb9bbSJeremy L Thompson 148980d4a7Sjeremylt call ceedinit(trim(arg)//char(0),ceed,err) 158980d4a7Sjeremylt 16*52bfb9bbSJeremy L Thompson! Already collocated, GetCollocatedGrad will return grad1d 17*52bfb9bbSJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss_lobatto,b,& 18c8b9fe72Sjeremylt & err) 19*52bfb9bbSJeremy L Thompson call ceedbasisgetcollocatedgrad(b,colograd1d,err) 20*52bfb9bbSJeremy L Thompson call ceedbasisview(b,err) 21*52bfb9bbSJeremy L Thompson do i=1,16 22*52bfb9bbSJeremy L Thompson if (abs(colograd1d(i))<1.0D-14) then 23*52bfb9bbSJeremy L Thompson colograd1d(i) = 0 24*52bfb9bbSJeremy L Thompson endif 25*52bfb9bbSJeremy L Thompson enddo 26*52bfb9bbSJeremy L Thompson do i=0,3 27*52bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 28*52bfb9bbSJeremy L Thompson & 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4) 29*52bfb9bbSJeremy L Thompson call flush(6) 30*52bfb9bbSJeremy L Thompson enddo 31*52bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 328980d4a7Sjeremylt 33*52bfb9bbSJeremy L Thompson! Q = P, not already collocated 34*52bfb9bbSJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss,b,err) 35*52bfb9bbSJeremy L Thompson call ceedbasisgetcollocatedgrad(b,colograd1d,err) 36*52bfb9bbSJeremy L Thompson call ceedbasisview(b,err) 37*52bfb9bbSJeremy L Thompson do i=1,16 38*52bfb9bbSJeremy L Thompson if (abs(colograd1d(i))<1.0D-14) then 39a2546046Sjeremylt! LCOV_EXCL_START 40*52bfb9bbSJeremy L Thompson colograd1d(i) = 0 41de996c55Sjeremylt! LCOV_EXCL_STOP 428980d4a7Sjeremylt endif 438980d4a7Sjeremylt enddo 44*52bfb9bbSJeremy L Thompson do i=0,3 45*52bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 46*52bfb9bbSJeremy L Thompson & 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4) 47*52bfb9bbSJeremy L Thompson call flush(6) 48*52bfb9bbSJeremy L Thompson enddo 49*52bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 508980d4a7Sjeremylt 51*52bfb9bbSJeremy L Thompson! Q = P + 2, not already collocated 52*52bfb9bbSJeremy L Thompson call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,ceed_gauss,b,err) 53*52bfb9bbSJeremy L Thompson call ceedbasisgetcollocatedgrad(b,colograd1d2,err) 54*52bfb9bbSJeremy L Thompson call ceedbasisview(b,err) 55*52bfb9bbSJeremy L Thompson do i=1,36 56*52bfb9bbSJeremy L Thompson if (abs(colograd1d2(i))<1.0D-14) then 57*52bfb9bbSJeremy L Thompson! LCOV_EXCL_START 58*52bfb9bbSJeremy L Thompson colograd1d2(i) = 0 59*52bfb9bbSJeremy L Thompson! LCOV_EXCL_STOP 60*52bfb9bbSJeremy L Thompson endif 61*52bfb9bbSJeremy L Thompson enddo 62*52bfb9bbSJeremy L Thompson do i=0,5 63*52bfb9bbSJeremy L Thompson write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 64*52bfb9bbSJeremy L Thompson & 'colograd[',i,']:',(colograd1d2(j+6*i),j=1,6) 65*52bfb9bbSJeremy L Thompson call flush(6) 66*52bfb9bbSJeremy L Thompson enddo 67*52bfb9bbSJeremy L Thompson call ceedbasisdestroy(b,err) 68*52bfb9bbSJeremy L Thompson 698980d4a7Sjeremylt call ceeddestroy(ceed,err) 70*52bfb9bbSJeremy L Thompson 718980d4a7Sjeremylt end 728980d4a7Sjeremylt!----------------------------------------------------------------------- 73