1!----------------------------------------------------------------------- 2! 3! Header with common subroutine 4! 5 include 't320-basis-f.h' 6! 7! Header with QFunctions 8! 9 include 't510-operator-f.h' 10!----------------------------------------------------------------------- 11 program test 12 implicit none 13 include 'ceedf.h' 14 15 integer ceed,err,i 16 integer stridesu(3) 17 integer erestrictx,erestrictu,erestrictui 18 integer bx,bu 19 integer qf_setup,qf_mass 20 integer op_setup,op_mass 21 integer qdata,x,u,v 22 integer nelem,p,q,d 23 integer val,row,col,offset 24 parameter(nelem=12) 25 parameter(p=6) 26 parameter(q=4) 27 parameter(d=2) 28 integer ndofs,nqpts,nx,ny 29 parameter(nx=3) 30 parameter(ny=2) 31 parameter(ndofs=(nx*2+1)*(ny*2+1)) 32 parameter(nqpts=nelem*q) 33 integer indx(nelem*p) 34 real*8 arrx(d*ndofs) 35 integer*8 voffset,xoffset 36 37 real*8 qref(d*q) 38 real*8 qweight(q) 39 real*8 interp(p*q) 40 real*8 grad(d*p*q) 41 42 real*8 hv(ndofs) 43 44 character arg*32 45 46 external setup,mass 47 48 call getarg(1,arg) 49 50 call ceedinit(trim(arg)//char(0),ceed,err) 51 52 do i=0,ndofs-1 53 arrx(i+1)=mod(i,(nx*2+1)) 54 arrx(i+1)=arrx(i+1)*(1.d0/(nx*2.d0)) 55 val=(i/(nx*2+1)) 56 arrx(i+1+ndofs)=val*(1.d0/(ny*2.d0)) 57 enddo 58 do i=0,5 59 col=mod(i,nx) 60 row=i/nx 61 offset=col*2+row*(nx*2+1)*2 62 63 indx(i*2*p+1)=2+offset 64 indx(i*2*p+2)=9+offset 65 indx(i*2*p+3)=16+offset 66 indx(i*2*p+4)=1+offset 67 indx(i*2*p+5)=8+offset 68 indx(i*2*p+6)=0+offset 69 70 indx(i*2*p+7)=14+offset 71 indx(i*2*p+8)=7+offset 72 indx(i*2*p+9)=0+offset 73 indx(i*2*p+10)=15+offset 74 indx(i*2*p+11)=8+offset 75 indx(i*2*p+12)=16+offset 76 enddo 77 78 call ceedelemrestrictioncreate(ceed,nelem,p,d,ndofs,d*ndofs,& 79 & ceed_mem_host,ceed_use_pointer,indx,erestrictx,err) 80 81 call ceedelemrestrictioncreate(ceed,nelem,p,1,1,ndofs,ceed_mem_host,& 82 & ceed_use_pointer,indx,erestrictu,err) 83 stridesu=[1,q,q] 84 call ceedelemrestrictioncreatestrided(ceed,nelem,q,1,nqpts,stridesu,& 85 & erestrictui,err) 86 87 call buildmats(qref,qweight,interp,grad) 88 call ceedbasiscreateh1(ceed,ceed_triangle,d,p,q,interp,grad,qref,qweight,& 89 & bx,err) 90 call buildmats(qref,qweight,interp,grad) 91 call ceedbasiscreateh1(ceed,ceed_triangle,1,p,q,interp,grad,qref,qweight,& 92 & bu,err) 93 94 call ceedqfunctioncreateinterior(ceed,1,setup,& 95 &SOURCE_DIR& 96 &//'t510-operator.h:setup'//char(0),qf_setup,err) 97 call ceedqfunctionaddinput(qf_setup,'_weight',1,ceed_eval_weight,err) 98 call ceedqfunctionaddinput(qf_setup,'x',d*d,ceed_eval_grad,err) 99 call ceedqfunctionaddoutput(qf_setup,'rho',1,ceed_eval_none,err) 100 101 call ceedqfunctioncreateinterior(ceed,1,mass,& 102 &SOURCE_DIR& 103 &//'t510-operator.h:mass'//char(0),qf_mass,err) 104 call ceedqfunctionaddinput(qf_mass,'rho',1,ceed_eval_none,err) 105 call ceedqfunctionaddinput(qf_mass,'u',1,ceed_eval_interp,err) 106 call ceedqfunctionaddoutput(qf_mass,'v',1,ceed_eval_interp,err) 107 108 call ceedoperatorcreate(ceed,qf_setup,ceed_qfunction_none,& 109 & ceed_qfunction_none,op_setup,err) 110 call ceedoperatorcreate(ceed,qf_mass,ceed_qfunction_none,& 111 & ceed_qfunction_none,op_mass,err) 112 113 call ceedvectorcreate(ceed,d*ndofs,x,err) 114 xoffset=0 115 call ceedvectorsetarray(x,ceed_mem_host,ceed_use_pointer,arrx,xoffset,err) 116 call ceedvectorcreate(ceed,nqpts,qdata,err) 117 118 call ceedoperatorsetfield(op_setup,'_weight',ceed_elemrestriction_none,& 119 & bx,ceed_vector_none,err) 120 call ceedoperatorsetfield(op_setup,'x',erestrictx,bx,& 121 & ceed_vector_active,err) 122 call ceedoperatorsetfield(op_setup,'rho',erestrictui,& 123 & ceed_basis_collocated,ceed_vector_active,err) 124 call ceedoperatorsetfield(op_mass,'rho',erestrictui,& 125 & ceed_basis_collocated,qdata,err) 126 call ceedoperatorsetfield(op_mass,'u',erestrictu,bu,& 127 & ceed_vector_active,err) 128 call ceedoperatorsetfield(op_mass,'v',erestrictu,bu,& 129 & ceed_vector_active,err) 130 131 call ceedoperatorapply(op_setup,x,qdata,ceed_request_immediate,err) 132 133 call ceedvectorcreate(ceed,ndofs,u,err) 134 call ceedvectorsetvalue(u,0.d0,err) 135 call ceedvectorcreate(ceed,ndofs,v,err) 136 call ceedoperatorapply(op_mass,u,v,ceed_request_immediate,err) 137 138 call ceedvectorgetarrayread(v,ceed_mem_host,hv,voffset,err) 139 do i=1,ndofs 140 if (abs(hv(voffset+i))>1.0d-10) then 141! LCOV_EXCL_START 142 write(*,*) '[',i,'] v ',hv(voffset+i),' != 0.0' 143! LCOV_EXCL_STOP 144 endif 145 enddo 146 call ceedvectorrestorearrayread(v,hv,voffset,err) 147 148 call ceedvectordestroy(qdata,err) 149 call ceedvectordestroy(x,err) 150 call ceedvectordestroy(u,err) 151 call ceedvectordestroy(v,err) 152 call ceedoperatordestroy(op_mass,err) 153 call ceedoperatordestroy(op_setup,err) 154 call ceedqfunctiondestroy(qf_mass,err) 155 call ceedqfunctiondestroy(qf_setup,err) 156 call ceedbasisdestroy(bu,err) 157 call ceedbasisdestroy(bx,err) 158 call ceedelemrestrictiondestroy(erestrictu,err) 159 call ceedelemrestrictiondestroy(erestrictx,err) 160 call ceedelemrestrictiondestroy(erestrictui,err) 161 call ceeddestroy(ceed,err) 162 end 163!----------------------------------------------------------------------- 164