1!----------------------------------------------------------------------- 2 program test 3 implicit none 4 include 'ceed/fortran.h' 5 6 integer ceed,err,i,j 7 integer b 8 real*8 collograd1d(16), collograd1d2(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,collograd1d,err) 20 do i=1,16 21 if (abs(collograd1d(i))<1.0D-14) then 22 collograd1d(i) = 0 23 endif 24 enddo 25 do i=0,3 26 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 27 & 'collograd[',i,']:',(collograd1d(j+4*i),j=1,4) 28 call flush(6) 29 enddo 30 call ceedbasisdestroy(b,err) 31 32! Q = P, not already collocated 33 call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,4,ceed_gauss,b,err) 34 call ceedbasisgetcollocatedgrad(b,collograd1d,err) 35 do i=1,16 36 if (abs(collograd1d(i))<1.0D-14) then 37! LCOV_EXCL_START 38 collograd1d(i) = 0 39! LCOV_EXCL_STOP 40 endif 41 enddo 42 do i=0,3 43 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 44 & 'collograd[',i,']:',(collograd1d(j+4*i),j=1,4) 45 call flush(6) 46 enddo 47 call ceedbasisdestroy(b,err) 48 49! Q = P + 2, not already collocated 50 call ceedbasiscreatetensorh1lagrange(ceed,1,1,4,6,ceed_gauss,b,err) 51 call ceedbasisgetcollocatedgrad(b,collograd1d2,err) 52 do i=1,36 53 if (abs(collograd1d2(i))<1.0D-14) then 54! LCOV_EXCL_START 55 collograd1d2(i) = 0 56! LCOV_EXCL_STOP 57 endif 58 enddo 59 do i=0,5 60 write(*,'(A,I1,A,F12.8,F12.8,F12.8,F12.8,F12.8,F12.8)')& 61 & 'collograd[',i,']:',(collograd1d2(j+6*i),j=1,6) 62 call flush(6) 63 enddo 64 call ceedbasisdestroy(b,err) 65 66 call ceeddestroy(ceed,err) 67 68 end 69!----------------------------------------------------------------------- 70