source: codes/icosagcm/trunk/src/kernels/advect_horiz.k90 @ 1057

   !--------------------------------------------------------------------------
   !---------------------------- advect_horiz ----------------------------------

   !$acc data create(qflux(:,:)) present(qi(:,:), cc(:,:,:), gradq3d(:,:,:), mass(:,:), hfluxt(:,:), Ai(:), xyz_i(:,:)) async

   ! evaluate tracer field at point cc using piecewise linear reconstruction
   ! q(cc)= q0 + gradq.(cc-xyz_i) with xi centroid of hexagon
   ! sign*hfluxt>0 iff outgoing
   !$acc parallel loop collapse(2) async
   DO l = ll_begin, ll_end
      !DIR$ SIMD
      DO ij=ij_begin_ext, ij_end_ext
         IF(ne_right*hfluxt(ij+u_right,l)>0.) THEN
            ij_tmp = ij
         ELSE
            ij_tmp = ij+t_right
         END IF

         qe = qi(ij_tmp,l)
         qe = qe + (cc(ij+u_right,l,1)-xyz_i(ij_tmp,1))*gradq3d(ij_tmp,l,1)
         qe = qe + (cc(ij+u_right,l,2)-xyz_i(ij_tmp,2))*gradq3d(ij_tmp,l,2)
         qe = qe + (cc(ij+u_right,l,3)-xyz_i(ij_tmp,3))*gradq3d(ij_tmp,l,3)

         qflux(ij+u_right,l) = hfluxt(ij+u_right,l)*qe

         IF(ne_lup*hfluxt(ij+u_lup,l)>0.) THEN
            ij_tmp = ij
         ELSE
            ij_tmp = ij+t_lup
         END IF

         qe = qi(ij_tmp,l)
         qe = qe + (cc(ij+u_lup,l,1)-xyz_i(ij_tmp,1))*gradq3d(ij_tmp,l,1)
         qe = qe + (cc(ij+u_lup,l,2)-xyz_i(ij_tmp,2))*gradq3d(ij_tmp,l,2)
         qe = qe + (cc(ij+u_lup,l,3)-xyz_i(ij_tmp,3))*gradq3d(ij_tmp,l,3)

         qflux(ij+u_lup,l) = hfluxt(ij+u_lup,l)*qe

         IF(ne_ldown*hfluxt(ij+u_ldown,l)>0.) THEN
            ij_tmp = ij
         ELSE
            ij_tmp = ij+t_ldown
         END IF

         qe = qi(ij_tmp,l)
         qe = qe + (cc(ij+u_ldown,l,1)-xyz_i(ij_tmp,1))*gradq3d(ij_tmp,l,1)
         qe = qe + (cc(ij+u_ldown,l,2)-xyz_i(ij_tmp,2))*gradq3d(ij_tmp,l,2)
         qe = qe + (cc(ij+u_ldown,l,3)-xyz_i(ij_tmp,3))*gradq3d(ij_tmp,l,3)

         qflux(ij+u_ldown,l) = hfluxt(ij+u_ldown,l)*qe
      END DO
   END DO

   IF(diagflux_on) THEN
     !$acc parallel loop collapse(2) copy(qfluxt(:,:)) async
     DO l = ll_begin, ll_end
        !DIR$ SIMD
        DO ij=ij_begin_ext, ij_end_ext
           qfluxt(ij+u_right,l) = qfluxt(ij+u_right,l)+qflux(ij+u_right,l)
           qfluxt(ij+u_lup,l) = qfluxt(ij+u_lup,l)+qflux(ij+u_lup,l)
           qfluxt(ij+u_ldown,l) = qfluxt(ij+u_ldown,l)+qflux(ij+u_ldown,l)
        END DO
     END DO
   END IF

   ! update q and, if update_mass, update mass
   !$acc parallel loop collapse(2) async
   DO l = ll_begin, ll_end
      !DIR$ SIMD
      DO ij=ij_begin, ij_end
         dmass=0.
         dq=0.
         dmass = dmass + ne_rup*hfluxt(ij+u_rup,l)
         dq = dq + ne_rup*qflux(ij+u_rup,l)
         dmass = dmass + ne_lup*hfluxt(ij+u_lup,l)
         dq = dq + ne_lup*qflux(ij+u_lup,l)
         dmass = dmass + ne_left*hfluxt(ij+u_left,l)
         dq = dq + ne_left*qflux(ij+u_left,l)
         dmass = dmass + ne_ldown*hfluxt(ij+u_ldown,l)
         dq = dq + ne_ldown*qflux(ij+u_ldown,l)
         dmass = dmass + ne_rdown*hfluxt(ij+u_rdown,l)
         dq = dq + ne_rdown*qflux(ij+u_rdown,l)
         dmass = dmass + ne_right*hfluxt(ij+u_right,l)
         dq = dq + ne_right*qflux(ij+u_right,l)
         newmass = mass(ij,l) - dmass/Ai(ij)
         qi(ij,l) = (qi(ij,l)*mass(ij,l)-dq/Ai(ij)) / newmass
         IF(update_mass) mass(ij,l)=newmass
      END DO
   END DO
   
   !$acc end data

   !---------------------------- advect_horiz ----------------------------------
   !--------------------------------------------------------------------------