bps.usr (77ad9f2917358ad654845919921e911aaeeffe6e) bps.usr (dc8efd83546faf0200bf0bfcfb1678fae1874cc5)
1C Copyright (c) 2017, Lawrence Livermore National Security, LLC. Produced at
2C the Lawrence Livermore National Laboratory. LLNL-CODE-734707. All Rights
3C reserved. See files LICENSE and NOTICE for details.
4C
5C This file is part of CEED, a collection of benchmarks, miniapps, software
6C libraries and APIs for efficient high-order finite element and spectral
7C element discretizations for exascale applications. For more information and
8C source code availability see http://github.com/ceed.
9C
10C The CEED research is supported by the Exascale Computing Project (17-SC-20-SC)
11C a collaborative effort of two U.S. Department of Energy organizations (Office
12C of Science and the National Nuclear Security Administration) responsible for
13C the planning and preparation of a capable exascale ecosystem, including
14C software, applications, hardware, advanced system engineering and early
15C testbed platforms, in support of the nation's exascale computing imperative.
16
17C> @file
18C> Mass and diffusion operators examples using Nek5000
1C Copyright (c) 2017, Lawrence Livermore National Security, LLC. Produced at
2C the Lawrence Livermore National Laboratory. LLNL-CODE-734707. All Rights
3C reserved. See files LICENSE and NOTICE for details.
4C
5C This file is part of CEED, a collection of benchmarks, miniapps, software
6C libraries and APIs for efficient high-order finite element and spectral
7C element discretizations for exascale applications. For more information and
8C source code availability see http://github.com/ceed.
9C
10C The CEED research is supported by the Exascale Computing Project (17-SC-20-SC)
11C a collaborative effort of two U.S. Department of Energy organizations (Office
12C of Science and the National Nuclear Security Administration) responsible for
13C the planning and preparation of a capable exascale ecosystem, including
14C software, applications, hardware, advanced system engineering and early
15C testbed platforms, in support of the nation's exascale computing imperative.
16
17C> @file
18C> Mass and diffusion operators examples using Nek5000
19C_TESTARGS -c {ceed_resource} -e bp1 -n 1 -b 4 -test
20C_TESTARGS -c {ceed_resource} -e bp3 -n 1 -b 4 -test
19C_TESTARGS(name="BP1") -c {ceed_resource} -e bp1 -n 1 -b 4 -test
20C_TESTARGS(name="BP3") -c {ceed_resource} -e bp3 -n 1 -b 4 -test
21
22C-----------------------------------------------------------------------
23 subroutine masssetupf(ctx,q,u1,u2,u3,u4,u5,u6,u7,
24 $ u8,u9,u10,u11,u12,u13,u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,
25 $ v9,v10,v11,v12,v13,v14,v15,v16,ierr)
26C Set up mass operator
27C Input: u1,u2,u3,q Output: v1,v2,ierr
28 integer q,ierr

--- 134 unchanged lines hidden (view full) ---

163 v1(i+3*q) = scl*(g21*g31+g22*g32+g23*g33) ! Gst
164 v1(i+4*q) = scl*(g11*g31+g12*g32+g13*g33) ! Grt
165 v1(i+5*q) = scl*(g11*g21+g12*g22+g13*g23) ! Grs
166
167C RHS
168 v2(i) = u3(i)*jacmq*pi*pi
169 $ *dsin(pi*(c(1)+k(1)*u1(i+0*q)))
170 $ *dsin(pi*(c(2)+k(2)*u1(i+1*q)))
21
22C-----------------------------------------------------------------------
23 subroutine masssetupf(ctx,q,u1,u2,u3,u4,u5,u6,u7,
24 $ u8,u9,u10,u11,u12,u13,u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,
25 $ v9,v10,v11,v12,v13,v14,v15,v16,ierr)
26C Set up mass operator
27C Input: u1,u2,u3,q Output: v1,v2,ierr
28 integer q,ierr

--- 134 unchanged lines hidden (view full) ---

