1 ! Copyright (c) 2017-2025, Lawrence Livermore National Security, LLC and other CEED contributors. 2 ! All Rights Reserved. See the top-level LICENSE and NOTICE files for details. 3 ! 4 ! SPDX-License-Identifier: BSD-2-Clause 5 ! 6 ! This file is part of CEED: http://github.com/ceed 7 ! 8 !----------------------------------------------------------------------- 9 subroutine buildmats(qref,qweight,interp,grad) 10 integer p,q,d 11 parameter(p=6) 12 parameter(q=4) 13 parameter(d=2) 14 15 real*8 qref(d*q) 16 real*8 qweight(q) 17 real*8 interp(p*q) 18 real*8 grad(d*p*q) 19 real*8 x1,x2 20 21 qref=(/2.d-1,6.d-1,1.d0/3.d0,2.d-1,2.d-1,2.d-1,1.d0/3.d0,6.d-1/) 22 qweight=(/25.d0/96.d0,25.d0/96.d0,-27.d0/96.d0,25.d0/96.d0/) 23 24 do i=0,q-1 25 x1 = qref(0*q+i+1) 26 x2 = qref(1*q+i+1); 27 ! Interp 28 interp(i*P+1)=2.*(x1+x2-1.)*(x1+x2-1./2.); 29 interp(i*P+2)=-4.*x1*(x1+x2-1.); 30 interp(i*P+3)=2.*x1*(x1-1./2.); 31 interp(i*P+4)=-4.*x2*(x1+x2-1.); 32 interp(i*P+5)=4.*x1*x2; 33 interp(i*P+6)=2.*x2*(x2-1./2.); 34 ! Grad 35 grad((i+0)*P+1)=2.*(1.*(x1+x2-1./2.)+(x1+x2-1.)*1.); 36 grad((i+Q)*P+1)=2.*(1.*(x1+x2-1./2.)+(x1+x2-1.)*1.); 37 grad((i+0)*P+2)=-4.*(1.*(x1+x2-1.)+x1*1.); 38 grad((i+Q)*P+2)=-4.*(x1*1.); 39 grad((i+0)*P+3)=2.*(1.*(x1-1./2.)+x1*1.); 40 grad((i+Q)*P+3)=2.*0.; 41 grad((i+0)*P+4)=-4.*(x2*1.); 42 grad((i+Q)*P+4)=-4.*(1.*(x1+x2-1.)+x2*1.); 43 grad((i+0)*P+5)=4.*(1.*x2); 44 grad((i+Q)*P+5)=4.*(x1*1.); 45 grad((i+0)*P+6)=2.*0.; 46 grad((i+Q)*P+6)=2.*(1.*(x2-1./2.)+x2*1.); 47 enddo 48 49 end 50 !----------------------------------------------------------------------- 51