1 !----------------------------------------------------------------------- 2 subroutine build_mass(ctx, q, j, w, u3, u4, u5, u6, u7, u8, u9, u10, u11, u12, u13, u14, u15, u16,& 3 qdata, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14, v15, v16, ierr) 4 integer*8 ctx(2) 5 integer*8 fe_dim, space_dim 6 ! j is Jacobians with shape [dim, dim, Q] 7 ! w is quadrature weights with shape [1, Q] 8 real*8 j(1) 9 real*8 w(1) 10 ! qdata is quadrature data with shape [1, Q] 11 real*8 qdata(1) 12 integer q, ierr 13 14 fe_dim = ctx(1) 15 space_dim = ctx(2) 16 17 select case (fe_dim + 10*space_dim) 18 case (11) 19 do i = 1, q 20 qdata(i) = j(i) * w(i) 21 end do 22 23 case (22) 24 do i = 1, q 25 qdata(i) = (j(0*q + i)*j(3*q + i) - j(1*q + i)*j(2*q + i)) * w(i) 26 end do 27 28 case (33) 29 do i = 1, q 30 qdata(i) = (j(0*q + i) * (j(4*q + i)*j(8*q + i) - j(5*q + i)*j(7*q + i)) -& 31 &j(1*q + i) * (j(3*q + i)*j(8*q + i) - j(5*q + i)*j(6*q + i)) +& 32 &j(2*q + i) * (j(3*q + i)*j(7*q + i) - j(4*q + i)*j(6*q + i))) * w(i) 33 end do 34 end select 35 ierr = 0 36 end 37 38 !----------------------------------------------------------------------- 39 subroutine apply_mass(ctx, q, u, qdata, u3, u4, u5, u6, u7, u8, u9, u10, u11, u12, u13, u14, u15, u16,& 40 v, v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12, v13, v14, v15, v16, ierr) 41 integer*8 ctx 42 ! u is solution variables with shape [1, Q] 43 ! qdata is quadrature data with shape [1, Q] 44 real*8 u(1) 45 real*8 qdata(1) 46 ! v is solution variables with shape [1, Q] 47 real*8 v(1) 48 integer q, ierr 49 50 do i = 1, q 51 v(i) = qdata(i) * u(i) 52 end do 53 ierr = 0 54 end 55 !----------------------------------------------------------------------- 56