subroutine EvaulateCh use basicmod use fluxmod use mpimod implicit none integer :: i,j,k,n real(8),parameter:: drate=0.1d0 ! ! local variable real(8):: dh1l,dh2l,dh3l,dhl,dhd real(8):: ch1l,ch2l,ch3l,chl,chd real(8):: cts,css,cms real(8),parameter:: huge=1.0d90 integer::theid !$acc kernels chd = 0.0d0 ch1l = 0.0d0; ch2l = 0.0d0; ch3l = 0.0d0 dhd = huge dh1l = huge; dh2l = huge; dh3l = huge !$acc loop collapse(3) reduction(max:chd) do k=ks,ke do j=js,je do i=is,ie css = svc(ncsp,i,j,k)**2 cts = css &! cs^2+c_a^2 & + (svc(nbm1,i,j,k)**2+svc(nbm2,i,j,k)**2+svc(nbm3,i,j,k)**2)/svc(nden,i,j,k) cms = sqrt((cts +sqrt(cts**2 & & -4.0d0*css*svc(nbm1,i,j,k)**2/svc(nden,i,j,k)))/2.0d0) ch1l = ( abs(svc(nve1,i,j,k)) + cms ) dh1l = (x1a(i+1)-x1a(i)) cms = sqrt((cts +sqrt(cts**2 & & -4.0d0*css*svc(nbm2,i,j,k)**2/svc(nden,i,j,k)))/2.0d0) ch2l = ( abs(svc(nve2,i,j,k)) + cms ) dh2l = (x2a(j+1)-x2a(j)) cms = sqrt((cts +sqrt(cts**2 & & -4.0d0*css*svc(nbm3,i,j,k)**2/svc(nden,i,j,k)))/2.0d0) ch3l = ( abs(svc(nve3,i,j,k)) + cms ) dh3l = (x3a(k+1)-x3a(k)) chl = max(ch1l,ch2l,ch3l) dhl = min(dh1l,dh2l,dh3l) chd = max(chl,chd) dhd = min(dhl,dhd) enddo enddo enddo bufinpmax(1) = chd bufinpmax(2) = dble(myid_w) !$acc end kernels call MPImaxfind !$acc kernels chd = bufoutmax(1) theid = int(bufoutmax(2)) chg = chd !$acc end kernels return end subroutine EvaulateCh