Feature-support passive scalar (#172)

code/MOR

@@ -12,7 +12,7 @@ c     parameters and common blocks for MOR
      $                  wb(lx1*ly1*lz1*lelm,0:lub),
      $                  uvwb(lx1*ly1*lz1*lelm,ldim,0:lub),
      $                  pb(lx2*ly2*lz2*lelm,0:lpb),
-     $                  tb(lx1*ly1*lz1*lelm,0:ltb)
+     $                  tb(lx1*ly1*lz1*lelm,0:ltb,ldimt)
 
       common /moric/ uic(lx1*ly1*lz1*lelm),
      $               vic(lx1*ly1*lz1*lelm),
@@ -25,7 +25,7 @@ c     parameters and common blocks for MOR
 
       common /morusnap/ us0(lx1*ly1*lz1*lelm,ldim,lsu)
       common /morpsnap/ prs(lx2*ly2*lz2*lelm,lsp)
-      common /mortsnap/ ts0(lx1*ly1*lz1*lelm,lst)
+      common /mortsnap/ ts0(lx1*ly1*lz1*lelm,lst,ldimt)
 
       common /morsnaptmp/ snapt(lx1*ly1*lz1*lelm,ldim,lsu)
 
@@ -166,8 +166,9 @@ c     parameters and common blocks for MOR
       ! Flags
 
       logical ifl2,ifvort,ifstep,ifpart,ifavg0,ifplay,
-     $        ifcdrag,ifrms,ifread,ifreads(3),ifforce,ifpod(0:ldimt1),
-     $        ifbuoy,ifrom(0:ldimt1),ifcintp,iffastc,ifcnuss,ifctke,
+     $        ifcdrag,ifrms,ifread,ifreads(0:ldimt1),ifforce,
+     $        ifpod(0:ldimt1),ifbuoy,ifrom(0:ldimt1),
+     $        ifcintp,iffastc,ifcnuss,ifctke,
      $        iffasth,ifavisc,ifsource,ifei,ifsub0,ifrecon,iftneu,
      $        ifdecpl,ifcore,ifquad,ifhelm,ifsrct,iftflux,ifcomb,ifpb,
      $        ifcp,ifcflow

code/ana.f

@@ -420,8 +420,8 @@ subroutine snap_analysis
 
 
          if (ifpod(2)) then
-            call ps2b(ut,ts0(1,j),tb) 
-            call add2(ts0(1,j),tb,n)
+            call ps2b(ut,ts0(1,j,1),tb)
+            call add2(ts0(1,j,1),tb,n)
          endif
 
          nio = nid
@@ -432,7 +432,7 @@ subroutine snap_analysis
          call opcopy(t1,t2,t3,us0(1,1,j),us0(1,2,j),us0(1,ldim,j))
          energy=op_glsc2_wt(t1,t2,t3,t1,t2,t3,bm1)
 
-         if (ifpod(2)) call copy(t4,ts0(1,j),n)
+         if (ifpod(2)) call copy(t4,ts0(1,j,1),n)
 
          ttmp = time
          itmp = istep
@@ -457,7 +457,7 @@ subroutine snap_analysis
             s=-ut(i)
             ss = 0
             if (ifpod(2)) then
-               call add2s2(t4,tb(1,i),s,n)
+               call add2s2(t4,tb(1,i,1),s,n)
                do ii=1,n
                   ss=ss+bm1(ii,1,1,1)*(t4(ii)*t4(ii))
                enddo
@@ -503,7 +503,7 @@ subroutine tj_analysis
       npts=128
 
       do i=0,nb
-         call sol_intp_xline_qoi(ub(1,i),vb(1,i),wb(1,i),tb(1,i),
+         call sol_intp_xline_qoi(ub(1,i),vb(1,i),wb(1,i),tb(1,i,1),
      $                           2.5,0.,128,i)
       enddo
 

code/aux.f

@@ -28,7 +28,7 @@ subroutine recont(tt,coef)
       call rzero(tt,n)
 
       do i=0,nb
-         call add2s2(tt,tb(1,i),coef(i),n)
+         call add2s2(tt,tb(1,i,1),coef(i),n)
       enddo
 
       return
@@ -51,7 +51,7 @@ subroutine recont_rms(tt)
 
       do j=0,nb
       do i=0,nb
-         call col3(tbt,tb(1,i),tb(1,j),n)
+         call col3(tbt,tb(1,i,1),tb(1,j,1),n)
          call add2s2(tt,tbt,ut2a(1+i+(nb+1)*j),n)
       enddo
       enddo
@@ -371,7 +371,7 @@ subroutine add_sol(vx,vy,vz,pr,t,ux,uy,uz,pp,tt)
       call opadd2(vx,vy,vz,ux,uy,uz)
       call add2(pr,pp,lx2*ly2*lz2*nelv)
 
-      do idim=1,1
+      do idim=1,ldimt
          call add2(t(1,idim),tt(1,idim),lx1*ly1*lz1*nelt)
       enddo
 
@@ -874,10 +874,10 @@ subroutine dump_sfld
          call opzero(ux1,uy1,uz1)
          do j=0,nb
          do i=0,nb
-            call admcol3(ux1,ub(1,i),tb(1,j),uuta(1+i+(nb+1)*j),n)
-            call admcol3(uy1,vb(1,i),tb(1,j),uuta(1+i+(nb+1)*j),n)
+            call admcol3(ux1,ub(1,i),tb(1,j,1),uuta(1+i+(nb+1)*j),n)
+            call admcol3(uy1,vb(1,i),tb(1,j,1),uuta(1+i+(nb+1)*j),n)
             if (ldim.eq.3)
-     $         call admcol3(uz1,wb(1,i),tb(1,j),uuta(1+i+(nb+1)*j),n)
+     $         call admcol3(uz1,wb(1,i),tb(1,j,1),uuta(1+i+(nb+1)*j),n)
          enddo
          enddo
          call outpost(ux1,uy1,uz1,pr,tt,'tmn')
@@ -1418,7 +1418,7 @@ subroutine k_mean(k,nsu,nsp,nst,fn,seed)
                label(i) = j
             endif
          enddo
-         call copy(cent_fld(1,i),ts0(1,label(i)),n)
+         call copy(cent_fld(1,i),ts0(1,label(i),1),n)
       enddo
 
       ! minimize distortion measure
@@ -1428,7 +1428,7 @@ subroutine k_mean(k,nsu,nsp,nst,fn,seed)
          call rzero(rnk,ls*k)
          do i=1,ls
             do j=1,k
-              call sub3(tmp(1,j),ts0(1,i),cent_fld(1,j),n)
+              call sub3(tmp(1,j),ts0(1,i,1),cent_fld(1,j),n)
               dist(j) = glsc2(tmp(1,j),tmp(1,j),n)
             enddo
             write(6,*)ls,minloc(dist),sample(i)
@@ -1459,7 +1459,7 @@ subroutine k_mean(k,nsu,nsp,nst,fn,seed)
          do i=1,k
             call rzero(cent_fld,n*k)
             do j=1,ls
-               call add2s2(cent_fld(1,i),ts0(1,j),rnk(j,i),n)
+               call add2s2(cent_fld(1,i),ts0(1,j,1),rnk(j,i),n)
             enddo
             call cmult(cent_fld(1,i),1./num_sc(i),n)
             centroid(i) = glsc2(sample,rnk(1,i),ls)/num_sc(i)
@@ -1476,7 +1476,7 @@ subroutine k_mean(k,nsu,nsp,nst,fn,seed)
                   label(i) = j
                endif
             enddo
-            call copy(cent_fld(1,i),ts0(1,label(i)),n)
+            call copy(cent_fld(1,i),ts0(1,label(i),1),n)
          enddo
          call c_distortion_measure(obj_f,cent_fld,rnk,k)
          write(6,*)kk,obj_f,'distortion measure M'
@@ -1534,7 +1534,7 @@ subroutine c_distortion_measure(obj_f,cent_fld,rnk,k)
       do i=1,ls
          do j=1,k
             if (abs(rnk(i,j)-1).le.1e-8) then
-               call sub3(tmp(1,j),ts0(1,i),cent_fld(1,j),n)
+               call sub3(tmp(1,j),ts0(1,i,1),cent_fld(1,j),n)
                dist(j) = glsc2(tmp(1,j),tmp(1,j),n)
                obj_f = obj_f + dist(j)
             endif
@@ -1581,8 +1581,8 @@ subroutine projtoprerb(nocp,uuk,ttk)
       do j=1,ns
       ttk(0,j) = 1.
       do i=1,nocp
-         ww=sip(tb(1,i),tb(1,i))
-         vv=sip(tb(1,i),ts0(1,j))
+         ww=sip(tb(1,i,1),tb(1,i,1))
+         vv=sip(tb(1,i,1),ts0(1,j,1))
          ttk(i,j) = vv/ww
       enddo
       enddo
@@ -1597,7 +1597,7 @@ subroutine projtoprerb(nocp,uuk,ttk)
             call sub2(us0(1,2,i),vy,n)
             if (ldim.eq.3) call sub2(us0(1,ldim,i),vz,n)
          endif
-         if (ifrom(2)) call sub2(ts0(1,i),t,n)
+         if (ifrom(2)) call sub2(ts0(1,i,1),t,n)
       enddo
 
       if (nio.eq.0) write (6,*) 'exiting projtoprerb'
@@ -1755,7 +1755,7 @@ subroutine recont_wo0(tt,coef,nocp)
       call rzero(tt,n)
 
       do i=1,nocp
-         call add2s2(tt,tb(1,i),coef(i),n)
+         call add2s2(tt,tb(1,i,1),coef(i),n)
       enddo
 
       return

code/dump.f

@@ -252,7 +252,7 @@ subroutine dump_all
          time=i
          itmp=i
          ifxyo=(i.eq.0)
-         call outpost(ub(1,i),vb(1,i),wb(1,i),pb(1,i),tb(1,i),'bas')
+         call outpost(ub(1,i),vb(1,i),wb(1,i),pb(1,i),tb(1,i,1),'bas')
       enddo
 
       istep=itmp
@@ -325,12 +325,14 @@ subroutine dump_bas
       parameter (lt=lx1*ly1*lz1*lelt)
 
       common /dumpglobal/ wk1(lcloc),wk2(lcloc)
+      common /romdbas/ tmp(lt,ldimt)
 
       logical iftmp1,iftmp2,iftmp3
 
       call nekgsync
       dbas_time=dnekclock()
 
+      n=lx1*ly1*lz1*lelt
       ttmp=time
       itmp=istep
 
@@ -348,7 +350,10 @@ subroutine dump_bas
          time=i
          itmp=i
          ifxyo=(i.eq.0)
-         call outpost(ub(1,i),vb(1,i),wb(1,i),pb(1,i),tb(1,i),'bas')
+         do j=1,ldimt
+            call copy(tmp(1,j),tb(1,i,j),n)
+         enddo
+         call outpost2(ub(1,i),vb(1,i),wb(1,i),pb(1,i),tmp,ldimt,'bas')
       enddo
 
       istep=itmp
@@ -451,7 +456,7 @@ subroutine dump_snaps
 
       do i=1,ns
          call outpost(us0(1,1,i),us0(1,2,i),us0(1,ldim,i),
-     $      pr,ts0(1,i),'sna')
+     $      pr,ts0(1,i,1),'sna')
          ifxyo=.false.
       enddo