1!----------------------------------------------------------------------- 2 program test 3 4 include 'ceedf.h' 5 6 integer ceed,err 7 integer b 8 real*8 colograd1d(16), colograd1d2(36) 9 10 character arg*32 11 12 call getarg(1,arg) 13 14 call ceedinit(trim(arg)//char(0),ceed,err) 15 16! Already collocated, GetCollocatedGrad will return grad1d 17 call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss_lobatto,b,& 18 & err) 19 call ceedbasisgetcollocatedgrad(b,colograd1d,err) 20 call ceedbasisview(b,err) 21 do i=1,16 22 if (abs(colograd1d(i))<1.0D-14) then 23 colograd1d(i) = 0 24 endif 25 enddo 26 do i=0,3 27 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 28 & 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4) 29 call flush(6) 30 enddo 31 call ceedbasisdestroy(b,err) 32 33! Q = P, not already collocated 34 call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss,b,err) 35 call ceedbasisgetcollocatedgrad(b,colograd1d,err) 36 call ceedbasisview(b,err) 37 do i=1,16 38 if (abs(colograd1d(i))<1.0D-14) then 39! LCOV_EXCL_START 40 colograd1d(i) = 0 41! LCOV_EXCL_STOP 42 endif 43 enddo 44 do i=0,3 45 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 46 & 'colograd[',i,']:',(colograd1d(j+4*i),j=1,4) 47 call flush(6) 48 enddo 49 call ceedbasisdestroy(b,err) 50 51! Q = P + 2, not already collocated 52 call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,ceed_gauss,b,err) 53 call ceedbasisgetcollocatedgrad(b,colograd1d2,err) 54 call ceedbasisview(b,err) 55 do i=1,36 56 if (abs(colograd1d2(i))<1.0D-14) then 57! LCOV_EXCL_START 58 colograd1d2(i) = 0 59! LCOV_EXCL_STOP 60 endif 61 enddo 62 do i=0,5 63 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 64 & 'colograd[',i,']:',(colograd1d2(j+6*i),j=1,6) 65 call flush(6) 66 enddo 67 call ceedbasisdestroy(b,err) 68 69 call ceeddestroy(ceed,err) 70 71 end 72!----------------------------------------------------------------------- 73