subroutine r0shift ! ! shift theta_0's to include the effect of external ExB shear ! ! time is the present time, and we have just taken a step of dt, ! but need to update theta_0 ! use mp, only: max_allreduce, proc0, iproc use itg_data, only: nspecies, beta_e, etak, etak_par, & rho, iflr, tau, charge, n_I, s_perp, tiovte, a0, & semi_imp, iphi00, lin, shr, jacobian, omegae, linlay, & omega_gb, omega_gb0, omega_gb1, & omega_kap, omega_kap0, omega_kap1, time, epse use itg_data, only: omegade, omegade0, omegade1 use gryffin_grid, only: ld, l_left, l_right, md, ldb, nd, x0, & rkperp2, rky2, rkx2, r0, nmax, nrr, z0, mrr, & rkperp20, rkperp21, rkperp22 use linear use gryffin_layouts implicit none integer j,m,n,i,l real thetam ! write(*,*) 'in r0shift, a: rkperp2(10,1,2): ',rkperp2(10,1,2) ! write(*,*) 'in r0shift, a: r0(1,2): ',r0(1,2) do m = m_low,m_high do n = n_low, n_high if (mrr(m,n) == 0.or.(lin == 1 .and. linlay)) then if (nmax /= 0) then r0(m,n)=z0*float(nrr(n))/nmax else r0(m,n)=z0*float(nrr(n)) endif else if (nmax /= 0) then r0(m,n)=z0*float(nrr(n))/nmax/float(mrr(m,n)) else r0(m,n)=z0*float(nrr(n))/float(mrr(m,n)) endif endif if (mrr(m,n) /= 0) then r0(m,n)=r0(m,n)+abs(omegae*time(m)/shr) if (lin == 1 .and. linlay) then thetam=z0*(1+0.5/float(nmax)) else thetam=z0/float(mrr(m,n))*(1+0.5/float(nmax)) endif j=(r0(m,n)+thetam)/(2*thetam) r0(m,n)=r0(m,n)-2*j*thetam if ((r0(m,n) > thetam) .or. (r0(m,n) < -thetam)) then write(*,*) 'error in r0shift',thetam,r0(m,n),j,nmax, & time(m)*omegae/shr endif endif enddo enddo do i=1,nspecies do n = n_low, n_high do m = m_low, m_high do l=1,ld-1 omega_gb(l,m,n,i)=omega_gb0(l,m,n,i) & +r0(m,n)*omega_gb1(l,m,n,i) omega_kap(l,m,n,i)=omega_kap0(l,m,n,i) & +r0(m,n)*omega_kap1(l,m,n,i) enddo enddo enddo enddo if (epse .ne. 0) then do n = n_low, n_high do m = m_low, m_high do l=1,ld-1 omegade(l,m,n)=omegade0(l,m,n)+r0(m,n)*omegade1(l,m,n) enddo enddo enddo endif do n = n_low, n_high do m = m_low, m_high do l=1,ld-1 rkperp2(l,m,n)=rkperp20(l,m,n)+r0(m,n)*rkperp21(l,m,n) & +r0(m,n)**2*rkperp22(l,m,n) enddo enddo enddo ! write(*,*) 'in r0shift, b: denom0(1,2): ',denom0(1,2) ! write(*,*) 'in r0shift, b: rkperp2(10,1,2): ',rkperp2(10,1,2) ! write(*,*) 'in r0shift, b: r0(1,2): ',r0(1,2) call flrinit(1) ! write(*,*) 'in r0shift, c: denom0(1,2): ',denom0(1,2) ! write(*,*) 'in r0shift, c: rkperp2(10,1,2): ',rkperp2(10,1,2) ! write(*,*) 'in r0shift, c: r0(1,2): ',r0(1,2) end subroutine r0shift