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