163 v1(i+3*q) = scl*(g21*g31+g22*g32+g23*g33) ! Gst
164 v1(i+4*q) = scl*(g11*g31+g12*g32+g13*g33) ! Grt
165 v1(i+5*q) = scl*(g11*g21+g12*g22+g13*g23) ! Grs
166
167C RHS
168 v2(i) = u3(i)*jacmq*pi*pi
169 $ *dsin(pi*(c(1)+k(1)*u1(i+0*q)))
170 $ *dsin(pi*(c(2)+k(2)*u1(i+1*q)))
171 $ *dsin(pi*(c(3)+k(3)*u1(i+2*q)))
172 $ *(k(1)*k(1)+k(2)*k(2)+k(3)*k(3))
171 $ *dsin(pi*(c(3)+k(3)*u1(i+2*q)))
172 $ *(k(1)*k(1)+k(2)*k(2)+k(3)*k(3))
173
174 enddo
175
176 ierr=0
177 end
178C-----------------------------------------------------------------------
179 subroutine diffusionf(ctx,q,u1,u2,u3,u4,u5,u6,u7,
180 $ u8,u9,u10,u11,u12,u13,u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,

--- 267 unchanged lines hidden (view full) ---

448c-----------------------------------------------------------------------
449 subroutine loc_grad3t(u,ur,us,ut,N,D,Dt,w)
450C 3D transpose of local gradient
451C Input: ur,us,ut,N,D,Dt Output: u
452 real*8 u (0:N,0:N,0:N)
453 real*8 ur(0:N,0:N,0:N),us(0:N,0:N,0:N),ut(0:N,0:N,0:N)
454 real*8 D (0:N,0:N),Dt(0:N,0:N)
455 real*8 w (0:N,0:N,0:N)
173
174 enddo
175
176 ierr=0
177 end
178C-----------------------------------------------------------------------
179 subroutine diffusionf(ctx,q,u1,u2,u3,u4,u5,u6,u7,
180 $ u8,u9,u10,u11,u12,u13,u14,u15,u16,v1,v2,v3,v4,v5,v6,v7,v8,

--- 267 unchanged lines hidden (view full) ---

448c-----------------------------------------------------------------------
449 subroutine loc_grad3t(u,ur,us,ut,N,D,Dt,w)
450C 3D transpose of local gradient
451C Input: ur,us,ut,N,D,Dt Output: u
452 real*8 u (0:N,0:N,0:N)
453 real*8 ur(0:N,0:N,0:N),us(0:N,0:N,0:N),ut(0:N,0:N,0:N)
454 real*8 D (0:N,0:N),Dt(0:N,0:N)
455 real*8 w (0:N,0:N,0:N)
456
456
457 m1 = N+1
458 m2 = m1*m1
459 m3 = m1*m1*m1
457 m1 = N+1
458 m2 = m1*m1
459 m3 = m1*m1*m1
460
460
461 call mxm(Dt,m1,ur,m1,u(0,0,0),m2)
462 do k=0,N
463 call mxm(us(0,0,k),m1,D ,m1,w(0,0,k),m1)
464 enddo
465 call add2(u(0,0,0),w,m3)
466 call mxm(ut,m2,D ,m1,w,m1)
467 call add2(u(0,0,0),w,m3)
468

--- 680 unchanged lines hidden (view full) ---

1149 call ceedqfunctioncreateinterior(ceed,1,diffusionf,
1150 $ EXAMPLE_DIR
1151 $ //'bps/bps.h:diffusionf'//char(0),qf_diffusion,err)
1152 call ceedqfunctionaddinput(qf_diffusion,'u',ncompu*ldim,
1153 $ ceed_eval_grad,err)
1154 call ceedqfunctionaddinput(qf_diffusion,'qdata',ngeo,
1155 $ ceed_eval_none,err)
1156 call ceedqfunctionaddoutput(qf_diffusion,'v',ncompu*ldim,
461 call mxm(Dt,m1,ur,m1,u(0,0,0),m2)
462 do k=0,N
463 call mxm(us(0,0,k),m1,D ,m1,w(0,0,k),m1)
464 enddo
465 call add2(u(0,0,0),w,m3)
466 call mxm(ut,m2,D ,m1,w,m1)
467 call add2(u(0,0,0),w,m3)
468

--- 680 unchanged lines hidden (view full) ---

1149 call ceedqfunctioncreateinterior(ceed,1,diffusionf,
1150 $ EXAMPLE_DIR
1151 $ //'bps/bps.h:diffusionf'//char(0),qf_diffusion,err)
1152 call ceedqfunctionaddinput(qf_diffusion,'u',ncompu*ldim,
1153 $ ceed_eval_grad,err)
1154 call ceedqfunctionaddinput(qf_diffusion,'qdata',ngeo,
1155 $ ceed_eval_none,err)
1156 call ceedqfunctionaddoutput(qf_diffusion,'v',ncompu*ldim,
1157 $ ceed_eval_grad,err)
1157 $ ceed_eval_grad,err)
1158
1159C Create ceed operators
1160 call ceedoperatorcreate(ceed,qf_setup,
1161 $ ceed_qfunction_none,ceed_qfunction_none,op_setup,err)
1162 call ceedoperatorsetfield(op_setup,'x',erstrctx,
1163 $ basisx,ceed_vector_active,err)
1164 call ceedoperatorsetfield(op_setup,'dx',erstrctx,
1165 $ basisx,ceed_vector_active,err)

--- 534 unchanged lines hidden ---
1158
1159C Create ceed operators
1160 call ceedoperatorcreate(ceed,qf_setup,
1161 $ ceed_qfunction_none,ceed_qfunction_none,op_setup,err)
1162 call ceedoperatorsetfield(op_setup,'x',erstrctx,
1163 $ basisx,ceed_vector_active,err)
1164 call ceedoperatorsetfield(op_setup,'dx',erstrctx,
1165 $ basisx,ceed_vector_active,err)

--- 534 unchanged lines hidden ---