Lines Matching full:1
10 C_TESTARGS(name="BP1") -c {ceed_resource} -e bp1 -n 1 -b 4 -test
11 C_TESTARGS(name="BP3") -c {ceed_resource} -e bp3 -n 1 -b 4 -test
20 real*8 ctx(1)
31 do i=1,q
36 a21=u2(i+q*1)
64 $ +u1(i+q*1)*u1(i+q*1)
77 real*8 ctx(1)
83 do i=1,q
96 real*8 ctx(1)
108 do i=1,q
111 c(1)=0.
112 c(2)=1.
114 k(1)=1.
122 a21=u2(i+q*1)
149 C 5 1 3
152 v1(i+1*q) = scl*(g21*g21+g22*g22+g23*g23) ! Gss
160 $ *dsin(pi*(c(1)+k(1)*u1(i+0*q)))
161 $ *dsin(pi*(c(2)+k(2)*u1(i+1*q)))
163 $ *(k(1)*k(1)+k(2)*k(2)+k(3)*k(3))
176 real*8 ctx(1)
182 do i=1,q
185 v1(i+1*q)=
186 $ u2(i+5*q)*u1(i)+u2(i+1*q)*u1(i+q)+u2(i+3*q)*u1(i+2*q)
198 real*8 h2(1),bmq(1)
208 do e=1,lelt
209 do i=1,nxq**ldim
210 L=L+1
224 real*8 e(1)
228 do i=1,n
229 x=xm1(i,1,1,1)
230 y=ym1(i,1,1,1)
231 z=zm1(i,1,1,1)
247 real*8 e(1)
253 c(1)=0.
254 c(2)=1.
256 k(1)=1.
260 do i=1,n
261 x=xm1(i,1,1,1)
262 y=ym1(i,1,1,1)
263 z=zm1(i,1,1,1)
265 e(i) = dsin(pi*(c(1)+k(1)*x))
360 x1 = 1
365 param(59)=1 ! Force Nek to use the "deformed element" formulation
382 real*8 r1(1),h2(1)
385 do i=1,n
401 do i=1,n
409 dmx = glmax(dmx,1) ! max across processors
410 xmx = glmax(xmx,1)
428 m1 = N+1
448 m1 = N+1
464 C Routine to generate elemental geometric matrices on mesh 1
469 parameter (lg=3+3*(ldim-2),lzq=lx1+1,lxyd=lzq**ldim)
491 do k=1,nxq
492 do j=1,nxq
493 do i=1,nxq
500 nxqm1 = lzq-1
502 do e=1,nelt
503 call intp_rstd (tmp,xm1(1,1,1,e),lx1,lzq,if3d,0) ! 0-->Fwd interpolation
506 call intp_rstd (tmp,ym1(1,1,1,e),lx1,lzq,if3d,0)
509 call intp_rstd (tmp,zm1(1,1,1,e),lx1,lzq,if3d,0)
512 do i=1,nxyzq
539 bmq(i,e) = w3mq(i,1,1)*jacmq
540 scale = w3mq(i,1,1)/jacmq
542 gf(1,i,e) = scale*(g11*g11+g12*g12+g13*g13) ! Grr
582 do 1000 e=1,nel
584 call rzero(d(1,1,1,e),nxyz)
586 do 320 iz=1,lz1
587 do 320 iy=1,ly1
588 do 320 ix=1,lx1
589 do 320 iq=1,lx1
591 $ + gf(1,iq,iy,iz,e) * dxm1(iq,ix)**2
600 do i2=1,ly1,ly1-1
601 do i1=1,lx1,lx1-1
602 d(1,i1,i2,e) = d(1,i1,i2,e)
603 $ + gf(4,1,i1,i2,e) * dxtm1(1,1)*dytm1(i1,i1)
604 $ + gf(5,1,i1,i2,e) * dxtm1(1,1)*dztm1(i2,i2)
608 d(i1,1,i2,e) = d(i1,1,i2,e)
609 $ + gf(4,i1,1,i2,e) * dytm1(1,1)*dxtm1(i1,i1)
610 $ + gf(6,i1,1,i2,e) * dytm1(1,1)*dztm1(i2,i2)
614 d(i1,i2,1,e) = d(i1,i2,1,e)
615 $ + gf(5,i1,i2,1,e) * dztm1(1,1)*dxtm1(i1,i1)
616 $ + gf(6,i1,i2,1,e) * dztm1(1,1)*dytm1(i2,i2)
625 do i=1,lxyz
626 d(i,1,1,e)=d(i,1,1,e)*h1(i,e)+h2(i,e)*bm1(i,1,1,e)
634 do 1200 e=1,nel
635 if (ifrzer(e)) call mxm(ym1(1,1,1,e),lx1,datm1,ly1,ysm1,1)
637 do 1190 j=1,ly1
638 do 1190 i=1,lx1
639 k=k+1
640 if (ym1(i,j,1,e).ne.0.) then
641 term1 = bm1(i,j,1,e)/ym1(i,j,1,e)**2
643 term2 = wxm1(i)*wam1(1)*dam1(1,j)
644 $ *jacm1(i,1,1,e)/ysm1(i)
648 d(i,j,1,e) = d(i,j,1,e) + h1(k,e)*(term1+term2)
657 if (nio.eq.0) write(6,1) n,d(1,1,1,1),h1(1,1),h2(1,1),bm1(1,1,1,1)
658 1 format(i9,1p4e12.4,' diag prec')
685 if (bp==1) then
704 parameter (lzq=lx1+1)
732 ifield = 1
733 nxq = nx1+1
740 do j=0,nelt-1
741 do i=1,lx
742 ii=ii+1
743 x = xm1(ii,1,1,1)
744 y = ym1(ii,1,1,1)
745 z = zm1(ii,1,1,1)
747 coords(i+1*lx+3*j*lx)=y
767 tol = 1e-10
775 q=p+1
776 ncompu=1
786 stridesx=[1,enode,enode*ldim]
789 stridesu=[1,enode,enode*ncompu]
793 $ 1,nelt*q**ldim,ceed_strides_backend,erstrctw,err)
807 call ceedqfunctioncreateinterior(ceed,1,masssetupf,
821 call ceedqfunctioncreateinterior(ceed,1,massf,
891 if (test.eq.1.and.nid.eq.0) then
900 nx = nx1-1
909 if (nid.eq.0) write(6,1) 'case scalar:'
926 if (test.eq.1.and.nid.eq.0) then
930 if (dabs(er1)>1e-5) then
935 nx = nx1-1
944 if (nid.eq.0) write(6,1) 'case scalar:'
961 if (test.eq.1.and.nid.eq.0) then
965 if (dabs(er1)>1e-5) then
970 nx = nx1-1
979 if (nid.eq.0) write(6,1) 'case scalar:'
982 1 format(a12,i7,i3,i7,i10,i14,i10,i4,1p4e13.5)
983 3 format(i3,i9,e12.4,1x,a8,i9)
1013 parameter (lzq=lx1+1)
1042 ifield = 1
1043 nxq = nx1+1
1050 do j=0,nelt-1
1051 do i=1,lx
1052 ii=ii+1
1053 x = xm1(ii,1,1,1)
1054 y = ym1(ii,1,1,1)
1055 z = zm1(ii,1,1,1)
1057 coords(i+1*lx+3*j*lx)=y
1059 if ( x.eq.0.or.x.eq.1
1060 $ .or.y.eq.0.or.y.eq.1
1061 $ .or.z.eq.0.or.z.eq.1 ) then
1064 h2(ii)=1.
1084 tol = 1e-10
1092 q=p+1
1093 ncompu=1
1103 ngeo=(ldim*(ldim+1))/2
1104 stridesx=[1,enode,enode*ldim]
1107 stridesu=[1,enode,enode*ncompu]
1110 stridesw=[1,q**ldim,ngeo*q**ldim]
1126 call ceedqfunctioncreateinterior(ceed,1,diffsetupf,
1140 call ceedqfunctioncreateinterior(ceed,1,diffusionf,
1213 if (test.eq.1.and.nid.eq.0) then
1217 if (dabs(er1)>1e-3) then
1222 nx = nx1-1
1231 if (nid.eq.0) write(6,1) 'case scalar:'
1248 if (test.eq.1.and.nid.eq.0) then
1252 if (dabs(er1)>1e-9) then
1257 nx = nx1-1
1266 if (nid.eq.0) write(6,1) 'case scalar:'
1283 if (test.eq.1.and.nid.eq.0) then
1287 if (dabs(er1)>1e-9) then
1292 nx = nx1-1
1301 if (nid.eq.0) write(6,1) 'case scalar:'
1304 1 format(a12,i7,i3,i7,i10,i14,i10,i4,1p4e13.5)
1305 3 format(i3,i9,e12.4,1x,a8,i9)
1345 real*8 rmult(1),binv(1)
1357 nx = nx1-1 ! Polynomial order (just for i/o)
1369 wv(1)=0
1370 do i=1,n
1371 s=rmult(i) ! -1
1373 wv(1)=wv(1)+s*p1(i)*r1(i) ! r p
1375 call gop(wv(1),wk,'+ ',1)
1376 rpp1(1) = wv (1)
1378 do 1000 iter=1,maxit
1384 call gop (pap,wk,'+ ',1)
1385 alph(1) = rpp1(1)/pap(1)
1387 do i=1,n
1388 u1(i)=u1(i)+alph(1)* p1(i)
1389 r1(i)=r1(i)-alph(1)*ap1(i)
1394 do i=1,n
1395 wv(1)=wv(1)+r1(i)*r1(i) ! L2 error estimate
1401 C if (nio.eq.0) write(6,1) ifield,istep,iter,nx,(wv(k),k=1,1)
1402 1 format(i2,i9,i5,i4,1p1e12.4,' cggos')
1404 enorm=sqrt(wv(1))
1410 C if (nio.eq.0) write(6,2) iter,enorm,alph(1),pap(1),'alpha'
1411 2 format(i5,1p3e12.4,2x,a5)
1413 rpp2(1)=rpp1(1)
1414 rpp1(1)=wv (2)
1415 beta1 =rpp1(1)/rpp2(1)
1416 do i=1,n
1422 rbnorm=sqrt(wv(1))
1424 iter = iter-1
1430 3000 format(i12,1x,'cggo scalar:',i6,1p5e13.4)
1431 3001 format(2i6,' Unconverged cggo scalar: rbnorm =',1p2e13.6)
1470 pap(1)=0.
1472 do e=1,nelt
1473 do i=1,lx
1474 pap(1)=pap(1)+ap1(i,e)*p1(i,e)
1491 nxq = nx1+1 ! Number of quadrature points
1496 do i=1,lxyzq
1499 call intp_rstd (w,ju,lx1,nxq,if3d,1) ! 1 --> ju-->u
1524 pap(1)=0.
1526 k=1
1527 nxq = nx1+1
1529 do e=1,nelt
1531 call ax_e_bp1(ap1(1,e),p1(1,e),gf(1,1,e),h1(1,e),h2(k,1)
1532 $ ,bm1(1,1,1,e),ur,us,ut)
1533 do i=1,lx
1534 pap(1)=pap(1)+ap1(i,e)*p1(i,e)
1549 parameter (lzq=lx1+1,lxyz=lx1*lx1*lx1,lxyzq=lzq*lzq*lzq)
1557 n = lzq-1
1562 do i=1,lxyzq
1563 wr = g(1,i)*ur(i) + g(2,i)*us(i) + g(3,i)*ut(i)
1572 call intp_rstd (w,wk,lx1,lzq,if3d,1) ! 1 --> ju-->u
1583 parameter (lzq=lx1+1)
1597 pap(1)=0.
1599 do e=1,nelt
1601 call ax_e_bp3(ap1(1,e),p1(1,e),gf(1,1,e),ur,us,ut,wk)
1602 do i=1,lx
1603 pap(1)=pap(1)+p1(i,e)*ap1(i,e)
1647 if(iargc().ge.1) then
1648 call getarg(1,bpval)
1651 bp=1
1684 test=1