subroutine filter(density1, u_par1, t_par1, q_par1, t_perp1, q_perp1, dt_loc) use itg_data implicit none complex, dimension(:,:,:,:) :: density1, u_par1, t_par1, q_par1, t_perp1, q_perp1 real, dimension(:) :: dt_loc real, allocatable, dimension(:,:,:,:) :: pfilterf, pfiltern ! declare other local variables integer n,m,l,i real rkp2 ! ! If iflr=6, use k^2 damping on all moments, like Ron ! allocate (pfilterf(ldb, md, nd, nspecies), pfiltern(ldb, md, nd, nspecies)) if (iflr == 6) then if(icrit /= 0) write(*,*) 'update the filter subroutine' do n=1,nd do i=1,nspecies do m=1,md do l=1,ldb ! pfiltern(l,m,n,i)=1./(1.+dt_loc(m)*rmu1*rkx2(l,m,n)*rho(i)**2) pfilterf(l,m,n,i)=1./(1.+dt_loc(m)*rmu1*rkx2(l,m,n)*rho(i)**2) enddo enddo enddo enddo else do n=1,nd do i=1,nspecies do m=1,md do l=1,ldb rkp2=rkperp2(l,m,n)*rho(i)**2 pfiltern(l,m,n,i)=1./(1.+dt_loc(m)*rdiff(m,n)*rkp2**iexp) pfilterf(l,m,n,i)=1./(1.+dt_loc(m)*rdiff(m,n)*rkp2) enddo enddo enddo enddo endif do l=1,ld-1 density1(l,:,:,:)=density1(l,:,:,:)*pfiltern(l,:,:,:) ! density1(l,:,:,:)=density1(l,:,:,:)*pfilterf(l,:,:,:) u_par1(l,:,:,:)=u_par1(l,:,:,:)*pfilterf(l,:,:,:) t_par1(l,:,:,:)=t_par1(l,:,:,:)*pfilterf(l,:,:,:) t_perp1(l,:,:,:)=t_perp1(l,:,:,:)*pfilterf(l,:,:,:) enddo if(nparmom >= 4) then do l=1,ld-1 q_par1(l,:,:,:)=q_par1(l,:,:,:)*pfilterf(l,:,:,:) enddo endif if(nperpmom >= 2) then do l=1,ld-1 q_perp1(l,:,:,:)=q_perp1(l,:,:,:)*pfilterf(l,:,:,:) enddo endif deallocate (pfilterf, pfiltern) end subroutine filter