diff --git a/.gitignore b/.gitignore
index 30433afe7adc8ea2067b6584b132bcd522fe24b6..cc0b792c3f8af8f7e3b30a531c40e36bdae694e2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
conf/profile_mesonh-*
+exe/*
pub/ncl_ncarg*/
src/dir_obj-*
src/LIB/grib_api*
diff --git a/src/LIB/BITREP/LICENSE b/src/LIB/BITREP/LICENSE
new file mode 100644
index 0000000000000000000000000000000000000000..8fdd84784674c977e2114a6c800a2e48b0ccb6a8
--- /dev/null
+++ b/src/LIB/BITREP/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2013, Andrea Arteaga
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+ Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+
+ Redistributions in binary form must reproduce the above copyright notice, this
+ list of conditions and the following disclaimer in the documentation and/or
+ other materials provided with the distribution.
+
+ Neither the name of the {organization} nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/src/LIB/BITREP/br_transcendentals.cpp b/src/LIB/BITREP/br_transcendentals.cpp
new file mode 100644
index 0000000000000000000000000000000000000000..9f54af05c304dff778e81609f85b6749fa0e2a54
--- /dev/null
+++ b/src/LIB/BITREP/br_transcendentals.cpp
@@ -0,0 +1,1023 @@
+#include <cmath>
+#include <limits>
+#include <cstdio>
+#ifdef BITREPCPP11
+# include <cstdint>
+#else
+# include <stdint.h>
+#endif
+
+
+#if (defined BITREPFMA && defined BITREPCPP11)
+# define __BITREPFMA(a,b,c) std::fma(a,b,c)
+#else
+# define __BITREPFMA(a,b,c) (a*b + c)
+#endif
+
+namespace bitrep
+{
+
+/*************
+ * CONSTANTS *
+ *************/
+
+static const double const_2_over_pi = 6.3661977236758138e-1;
+
+static const double __sin_cos_coefficient[16] =
+{
+ 1.590307857061102704e-10, /* sin0 */
+ -2.505091138364548653e-08, /* sin1 */
+ 2.755731498463002875e-06, /* sin2 */
+ -1.984126983447703004e-04, /* sin3 */
+ 8.333333333329348558e-03, /* sin4 */
+ -1.666666666666666297e-01, /* sin5 */
+ 0.00000000000000000, /* sin6 */
+ 0.00000000000000000, /* unused */
+
+ -1.136781730462628422e-11, /* cos0 */
+ 2.087588337859780049e-09, /* cos1 */
+ -2.755731554299955694e-07, /* cos2 */
+ 2.480158729361868326e-05, /* cos3 */
+ -1.388888888888066683e-03, /* cos4 */
+ 4.166666666666663660e-02, /* cos5 */
+ -5.000000000000000000e-01, /* cos6 */
+ 1.000000000000000000e+00, /* cos7 */
+};
+
+
+
+/*****************************************
+ * FORWARD DECLARATION OF SOME FUNCTIONS *
+ *****************************************/
+
+double __internal_exp_kernel(double x, int scale);
+double __internal_expm1_kernel(double x);
+double log1p(double);
+double log(double);
+
+/********************
+ * HELPER FUNCTIONS *
+ ********************/
+
+double __internal_copysign_pos(double a, double b)
+{
+ union {
+ int32_t i[2];
+ double d;
+ } aa, bb;
+ aa.d = a;
+ bb.d = b;
+ aa.i[1] = (bb.i[1] & 0x80000000) | aa.i[1];
+ return aa.d;
+}
+
+double __internal_old_exp_kernel(double x, int scale)
+{
+ double t, z;
+ int i, j, k;
+
+ union {
+ int32_t i[2];
+ double d;
+ } zz;
+
+ t = std::floor (__BITREPFMA(x, 1.4426950408889634e+0, 4.99999999999999945e-1));
+ i = (int)t;
+ z = __BITREPFMA (t, -6.9314718055994529e-1, x);
+ z = __BITREPFMA (t, -2.3190468138462996e-17, z);
+ t = __internal_expm1_kernel (z);
+ k = ((i + scale) << 20) + (1023 << 20);
+
+ if (std::abs(i) < 1021) {
+ zz.i[0] = 0; zz.i[1] = k;
+ z = zz.d;
+ z = __BITREPFMA (t, z, z);
+ } else {
+ j = 0x40000000;
+ if (i < 0) {
+ k += (55 << 20);
+ j -= (55 << 20);
+ }
+ k = k - (1 << 20);
+
+ zz.i[0] = 0; zz.i[1] = j; /* 2^-54 if a is denormal, 2.0 otherwise */
+ z = zz.d;
+ t = __BITREPFMA (t, z, z);
+
+ zz.i[0] = 0; zz.i[1] = k; /* 2^-54 if a is denormal, 2.0 otherwise */
+ z = zz.d;
+ z = t * z;
+ }
+ return z;
+}
+
+
+/***************************
+ * TRIGONOMETRIC FUNCTIONS *
+ ***************************/
+
+/**
+ * \param x The number whose sin or cos must be computed
+ * \param q Represents the quadrant as integer
+ */
+static double __internal_sin_cos_kerneld(double x, int q)
+
+{
+ const double *coeff = __sin_cos_coefficient + 8*(q&1);
+ double x2 = x*x;
+
+ double z = (q & 1) ? -1.136781730462628422e-11 : 1.590307857061102704e-10;
+
+ z = __BITREPFMA(z, x2, coeff[1]);
+ z = __BITREPFMA(z, x2, coeff[2]);
+ z = __BITREPFMA(z, x2, coeff[3]);
+ z = __BITREPFMA(z, x2, coeff[4]);
+ z = __BITREPFMA(z, x2, coeff[5]);
+ z = __BITREPFMA(z, x2, coeff[6]);
+
+ x = __BITREPFMA(z, x, x);
+
+ if (q & 1) x = __BITREPFMA(z, x2, 1.);
+ if (q & 2) x = __BITREPFMA(x, -1., 0.);
+
+ return x;
+}
+
+
+double __internal_tan_kernel(double x, int i)
+{
+ double x2, z, q;
+ x2 = x*x;
+ z = 9.8006287203286300E-006;
+
+ z = __BITREPFMA(z, x2, -2.4279526494179897E-005);
+ z = __BITREPFMA(z, x2, 4.8644173130937162E-005);
+ z = __BITREPFMA(z, x2, -2.5640012693782273E-005);
+ z = __BITREPFMA(z, x2, 6.7223984330880073E-005);
+ z = __BITREPFMA(z, x2, 8.3559287318211639E-005);
+ z = __BITREPFMA(z, x2, 2.4375039850848564E-004);
+ z = __BITREPFMA(z, x2, 5.8886487754856672E-004);
+ z = __BITREPFMA(z, x2, 1.4560454844672040E-003);
+ z = __BITREPFMA(z, x2, 3.5921008885857180E-003);
+ z = __BITREPFMA(z, x2, 8.8632379218613715E-003);
+ z = __BITREPFMA(z, x2, 2.1869488399337889E-002);
+ z = __BITREPFMA(z, x2, 5.3968253972902704E-002);
+ z = __BITREPFMA(z, x2, 1.3333333333325342E-001);
+ z = __BITREPFMA(z, x2, 3.3333333333333381E-001);
+ z = z * x2;
+ q = __BITREPFMA(z, x, x);
+
+ if (i) {
+ double s = q - x;
+ double w = __BITREPFMA(z, x, -s); // tail of q
+ z = - (1. / q);
+ s = __BITREPFMA(q, z, 1.0);
+ q = __BITREPFMA(__BITREPFMA(z,w,s), z, z);
+ }
+
+ return q;
+}
+
+
+static double __internal_trig_reduction_kerneld(double x, int *q_)
+{
+ double j, t;
+ int& q = *q_;
+
+ //q = static_cast<int>(x * const_2_over_pi + .5);
+ q = static_cast<int>(std::floor(x * const_2_over_pi + .5));
+ j = q;
+
+ t = (-j) * 1.5707963267948966e+000 + x;
+ t = (-j) * 6.1232339957367574e-017 + t;
+ t = (-j) * 8.4784276603688985e-032 + t;
+
+ // TODO: support huge values (fabs(a) > 2147483648.0)
+
+ return t;
+}
+
+double sin(double x)
+{
+ double z;
+ int q;
+
+ // TODO: support infinite x
+
+ z = __internal_trig_reduction_kerneld(x, &q);
+ z = __internal_sin_cos_kerneld(z, q);
+
+ return z;
+}
+
+double cos(double x)
+{
+ double z;
+ int q;
+
+ // TODO: support infinite x
+
+ z = __internal_trig_reduction_kerneld(x, &q);
+ ++q;
+ z = __internal_sin_cos_kerneld(z, q);
+
+ return z;
+}
+
+double tan(double x)
+{
+ double z, inf = std::numeric_limits<double>::infinity();
+ int i;
+
+ if (x == inf || x == -inf) {
+ x = x * 0.; // Gives NaN
+ }
+ z = __internal_trig_reduction_kerneld(x, &i);
+ z = __internal_tan_kernel(z, i & 1);
+ return z;
+}
+
+
+/***********************************
+ * INVERSE TRIGONOMETRIC FUNCTIONS *
+ ***********************************/
+
+double __internal_asin_kernel(double x)
+{
+ double r;
+ r = 6.259798167646803E-002;
+ r = __BITREPFMA (r, x, -7.620591484676952E-002);
+ r = __BITREPFMA (r, x, 6.686894879337643E-002);
+ r = __BITREPFMA (r, x, -1.787828218369301E-002);
+ r = __BITREPFMA (r, x, 1.745227928732326E-002);
+ r = __BITREPFMA (r, x, 1.000422754245580E-002);
+ r = __BITREPFMA (r, x, 1.418108777515123E-002);
+ r = __BITREPFMA (r, x, 1.733194598980628E-002);
+ r = __BITREPFMA (r, x, 2.237350511593569E-002);
+ r = __BITREPFMA (r, x, 3.038188875134962E-002);
+ r = __BITREPFMA (r, x, 4.464285849810986E-002);
+ r = __BITREPFMA (r, x, 7.499999998342270E-002);
+ r = __BITREPFMA (r, x, 1.666666666667375E-001);
+ r = r * x;
+ return r;
+}
+
+double __internal_atan_kernel(double x)
+{
+ double t, x2;
+ x2 = x * x;
+ t = -2.0258553044438358E-005 ;
+ t = __BITREPFMA (t, x2, 2.2302240345758510E-004);
+ t = __BITREPFMA (t, x2, -1.1640717779930576E-003);
+ t = __BITREPFMA (t, x2, 3.8559749383629918E-003);
+ t = __BITREPFMA (t, x2, -9.1845592187165485E-003);
+ t = __BITREPFMA (t, x2, 1.6978035834597331E-002);
+ t = __BITREPFMA (t, x2, -2.5826796814495994E-002);
+ t = __BITREPFMA (t, x2, 3.4067811082715123E-002);
+ t = __BITREPFMA (t, x2, -4.0926382420509971E-002);
+ t = __BITREPFMA (t, x2, 4.6739496199157994E-002);
+ t = __BITREPFMA (t, x2, -5.2392330054601317E-002);
+ t = __BITREPFMA (t, x2, 5.8773077721790849E-002);
+ t = __BITREPFMA (t, x2, -6.6658603633512573E-002);
+ t = __BITREPFMA (t, x2, 7.6922129305867837E-002);
+ t = __BITREPFMA (t, x2, -9.0909012354005225E-002);
+ t = __BITREPFMA (t, x2, 1.1111110678749424E-001);
+ t = __BITREPFMA (t, x2, -1.4285714271334815E-001);
+ t = __BITREPFMA (t, x2, 1.9999999999755019E-001);
+ t = __BITREPFMA (t, x2, -3.3333333333331860E-001);
+ t = t * x2;
+ t = __BITREPFMA (t, x, x);
+ return t;
+}
+
+
+double asin(double x)
+{
+ double fx, t0, t1;
+ double xhi, ihi;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx, fxx;
+
+ fx = std::abs(x);
+ xx.d = x;
+ xhi = xx.i[1];
+ fxx.d = fx;
+ ihi = fxx.i[1];
+
+ if (ihi < 0x3fe26666) {
+ t1 = fx * fx;
+ t1 = __internal_asin_kernel (t1);
+ t1 = __BITREPFMA (t1, fx, fx);
+ t1 = __internal_copysign_pos(t1, x);
+ } else {
+ t1 = __BITREPFMA (-0.5, fx, 0.5);
+ t0 = std::sqrt (t1);
+ t1 = __internal_asin_kernel (t1);
+ t0 = -2.0 * t0;
+ t1 = __BITREPFMA (t0, t1, 6.1232339957367660e-17);
+ t0 = t0 + 7.8539816339744828e-1;
+ t1 = t0 + t1;
+ t1 = t1 + 7.8539816339744828e-1;
+ if (xhi < 0x3ff00000) {
+ t1 = __internal_copysign_pos(t1, x);
+ }
+ }
+ return t1;
+}
+
+double acos(double x)
+{
+ double t0, t1;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx, fxx;
+ xx.d = x;
+ fxx.d = (t0 = std::abs(x));
+
+ const int32_t& xhi = xx.i[1];
+ const int32_t& ihi = fxx.i[1];
+
+ if (ihi < 0x3fe26666) {
+ t1 = t0 * t0;
+ t1 = __internal_asin_kernel (t1);
+ t0 = __BITREPFMA (t1, t0, t0);
+ if (xhi < 0) {
+ t0 = t0 + 6.1232339957367660e-17;
+ t0 = 1.5707963267948966e+0 + t0;
+ } else {
+ t0 = t0 - 6.1232339957367660e-17;
+ t0 = 1.5707963267948966e+0 - t0;
+ }
+ } else {
+ /* acos(x) = [y + y^2 * p(y)] * rsqrt(y/2), y = 1 - x */
+ double p, r, y;
+ y = 1.0 - t0;
+ r = 1. / std::sqrt(y / 2.);
+ p = 2.7519189493111718E-006;
+ p = __BITREPFMA (p, y, -1.5951212865388395E-006);
+ p = __BITREPFMA (p, y, 6.1185294127269731E-006);
+ p = __BITREPFMA (p, y, 6.9283438595562408E-006);
+ p = __BITREPFMA (p, y, 1.9480663162164715E-005);
+ p = __BITREPFMA (p, y, 4.5031965455307141E-005);
+ p = __BITREPFMA (p, y, 1.0911426300865435E-004);
+ p = __BITREPFMA (p, y, 2.7113554445344455E-004);
+ p = __BITREPFMA (p, y, 6.9913006155254860E-004);
+ p = __BITREPFMA (p, y, 1.8988715243469585E-003);
+ p = __BITREPFMA (p, y, 5.5803571429249681E-003);
+ p = __BITREPFMA (p, y, 1.8749999999999475E-002);
+ p = __BITREPFMA (p, y, 8.3333333333333329E-002);
+ p = p * y * y * r;
+ fxx.d = y;
+ if (ihi <= 0) {
+ t0 = t0 * 0.;
+ } else {
+ t0 = __BITREPFMA (r, y, p);
+ }
+ if (ihi < 0) {
+ t0 = t0 * std::numeric_limits<double>::infinity();
+ }
+ if (xhi < 0) {
+ t0 = t0 - 1.2246467991473532e-16;
+ t0 = 3.1415926535897931e+0 - t0;
+ }
+ }
+ return t0;
+}
+
+double atan(double x)
+{
+ double t0, t1;
+ /* reduce argument to first octant */
+ t0 = std::abs(x);
+ t1 = t0;
+ if (t0 > 1.0) {
+ t1 = 1. / t1;
+ if (t0 == std::numeric_limits<double>::infinity()) t1 = 0.0;
+ }
+
+ /* approximate atan(r) in first octant */
+ t1 = __internal_atan_kernel(t1);
+
+ /* map result according to octant. */
+ if (t0 > 1.0) {
+ t1 = 1.5707963267948966e+0 - t1;
+ }
+ return __internal_copysign_pos(t1, x);
+}
+
+
+/************************
+ * HYPERBOLIC FUNCTIONS *
+ ************************/
+
+double __internal_expm1_kernel (double x)
+{
+ double t;
+ t = 2.0900320002536536E-009;
+ t = __BITREPFMA (t, x, 2.5118162590908232E-008);
+ t = __BITREPFMA (t, x, 2.7557338697780046E-007);
+ t = __BITREPFMA (t, x, 2.7557224226875048E-006);
+ t = __BITREPFMA (t, x, 2.4801587233770713E-005);
+ t = __BITREPFMA (t, x, 1.9841269897009385E-004);
+ t = __BITREPFMA (t, x, 1.3888888888929842E-003);
+ t = __BITREPFMA (t, x, 8.3333333333218910E-003);
+ t = __BITREPFMA (t, x, 4.1666666666666609E-002);
+ t = __BITREPFMA (t, x, 1.6666666666666671E-001);
+ t = __BITREPFMA (t, x, 5.0000000000000000E-001);
+ t = t * x;
+ t = __BITREPFMA (t, x, x);
+ return t;
+}
+
+double __internal_exp2i_kernel(int32_t b)
+{
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+
+ xx.i[0] = 0;
+ xx.i[1] = (b + 1023) << 20;
+
+ return xx.d;
+}
+
+double __internal_expm1_scaled(double x, int scale)
+{
+ double t, z, u;
+ int i, j;
+
+ union {
+ uint32_t i[2];
+ double d;
+ } xx;
+ xx.d = x;
+ uint32_t& k = xx.i[1];
+
+ t = std::floor (__BITREPFMA(x, 1.4426950408889634e+0, 4.99999999999999945e-1));
+ i = (int)t + scale;
+ z = __BITREPFMA (t, -6.9314718055994529e-1, x);
+ z = __BITREPFMA (t, -2.3190468138462996e-17, z);
+ k = k + k;
+ if ((unsigned)k < (unsigned)0x7fb3e647) {
+ z = x;
+ i = 0;
+ }
+ t = __internal_expm1_kernel(z);
+ j = i;
+ if (i == 1024) j--;
+ u = __internal_exp2i_kernel(j);
+
+ xx.i[0] = 0;
+ xx.i[1] = 0x3ff00000 + (scale << 20);
+ x = xx.d;
+
+ x = u - x;
+ t = __BITREPFMA (t, u, x);
+ if (i == 1024) t = t + t;
+ if (k == 0) t = z; /* preserve -0 */
+ return t;
+}
+
+double sinh(double x)
+{
+ double z;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ xx.d = x;
+ xx.i[1] = xx.i[1] & 0x7fffffff;
+
+ int32_t& thi = xx.i[1];
+ int32_t& tlo = xx.i[0];
+ double& t = xx.d;
+
+ if (thi < 0x3ff00000) {
+ double t2 = t*t;
+ z = 7.7587488021505296E-013;
+ z = __BITREPFMA (z, t2, 1.6057259768605444E-010);
+ z = __BITREPFMA (z, t2, 2.5052123136725876E-008);
+ z = __BITREPFMA (z, t2, 2.7557319157071848E-006);
+ z = __BITREPFMA (z, t2, 1.9841269841431873E-004);
+ z = __BITREPFMA (z, t2, 8.3333333333331476E-003);
+ z = __BITREPFMA (z, t2, 1.6666666666666669E-001);
+ z = z * t2;
+ z = __BITREPFMA (z, t, t);
+ } else {
+ z = __internal_expm1_scaled (t, -1);
+ z = z + z / (__BITREPFMA (2.0, z, 1.0));
+ if (t >= 7.1047586007394398e+2) {
+ z = std::numeric_limits<double>::infinity();
+ }
+ }
+
+ z = __internal_copysign_pos(z, x);
+ return z;
+}
+
+double cosh(double x)
+{
+ double t, z;
+ z = std::abs(x);
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ xx.d = z;
+
+ int32_t& i = xx.i[1];
+
+ if ((unsigned)i < (unsigned)0x408633cf) {
+ z = __internal_exp_kernel(z, -2);
+ t = 1. / z;
+ z = __BITREPFMA(2.0, z, 0.125 * t);
+ } else {
+ if (z > 0.0) x = std::numeric_limits<double>::infinity();
+ z = x + x;
+ }
+
+ return z;
+}
+
+double tanh(double x)
+{
+ double t;
+ t = std::abs(x);
+ if (t >= 0.55) {
+ double s;
+ s = 1. / (__internal_old_exp_kernel (2.0 * t, 0) + 1.0);
+ s = __BITREPFMA (2.0, -s, 1.0);
+ if (t > 350.0) {
+ s = 1.0; /* overflow -> 1.0 */
+ }
+ x = __internal_copysign_pos(s, x);
+ } else {
+ double x2;
+ x2 = x * x;
+ t = 5.102147717274194E-005;
+ t = __BITREPFMA (t, x2, -2.103023983278533E-004);
+ t = __BITREPFMA (t, x2, 5.791370145050539E-004);
+ t = __BITREPFMA (t, x2, -1.453216755611004E-003);
+ t = __BITREPFMA (t, x2, 3.591719696944118E-003);
+ t = __BITREPFMA (t, x2, -8.863194503940334E-003);
+ t = __BITREPFMA (t, x2, 2.186948597477980E-002);
+ t = __BITREPFMA (t, x2, -5.396825387607743E-002);
+ t = __BITREPFMA (t, x2, 1.333333333316870E-001);
+ t = __BITREPFMA (t, x2, -3.333333333333232E-001);
+ t = t * x2;
+ t = __BITREPFMA (t, x, x);
+ x = __internal_copysign_pos(t, x);
+ }
+ return x;
+}
+
+
+/********************************
+ * INVERSE HIPERBOLIC FUNCTIONS *
+ ********************************/
+
+double __internal_atanh_kernel (double a_1, double a_2)
+{
+ double a, a2, t;
+
+ a = a_1 + a_2;
+ a2 = a * a;
+ t = 7.597322383488143E-002/65536.0;
+ t = __BITREPFMA (t, a2, 6.457518383364042E-002/16384.0);
+ t = __BITREPFMA (t, a2, 7.705685707267146E-002/4096.0);
+ t = __BITREPFMA (t, a2, 9.090417561104036E-002/1024.0);
+ t = __BITREPFMA (t, a2, 1.111112158368149E-001/256.0);
+ t = __BITREPFMA (t, a2, 1.428571416261528E-001/64.0);
+ t = __BITREPFMA (t, a2, 2.000000000069858E-001/16.0);
+ t = __BITREPFMA (t, a2, 3.333333333333198E-001/4.0);
+ t = t * a2;
+ t = __BITREPFMA (t, a, a_2);
+ t = t + a_1;
+ return t;
+}
+
+double asinh(double x)
+{
+ double fx, t;
+ fx = std::abs(x);
+
+ union {
+ int32_t i[2];
+ double d;
+ } fxx;
+ fxx.d = fx;
+
+ if (fxx.i[1] >= 0x5ff00000) { /* prevent intermediate underflow */
+ t = 6.9314718055994529e-1 + log(fx);
+ } else {
+ t = fx * fx;
+ t = log1p (fx + t / (1.0 + std::sqrt(1.0 + t)));
+ }
+ return __internal_copysign_pos(t, x);
+}
+
+double acosh(double x)
+{
+ double t;
+ t = x - 1.0;
+ if (std::abs(t) > 4503599627370496.0) {
+ /* for large a, acosh = log(2*a) */
+ t = 6.9314718055994529e-1 + log(x);
+ } else {
+ t = t + std::sqrt(__BITREPFMA(x, t, t));
+ t = log1p(t);
+ }
+ return t;
+}
+
+double atanh(double x)
+{
+ double fx, t;
+ fx = std::abs(x);
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ xx.d = x;
+
+ t = (2.0 * fx) / (1.0 - fx);
+ t = 0.5 * log1p(t);
+ if (xx.i[1] < 0) {
+ t = -t;
+ }
+ return t;
+}
+
+/**************
+ * LOGARITHMS *
+ **************/
+
+
+
+#if 0
+double log(double x)
+{
+ double m, f, g, u, v, tmp, q, ulo, log_lo, log_hi;
+ int32_t ihi, ilo;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx, mm;
+ xx.d = x;
+
+ ihi = xx.i[1];
+ ilo = xx.i[0];
+
+ if ((x > 0.) && (x < std::numeric_limits<double>::infinity())) {
+ int32_t e = -1023;
+
+ // Normalize denormals
+ if (static_cast<uint32_t>(ihi) < static_cast<uint32_t>(0x00100000)) {
+ x = x * 9007199254740992.0;
+ xx.d = x;
+ e -= 54;
+ ihi = xx.i[1];
+ ilo = xx.i[0];
+ }
+
+ e += (ihi >> 20);
+ ihi = (ihi & 0x800fffff) | 0x3ff00000;
+ mm.i[1] = ihi;
+ mm.i[0] = ilo;
+ m = mm.d;
+ if (static_cast<uint32_t>(ihi) > static_cast<uint32_t>(0x3ff6a09e)) {
+ m = m / 2.;
+ e = e + 1;
+ }
+
+ f = m - 1.0;
+ g = m + 1.0;
+ u = f / g;
+ u = u + u;
+
+ v = u*u;
+ q = 6.7261411553826339E-2/65536.0;
+ q = __BITREPFMA(q, v, 6.6133829643643394E-2/16384.0);
+ q = __BITREPFMA(q, v, 7.6940931149150890E-2/4096.0);
+ q = __BITREPFMA(q, v, 9.0908745692137444E-2/1024.0);
+ q = __BITREPFMA(q, v, 1.1111111499059706E-1/256.0);
+ q = __BITREPFMA(q, v, 1.4285714283305975E-1/64.0);
+ q = __BITREPFMA(q, v, 2.0000000000007223E-1/16.0);
+ q = __BITREPFMA(q, v, 3.3333333333333326E-1/4.0);
+ tmp = 2.0 * (f - u);
+ tmp = __BITREPFMA(-u, f, tmp);
+ ulo = g * tmp;
+
+ q = q * v;
+
+ log_hi = u;
+ log_lo = __BITREPFMA(q, u, ulo);
+
+ q = __BITREPFMA( e, 6.9314718055994529e-1, log_hi);
+ tmp = __BITREPFMA(-e, 6.9314718055994529e-1, q);
+ tmp = tmp - log_hi;
+ log_hi = q;
+ log_lo = log_lo - tmp;
+ log_lo = __BITREPFMA(e, 2.3190468138462996e-17, log_lo);
+ q = log_hi + log_lo;
+ } else if (x != x) {
+ q = x + x;
+ } else if (x == 0.) {
+ q = -std::numeric_limits<double>::infinity();
+ } else if (x == std::numeric_limits<double>::infinity()) {
+ q = x;
+ } else {
+ q = std::numeric_limits<double>::quiet_NaN();
+ }
+
+ return q;
+}
+#endif
+
+
+#pragma acc routine seq
+double log(double x)
+{
+ double m, f, g, u, v, tmp, q, ulo, log_lo, log_hi;
+ int32_t ihi, ilo;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx, mm;
+ xx.d = x;
+
+ ihi = xx.i[1];
+ ilo = xx.i[0];
+
+ if ((x > 0.) && (x < std::numeric_limits<double>::infinity())) {
+ int32_t e = -1023;
+
+ // Normalize denormals
+ if (static_cast<uint32_t>(ihi) < static_cast<uint32_t>(0x00100000)) {
+ x = x * 9007199254740992.0;
+ xx.d = x;
+ e -= 54;
+ ihi = xx.i[1];
+ ilo = xx.i[0];
+ }
+
+ e += (ihi >> 20);
+ ihi = (ihi & 0x800fffff) | 0x3ff00000;
+ mm.i[1] = ihi;
+ mm.i[0] = ilo;
+ m = mm.d;
+ if (static_cast<uint32_t>(ihi) > static_cast<uint32_t>(0x3ff6a09e)) {
+ m = m / 2.;
+ e = e + 1;
+ }
+
+ f = m - 1.0;
+ g = m + 1.0;
+ u = f / g;
+ u = u + u;
+
+ v = u*u;
+ q = 6.7261411553826339E-2/65536.0;
+ q = __BITREPFMA(q, v, 6.6133829643643394E-2/16384.0);
+ q = __BITREPFMA(q, v, 7.6940931149150890E-2/4096.0);
+ q = __BITREPFMA(q, v, 9.0908745692137444E-2/1024.0);
+ q = __BITREPFMA(q, v, 1.1111111499059706E-1/256.0);
+ q = __BITREPFMA(q, v, 1.4285714283305975E-1/64.0);
+ q = __BITREPFMA(q, v, 2.0000000000007223E-1/16.0);
+ q = __BITREPFMA(q, v, 3.3333333333333326E-1/4.0);
+ tmp = 2.0 * (f - u);
+ tmp = __BITREPFMA(-u, f, tmp);
+ ulo = g * tmp;
+
+ q = q * v;
+
+ log_hi = u;
+ log_lo = __BITREPFMA(q, u, ulo);
+
+ q = __BITREPFMA( e, 6.9314718055994529e-1, log_hi);
+ tmp = __BITREPFMA(-e, 6.9314718055994529e-1, q);
+ tmp = tmp - log_hi;
+ log_hi = q;
+ log_lo = log_lo - tmp;
+ log_lo = __BITREPFMA(e, 2.3190468138462996e-17, log_lo);
+ q = log_hi + log_lo;
+ } else if (x != x) {
+ q = x + x;
+ } else if (x == 0.) {
+ q = -std::numeric_limits<double>::infinity();
+ } else if (x == std::numeric_limits<double>::infinity()) {
+ q = x;
+ } /*else {
+ q = std::numeric_limits<double>::quiet_NaN();
+ }*/
+
+ return q;
+}
+
+
+double log1p(double x)
+{
+ double t;
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ xx.d = x;
+
+ int i = xx.i[1];
+ if (((unsigned)i < (unsigned)0x3fe55555) || ((int)i < (int)0xbfd99999)) {
+ /* Compute log2(x+1) = 2*atanh(x/(x+2)) */
+ t = x + 2.0;
+ t = x / t;
+ t = -x * t;
+ t = __internal_atanh_kernel(x, t);
+ } else {
+ t = log (x + 1.);
+ }
+ return t;
+}
+
+
+double __internal_exp_poly(double x)
+{
+ double t;
+
+ t = 2.5052097064908941E-008;
+ t = __BITREPFMA (t, x, 2.7626262793835868E-007);
+ t = __BITREPFMA (t, x, 2.7557414788000726E-006);
+ t = __BITREPFMA (t, x, 2.4801504602132958E-005);
+ t = __BITREPFMA (t, x, 1.9841269707468915E-004);
+ t = __BITREPFMA (t, x, 1.3888888932258898E-003);
+ t = __BITREPFMA (t, x, 8.3333333333978320E-003);
+ t = __BITREPFMA (t, x, 4.1666666666573905E-002);
+ t = __BITREPFMA (t, x, 1.6666666666666563E-001);
+ t = __BITREPFMA (t, x, 5.0000000000000056E-001);
+ t = __BITREPFMA (t, x, 1.0000000000000000E+000);
+ t = __BITREPFMA (t, x, 1.0000000000000000E+000);
+ return t;
+}
+
+double __internal_exp_scale(double x, int i)
+{
+ unsigned int j, k;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+
+ if (std::abs(i) < 1023) {
+ k = (i << 20) + (1023 << 20);
+ } else {
+ k = i + 2*1023;
+ j = k / 2;
+ j = j << 20;
+ k = (k << 20) - j;
+ xx.i[0] = 0;
+ xx.i[1] = j;
+ x = x * xx.d;
+ }
+
+ xx.i[0] = 0;
+ xx.i[1] = k;
+ x = x * xx.d;
+
+ return x;
+}
+
+double __internal_exp_kernel(double x, int scale)
+{
+ double t, z;
+ int i;
+
+ t = std::floor (x*1.4426950408889634e+0 + 4.99999999999999945e-1);
+ i = (int)t;
+ z = __BITREPFMA(t, -6.9314718055994529e-1, x);
+ z = __BITREPFMA(t, -2.3190468138462996e-17, z);
+ t = __internal_exp_poly (z);
+ z = __internal_exp_scale (t, i + scale);
+ return z;
+}
+
+#if 0
+double exp(double x)
+{
+ double t;
+ int i;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ xx.d = x;
+
+ i = xx.i[1];
+
+ if (((unsigned)i < 0x40862e43) || (i < (int)0xC0874911)) {
+ t = __internal_exp_kernel(x, 0);
+ } else {
+ t = (i < 0) ? 0 : std::numeric_limits<double>::infinity();
+ if (!(x == x)) {
+ t = x + x;
+ }
+ }
+ return t;
+}
+#endif
+
+#pragma acc routine seq
+double exp(double x)
+{
+ double t,z;
+ int i;
+
+ unsigned int j, k;
+
+ union {
+ int32_t i[2];
+ double d;
+ } xx;
+ {
+ xx.d = x;
+
+ i = xx.i[1];
+
+ if (((unsigned)i < 0x40862e43) || (i < (int)0xC0874911)) {
+ t = std::floor (x*1.4426950408889634e+0 + 4.99999999999999945e-1);
+ i = (int)t;
+ z = __BITREPFMA(t, -6.9314718055994529e-1, x);
+ z = __BITREPFMA(t, -2.3190468138462996e-17, z);
+
+ t = 2.5052097064908941E-008;
+ t = __BITREPFMA (t, z, 2.7626262793835868E-007);
+ t = __BITREPFMA (t, z, 2.7557414788000726E-006);
+ t = __BITREPFMA (t, z, 2.4801504602132958E-005);
+ t = __BITREPFMA (t, z, 1.9841269707468915E-004);
+ t = __BITREPFMA (t, z, 1.3888888932258898E-003);
+ t = __BITREPFMA (t, z, 8.3333333333978320E-003);
+ t = __BITREPFMA (t, z, 4.1666666666573905E-002);
+ t = __BITREPFMA (t, z, 1.6666666666666563E-001);
+ t = __BITREPFMA (t, z, 5.0000000000000056E-001);
+ t = __BITREPFMA (t, z, 1.0000000000000000E+000);
+ t = __BITREPFMA (t, z, 1.0000000000000000E+000);
+
+ if (std::abs(i) < 1023) {
+ k = (i << 20) + (1023 << 20);
+ } else {
+ k = i + 2*1023;
+ j = k / 2;
+ j = j << 20;
+ k = (k << 20) - j;
+ xx.i[0] = 0;
+ xx.i[1] = j;
+ t = t * xx.d;
+ }
+
+ xx.i[0] = 0;
+ xx.i[1] = k;
+ t = t * xx.d;
+ } else {
+ t = (i < 0) ? 0 : std::numeric_limits<double>::infinity();
+ if (!(x == x)) {
+ t = x + x;
+ }
+ }
+ }
+ return t;
+}
+
+
+} // End of namespace bitrep
+
+// Implement C interface
+extern "C"
+{
+double br_sin (double x) { return bitrep::sin (x); }
+double br_cos (double x) { return bitrep::cos (x); }
+double br_tan (double x) { return bitrep::tan (x); }
+double br_asin (double x) { return bitrep::asin (x); }
+double br_acos (double x) { return bitrep::acos (x); }
+double br_atan (double x) { return bitrep::atan (x); }
+double br_sinh (double x) { return bitrep::sinh (x); }
+double br_cosh (double x) { return bitrep::cosh (x); }
+double br_tanh (double x) { return bitrep::tanh (x); }
+double br_asinh(double x) { return bitrep::asinh(x); }
+double br_acosh(double x) { return bitrep::acosh(x); }
+double br_atanh(double x) { return bitrep::atanh(x); }
+#pragma acc routine seq
+double br_log (double x) { return bitrep::log (x); }
+double br_log1p(double x) { return bitrep::log1p(x); }
+#pragma acc routine seq
+double br_exp (double x) { return bitrep::exp (x); }
+}
diff --git a/src/LIB/BITREP/modi_bitrep.f90 b/src/LIB/BITREP/modi_bitrep.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de2471e0895e34e755c1c136e48691c06b81b6c2
--- /dev/null
+++ b/src/LIB/BITREP/modi_bitrep.f90
@@ -0,0 +1,60 @@
+MODULE MODI_BITREP
+!
+ USE, INTRINSIC :: ISO_C_BINDING
+!
+ IMPLICIT NONE
+!
+CONTAINS
+!
+ELEMENTAL FUNCTION BR_EXP(PVAL)
+!$acc routine seq
+!
+REAL, INTENT(IN) :: PVAL
+REAL :: BR_EXP
+!
+INTERFACE
+ PURE FUNCTION BR_EXP_C(PIN) BIND(C,NAME="br_exp")
+!$acc routine seq
+ IMPORT C_DOUBLE
+ REAL(KIND=C_DOUBLE) :: BR_EXP_C
+ REAL(KIND=C_DOUBLE),VALUE :: PIN
+ END FUNCTION
+END INTERFACE
+!
+BR_EXP = BR_EXP_C(REAL(PVAL,KIND=C_DOUBLE))
+!
+END FUNCTION
+!
+!
+ELEMENTAL FUNCTION BR_LOG(PVAL)
+!$acc routine seq
+!
+REAL, INTENT(IN) :: PVAL
+REAL :: BR_LOG
+!
+INTERFACE
+ PURE FUNCTION BR_LOG_C(PIN) BIND(C,NAME="br_log")
+!$acc routine seq
+ IMPORT C_DOUBLE
+ REAL(KIND=C_DOUBLE) :: BR_LOG_C
+ REAL(KIND=C_DOUBLE),VALUE :: PIN
+ END FUNCTION
+END INTERFACE
+!
+BR_LOG = BR_LOG_C(REAL(PVAL,KIND=C_DOUBLE))
+!
+END FUNCTION
+!
+!
+ELEMENTAL FUNCTION BR_POW(PVAL,PPOW)
+!$acc routine seq
+!
+REAL, INTENT(IN) :: PVAL,PPOW
+REAL :: BR_POW
+!
+BR_POW = BR_EXP( PPOW * BR_LOG(PVAL) )
+!
+END FUNCTION
+!
+!
+END MODULE MODI_BITREP
diff --git a/src/LIB/BITREP/readme.txt b/src/LIB/BITREP/readme.txt
new file mode 100644
index 0000000000000000000000000000000000000000..f390a6d30a365f7325b903100a048bf9a65fb797
--- /dev/null
+++ b/src/LIB/BITREP/readme.txt
@@ -0,0 +1,4 @@
+Bit-reproductible math functions.
+Original source: https://github.com/andyspiros/bitrep
+Modified by Philippe Wautelet
+Added a Fortran 2003 module file to interface Fortran and C
diff --git a/src/LIB/NEWLFI/src/NEWLFI_ALL.f b/src/LIB/NEWLFI/src/NEWLFI_ALL.f
index 3ce0beb2f5920bbc9297c7299f21e217f73fd80a..2daebeafbd1f6778c06c3e65cb6263a0c634ccfd 100644
--- a/src/LIB/NEWLFI/src/NEWLFI_ALL.f
+++ b/src/LIB/NEWLFI/src/NEWLFI_ALL.f
@@ -6737,6 +6737,9 @@ C
IRANMS=0
INBARI=0
LLVERG=.FALSE.
+CJUAN
+ CLACTI='UNKNOWN'
+
C
C Appel legerement anticipe a LFINUM, permettant une initialisa-
C tion des variables globales du logiciel a la 1ere utilisation.
diff --git a/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90 b/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
index ba51210ca67dacfb5e65e130a113b26e004715a8..664392f8aec4e80ce0cc881f70fc5c44dc2d8a46 100644
--- a/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
+++ b/src/LIB/SURCOUCHE/src/extern_usersurc_ll.f90
@@ -1318,7 +1318,7 @@
!
!! ##########################################
- SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
+ SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODE_EXCHANGE_ll, ONLY : E_UPDATE_HALO_ll => UPDATE_HALO_ll
@@ -1327,8 +1327,9 @@
!
TYPE(LIST_ll), POINTER :: TPLIST
INTEGER :: KINFO
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
- CALL E_UPDATE_HALO_ll( TPLIST, KINFO )
+ CALL E_UPDATE_HALO_ll( TPLIST, KINFO, HDIR=HDIR )
!
END SUBROUTINE UPDATE_HALO_ll
!
diff --git a/src/LIB/SURCOUCHE/src/mode_device.f90 b/src/LIB/SURCOUCHE/src/mode_device.f90
new file mode 100644
index 0000000000000000000000000000000000000000..54641b593c58fc474af959d1c0b472e606fdc76f
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/mode_device.f90
@@ -0,0 +1,228 @@
+#ifdef _FAKEOPENACC
+#undef _OPENACC
+#endif
+
+MODULE MODE_DEVICE
+
+IMPLICIT NONE
+
+INTERFACE INIT_ON_HOST_AND_DEVICE
+ MODULE PROCEDURE INIT_ON_HOST_AND_DEVICE2D, INIT_ON_HOST_AND_DEVICE3D, &
+ INIT_ON_HOST_AND_DEVICE4D
+END INTERFACE
+
+CONTAINS
+
+ SUBROUTINE GET_FROM_DEVICE(PTAB,ZTAB,O_PTAB_ON_DEVICE)
+
+#ifdef _OPENACC
+ USE&
+ OPENACC
+#endif
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:,:) :: PTAB
+ REAL, DIMENSION(:,:,:) :: ZTAB
+ LOGICAL :: O_PTAB_ON_DEVICE
+
+#ifdef _OPENACC
+ O_PTAB_ON_DEVICE = acc_is_present(PTAB)
+ if ( O_PTAB_ON_DEVICE ) then
+ !$acc data create(ZTAB)
+ !$acc kernels
+ ZTAB=PTAB
+ !$acc end kernels
+ !$acc update host(ZTAB)
+ !$acc end data
+ else
+ ZTAB=PTAB
+ endif
+#else
+ O_PTAB_ON_DEVICE = .FALSE.
+ ZTAB=PTAB
+#endif
+
+ END SUBROUTINE GET_FROM_DEVICE
+
+ SUBROUTINE PRINT_ON_DEVICE(PTAB,MES)
+
+#ifdef _OPENACC
+ USE&
+ OPENACC
+#endif
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:,:) :: PTAB
+ CHARACTER(len=*) :: MES
+ LOGICAL :: G_PTAB_ON_DEVICE,G_EXEC_ON_DEVICE
+
+#ifdef _OPENACC
+ G_PTAB_ON_DEVICE = acc_is_present(PTAB)
+ G_EXEC_ON_DEVICE = ( acc_get_device_type() <> acc_device_host )
+ if (G_EXEC_ON_DEVICE) then
+ if (G_PTAB_ON_DEVICE) then
+ print*,"PRESENT::",MES
+ else
+ print*,"ABSENT ::",MES
+ end if
+ end if
+#else
+ print*,"ABSENT ::",MES
+#endif
+
+ END SUBROUTINE PRINT_ON_DEVICE
+
+ SUBROUTINE INIT_ON_HOST_AND_DEVICE2D(PTAB,PVALUE,HNAME)
+#ifdef _OPENACC
+ USE OPENACC
+#endif
+! USE IEEE_ARITHMETIC
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PTAB
+ REAL, OPTIONAL, INTENT(IN) :: PVALUE
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
+
+ LOGICAL :: O_PTAB_ON_DEVICE
+ REAL :: ZVALUE
+ CHARACTER(LEN=:),ALLOCATABLE :: YNAME
+
+ IF (PRESENT(PVALUE)) THEN
+ ZVALUE = PVALUE
+ ELSE
+ ZVALUE = 0.
+ END IF
+
+ IF (PRESENT(HNAME)) THEN
+ YNAME = HNAME
+ ELSE
+ YNAME = 'PTAB'
+ END IF
+
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
+
+ PTAB(:,:) = ZVALUE
+
+#ifdef _OPENACC
+ O_PTAB_ON_DEVICE = acc_is_present(PTAB)
+ IF ( O_PTAB_ON_DEVICE ) THEN
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
+print *,'Initializing ',trim(YNAME),' on host and device'
+ !$acc update device(PTAB)
+ ELSE
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
+print *,'Initializing ',trim(YNAME),' on host'
+ END IF
+#endif
+
+ DEALLOCATE (YNAME)
+
+ END SUBROUTINE INIT_ON_HOST_AND_DEVICE2D
+
+ SUBROUTINE INIT_ON_HOST_AND_DEVICE3D(PTAB,PVALUE,HNAME)
+#ifdef _OPENACC
+ USE OPENACC
+#endif
+! USE IEEE_ARITHMETIC
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTAB
+ REAL, OPTIONAL, INTENT(IN) :: PVALUE
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
+
+ LOGICAL :: O_PTAB_ON_DEVICE
+ REAL :: ZVALUE
+ CHARACTER(LEN=:),ALLOCATABLE :: YNAME
+
+ IF (PRESENT(PVALUE)) THEN
+ ZVALUE = PVALUE
+ ELSE
+ ZVALUE = 0.
+ END IF
+
+ IF (PRESENT(HNAME)) THEN
+ YNAME = HNAME
+ ELSE
+ YNAME = 'PTAB'
+ END IF
+
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
+
+ PTAB(:,:,:) = ZVALUE
+
+#ifdef _OPENACC
+ O_PTAB_ON_DEVICE = acc_is_present(PTAB)
+ IF ( O_PTAB_ON_DEVICE ) THEN
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
+print *,'Initializing ',trim(YNAME),' on host and device'
+ !$acc update device(PTAB)
+ ELSE
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
+print *,'Initializing ',trim(YNAME),' on host'
+ END IF
+#endif
+
+ DEALLOCATE (YNAME)
+
+ END SUBROUTINE INIT_ON_HOST_AND_DEVICE3D
+
+ SUBROUTINE INIT_ON_HOST_AND_DEVICE4D(PTAB,PVALUE,HNAME)
+#ifdef _OPENACC
+ USE OPENACC
+#endif
+! USE IEEE_ARITHMETIC
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PTAB
+ REAL, OPTIONAL, INTENT(IN) :: PVALUE
+ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAME
+
+ LOGICAL :: O_PTAB_ON_DEVICE
+ REAL :: ZVALUE
+ CHARACTER(LEN=:),ALLOCATABLE :: YNAME
+
+ IF (PRESENT(PVALUE)) THEN
+ ZVALUE = PVALUE
+ ELSE
+ ZVALUE = 0.
+ END IF
+
+ IF (PRESENT(HNAME)) THEN
+ YNAME = HNAME
+ ELSE
+ YNAME = 'PTAB'
+ END IF
+
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_SIGNALING_NAN)
+!ZVALUE = IEEE_VALUE(ZVALUE,IEEE_QUIET_NAN)
+
+ PTAB(:,:,:,:) = ZVALUE
+
+#ifdef _OPENACC
+ O_PTAB_ON_DEVICE = acc_is_present(PTAB)
+ IF ( O_PTAB_ON_DEVICE ) THEN
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host and device'
+print *,'Initializing ',trim(YNAME),' on host and device'
+ !$acc update device(PTAB)
+ ELSE
+!print *,'Initializing ',trim(YNAME),' to ',ZVALUE,' on host'
+print *,'Initializing ',trim(YNAME),' on host'
+ END IF
+#endif
+
+ DEALLOCATE (YNAME)
+
+ END SUBROUTINE INIT_ON_HOST_AND_DEVICE4D
+END MODULE MODE_DEVICE
+
+#ifdef _FAKEOPENACC
+#define _OPENACC
+#endif
+
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
index ca137a3805112565e44b1056e950ff516ef14267..8c0736f699389604736ea45b9082ba5cf0781ba0 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
@@ -94,7 +94,7 @@
CONTAINS
!
! ########################################
- SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO)
+ SUBROUTINE UPDATE_HALO_ll(TPLIST, KINFO, HDIR )
! ########################################
!
!!**** *UPDATE_HALO_ll* - routine to update halo
@@ -159,6 +159,7 @@
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
TYPE(LIST_ll), POINTER :: TZFIELD
@@ -172,7 +173,7 @@
! -------------------------------------------------------------
!
CALL SEND_RECV_CRSPD(TCRRT_COMDATA%TSEND_HALO1, TCRRT_COMDATA%TRECV_HALO1, &
- TPLIST, TPLIST, NHALO_COM, KINFO)
+ TPLIST, TPLIST, NHALO_COM, KINFO, HDIR=HDIR )
!
!* 2. UPDATE THE ZONES THE PROCESSOR SENDS OR RECEIVED FROM ITSELF
! ------------------------------------------------------------
@@ -2241,7 +2242,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
! ##############################################################
SUBROUTINE SEND_RECV_CRSPD(TPCRSPDSEND, TPCRSPDRECV, &
TPFIELDLISTSEND, TPFIELDLISTRECV, &
- KMPI_COMM, KINFO, KBARRIER)
+ KMPI_COMM, KINFO, KBARRIER, HDIR )
! ##############################################################
!
!!**** *SEND_RECV_CRSPD*-
@@ -2338,6 +2339,7 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
INTEGER :: KMPI_COMM
INTEGER :: KINFO
INTEGER, OPTIONAL :: KBARRIER
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
!* 0.2 declarations of local variables
!
@@ -2371,6 +2373,9 @@ INTEGER,SAVE,DIMENSION(MPI_MAX_REQ) :: REQ_TAB
INTEGER,SAVE,DIMENSION(MPI_STATUS_SIZE,MPI_MAX_REQ) :: STATUS_TAB
INTEGER :: NB_REQ,NFIRST_REQ_RECV
!endif
+!
+LOGICAL :: GDIR_ALL , GLX , GLY
+INTEGER :: INX , INY
! JUAN
!
!-------------------------------------------------------------------------------
@@ -2382,6 +2387,10 @@ INTEGER :: NB_REQ,NFIRST_REQ_RECV
.OR.(.NOT.ASSOCIATED(TPFIELDLISTRECV))) THEN
RETURN
ENDIF
+ !
+ ! init test if only halo in some direction are need
+ !
+ CALL INIT_GOOD_DIR(HDIR)
!
IF (.NOT.ASSOCIATED(TPCRSPDSEND)) THEN
ISENDNB = 0
@@ -2445,6 +2454,7 @@ endif
! Build the send buffer
TZZONESEND => TPMAILSEND%TELT
IF (TZZONESEND%NUMBER /= IP) THEN
+ IF ( GOOD_DIR(TPMAILSEND) ) THEN
JINC = 0
! JUAN
!if defined (MNH_MPI_ISEND)
@@ -2467,6 +2477,7 @@ endif
endif
+ ENDIF
ENDIF
TPMAILSEND => TPMAILSEND%TNEXT
ENDIF
@@ -2482,9 +2493,8 @@ endif
! JUAN
DO WHILE (ASSOCIATED(TPMAILRECV))
- IF (TPMAILRECV%TELT%NUMBER == IP) THEN
- TPMAILRECV => TPMAILRECV%TNEXT
- ELSE
+ IF (TPMAILRECV%TELT%NUMBER /= IP) THEN
+ IF ( GOOD_DIR(TPMAILRECV) ) THEN
!if defined (MNH_MPI_ISEND)
IF ( .NOT. LMNH_MPI_BSEND) THEN
NB_REQ = NB_REQ + 1
@@ -2500,12 +2510,12 @@ endif
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,1), JINC)
endif
- ! JUAN
- TPMAILRECV => TPMAILRECV%TNEXT
- !
+ ! JUAN !
ENDIF
- !
+ ENDIF
+ TPMAILRECV => TPMAILRECV%TNEXT
+ !
ENDDO
! JUAN
@@ -2517,18 +2527,18 @@ endif
NB_REQ = NFIRST_REQ_RECV
DO WHILE (ASSOCIATED(TPMAILRECV))
- IF (TPMAILRECV%TELT%NUMBER == IP) THEN
- TPMAILRECV => TPMAILRECV%TNEXT
- ELSE
+ IF (TPMAILRECV%TELT%NUMBER /= IP) THEN
+ IF ( GOOD_DIR(TPMAILRECV) ) THEN
!
NB_REQ = NB_REQ + 1
JINC = 0
CALL FILLOUT_BUFFERS(TZFIELDLISTRECV, TPMAILRECV%TELT, TZBUFFER(:,NB_REQ), JINC)
- TPMAILRECV => TPMAILRECV%TNEXT
!
ENDIF
- !
+ ENDIF
+ !
+ TPMAILRECV => TPMAILRECV%TNEXT
ENDDO
endif
!JUAN
@@ -2544,6 +2554,86 @@ endif
ITAGOFFSET = MOD((ITAGOFFSET + NNEXTTAG), NMAXTAG)
!
!-------------------------------------------------------------------------------
+ !
+ CONTAINS
+ SUBROUTINE INIT_GOOD_DIR(HDIR)
+ !
+ ! init the direction of halo if needed
+ !
+ USE MODD_VAR_ll, ONLY : JPHALO
+ !
+ IMPLICIT NONE
+ CHARACTER(len=4), OPTIONAL :: HDIR
+ !
+
+ IF (.NOT. PRESENT(HDIR)) THEN
+ GDIR_ALL = .TRUE.
+ ELSE
+ !print*,"GOOD_DIR HDIR=",HDIR,"####"
+ GDIR_ALL = .FALSE.
+ INX = 0
+ INY = 0
+ GLX = .FALSE.
+ GLY = .FALSE.
+ IF ( HDIR == "Z0_X" ) THEN
+ !print*,"ZZZZZ0000_XXXXXXXXXXXXXXXX"
+ !GDIR_ALL = .TRUE.
+ INX = -100 ! -100 also OK so not really needed !!!
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "S0_X" ) THEN
+ !print*,"SSSSS0000_XXXXXXXXXXXXXXXX"
+ !GDIR_ALL = .TRUE.
+ INX = -100. ! JPHALO
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "Z0_Y" ) THEN
+ !print*,"ZZZZZ0000_YYYYYYYYYYYYYYY"
+ !GDIR_ALL = .TRUE.
+ INY = -100 ! -100 also OK so not really needed !!!
+ GLY = .TRUE.
+ ELSEIF ( HDIR == "S0_Y" ) THEN
+ !print*,"SSSS0000_YYYYYYYYYYYYYYY"
+ !GDIR_ALL = .TRUE.
+ INY = -100. ! JPHALO
+ GLY = .TRUE.
+ ELSEIF ( HDIR == "01_X" ) THEN
+ !print*,"01_X"
+ !GDIR_ALL = .TRUE.
+ INX = JPHALO
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "Z1_X" ) THEN
+ !print*,"ZZZZZZZZZZZZZZZZ1_X"
+ !GDIR_ALL = .TRUE.
+ INX = -100
+ GLX = .TRUE.
+ ELSEIF ( HDIR == "01_Y" ) THEN
+ !print*,"01_YYYYYYYYYYYYY"
+ !GDIR_ALL = .TRUE.
+ INY = JPHALO
+ GLY = .TRUE.
+ ELSE
+ print*,"GOOD_DIR DEFAULT :: SOMETHING WRONG !!! HDIR=",HDIR,"####"
+ STOP "INIT_GOOD_DIR :: SOMETHING WRONG !!! "
+ END IF
+ END IF
+ END SUBROUTINE INIT_GOOD_DIR
+ !
+ LOGICAL FUNCTION GOOD_DIR(TP)
+ IMPLICIT NONE
+ type(crspd_ll) :: TP
+ !
+ !GOOD_DIR = .TRUE. ; RETURN ! JUAN TEST NHALO
+ !
+ GOOD_DIR = .FALSE.
+ ! RETURN
+ IF (GDIR_ALL) THEN
+ GOOD_DIR = .TRUE.
+ ELSEIF ( GLX ) THEN
+ GOOD_DIR = ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) == INX ) .AND. ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) /= INX )
+ ELSEIF ( GLY ) THEN
+ GOOD_DIR = ( (TP%TELT%NYEND - TP%TELT%NYOR + 1 ) == INY ) .AND. ( (TP%TELT%NXEND - TP%TELT%NXOR + 1 ) /= INY )
+ END IF
+ !
+ END FUNCTION GOOD_DIR
!
END SUBROUTINE SEND_RECV_CRSPD
!
diff --git a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90 b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
index 5614c9799ea758d1420373c1671b1f6c0ffde679..88d4b6e1f473008876cdd6a4f6f74811d9642256 100644
--- a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
@@ -1,3 +1,7 @@
+#ifdef _FAKEOPENACC
+#undef _OPENACC
+#endif
+
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
@@ -24,6 +28,11 @@ CONTAINS
#endif
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
!JUANZ
+#ifdef _OPENACC
+ USE OPENACC
+#endif
+ !USE IEEE_ARITHMETIC
+
IMPLICIT NONE
INTEGER :: KINFO_ll
@@ -42,6 +51,22 @@ CONTAINS
#endif
!JUANZ
+#if 0
+ !Try to initialise device memory by creating a big array
+ REAL,dimension(:,:,:),allocatable :: big
+ !$acc declare create(big)
+
+
+ allocate(big(1024,1024,128))
+
+ !$acc kernels pcopyout(big)
+ big(:,:,:)=1e123
+ !big(:,:,:)=IEEE_VALUE(big(1,1,1),IEEE_QUIET_NAN)
+ !$acc end kernels
+ print *,'big=',big(1,1,1),big(1000,1024,128)
+
+ deallocate(big)
+#endif
!
KINFO_ll = 0
CALL MPI_INITIALIZED(GISINIT, KINFO_ll)
@@ -60,7 +85,21 @@ CONTAINS
! Read namelist config file
!
IF ( irank .EQ. 0 ) THEN
- PRINT*,"hello world from rank=",irank," nproc=",IPROC
+ PRINT*,"Hello world from rank=",irank," nproc=",IPROC
+#ifdef _OPENACC
+ IF ( OPENACC_VERSION == 201111 ) THEN
+ PRINT *,"Using OpenACC 1.0"
+ ELSE IF ( OPENACC_VERSION == 201306 ) THEN
+ PRINT *,"Using OpenACC 2.0"
+ ELSE IF ( OPENACC_VERSION == 201510 ) THEN
+ PRINT *,"Using OpenACC 2.5"
+ ELSE
+ PRINT *,"Using OpenACC (unknown version)"
+ ENDIF
+ PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_NVIDIA)," NVIDIA GPU(s) (for rank 0)"
+ PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_RADEON)," Radeon GPU(s) (for rank 0)"
+ PRINT *," with ",ACC_GET_NUM_DEVICES(ACC_DEVICE_XEONPHI)," Xeon Phi(s) (for rank 0)"
+#endif
OPEN(unit=10,form="formatted",file=conf_mnh_world,STATUS='OLD',iostat=IERR)
! Read IO parameter
IF (IERR.EQ.0) THEN
@@ -158,3 +197,7 @@ CONTAINS
END MODULE MODE_MNH_WORLD
+
+#ifdef _FAKEOPENACC
+#define _OPENACC
+#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_mppdb.f90 b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
index 42bff6b5a7bef6b3265d4d61f20039f045cca9b0..cf5ac31a5b5b7b67f567e8b95854971b57a7c6e8 100644
--- a/src/LIB/SURCOUCHE/src/mode_mppdb.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mppdb.f90
@@ -2,6 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+#define _COLOR_OUTPUT
MODULE MODE_MPPDB
!
! Modifs :
@@ -10,6 +11,8 @@ MODULE MODE_MPPDB
! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! G.Delautier : 23/06/2016 : surfex v8
!
+ USE ISO_FORTRAN_ENV , ONLY : OUTPUT_UNIT
+
IMPLICIT NONE
@@ -33,6 +36,7 @@ MODULE MODE_MPPDB
REAL :: PRECISION = 1e-8 * 0.0
LOGICAL :: MPPDB_CHECK_LB = .FALSE.
+ LOGICAL :: MPPDB_CHECK_LB_CORNERS = .FALSE.
CONTAINS
@@ -49,13 +53,14 @@ CONTAINS
USE MODE_MNH_WORLD , ONLY : INIT_NMNH_COMM_WORLD
USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
!JUANZ
+ USE MODD_MPIF
+
IMPLICIT NONE
- INCLUDE "mpif.h"
+ !INCLUDE "mpif.h"
INTEGER :: IUNIT = 100
INTEGER :: IERR
- INTEGER :: IRANK_WORLD,IRANK_INTRA
INTEGER :: NBPROC_WORLD,NBPROC_INTRA
LOGICAL :: GISINIT
@@ -69,7 +74,7 @@ CONTAINS
- NAMELIST /NAM_MPPDB/ MPPDB_DEBUG,MPPDB_EXEC,MPPDB_HOST,MPPDB_NBSON,MPPDB_WDIR,MPPDB_CHECK_LB
+ NAMELIST /NAM_MPPDB/ MPPDB_DEBUG,MPPDB_EXEC,MPPDB_HOST,MPPDB_NBSON,MPPDB_WDIR,MPPDB_CHECK_LB,MPPDB_CHECK_LB_CORNERS
!NMNH_COMM_WORLD = MPI_COMM_WORLD
@@ -181,7 +186,7 @@ CONTAINS
! I'm the first father
IF (MPPDB_DEBUG) print*,"MPPDB_INIT :: FIRST FATHER mppdb_irank_intra=", mppdb_irank_intra &
,"mppdb_nbproc_intra=",mppdb_nbproc_intra
- call flush(6)
+ call flush(OUTPUT_UNIT)
endif
!
! Wait the sons
@@ -260,10 +265,11 @@ CONTAINS
USE MODD_PARAMETERS_ll, ONLY : JPHEXT
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
- USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM
+ USE MODD_MPIF , ONLY : MPI_CHARACTER, MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM, MPI_MAX
- IMPLICIT NONE
+ USE MODE_DEVICE
+ IMPLICIT NONE
REAL, DIMENSION(:,:,:) :: PTAB
CHARACTER(len=*) :: MESSAGE
@@ -272,22 +278,32 @@ CONTAINS
!
! local var
!
- REAL,ALLOCATABLE,TARGET, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll,TAB_SAVE_ll
+ INTEGER,PARAMETER :: MAXPAS = 2
+ INTEGER,PARAMETER :: MAXMSGLEN = 256
+ REAL,ALLOCATABLE,TARGET, DIMENSION(:,:,:) :: TAB_ll,TAB_SON_ll
+
INTEGER :: IIMAX_ll,IJMAX_ll
- INTEGER :: IIU,IJU,IIU_ll,IJU_ll,IKU_ll
+ INTEGER :: IIU_ll,IJU_ll,IKU_ll
INTEGER :: IINFO_ll
- INTEGER,PARAMETER :: ITAG1 = 12345 , ITAG2 = 123456
+ INTEGER,PARAMETER :: ITAG = 12345
INTEGER :: I_FIRST_SON
INTEGER :: I_FIRST_FATHER
- REAL :: MAX_DIFF , MAX_VAL
+ REAL,DIMENSION(MAXPAS) :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
INTEGER :: IGLBSIZEPTAB
REAL,POINTER, DIMENSION(:,:,:) :: TAB_INTERIOR_ll ! for easy debug
- INTEGER :: IK
- INTEGER :: KSIZEBUF
+
+ REAL, DIMENSION(size(ptab,1),size(ptab,2),size(ptab,3)) :: ZTAB
+ LOGICAL :: G_PTAB_ON_DEVICE
+ INTEGER :: IPAS,NPAS,NPAS_ll
+ LOGICAL,DIMENSION(MAXPAS) :: OK
+ CHARACTER(len=40) :: YMSG
+ REAL :: DIV
+ CHARACTER(len=MAXMSGLEN) :: MSG
+ CHARACTER(len=MAXMSGLEN),DIMENSION(:),ALLOCATABLE :: ALLMSG
INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll
INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
@@ -303,113 +319,223 @@ CONTAINS
IF ( IGLBSIZEPTAB == 0 ) RETURN
!
CALL MPPDB_BARRIER()
- !
- IF(MPPDB_FATHER_WORLD) THEN
- !
- ! Reconstruct the whole PTAB in TAB_ll
- !
- CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
- IIU_ll = IIMAX_ll+2*JPHEXT
- IJU_ll = IJMAX_ll+2*JPHEXT
- IKU_ll = SIZE(PTAB,3)
- ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
- ALLOCATE(TAB_SAVE_ll(IIU_ll,IJU_ll,IKU_ll))
- CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
- IF (MPPDB_IRANK_WORLD.EQ.0) THEN
- !
- ! I'm the first FATHER => recieve the correct globale ARRAY from first son
- !
- !
- ! the first son , is the next processus after this 'world' so
- !
- I_FIRST_SON = MPPDB_NBPROC_WORLD
- !
- ! recieve JPHEXT from son if different
- !
- CALL MPI_RECV(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_SON, &
- ITAG1, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
+ ALLOCATE(ALLMSG(MPPDB_NBPROC_INTRA))
+ MSG = MESSAGE
+ CALL MPI_ALLGATHER(MSG,LEN(MSG),MPI_CHARACTER,ALLMSG,LEN(MSG),MPI_CHARACTER,MPPDB_INTRA_COMM,IINFO_ll)
+ DO IPAS = 1, MPPDB_NBPROC_INTRA
+ IF ( ALLMSG(IPAS) /= MSG ) THEN
+ PRINT *,'Error in MPPDB_CHECK3D: message not similar on all processes'
+ print *,'**',trim(ALLMSG(IPAS)),'**',trim(msg),'**'
+ CALL MPI_ABORT(MPPDB_INTRA_COMM,123,IINFO_ll)
+ END IF
+ END DO
+ DEALLOCATE(ALLMSG)
+
+ CALL GET_FROM_DEVICE(PTAB,ZTAB,G_PTAB_ON_DEVICE)
- !IHEXT_SON_ll = JPHEXT
+ NPAS = 1
+ IF (G_PTAB_ON_DEVICE) NPAS=2
+ CALL MPI_ALLREDUCE(NPAS,NPAS_ll,1,MPI_INTEGER,MPI_MAX,MPPDB_INTRA_COMM,IINFO_ll)
- IIU_SON_ll = IIMAX_ll+2*IHEXT_SON_ll
- IJU_SON_ll = IJMAX_ll+2*IHEXT_SON_ll
- IKU_SON_ll = SIZE(PTAB,3)
-
- ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll))
- !
- CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- ITAG2, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
- !
+ MAX_DIFF(:) = 0.0
- !
+ IF (NPAS_ll>MAXPAS) THEN
+ NPAS_ll = MAXPAS
+ print *,'Warning: in MPPDB_CHECK3D: NPAS_ll reduced to ',MAXPAS
+ END IF
- IF (MPPDB_CHECK_LB) THEN
- IDIFF_HEXT = MIN(JPHEXT,IHEXT_SON_ll)
- ELSE
- IDIFF_HEXT = 0
- ENDIF
- IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
- IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
-
- IIB_SON_ll = 1 + IHEXT_SON_ll ; IJB_SON_ll = 1 + IHEXT_SON_ll
- IIE_SON_ll = IIU_SON_ll-IHEXT_SON_ll ; IJE_SON_ll = IJU_SON_ll-IHEXT_SON_ll
+ DO IPAS=1,NPAS_ll
+ IF ((IPAS.EQ.2) .AND. G_PTAB_ON_DEVICE ) ZTAB = PTAB ! the 2 time test the value on host
+ !
+ IF(MPPDB_FATHER_WORLD) THEN
!
- TAB_SAVE_ll = TAB_ll
- TAB_ll = 0.0
- TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) &
- = ABS ( TAB_SAVE_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll) &
- - TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT &
- ,1:IKU_SON_ll) )
-
- MAX_VAL = MAXVAL( ABS (TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,&
- IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT,1:IKU_SON_ll) ) )
- IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
- MAX_DIFF=MAXVAL(TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)/MAX_VAL)
- TAB_INTERIOR_ll=> TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)
+ ! Reconstruct the whole PTAB in TAB_ll
!
- IF (MAX_DIFF > PRECISION ) THEN
- write(6, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
- ELSE
- write(6, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ IIU_ll = IIMAX_ll+2*JPHEXT
+ IJU_ll = IJMAX_ll+2*JPHEXT
+ IKU_ll = SIZE(PTAB,3)
+ IF (.NOT. ALLOCATED(TAB_ll)) ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZTAB,TAB_ll,IINFO_ll)
+
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ !
+ ! I'm the first FATHER => recieve the correct globale ARRAY from first son
+ !
+ !
+ ! the first son , is the next processus after this 'world' so
+ !
+ I_FIRST_SON = MPPDB_NBPROC_WORLD
+ !
+ ! recieve JPHEXT from son if different
+ !
+ CALL MPI_RECV(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_SON, &
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
+
+ !IHEXT_SON_ll = JPHEXT
+
+ IIU_SON_ll = IIMAX_ll+2*IHEXT_SON_ll
+ IJU_SON_ll = IJMAX_ll+2*IHEXT_SON_ll
+ IKU_SON_ll = SIZE(PTAB,3)
+
+ IF (.NOT. ALLOCATED(TAB_SON_ll)) ALLOCATE(TAB_SON_ll(IIU_SON_ll,IJU_SON_ll,IKU_SON_ll))
+ !
+ CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
+ ITAG,MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
+ !
+ TAB_ll = ABS ( TAB_ll - TAB_SON_ll )
+ !
+ ! Set corners values to zero if we want to check the halos without the corners
+ IF ( MPPDB_CHECK_LB .AND. .NOT.MPPDB_CHECK_LB_CORNERS ) THEN
+ TAB_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_SON_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_SON_ll(1:JPHEXT, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_SON_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_SON_ll(1:JPHEXT, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, 1:JPHEXT, 1:IKU_ll) = 0d0
+ TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ TAB_SON_ll(IIU_ll-JPHEXT:IIU_ll, IJU_ll-JPHEXT:IJU_ll, 1:IKU_ll) = 0d0
+ END IF
+ !
+ IF (MPPDB_CHECK_LB) THEN
+ IDIFF_HEXT = MIN(JPHEXT,IHEXT_SON_ll)
+ ELSE
+ IDIFF_HEXT = 0
+ END IF
+ IIB_ll = 1 + JPHEXT ; IJB_ll = 1 + JPHEXT
+ IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
+
+ IIB_SON_ll = 1 + IHEXT_SON_ll ; IJB_SON_ll = 1 + IHEXT_SON_ll
+ IIE_SON_ll = IIU_SON_ll-IHEXT_SON_ll ; IJE_SON_ll = IJU_SON_ll-IHEXT_SON_ll
+
+ MAX_VAL(IPAS) = MAXVAL( ABS (TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,&
+ IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT,1:IKU_SON_ll) ) )
+ MAX_DIFF(IPAS) = MAXVAL( TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll))
+ TAB_INTERIOR_ll => TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)
+ !
+ IF ( MAX_VAL(IPAS) .EQ. 0.0 ) THEN
+ DIV=1.0
+ ELSE
+ DIV=MAX_VAL(IPAS)
+ END IF
+ IF ( MAX_DIFF(IPAS)/DIV > PRECISION ) THEN
+ OK(IPAS) = .FALSE.
+ !write(*, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," PTAB_ON_DEVICE=",l1," IPAS=",I1)' ) MESSAGE,MAX_DIFF(IPAS),MAX_VAL(IPAS),G_PTAB_ON_DEVICE,IPAS
+ ELSE
+ OK(IPAS) = .TRUE.
+ !write(*, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8," PTAB_ON_DEVICE=",l1," IPAS=",I1)' ) MESSAGE,MAX_DIFF(IPAS),MAX_VAL(IPAS),G_PTAB_ON_DEVICE,IPAS
+ END IF
+ !call flush(OUTPUT_UNIT)
+ !
+ DEALLOCATE(TAB_ll,TAB_SON_ll)
+ !
END IF
- call flush(6)
+ ELSE
!
- DEALLOCATE(TAB_ll,TAB_SON_ll)
+ ! Reconstruct the all PTAB in TAB_ll
!
- END IF
- ELSE
- !
- ! Reconstruct the all PTAB in TAB_ll
- !
- CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
- IIU_ll = IIMAX_ll+2*JPHEXT
- IJU_ll = IJMAX_ll+2*JPHEXT
- IKU_ll = SIZE(PTAB,3)
- ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
- CALL GATHERALL_FIELD_ll('XY',PTAB,TAB_ll,IINFO_ll)
- !
- ! SON WORLD
- !
- IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
+ IIU_ll = IIMAX_ll+2*JPHEXT
+ IJU_ll = IJMAX_ll+2*JPHEXT
+ IKU_ll = SIZE(PTAB,3)
+ IF (.NOT. ALLOCATED(TAB_ll)) ALLOCATE(TAB_ll(IIU_ll,IJU_ll,IKU_ll))
+ CALL GATHERALL_FIELD_ll('XY',ZTAB,TAB_ll,IINFO_ll)
!
- ! first son --> send the good array to the first father
+ ! SON WORLD
!
- I_FIRST_FATHER = 0
- IHEXT_SON_ll = JPHEXT
- CALL MPI_BSEND(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_FATHER, &
- ITAG1, MPPDB_INTRA_COMM, IINFO_ll)
-
- CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
- ITAG2, MPPDB_INTRA_COMM, IINFO_ll)
-
+ IF (MPPDB_IRANK_WORLD.EQ.0) THEN
+ !
+ ! first son --> send the good array to the first father
+ !
+ I_FIRST_FATHER = 0
+ IHEXT_SON_ll = JPHEXT
+ CALL MPI_BSEND(IHEXT_SON_ll,1,MPI_INTEGER,I_FIRST_FATHER, &
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
+
+ CALL MPI_BSEND(TAB_ll,SIZE(TAB_ll),MPI_PRECISION,I_FIRST_FATHER, &
+ ITAG, MPPDB_INTRA_COMM, IINFO_ll)
+ END IF
END IF
- END IF
+
+ CALL MPPDB_BARRIER()
- CALL MPPDB_BARRIER()
+ END DO
+
+ IF (MPPDB_FATHER_WORLD .AND. MPPDB_IRANK_WORLD.EQ.0) THEN
+ YMSG=ADJUSTL(MESSAGE)
+
+ IF (NPAS_ll == 1) THEN
+#ifdef _COLOR_OUTPUT
+ IF ( OK(1) ) THEN
+ write(*, '( A29,A22,A40," ERROR: ",e15.8," MAXVAL= ",e15.8 )' ) &
+ achar(27)//'[32mMPPDB_CHECK3D :: OK'//achar(27)//'[0m ','',YMSG, MAX_DIFF(1),MAX_VAL(1)
+ ELSE
+ write(*, '( A29,A22,A40," ERROR: ",e15.8," MAXVAL= ",e15.8 )' ) &
+ achar(27)//'[31mMPPDB_CHECK3D :: KO'//achar(27)//'[0m ','',YMSG, MAX_DIFF(1),MAX_VAL(1)
+ END IF
+#else
+ IF ( OK(1) ) THEN
+ write(*, '(" MPPDB_CHECK3D :: OK MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF(1),MAX_VAL(1)
+ ELSE
+ write(*, '(" MPPDB_CHECK3D :: PB MPPDB_CHECK3D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF(1),MAX_VAL(1)
+ END IF
+#endif
+ call flush(OUTPUT_UNIT)
+ ELSE IF (NPAS_ll == 2) THEN
+#ifdef _COLOR_OUTPUT
+ IF ( OK(1) .AND. OK(2) ) THEN
+ write(*, '( A51,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ achar(27)//'[32mMPPDB_CHECK3D :: OK on host, OK on device'//achar(27)//'[0m ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(1) .AND. .NOT.OK(2) ) THEN
+ write(*, '( A51,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ achar(27)//'[31mMPPDB_CHECK3D :: KO on host, KO on device'//achar(27)//'[0m ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(1) ) THEN
+ write(*, '( A51,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ achar(27)//'[33mMPPDB_CHECK3D :: OK on host, KO on device'//achar(27)//'[0m ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(2) ) THEN
+ write(*, '( A51,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ achar(27)//'[33mMPPDB_CHECK3D :: KO on host, OK on device'//achar(27)//'[0m ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ END IF
+#else
+ IF ( OK(1) .AND. OK(2) ) THEN
+ write(*, '( A42,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ 'MPPDB_CHECK3D :: OK on host, OK on device ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(1) .AND. .NOT.OK(2) ) THEN
+ write(*, '( A42,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ 'MPPDB_CHECK3D :: KO on host, KO on device ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(1) ) THEN
+ write(*, '( A42,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ 'MPPDB_CHECK3D :: OK on host, KO on device ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ ELSE IF ( .NOT.OK(2) ) THEN
+ write(*, '( A42,A40," ERRORS: host=",e15.8," device=",e15.8," MAXVALS=",e15.8,e15.8 )' ) &
+ 'MPPDB_CHECK3D :: KO on host, OK on device ',YMSG, &
+ MAX_DIFF(2),MAX_DIFF(1),MAX_VAL(2),MAX_VAL(1)
+ END IF
+#endif
+ call flush(OUTPUT_UNIT)
+ ELSE
+ print *,'Warning: in MPPDB_CHECK3D: NPAS_ll>2 not (yet) implemented'
+ END IF
+ END IF
#endif
END SUBROUTINE MPPDB_CHECK3D
-
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -461,7 +587,6 @@ CONTAINS
USE MODI_GATHER_ll
USE MODD_VAR_ll , ONLY : MPI_PRECISION
USE MODD_MPIF , ONLY : MPI_INTEGER, MPI_STATUS_IGNORE, MPI_SUM
-
USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
IMPLICIT NONE
@@ -486,12 +611,12 @@ CONTAINS
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
REAL,POINTER, DIMENSION(:,:) :: TAB_INTERIOR_ll ! for easy debug
+ CHARACTER(len=40) :: YMSG
INTEGER :: IGLBSIZEPTAB
INTEGER :: IIU_SON_ll,IJU_SON_ll
INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
INTEGER :: IHEXT_SON_ll , IDIFF_HEXT
-
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
RETURN
@@ -534,9 +659,8 @@ CONTAINS
!
CALL MPI_RECV(TAB_SON_ll,SIZE(TAB_SON_ll),MPI_PRECISION,I_FIRST_SON, &
- ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE, IINFO_ll)
+ ITAG, MPPDB_INTRA_COMM,MPI_STATUS_IGNORE,IINFO_ll)
!
-
IF (MPPDB_CHECK_LB) THEN
IDIFF_HEXT = MIN(JPHEXT,IHEXT_SON_ll)
ELSE
@@ -547,7 +671,6 @@ CONTAINS
IIE_ll = IIU_ll-JPHEXT ; IJE_ll = IJU_ll-JPHEXT
IIB_SON_ll = 1 + IHEXT_SON_ll ; IJB_SON_ll = 1 + IHEXT_SON_ll
IIE_SON_ll = IIU_SON_ll-IHEXT_SON_ll ; IJE_SON_ll = IJU_SON_ll-IHEXT_SON_ll
-
!
TAB_SAVE_ll = TAB_ll
TAB_ll = 0.0
@@ -560,12 +683,23 @@ CONTAINS
IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
MAX_DIFF = MAXVAL( TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IIB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT) / MAX_VAL )
TAB_INTERIOR_ll => TAB_ll(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IIB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT)
+#ifdef _COLOR_OUTPUT
+ YMSG=ADJUSTL(MESSAGE)
IF (MAX_DIFF > PRECISION ) THEN
- write(6, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ write(*, '( A29,A22,A40," ERROR: ",e15.8," MAXVAL= ",e15.8 )' ) &
+ achar(27)//'[31mMPPDB_CHECK2D :: KO'//achar(27)//'[0m ','',YMSG, MAX_DIFF,MAX_VAL
ELSE
- write(6, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ write(*, '( A29,A22,A40," ERROR: ",e15.8," MAXVAL= ",e15.8 )' ) &
+ achar(27)//'[32mMPPDB_CHECK2D :: OK'//achar(27)//'[0m ','',YMSG, MAX_DIFF,MAX_VAL
END IF
- call flush(6)
+#else
+ IF (MAX_DIFF > PRECISION ) THEN
+ write(*, '(" MPPDB_CHECK2D :: PB MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ ELSE
+ write(*, '(" MPPDB_CHECK2D :: OK MPPDB_CHECK2D =",A40," ERROR=",e15.8," MAXVAL=",e15.8)' ) MESSAGE,MAX_DIFF , MAX_VAL
+ END IF
+#endif
+ call flush(OUTPUT_UNIT)
!
DEALLOCATE(TAB_ll,TAB_SON_ll)
!
@@ -638,13 +772,12 @@ CONTAINS
INTEGER :: I_FIRST_FATHER
REAL :: MAX_DIFF , MAX_VAL
INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll
- INTEGER :: JI
- INTEGER :: IIB,IIE,IJB,IJE
+ INTEGER :: JI
+ INTEGER :: IIB,IIE,IJB,IJE
INTEGER :: IIU_SON_ll,IJU_SON_ll,IKU_SON_ll
INTEGER :: IIB_SON_ll,IIE_SON_ll,IJB_SON_ll,IJE_SON_ll
INTEGER :: IHEXT_SON_ll , IDIFF_HEXT , IRIM_ll , IRIM_SON_ll
-
#ifdef MNH_SP4
!pas de mpi_spawn sur IBM-SP ni MPI_ARGV_NULL etc ...
RETURN
@@ -677,8 +810,7 @@ CONTAINS
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_PRECISION,JI-1 &
- ,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_PRECISION,JI-1,99,NMNH_COMM_WORLD,MPI_STATUS_IGNORE,IINFO_ll)
ELSE
CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
TX3DP = PLB(IIB:IIE,IJB:IJE,:)
@@ -751,7 +883,7 @@ CONTAINS
!
MAX_VAL = MAXVAL( ABS (TAB_SON_ll(IIB_SON_ll-IDIFF_HEXT:IIE_SON_ll+IDIFF_HEXT,&
IJB_SON_ll-IDIFF_HEXT:IJE_SON_ll+IDIFF_HEXT,1:IKU_SON_ll) ) )
- IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
+ IF ( MAX_VAL .EQ. 0.0 ) MAX_VAL = 1.0
!
MAX_DIFF=MAXVAL(Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)/MAX_VAL)
TAB_INTERIOR_ll=> Z3D(IIB_ll-IDIFF_HEXT:IIE_ll+IDIFF_HEXT,IJB_ll-IDIFF_HEXT:IJE_ll+IDIFF_HEXT,1:IKU_ll)
@@ -761,7 +893,7 @@ CONTAINS
ELSE
print*," MPPDB_CHECKLB :: OK MPPDB_CHECKLB =", MESSAGE ," ERROR=",MAX_DIFF , MAX_VAL
END IF
- call flush(6)
+ call flush(OUTPUT_UNIT)
!
DEALLOCATE(TAB_SON_ll)
!
@@ -1024,7 +1156,7 @@ CONTAINS
!
END SUBROUTINE MPPDB_CHECK_SURFEX3D
-
END MODULE MODE_MPPDB
+
diff --git a/src/LIB/SURCOUCHE/src/mode_sum_ll.f90 b/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
index 0fb29815036b842f1abdd0421a85e933b2eac5a1..983588cbb17c2280bacea7f275e12e8f35881b1e 100644
--- a/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_sum_ll.f90
@@ -1211,6 +1211,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!! MODIFICATIONS
!! -------------
! Original 16/09/98
+! 2016/07/04 Philippe Wautelet: compute SUM by hand instead of intrinsic Fortran
+! to allow bit reproductibility with PGI compiler (16.4)
!
!-------------------------------------------------------------------------------
!
@@ -1250,6 +1252,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
INTEGER :: IB, IE
INTEGER :: IGB, IGE
INTEGER :: IWEST, IEAST, INORTH, ISOUTH
+ INTEGER :: JI
!
!-------------------------------------------------------------------------------
!
@@ -1347,8 +1350,14 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_ll
!* 3. CALCULATE THE SUM
! -----------------
!
-!OCL SCALAR
- ZSUM = SUM(ZGLOBFIELD(1:IGE-IGB+1))
+!!OCL SCALAR
+! ZSUM = SUM(ZGLOBFIELD(1:IGE-IGB+1))
+ ZSUM = 0.
+!pgi$ novector
+ DO JI = 1, IGE-IGB+1
+ ZSUM = ZSUM + ZGLOBFIELD(JI)
+ END DO
+!WRITE(*,'( "ZSUM in hexa",Z)') ZSUM
!
DEALLOCATE(ZGLOBFIELD)
!
diff --git a/src/LIB/SURCOUCHE/src/modi_update_ll.f90 b/src/LIB/SURCOUCHE/src/modi_update_ll.f90
index 9405a7aa475dcdec434de27c41b39e68fe28c282..046255d89fb9b201514f60fd887af7c6b6b68e7c 100644
--- a/src/LIB/SURCOUCHE/src/modi_update_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modi_update_ll.f90
@@ -19,13 +19,14 @@
INTERFACE
!
!! ##########################################
- SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO )
+ SUBROUTINE UPDATE_HALO_ll( TPLIST, KINFO, HDIR )
!! ##########################################
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
TYPE(LIST_ll), POINTER :: TPLIST ! pointer to the list of fields to be updated
INTEGER :: KINFO ! return status
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
END SUBROUTINE UPDATE_HALO_ll
!
diff --git a/src/MNH/adv_boundaries.f90 b/src/MNH/adv_boundaries.f90
index 2dd15d81dfd9db26e09d3bca16cf1e2067267a57..cafddb0fb4bcf01ac33b266bda2fbda43825441e 100644
--- a/src/MNH/adv_boundaries.f90
+++ b/src/MNH/adv_boundaries.f90
@@ -6,22 +6,346 @@
MODULE MODI_ADV_BOUNDARIES
!#####################
!
-INTERFACE
+INTERFACE ADV_BOUNDARIES_DEVICE
+ MODULE PROCEDURE ADV_BOUNDARIES_DEVICE1, ADV_BOUNDARIES_DEVICE2, ADV_BOUNDARIES_DEVICE3
+END INTERFACE
+!
+!INTERFACE
!
- SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
+#if 0
+ SUBROUTINE ADV_BOUNDARIES_DEVICE1 ( HLBCX,HLBCY,PFIELD )
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
-REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+!$acc declare present(PFIELD)
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE1
+!
+ SUBROUTINE ADV_BOUNDARIES_DEVICE2 ( HLBCX,HLBCY,PFIELD,PFIELDI )
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
+!$acc declare present(PFIELD,PFIELDI)
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE2
+!
+ SUBROUTINE ADV_BOUNDARIES_DEVICE3 ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIElD )
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
+CHARACTER(LEN=1), INTENT(IN) :: HFIELD ! Field type
+!$acc declare present(PFIELD,PFIELDI)
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE3
+!
+ SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN), OPTIONAL :: PFIELDI
CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: HFIELD ! Field type
!
END SUBROUTINE ADV_BOUNDARIES
!
END INTERFACE
!
-
END MODULE MODI_ADV_BOUNDARIES
+#endif
!
+CONTAINS
+!
+! ####################################################################
+ SUBROUTINE ADV_BOUNDARIES_DEVICE1 ( HLBCX,HLBCY,PFIELD )
+! ####################################################################
+!
+!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+!$acc declare present(PFIELD)
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+IKB = 1 + JPVEXT
+IKE = SIZE(PFIELD,3) - JPVEXT
+IIU=SIZE(PFIELD,1)
+IJU=SIZE(PFIELD,2)
+!
+IF (SIZE(PFIELD)==0) RETURN
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+!$acc kernels
+ PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+ PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
+!$acc end kernels
+!
+!Not enough? !$acc update self(PFIELD(:,:,IKB-1))
+!Not enough? !$acc update self(PFIELD(:,:,IKE+1))
+!$acc update self(PFIELD(:,:,:))
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE1
+!
+! ####################################################################
+ SUBROUTINE ADV_BOUNDARIES_DEVICE2 ( HLBCX,HLBCY,PFIELD,PFIELDI )
+! ####################################################################
+!
+!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
+!$acc declare present(PFIELD,PFIELDI)
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+IKB = 1 + JPVEXT
+IKE = SIZE(PFIELD,3) - JPVEXT
+IIU=SIZE(PFIELD,1)
+IJU=SIZE(PFIELD,2)
+!
+IF (SIZE(PFIELD)==0) RETURN
+!
+!$acc kernels
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+!
+ PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
+
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+ PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
+!
+!
+!* 3. LATERAL BC FILLING
+! ---------------------------
+!
+ IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ PFIELD(1,:,:) = PFIELDI(1,:,:)
+ END IF
+ IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ PFIELD(IIU,:,:) = PFIELDI(IIU,:,:)
+ END IF
+ IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ PFIELD(:,1,:) = PFIELDI(:,1,:)
+ END IF
+ IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ PFIELD(:,IJU,:) = PFIELDI(:,IJU,:)
+ END IF
+!$acc end kernels
+!
+#if 0
+!Not enough?
+ !$acc update self(PFIELD(:,:,IKB-1))
+ !$acc update self(PFIELD(:,:,IKE+1))
+ IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ !$acc update self(PFIELD(1,:,:))
+ END IF
+ IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ !$acc update self(PFIELD(IIU,:,:))
+ END IF
+ IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ !$acc update self(PFIELD(:,1,:))
+ END IF
+ IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ !$acc update self(PFIELD(:,IJU,:))
+ END IF
+#else
+!$acc update self(PFIELD(:,:,:))
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE2
+!
+! ####################################################################
+ SUBROUTINE ADV_BOUNDARIES_DEVICE3 ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
+! ####################################################################
+!
+!!**** *ADV_BOUNDARIES* - routine to prepare the top and bottom Boundary Conditions
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+!
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDI
+!$acc declare present(PFIELD,PFIELDI)
+CHARACTER(LEN=1), INTENT(IN) :: HFIELD ! Field type
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: IIU, IJU ! Index End in X and Y directions
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+IKB = 1 + JPVEXT
+IKE = SIZE(PFIELD,3) - JPVEXT
+IIU=SIZE(PFIELD,1)
+IJU=SIZE(PFIELD,2)
+!
+IF (SIZE(PFIELD)==0) RETURN
+!
+!$acc kernels
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. UPPER AND LOWER BC FILLING:
+! ---------------------------
+!
+!* 2.1 COMPUTE THE FIELD EXTRAPOLATIONS AT THE GROUND
+!
+!
+ IF (HFIELD=='W') &
+ PFIELD (:,:,IKB ) = PFIELDI (:,:,IKB)
+!
+ PFIELD (:,:,IKB-1) = PFIELD (:,:,IKB)
+
+!
+!* 2.2 COMPUTE THE FIELD EXTRAPOLATIONS AT THE TOP
+!
+ PFIELD (:,:,IKE+1) = PFIELD (:,:,IKE)
+!
+!
+!* 3. LATERAL BC FILLING
+! ---------------------------
+!
+ IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ PFIELD(1,:,:) = PFIELDI(1,:,:)
+ IF (HFIELD=='U') &
+ PFIELD(2,:,:) = PFIELDI(2,:,:)
+ END IF
+ IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ PFIELD(IIU,:,:) = PFIELDI(IIU,:,:)
+ END IF
+ IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ PFIELD(:,1,:) = PFIELDI(:,1,:)
+ IF (HFIELD=='V') &
+ PFIELD(:,2,:) = PFIELDI(:,2,:)
+ END IF
+ IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ PFIELD(:,IJU,:) = PFIELDI(:,IJU,:)
+ END IF
+!$acc end kernels
+!
+#if 0
+!Not enough?
+!add also if hfield =u or v
+ !$acc update self(PFIELD(:,:,IKB-1))
+ !$acc update self(PFIELD(:,:,IKE+1))
+ IF (HLBCX(1)=='OPEN' .AND. LWEST_ll()) THEN
+ !$acc update self(PFIELD(1,:,:))
+ END IF
+ IF (HLBCX(2)=='OPEN' .AND. LEAST_ll()) THEN
+ !$acc update self(PFIELD(IIU,:,:))
+ END IF
+ IF (HLBCY(1)=='OPEN' .AND. LSOUTH_ll()) THEN
+ !$acc update self(PFIELD(:,1,:))
+ END IF
+ IF (HLBCY(2)=='OPEN' .AND. LNORTH_ll()) THEN
+ !$acc update self(PFIELD(:,IJU,:))
+ END IF
+#else
+!$acc update self(PFIELD(:,:,:))
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADV_BOUNDARIES_DEVICE3
!
! ####################################################################
SUBROUTINE ADV_BOUNDARIES ( HLBCX,HLBCY,PFIELD,PFIELDI,HFIELD )
@@ -128,3 +452,5 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADV_BOUNDARIES
+
+END MODULE MODI_ADV_BOUNDARIES
diff --git a/src/MNH/advec_4th_order_aux.f90 b/src/MNH/advec_4th_order_aux.f90
index 9da1b685187d1ed71f69670f5b10840cd969db92..aad9489c5fd3c5098dd1d37c318c458f6ec2f494 100644
--- a/src/MNH/advec_4th_order_aux.f90
+++ b/src/MNH/advec_4th_order_aux.f90
@@ -26,7 +26,9 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes
+!$acc declare present(PMEANX,PMEANY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
+!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
@@ -117,6 +119,9 @@ USE MODD_LUNIT
USE MODD_CONF
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
USE MODE_IO_ll
+#ifdef _OPENACC
+USE MODE_DEVICE
+#endif
!
IMPLICIT NONE
!
@@ -125,8 +130,10 @@ IMPLICIT NONE
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PMEANX, PMEANY ! fluxes
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMEANX, PMEANY ! fluxes
+!$acc declare present(PMEANX,PMEANY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
+!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
@@ -140,20 +147,41 @@ INTEGER:: IIE,IJE ! End useful area in x,y directions
!
INTEGER:: ILUOUT,IRESP ! for prints
!
+! JUAN ACC
+LOGICAL :: GWEST , GEAST
+LOGICAL :: GSOUTH , GNORTH
+REAL, DIMENSION(SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZHALO2_WEST,ZHALO2_EAST
+REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,3)) :: ZHALO2_SOUTH,ZHALO2_NORTH
+!$acc declare create (ZHALO2_WEST,ZHALO2_EAST,ZHALO2_SOUTH,ZHALO2_NORTH)
+!
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+#ifdef _OPENACC
+CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_WEST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_WEST')
+CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_EAST,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_EAST')
+CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_SOUTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_SOUTH')
+CALL INIT_ON_HOST_AND_DEVICE(ZHALO2_NORTH,-1e99,'ADVEC_4TH_ORDER_ALGO::ZHALO2_NORTH')
+#endif
+!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+GSOUTH = LSOUTH_ll()
+GNORTH = LNORTH_ll()
+!
!-------------------------------------------------------------------------------
!
!* 0.4. INITIALIZE THE FIELDS
! ---------------------
!
+!$acc kernels present(PMEANX,PMEANY)
PMEANX(:,:,:) = 0.0
PMEANY(:,:,:) = 0.0
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -167,6 +195,11 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
!
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
+ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
+ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
+!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
+!
+!$acc kernels present(PMEANX)
!!$ IF(NHALO == 1) THEN
IW=IIB+1
IE=IIE
@@ -193,23 +226,24 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
!* lateral boundary conditions
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
- ( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
+ ( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
!
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
- ( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
+ ( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!
!* inner domain
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
+!$acc end kernels
!
!!$!
!!$
!!$ IF(NHALO == 1) THEN
!!$ PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
-!!$ ( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
+!!$ ( PFIELDT(IW,:,:)+ZPHALO2_WEST(:,:) ) )/12.0
!!$!
!!$ PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
-!!$ ( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
+!!$ ( ZPHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
@@ -219,7 +253,12 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
CASE ('OPEN','WALL','NEST')
!
- IF (LWEST_ll()) THEN
+ZHALO2_WEST(:,:) = TPHALO2%WEST(:,:)
+ZHALO2_EAST(:,:) = TPHALO2%EAST(:,:)
+!$acc update device (ZHALO2_WEST,ZHALO2_EAST)
+!
+!$acc kernels present(PMEANX)
+ IF (GWEST) THEN
IF(KGRID == 2) THEN
IW=IIB+2 ! special case of C grid
ELSE
@@ -232,8 +271,8 @@ CASE ('OPEN','WALL','NEST')
!!$ IW=IIB
!!$ ENDIF
ENDIF
-!!$ IF (LEAST_ll() .OR. NHALO == 1) THEN
- IF (LEAST_ll() ) THEN
+!!$ IF (GEAST .OR. NHALO == 1) THEN
+ IF (GEAST) THEN
! T. Maric
! IE=IIE-1 ! original
IE=IIE
@@ -255,7 +294,7 @@ CASE ('OPEN','WALL','NEST')
!
!* Use a second order scheme at the physical border
!
- IF (LWEST_ll()) THEN
+ IF (GWEST) THEN
PMEANX(IWF-1,:,:) = 0.5*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) )
! T. Maric
! PMEANX(1,:,:) = PMEANX(IWF-1,:,:)
@@ -264,21 +303,22 @@ CASE ('OPEN','WALL','NEST')
!!$ ELSE IF (NHALO == 1) THEN
ELSE
PMEANX(IWF-1,:,:) = (7.0*( PFIELDT(IW-1,:,:)+PFIELDT(IW-2,:,:) ) - &
- ( PFIELDT(IW,:,:)+TPHALO2%WEST(:,:) ) )/12.0
+ ( PFIELDT(IW,:,:)+ZHALO2_WEST(:,:) ) )/12.0
ENDIF
!
- IF (LEAST_ll()) THEN
+ IF (GEAST) THEN
PMEANX(IEF+1,:,:) = 0.5*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) )
!!$ ELSEIF (NHALO == 1) THEN
ELSE
PMEANX(IEF+1,:,:) = (7.0*( PFIELDT(IE+1,:,:)+PFIELDT(IE,:,:) ) - &
- ( TPHALO2%EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
+ ( ZHALO2_EAST(:,:)+PFIELDT(IE-1,:,:) ) )/12.0
ENDIF
!
!* Use a fourth order scheme elsewhere
!
PMEANX(IWF:IEF,:,:) = (7.0*( PFIELDT(IW:IE,:,:)+PFIELDT(IW-1:IE-1,:,:) ) - &
( PFIELDT(IW+1:IE+1,:,:)+PFIELDT(IW-2:IE-2,:,:) ) )/12.0
+!$acc end kernels
END SELECT
!
!-------------------------------------------------------------------------------
@@ -293,6 +333,12 @@ IF ( .NOT. L2D ) THEN
!
CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
+ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
+ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
+!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
+!
+!$acc kernels present(PMEANY)
+!
!
!!$ IF(NHALO == 1) THEN
IS=IJB+1
@@ -320,21 +366,22 @@ IF ( .NOT. L2D ) THEN
!
!* lateral boundary conditions
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) ) - &
- ( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ) )/12.0
+ ( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ) )/12.0
!
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) ) - &
- ( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0
+ ( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ) )/12.0
!
!* inner domain
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
+!$acc end kernels
!!$!
!!$ IF(NHALO == 1) THEN
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
-!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ) )/12.0
+!!$ ( PFIELDT(:,IS+1,:)+ZPHALO2_SOUTH(:,:) ) )/12.0
!!$!
!!$ PMEANY(:,ISF+1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:) ) - &
-!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IS-2,:) ) )/12.0
+!!$ ( ZPHALO2_NORTH(:,:)+PFIELDT(:,IS-2,:) ) )/12.0
!!$ ENDIF
!!$!
!!$ PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
@@ -344,7 +391,12 @@ IF ( .NOT. L2D ) THEN
!
CASE ('OPEN','WALL','NEST')
!
- IF (LSOUTH_ll()) THEN
+ZHALO2_SOUTH(:,:) = TPHALO2%SOUTH(:,:)
+ZHALO2_NORTH(:,:) = TPHALO2%NORTH(:,:)
+!$acc update device (ZHALO2_SOUTH,ZHALO2_NORTH)
+!
+!$acc kernels present(PMEANY)
+ IF (GSOUTH) THEN
IF(KGRID == 3) THEN
IS=IJB+2 ! special case of C grid
ELSE
@@ -357,8 +409,8 @@ IF ( .NOT. L2D ) THEN
!!$ IS=IJB
!!$ ENDIF
ENDIF
-!!$ IF (LNORTH_ll() .OR. NHALO == 1) THEN
- IF (LNORTH_ll()) THEN
+!!$ IF (GNORTH .OR. NHALO == 1) THEN
+ IF (GNORTH) THEN
! T. Maric
! IN=IJE-1 ! original
IN=IJE
@@ -376,7 +428,7 @@ IF ( .NOT. L2D ) THEN
!
!* Use a second order scheme at the physical border
!
- IF (LSOUTH_ll()) THEN
+ IF (GSOUTH) THEN
PMEANY(:,ISF-1,:) = 0.5*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:) )
! T. Maric
! PMEANY(:,1,:) = PMEANY(:,ISF-1,:)
@@ -387,27 +439,30 @@ IF ( .NOT. L2D ) THEN
!!$ PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS,:)+PFIELDT(:,IS-1,:)) - &
!!$ ( PFIELDT(:,IS+1,:)+TPHALO2%SOUTH(:,:) ))/12.0
PMEANY(:,ISF-1,:) = (7.0*( PFIELDT(:,IS-1,:)+PFIELDT(:,IS-2,:)) - &
- ( PFIELDT(:,IS,:)+TPHALO2%SOUTH(:,:) ))/12.0
+ ( PFIELDT(:,IS,:)+ZHALO2_SOUTH(:,:) ))/12.0
ENDIF
!
- IF (LNORTH_ll()) THEN
+ IF (GNORTH) THEN
PMEANY(:,INF+1,:) = 0.5*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:) )
!!$ ELSEIF (NHALO == 1) THEN
ELSE
!!$ PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN,:)+PFIELDT(:,IN-1,:)) - &
!!$ ( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-2,:) ))/12.0
PMEANY(:,INF+1,:) = (7.0*( PFIELDT(:,IN+1,:)+PFIELDT(:,IN,:)) - &
- ( TPHALO2%NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0
+ ( ZHALO2_NORTH(:,:)+PFIELDT(:,IN-1,:) ))/12.0
ENDIF
!
!* Use a fourth order scheme elsewhere
!
PMEANY(:,ISF:INF,:) = (7.0*( PFIELDT(:,IS:IN,:)+PFIELDT(:,IS-1:IN-1,:)) - &
( PFIELDT(:,IS+1:IN+1,:)+PFIELDT(:,IS-2:IN-2,:) ))/12.0
+!$acc end kernels
!
END SELECT
ELSE
+!$acc kernels present(PMEANY)
PMEANY(:,:,:) = 0.0
+!$acc end kernels
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/advec_ppm_algo.f90 b/src/MNH/advec_ppm_algo.f90
index b7eb4415ff508d1e5c77e8d135c171e4ee3eb2bc..bde308c8e234a62af2f07f74c6d2bfdf315d5cfe 100644
--- a/src/MNH/advec_ppm_algo.f90
+++ b/src/MNH/advec_ppm_algo.f90
@@ -26,14 +26,18 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
+!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
+!$acc declare present(PCRU,PCRV,PCRW)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
@@ -47,11 +51,71 @@ END INTERFACE
END MODULE MODI_ADVEC_PPM_ALGO
!
!
+#ifdef _OPENACC
! ##########################################################################
SUBROUTINE ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
PRHODJ, PTSTEP, PTSTEP_PPM, &
PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
PSRC, TPDTCUR, PCRU, PCRV, PCRW)
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+USE MODD_TIME, ONLY: DATE_TIME
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
+!$acc declare present(PFIELDT)
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
+!$acc declare present(PCRU,PCRV,PCRW)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
+TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection
+!$acc declare present(PSRC)
+
+INTEGER :: IZPPM
+
+ CALL MNH_GET_ZT3D(IZPPM)
+
+ CALL ADVEC_PPM_ALGO_D(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
+ & PRHODJ, PTSTEP, PTSTEP_PPM, &
+ & PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
+ & PSRC, TPDTCUR, PCRU, PCRV, PCRW, &
+ & ZT3D(:,:,:,IZPPM) )
+
+ CALL MNH_REL_ZT3D(IZPPM)
+
+CONTAINS
+#endif
+! ##########################################################################
+#ifndef _OPENACC
+ SUBROUTINE ADVEC_PPM_ALGO(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
+ PRHODJ, PTSTEP, PTSTEP_PPM, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
+ PSRC, TPDTCUR, PCRU, PCRV, PCRW)
+#else
+ SUBROUTINE ADVEC_PPM_ALGO_D(HMET_ADV_SCHEME, HLBCX, HLBCY, KGRID, PFIELDT, &
+ PRHODJ, PTSTEP, PTSTEP_PPM, &
+ PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1,PRHOZ2,&
+ PSRC, TPDTCUR, PCRU, PCRV, PCRW, &
+ ZPPM)
+#endif
! ##########################################################################
!!
!!**** *ADVEC_PPM_ALGO* - interface for 3D advection with PPM type scheme
@@ -81,6 +145,9 @@ END MODULE MODI_ADVEC_PPM_ALGO
!
!
USE MODD_TYPE_DATE
+#ifdef _OPENACC
+USE MODE_DEVICE
+#endif
!
USE MODI_SHUMAN
USE MODI_PPM
@@ -94,25 +161,34 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
CHARACTER (LEN=6), INTENT(IN) :: HMET_ADV_SCHEME
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDT ! variable at t
+!$acc declare present(PFIELDT)
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU, PCRV, PCRW ! Courant numbers
+!$acc declare present(PCRU,PCRV,PCRW)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1, PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1, PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1, PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRC ! source term after advection
+!$acc declare present(PSRC)
!
!TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
!
!* 0.2 Declarations of local variables :
!
LOGICAL :: GFLAG ! Logical flag
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PFIELDT,1),SIZE(PFIELDT,2),SIZE(PFIELDT,3)) :: ZPPM ! temp PPM output
+!$acc declare present(ZPPM)
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -124,7 +200,13 @@ LOGICAL :: GFLAG ! Logical flag
!* 0. INITIAL STEP
! ------------
!
+#ifdef _OPENACC
+CALL INIT_ON_HOST_AND_DEVICE(ZPPM,PVALUE=-1e99,HNAME='ADVEC_PPM_ALGO::ZPPM')
+#endif
+!
+!$acc kernels present(PSRC,PFIELDT)
PSRC = PFIELDT
+!$acc end kernels
GFLAG = ABS(MOD(TPDTCUR%TIME/PTSTEP,2.)-1.) .LE. 0.5
!
SELECT CASE (HMET_ADV_SCHEME)
@@ -132,6 +214,10 @@ SELECT CASE (HMET_ADV_SCHEME)
! unlimited scheme (Skamarock notation)
!
CASE('PPM_00')
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_ppm_algo::PPM_00 not yet tested'
+CALL ABORT
+#endif
!
! IF (MODULO(KTCOUNT,2) .EQ. 0) THEN ! JUANTEST50
IF (GFLAG ) THEN
@@ -139,20 +225,38 @@ CASE('PPM_00')
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP_PPM)
+#else
+ CALL PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP_PPM, PSRC )
+#endif
+ !$acc kernels present(PSRC,PRHOX1)
PSRC = PSRC / PRHOX1
+ !$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP_PPM)
+#else
+ CALL PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOY1)
PSRC = PSRC / PRHOY1
+ !$acc end kernels
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S0_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP_PPM)
+#else
+ CALL PPM_S0_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOZ1)
PSRC = PSRC / PRHOZ1
+ !$acc end kernels
!
ELSE
!
@@ -160,20 +264,38 @@ CASE('PPM_00')
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S0_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP_PPM)
+#else
+ CALL PPM_S0_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOZ2)
PSRC = PSRC / PRHOZ2
+ !$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP_PPM)
+#else
+ CALL PPM_S0_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOY2)
PSRC = PSRC / PRHOY2
+ !$acc end kernels
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
- PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP_PPM)
+#ifndef _OPENACC
+ PSRC = PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP_PPM)
+#else
+ CALL PPM_S0_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOX2)
PSRC = PSRC / PRHOX2
+ !$acc end kernels
!
END IF
!
@@ -186,92 +308,180 @@ CASE('PPM_01')
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHODJ) - &
PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP_PPM)
PSRC = PSRC / PRHOX1
+#else
+ CALL PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHODJ,ZPPM,PRHOX1)
+ PSRC = ( PSRC * PRHODJ ) - ZPPM
+ PSRC = PSRC / PRHOX1
+ !$acc end kernels
+#endif
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHOX1) - &
PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP_PPM)
PSRC = PSRC / PRHOY1
+#else
+ CALL PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHOX1,ZPPM,PRHOY1)
+ PSRC = (PSRC * PRHOX1) - ZPPM
+ PSRC = PSRC / PRHOY1
+ !$acc end kernels
+#endif
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHOY1) - &
PPM_01_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP_PPM)
PSRC = PSRC / PRHOZ1
+#else
+ CALL PPM_01_Z(KGRID, PSRC, PCRW, PRHOY1, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHOY1,ZPPM,PRHOZ1)
+ PSRC = (PSRC * PRHOY1) - ZPPM
+ PSRC = PSRC / PRHOZ1
+ !$acc end kernels
+#endif
!
ELSE
!
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHODJ) - &
PPM_01_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP_PPM)
PSRC = PSRC / PRHOZ2
+#else
+ CALL PPM_01_Z(KGRID, PSRC, PCRW, PRHODJ, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHODJ,ZPPM,PRHOZ2)
+ PSRC = (PSRC * PRHODJ) - ZPPM
+ PSRC = PSRC / PRHOZ2
+ !$acc end kernels
+#endif
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHOZ2) - &
PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP_PPM)
PSRC = PSRC / PRHOY2
+#else
+ CALL PPM_01_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHOZ2,ZPPM,PRHOY2)
+ PSRC = (PSRC * PRHOZ2) - ZPPM
+ PSRC = PSRC / PRHOY2
+ !$acc end kernels
+#endif
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = (PSRC * PRHOY2) - &
PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP_PPM)
PSRC = PSRC / PRHOX2
+#else
+ CALL PPM_01_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PTSTEP, ZPPM)
+ !$acc kernels present(PSRC,PRHOY2,ZPPM,PRHOX2)
+ PSRC = (PSRC * PRHOY2) - ZPPM
+ PSRC = PSRC / PRHOX2
+ !$acc end kernels
+#endif
!
END IF
!
! monotonic scheme (Skamarock notation)
!
CASE('PPM_02')
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_ppm_algo::PPM_02 not yet tested'
+CALL ABORT
+#endif
!
IF (GFLAG ) THEN
!
!* 1. ADVECTION IN X DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PRHOX1, PTSTEP_PPM)
+#else
+ CALL PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHODJ, PRHOX1, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOX1)
PSRC = PSRC / PRHOX1
+ !$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PRHOY1, PTSTEP_PPM)
+#else
+ CALL PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOX1, PRHOY1, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOY1)
PSRC = PSRC / PRHOY1
+ !$acc end kernels
!
!* 3. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_Z(KGRID, PSRC, PCRW, PRHOY1, PRHOZ1, PTSTEP_PPM)
+#else
+ CALL PPM_S1_Z(KGRID, PSRC, PCRW, PRHOY1, PRHOZ1, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOZ1)
PSRC = PSRC / PRHOZ1
+ !$acc end kernels
!
ELSE
!
!* 1. ADVECTION IN Z DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_Z(KGRID, PSRC, PCRW, PRHODJ, PRHOZ2, PTSTEP_PPM)
+#else
+ CALL PPM_S1_Z(KGRID, PSRC, PCRW, PRHODJ, PRHOZ2, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOZ2)
PSRC = PSRC / PRHOZ2
+ !$acc end kernels
!
!* 2. ADVECTION IN Y DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PRHOY2, PTSTEP_PPM)
+#else
+ CALL PPM_S1_Y(HLBCY, KGRID, PSRC, PCRV, PRHOZ2, PRHOY2, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOY2)
PSRC = PSRC / PRHOY2
+ !$acc end kernels
!
!* 3. ADVECTION IN X DIRECTION
! ------------------------
!
+#ifndef _OPENACC
PSRC = PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PRHOX2, PTSTEP_PPM)
+#else
+ CALL PPM_S1_X(HLBCX, KGRID, PSRC, PCRU, PRHOY2, PRHOX2, PTSTEP_PPM, PSRC)
+#endif
+ !$acc kernels present(PSRC,PRHOX2)
PSRC = PSRC / PRHOX2
+ !$acc end kernels
!
END IF
!
@@ -285,6 +495,12 @@ END SELECT
! compatible to the rest of the model forcings, we need to substract the
! initial field, devide by dt and muliplty by RHODJ
!
+!$acc kernels present(PSRC,PFIELDT,PRHODJ)
PSRC = (PSRC - PFIELDT)*PRHODJ/PTSTEP_PPM
+!$acc end kernels
+!
+#ifdef _OPENACC
+END SUBROUTINE ADVEC_PPM_ALGO_D
+#endif
!
END SUBROUTINE ADVEC_PPM_ALGO
diff --git a/src/MNH/advec_weno_k_1_aux.f90 b/src/MNH/advec_weno_k_1_aux.f90
index 935ceaf4b7679f23df95cc6e79e52e0272d02785..0af47fef5511a5272f47878153a3c32d8aa50043 100644
--- a/src/MNH/advec_weno_k_1_aux.f90
+++ b/src/MNH/advec_weno_k_1_aux.f90
@@ -15,6 +15,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_UX
!
+SUBROUTINE UP_UX_DEVICE(PSRC, PRUCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRUCT,PR)
+END SUBROUTINE UP_UX_DEVICE
+!
FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
@@ -22,6 +30,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MX
!
+SUBROUTINE UP_MX_DEVICE(PSRC, PRUCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRUCT,PR)
+END SUBROUTINE UP_MX_DEVICE
+!
FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
@@ -29,6 +45,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_VY
!
+SUBROUTINE UP_VY_DEVICE(PSRC, PRVCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRVCT,PR)
+END SUBROUTINE UP_VY_DEVICE
+!
FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
@@ -36,6 +60,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MY
!
+SUBROUTINE UP_MY_DEVICE(PSRC, PRVCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRVCT,PR)
+END SUBROUTINE UP_MY_DEVICE
+!
FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
@@ -43,6 +75,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_WZ
!
+SUBROUTINE UP_WZ_DEVICE(PSRC, PRWCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRWCT,PR)
+END SUBROUTINE UP_WZ_DEVICE
+!
FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
@@ -50,6 +90,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR ! output src term
END FUNCTION UP_MZ
!
+SUBROUTINE UP_MZ_DEVICE(PSRC, PRWCT, PR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRWCT,PR)
+END SUBROUTINE UP_MZ_DEVICE
+!
END INTERFACE
!
END MODULE MODI_ADVEC_WENO_K_1_AUX
@@ -104,6 +152,57 @@ END FUNCTION UP_UX
!
!-------------------------------------------------------------------------------
!
+! ########################################################################
+ SUBROUTINE UP_UX_DEVICE(PSRC, PRUCT, PR)
+! ########################################################################
+!!
+!!**** UP_UX - upstream fluxes of U in X direction
+!! input variable PSRC is on U grid, and output PR is on mass grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRUCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+!$acc kernels
+PR(IIB:IIE,:,:) = PSRC(IIB:IIE,:,:) * (0.5+SIGN(0.5,PRUCT(IIB:IIE,:,:))) +&
+ PSRC(IIB+1:IIE+1,:,:) * (0.5-SIGN(0.5,PRUCT(IIB:IIE,:,:)))
+!
+PR(IIB-1,:,:) = PR(IIE,:,:)
+PR(IIE+1,:,:) = PR(IIB,:,:)
+!
+PR = PR * PRUCT
+!$acc end kernels
+!
+END SUBROUTINE UP_UX_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
! ########################################################################
FUNCTION UP_MX(PSRC, PRUCT) RESULT(PR)
! ########################################################################
@@ -152,6 +251,57 @@ END FUNCTION UP_MX
!
!-------------------------------------------------------------------------------
!
+! ########################################################################
+ SUBROUTINE UP_MX_DEVICE(PSRC, PRUCT, PR)
+! ########################################################################
+!!
+!!**** UP_MX - upstream fluxes of variable in X direction
+!! input variable PSRC is on MASS grid, and output PR is on U grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS GRID at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on U GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRUCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+!$acc kernels
+PR(IIB:IIE,:,:) = PSRC(IIB-1:IIE-1,:,:) * (0.5 + SIGN(0.5,PRUCT(IIB:IIE,:,:))) &
+ + PSRC(IIB:IIE,:,:) * (0.5 - SIGN(0.5,PRUCT(IIB:IIE,:,:)))
+!
+PR(IIB-1,:,:) = PR(IIE,:,:)
+PR(IIE+1,:,:) = PR(IIB,:,:)
+!
+PR = PR * PRUCT
+!$acc end kernels
+!
+END SUBROUTINE UP_MX_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
! ########################################################################
FUNCTION UP_VY(PSRC, PRVCT) RESULT(PR)
! ########################################################################
@@ -200,6 +350,57 @@ END FUNCTION UP_VY
!
!-------------------------------------------------------------------------------
!
+! ########################################################################
+ SUBROUTINE UP_VY_DEVICE(PSRC, PRVCT, PR)
+! ########################################################################
+!!
+!!**** UP_VY - upstream fluxes of V in Y direction
+!! input variable PSRC is on V grid, and output PR is on MASS grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on V grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRVCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+!$acc kernels
+PR(:,IJB:IJE,:) = PSRC(:,IJB:IJE,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
+ PSRC(:,IJB+1:IJE+1,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
+!
+PR(:,IJB-1,:) = PR(:,IJE,:)
+PR(:,IJE+1,:) = PR(:,IJB,:)
+!
+PR = PR * PRVCT
+!$acc end kernels
+!
+END SUBROUTINE UP_VY_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
! ########################################################################
FUNCTION UP_MY(PSRC, PRVCT) RESULT(PR)
! ########################################################################
@@ -248,6 +449,57 @@ END FUNCTION UP_MY
!
!-------------------------------------------------------------------------------
!
+! ########################################################################
+ SUBROUTINE UP_MY_DEVICE(PSRC, PRVCT, PR)
+! ########################################################################
+!!
+!!**** UP_MY - upstream fluxes of variable in Y direction
+!! input variable PSRC is on MASS grid, and output PR is on V grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on V GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRVCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER :: IIE,IJE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+!
+! upstream flux on mass points
+!
+!$acc kernels
+PR(:,IJB:IJE,:) = PSRC(:,IJB-1:IJE-1,:) * (0.5+SIGN(0.5,PRVCT(:,IJB:IJE,:))) +&
+ PSRC(:,IJB:IJE,:) * (0.5-SIGN(0.5,PRVCT(:,IJB:IJE,:)))
+!
+PR(:,IJB-1,:) = PR(:,IJE,:)
+PR(:,IJE+1,:) = PR(:,IJB,:)
+!
+PR = PR * PRVCT
+!$acc end kernels
+!
+END SUBROUTINE UP_MY_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
! ########################################################################
FUNCTION UP_WZ(PSRC, PRWCT) RESULT(PR)
! ########################################################################
@@ -298,6 +550,59 @@ END FUNCTION UP_WZ
!
!-------------------------------------------------------------------------------
!
+! ########################################################################
+ SUBROUTINE UP_WZ_DEVICE(PSRC, PRWCT, PR)
+! ########################################################################
+!!
+!!**** UP_WZ - upstream fluxes of W in Z direction
+!! input variable PSRC is on W grid, and output PR is on MASS grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRWCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+!$acc kernels
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB:IKE) = PSRC(:,:,IKB:IKE) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
+ PSRC(:,:,IKB+1:IKE+1) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
+!
+PR(:,:,IKB-1) = PR(:,:,IKB)
+PR(:,:,IKE+1) = PR(:,:,IKE)
+!
+PR = PR * PRWCT
+!$acc end kernels
+!
+END SUBROUTINE UP_WZ_DEVICE
+!
+!-------------------------------------------------------------------------------
+!
! ########################################################################
FUNCTION UP_MZ(PSRC, PRWCT) RESULT(PR)
! ########################################################################
@@ -345,3 +650,56 @@ PR(:,:,IKE+1) = PR(:,:,IKE)
PR = PR * PRWCT
!
END FUNCTION UP_MZ
+!
+!-------------------------------------------------------------------------------
+!
+! ########################################################################
+ SUBROUTINE UP_MZ_DEVICE(PSRC, PRWCT, PR)
+! ########################################################################
+!!
+!!**** UP_MZ - upstream fluxes of variable in Z direction
+!! input variable PSRC is on MASS grid, and output PR is on W grid
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+USE MODE_ll
+USE MODD_PARAMETERS,ONLY: JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!
+! output source term
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR ! output src term
+!$acc declare present(PSRC,PRWCT,PR)
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: IKB ! Begining useful area in x,y,z directions
+INTEGER :: IKE ! End useful area in x,y,z directions
+!
+!-------------------------------------------------------------------------------
+!
+!$acc kernels
+IKB = 1 + JPVEXT
+IKE = SIZE(PSRC,3) - JPVEXT
+!
+! upstream flux on mass points
+!
+PR(:,:,IKB:IKE) = PSRC(:,:,IKB-1:IKE-1) * (0.5+SIGN(0.5,PRWCT(:,:,IKB:IKE))) +&
+ PSRC(:,:,IKB:IKE) * (0.5-SIGN(0.5,PRWCT(:,:,IKB:IKE)))
+!
+PR(:,:,IKB-1) = PR(:,:,IKB)
+PR(:,:,IKE+1) = PR(:,:,IKE)
+!
+PR = PR * PRWCT
+!$acc end kernels
+!
+END SUBROUTINE UP_MZ_DEVICE
diff --git a/src/MNH/advec_weno_k_2_aux.f90 b/src/MNH/advec_weno_k_2_aux.f90
index 4660a4a7b972cea8f1d753d63e8bf6cab664e91e..3977e4e88073cb3aea1fffc251918bb46cf07103 100644
--- a/src/MNH/advec_weno_k_2_aux.f90
+++ b/src/MNH/advec_weno_k_2_aux.f90
@@ -8,7 +8,13 @@
!
INTERFACE
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TWEST, TEAST, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -19,16 +25,40 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TWEST,TEAST
+!$acc declare copyin(TWEST,TEAST)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_2_UX
!
! ----------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TWEST, TEAST, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -39,16 +69,40 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TWEST,TEAST
+!$acc declare copyin(TWEST,TEAST)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_2_MX
!
! ---------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY,PSRC, PRVCT, PR, TNORTH, TSOUTH, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -59,17 +113,41 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TNORTH,TSOUTH
+!$acc declare copyin(TNORTH,TSOUTH)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_2_VY
!
! ------------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TNORTH, TSOUTH, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -80,36 +158,110 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TNORTH,TSOUTH
+!$acc declare copyin(TNORTH,TSOUTH)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_2_MY
!
! -------------------------------
!
+#ifndef _OPENACC
FUNCTION WENO_K_2_WZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRwCT)
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_2_WZ
+#else
+SUBROUTINE WENO_K_2_WZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRwCT)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+!
+END SUBROUTINE WENO_K_2_WZ
+#endif
!
! ------------------------------
!
+#ifndef _OPENACC
FUNCTION WENO_K_2_MZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRwCT)
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_2_MZ
+#else
+SUBROUTINE WENO_K_2_MZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRwCT)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFPOS1,ZFPOS2,ZFNEG1,ZFNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
+!
+END SUBROUTINE WENO_K_2_MZ
+#endif
!
END INTERFACE
!
@@ -118,7 +270,13 @@ END MODULE MODI_ADVEC_WENO_K_2_AUX
!-----------------------------------------------------------------------------
!
! ############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_UX(HLBCX,PSRC, PRUCT, PR, TWEST, TEAST, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! ############################################################
!!
!!**** Computes PRUCT * PUT. Upstream fluxes of U in X direction.
@@ -149,11 +307,19 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+REAL, DIMENSION(:,:), POINTER :: TWEST, TEAST
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TWEST,TEAST
+!$acc declare copyin(TWEST,TEAST)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -166,21 +332,25 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -200,6 +370,14 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+#ifndef _OPENACC
+IF (PRESENT(TPHALO2)) THEN
+ TWEST => TPHALO2%WEST
+ TEAST => TPHALO2%EAST
+END IF
+#endif
+!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -222,6 +400,9 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
!* 1.1 CYCLIC CASE IN THE X DIRECTION:
!
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_weno_k_2_aux::ADVEC_WENO_K_2_UX::CYCL not yet tested'
+#endif
!
!!$ IF(NHALO == 1) THEN
IW=IIB
@@ -240,34 +421,34 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
! (r=1 for the first stencil ZFPOS1, r=0 for the second ZFPOS2)
!
ZFPOS1(IW:IE+1,:,:) = 0.5 * (3.0*PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))
- ZFPOS1(IW-1, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+ ZFPOS1(IW-1, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TWEST(:,:))
!
ZFPOS2(IW-1:IE,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
- ZFPOS2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TPHALO2%EAST(:,:))
+ ZFPOS2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TEAST(:,:))
!
! intermediate flux at the mass point on Ugrid (i+1/2,j,k) for negative wind
! case (from the right to the left)
! (r=0 for the second stencil ZFNEG2=ZFPOS2, r=-1 for the first ZFNEG1)
!
- ZFNEG1(IW-1:IE-1,:,:) = 0.5 * (3.0*PSRC(IW:IE,:,:) - PSRC(IW+1:IE+1,:,:))
- ZFNEG1(IE, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))
- ZFNEG2(IW-1:IE,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
- ZFNEG2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TPHALO2%EAST(:,:))
+ ZFNEG1(IW-1:IE-1,:,:) = 0.5 * (3.0*PSRC(IW:IE,:,:) - PSRC(IW+1:IE+1,:,:))
+ ZFNEG1(IE, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TEAST(:,:))
+ ZFNEG2(IW-1:IE,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
+ ZFNEG2(IE+1, :,:) = 0.5 * (PSRC(IE+1, :,:) + TEAST(:,:))
!
! smoothness indicators for positive wind case
!
ZBPOS1(IW:IE+1,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
- ZBPOS1(IW-1, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IW-1, :,:) = (PSRC(IW-1, :,:) - TWEST(:,:))**2
!
ZBPOS2(IW-1:IE,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
- ZBPOS2(IE+1, :,:) = (TPHALO2%EAST(:,:) - PSRC(IE+1, :,:))**2
+ ZBPOS2(IE+1, :,:) = (TEAST(:,:) - PSRC(IE+1, :,:))**2
!
! smoothness indicators for negative wind case
!
ZBNEG1(IW-1:IE-1,:,:) = (PSRC(IW:IE,:,:) - PSRC(IW+1:IE+1,:,:))**2
- ZBNEG1(IE, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE, :,:) = (PSRC(IE+1, :,:) - TEAST(:,:))**2
ZBNEG2(IW-1:IE,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
- ZBNEG2(IE+1, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG2(IE+1, :,:) = (PSRC(IE+1, :,:) - TEAST(:,:))**2
!
! WENO weights
!
@@ -298,9 +479,9 @@ CASE ('OPEN','WALL','NEST')
!
!!$ ELSEIF (NHALO == 1) THEN
ELSE
- ZFPOS1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))
+ ZFPOS1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW-1,:,:) - TWEST(:,:))
ZFPOS2(IW-1,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW,:,:))
- ZBPOS1(IW-1,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IW-1,:,:) = (PSRC(IW-1,:,:) - TWEST(:,:))**2
ZBPOS2(IW-1,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
!
ZFNEG1(IW-1,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
@@ -330,9 +511,9 @@ CASE ('OPEN','WALL','NEST')
ZBPOS1(IE,:,:) = (PSRC(IE,:,:) - PSRC(IE-1,:,:))**2
ZBPOS2(IE,:,:) = (PSRC(IE+1,:,:) - PSRC(IE,:,:))**2
!
- ZFNEG1(IE,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG1(IE,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TEAST(:,:))
ZFNEG2(IE,:,:) = 0.5 * (PSRC(IE,:,:) + PSRC(IE+1,:,:))
- ZBNEG1(IE,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE,:,:) = (PSRC(IE+1,:,:) - TEAST(:,:))**2
ZBNEG2(IE,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
!
ZOMP1(IE,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE,:,:))**2
@@ -372,14 +553,23 @@ CASE ('OPEN','WALL','NEST')
END SELECT
!
PR = PR * PRUCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
END SUBROUTINE ADVEC_WENO_K_2_UX
!
!------------------------------------------------------------------------------
!
! ############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_MX(HLBCX,PSRC, PRUCT, PR, TWEST, TEAST, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! ############################################################
!!
!!**** Computes PRUCT * PWT (or PRUCT * PVT). Upstream fluxes of W (or V)
@@ -410,11 +600,19 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+REAL, DIMENSION(:,:), POINTER :: TWEST, TEAST
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TWEST,TEAST
+!$acc declare copyin(TWEST,TEAST)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -427,21 +625,25 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -462,6 +664,14 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+#ifndef _OPENACC
+IF (PRESENT(TPHALO2)) THEN
+ TWEST => TPHALO2%WEST
+ TEAST => TPHALO2%EAST
+END IF
+#endif
+!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -484,6 +694,9 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
!* 1.1 CYCLIC CASE IN THE X DIRECTION:
!
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_weno_k_2_aux::ADVEC_WENO_K_2_MX::CYCL not yet tested'
+#endif
!
!!$ IF(NHALO == 1) THEN
IW=IIB
@@ -499,36 +712,36 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
! intermediate fluxes for positive wind case
!
ZFPOS1(IW+1:IE+1,:,:) = 0.5 * (3.0*PSRC(IW:IE,:,:) - PSRC(IW-1:IE-1,:,:))
- ZFPOS1(IW, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+ ZFPOS1(IW, :,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TWEST(:,:))
!! ZFPOS1(IW-1, :,:) = - 999.
!
ZFPOS2(IW:IE+1,:,:) = 0.5 * (PSRC(IW-1:IE,:,:) + PSRC(IW:IE+1,:,:))
- ZFPOS2(IW-1, :,:) = 0.5 * (TPHALO2%WEST(:,:) + PSRC(IW-1, :,:))
+ ZFPOS2(IW-1, :,:) = 0.5 * (TWEST(:,:) + PSRC(IW-1, :,:))
!
! intermediate flux for negative wind case
!
ZFNEG1(IW-1:IE,:,:) = 0.5 * (3.0*PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))
- ZFNEG1(IE+1, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))
+ ZFNEG1(IE+1, :,:) = 0.5 * (3.0*PSRC(IE+1, :,:) - TEAST(:,:))
!
ZFNEG2(IW:IE+1,:,:) = 0.5 * (PSRC(IW:IE+1,:,:) + PSRC(IW-1:IE,:,:))
- ZFNEG2(IW-1, :,:) = 0.5 * (PSRC(IW-1, :,:) + TPHALO2%WEST(:,:))
+ ZFNEG2(IW-1, :,:) = 0.5 * (PSRC(IW-1, :,:) + TWEST(:,:))
!
! smoothness indicators for positive wind case
!
ZBPOS1(IW+1:IE+1,:,:) = (PSRC(IW:IE,:,:) - PSRC(IW-1:IE-1,:,:))**2
- ZBPOS1(IW, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IW, :,:) = (PSRC(IW-1, :,:) - TWEST(:,:))**2
!! ZBPOS1(IW-1, :,:) = - 999.
!
ZBPOS2(IW:IE+1,:,:) = (PSRC(IW:IE+1,:,:) - PSRC(IW-1:IE,:,:))**2
- ZBPOS2(IW-1, :,:) = (PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS2(IW-1, :,:) = (PSRC(IW-1, :,:) - TWEST(:,:))**2
!
! smoothness indicators for negative wind case
!
ZBNEG1(IW-1:IE,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
- ZBNEG1(IE+1, :,:) = (PSRC(IE+1, :,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE+1, :,:) = (PSRC(IE+1, :,:) - TEAST(:,:))**2
!
ZBNEG2(IW:IE+1,:,:) = (PSRC(IW-1:IE,:,:) - PSRC(IW:IE+1,:,:))**2
- ZBNEG2(IW-1, :,:) = (TPHALO2%WEST(:,:) - PSRC(IW-1,:,:))**2
+ ZBNEG2(IW-1, :,:) = (TWEST(:,:) - PSRC(IW-1,:,:))**2
!
! WENO weights
!
@@ -559,9 +772,9 @@ CASE ('OPEN','WALL','NEST')
!
!!$ ELSEIF (NHALO == 1) THEN
ELSE
- ZFPOS1(IW,:,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TPHALO2%WEST(:,:))
+ ZFPOS1(IW,:,:) = 0.5 * (3.0*PSRC(IW-1, :,:) - TWEST(:,:))
ZFPOS2(IW,:,:) = 0.5 * (PSRC(IW-1, :,:) + PSRC(IW, :,:))
- ZBPOS1(IW,:,:) = (PSRC(IW-1,:,:) - TPHALO2%WEST(:,:))**2
+ ZBPOS1(IW,:,:) = (PSRC(IW-1,:,:) - TWEST(:,:))**2
ZBPOS2(IW,:,:) = (PSRC(IW, :,:) - PSRC(IW-1,:,:))**2
!
ZFNEG1(IW,:,:) = 0.5 * (3.0*PSRC(IW,:,:) - PSRC(IW+1,:,:))
@@ -591,9 +804,9 @@ CASE ('OPEN','WALL','NEST')
ZBPOS1(IE+1,:,:) = (PSRC(IE,:,:) - PSRC(IE-1,:,:))**2
ZBPOS2(IE+1,:,:) = (PSRC(IE+1,:,:) - PSRC(IE,:,:))**2
!
- ZFNEG1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))
+ ZFNEG1(IE+1,:,:) = 0.5 * (3.0*PSRC(IE+1,:,:) - TEAST(:,:))
ZFNEG2(IE+1,:,:) = 0.5 * (PSRC(IE+1, :,:) + PSRC(IE,:,:))
- ZBNEG1(IE+1,:,:) = (PSRC(IE+1,:,:) - TPHALO2%EAST(:,:))**2
+ ZBNEG1(IE+1,:,:) = (PSRC(IE+1,:,:) - TEAST(:,:))**2
ZBNEG2(IE+1,:,:) = (PSRC(IE, :,:) - PSRC(IE+1,:,:))**2
!
ZOMP1(IE+1,:,:) = ZGAMMA1 / (ZEPS + ZBPOS1(IE+1,:,:))**2
@@ -633,14 +846,23 @@ CASE ('OPEN','WALL','NEST')
END SELECT
!
PR = PR * PRUCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
END SUBROUTINE ADVEC_WENO_K_2_MX
!
!-------------------------------------------------------------------------------
!
! ############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_MY(HLBCY,PSRC, PRVCT, PR, TNORTH, TSOUTH, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! ############################################################
!!
!!**** Computes PRVCT * PUT (or PRVCT * PWT). Upstream fluxes of U (or W)
@@ -671,11 +893,19 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
-TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+!$acc declare present(PR)
+#ifndef _OPENACC
+TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+REAL, DIMENSION(:,:), POINTER :: TNORTH, TSOUTH
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TNORTH, TSOUTH
+!$acc declare copyin(TNORTH,TSOUTH)
+#endif
!
!
!* 0.2 Declarations of local variables :
@@ -689,21 +919,25 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -724,6 +958,14 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+#ifndef _OPENACC
+IF (PRESENT(TPHALO2)) THEN
+ TNORTH => TPHALO2%NORTH
+ TSOUTH => TPHALO2%SOUTH
+END IF
+#endif
+!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -746,6 +988,9 @@ SELECT CASE ( HLBCY(1) ) !
!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
!
CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_weno_k_2_aux::ADVEC_WENO_K_2_MY::CYCL not yet tested'
+#endif
!
!!$ IF(NHALO == 1) THEN
IS=IJB
@@ -761,34 +1006,34 @@ CASE ('CYCL') ! In that case one must have HLBCY(1) == HLBCY(2)
! intermediate fluxes for positive wind case
!
ZFPOS1(:,IS+1:IN+1,:) = 0.5 * (3.0*PSRC(:,IS:IN,:) - PSRC(:,IS-1:IN-1,:))
- ZFPOS1(:,IS, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IS, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TSOUTH(:,:))
!! ZFPOS1(:,IS-1, :) = - 999.
!
ZFPOS2(:,IS:IN+1,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
- ZFPOS2(:,IS-1, :) = 0.5 * (TPHALO2%SOUTH(:,:) + PSRC(:,IS-1, :))
+ ZFPOS2(:,IS-1, :) = 0.5 * (TSOUTH(:,:) + PSRC(:,IS-1, :))
!
ZFNEG1(:,IS-1:IN,:) = 0.5 * (3.0*PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))
- ZFNEG1(:,IN+1, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IN+1, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TNORTH(:,:))
!
ZFNEG2(:,IS:IN+1,:) = 0.5 * (PSRC(:,IS:IN+1,:) + PSRC(:,IS-1:IN,:))
- ZFNEG2(:,IS-1, :) = 0.5 * (PSRC(:,IS-1, :) + TPHALO2%SOUTH(:,:))
+ ZFNEG2(:,IS-1, :) = 0.5 * (PSRC(:,IS-1, :) + TSOUTH(:,:))
!
! smoothness indicators for positive wind case
!
ZBPOS1(:,IS+1:IN+1,:) = (PSRC(:,IS:IN,:) - PSRC(:,IS-1:IN-1,:))**2
- ZBPOS1(:,IS, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS1(:,IS, :) = (PSRC(:,IS-1, :) - TSOUTH(:,:))**2
!! ZBPOS1(:,IS-1, :) = - 999.
!
ZBPOS2(:,IS:IN+1,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
- ZBPOS2(:,IS-1, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS2(:,IS-1, :) = (PSRC(:,IS-1, :) - TSOUTH(:,:))**2
!
! smoothness indicators for negative wind case
!
ZBNEG1(:,IS-1:IN,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
- ZBNEG1(:,IN+1, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IN+1, :) = (PSRC(:,IN+1, :) - TNORTH(:,:))**2
!
ZBNEG2(:,IS:IN+1,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
- ZBNEG2(:,IS-1, :) = (TPHALO2%SOUTH(:,:) - PSRC(:,IS-1,:))**2
+ ZBNEG2(:,IS-1, :) = (TSOUTH(:,:) - PSRC(:,IS-1,:))**2
!
! WENO weights
!
@@ -819,9 +1064,9 @@ CASE ('OPEN','WALL','NEST')
!
!!$ ELSEIF (NHALO == 1) THEN
ELSE
- ZFPOS1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TSOUTH(:,:))
ZFPOS2(:,IS,:) = 0.5 * (PSRC(:,IS-1,:) + PSRC(:,IS,:))
- ZBPOS1(:,IS,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS1(:,IS,:) = (PSRC(:,IS-1,:) - TSOUTH(:,:))**2
ZBPOS2(:,IS,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
!
ZFNEG1(:,IS,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
@@ -851,9 +1096,9 @@ CASE ('OPEN','WALL','NEST')
ZBPOS1(:,IN+1,:) = (PSRC(:,IN,:) - PSRC(:,IN-1,:))**2
ZBPOS2(:,IN+1,:) = (PSRC(:,IN+1,:) - PSRC(:,IN,:))**2
!
- ZFNEG1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IN+1,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TNORTH(:,:))
ZFNEG2(:,IN+1,:) = 0.5 * (PSRC(:,IN+1, :) + PSRC(:,IN,:))
- ZBNEG1(:,IN+1,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IN+1,:) = (PSRC(:,IN+1,:) - TNORTH(:,:))**2
ZBNEG2(:,IN+1,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
!
ZOMP1(:,IN+1,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN+1,:))**2
@@ -893,13 +1138,22 @@ CASE ('OPEN','WALL','NEST')
END SELECT
!
PR = PR * PRVCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
END SUBROUTINE ADVEC_WENO_K_2_MY
!-------------------------------------------------------------------------------
!
! #############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY, PSRC, PRVCT, PR, TPHALO2)
+#else
+ SUBROUTINE ADVEC_WENO_K_2_VY(HLBCY, PSRC, PRVCT, PR, TNORTH, TSOUTH, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! #############################################################
!!
!!**** Computes PRVCT * PVT. Upstream fluxes of V in Y direction.
@@ -929,10 +1183,18 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifndef _OPENACC
TYPE(HALO2_ll), OPTIONAL, POINTER :: TPHALO2 ! halo2 for the field at t
+REAL, DIMENSION(:,:), POINTER :: TNORTH, TSOUTH
+#else
+REAL, DIMENSION(:,:), INTENT(IN) :: TNORTH, TSOUTH
+!$acc declare copyin(TNORTH,TSOUTH)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -945,21 +1207,25 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -980,6 +1246,14 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+#ifndef _OPENACC
+IF (PRESENT(TPHALO2)) THEN
+ TNORTH => TPHALO2%NORTH
+ TSOUTH => TPHALO2%SOUTH
+END IF
+#endif
+!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -1002,6 +1276,9 @@ SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
!* 1.1 CYCLIC CASE IN THE Y DIRECTION:
!
CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: advec_weno_k_2_aux::ADVEC_WENO_K_2_VY::CYCL not yet tested'
+#endif
!
!!$ IF(NHALO == 1) THEN
IS=IJB
@@ -1017,34 +1294,34 @@ CASE ('CYCL') ! In that case one must have HLBCX(1) == HLBCX(2)
! intermediate fluxes for positive wind case
!
ZFPOS1(:,IS:IN+1,:) = 0.5 * (3.0*PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))
- ZFPOS1(:,IS-1, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IS-1, :) = 0.5 * (3.0*PSRC(:,IS-1, :) - TSOUTH(:,:))
!
ZFPOS2(:,IS-1:IN,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
- ZFPOS2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TPHALO2%NORTH(:,:))
+ ZFPOS2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TNORTH(:,:))
!
! intermediate flux for negative wind case
!
ZFNEG1(:,IS-1:IN-1,:) = 0.5 * (3.0*PSRC(:,IS:IN,:) - PSRC(:,IS+1:IN+1,:))
- ZFNEG1(:,IN, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IN, :) = 0.5 * (3.0*PSRC(:,IN+1, :) - TNORTH(:,:))
!
ZFNEG2(:,IS-1:IN,:) = 0.5 * (PSRC(:,IS-1:IN,:) + PSRC(:,IS:IN+1,:))
- ZFNEG2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TPHALO2%NORTH(:,:))
+ ZFNEG2(:,IN+1, :) = 0.5 * (PSRC(:,IN+1, :) + TNORTH(:,:))
!
! smoothness indicators for positive wind case
!
ZBPOS1(:,IS:IN+1,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
- ZBPOS1(:,IS-1, :) = (PSRC(:,IS-1, :) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS1(:,IS-1, :) = (PSRC(:,IS-1, :) - TSOUTH(:,:))**2
!
ZBPOS2(:,IS-1:IN,:) = (PSRC(:,IS:IN+1,:) - PSRC(:,IS-1:IN,:))**2
- ZBPOS2(:,IN+1, :) = (TPHALO2%NORTH(:,:) - PSRC(:,IN+1, :))**2
+ ZBPOS2(:,IN+1, :) = (TNORTH(:,:) - PSRC(:,IN+1, :))**2
!
! smoothness indicators for negative wind case
!
ZBNEG1(:,IS-1:IN-1,:) = (PSRC(:,IS:IN,:) - PSRC(:,IS+1:IN+1,:))**2
- ZBNEG1(:,IN, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IN, :) = (PSRC(:,IN+1, :) - TNORTH(:,:))**2
!
ZBNEG2(:,IS-1:IN,:) = (PSRC(:,IS-1:IN,:) - PSRC(:,IS:IN+1,:))**2
- ZBNEG2(:,IN+1, :) = (PSRC(:,IN+1, :) - TPHALO2%NORTH(:,:))**2
+ ZBNEG2(:,IN+1, :) = (PSRC(:,IN+1, :) - TNORTH(:,:))**2
!
! WENO weights
!
@@ -1073,9 +1350,9 @@ CASE ('OPEN','WALL','NEST')
!
!!$ ELSEIF (NHALO == 1) THEN
ELSE
- ZFPOS1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))
+ ZFPOS1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS-1,:) - TSOUTH(:,:))
ZFPOS2(:,IS-1,:) = 0.5 * (PSRC(:,IS-1, :) + PSRC(:,IS,:))
- ZBPOS1(:,IS-1,:) = (PSRC(:,IS-1,:) - TPHALO2%SOUTH(:,:))**2
+ ZBPOS1(:,IS-1,:) = (PSRC(:,IS-1,:) - TSOUTH(:,:))**2
ZBPOS2(:,IS-1,:) = (PSRC(:,IS, :) - PSRC(:,IS-1,:))**2
!
ZFNEG1(:,IS-1,:) = 0.5 * (3.0*PSRC(:,IS,:) - PSRC(:,IS+1,:))
@@ -1105,9 +1382,9 @@ CASE ('OPEN','WALL','NEST')
ZBPOS1(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN-1,:))**2
ZBPOS2(:,IN,:) = (PSRC(:,IN+1,:) - PSRC(:,IN, :))**2
!
- ZFNEG1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))
+ ZFNEG1(:,IN,:) = 0.5 * (3.0*PSRC(:,IN+1,:) - TNORTH(:,:))
ZFNEG2(:,IN,:) = 0.5 * (PSRC(:,IN, :) + PSRC(:,IN+1,:))
- ZBNEG1(:,IN,:) = (PSRC(:,IN+1,:) - TPHALO2%NORTH(:,:))**2
+ ZBNEG1(:,IN,:) = (PSRC(:,IN+1,:) - TNORTH(:,:))**2
ZBNEG2(:,IN,:) = (PSRC(:,IN, :) - PSRC(:,IN+1,:))**2
!
ZOMP1(:,IN,:) = ZGAMMA1 / (ZEPS + ZBPOS1(:,IN,:))**2
@@ -1147,14 +1424,23 @@ CASE ('OPEN','WALL','NEST')
END SELECT
!
PR = PR * PRVCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
END SUBROUTINE ADVEC_WENO_K_2_VY
!
!-------------------------------------------------------------------------------
!
! ############################################
+#ifndef _OPENACC
FUNCTION WENO_K_2_WZ(PSRC, PRWCT) RESULT(PR)
+#else
+ SUBROUTINE WENO_K_2_WZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! ############################################
!!
!!* Computes PRWCT * PWT. Upstream fluxes of W in Z direction.
@@ -1181,9 +1467,15 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRwCT)
!
! output source term
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -1194,21 +1486,25 @@ INTEGER :: IT ! End useful area in x,y,z directions
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -1222,6 +1518,7 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+!$acc kernels
IB = 1 + JPVEXT
IT = SIZE(PSRC,3) - JPVEXT
!
@@ -1289,14 +1586,27 @@ PR(:,:,IT) = PSRC(:,:,IT) * (0.5+SIGN(0.5,PRWCT(:,:,IT) )) + &
PR(:,:,IT+1) = -999.
!
PR = PR * PRWCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
+#ifndef _OPENACC
END FUNCTION WENO_K_2_WZ
+#else
+END SUBROUTINE WENO_K_2_WZ
+#endif
!
!-----------------------------------------------------------------------------
!
! ############################################
+#ifndef _OPENACC
FUNCTION WENO_K_2_MZ(PSRC, PRWCT) RESULT(PR)
+#else
+ SUBROUTINE WENO_K_2_MZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFNEG1, ZFNEG2, ZBPOS1, ZBPOS2, &
+ ZBNEG1, ZBNEG2, ZOMP1, ZOMP2, ZOMN1, ZOMN2)
+#endif
! ############################################
!!
!!* Computes PRWCT * PUT (or PRWCT * PVT). Upstream fluxes of U (or V)
@@ -1324,10 +1634,16 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRwCT)
!
! output source term
!
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -1339,21 +1655,25 @@ INTEGER :: IT ! End useful area in x,y,z directions
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFPOS1, ZFPOS2
+!$acc declare present(ZFPOS1,ZFPOS2)
!
! intermediate reconstruction fluxes for negative wind case
! we need only one since ZFNEG2 = ZFPOS2
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZFNEG1, ZFNEG2
+!$acc declare present(ZFNEG1,ZFNEG2)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBPOS1, ZBPOS2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZBNEG1, ZBNEG2
+!$acc declare present(ZBPOS1,ZBPOS2,ZBNEG1,ZBNEG2)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2
+!$acc declare present(ZOMP1,ZOMP2,ZOMN1,ZOMN2)
!
! standard weights
!
@@ -1367,6 +1687,7 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+!$acc kernels
IB = 1 + JPVEXT
IT = SIZE(PSRC,3) - JPVEXT
!
@@ -1429,6 +1750,13 @@ PR(:,:,IT+1) = PSRC(:,:,IT) * (0.5+SIGN(0.5,PRWCT(:,:,IT+1) )) + &
PSRC(:,:,IT+1) * (0.5-SIGN(0.5,PRWCT(:,:,IT+1) ))
!
PR = PR * PRWCT
+!$acc end kernels
+!$acc update self(PR)
CALL GET_HALO(PR)
+!$acc update device(PR)
!
+#ifndef _OPENACC
END FUNCTION WENO_K_2_MZ
+#else
+END SUBROUTINE WENO_K_2_MZ
+#endif
diff --git a/src/MNH/advec_weno_k_3_aux.f90 b/src/MNH/advec_weno_k_3_aux.f90
index 0115668ae0a8770dcd1db16c0823d18aa78798d7..ae27d5b9f57347a672366b90102ca73ba1e64819 100644
--- a/src/MNH/advec_weno_k_3_aux.f90
+++ b/src/MNH/advec_weno_k_3_aux.f90
@@ -8,7 +8,14 @@
!
INTERFACE
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -18,15 +25,37 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_3_UX
!
!---------------------------------------------------------------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -36,15 +65,37 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_3_MX
!
!---------------------------------------------------------------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY,PSRC, PRVCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY,PSRC, PRVCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -54,16 +105,38 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_3_VY
!
!---------------------------------------------------------------------------------
!
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
USE MODE_ll
USE MODD_LUNIT
@@ -73,35 +146,110 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
!
END SUBROUTINE ADVEC_WENO_K_3_MY
!
!---------------------------------------------------------------------------------
!
+#ifndef _OPENACC
FUNCTION WENO_K_3_WZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_3_WZ
+#else
+SUBROUTINE WENO_K_3_WZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+!
+END SUBROUTINE WENO_K_3_WZ
+#endif
!
!---------------------------------------------------------------------------------
!
+#ifndef _OPENACC
FUNCTION WENO_K_3_MZ(PSRC, PRWCT) RESULT(PR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRWCT)
!
! output source term
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
!
END FUNCTION WENO_K_3_MZ
+#else
+SUBROUTINE WENO_K_3_MZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRWCT)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+!
+! Work arrays
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
+REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+!
+END SUBROUTINE WENO_K_3_MZ
+#endif
!
END INTERFACE
!
@@ -110,7 +258,14 @@ END MODULE MODI_ADVEC_WENO_K_3_AUX
!-----------------------------------------------------------------------------
!
! ############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_UX(HLBCX,PSRC, PRUCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! ############################################################
!!
!!**** Computes PRUCT * PUT. Upstream fluxes of U in X direction.
@@ -144,9 +299,11 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
!
!* 0.2 Declarations of local variables :
!
@@ -159,20 +316,24 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO non-normalized weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -188,6 +349,7 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -764,13 +926,21 @@ END IF ! IF(LWEST_ll())
!-------------------------------------------------------------------------------
!
PR = PR * PRUCT ! Add contravariant flux
+!$acc end kernels
!
END SUBROUTINE ADVEC_WENO_K_3_UX
!
!------------------------------------------------------------------------------
!
! ############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_MX(HLBCX,PSRC, PRUCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! ############################################################
!!
!!**** Computes PRUCT * PWT (or PRUCT * PVT). Upstream fluxes of W (or V)
@@ -803,10 +973,12 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRUCT)
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
!
!* 0.2 Declarations of local variables :
!
@@ -818,19 +990,23 @@ INTEGER:: ILUOUT,IRESP ! for prints
!
! intermediate reconstruction fluxes for positive wind case
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -848,6 +1024,7 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -1422,13 +1599,21 @@ END IF ! IF(LWEST_ll())
!-------------------------------------------------------------------------------
!
PR = PR * PRUCT ! Add contravariant flux
+!$acc end kernels
!
END SUBROUTINE ADVEC_WENO_K_3_MX
!
!-------------------------------------------------------------------------------
!
! ########################################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_MY(HLBCY,PSRC, PRVCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! ########################################################################
!!
!!**** Computes PRVCT * PUT (or PRVCT * PWT). Upstream fluxes of U (or W)
@@ -1462,10 +1647,12 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
!
!* 0.2 Declarations of local variables :
!
@@ -1479,15 +1666,18 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO weights
!
@@ -1495,6 +1685,7 @@ REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZWORK
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -1512,6 +1703,7 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -2088,13 +2280,21 @@ END IF ! IF(LNORTH_ll())
!-------------------------------------------------------------------------------
!
PR = PR * PRVCT ! Add contravariant flux
+!$acc end kernels
!
END SUBROUTINE ADVEC_WENO_K_3_MY
!
!-------------------------------------------------------------------------------
!
! #############################################################
+#ifndef _OPENACC
SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY, PSRC, PRVCT, PR)
+#else
+ SUBROUTINE ADVEC_WENO_K_3_VY(HLBCY, PSRC, PRVCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! #############################################################
!!
!!**** Computes PRVCT * PVT. Upstream fluxes of V in Y direction.
@@ -2127,9 +2327,11 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on U grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRVCT)
!
! output source term
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
!
!* 0.2 Declarations of local variables :
!
@@ -2142,21 +2344,25 @@ INTEGER:: ILUOUT,IRESP ! for prints
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -2174,6 +2380,7 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!* 0.4. INITIALIZE THE FIELD
! ---------------------
!
+!$acc kernels
PR(:,:,:) = 0.0
!
ZFPOS1 = 0.0
@@ -2752,13 +2959,21 @@ END IF ! IF(LNORTH_ll())
!-------------------------------------------------------------------------------
!
PR = PR * PRVCT ! Add contravariant flux
+!$acc end kernels
!
END SUBROUTINE ADVEC_WENO_K_3_VY
!
!-------------------------------------------------------------------------------
!
! ############################################
+#ifndef _OPENACC
FUNCTION WENO_K_3_WZ(PSRC, PRWCT) RESULT(PR)
+#else
+ SUBROUTINE WENO_K_3_WZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! ############################################
!!
!!* Computes PRWCT * PWT. Upstream fluxes of W in Z direction.
@@ -2787,10 +3002,16 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on W grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on MASS GRID
+!$acc declare present(PSRC,PRWCT)
!
! output source term
!
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -2801,20 +3022,24 @@ INTEGER :: IT ! End useful area in x,y,z directions
!
! intermediate reconstruction fluxes for positive wind case
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -2825,6 +3050,7 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+!$acc kernels
IB = 1 + JPVEXT
IT = SIZE(PSRC,3) - JPVEXT
!
@@ -2987,13 +3213,25 @@ PR(:,:,IT-1) = (ZOMN2(:,:,IT-1)/(ZOMN1(:,:,IT-1)+ZOMN2(:,:,IT-1))*ZFNEG2(:,:,IT-
* (0.5+SIGN(0.5,PRWCT(:,:,IT-1))) ! Total flux
!
PR = PR * PRWCT ! Add contravariant flux
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION WENO_K_3_WZ
+#else
+END SUBROUTINE WENO_K_3_WZ
+#endif
!
!-----------------------------------------------------------------------------
!
! ########################################################################
+#ifndef _OPENACC
FUNCTION WENO_K_3_MZ(PSRC, PRWCT) RESULT(PR)
+#else
+ SUBROUTINE WENO_K_3_MZ(PSRC, PRWCT, PR, &
+ ZFPOS1, ZFPOS2, ZFPOS3, ZFNEG1, ZFNEG2, ZFNEG3, &
+ ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3, &
+ ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
+#endif
! ########################################################################
!!
!!* Computes PRWCT * PUT (or PRWCT * PVT). Upstream fluxes of U (or V)
@@ -3023,9 +3261,15 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable on MASS grid at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! contrav. comp. on W grid
+!$acc declare present(PSRC,PRWCT)
!
! output source term
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -3037,20 +3281,24 @@ INTEGER :: IT ! End useful area in x,y,z directions
! intermediate reconstruction fluxes for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFPOS1, ZFPOS2, ZFPOS3
+!$acc declare present(ZFPOS1, ZFPOS2, ZFPOS3)
!
! intermediate reconstruction fluxes for negative wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZFNEG1, ZFNEG2, ZFNEG3
+!$acc declare present(ZFNEG1, ZFNEG2, ZFNEG3)
!
! smoothness indicators for positive wind case
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBPOS1, ZBPOS2, ZBPOS3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZBNEG1, ZBNEG2, ZBNEG3
+!$acc declare present(ZBPOS1, ZBPOS2, ZBPOS3, ZBNEG1, ZBNEG2, ZBNEG3)
!
! WENO weights
!
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMP1, ZOMP2, ZOMP3
REAL, DIMENSION(SIZE(PSRC,1),SIZE(PSRC,2),SIZE(PSRC,3)):: ZOMN1, ZOMN2, ZOMN3
+!$acc declare present(ZOMP1, ZOMP2, ZOMP3, ZOMN1, ZOMN2, ZOMN3)
!
! EPSILON for weno weights calculation
!
@@ -3061,6 +3309,7 @@ REAL, PARAMETER :: ZEPS = 1.0E-15
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+!$acc kernels
IB = 1 + JPVEXT
IT = SIZE(PSRC,3) - JPVEXT
!
@@ -3223,5 +3472,10 @@ PR(:,:,IT) = (ZOMP2(:,:,IT)/(ZOMP1(:,:,IT)+ZOMP2(:,:,IT)) * ZFPOS2(:,:,IT) &
(0.5-SIGN(0.5,PRWCT(:,:,IT) )) ! Total flux
!
PR = PR * PRWCT ! Add contravariant flux
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION WENO_K_3_MZ
+#else
+END SUBROUTINE WENO_K_3_MZ
+#endif
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 8318e5f0559455e04f6816443730bcac41207f7f..cc1b8cf7d5be24e8a1bcb634f75821a89a80b9a8 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -45,20 +45,29 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+!$acc declare copyin(PUT,PVT,PWT)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+!$acc declare copyin(PTHT,PTKET)
+!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+!$acc declare copyin(PRT,PSVT)
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
! of the reference state
+!$acc declare create(PTHVREF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+!$acc declare create(PRTHS,PRTKES)
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+!$acc declare create(PRRS,PRSVS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD,PRSVS_CLD
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!$acc declare create(PRTKES_ADV)
!
END SUBROUTINE ADVECTION_METSV
!
@@ -143,6 +152,11 @@ END MODULE MODI_ADVECTION_METSV
USE MODE_FM
USE MODE_ll
USE MODE_IO_ll
+#ifdef _OPENACC
+USE MODD_MPIF
+USE MODD_PARAMETERS_ll, ONLY : JPVEXT
+USE MODD_VAR_ll, ONLY : MPI_PRECISION,NMNH_COMM_WORLD
+#endif
USE MODD_PARAM_n
USE MODD_CONF, ONLY : LNEUTRAL,NHALO,L1D, L2D
USE MODD_CTURB, ONLY : XTKEMIN
@@ -159,6 +173,12 @@ USE MODI_BUDGET
USE MODI_GET_HALO
!
USE MODE_FMWRIT
+!
+#ifdef _OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -191,20 +211,30 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
+!$acc declare copyin(PUT,PVT,PWT)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
+!$acc declare copyin(PTHT,PTKET)
+!$acc declare present(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT , PSVT
+!$acc declare copyin(PRT,PSVT)
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
! of the reference state
+!$acc declare create(PTHVREF)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
+!$acc declare create(PRTHS,PRTKES)
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
+!$acc declare create(PRRS,PRSVS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS_CLD, PRSVS_CLD
+!PW: not interesting to declare PR*_CLD on device (except if async transfers?)
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source term
+!$acc declare create(PRTKES_ADV)
!
!
!* 0.2 declarations of local variables
@@ -213,37 +243,48 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTKES_ADV ! Advection TKE source te
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCPPM
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCPPM
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCPPM
+!$acc declare create(ZRUCPPM,ZRVCPPM,ZRWCPPM)
! contravariant
! components
! of momentum
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLU
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLW
+!$acc declare create(ZCFLU,ZCFLV,ZCFLW)
! ! CFL numbers on each direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFL
+!$acc declare create(ZCFL)
! ! CFL number
!
REAL :: ZCFLU_MAX, ZCFLV_MAX, ZCFLW_MAX, ZCFL_MAX ! maximum CFL numbers
!
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZTH
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZTKE
+!$acc declare create(ZTH,ZTKE)
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_OTHER
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_OTHER
+!$acc declare create(ZRTHS_OTHER,ZRTKES_OTHER)
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_PPM
+!$acc declare create(ZRTHS_PPM)
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_PPM
+!$acc declare create(ZRTKES_PPM)
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZR
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV
+!$acc declare create(ZR,ZSV)
! Guess at the sub time step
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_OTHER
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_OTHER
+!$acc declare create(ZRRS_OTHER,ZRSVS_OTHER)
! Tendencies since the beginning of the time step
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_PPM
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_PPM
+!$acc declare create(ZRRS_PPM,ZRSVS_PPM)
! Guess at the end of the sub time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1,ZRHOX2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1,ZRHOY2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1,ZRHOZ2
-REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZT,ZEXN,ZLV,ZLS,ZCPH
+!$acc declare create(ZRHOX1,ZRHOX2,ZRHOY1,ZRHOY2,ZRHOZ1,ZRHOZ2)
! Temporary advected rhodj for PPM routines
!
INTEGER :: JS,JR,JSV,JSPL ! Loop index
@@ -263,6 +304,10 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
INTEGER :: ILUOUT ! logical unit
INTEGER :: ISPLIT_PPM ! temporal time splitting
INTEGER :: IIB, IIE, IJB, IJE
+#ifdef _OPENACC
+INTEGER :: IKB,IKE
+INTEGER :: IZ1, IZ2
+#endif
!-------------------------------------------------------------------------------
!
!* 0. INITIALIZATION
@@ -272,6 +317,46 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
GTKE=(SIZE(PTKET)/=0)
!
+#ifdef _OPENACC
+!IN argument CALL INIT_ON_HOST_AND_DEVICE(PTHVREF, PVALUE=-1e99,HNAME='ADVECTION_METSV::PTHVREF')
+!IN argument CALL INIT_ON_HOST_AND_DEVICE(PRTHS, PVALUE=-1e99,HNAME='ADVECTION_METSV::PRTHS')
+!IN argument CALL INIT_ON_HOST_AND_DEVICE(PRTKES, PVALUE=-1e99,HNAME='ADVECTION_METSV::PRTKES')
+!IN argument CALL INIT_ON_HOST_AND_DEVICE(PRRS, PVALUE=-1e99,HNAME='ADVECTION_METSV::PRRS')
+!IN argument CALL INIT_ON_HOST_AND_DEVICE(PRSVS, PVALUE=-1e99,HNAME='ADVECTION_METSV::PRSVS')
+CALL INIT_ON_HOST_AND_DEVICE(PRTKES_ADV,PVALUE=-1e99,HNAME='ADVECTION_METSV::PRTKES_ADV')
+
+CALL INIT_ON_HOST_AND_DEVICE(ZRUCPPM,PVALUE=-1e90,HNAME='ADVECTION_METSV::ZRUCPPM')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVCPPM,PVALUE=-1e91,HNAME='ADVECTION_METSV::ZRVCPPM')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWCPPM,PVALUE=-1e92,HNAME='ADVECTION_METSV::ZRWCPPM')
+
+CALL INIT_ON_HOST_AND_DEVICE(ZCFLU,PVALUE=-1e99,HNAME='ADVECTION_METSV::ZCFLU')
+CALL INIT_ON_HOST_AND_DEVICE(ZCFLV,PVALUE=-1e99,HNAME='ADVECTION_METSV::ZCFLV')
+CALL INIT_ON_HOST_AND_DEVICE(ZCFLW,PVALUE=-1e99,HNAME='ADVECTION_METSV::ZCFLW')
+CALL INIT_ON_HOST_AND_DEVICE(ZCFL, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZCFL')
+
+CALL INIT_ON_HOST_AND_DEVICE(ZTH, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZTH')
+CALL INIT_ON_HOST_AND_DEVICE(ZTKE, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZTKE')
+CALL INIT_ON_HOST_AND_DEVICE(ZRTHS_OTHER, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRTHS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRTKES_OTHER,PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRTKES_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRTHS_PPM, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRTHS_PPM')
+CALL INIT_ON_HOST_AND_DEVICE(ZRTKES_PPM, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRTKES_PPM')
+CALL INIT_ON_HOST_AND_DEVICE(ZR, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZR')
+CALL INIT_ON_HOST_AND_DEVICE(ZSV, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZSV')
+CALL INIT_ON_HOST_AND_DEVICE(ZRRS_OTHER, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRRS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRSVS_OTHER, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRSVS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRRS_PPM, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRRS_PPM')
+CALL INIT_ON_HOST_AND_DEVICE(ZRSVS_PPM, PVALUE=-1e99,HNAME='ADVECTION_METSV::ZRSVS_PPM')
+
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOX1,PVALUE=-1e93,HNAME='ADVECTION_METSV::ZRHOX1')
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOX2,PVALUE=-1e94,HNAME='ADVECTION_METSV::ZRHOX2')
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOY1,PVALUE=-1e95,HNAME='ADVECTION_METSV::ZRHOY1')
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOY2,PVALUE=-1e96,HNAME='ADVECTION_METSV::ZRHOY2')
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOZ1,PVALUE=-1e97,HNAME='ADVECTION_METSV::ZRHOZ1')
+CALL INIT_ON_HOST_AND_DEVICE(ZRHOZ2,PVALUE=-1e98,HNAME='ADVECTION_METSV::ZRHOZ2')
+!
+CALL MNH_GET_ZT3D(IZ1, IZ2)
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 2. COMPUTES THE CONTRAVARIANT COMPONENTS (FOR PPM ONLY)
@@ -279,35 +364,49 @@ GTKE=(SIZE(PTKET)/=0)
!
!* 2.1 computes contravariant components
!
+!Update on host of ZRUCPPM,ZRVCPPM,ZRWCPPM is done in CONTRAV_DEVICE
+#ifndef _OPENACC
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2)
ELSE
CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4)
END IF
+#else
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+ CALL CONTRAV_DEVICE (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2, &
+ ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
+ELSE
+ CALL CONTRAV_DEVICE (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4, &
+ ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
+END IF
+#endif
!
!
!* 2.2 computes CFL numbers
!
-
+!PW: not necessary: data already on device due to contrav_device !$acc update device(ZRUCPPM,ZRVCPPM,ZRWCPPM)
+!$acc kernels present(ZCFLU,ZCFLV,ZCFLW,ZCFL) present(ZRUCPPM,ZRVCPPM,ZRWCPPM)
IF (.NOT. L1D) THEN
ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
IF (.NOT. L2D) THEN
- ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
+ ZCFL(:,:,:) = SQRT(ZCFLU(:,:,:)**2+ZCFLV(:,:,:)**2+ZCFLW(:,:,:)**2)
ELSE
- ZCFL = SQRT(ZCFLU**2+ZCFLW**2)
+ ZCFL = SQRT(ZCFLU(:,:,:)**2+ZCFLW(:,:,:)**2)
END IF
ELSE
ZCFLU = 0.0 ; ZCFLV = 0.0 ; ZCFLW = 0.0
ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFL = SQRT(ZCFLW**2)
END IF
+!$acc end kernels
!
!* prints in the file the 3D Courant numbers (one should flag this)
!
IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
+ !$acc update host(ZCFLU,ZCFLV,ZCFLW,ZCFL)
YRECFM ='CFLU'
YCOMMENT='X_Y_Z_CFLU (-)'
IGRID = 1
@@ -337,10 +436,29 @@ END IF
!
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!
+#ifndef _OPENACC
ZCFLU_MAX = MAX_ll(ZCFLU,IINFO_ll)
ZCFLV_MAX = MAX_ll(ZCFLV,IINFO_ll)
ZCFLW_MAX = MAX_ll(ZCFLW,IINFO_ll)
ZCFL_MAX = MAX_ll(ZCFL,IINFO_ll)
+#else
+CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
+!
+IKB=1+JPVEXT
+IKE=SIZE(ZCFLU,3)-JPVEXT
+!
+!$acc kernels present(ZCFLU,ZCFLV,ZCFLW,ZCFL)
+ZCFLU_MAX = MAXVAL(ZCFLU(IIB:IIE,IJB:IJE,IKB:IKE))
+ZCFLV_MAX = MAXVAL(ZCFLV(IIB:IIE,IJB:IJE,IKB:IKE))
+ZCFLW_MAX = MAXVAL(ZCFLW(IIB:IIE,IJB:IJE,IKB:IKE))
+ZCFL_MAX = MAXVAL(ZCFL (IIB:IIE,IJB:IJE,IKB:IKE))
+!$acc end kernels
+!
+CALL MPI_ALLREDUCE(MPI_IN_PLACE,ZCFLU_MAX,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+CALL MPI_ALLREDUCE(MPI_IN_PLACE,ZCFLV_MAX,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+CALL MPI_ALLREDUCE(MPI_IN_PLACE,ZCFLW_MAX,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+CALL MPI_ALLREDUCE(MPI_IN_PLACE,ZCFL_MAX,1,MPI_PRECISION,MPI_MAX,NMNH_COMM_WORLD,IINFO_ll)
+#endif
!
WRITE(ILUOUT,FMT='(A24,F10.2,A5,F10.2,A5,F10.2,A9,F10.2)') &
'Max. CFL number for U : ',ZCFLU_MAX, &
@@ -400,6 +518,14 @@ ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
!
!* 2.4 normalized contravariant components for splitted PPM time-step
!
+!$acc update device(PRHODJ,PRTHS,PRTKES,PRRS,PRSVS)
+!$acc kernels present(ZRUCPPM,ZRVCPPM,ZRWCPPM,PRHODJ) &
+!$acc & present(PTHT,PTKET,PRT,PSVT) &
+!$acc & present(PRTHS,PRTKES,PRRS,PRSVS) &
+!$acc & present(ZRTHS_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV)) &
+!$acc & present(ZRTKES_OTHER)
+!!$acc & pcopyout(ZRTHS_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV)) &
+!!$acc & pcopyout(ZRTKES_OTHER)
ZRUCPPM = ZRUCPPM*ZTSTEP_PPM
ZRVCPPM = ZRVCPPM*ZTSTEP_PPM
ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
@@ -415,7 +541,7 @@ ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
! Clouds related processes from previous time-step are taken into account in PRTHS_CLD
! Advection related processes from previous time-step will be taken into account in ZRTHS_PPM
!
-ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP
+ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP
IF (GTKE) ZRTKES_OTHER = PRTKES - PTKET * PRHODJ / PTSTEP
DO JR = 1, KRR
ZRRS_OTHER(:,:,:,JR) = PRRS(:,:,:,JR) - PRT(:,:,:,JR) * PRHODJ(:,:,:) / PTSTEP
@@ -423,17 +549,19 @@ END DO
DO JSV = 1, KSV
ZRSVS_OTHER(:,:,:,JSV) = PRSVS(:,:,:,JSV) - PSVT(:,:,:,JSV) * PRHODJ / PTSTEP
END DO
+!$acc end kernels
!
! Top and bottom Boundaries
!
-CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTHS_OTHER)
-IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTKES_OTHER)
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRTHS_OTHER)
+IF (GTKE) CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRTKES_OTHER)
DO JR = 1, KRR
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
END DO
DO JSV = 1, KSV
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
END DO
+!Already done in ADV_BOUNDARIES_DEVICE !$acc update self(ZRTHS_OTHER,ZRTKES_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV))
!
! Exchanges on processors
!
@@ -450,6 +578,8 @@ NULLIFY(TZFIELDS0_ll)
CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS0_ll)
!!$END IF
+!PW: TODO: update only what is needed...
+!$acc update device(ZRTHS_OTHER,ZRTKES_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV))
!
!
@@ -463,14 +593,19 @@ CALL PPM_RHODJ(HLBCX,HLBCY, ZRUCPPM, ZRVCPPM, ZRWCPPM, &
ZRHOZ1, ZRHOZ2 )
!
!* values of the fields at the beginning of the time splitting loop
-ZTH = PTHT
-ZTKE = PTKET
-IF (KRR /=0 ) ZR = PRT
-IF (KSV /=0 ) ZSV = PSVT
+!PW: not declared PRTKES_ADV as present due to bug in PGI 15.10 and 16.1 when zero size
+!!$acc kernels present(PTHT,PTKET,PRT,PSVT) present(ZTH,ZTKE,ZR,ZSV,PRTKES_ADV)
+!$acc kernels present(PTHT,PTKET,PRT,PSVT) present(ZTH,ZTKE,ZR,ZSV)
+ZTH(:,:,:) = PTHT(:,:,:)
+ZTKE(:,:,:) = PTKET(:,:,:)
+IF (KRR /=0 ) ZR(:,:,:,:) = PRT(:,:,:,:)
+IF (KSV /=0 ) ZSV(:,:,:,:) = PSVT(:,:,:,:)
!
IF (GTKE) PRTKES_ADV(:,:,:) = 0.
+!$acc end kernels
!
!* time splitting loop
+!$acc update device(PTHVREF) if(LNEUTRAL)
DO JSPL=1,KSPLIT
!
!ZRTHS_PPM(:,:,:) = 0.
@@ -478,11 +613,21 @@ DO JSPL=1,KSPLIT
!IF (KRR /=0) ZRRS_PPM(:,:,:,:) = 0.
!IF (KSV /=0) ZRSVS_PPM(:,:,:,:) = 0.
!
- IF (LNEUTRAL) ZTH=ZTH-PTHVREF !* To be removed with the new PPM scheme ?
- CALL PPM_MET (HLBCX,HLBCY, KRR, TPDTCUR,ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP,ZTSTEP_PPM, &
- PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
+ IF (LNEUTRAL) THEN
+ !Must be done in a kernels region
+ !$acc kernels present(ZTH)
+ ZTH=ZTH-PTHVREF !* To be removed with the new PPM scheme ?
+ !$acc end kernels
+ END IF
+ CALL PPM_MET (HLBCX,HLBCY, KRR, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP,ZTSTEP_PPM, &
+ PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
ZTH, ZTKE, ZR, ZRTHS_PPM, ZRTKES_PPM, ZRRS_PPM, HMET_ADV_SCHEME)
- IF (LNEUTRAL) ZTH=ZTH+PTHVREF !* To be removed with the new PPM scheme ?
+ IF (LNEUTRAL) THEN
+ !Must be done in a kernels region
+ !$acc kernels present(ZTH)
+ ZTH=ZTH+PTHVREF !* To be removed with the new PPM scheme ?
+ !$acc end kernels
+ END IF
!
CALL PPM_SCALAR (HLBCX,HLBCY, KSV, TPDTCUR, ZRUCPPM, ZRVCPPM, ZRWCPPM, PTSTEP, &
ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOX2, ZRHOY1, ZRHOY2, ZRHOZ1, ZRHOZ2, &
@@ -490,6 +635,13 @@ DO JSPL=1,KSPLIT
!
! Tendencies of PPM
!
+!$acc kernels present(ZTH,ZTKE,ZR,ZSV,ZRTHS_PPM,ZRTKES_PPM,ZRRS_PPM,ZRSVS_PPM) &
+!PW: not declared PRTKES_ADV as present due to bug in PGI 15.10 and 16.1 when zero size
+!!$acc & present(PRTHS,PRTKES_ADV,PRRS,PRSVS) &
+!$acc & present(PRTHS,PRRS,PRSVS) &
+!$acc & pcopyin(PRTHS_CLD,PRRS_CLD,PRSVS_CLD) &
+!$acc & present(ZRTHS_OTHER,ZRTKES_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV))
+!!$acc & pcopyin(ZRTHS_OTHER,ZRTKES_OTHER,ZRRS_OTHER(:,:,:,1:KRR),ZRSVS_OTHER(:,:,:,1:KSV))
PRTHS(:,:,:) = PRTHS (:,:,:) + ZRTHS_PPM (:,:,:) / KSPLIT
IF (GTKE) PRTKES_ADV(:,:,:) = PRTKES_ADV(:,:,:) + ZRTKES_PPM(:,:,:) / KSPLIT
IF (KRR /=0) PRRS (:,:,:,:) = PRRS (:,:,:,:) + ZRRS_PPM (:,:,:,:) / KSPLIT
@@ -510,17 +662,33 @@ DO JSPL=1,KSPLIT
ZSV(:,:,:,JSV) = ZSV(:,:,:,JSV) + ( ZRSVS_PPM(:,:,:,JSV) + ZRSVS_OTHER(:,:,:,JSV) + &
PRSVS_CLD(:,:,:,JSV) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
END DO
+ END IF
+!$acc end kernels
+!$acc update self(PRTHS,PRRS,PRSVS)
!
! Top and bottom Boundaries and LBC for the guesses
!
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
- IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
+ IF (JSPL<KSPLIT) THEN
+#ifndef _OPENACC
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )
+ IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
DO JR = 1, KRR
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
END DO
DO JSV = 1, KSV
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
END DO
+#else
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZTH, PTHT )
+ IF (GTKE) CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZTKE, PTKET)
+ DO JR = 1, KRR
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
+ END DO
+ DO JSV = 1, KSV
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
+ END DO
+!Already done in ADV_BOUNDARIES_DEVICE !$acc update self(ZTH,ZTKE,ZR,ZSV)
+#endif
!
! Exchanges fields between processors
!
@@ -549,8 +717,11 @@ END DO
! (previously done in tke_eps_sources)
!
IF (GTKE) THEN
+!$acc kernels present(PRTKES,PRTKES_ADV,PRHODJ)
PRTKES(:,:,:) = PRTKES(:,:,:) + PRTKES_ADV(:,:,:)
PRTKES(:,:,:) = MAX (PRTKES(:,:,:) , XTKEMIN * PRHODJ(:,:,:) / PTSTEP )
+!$acc end kernels
+!$acc update host(PRTKES,PRTKES_ADV)
END IF
!
!-------------------------------------------------------------------------------
@@ -598,8 +769,10 @@ IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), 7,'NEADV_BU_RRC')
END IF
-
-
+!
+#ifdef _OPENACC
+CALL MNH_REL_ZT3D(IZ1, IZ2)
+#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_METSV
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index 59233afc0f4103a3e998a8d44db946131d81046f..bebde37b6073d1403e3ff808e35f8b0c1874af4d 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -31,9 +31,12 @@ REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
+!$acc declare create(PRUS,PRVS,PRWS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
@@ -102,12 +105,21 @@ USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_CONF, ONLY : NHALO
USE MODD_BUDGET
!
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_CONTRAV
USE MODI_ADVECUVW_RK
USE MODI_ADV_BOUNDARIES
USE MODI_BUDGET
!
+#ifdef _OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D
+#endif
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -129,9 +141,12 @@ REAL, INTENT(IN) :: PTSTEP
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
+!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS, PRWS
+!$acc declare create(PRUS,PRVS,PRWS)
! Sources terms
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
!
@@ -145,6 +160,7 @@ INTEGER :: IKE ! indice K End in z direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
+!$acc declare create(ZRUT,ZRVT,ZRWT)
! cartesian
! components of
! momentum
@@ -152,22 +168,27 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
+!$acc declare create(ZRUCT,ZRVCT,ZRWCT)
! contravariant
! components
! of momentum
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZU, ZV, ZW
+!$acc declare create(ZU,ZV,ZW)
! Guesses at the end of the sub time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_OTHER
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_OTHER
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_OTHER
+!$acc declare create(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
! Contribution of the RK time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS_ADV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS_ADV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS_ADV
+!$acc declare create(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV)
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
+!$acc declare create(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
!
! Momentum tendencies due to advection
INTEGER :: ISPLIT ! Number of splitting loops
@@ -180,11 +201,55 @@ TYPE(LIST_ll), POINTER :: TZFIELD_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
!
+#ifdef _OPENACC
+INTEGER :: ISPL, IZUT, IZVT, IZWT, IZ1, IZ2
+INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE
+#endif
+!
!
!-------------------------------------------------------------------------------
!
!* 0. INITIALIZATION
! --------------
+#ifdef _OPENACC
+CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW::ZRUT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW::ZRVT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWT,-3e99,'ADVECTION_UVW::ZRWT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUCT,-1e98,'ADVECTION_UVW::ZRUCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVCT,-2e98,'ADVECTION_UVW::ZRVCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWCT,-3e98,'ADVECTION_UVW::ZRWCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZU,-1e99,'ADVECTION_UVW::ZU')
+CALL INIT_ON_HOST_AND_DEVICE(ZV,-1e99,'ADVECTION_UVW::ZV')
+CALL INIT_ON_HOST_AND_DEVICE(ZW,-1e99,'ADVECTION_UVW::ZW')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUS_OTHER,-1e99,'ADVECTION_UVW::ZRUS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVS_OTHER,-1e99,'ADVECTION_UVW::ZRVS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWS_OTHER,-1e99,'ADVECTION_UVW::ZRWS_OTHER')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUS_ADV,-1e99,'ADVECTION_UVW::ZRUS_ADV')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVS_ADV,-1e99,'ADVECTION_UVW::ZRVS_ADV')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWS_ADV,-1e99,'ADVECTION_UVW::ZRWS_ADV')
+CALL INIT_ON_HOST_AND_DEVICE(ZMXM_RHODJ,-1e97,'ADVECTION_UVW::ZMXM_RHODJ')
+CALL INIT_ON_HOST_AND_DEVICE(ZMYM_RHODJ,-2e97,'ADVECTION_UVW::ZMYM_RHODJ')
+CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW::ZMZM_RHODJ')
+!
+SELECT CASE (HTEMP_SCHEME)
+ CASE('RK11')
+ ISPL = 1
+ CASE('RK21')
+ ISPL = 2
+ CASE('RK33')
+ ISPL = 3
+ CASE('RK53')
+ ISPL = 5
+ CASE DEFAULT
+ PRINT *,'ERROR: UNKNOWN HTEMP_SCHEME'
+ CALL ABORT()
+END SELECT
+!
+CALL MNH_GET_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2)
+CALL MNH_GET_ZT4D(ISPL, IZRUSB, IZRUSE)
+CALL MNH_GET_ZT4D(ISPL, IZRVSB, IZRVSE)
+CALL MNH_GET_ZT4D(ISPL, IZRWSB, IZRWSE)
+#endif
!
IKE = SIZE(PWT,3) - JPVEXT
!
@@ -193,18 +258,27 @@ IJU = SIZE(PWT,2)
IKU = SIZE(PWT,3)
!
!
+#ifndef _OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+#else
+CALL MXM_DEVICE(PRHODJ,ZMXM_RHODJ)
+CALL MYM_DEVICE(PRHODJ,ZMYM_RHODJ)
+CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
+#endif
!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
! -------------------------------------
!
+!$acc kernels present(ZRUT,ZRVT,ZRWT) present(PUT,PVT,PWT) present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
ZRUT = PUT(:,:,:) * ZMXM_RHODJ
ZRVT = PVT(:,:,:) * ZMYM_RHODJ
ZRWT = PWT(:,:,:) * ZMZM_RHODJ
+!$acc end kernels
+!$acc update self(ZRUT,ZRVT)
!
NULLIFY(TZFIELD_ll)
!!$IF(NHALO == 1) THEN
@@ -213,8 +287,15 @@ NULLIFY(TZFIELD_ll)
CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELD_ll)
!!$END IF
+!$acc update device(ZRUT,ZRVT)
!
+#ifndef _OPENACC
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
+#else
+CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4,&
+ ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
+!Not necessary: already done in contrav_device !$acc update self(ZRUCT,ZRVCT,ZRWCT)
+#endif
!
NULLIFY(TZFIELDS_ll)
!!$IF(NHALO == 1) THEN
@@ -224,6 +305,7 @@ NULLIFY(TZFIELDS_ll)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!!$END IF
+!$acc update device(ZRUCT,ZRVCT,ZRWCT) !Needed in advecuvw_weno_k called by advecuvw_rk
!
!-------------------------------------------------------------------------------
!
@@ -231,17 +313,31 @@ NULLIFY(TZFIELDS_ll)
!* 2. COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
! ------------------------------------------------------------
!
+!$acc update device(PRUS,PRVS,PRWS)
+!$acc kernels present(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER) &
+!$acc & present(ZRUT,ZRVT,ZRWT) present(PRUS,PRVS,PRWS) &
+!$acc & copyin(PRUS_PRES,PRVS_PRES,PRWS_PRES)
ZRUS_OTHER = PRUS - ZRUT / PTSTEP + PRUS_PRES
ZRVS_OTHER = PRVS - ZRVT / PTSTEP + PRVS_PRES
ZRWS_OTHER = PRWS - ZRWT / PTSTEP + PRWS_PRES
+!$acc end kernels
!
! Top and bottom Boundaries
!
+#ifndef _OPENACC
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRUS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRVS_OTHER)
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRWS_OTHER)
+#else
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRUS_OTHER)
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRVS_OTHER)
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZRWS_OTHER)
+#endif
+!$acc kernels
ZRWS_OTHER(:,:,IKE+1) = 0.
+!$acc end kernels
+!$acc update self(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
NULLIFY(TZFIELDS0_ll)
!!$IF(NHALO == 1) THEN
CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRUS_OTHER)
@@ -250,6 +346,7 @@ NULLIFY(TZFIELDS0_ll)
CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS0_ll)
!!$END IF
+!$acc update device(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER)
!
!
!
@@ -266,9 +363,12 @@ ZTSTEP = PTSTEP / REAL(ISPLIT)
!
!-------------------------------------------------------------------------------
!
+!$acc kernels present(ZU,ZV,ZW) present(PUT,PVT,PWT)
ZU = PUT
ZV = PVT
ZW = PWT
+!$acc end kernels
+!$acc update self(ZU,ZV,ZW)
!
!
!* 3. TIME SPLITTING
@@ -284,10 +384,20 @@ DO JSPL=1,ISPLIT
ZMXM_RHODJ, ZMYM_RHODJ, ZMZM_RHODJ, &
ZRUCT, ZRVCT, ZRWCT, &
ZRUS_ADV, ZRVS_ADV, ZRWS_ADV, &
- ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER )
+ ZRUS_OTHER, ZRVS_OTHER, ZRWS_OTHER &
+#ifndef _OPENACC
+ )
+#else
+ ,ZT3D(:,:,:,IZUT), ZT3D(:,:,:,IZVT), ZT3D(:,:,:,IZWT), &
+ ZT3D(:,:,:,IZRUSB:IZRUSE), ZT3D(:,:,:,IZRVSB:IZRVSE), ZT3D(:,:,:,IZRWSB:IZRWSE) )
+#endif
!
! Tendencies on wind
-
+!$acc update device(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV)
+!$acc kernels present(ZU,ZV,ZW) present(ZRUS_ADV,ZRVS_ADV,ZRWS_ADV) &
+!$acc & present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ) &
+!$acc & present(ZRUS_OTHER,ZRVS_OTHER,ZRWS_OTHER) &
+!$acc & present(PRUS,PRVS,PRWS)
PRUS(:,:,:) = PRUS(:,:,:) + ZRUS_ADV(:,:,:) / ISPLIT
PRVS(:,:,:) = PRVS(:,:,:) + ZRVS_ADV(:,:,:) / ISPLIT
PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_ADV(:,:,:) / ISPLIT
@@ -302,13 +412,26 @@ DO JSPL=1,ISPLIT
(ZRVS_OTHER(:,:,:) + ZRVS_ADV(:,:,:))
ZW(:,:,:) = ZW(:,:,:) + ZTSTEP / ZMZM_RHODJ * &
(ZRWS_OTHER(:,:,:) + ZRWS_ADV(:,:,:))
+ END IF
+!$acc end kernels
+!$acc update self(PRUS,PRVS,PRWS)
!
! Top and bottom Boundaries
!
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
+ IF (JSPL<ISPLIT) THEN
+#ifndef _OPENACC
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZU, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZV, PVT, 'V' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZW, PWT, 'W' )
+#else
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZU, PUT, 'U' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZV, PVT, 'V' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZW, PWT, 'W' )
+#endif
+!$acc kernels present(ZW)
ZW (:,:,IKE+1 ) = 0.
+!$acc end kernels
+!$acc update self(ZU,ZV,ZW)
END IF
!
! End of the time splitting loop
@@ -323,4 +446,11 @@ IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+CALL MNH_REL_ZT4D(ISPL, IZRWSB)
+CALL MNH_REL_ZT4D(ISPL, IZRVSB)
+CALL MNH_REL_ZT4D(ISPL, IZRUSB)
+CALL MNH_REL_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2)
+#endif
+!
END SUBROUTINE ADVECTION_UVW
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index aaed2d1de4237086e346a1b7adb2d4321895d4cc..01521ce78e419b0968903b42d16b567bf886b3dd 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -27,10 +27,13 @@ CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
REAL, INTENT(IN) :: PTSTEP! time step
INTEGER, INTENT(IN) :: KTCOUNT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
+!$acc declare pcopyin(PUM,PVM,PWM)
! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
+!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
! Sources terms
@@ -101,7 +104,11 @@ USE MODD_CONF
USE MODD_PARAMETERS
USE MODD_GRID_n
!
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_CONTRAV
USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
@@ -109,6 +116,11 @@ USE MODI_ADVECUVW_4TH
USE MODD_BUDGET
USE MODI_BUDGET
!
+#ifdef _OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -122,10 +134,13 @@ CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
REAL, INTENT(IN) :: PTSTEP! time step
INTEGER, INTENT(IN) :: KTCOUNT
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUM, PVM, PWM
+!$acc declare pcopyin(PUM,PVM,PWM)
! Variables at t-dt
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDUM, PDVM, PDWM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT , PVT , PWT, PRHODJ
+!$acc declare pcopyin(PUT,PVT,PWT,PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS , PRVS , PRWS
! Sources terms
@@ -140,11 +155,13 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2MLIST ! momentum variables
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZVS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZWS
+!$acc declare create(ZUS,ZVS,ZWS)
! guess of cartesian components of
! momentum at future (+PTSTEP) timestep
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS
+!$acc declare create(ZRUS,ZRVS,ZRWS)
! cartesian components of
! rhodJ times the tendency of
! momentum from previous (-PTSTEP)
@@ -153,6 +170,7 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWS
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
+!$acc declare create(ZRUT,ZRVT,ZRWT)
! cartesian
! components of
! momentum
@@ -160,42 +178,85 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCT
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCT
+!$acc declare create(ZRUCT,ZRVCT,ZRWCT)
! contravariant
! components
! of momentum
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMXM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMYM_RHODJ
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMZM_RHODJ
+!$acc declare create(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
!
INTEGER :: IINFO_ll ! return code of parallel routine
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IKU
INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! index values for the physical subdomain
-
+#ifdef _OPENACC
+INTEGER :: IZ1, IZ2
+#endif
!
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+CALL INIT_ON_HOST_AND_DEVICE(ZUS,-1e99,'ADVECTION_UVW_CEN::ZUS')
+CALL INIT_ON_HOST_AND_DEVICE(ZVS,-2e99,'ADVECTION_UVW_CEN::ZVS')
+CALL INIT_ON_HOST_AND_DEVICE(ZWS,-3e99,'ADVECTION_UVW_CEN::ZWS')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUS,-1e99,'ADVECTION_UVW_CEN::ZRUS')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVS,-2e99,'ADVECTION_UVW_CEN::ZRVS')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWS,-3e99,'ADVECTION_UVW_CEN::ZRWS')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUT,-1e99,'ADVECTION_UVW_CEN::ZRUT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVT,-2e99,'ADVECTION_UVW_CEN::ZRVT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWT,-3e99,'ADVECTION_UVW_CEN::ZRWT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRUCT,-1e98,'ADVECTION_UVW_CEN::ZRUCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRVCT,-2e98,'ADVECTION_UVW_CEN::ZRVCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZRWCT,-3e98,'ADVECTION_UVW_CEN::ZRWCT')
+CALL INIT_ON_HOST_AND_DEVICE(ZMXM_RHODJ,-1e97,'ADVECTION_UVW_CEN::ZMXM_RHODJ')
+CALL INIT_ON_HOST_AND_DEVICE(ZMYM_RHODJ,-2e97,'ADVECTION_UVW_CEN::ZMYM_RHODJ')
+CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW_CEN::ZMZM_RHODJ')
+!
+CALL MNH_GET_ZT3D(IZ1, IZ2)
+#endif
+!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU = SIZE(XZHAT)
IKB=1+JPVEXT
IKE=IKU-JPVEXT
+!
+#ifndef _OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+#else
+CALL MXM_DEVICE(PRHODJ,ZMXM_RHODJ)
+CALL MYM_DEVICE(PRHODJ,ZMYM_RHODJ)
+CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
+#endif
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
! -------------------------------------
!
+!$acc kernels present(ZRUT,ZRVT,ZRWT,PUT,PVT,PWT,ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
ZRUT = PUT(:,:,:) * ZMXM_RHODJ
ZRVT = PVT(:,:,:) * ZMYM_RHODJ
ZRWT = PWT(:,:,:) * ZMZM_RHODJ
+!$acc end kernels
!
+#ifndef _OPENACC
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,2)
ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
CALL CONTRAV (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4)
END IF
-
+#else
+IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
+ CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,2, &
+ ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
+ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL CONTRAV_DEVICE (HLBCX,HLBCY,ZRUT,ZRVT,ZRWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCT,ZRVCT,ZRWCT,4, &
+ ZT3D(:,:,:,IZ1),ZT3D(:,:,:,IZ2),ODATA_ON_DEVICE=.TRUE.)
+END IF
+!Not necessary: already done in contrav_device !$acc update self(ZRUCT,ZRVCT,ZRWCT)
+#endif
!
NULLIFY(TZFIELDS_ll)
!!$IF(NHALO == 1) THEN
@@ -204,6 +265,7 @@ NULLIFY(TZFIELDS_ll)
CALL ADD3DFIELD_ll(TZFIELDS_ll, ZRVCT)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
+ !$acc update device(ZRUCT, ZRVCT, ZRWCT)
!!$END IF
!
!-------------------------------------------------------------------------------
@@ -211,9 +273,11 @@ NULLIFY(TZFIELDS_ll)
!* 2. TERM FROM PREVIOUS TIME-STEP (from initial_guess)
! ----------------------------
!
+!$acc kernels present(ZRUS,ZRVS,ZRWS,PUM,PVM,PWM,ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ)
ZRUS(:,:,:) = PUM(:,:,:) * ZMXM_RHODJ/(2.*PTSTEP)
ZRVS(:,:,:) = PVM(:,:,:) * ZMYM_RHODJ/(2.*PTSTEP)
ZRWS(:,:,:) = PWM(:,:,:) * ZMZM_RHODJ/(2.*PTSTEP)
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -223,15 +287,22 @@ ZRWS(:,:,:) = PWM(:,:,:) * ZMZM_RHODJ/(2.*PTSTEP)
! choose between 2nd and 4th order momentum advection.
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: advection_uvw_cen::ADVECUVW_2ND not yet implemented'
+CALL ABORT
+#endif
CALL ADVECUVW_2ND (PUT,PVT,PWT,ZRUCT,ZRVCT,ZRWCT,ZRUS,ZRVS,ZRWS)
!
ELSEIF (HUVW_ADV_SCHEME=='CEN4TH') THEN
!
CALL ADVECUVW_4TH ( HLBCX, HLBCY, ZRUCT, ZRVCT, ZRWCT, &
- PUT, PVT, PWT, ZRUS, ZRVS, ZRWS, TPHALO2MLIST )
+ PUT, PVT, PWT, ZRUS, ZRVS, ZRWS, TPHALO2MLIST )
!
END IF
!
+!$acc kernels present(ZRUS,ZRVS,ZRWS) present(ZUS,ZVS,ZWS) present(PUM,PVM,PWM) &
+!$acc & present(ZMXM_RHODJ,ZMYM_RHODJ,ZMZM_RHODJ) pcopy(PDUM,PDVM,PDWM,PRUS,PRVS,PRWS)
+!default added in OpenACC 2.5 !!$acc & default(none)
ZUS = ZRUS(:,:,:)/ZMXM_RHODJ*2.*PTSTEP
ZVS = ZRVS(:,:,:)/ZMYM_RHODJ*2.*PTSTEP
ZWS = ZRWS(:,:,:)/ZMZM_RHODJ*2.*PTSTEP
@@ -247,11 +318,15 @@ PRWS(:,:,:) = PRWS(:,:,:) + ( ZWS(:,:,:) - PWM(:,:,:) - 0.5* PDWM) * ZMZM_RHODJ/
PDUM = ZUS(:,:,:) - PUM(:,:,:)
PDVM = ZVS(:,:,:) - PVM(:,:,:)
PDWM = ZWS(:,:,:) - PWM(:,:,:)
+!$acc end kernels
!
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADV_BU_RU')
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
!
+#ifdef _OPENACC
+CALL MNH_REL_ZT3D(IZ1, IZ2)
+#endif
!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_UVW_CEN
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index 468515c425232c47bac036f26b642220c6ff9968..28aa980328cb641ce613933c07b56aa6a10936ca 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -25,10 +25,13 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!$acc declare present(PRUCT,PRVCT,PRWCT)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! U,V,W at t
+!$acc declare present(PUT,PVT,PWT)
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!$acc declare present(PRUS, PRVS, PRWS)
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
@@ -39,10 +42,74 @@ END INTERFACE
END MODULE MODI_ADVECUVW_4TH
!
!
+#ifdef _OPENACC
+! ######################################################################
+ SUBROUTINE ADVECUVW_4TH ( HLBCX, HLBCY, PRUCT, PRVCT, PRWCT, &
+ PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST )
+! ######################################################################
+
+ USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+ USE MODE_MNH_ZWORK , ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!$acc declare present(PRUCT,PRVCT,PRWCT)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+!$acc declare present(PUT,PVT,PWT)
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!$acc declare present(PRUS, PRVS, PRWS)
+!
+TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER:: IIE,IJE ! End useful area in x,y,z directions
+!
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
+
+INTEGER :: IZMEANX, IZMEANY, IZTEMP1,IZTEMP2,IZTEMP3,IZTEMP4
+
+ CALL MNH_GET_ZT3D(IZMEANX, IZMEANY,IZTEMP1,IZTEMP2,IZTEMP3,IZTEMP4 )
+
+ CALL ADVECUVW_4TH_D ( IIU,IJU,IKU,HLBCX, HLBCY, &
+ & PRUCT, PRVCT, PRWCT, &
+ & PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST, &
+ & ZT3D(:,:,:,IZMEANX),ZT3D(:,:,:,IZMEANY), &
+ & ZT3D(:,:,:,IZTEMP1),ZT3D(:,:,:,IZTEMP2), &
+ & ZT3D(:,:,:,IZTEMP3),ZT3D(:,:,:,IZTEMP4) &
+ & )
+
+ CALL MNH_REL_ZT3D(IZMEANX, IZMEANY, IZTEMP1,IZTEMP2,IZTEMP3,IZTEMP4)
+!
+CONTAINS
+!
+! ######################################################################
+ SUBROUTINE ADVECUVW_4TH_D ( IIU,IJU,IKU,HLBCX, HLBCY, &
+ & PRUCT, PRVCT, PRWCT, &
+ & PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST , &
+ & ZMEANX, ZMEANY, ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4 )
+
+! ######################################################################
+#else
! ######################################################################
SUBROUTINE ADVECUVW_4TH ( HLBCX, HLBCY, PRUCT, PRVCT, PRWCT, &
PUT, PVT, PWT, PRUS, PRVS, PRWS, TPHALO2LIST )
! ######################################################################
+#endif
!
!!**** *ADVECUVW_4TH * - routine to compute the 4th order centered
!! advection tendency of momentum (U,V,W)
@@ -127,6 +194,9 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
!
+#ifdef _OPENACC
+INTEGER , INTENT(IN) :: IIU,IJU,IKU
+#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
@@ -134,10 +204,13 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!$acc declare present(PRUCT,PRVCT,PRWCT)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+!$acc declare present(PUT,PVT,PWT)
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!$acc declare present(PRUS, PRVS, PRWS)
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
@@ -145,12 +218,43 @@ TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
+#ifndef _OPENACC
INTEGER :: IKU
+#endif
!
TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
!
INTEGER :: IGRID ! localisation on the model grid
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
+#else
+REAL, DIMENSION(IIU,IJU,IKU) :: ZMEANX, ZMEANY ! fluxes
+!$acc declare present(ZMEANX, ZMEANY)
+!
+REAL, DIMENSION(IIU,IJU,IKU) :: ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4
+!$acc declare present(ZTEMP1,ZTEMP2,ZTEMP3,ZTEMP4)
+
+INTEGER :: II
+#endif
+!
+#ifdef _OPENACC
+#define dxm(PDXM,PA) PDXM(2:IIU,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXM(1,:,:) = PDXM(IIU-2*JPHEXT+1,:,:) ! DXM(PDXM,PA)
+#define mxf(PMXF,PA) PMXF(1:IIU-1,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:) ! MXF(PMXF,PA)
+#define mxm(PMXM,PA) PMXM(2:IIU,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXM(1,:,:) = PMXM(IIU-2*JPHEXT+1,:,:) ! MXM(PMXM,PA)
+#define dyf(PDYF,PA) PDYF(:,1:IJU-1,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:) ! DYF(PDYF,PA)
+#define dzf(PDZF,PA) PDZF(:,:,1:IKU-1) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZF(:,:,IKU) = -999. ! DZF(PDZF,PA)
+#define mzm4(PMZM4,PA) PMZM4(:,:,3:IKU-1) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
+ PMZM4(:,:,2) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZM4(:,:,IKU) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZM4(:,:,1) = -999.
+#define mym(PMYM,PA) PMYM(:,2:IJU,:) = 0.5*( PA(:,2:IJU,:)+PA(:,1:IJU-1,:) ) ; PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:) ! MYM(PMYM,PA)
+#define dxf(PDXF,PA) PDXF(1:IIU-1,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXF(IIU,:,:) = PDXF(2*JPHEXT,:,:) ! DXF(PDXF,PA)
+#define myf(PMYF,PA) PMYF(:,1:IJU-1,:) = 0.5*( PA(:,1:IJU-1,:)+PA(:,2:IJU,:) ) ; PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:) ! MYF(PMYF,PA)
+#define dym(PDYM,PA) PDYM(:,2:IJU,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:) ; PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:) ! DYM(PDYM,PA)
+#define mzm(PMZM,PA) PMZM(:,:,2:IKU) = 0.5*( PA(:,:,2:IKU)+PA(:,:,1:IKU-1) ) ; PMZM(:,:,1) = -999. ! MZM(PMZM,PA)
+#define mzf(PMZF,PA) PMZF(:,:,1:IKU-1) = 0.5*( PA(:,:,1:IKU-1)+PA(:,:,2:IKU) ) ; PMZF(:,:,IKU) = -999. ! MZF(PMZF,PA)
+#define dzm(PDZM,PA) PDZM(:,:,2:IKU) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZM(:,:,1) = -999. ! DZM(PDZM,PA)
+#define mzf4(PMZF4,PA) PMZF4(:,:,2:IKU-2) = (7.0*( PA(:,:,3:IKU-1)+PA(:,:,2:IKU-2) ) - (PA(:,:,4:IKU)+PA(:,:,1:IKU-3) ) )/12.0 ; \
+ PMZF4(:,:,1) = 0.5*( PA(:,:,2)+PA(:,:,1) ) ; PMZF4(:,:,IKU-1) = 0.5*( PA(:,:,IKU)+PA(:,:,IKU-1) ) ; PMZF4(:,:,IKU) = -999.
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -159,7 +263,9 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZMEANX, ZMEANY ! fluxes
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
+#ifndef _OPENACC
IKU=SIZE(XZHAT)
+#endif
!-------------------------------------------------------------------------------
!
!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR MOMENTUM
@@ -174,6 +280,7 @@ IGRID = 2
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PUT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
+#ifndef _OPENACC
PRUS(:,:,:) = PRUS(:,:,:) &
-DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
@@ -182,6 +289,43 @@ PRUS(:,:,:) = PRUS(:,:,:) &
!
PRUS(:,:,:) = PRUS(:,:,:) &
-DZF(1,IKU,1, MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
+#else
+! pcopy(prus) pcopyin(pruct,ZMEANX) create(ZTEMP1,ZTEMP2,ZTEMP3)
+!!$PRUS(:,:,:) = PRUS(:,:,:) &
+!!$ -DXM( MXF(PRUCT(:,:,:))*ZMEANX(:,:,:) )
+
+!$acc kernels present(ZMEANX) present(PRUS)
+mxf(ZTEMP1,PRUCT)
+ZTEMP2 = ZTEMP1 * ZMEANX
+dxm(ZTEMP3,ZTEMP2)
+PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+!
+
+!!$PRUS(:,:,:) = PRUS(:,:,:) &
+!!$ -DYF( MXM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
+
+!$acc kernels present(ZMEANY) present(PRUS)
+mxm(ZTEMP1,PRVCT)
+ZTEMP2 = ZTEMP1 * ZMEANY
+dyf(ZTEMP3,ZTEMP2)
+PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+!
+
+!!$PRUS(:,:,:) = PRUS(:,:,:) &
+!!$ -DZF( MXM(PRWCT(:,:,:))*MZM4(PUT(:,:,:)) )
+
+!$acc kernels present(PUT,PRUS)
+mzm4(ZTEMP1,PUT)
+mxm(ZTEMP2,PRWCT)
+ZTEMP3 = ZTEMP1 * ZTEMP2
+dzf(ZTEMP4,ZTEMP3)
+PRUS(:,:,:) = PRUS(:,:,:) - ZTEMP4
+!$acc end kernels
+#endif
!
!
IGRID = 3
@@ -193,6 +337,7 @@ IGRID = 3
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PVT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
+#ifndef _OPENACC
PRVS(:,:,:) = PRVS(:,:,:) &
-DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
@@ -201,6 +346,43 @@ PRVS(:,:,:) = PRVS(:,:,:) &
!
PRVS(:,:,:) = PRVS(:,:,:) &
-DZF(1,IKU,1, MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
+#else
+!!$PRVS(:,:,:) = PRVS(:,:,:) &
+!!$ -DXF( MYM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
+
+!$acc kernels present(ZMEANX) present(PRVS)
+mym(ZTEMP1,PRUCT)
+ZTEMP2 = ZTEMP1 * ZMEANX
+dxf(ZTEMP3,ZTEMP2)
+PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+
+!
+
+!!$PRVS(:,:,:) = PRVS(:,:,:) &
+!!$ -DYM( MYF(PRVCT(:,:,:))*ZMEANY(:,:,:) )
+
+!$acc kernels present(ZMEANY) present(PRVS)
+myf(ZTEMP1,PRVCT)
+ZTEMP2 = ZTEMP1 * ZMEANY
+dym(ZTEMP3,ZTEMP2)
+PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+!
+
+!!$PRVS(:,:,:) = PRVS(:,:,:) &
+!!$ -DZF( MYM(PRWCT(:,:,:))*MZM4(PVT(:,:,:)) )
+
+!$acc kernels present(PVT,PRVS)
+mym(ZTEMP1,PRWCT)
+mzm4(ZTEMP2,PVT)
+ZTEMP3 = ZTEMP1 * ZTEMP2
+dzf(ZTEMP4,ZTEMP3)
+PRVS(:,:,:) = PRVS(:,:,:) - ZTEMP4
+!$acc end kernels
+#endif
!
!
IGRID = 4
@@ -213,6 +395,7 @@ IGRID = 4
!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PWT, IGRID, ZMEANX, ZMEANY)
!!$ENDIF
!
+#ifndef _OPENACC
PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM(1,IKU,1,PRUCT(:,:,:))*ZMEANX(:,:,:) )
!
@@ -221,7 +404,47 @@ PRWS(:,:,:) = PRWS(:,:,:) &
!
PRWS(:,:,:) = PRWS(:,:,:) &
-DZM(1,IKU,1, MZF(1,IKU,1,PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
+#else
+!!$PRWS(:,:,:) = PRWS(:,:,:) &
+!!$ -DXF( MZM(PRUCT(:,:,:))*ZMEANX(:,:,:) )
+
+!$acc kernels present(ZMEANX) present(PRWS)
+mzm(ZTEMP1,PRUCT)
+ZTEMP2 = ZTEMP1 * ZMEANX
+dxf(ZTEMP3,ZTEMP2)
+PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+!
+
+!!$PRWS(:,:,:) = PRWS(:,:,:) &
+!!$ -DYF( MZM(PRVCT(:,:,:))*ZMEANY(:,:,:) )
+
+!$acc kernels present(ZMEANY) present(PRWS)
+mzm(ZTEMP1,PRVCT)
+ZTEMP2 = ZTEMP1 * ZMEANY
+dyf(ZTEMP3,ZTEMP2)
+PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP3
+!$acc end kernels
+
+!
+
+!!$PRWS(:,:,:) = PRWS(:,:,:) &
+!!$ -DZM( MZF(PRWCT(:,:,:))*MZF4(PWT(:,:,:)) )
+
+!$acc kernels present(PWT,PRWS)
+mzf(ZTEMP1,PRWCT)
+mzf4(ZTEMP2,PWT)
+ZTEMP1 = ZTEMP1 * ZTEMP2
+dzm(ZTEMP4,ZTEMP1)
+PRWS(:,:,:) = PRWS(:,:,:) - ZTEMP4
+!$acc end kernels
+#endif
!
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+END SUBROUTINE ADVECUVW_4TH_D
+#endif
+!
END SUBROUTINE ADVECUVW_4TH
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 0241fdf9e6cbced31f7175511b68425a97287e92..0c4c518d4ba9b19e7db02a7de8b435ec911135f1 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -16,7 +16,12 @@ INTERFACE
PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
PRUCT, PRVCT, PRWCT, &
PRUS_ADV, PRVS_ADV, PRWS_ADV, &
- PRUS_OTHER, PRVS_OTHER, PRWS_OTHER )
+ PRUS_OTHER, PRVS_OTHER, PRWS_OTHER &
+#ifndef _OPENACC
+ )
+#else
+ ,ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS)
+#endif
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME! to the selected
CHARACTER(LEN=4), INTENT(IN) :: HTEMP_SCHEME ! Temporal scheme
@@ -29,19 +34,33 @@ CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU , PV , PW
+!$acc declare present(PU,PV,PW)
! Variables to advect
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT , PWT
+!$acc declare present(PUT,PVT,PWT)
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMXM_RHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMYM_RHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_RHODJ
+!$acc declare present(PMXM_RHODJ,PMYM_RHODJ,PMZM_RHODJ)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT , PRVCT, PRWCT
+!$acc declare present(PRUCT,PRVCT,PRWCT)
! Contravariant wind components
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS_ADV , PRVS_ADV, PRWS_ADV
+!$acc declare present(PRUS_ADV,PRVS_ADV,PRWS_ADV)
! Tendency due to advection
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
+!$acc declare present(PRUS_OTHER,PRVS_OTHER,PRWS_OTHER)
! ! tendencies from other processes
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT, ZVT, ZWT
+!$acc declare present(ZUT,ZVT,ZWT)
+REAL, DIMENSION(:,:,:,:) :: ZRUS,ZRVS,ZRWS
+!$acc declare present(ZRUS,ZRVS,ZRWS)
+#endif
+!
!
END SUBROUTINE ADVECUVW_RK
!
@@ -57,7 +76,12 @@ END MODULE MODI_ADVECUVW_RK
PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
PRUCT, PRVCT, PRWCT, &
PRUS_ADV, PRVS_ADV, PRWS_ADV, &
- PRUS_OTHER, PRVS_OTHER, PRWS_OTHER )
+ PRUS_OTHER, PRVS_OTHER, PRWS_OTHER &
+#ifndef _OPENACC
+ )
+#else
+ ,ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS)
+#endif
! ##########################################################################
!
!!**** *ADVECUVW_RK * - routine to call the specialized advection routines for wind
@@ -122,6 +146,11 @@ USE MODE_MPPDB
!
USE MODI_ADVECUVW_4TH
!
+#ifdef _OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -139,18 +168,24 @@ CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
REAL, INTENT(IN) :: PTSTEP
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU , PV , PW
+!$acc declare present(PU,PV,PW)
! Variables to advect
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT , PWT
+!$acc declare present(PUT,PVT,PWT)
! Variables at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMXM_RHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMYM_RHODJ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_RHODJ
+!$acc declare present(PMXM_RHODJ,PMYM_RHODJ,PMZM_RHODJ)
! metric coefficients
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT , PRVCT, PRWCT
+!$acc declare present(PRUCT,PRVCT,PRWCT)
! Contravariant wind components
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS_ADV , PRVS_ADV, PRWS_ADV
+!$acc declare present(PRUS_ADV,PRVS_ADV,PRWS_ADV)
! Tendency due to advection
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
+!$acc declare present(PRUS_OTHER,PRVS_OTHER,PRWS_OTHER)
! ! tendencies from other processes
!
!
@@ -162,14 +197,21 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
INTEGER :: IKE ! indice K End in z direction
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT, ZVT, ZWT
+!$acc declare present(ZUT,ZVT,ZWT)
! Intermediate Guesses inside the RK loop
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
+#else
+REAL, DIMENSION(:,:,:,:) :: ZRUS,ZRVS,ZRWS
+!$acc declare present(ZRUS,ZRVS,ZRWS)
+#endif
! Momentum tendencies due to advection
REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
! at the RK sub time step
REAL, DIMENSION(:), ALLOCATABLE :: ZBUTS! Butcher array coefficients
! at the end of the RK loop
+!$acc declare create(ZBUT,ZBUTS)
!JUAN
TYPE(LIST_ll), POINTER :: TZFIELDMT_ll ! list of fields to exchange
@@ -178,6 +220,9 @@ INTEGER :: INBVAR
INTEGER :: IIU, IJU, IKU ! array sizes
!JUAN
+#ifdef _OPENACC
+INTEGER :: IZMEAN, IZWORK
+#endif
! Momentum tendencies due to advection
INTEGER :: ISPL ! Number of RK splitting loops
INTEGER :: JI, JS ! Loop index
@@ -195,6 +240,17 @@ REAL :: XPRECISION
!* 0. INITIALIZATION
! --------------
!
+#ifdef _OPENACC
+!Data zone necessary to work around a bug seen with PGI at least up to 16.4
+!If not, update on a section of ZRUS will update a section of the total size of ZRUS
+!$acc data present(ZRUS,ZRVS,ZRWS)
+CALL INIT_ON_HOST_AND_DEVICE(ZUT,4e99,'ADVECUVW_RK::ZUT')
+CALL INIT_ON_HOST_AND_DEVICE(ZVT,5e99,'ADVECUVW_RK::ZVT')
+CALL INIT_ON_HOST_AND_DEVICE(ZWT,6e99,'ADVECUVW_RK::ZWT')
+!
+CALL MNH_GET_ZT3D(IZMEAN,IZWORK)
+#endif
+!
IKE = SIZE(PWT,3) - JPVEXT
IIU=SIZE(PUT,1)
IJU=SIZE(PUT,2)
@@ -313,11 +369,15 @@ CASE('RK65')
ZBUT(5,4) = -12./7.
ZBUT(5,5) = 8./7.
END SELECT
+!$acc update device(ZBUTS,ZBUT)
!
+#ifndef _OPENACC
ALLOCATE(ZRUS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRVS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRWS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+#endif
!
+!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV) present(ZUT,ZVT,ZWT) present(PU,PV,PW)
PRUS_ADV = 0.
PRVS_ADV = 0.
PRWS_ADV = 0.
@@ -330,11 +390,18 @@ PRWS_ADV = 0.
ZUT = PU
ZVT = PV
ZWT = PW
+!$acc end kernels
!
-CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
-CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+#ifndef _OPENACC
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
-
+#else
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZUT, PUT, 'U' )
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZVT, PVT, 'V' )
+CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZWT, PWT, 'W' )
+#endif
+!
NULLIFY(TZFIELDMT_ll)
CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZUT)
CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZVT)
@@ -342,22 +409,32 @@ CALL ADD3DFIELD_ll(TZFIELDMT_ll, ZWT)
INBVAR = 3
CALL INIT_HALO2_ll(TZHALO2MT_ll,INBVAR,SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3))
!
+!$acc kernels
ZRUS = 0.
ZRVS = 0.
ZRWS = 0.
+!$acc end kernels
!-------------------------------------------------------------------------------
!
!* 3. BEGINNING of Runge-Kutta loop
! -----------------------------
!
DO JS = 1, ISPL
-!
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
-!
- CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
- CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
+!
+#ifndef _OPENACC
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
+#else
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZWT, PWT, 'W' )
+#endif
+!
+!$acc update self(ZUT,ZVT,ZWT)
+ CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
+!$acc update device(ZUT,ZVT,ZWT)
!
!* 4. Advection with WENO
! -------------------
@@ -367,7 +444,12 @@ ZRWS = 0.
CALL ADVECUVW_WENO_K (HLBCX, HLBCY, KWENO_ORDER, ZUT, ZVT, ZWT, &
PRUCT, PRVCT, PRWCT, &
ZRUS(:,:,:,JS), ZRVS(:,:,:,JS), ZRWS(:,:,:,JS), &
+#ifndef _OPENACC
TZHALO2MT_ll )
+#else
+ TZHALO2MT_ll, ZT3D(:,:,:,IZMEAN), ZT3D(:,:,:,IZWORK) )
+!Not necessary: already done in ADVECUVW_WENO_K !$acc update self(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
+#endif
ELSE IF ((HUVW_ADV_SCHEME=='CEN4TH') .AND. (HTEMP_SCHEME=='RKC4')) THEN
CALL ADVECUVW_4TH (HLBCX, HLBCY, PRUCT, PRVCT, PRWCT, &
ZUT, ZVT, ZWT, &
@@ -382,13 +464,17 @@ ZRWS = 0.
CALL ADD3DFIELD_ll(TZFIELDS4_ll, ZRWS(:,:,:,JS))
CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS4_ll)
-!
+!$acc update device(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
+!
IF ( JS /= ISPL ) THEN
!
ZUT = PU
ZVT = PV
ZWT = PW
!
+!$acc kernels present(ZUT,ZVT,ZWT) present(ZBUT) &
+!$acc & present(ZRUS,ZRVS,ZRWS) present(PRUS_OTHER,PRVS_OTHER,PRWS_OTHER) &
+!$acc & present(PMXM_RHODJ,PMYM_RHODJ,PMZM_RHODJ)
DO JI = 1, JS
!
! Intermediate guesses inside the RK loop
@@ -401,16 +487,20 @@ ZRWS = 0.
( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ
!
END DO
+!$acc end kernels
+!$acc update self(ZUT,ZVT,ZWT)
!
ELSE
!
! Guesses at the end of the RK loop
!
+!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV,ZBUTS) present(ZRUS,ZRVS,ZRWS)
DO JI = 1, ISPL
PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI)
PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI)
PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI)
END DO
+!$acc end kernels
!
END IF
!
@@ -418,9 +508,17 @@ ZRWS = 0.
END DO
!
!
-DEALLOCATE(ZBUT, ZBUTS, ZRUS, ZRVS, ZRWS)
+#ifdef _OPENACC
+CALL MNH_REL_ZT3D(IZMEAN,IZWORK)
+#else
+DEALLOCATE(ZRUS, ZRVS, ZRWS)
+#endif
+!
+DEALLOCATE(ZBUT, ZBUTS)
CALL CLEANLIST_ll(TZFIELDMT_ll)
CALL DEL_HALO2_ll(TZHALO2MT_ll)
+!$acc update self(PRUS_ADV,PRVS_ADV,PRWS_ADV)
!-------------------------------------------------------------------------------
+!$acc end data
!
END SUBROUTINE ADVECUVW_RK
diff --git a/src/MNH/advecuvw_weno_k.f90 b/src/MNH/advecuvw_weno_k.f90
index a28258d060c8c656c2b9b1fdb0ed2b5d179f49de..84cf572f4dc0f0a07c90f3ef6dbda6097da19294 100644
--- a/src/MNH/advecuvw_weno_k.f90
+++ b/src/MNH/advecuvw_weno_k.f90
@@ -8,8 +8,13 @@
!
INTERFACE
!
- SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, TPHALO2LIST)
+ SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
+ PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, TPHALO2LIST &
+#ifndef _OPENACC
+ )
+#else
+ , ZMEAN, ZWORK)
+#endif
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
@@ -21,13 +26,22 @@ INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!$acc declare present(PRUCT,PRVCT,PRWCT)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! U,V,W at t
+!$acc declare present(PUT,PVT,PWT)
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!$acc declare present(PRUS,PRVS,PRWS)
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
+#ifdef _OPENACC
+! Work arrays
+REAL, DIMENSION(SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3)) :: ZMEAN, ZWORK
+!$acc declare present(ZMEAN,ZWORK)
+#endif
+!
END SUBROUTINE ADVECUVW_WENO_K
!
END INTERFACE
@@ -35,8 +49,13 @@ END INTERFACE
END MODULE MODI_ADVECUVW_WENO_K
!
! ##########################################################################
- SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, TPHALO2LIST)
+ SUBROUTINE ADVECUVW_WENO_K(HLBCX, HLBCY, KWENO_ORDER, PUT, PVT, PWT, &
+ PRUCT, PRVCT, PRWCT, PRUS, PRVS, PRWS, TPHALO2LIST &
+#ifndef _OPENACC
+ )
+#else
+ , ZMEAN, ZWORK)
+#endif
! ##########################################################################
!
!! AUTHOR
@@ -61,7 +80,11 @@ USE MODD_PARAMETERS
USE MODD_CONF
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_ADVEC_WENO_K_1_AUX
USE MODI_ADVEC_WENO_K_2_AUX
USE MODI_ADVEC_WENO_K_3_AUX
@@ -70,6 +93,11 @@ USE MODD_CONF, ONLY : NHALO
USE MODE_MPPDB
USE MODI_GET_HALO
!
+#ifdef _OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -82,10 +110,13 @@ INTEGER, INTENT(IN) :: KWENO_ORDER ! Order of the WENO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
+!$acc declare present(PRUCT,PRVCT,PRWCT)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Variables at t
+!$acc declare present(PUT,PVT,PWT)
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Source terms
+!$acc declare present(PRUS,PRVS,PRWS)
!
TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
!
@@ -97,10 +128,25 @@ TYPE(LIST_ll), POINTER :: TZHALO2_ZMEAN
INTEGER :: IINFO_ll ! return code of parallel routine
!
REAL, DIMENSION(SIZE(PUT,1), SIZE(PUT,2), SIZE(PUT,3)) :: ZMEAN, ZWORK, DYM_ZMEAN
+!$acc declare present(ZMEAN,ZWORK)
!
INTEGER :: K_SCHEME
INTEGER :: IKU
INTEGER :: IWORK
+#ifdef _OPENACC
+INTEGER :: IZFPOS1, IZFPOS2, IZFPOS3
+INTEGER :: IZFNEG1, IZFNEG2, IZFNEG3
+INTEGER :: IZBPOS1, IZBPOS2, IZBPOS3
+INTEGER :: IZBNEG1, IZBNEG2, IZBNEG3
+INTEGER :: IZOMP1, IZOMP2, IZOMP3
+INTEGER :: IZOMN1, IZOMN2, IZOMN3
+#endif
+!
+!
+#ifdef _OPENACC
+CALL INIT_ON_HOST_AND_DEVICE(ZMEAN,1e90,'ADVECUVW_WENO_K::ZMEAN')
+CALL INIT_ON_HOST_AND_DEVICE(ZWORK,2e90,'ADVECUVW_WENO_K::ZWORK')
+#endif
!
!------------------------- ADVECTION OF MOMENTUM ------------------------------
!
@@ -117,6 +163,7 @@ ZWORK=0.0
SELECT CASE(KWENO_ORDER)
!
CASE(1) ! WENO 1
+#ifndef _OPENACC
!
! U component
!
@@ -141,9 +188,90 @@ CASE(1) ! WENO 1
PRWS = PRWS - DYF(UP_MY(PWT,MZM(1,IKU,1,PRVCT)))
!
PRWS = PRWS - DZM(1,IKU,1,UP_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+#else
+!
+! U component
+!
+ !PRUS = PRUS - DXM(UP_UX(PUT,MXF(PRUCT)))
+ CALL MXF_DEVICE(PRUCT,ZWORK)
+ CALL UP_UX_DEVICE(PUT,ZWORK,ZMEAN)
+ CALL DXM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+ !PRUS = PRUS - DYF(UP_MY(PUT,MXM(PRVCT)))
+ CALL MXM_DEVICE(PRVCT,ZWORK)
+ CALL UP_MY_DEVICE(PUT,ZWORK,ZMEAN)
+ CALL DYF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+ !PRUS = PRUS - DZF(1,IKU,1,UP_MZ(PUT,MXM(PRWCT)))
+ CALL MXM_DEVICE(PRWCT,ZWORK)
+ CALL UP_MZ_DEVICE(PUT,ZWORK,ZMEAN)
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+! V component
+!
+ !PRVS = PRVS - DXF(UP_MX(PVT,MYM(PRUCT)))
+ CALL MYM_DEVICE(PRUCT,ZWORK)
+ CALL UP_MX_DEVICE(PVT,ZWORK,ZMEAN)
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+ !PRVS = PRVS - DYM(UP_VY(PVT,MYF(PRVCT)))
+ CALL MYF_DEVICE(PRVCT,ZWORK)
+ CALL UP_VY_DEVICE(PVT,ZWORK,ZMEAN)
+ CALL DYM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+ !PRVS = PRVS - DZF(1,IKU,1,UP_MZ(PVT,MYM(PRWCT)))
+ CALL MYM_DEVICE(PRWCT,ZWORK)
+ CALL UP_MZ_DEVICE(PVT,ZWORK,ZMEAN)
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+! W component
+!
+ !PRWS = PRWS - DXF(UP_MX(PWT,MZM(1,IKU,1,PRUCT)))
+ CALL MZM_DEVICE(PRUCT,ZWORK)
+ CALL UP_MX_DEVICE(PWT,ZWORK,ZMEAN)
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ !PRWS = PRWS - DYF(UP_MY(PWT,MZM(1,IKU,1,PRVCT)))
+ CALL MZM_DEVICE(PRVCT,ZWORK)
+ CALL UP_MY_DEVICE(PWT,ZWORK,ZMEAN)
+ CALL DYF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ !PRWS = PRWS - DZM(1,IKU,1,UP_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+ CALL MZF_DEVICE(1,IKU,1,PRWCT,ZWORK)
+ CALL UP_WZ_DEVICE(PWT,ZWORK,ZMEAN)
+ CALL DZM_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+#endif
!
!
CASE(3) ! WENO 3
+#ifndef _OPENACC
!
! U component
!
@@ -187,9 +315,122 @@ CASE(3) ! WENO 3
END IF
!
PRWS = PRWS - DZM(1,IKU,1,WENO_K_2_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+#else
+ CALL MNH_GET_ZT3D(IZFPOS1,IZFPOS2,IZFNEG1,IZFNEG2,IZBPOS1,IZBPOS2,IZBNEG1,IZBNEG2,IZOMP1,IZOMP2,IZOMN1,IZOMN2)
+!
+! U component
+!
+ CALL MXF_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_2_UX(HLBCX, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2%WEST, TZHALO2_UT%HALO2%EAST, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DXM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+ IF (.NOT.L2D) THEN
+ CALL MXM_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PUT, ZWORK, ZMEAN, TZHALO2_UT%HALO2%NORTH, TZHALO2_UT%HALO2%SOUTH, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DYF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+ END IF
+!
+! PRUS = PRUS - DZF(1,IKU,1,WENO_K_2_MZ(PUT, MXM(PRWCT)))
+ CALL MXM_DEVICE(PRWCT,ZWORK)
+ CALL WENO_K_2_MZ(PUT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+! V component
+!
+ IF (.NOT.L2D) THEN
+ CALL MYM_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2%WEST, TZHALO2_VT%HALO2%EAST, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+ CALL MYF_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_2_VY(HLBCY, PVT, ZWORK, ZMEAN, TZHALO2_VT%HALO2%NORTH, TZHALO2_VT%HALO2%SOUTH, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DYM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+! PRVS = PRVS - DZF(1,IKU,1,WENO_K_2_MZ(PVT, MYM(PRWCT)))
+ CALL MYM_DEVICE(PRWCT,ZWORK)
+ CALL WENO_K_2_MZ(PVT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+ END IF
+!
+! W component
+!
+! ZWORK = MZM(1,IKU,1,PRUCT)
+ CALL MZM_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_2_MX(HLBCX, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2%WEST, TZHALO2_WT%HALO2%EAST, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ IF (.NOT.L2D) THEN
+! ZWORK = MZM(1,IKU,1,PRVCT)
+ CALL MZM_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_2_MY(HLBCY, PWT, ZWORK, ZMEAN, TZHALO2_WT%HALO2%NORTH, TZHALO2_WT%HALO2%SOUTH, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DYF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+ END IF
+!
+! PRWS = PRWS - DZM(1,IKU,1,WENO_K_2_WZ(PWT,MZF(1,IKU,1,PRWCT)))
+ CALL MZF_DEVICE(1,IKU,1,PRWCT,ZWORK)
+ CALL WENO_K_2_WZ(PWT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2) )
+ CALL DZM_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ CALL MNH_REL_ZT3D(IZFPOS1,IZFPOS2,IZFNEG1,IZFNEG2,IZBPOS1,IZBPOS2,IZBNEG1,IZBNEG2,IZOMP1,IZOMP2,IZOMN1,IZOMN2)
+#endif
!
!
CASE(5) ! WENO 5
+#ifndef _OPENACC
!
! U component
!
@@ -246,10 +487,147 @@ CASE(5) ! WENO 5
ZMEAN = WENO_K_3_WZ(PWT,MZF(1,IKU,1,PRWCT))
CALL GET_HALO(ZMEAN)! Update HALO - maybe not necessary (T.Lunet)
PRWS = PRWS - DZM(1,IKU,1,ZMEAN)
+#else
+PRINT *,'OPENACC: advecuvw_weno_k::KWENO_ORDER=5 being implemented'
+ CALL MNH_GET_ZT3D(IZFPOS1,IZFPOS2,IZFPOS3,IZFNEG1,IZFNEG2,IZFNEG3,IZBPOS1, &
+ IZBPOS2,IZBPOS3,IZBNEG1,IZBNEG2,IZBNEG3,IZOMP1,IZOMP2,IZOMP3,IZOMN1,IZOMN2,IZOMN3)
+!
+! U component
+!
+ CALL MXF_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_3_UX(HLBCX, PUT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DXM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+ IF (.NOT.L2D) THEN
+ CALL MXM_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PUT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DYM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+ END IF
+!
+ CALL MXM_DEVICE(PRWCT,ZWORK)
+ CALL WENO_K_3_MZ(PUT,ZWORK,ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRUS = PRUS - ZWORK
+!$acc end kernels
+!
+! V component
+!
+ IF (.NOT.L2D) THEN
+ CALL MYM_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PVT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+ CALL MYF_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_3_VY(HLBCY, PVT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DYM_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+!
+ CALL MYM_DEVICE(PRWCT,ZWORK)
+ CALL WENO_K_3_MZ(PVT,ZWORK,ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DZF_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRVS = PRVS - ZWORK
+!$acc end kernels
+ END IF
+!
+! W component
+!
+ CALL MZM_DEVICE(PRUCT,ZWORK)
+ CALL ADVEC_WENO_K_3_MX(HLBCX, PWT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DXF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ IF (.NOT.L2D) THEN
+ CALL MZM_DEVICE(PRVCT,ZWORK)
+ CALL ADVEC_WENO_K_3_MY(HLBCY, PWT, ZWORK, ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DYF_DEVICE(ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+ END IF
+!
+ CALL MZF_DEVICE(1,IKU,1,PRWCT,ZWORK)
+ CALL WENO_K_3_WZ(PWT,ZWORK,ZMEAN, &
+ ZT3D(:,:,:,IZFPOS1), ZT3D(:,:,:,IZFPOS2), ZT3D(:,:,:,IZFPOS3), &
+ ZT3D(:,:,:,IZFNEG1), ZT3D(:,:,:,IZFNEG2), ZT3D(:,:,:,IZFNEG3), &
+ ZT3D(:,:,:,IZBPOS1), ZT3D(:,:,:,IZBPOS2), ZT3D(:,:,:,IZBPOS3), &
+ ZT3D(:,:,:,IZBNEG1), ZT3D(:,:,:,IZBNEG2), ZT3D(:,:,:,IZBNEG3), &
+ ZT3D(:,:,:,IZOMP1), ZT3D(:,:,:,IZOMP2), ZT3D(:,:,:,IZOMP3), &
+ ZT3D(:,:,:,IZOMN1), ZT3D(:,:,:,IZOMN2), ZT3D(:,:,:,IZOMN3) )
+ CALL DZM_DEVICE(1,IKU,1,ZMEAN,ZWORK)
+!$acc kernels
+ PRWS = PRWS - ZWORK
+!$acc end kernels
+!
+ CALL MNH_REL_ZT3D(IZFPOS1,IZFPOS2,IZFPOS3,IZFNEG1,IZFNEG2,IZFNEG3,IZBPOS1, &
+ IZBPOS2,IZBPOS3,IZBNEG1,IZBNEG2,IZBNEG3,IZOMP1,IZOMP2,IZOMP3,IZOMN1,IZOMN2,IZOMN3)
+#endif
!
!
END SELECT
! ---------------------------------
+!$acc update self(PRUS,PRVS,PRWS)
!
END SUBROUTINE ADVECUVW_WENO_K
-
diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90
index bc28c4906bfc8bcaa5271a228b3cdcbf80649897..5d42573683cc333f268e8d90d66c3ee334210b25 100644
--- a/src/MNH/contrav.f90
+++ b/src/MNH/contrav.f90
@@ -16,8 +16,8 @@ INTERFACE
!
SUBROUTINE CONTRAV(HLBCX,HLBCY,PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PRUCT,PRVCT,PRWCT,KADV_ORDER )
-
-
+!
+!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
@@ -31,10 +31,41 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! Metric coefficients
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
+INTEGER, INTENT(IN) :: KADV_ORDER ! Order of the advection
+! ! scheme
+END SUBROUTINE CONTRAV
+!
+#ifdef _OPENACC
+ SUBROUTINE CONTRAV_DEVICE(HLBCX,HLBCY,PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PRUCT,PRVCT,PRWCT,KADV_ORDER,Z1,Z2,ODATA_ON_DEVICE )
+!
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Cartesian comp along y
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWT ! Cartesian comp along z
+!$acc declare present(PRUT,PRVT,PRWT)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! Metric coefficients
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
+!$acc declare present(PRUCT,PRVCT,PRWCT)
INTEGER, INTENT(IN) :: KADV_ORDER ! Order of the advection
! scheme
+LOGICAL, OPTIONAL, INTENT(IN) :: ODATA_ON_DEVICE ! Is some of the data on the accelerator device
!
-END SUBROUTINE CONTRAV
+! Work arrays
+REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,2),SIZE(PDXX,3)):: Z1,Z2
+!$acc declare present(Z1,Z2)
+!
+END SUBROUTINE CONTRAV_DEVICE
+#endif
!
END INTERFACE
!
@@ -417,3 +448,442 @@ END IF
CALL MPPDB_CHECK3DM("contrav end ::PRU/V/WCT",PRECISION,PRUCT,PRVCT,PRWCT)
!
END SUBROUTINE CONTRAV
+!
+#ifdef _OPENACC
+! ##############################################################
+ SUBROUTINE CONTRAV_DEVICE(HLBCX,HLBCY,PRUT,PRVT,PRWT,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+ PRUCT,PRVCT,PRWCT,KADV_ORDER,Z1,Z2,ODATA_ON_DEVICE )
+! ##############################################################
+!
+!!**** *CONTRAV * - computes the contravariant components from the
+!! cartesian components
+!!
+!! PURPOSE
+!! -------
+! This routine computes the contravariant components of vector
+! defined by its cartesian components (U,V,W) , using the following
+! formulae:
+! UC = U / DXX
+! VC = V / DYY
+! ( ----------x ----------y )
+! ( ---z ---z )
+! 1 ( U V )
+! WC = --- ( W - DZX * --- - DZY * --- )
+! DZZ ( DXX DYY )
+!
+!
+! In the no-topography case, WC = W / DZZ
+!
+!
+!!** METHOD
+!! ------
+!! We employ the Shuman operators to compute the averages. The metric
+!! coefficients PDXX, PDYY, PDZX, PDZY, PDZZ are dummy arguments
+!!
+!!
+!! EXTERNAL
+!! --------
+!! MXF, MYF, MZM : Shuman functions (mean operators)
+!!
+!! Module MODI_SHUMAN : Interface for Shuman functions
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variable
+!! LFLAT : Logical for topography
+!! = .TRUE. if Zs = 0 (Flat terrain)
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation (subroutine CONTRAV)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.L. Redelsperger * CNRM *
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/07/94
+!! Corrections 3/08/94 (by J.P. Lafore)
+!! Corrections 17/10/94 (by J.P. Lafore) WC modified for w-advection
+!! Corrections 19/01/11 (by J.P. Pinty) WC 4th order
+!! Corrections 28/03/11 (by V.Masson) // of WC 4th order
+!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODD_CONF
+USE MODD_PARAMETERS
+USE MODD_GRID_n, ONLY: XZZ
+!
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_ll
+!
+USE MODI_SHUMAN
+USE MODI_GET_HALO
+!
+USE MODE_MPPDB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUT ! Cartesian comp along x
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Cartesian comp along y
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWT ! Cartesian comp along z
+!$acc declare present(PRUT,PRVT,PRWT)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! Metric coefficients
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! Metric coefficients
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY)
+!
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUCT ! Contrav comp along x-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRVCT ! Contrav comp along y-bar
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRWCT ! Contrav comp along z-bar
+!$acc declare present(PRUCT,PRVCT,PRWCT)
+INTEGER, INTENT(IN) :: KADV_ORDER ! Order of the advection
+ ! scheme
+LOGICAL, OPTIONAL, INTENT(IN) :: ODATA_ON_DEVICE ! Is some of the data on the accelerator device
+!
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,2),SIZE(PDXX,3)):: Z1,Z2
+!$acc declare present(Z1,Z2)
+REAL, DIMENSION(:,:),ALLOCATABLE::ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH
+!$acc declare create(ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH)
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
+INTEGER :: IIU, IJU, IKU
+INTEGER:: IW,IE,IS,IN ! Coordinate of forth order diffusion area
+!
+TYPE(LIST_ll), POINTER :: TZFIELD_U, TZFIELD_V, TZFIELD_DZX, TZFIELD_DZY
+TYPE(HALO2LIST_ll), POINTER :: TZHALO2_U, TZHALO2_V, TZHALO2_DZX, TZHALO2_DZY
+INTEGER :: IINFO_ll
+!JUAN
+REAL :: XPRECISION
+LOGICAL :: GDATA_ON_DEVICE
+
+
+IF ( PRESENT(ODATA_ON_DEVICE) ) THEN
+ GDATA_ON_DEVICE = ODATA_ON_DEVICE
+ELSE
+ GDATA_ON_DEVICE = .FALSE.
+END IF
+!-----------------------------------------------------------------------
+!
+!* 1. Compute the horizontal contravariant components
+! -----------------------------------------------
+!
+CALL MPPDB_CHECK3DM("contrav big ::PRU/V/WT",PRECISION,PRUT,PRVT,PRWT)
+!
+IIU= SIZE(PDXX,1)
+IJU= SIZE(PDXX,2)
+IKU= SIZE(PDXX,3)
+!
+CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
+!
+IKB=1+JPVEXT
+IKE=IKU - JPVEXT
+!
+IF (GDATA_ON_DEVICE) THEN
+!PW TODO:remplacer (ailleurs aussi...) 1/PDXX... par PINV_PDXX (fait pour la turbulence...) cfr MNH/turb_hor_splt.f90
+!$acc kernels present(PRUCT,PRVCT,PRUT,PRVT,PDXX,PDYY)
+ PRUCT(:,:,:) = PRUT(:,:,:) / PDXX(:,:,:)
+ PRVCT(:,:,:) = PRVT(:,:,:) / PDYY(:,:,:)
+!$acc end kernels
+!$acc update self(PRUCT,PRVCT)
+ELSE
+ PRUCT(:,:,:) = PRUT(:,:,:) / PDXX(:,:,:)
+ PRVCT(:,:,:) = PRVT(:,:,:) / PDYY(:,:,:)
+END IF
+!
+IF (KADV_ORDER == 4 ) THEN
+ IF( .NOT. LFLAT) THEN
+ NULLIFY(TZFIELD_U)
+ NULLIFY(TZFIELD_V)
+ CALL ADD3DFIELD_ll(TZFIELD_U, PRUCT)
+ CALL ADD3DFIELD_ll(TZFIELD_V, PRVCT)
+ CALL UPDATE_HALO_ll(TZFIELD_U,IINFO_ll)
+ CALL UPDATE_HALO_ll(TZFIELD_V,IINFO_ll)
+!!$ IF( NHALO==1 ) THEN
+ NULLIFY(TZFIELD_DZX)
+ NULLIFY(TZFIELD_DZY)
+ CALL ADD3DFIELD_ll(TZFIELD_DZX, PDZX)
+ CALL ADD3DFIELD_ll(TZFIELD_DZY, PDZY)
+ NULLIFY(TZHALO2_U)
+ NULLIFY(TZHALO2_V)
+ NULLIFY(TZHALO2_DZX)
+ NULLIFY(TZHALO2_DZY)
+ CALL INIT_HALO2_ll(TZHALO2_U,1,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TZHALO2_V,1,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TZHALO2_DZX,1,IIU,IJU,IKU)
+ CALL INIT_HALO2_ll(TZHALO2_DZY,1,IIU,IJU,IKU)
+ CALL UPDATE_HALO2_ll(TZFIELD_U, TZHALO2_U, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELD_V, TZHALO2_V, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELD_DZX, TZHALO2_DZX, IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELD_DZY, TZHALO2_DZY, IINFO_ll)
+!$acc update device(PRUCT,PRVCT)
+!!$ END IF
+!
+ !PW: necessary because pointers does not work with OpenACC (PGI 16.1)
+ ALLOCATE(ZU_EAST(IJU,IKU),ZV_NORTH(IIU,IKU),ZDZX_EAST(IJU,IKU),ZDZY_NORTH(IIU,IKU))
+ ZU_EAST(:,:) = TZHALO2_U%HALO2%EAST
+ ZDZX_EAST(:,:) = TZHALO2_DZX%HALO2%EAST
+ ZV_NORTH(:,:) = TZHALO2_V%HALO2%NORTH
+ ZDZY_NORTH(:,:) = TZHALO2_DZY%HALO2%NORTH
+ !$acc update device(ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH)
+ END IF
+END IF
+!
+!
+!* 2. Compute the vertical contravariant components (flat case)
+! ------------------------------------
+!
+IF (LFLAT) THEN
+IF (GDATA_ON_DEVICE) THEN
+!$acc kernels present(PRWCT,PRWT,PDZZ)
+ PRWCT(:,:,:) = PRWT(:,:,:) / PDZZ(:,:,:)
+!$acc end kernels
+!$acc update self(PRWCT)
+ELSE
+ PRWCT(:,:,:) = PRWT(:,:,:) / PDZZ(:,:,:)
+END IF
+ RETURN
+END IF
+!
+!* 3. Compute the vertical contravariant components (general case)
+! ------------------------------------
+!
+!$acc kernels present(Z1,Z2) present(PRUCT,PRVCT,PRWCT) present(PDXX,PDYY,PDZZ,PDZX,PDZY) &
+!$acc & present(ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH)
+!PW:TODO:initialize Z1,Z2,PRWCT only if necessary (or part of it)
+Z1(:,:,:) = 0.
+Z2(:,:,:) = 0.
+!
+IF (KADV_ORDER == 2 ) THEN
+#ifdef _OPENACC
+PRINT *,'OPENACC: contrav::KADV_ORDER=2 and LFLAT=.TRUE. not yet tested'
+CALL ABORT
+#endif
+!
+!PW:TODO: not parallelized with openacc
+ Z1(IIB:IIE,:,IKB:IKE+1)= &
+ (PRUCT(IIB:IIE,:,IKB:IKE+1)+PRUCT(IIB:IIE,:,IKB-1:IKE) ) &
+ *PDZX(IIB:IIE,:,IKB:IKE+1) *0.25 &
+ +(PRUCT(IIB+1:IIE+1,:,IKB:IKE+1)+PRUCT(IIB+1:IIE+1,:,IKB-1:IKE) ) &
+ *PDZX(IIB+1:IIE+1,:,IKB:IKE+1) *0.25
+
+!PW:TODO: not parallelized with openacc
+ Z2(:,IJB:IJE,IKB:IKE+1)= &
+ (PRVCT(:,IJB:IJE,IKB:IKE+1)+PRVCT(:,IJB:IJE,IKB-1:IKE) ) &
+ *PDZY(:,IJB:IJE,IKB:IKE+1) *0.25 &
+ +(PRVCT(:,IJB+1:IJE+1,IKB:IKE+1)+PRVCT(:,IJB+1:IJE+1,IKB-1:IKE) ) &
+ *PDZY(:,IJB+1:IJE+1,IKB:IKE+1) *0.25
+ PRWCT(:,:,:)=0.
+!PW:TODO: not parallelized with openacc
+ PRWCT(IIB:IIE,IJB:IJE,IKB:IKE+1) = &
+ ( PRWT(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z1(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z2(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ ) / PDZZ(IIB:IIE,IJB:IJE,IKB:IKE+1)
+!
+ELSE IF (KADV_ORDER == 4 ) THEN
+!
+!!$ IF (NHALO == 1) THEN
+ IF ( LWEST_ll() .AND. HLBCX(1)/='CYCL' ) THEN
+ IW=IIB+2 -1
+ ELSE
+ IW=IIB+1 -1
+ END IF
+ IE=IIE-1
+!!$ ELSE
+!!$ IF (LWEST_ll()) THEN
+!!$ IW=IIB+1
+!!$ ELSE
+!!$ IW=IIB
+!!$ END IF
+!!$ IF (LEAST_ll() .AND. HLBCX(2)/='CYCL' ) THEN
+!!$ IE=IIE-1
+!!$ ELSE
+!!$ IE=IIE
+!!$ END IF
+!!$ END IF
+ !
+!!$ IF(NHALO == 1) THEN
+ IF ( LSOUTH_ll() .AND. HLBCY(1)/='CYCL' ) THEN
+ IS=IJB+2 -1
+ ELSE
+ IS=IJB+1 -1
+ END IF
+ IN=IJE-1
+!!$ ELSE
+!!$ IF (LSOUTH_ll()) THEN
+!!$ IS=IJB+1
+!!$ ELSE
+!!$ IS=IJB
+!!$ END IF
+!!$ IF (LNORTH_ll() .AND. HLBCY(2)/='CYCL' ) THEN
+!!$ IN=IJE-1
+!!$ ELSE
+!!$ IN=IJE
+!!$ END IF
+!!$ END IF
+ !
+ !
+ !* 3.1 interior of the processor subdomain
+!
+!
+ Z1(IW:IE,:,IKB:IKE+1)= &
+ 7.0*( (PRUCT(IW:IE,:,IKB:IKE+1)+PRUCT(IW:IE,:,IKB-1:IKE)) &
+ *( 9.0*PDZX(IW:IE,:,IKB:IKE+1)-(PDZX(IW+1:IE+1,:,IKB:IKE+1) &
+ +PDZX(IW:IE,:,IKB:IKE+1)+PDZX(IW-1:IE-1,:,IKB:IKE+1))/3.0)/8.0 * 0.5 &
+ +(PRUCT(IW+1:IE+1,:,IKB:IKE+1)+PRUCT(IW+1:IE+1,:,IKB-1:IKE)) &
+ *( 9.0*PDZX(IW+1:IE+1,:,IKB:IKE+1)-(PDZX(IW+2:IE+2,:,IKB:IKE+1) &
+ +PDZX(IW+1:IE+1,:,IKB:IKE+1)+PDZX(IW:IE,:,IKB:IKE+1))/3.0)/8.0 * 0.5 )/12.0 &
+ -( (PRUCT(IW-1:IE-1,:,IKB:IKE+1)+PRUCT(IW-1:IE-1,:,IKB-1:IKE)) &
+ *PDZX(IW-1:IE-1,:,IKB:IKE+1) *0.5 &
+ +(PRUCT(IW+2:IE+2,:,IKB:IKE+1)+PRUCT(IW+2:IE+2,:,IKB-1:IKE)) &
+ *PDZX(IW+2:IE+2,:,IKB:IKE+1) *0.5)/12.0
+
+!
+ Z2(:,IS:IN,IKB:IKE+1)= &
+ 7.0*( (PRVCT(:,IS:IN,IKB:IKE+1)+PRVCT(:,IS:IN,IKB-1:IKE)) &
+ *( 9.0*PDZY(:,IS:IN,IKB:IKE+1)-(PDZY(:,IS+1:IN+1,IKB:IKE+1) &
+ +PDZY(:,IS:IN,IKB:IKE+1)+PDZY(:,IS-1:IN-1,IKB:IKE+1))/3.0)/8.0 * 0.5 &
+ +(PRVCT(:,IS+1:IN+1,IKB:IKE+1)+PRVCT(:,IS+1:IN+1,IKB-1:IKE)) &
+ *( 9.0*PDZY(:,IS+1:IN+1,IKB:IKE+1)-(PDZY(:,IS+2:IN+2,IKB:IKE+1) &
+ +PDZY(:,IS+1:IN+1,IKB:IKE+1)+PDZY(:,IS:IN,IKB:IKE+1))/3.0)/8.0 * 0.5 )/12.0 &
+ -( (PRVCT(:,IS-1:IN-1,IKB:IKE+1)+PRVCT(:,IS-1:IN-1,IKB-1:IKE)) &
+ *PDZY(:,IS-1:IN-1,IKB:IKE+1) *0.5 &
+ +(PRVCT(:,IS+2:IN+2,IKB:IKE+1)+PRVCT(:,IS+2:IN+2,IKB-1:IKE)) &
+ *PDZY(:,IS+2:IN+2,IKB:IKE+1) *0.5)/12.0
+!
+!* 3.2 limits of the processor subdomain (inside the whole domain or in cyclic conditions)
+!
+!!$ IF (NHALO==1) THEN
+
+ Z1(IIE,:,IKB:IKE+1)= &
+ 7.0*( (PRUCT(IIE,:,IKB:IKE+1)+PRUCT(IIE,:,IKB-1:IKE)) &
+ *( 9.0*PDZX(IIE,:,IKB:IKE+1)-(PDZX(IIE+1,:,IKB:IKE+1) &
+ +PDZX(IIE,:,IKB:IKE+1)+PDZX(IIE-1,:,IKB:IKE+1))/3.0)/8.0 * 0.5 &
+ +(PRUCT(IIE+1,:,IKB:IKE+1)+PRUCT(IIE+1,:,IKB-1:IKE)) &
+! *( 9.0*PDZX(IIE+1,:,IKB:IKE+1)-(TZHALO2_DZX%HALO2%EAST(:,IKB:IKE+1) &
+ *( 9.0*PDZX(IIE+1,:,IKB:IKE+1)-(ZDZX_EAST(:,IKB:IKE+1) &
+ +PDZX(IIE+1,:,IKB:IKE+1)+PDZX(IIE,:,IKB:IKE+1))/3.0)/8.0 * 0.5 )/12.0 &
+ -( (PRUCT(IIE-1,:,IKB:IKE+1)+PRUCT(IIE-1,:,IKB-1:IKE)) &
+ *PDZX(IIE-1,:,IKB:IKE+1) *0.5 &
+! +(TZHALO2_U%HALO2%EAST(:,IKB:IKE+1)+TZHALO2_U%HALO2%EAST(:,IKB-1:IKE)) &
+ +(ZU_EAST(:,IKB:IKE+1)+ZU_EAST(:,IKB-1:IKE)) &
+! *TZHALO2_DZX%HALO2%EAST(:,IKB:IKE+1) *0.5)/12.0
+ *ZDZX_EAST(:,IKB:IKE+1) *0.5)/12.0
+!
+ Z2(:,IJE,IKB:IKE+1)= &
+ 7.0*( (PRVCT(:,IJE,IKB:IKE+1)+PRVCT(:,IJE,IKB-1:IKE)) &
+ *( 9.0*PDZY(:,IJE,IKB:IKE+1)-(PDZY(:,IJE+1,IKB:IKE+1) &
+ +PDZY(:,IJE,IKB:IKE+1)+PDZY(:,IJE-1,IKB:IKE+1))/3.0)/8.0 * 0.5 &
+ +(PRVCT(:,IJE+1,IKB:IKE+1)+PRVCT(:,IJE+1,IKB-1:IKE)) &
+! *( 9.0*PDZY(:,IJE+1,IKB:IKE+1)-(TZHALO2_DZY%HALO2%NORTH(:,IKB:IKE+1) &
+ *( 9.0*PDZY(:,IJE+1,IKB:IKE+1)-(ZDZY_NORTH(:,IKB:IKE+1) &
+ +PDZY(:,IJE+1,IKB:IKE+1)+PDZY(:,IJE,IKB:IKE+1))/3.0)/8.0 * 0.5 )/12.0 &
+ -( (PRVCT(:,IJE-1,IKB:IKE+1)+PRVCT(:,IJE-1,IKB-1:IKE)) &
+ *PDZY(:,IJE-1,IKB:IKE+1) *0.5 &
+! +(TZHALO2_V%HALO2%NORTH(:,IKB:IKE+1)+TZHALO2_V%HALO2%NORTH(:,IKB-1:IKE)) &
+ +(ZV_NORTH(:,IKB:IKE+1)+ZV_NORTH(:,IKB-1:IKE)) &
+! *TZHALO2_DZY%HALO2%NORTH(:,IKB:IKE+1) *0.5)/12.0
+ *ZDZY_NORTH(:,IKB:IKE+1) *0.5)/12.0
+!!$ END IF
+!
+!* 3.3 non-CYCLIC CASE IN THE X DIRECTION: 2nd order case
+!
+ IF (HLBCX(1)/='CYCL' .AND. LWEST_ll()) THEN
+!
+ Z1(IIB,:,IKB:IKE+1)= &
+ (PRUCT(IIB,:,IKB:IKE+1)+PRUCT(IIB,:,IKB-1:IKE) ) &
+ *PDZX(IIB,:,IKB:IKE+1) *0.25 &
+ +(PRUCT(IIB+1,:,IKB:IKE+1)+PRUCT(IIB+1,:,IKB-1:IKE) ) &
+ *PDZX(IIB+1,:,IKB:IKE+1) *0.25
+ END IF
+!
+ IF (HLBCX(2)/='CYCL' .AND. LEAST_ll()) THEN
+!
+ Z1(IIE,:,IKB:IKE+1)= &
+ (PRUCT(IIE,:,IKB:IKE+1)+PRUCT(IIE,:,IKB-1:IKE) ) &
+ *PDZX(IIE,:,IKB:IKE+1) *0.25 &
+ +(PRUCT(IIE+1,:,IKB:IKE+1)+PRUCT(IIE+1,:,IKB-1:IKE) ) &
+ *PDZX(IIE+1,:,IKB:IKE+1) *0.25
+ END IF
+!
+!* 3.4 non-CYCLIC CASE IN THE Y DIRECTION: 2nd order case
+!
+ IF (HLBCY(1)/='CYCL' .AND. LSOUTH_ll()) THEN
+!
+ Z2(:,IJB,IKB:IKE+1)= &
+ (PRVCT(:,IJB,IKB:IKE+1)+PRVCT(:,IJB,IKB-1:IKE) ) &
+ *PDZY(:,IJB,IKB:IKE+1) *0.25 &
+ +(PRVCT(:,IJB+1,IKB:IKE+1)+PRVCT(:,IJB+1,IKB-1:IKE) ) &
+ *PDZY(:,IJB+1,IKB:IKE+1) *0.25
+!
+ END IF
+!
+ IF (HLBCY(2)/='CYCL' .AND. LNORTH_ll()) THEN
+!
+ Z2(:,IJE,IKB:IKE+1)= &
+ (PRVCT(:,IJE,IKB:IKE+1)+PRVCT(:,IJE,IKB-1:IKE) ) &
+ *PDZY(:,IJE,IKB:IKE+1) *0.25 &
+ +(PRVCT(:,IJE+1,IKB:IKE+1)+PRVCT(:,IJE+1,IKB-1:IKE) ) &
+ *PDZY(:,IJE+1,IKB:IKE+1) *0.25
+!
+ END IF
+!
+!* 3.5 Vertical contyravariant wind
+!
+!
+!!$ CALL GET_HALO(Z1)
+!!$ CALL GET_HALO(Z2)
+!!$
+!!$ CALL MPPDB_CHECK3DM("contrav_device ::Z1/Z2/ PDZZ",PRECISION,Z1,Z2,PDZZ)
+ PRWCT(:,:,:)=0.
+!PW:TODO: not parallelized with openacc
+ PRWCT(IIB:IIE,IJB:IJE,IKB:IKE+1) = &
+ ( PRWT(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z1(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ - Z2(IIB:IIE,IJB:IJE,IKB:IKE+1) &
+ ) / PDZZ(IIB:IIE,IJB:IJE,IKB:IKE+1)
+!
+!
+END IF
+!
+PRWCT(:,:,1) = - PRWCT(:,:,3) ! Mirror hypothesis
+!$acc end kernels
+!$acc update self(PRWCT)
+!
+IF (KADV_ORDER == 4 ) THEN
+ DEALLOCATE(ZU_EAST,ZV_NORTH,ZDZX_EAST,ZDZY_NORTH)
+ CALL CLEANLIST_ll(TZFIELD_U)
+ CALL CLEANLIST_ll(TZFIELD_V)
+!!$ IF (NHALO==1) THEN
+ CALL CLEANLIST_ll(TZFIELD_DZX)
+ CALL CLEANLIST_ll(TZFIELD_DZY)
+ CALL DEL_HALO2_ll(TZHALO2_U)
+ CALL DEL_HALO2_ll(TZHALO2_V)
+ CALL DEL_HALO2_ll(TZHALO2_DZX)
+ CALL DEL_HALO2_ll(TZHALO2_DZY)
+!!$ END IF
+END IF
+!-----------------------------------------------------------------------
+CALL MPPDB_CHECK3DM("contrav end ::PRU/V/WCT",PRECISION,PRUCT,PRVCT,PRWCT)
+!
+END SUBROUTINE CONTRAV_DEVICE
+#endif
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index f6b63b7070fc632b29231af7a5ee7754a5c6684e..0e9ff3b9813b6c62997b75b60142bf0d31168907 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -1,3 +1,4 @@
+
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
diff --git a/src/MNH/emoist.f90 b/src/MNH/emoist.f90
index f58a1b32d2f6d7901b6c25f61edad0a0ddde339f..becf7b6d96dc43b344dbd6774be90adcbb7e6d74 100644
--- a/src/MNH/emoist.f90
+++ b/src/MNH/emoist.f90
@@ -14,7 +14,11 @@ MODULE MODI_EMOIST
!
INTERFACE
!
+#ifndef _OPENACC
FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+#else
+SUBROUTINE EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,PEMOIST)
+#endif
!
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
@@ -27,16 +31,29 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
+#ifndef _OPENACC
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
+#else
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), INTENT(OUT):: PEMOIST ! result
+!$acc declare present(PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,PEMOIST)
+#endif
!
+#ifndef _OPENACC
END FUNCTION EMOIST
+#else
+END SUBROUTINE EMOIST
+#endif
!
END INTERFACE
!
END MODULE MODI_EMOIST
!
! ############################################################################
+#ifndef _OPENACC
FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
+#else
+SUBROUTINE EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,PEMOIST)
+#endif
! ############################################################################
!
! PURPOSE
@@ -80,6 +97,7 @@ FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
!! J. Stein Feb 28, 1996 optimization + Doctorization
!! J. Stein Spet 15, 1996 Amoist previously computed
!! J.-P. Pinty May 20, 2003 Improve EMOIST expression
+!! M.Moge April, 2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
!! ----------------------------------------------------------------------
!
@@ -103,13 +121,19 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PAMOIST ! Amoist
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
+#ifndef _OPENACC
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PEMOIST ! result
+#else
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), INTENT(OUT):: PEMOIST ! result
+!$acc declare present(PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,PEMOIST)
+#endif
!
!* 0.2 declarations of local variables
!
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZA, ZRW
! ZA = coeft A, ZRW = total mixing ratio rw
+!$acc declare create(ZA,ZRW)
REAL :: ZDELTA ! = Rv/Rd - 1
INTEGER :: JRR ! moist loop counter
!
@@ -120,6 +144,7 @@ INTEGER :: JRR ! moist loop counter
! --------------
!
!
+!$acc kernels
IF ( KRR == 0 ) THEN ! dry case
PEMOIST(:,:,:) = 0.
ELSE IF ( KRR == 1 ) THEN ! only vapor
@@ -174,7 +199,12 @@ ELSE ! liquid water & ice present
) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
END IF
END IF
+!$acc end kernels
!
!---------------------------------------------------------------------------
!
+#ifndef _OPENACC
END FUNCTION EMOIST
+#else
+END SUBROUTINE EMOIST
+#endif
diff --git a/src/MNH/etheta.f90 b/src/MNH/etheta.f90
index 6c673cb978262ffe9cdb70251f4943f8b828cb0b..59456b2adf77a197a62e8fd2364d061b85749e82 100644
--- a/src/MNH/etheta.f90
+++ b/src/MNH/etheta.f90
@@ -14,7 +14,11 @@ MODULE MODI_ETHETA
!
INTERFACE
!
+#ifndef _OPENACC
FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+#else
+SUBROUTINE ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,PETHETA)
+#endif
!
INTEGER :: KRR ! number of moist var.
INTEGER :: KRRI ! number of ice var.
@@ -28,17 +32,30 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
+#ifndef _OPENACC
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
+#else
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), INTENT(OUT):: PETHETA ! result
+!$acc declare present(PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,PETHETA)
+#endif
!
!
+#ifndef _OPENACC
END FUNCTION ETHETA
+#else
+END SUBROUTINE ETHETA
+#endif
!
END INTERFACE
!
END MODULE MODI_ETHETA
!
! ############################################################################
+#ifndef _OPENACC
FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
+#else
+SUBROUTINE ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,PETHETA)
+#endif
! ############################################################################
!
! PURPOSE
@@ -82,6 +99,7 @@ FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
!! J. Stein Feb 28, 1996 optimization + Doctorization
!! J. Stein Sept 15, 1996 Atheta previously computed
!! J.-P. Pinty May 20, 2003 Improve ETHETA expression
+!! M.Moge April, 2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
!! ----------------------------------------------------------------------
!
@@ -106,7 +124,12 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PATHETA ! Atheta
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRCM ! Normalized 2dn_order
! moment s'r'c/2Sigma_s2
!
+#ifndef _OPENACC
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
+#else
+REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)), INTENT(OUT):: PETHETA ! result
+!$acc declare present(PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,PETHETA)
+#endif
!
!
!
@@ -115,6 +138,7 @@ REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)):: PETHETA ! result
REAL,DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZA, ZRW
! ZA = coeft A, ZRW = total mixing ratio rw
+!$acc declare create(ZA,ZRW)
REAL :: ZDELTA ! = Rv/Rd - 1
INTEGER :: JRR ! moist loop counter
!
@@ -125,6 +149,7 @@ INTEGER :: JRR ! moist loop counter
! --------------
!
!
+!$acc kernels
IF ( KRR == 0 ) THEN ! dry case
PETHETA(:,:,:) = 1.
ELSE IF ( KRR == 1 ) THEN ! only vapor
@@ -174,7 +199,12 @@ ELSE ! liquid water & ice present
) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
END IF
END IF
+!$acc end kernels
!
!---------------------------------------------------------------------------
!
+#ifndef _OPENACC
END FUNCTION ETHETA
+#else
+END SUBROUTINE ETHETA
+#endif
diff --git a/src/MNH/fast_terms.f90 b/src/MNH/fast_terms.f90
index 3507eda6ff15df634f74b76d5b0188e5ce7b6ab4..995362266a638796d6003857baf13e55a5bbfeab 100644
--- a/src/MNH/fast_terms.f90
+++ b/src/MNH/fast_terms.f90
@@ -26,11 +26,11 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
! model n
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
+CHARACTER(LEN=*), INTENT(IN) :: HTURBDIM ! Dimensionality of the
! turbulence scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(LEN=*), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=*), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+CHARACTER(LEN=*), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -47,8 +47,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRS ! Rain water m.r. source
!
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
@@ -182,11 +182,11 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
CHARACTER(LEN=*), INTENT(IN) :: HLUOUT ! Output-listing name for
! model n
-CHARACTER*4, INTENT(IN) :: HTURBDIM ! Dimensionality of the
+CHARACTER(LEN=*), INTENT(IN) :: HTURBDIM ! Dimensionality of the
! turbulence scheme
-CHARACTER(LEN=4), INTENT(IN) :: HSCONV ! Shallow convection scheme
-CHARACTER(LEN=4), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
-CHARACTER*4, INTENT(IN) :: HRAD ! Radiation scheme name
+CHARACTER(LEN=*), INTENT(IN) :: HSCONV ! Shallow convection scheme
+CHARACTER(LEN=*), INTENT(IN) :: HMF_CLOUD! Type of statistical cloud
+CHARACTER(LEN=*), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -264,6 +264,8 @@ IF( NVERB>5) THEN
END IF
END IF
!
+!PW: OpenACC directives not interpreted (see Rules.LXpgi_openacc.mk due to internal compiler error PGI)
+!$acc kernels
WHERE ( PRCS(:,:,:)+PRVS(:,:,:) < 0.)
PRVS(:,:,:) = - PRCS(:,:,:)
END WHERE
@@ -271,10 +273,12 @@ END WHERE
!* 2.2 estimate the Exner function at t+1
!
ZEXNS(:,:,:) = ( PPABST(:,:,:) / XP00 ) ** (XRD/XCPD)
+!$acc end kernels
!
! beginning of the iterative loop
!
DO JITER =1,ITERMAX
+!$acc kernels
!
!* 2.3 compute the intermediate temperature at t+1, T*
!
@@ -312,6 +316,7 @@ DO JITER =1,ITERMAX
!* 2.9 compute Cph + Lv * rvs'
!
ZW3(:,:,:) = ZCPH(:,:,:) + ZLV(:,:,:) * ZW1(:,:,:)
+!$acc end kernels
!
!
!-------------------------------------------------------------------------------
@@ -323,9 +328,11 @@ DO JITER =1,ITERMAX
!
!* 3.1 compute Q1
!
+!$acc kernels
ZW2(:,:,:) = ( ( PRVS(:,:,:)*PTSTEP - ZW2(:,:,:) ) * ZCPH(:,:,:) / ZW3(:,:,:) &
+ PRCS(:,:,:)*PTSTEP &
) / ( 2. * PSIGS(:,:,:) )
+!$acc end kernels
!
!* 3.2 compute s'rc'/2Sigma_s2, Rc and the nebolisity
@@ -333,6 +340,7 @@ DO JITER =1,ITERMAX
CALL CONDENS(HTURBDIM, ZW2,ZW1,ZW3,PSRCS) ! ZW1 = Cloud fraction
! PSRC = s'rc'/(2 Sigma_s**2)
! ZW3 = Rc / (2 Sigma_s)
+!$acc kernels
ZW3(:,:,:) = 2. * PSIGS(:,:,:) * ZW3(:,:,:) ! Rc
!
! multiply PSRCS by the lambda3 coefficient
@@ -346,6 +354,7 @@ DO JITER =1,ITERMAX
! Rc - Rc*
ZW3(:,:,:) = (ZW3(:,:,:)/PTSTEP) - PRCS(:,:,:) ! Pcon = ----------
! 2 Delta t
+!$acc end kernels
ELSE
!
!
@@ -354,6 +363,7 @@ DO JITER =1,ITERMAX
!
!* 4.1 compute Delta 2
!
+!$acc kernels
ZW1(:,:,:) = (ZW1(:,:,:) * ZLV(:,:,:) / ZW3(:,:,:) ) * &
( ((-2.*XBETAW+XGAMW*ZT(:,:,:)) / (XBETAW-XGAMW*ZT(:,:,:)) &
+ (XBETAW/ZT(:,:,:)-XGAMW)*(1.0+2.0*ZW2(:,:,:)/ZEPS))/ZT(:,:,:) )
@@ -370,6 +380,7 @@ DO JITER =1,ITERMAX
! end of the IF structure on the all or nothing or statistical condensation
! scheme
!
+!$acc end kernels
END IF
!
!
@@ -379,6 +390,7 @@ DO JITER =1,ITERMAX
!
!* 5.1 compute the sources
!
+!$acc kernels
ZW3(:,:,:) = MAX ( ZW3(:,:,:), -PRCS(:,:,:) )
WHERE (ZW3(:,:,:) > 0.0)
ZW3(:,:,:) = MIN ( ZW3(:,:,:), PRVS(:,:,:) )
@@ -387,6 +399,7 @@ DO JITER =1,ITERMAX
PRVS(:,:,:) = PRVS(:,:,:) - ZW3(:,:,:)
PTHS(:,:,:) = PTHS(:,:,:) + ZW3(:,:,:) * ZLV(:,:,:) / ZCPH(:,:,:) &
/ ZEXNS(:,:,:)
+!$acc end kernels
!
! end of the iterative loop
!
@@ -394,6 +407,7 @@ END DO
!
!* 5.2 compute the cloud fraction PCLDFR
!
+!$acc kernels
IF ( .NOT. OSUBG_COND ) THEN
WHERE (PRCS(:,:,:) > 1.E-12 / PTSTEP)
ZW1(:,:,:) = 1.
@@ -416,6 +430,7 @@ ELSE
/ ZEXNS(:,:,:) /PTSTEP
END IF
ENDIF
+!$acc end kernels
!
!
!
diff --git a/src/MNH/flat_invz.f90 b/src/MNH/flat_invz.f90
index 113a7ec4aeb232ab2f74a97f538e06d3dbf6aa1f..3cae073f41741f32f6489746cc094001b1cd4800 100644
--- a/src/MNH/flat_invz.f90
+++ b/src/MNH/flat_invz.f90
@@ -1006,10 +1006,12 @@ CONTAINS
SUBROUTINE FAST_SUBSTITUTION_3D(PBAND_YR,PBETX,PPBF,PGAM,PPCF,PAF &
,PBAND_Y,KIY,KJY,KKU)
- INTEGER :: KIY,KJY,KKU
- REAL, DIMENSION (KIY*KJY,KKU) :: PBAND_YR,PBAND_Y,PPBF,PGAM,PAF
- REAL, DIMENSION (KIY*KJY) :: PBETX
- REAL, DIMENSION (KKU) :: PPCF
+ INTEGER,INTENT(IN) :: KIY,KJY,KKU
+ REAL, DIMENSION (KIY*KJY,KKU),INTENT(OUT) :: PBAND_YR,PGAM
+ REAL, DIMENSION (KIY*KJY,KKU),INTENT(IN) :: PBAND_Y,PPBF,PAF
+ REAL, DIMENSION (KIY*KJY),INTENT(OUT) :: PBETX
+ REAL, DIMENSION (KKU),INTENT(IN) :: PPCF
+ !
INTEGER :: JK
!
!
diff --git a/src/MNH/get_halo.f90 b/src/MNH/get_halo.f90
index 7fb8a058b1b902d5f54ca07fd9a3ae1c648391da..2e660d9dd85ab5ab6b378a97ae9206eb1bc974a3 100644
--- a/src/MNH/get_halo.f90
+++ b/src/MNH/get_halo.f90
@@ -14,20 +14,35 @@
!
INTERFACE
!
-SUBROUTINE GET_HALO2(PSRC,TP_PSRC_HALO2_ll)
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
-!
-END SUBROUTINE GET_HALO2
-!
-SUBROUTINE GET_HALO(PSRC)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+ SUBROUTINE GET_HALO2(PSRC,TP_PSRC_HALO2_ll)
+ !
+ USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+ TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
+ !
+ END SUBROUTINE GET_HALO2
+END INTERFACE
!
-END SUBROUTINE GET_HALO
+INTERFACE
+ SUBROUTINE GET_HALO(PSRC,HDIR)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
+ !
+ END SUBROUTINE GET_HALO
+END INTERFACE
+!
+INTERFACE
+ SUBROUTINE GET_HALO_D(PSRC,HDIR)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+ !$acc declare present (PSRC)
+ CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
+ !
+ END SUBROUTINE GET_HALO_D
+END INTERFACE
!
+INTERFACE
SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
!
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
@@ -48,7 +63,7 @@ USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
TYPE(HALO2LIST_ll), POINTER :: TP_PSRC_HALO2_ll ! halo2 for SRC
!
INTEGER :: IIU,IJU,IKU ! domain sizes
@@ -74,7 +89,7 @@ END SUBROUTINE GET_HALO2
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! #########################
- SUBROUTINE GET_HALO(PSRC)
+ SUBROUTINE GET_HALO(PSRC,HDIR)
! #########################
!
USE MODE_ll
@@ -82,7 +97,8 @@ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
!
TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
INTEGER :: IERROR ! error return code
@@ -90,11 +106,265 @@ INTEGER :: IERROR ! error return code
NULLIFY( TZ_PSRC_ll)
!
CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
-CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR)
+CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
CALL CLEANLIST_ll(TZ_PSRC_ll)
!
END SUBROUTINE GET_HALO
!-----------------------------------------------------------------------
+MODULE MODD_HALO_D
+IMPLICIT NONE
+REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN
+REAL, SAVE , ALLOCATABLE, DIMENSION(:,:,:) :: ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT
+!PW ne passe pas avec PGI 15.10 (call to cuStreamSynchronize returned error 700: Illegal address during kernel execution):
+!!$acc declare create (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN)
+!!$acc declare create (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
+!!$acc declare mirror (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN)
+!!$acc declare mirror (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
+
+LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
+
+END MODULE MODD_HALO_D
+!-------------------------------------------------------------------------------
+! #########################
+ SUBROUTINE GET_HALO_D(PSRC,HDIR)
+! #########################
+!
+USE MODD_HALO_D
+USE MODE_ll
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+USE MODD_IO_ll, ONLY : GSMONOPROC
+USE MODE_MNH_ZWORK, ONLY : GWEST , GEAST, GSOUTH , GNORTH
+!
+USE MODD_CONF, ONLY : NHALO
+USE MODE_DEVICE
+USE MODE_MPPDB
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present (PSRC)
+CHARACTER(len=4), OPTIONAL :: HDIR ! to send only halo on X or Y direction
+!
+TYPE(LIST_ll) , POINTER :: TZ_PSRC_ll ! halo
+INTEGER :: IERROR ! error return code
+INTEGER, SAVE :: IIB,IJB ! Begining useful area in x,y,z directions
+INTEGER, SAVE :: IIE,IJE ! End useful area in x,y,z directions
+
+INTEGER,SAVE :: IIU,IJU,IKU
+INTEGER,SAVE :: IHALO_1
+INTEGER,PARAMETER :: IS_WEST=1 , IS_EAST=2, IS_SOUTH=3, IS_NORTH=4
+
+LOGICAL :: LX , LY
+
+!
+!LOGICAL, SAVE :: GFIRST_GET_HALO_D = .TRUE.
+!
+
+!JUANCHECK3D IF (GSMONOPROC) RETURN
+!
+#define _PW_NOINTERM
+NULLIFY( TZ_PSRC_ll)
+!
+IF (GFIRST_GET_HALO_D ) THEN
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ !
+ IIU=size(psrc,1)
+ IJU=size(psrc,2)
+ IKU=size(psrc,3)
+ !
+ IHALO_1 = NHALO-1
+ !
+#ifndef _PW_NOINTERM
+ ALLOCATE ( ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , IKU ) )
+ ALLOCATE ( ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , IKU ) )
+ ALLOCATE ( ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , IKU ) )
+ ALLOCATE ( ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , IKU ) )
+ !$acc enter data create (ZNORTH_IN, ZSOUTH_IN, ZWEST_IN, ZEAST_IN)
+ !
+ ALLOCATE ( ZSOUTH_OUT ( IIB:IIE , 1:IJB-1 , IKU ) )
+ ALLOCATE ( ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , IKU ) )
+ ALLOCATE ( ZWEST_OUT ( 1:IIB-1 , IJB:IJE , IKU ) )
+ ALLOCATE ( ZEAST_OUT ( IIE+1:IIU , IJB:IJE , IKU ) )
+ !$acc enter data create (ZNORTH_OUT, ZSOUTH_OUT, ZWEST_OUT, ZEAST_OUT)
+
+ CALL INIT_ON_HOST_AND_DEVICE(ZSOUTH_IN,-1e99,'GET_HALO_D::ZSOUTH_IN')
+ CALL INIT_ON_HOST_AND_DEVICE(ZNORTH_IN,-1e99,'GET_HALO_D::ZNORTH_IN')
+ CALL INIT_ON_HOST_AND_DEVICE(ZWEST_IN,-1e99,'GET_HALO_D::ZWEST_IN')
+ CALL INIT_ON_HOST_AND_DEVICE(ZEAST_IN,-1e99,'GET_HALO_D::ZEAST_IN')
+
+ CALL INIT_ON_HOST_AND_DEVICE(ZSOUTH_OUT,-1e99,'GET_HALO_D::ZSOUTH_OUT')
+ CALL INIT_ON_HOST_AND_DEVICE(ZNORTH_OUT,-1e99,'GET_HALO_D::ZNORTH_OUT')
+ CALL INIT_ON_HOST_AND_DEVICE(ZWEST_OUT,-1e99,'GET_HALO_D::ZWEST_OUT')
+ CALL INIT_ON_HOST_AND_DEVICE(ZEAST_OUT,-1e99,'GET_HALO_D::ZEAST_OUT')
+#endif
+
+ GFIRST_GET_HALO_D = .FALSE.
+END IF
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+LX = .FALSE.
+LY = .FALSE.
+
+IF (.NOT. PRESENT(HDIR) ) THEN
+LX = .TRUE.
+LY = .TRUE.
+ELSE
+LX = ( HDIR == "01_X" .OR. HDIR == "S0_X" )
+LY = ( HDIR == "01_Y" .OR. HDIR == "S0_Y" )
+!!$print *,"IIB=",IIB," HDIR=",HDIR," LX=",LX," LY=",LY ; call flush(6)
+END IF
+
+
+!Copy the halo on the device PSRC to Zxxxx_IN and put it in the PSRC copy on the host
+#ifndef _PW_NOINTERM
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+ !$acc kernels async(IS_WEST)
+ ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : ) = PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : )
+ !$acc end kernels
+ !$acc update host(ZWEST_IN) async(IS_WEST)
+ END IF
+ IF (.NOT.GEAST) THEN
+ !$acc kernels async(IS_EAST)
+ ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , : ) = PSRC( IIE-IHALO_1:IIE , IJB:IJE , : )
+ !$acc end kernels
+ !$acc update host(ZEAST_IN) async(IS_EAST)
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ !$acc kernels async(IS_SOUTH)
+ ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , : ) = PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : )
+ !$acc end kernels
+ !$acc update host(ZSOUTH_IN) async(IS_SOUTH)
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ !$acc kernels async(IS_NORTH)
+ ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , : ) = PSRC( IIB:IIE , IJE-IHALO_1:IJE , : )
+ !$acc end kernels
+ !$acc update host(ZNORTH_IN) async(IS_NORTH)
+ ENDIF
+ENDIF
+!$acc wait
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+ PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : ) = ZWEST_IN ( IIB:IIB+IHALO_1 , IJB:IJE , : )
+ ENDIF
+ IF (.NOT.GEAST) THEN
+ PSRC( IIE-IHALO_1:IIE , IJB:IJE , : ) = ZEAST_IN ( IIE-IHALO_1:IIE , IJB:IJE , : )
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : ) = ZSOUTH_IN ( IIB:IIE , IJB:IJB+IHALO_1 , : )
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ PSRC( IIB:IIE , IJE-IHALO_1:IJE , : ) = ZNORTH_IN ( IIB:IIE , IJE-IHALO_1:IJE , : )
+ ENDIF
+ENDIF
+#else
+IF (LX) THEN
+ IF (.NOT. GWEST) THEN
+ !$acc update host(PSRC( IIB:IIB+IHALO_1 , IJB:IJE , : ))
+ ENDIF
+ IF (.NOT.GEAST) THEN
+ !$acc update host(PSRC( IIE-IHALO_1:IIE , IJB:IJE , : ))
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ !$acc update host(PSRC( IIB:IIE , IJB:IJB+IHALO_1 , : ))
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ !$acc update host(PSRC( IIB:IIE , IJE-IHALO_1:IJE , : ))
+ ENDIF
+ENDIF
+#endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+IF (LX .OR. LY) THEN
+CALL ADD3DFIELD_ll(TZ_PSRC_ll,PSRC)
+CALL UPDATE_HALO_ll(TZ_PSRC_ll,IERROR, HDIR=HDIR )
+CALL CLEANLIST_ll(TZ_PSRC_ll)
+ELSE
+!Necessary to allow comparisons/checks with standard GET_HALO
+CALL MPPDB_CHECK3D(PSRC,"UPDATE_HALO_ll",PRECISION)
+ENDIF
+
+!Copy the halo on the host PSRC to Zxxxx_OUT and put it in the PSRC copy on the device
+#ifndef _PW_NOINTERM
+IF (LX) THEN
+ IF (.NOT.GWEST) THEN
+ ZWEST_OUT( 1:IIB-1 , IJB:IJE , : ) = PSRC( 1:IIB-1 , IJB:IJE , : )
+ ENDIF
+ IF (.NOT.GEAST) THEN
+ ZEAST_OUT( IIE+1:IIU , IJB:IJE , : ) = PSRC( IIE+1:IIU , IJB:IJE , : )
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ ZSOUTH_OUT ( IIB:IIE , 1:IJB-1 , : ) = PSRC( IIB:IIE , 1:IJB-1 , : )
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , : ) = PSRC( IIB:IIE , IJE+1:IJU , : )
+ ENDIF
+END IF
+IF (LX) THEN
+ IF (.NOT.GWEST) THEN
+ !$acc update device(ZWEST_OUT) async(IS_WEST)
+ !$acc kernels async(IS_WEST)
+ PSRC( 1:IIB-1 , IJB:IJE , : ) = ZWEST_OUT( 1:IIB-1 , IJB:IJE , : )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GEAST) THEN
+ !$acc update device(ZEAST_OUT) async(IS_EAST)
+ !$acc kernels async(IS_EAST)
+ PSRC( IIE+1:IIU , IJB:IJE , : ) = ZEAST_OUT( IIE+1:IIU , IJB:IJE , : )
+ !$acc end kernels
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ !$acc update device(ZSOUTH_OUT) async(IS_SOUTH)
+ !$acc kernels async(IS_SOUTH)
+ PSRC( IIB:IIE , 1:IJB-1 , : ) = ZSOUTH_OUT( IIB:IIE , 1:IJB-1 , : )
+ !$acc end kernels
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ !$acc update device(ZNORTH_OUT) async(IS_NORTH)
+ !$acc kernels async(IS_NORTH)
+ PSRC( IIB:IIE , IJE+1:IJU , : ) = ZNORTH_OUT ( IIB:IIE , IJE+1:IJU , : )
+ !$acc end kernels
+ ENDIF
+END IF
+!$acc wait
+#else
+IF (LX) THEN
+ IF (.NOT.GWEST) THEN
+ !$acc update device(PSRC( 1:IIB-1 , IJB:IJE , : ))
+ ENDIF
+ IF (.NOT.GEAST) THEN
+ !$acc update device(PSRC( IIE+1:IIU , IJB:IJE , : ))
+ ENDIF
+END IF
+IF (LY) THEN
+ IF (.NOT.GSOUTH) THEN
+ !$acc update device(PSRC( IIB:IIE , 1:IJB-1 , : ))
+ ENDIF
+ IF (.NOT.GNORTH) THEN
+ !$acc update device(PSRC( IIB:IIE , IJE+1:IJU , : ))
+ ENDIF
+END IF
+#endif
+!
+END SUBROUTINE GET_HALO_D
+!-----------------------------------------------------------------------
+!
!
! ####################################
SUBROUTINE DEL_HALO2_ll(TPHALO2LIST)
diff --git a/src/MNH/gradient_m.f90 b/src/MNH/gradient_m.f90
index 7a6abf7343e151be794df8d8ed1f74f4a458898b..a31398eb734c7c8259b6cba9fefca8c169553b8c 100644
--- a/src/MNH/gradient_m.f90
+++ b/src/MNH/gradient_m.f90
@@ -27,6 +27,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_M_M ! result mass point
END FUNCTION GX_M_M
!
!
+#ifdef _OPENACC
+SUBROUTINE GX_M_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_M_M)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_M_M ! result mass point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_M_M)
+!
+END SUBROUTINE GX_M_M_DEVICE
+#endif
+!
+!
FUNCTION GY_M_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
@@ -40,6 +56,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_M_M ! result mass point
END FUNCTION GY_M_M
!
!
+#ifdef _OPENACC
+SUBROUTINE GY_M_M_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_M_M)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_M_M ! result mass point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_M_M)
+!
+END SUBROUTINE GY_M_M_DEVICE
+#endif
+!
+!
FUNCTION GZ_M_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_M_M)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
@@ -51,10 +83,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_M_M ! result mass point
!
END FUNCTION GZ_M_M
!
- FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
-!
-IMPLICIT NONE
!
+#ifdef _OPENACC
+SUBROUTINE GZ_M_M_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_M_M)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_M_M ! result mass point
+!$acc declare present(PA,PDZZ,PGY_M_M)
+!
+END SUBROUTINE GZ_M_M_DEVICE
+#endif
+!
+!
+FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
@@ -68,10 +112,24 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGX_M_U ! result at flux
END FUNCTION GX_M_U
!
!
- FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
+#ifdef _OPENACC
+SUBROUTINE GX_M_U_DEVICE(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX,PGX_M_U)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGX_M_U ! result at flux side
+!$acc declare present(PY,PDXX,PDZZ,PDZX,PGX_M_U)
+!
+END SUBROUTINE GX_M_U_DEVICE
+#endif
!
-IMPLICIT NONE
!
+FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY !d*yy
@@ -84,11 +142,25 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGY_M_V ! result at flux
! side
END FUNCTION GY_M_V
!
- FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(PGZ_M_W)
-!
-IMPLICIT NONE
!
- ! Metric coefficient:
+#ifdef _OPENACC
+SUBROUTINE GY_M_V_DEVICE(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY,PGY_M_V)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGY_M_V ! result at flux side
+!$acc declare present(PY,PDYY,PDZZ,PDZY,PGY_M_V)
+!
+END SUBROUTINE GY_M_V_DEVICE
+#endif
+!
+!
+FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(PGZ_M_W)
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
@@ -100,6 +172,21 @@ REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)) :: PGZ_M_W ! result at flux
!
END FUNCTION GZ_M_W
!
+!
+#ifdef _OPENACC
+SUBROUTINE GZ_M_W_DEVICE(KKA,KKU,KL,PY,PDZZ,PGZ_M_W)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGZ_M_W ! result at flux side
+!$acc declare present(PY,PDZZ,PGZ_M_W)
+!
+END SUBROUTINE GZ_M_W_DEVICE
+#endif
+!
END INTERFACE
!
END MODULE MODI_GRADIENT_M
@@ -166,7 +253,7 @@ END MODULE MODI_GRADIENT_M
!
!
USE MODI_SHUMAN
-USE MODD_CONF
+USE MODD_CONF, ONLY:LFLAT
!
IMPLICIT NONE
!
@@ -205,6 +292,77 @@ END IF
END FUNCTION GX_M_M
!
!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GX_M_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_M_M)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF, ONLY:LFLAT
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_M_M ! result mass point
+!
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_M_M)
+!
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IDX1,IDX2,IDX3,IDX4
+!
+!----------------------------------------------------------------------------
+CALL MNH_GET_ZT3D(IDX1,IDX2,IDX3,IDX4)
+!
+!* 1. DEFINITION of GX_M_M
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ CALL MXM_DEVICE(PA(:,:,:),ZT3D(:,:,:,IDX1))
+ CALL DXF_DEVICE(ZT3D(:,:,:,IDX1),ZT3D(:,:,:,IDX2))
+ CALL MXF_DEVICE(PDZX,ZT3D(:,:,:,IDX1))
+ CALL DZM_DEVICE(KKA,KKU,KL,PA(:,:,:),ZT3D(:,:,:,IDX3))
+ !$acc kernels
+ ZT3D(:,:,:,IDX4) = ZT3D(:,:,:,IDX1)*ZT3D(:,:,:,IDX3)/PDZZ(:,:,:)
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL,ZT3D(:,:,:,IDX4),ZT3D(:,:,:,IDX1))
+ CALL MXF_DEVICE(PDXX(:,:,:),ZT3D(:,:,:,IDX3))
+ !$acc kernels
+ PGX_M_M(:,:,:)= (ZT3D(:,:,:,IDX2) - ZT3D(:,:,:,IDX1) &
+ ) /ZT3D(:,:,:,IDX3)
+ !$acc end kernels
+ELSE
+ CALL MXM_DEVICE(PA(:,:,:),ZT3D(:,:,:,IDX1))
+ CALL DXF_DEVICE(ZT3D(:,:,:,IDX1),ZT3D(:,:,:,IDX2))
+ CALL MXF_DEVICE(PDXX(:,:,:),ZT3D(:,:,:,IDX3))
+ !$acc kernels
+ PGX_M_M(:,:,:)= ZT3D(:,:,:,IDX2) / ZT3D(:,:,:,IDX3)
+ !$acc end kernels
+END IF
+!
+CALL MNH_REL_ZT3D(IDX1,IDX2,IDX3,IDX4)
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GX_M_M_DEVICE
+#endif
+!
+!
! #######################################################
FUNCTION GY_M_M(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_M_M)
! #######################################################
@@ -262,7 +420,7 @@ END FUNCTION GX_M_M
!* 0. DECLARATIONS
!
!
-USE MODD_CONF
+USE MODD_CONF, ONLY:LFLAT
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -300,9 +458,77 @@ ENDIF
!----------------------------------------------------------------------------
!
END FUNCTION GY_M_M
-
!
!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GY_M_M_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_M_M)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODD_CONF, ONLY:LFLAT
+USE MODI_SHUMAN_DEVICE
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_M_M ! result mass point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_M_M)
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IDX1,IDX2,IDX3,IDX4
+!
+!----------------------------------------------------------------------------
+CALL MNH_GET_ZT3D(IDX1,IDX2,IDX3,IDX4)
+!
+!* 1. DEFINITION of GY_M_M
+! --------------------
+!
+!
+IF (.NOT. LFLAT) THEN
+ CALL MYM_DEVICE(PA,ZT3D(:,:,:,IDX1))
+ CALL DYF_DEVICE(ZT3D(:,:,:,IDX1),ZT3D(:,:,:,IDX2))
+ CALL MYF_DEVICE(PDZY,ZT3D(:,:,:,IDX1))
+ CALL DZM_DEVICE(KKA,KKU,KL,PA,ZT3D(:,:,:,IDX3))
+ !$acc kernels
+ ZT3D(:,:,:,IDX4) = ZT3D(:,:,:,IDX1)*ZT3D(:,:,:,IDX3)/PDZZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL,ZT3D(:,:,:,IDX4),ZT3D(:,:,:,IDX1))
+ CALL MYF_DEVICE(PDYY,ZT3D(:,:,:,IDX3))
+ !$acc kernels
+ PGY_M_M(:,:,:)= (ZT3D(:,:,:,IDX2) - ZT3D(:,:,:,IDX1) &
+ ) /ZT3D(:,:,:,IDX3)
+ !$acc end kernels
+ELSE
+ CALL MYM_DEVICE(PA,ZT3D(:,:,:,IDX1))
+ CALL DYF_DEVICE(ZT3D(:,:,:,IDX1),ZT3D(:,:,:,IDX2))
+ CALL MYF_DEVICE(PDYY,ZT3D(:,:,:,IDX1))
+ !$acc kernels
+ PGY_M_M(:,:,:)= ZT3D(:,:,:,IDX2)/ZT3D(:,:,:,IDX1)
+ !$acc end kernels
+ENDIF
+!
+CALL MNH_REL_ZT3D(IDX1,IDX2,IDX3,IDX4)
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GY_M_M_DEVICE
+#endif
+!
!
! #######################################################
FUNCTION GZ_M_M(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_M_M)
@@ -388,6 +614,55 @@ PGZ_M_M(:,:,:)= MZF(KKA,KKU,KL, DZM(KKA,KKU,KL,PA(:,:,:))/PDZZ(:,:,:) )
END FUNCTION GZ_M_M
!
!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GZ_M_M_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_M_M)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the mass point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_M_M ! result mass point
+!$acc declare present(PA,PDZZ,PGZ_M_M)
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IDX1,IDX2
+!
+!----------------------------------------------------------------------------
+CALL MNH_GET_ZT3D(IDX1,IDX2)
+!
+!* 1. DEFINITION of GZ_M_M
+! --------------------
+!
+CALL DZM_DEVICE(KKA,KKU,KL,PA(:,:,:),ZT3D(:,:,:,IDX1))
+!$acc kernels
+ZT3D(:,:,:,IDX2) = ZT3D(:,:,:,IDX1)/PDZZ(:,:,:)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KL,ZT3D(:,:,:,IDX2),PGZ_M_M)
+!
+CALL MNH_REL_ZT3D(IDX1,IDX2)
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_M_M_DEVICE
+#endif
+!
+!
! ##################################################
FUNCTION GX_M_U(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX) RESULT(PGX_M_U)
! ##################################################
@@ -450,8 +725,7 @@ END FUNCTION GZ_M_M
!* 0. DECLARATIONS
! ------------
!
-USE MODI_SHUMAN
-USE MODD_CONF
+USE MODD_CONF, ONLY:LFLAT
USE MODD_PARAMETERS
!
IMPLICIT NONE
@@ -486,19 +760,23 @@ IJU=SIZE(PY,2)
IKU=SIZE(PY,3)
IF (.NOT. LFLAT) THEN
! PGX_M_U = ( DXM(PY) - MZF ( MXM( DZM(PY) /PDZZ ) * PDZX ) )/PDXX
-!! DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
-!! DO JI=1+JPHEXT,IIU
-!! PGX_M_U(JI,:,JK)= &
-!! ( PY(JI,:,JK)-PY(JI-1,:,JK) &
-!! -( (PY(JI,:,JK)-PY(JI,:,JK-1)) / PDZZ(JI,:,JK) &
-!! +(PY(JI-1,:,JK)-PY(JI-1,:,JK-1)) / PDZZ(JI-1,:,JK) &
-!! ) * PDZX(JI,:,JK)* 0.25 &
-!! -( (PY(JI,:,JK+1)-PY(JI,:,JK)) / PDZZ(JI,:,JK+1) &
-!! +(PY(JI-1,:,JK+1)-PY(JI-1,:,JK)) / PDZZ(JI-1,:,JK+1) &
-!! ) * PDZX(JI,:,JK+1)* 0.25 &
-!! ) / PDXX(JI,:,JK)
-!! END DO
-!! END DO
+!$acc data pcopyin (pdzz,pdzx,pdxx,py)
+!$acc kernels
+#ifndef _OPT_LINEARIZED_LOOPS
+ DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
+ DO JI=1+JPHEXT,IIU
+ PGX_M_U(JI,:,JK)= &
+ ( PY(JI,:,JK)-PY(JI-1,:,JK) &
+ -( (PY(JI,:,JK)-PY(JI,:,JK-1)) / PDZZ(JI,:,JK) &
+ +(PY(JI-1,:,JK)-PY(JI-1,:,JK-1)) / PDZZ(JI-1,:,JK) &
+ ) * PDZX(JI,:,JK)* 0.25 &
+ -( (PY(JI,:,JK+1)-PY(JI,:,JK)) / PDZZ(JI,:,JK+1) &
+ +(PY(JI-1,:,JK+1)-PY(JI-1,:,JK)) / PDZZ(JI-1,:,JK+1) &
+ ) * PDZX(JI,:,JK+1)* 0.25 &
+ ) / PDXX(JI,:,JK)
+ END DO
+ END DO
+#else
JIJKOR = 1 + JPHEXT + IIU*IJU*(JPVEXT_TURB+1 - 1)
JIJKEND = IIU*IJU*(IKU-JPVEXT_TURB)
!CDIR NODEP
@@ -521,12 +799,14 @@ IF (.NOT. LFLAT) THEN
) * PDZX(JIJKP1,1,1)* 0.25 &
) / PDXX(JIJK,1,1)
END DO
-
+#endif
!
DO JI=1+JPHEXT,IIU
PGX_M_U(JI,:,KKU)= ( PY(JI,:,KKU)-PY(JI-1,:,KKU) ) / PDXX(JI,:,KKU)
PGX_M_U(JI,:,KKA)= PGX_M_U(JI,:,KKU) ! -999.
END DO
+!$acc end kernels
+!$acc end data
ELSE
! PGX_M_U = DXM(PY) / PDXX
PGX_M_U(1+1:IIU,:,:) = ( PY(1+1:IIU,:,:)-PY(1:IIU-1,:,:) ) & ! +JPHEXT
@@ -541,6 +821,85 @@ END DO
END FUNCTION GX_M_U
!
!
+#ifdef _OPENACC
+! ##################################################
+ SUBROUTINE GX_M_U_DEVICE(KKA,KKU,KL,PY,PDXX,PDZZ,PDZX,PGX_M_U)
+! ##################################################
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! d*xx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! d*zx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGX_M_U ! result at flux side
+!$acc declare present(PY,PDXX,PDZZ,PDZX,PGX_M_U)
+!
+INTEGER IIU,IJU,IKU,JI
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG X
+! -----------------------------
+!
+
+IIU=SIZE(PY,1)
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+IF (.NOT. LFLAT) THEN
+!$acc kernels
+PGX_M_U(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB) = &
+ ( PY(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)-PY(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB) &
+ -( (PY(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)-PY(1+JPHEXT:IIU,1:IJU,JPVEXT_TURB:IKU-JPVEXT_TURB-1)) &
+ / PDZZ(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB) &
+ +(PY(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)-PY(JPHEXT:IIU-1,1:IJU,JPVEXT_TURB:IKU-JPVEXT_TURB-1)) &
+ / PDZZ(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB) &
+ ) * PDZX(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)* 0.25 &
+ -( (PY(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB+1:IKU-JPVEXT_TURB+1)-PY(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)) &
+ / PDZZ(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB+1:IKU-JPVEXT_TURB+1) &
+ +(PY(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB+1:IKU-JPVEXT_TURB+1)-PY(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)) &
+ / PDZZ(JPHEXT:IIU-1,1:IJU,1+JPVEXT_TURB+1:IKU-JPVEXT_TURB+1) &
+ ) * PDZX(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB+1:IKU-JPVEXT_TURB+1)* 0.25 &
+ ) / PDXX(1+JPHEXT:IIU,1:IJU,1+JPVEXT_TURB:IKU-JPVEXT_TURB)
+!
+ DO JI=1+JPHEXT,IIU
+ PGX_M_U(JI,:,KKU)= ( PY(JI,:,KKU)-PY(JI-1,:,KKU) ) / PDXX(JI,:,KKU)
+ PGX_M_U(JI,:,KKA)= -999.
+ END DO
+!
+ PGX_M_U(1,:,:)=PGX_M_U(IIU-2*JPHEXT+1,:,:)
+!$acc end kernels
+
+ELSE
+!$acc kernels
+ PGX_M_U(1+JPHEXT:IIU,:,:) = ( PY(1+JPHEXT:IIU,:,:)-PY(JPHEXT:IIU-1,:,:) ) &
+ / PDXX(1+JPHEXT:IIU,:,:)
+!
+ PGX_M_U(1,:,:)=PGX_M_U(IIU-2*JPHEXT+1,:,:)
+!$acc end kernels
+!
+ENDIF
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GX_M_U_DEVICE
+#endif
+!
+!
! ##################################################
FUNCTION GY_M_V(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY) RESULT(PGY_M_V)
! ##################################################
@@ -603,8 +962,7 @@ END FUNCTION GX_M_U
!* 0. DECLARATIONS
! ------------
!
-USE MODI_SHUMAN
-USE MODD_CONF
+USE MODD_CONF, ONLY:LFLAT
USE MODD_PARAMETERS
!
IMPLICIT NONE
@@ -633,6 +991,7 @@ IJU=SIZE(PY,2)
IKU=SIZE(PY,3)
IF (.NOT. LFLAT) THEN
! PGY_M_V = ( DYM(PY) - MZF ( MYM( DZM(PY) /PDZZ ) * PDZY ) )/PDYY
+!$acc kernels
DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
DO JJ=1+JPHEXT,IJU
PGY_M_V(:,JJ,JK)= &
@@ -651,6 +1010,7 @@ IF (.NOT. LFLAT) THEN
PGY_M_V(:,JJ,KKU)= ( PY(:,JJ,KKU)-PY(:,JJ-1,KKU) ) / PDYY(:,JJ,KKU)
PGY_M_V(:,JJ,KKA)= PGY_M_V(:,JJ,KKU) ! -999.
END DO
+!$acc end kernels
ELSE
! PGY_M_V = DYM(PY)/PDYY
PGY_M_V(:,1+1:IJU,:) = ( PY(:,1+1:IJU,:)-PY(:,1:IJU-1,:) ) & ! +JPHEXT
@@ -665,6 +1025,80 @@ END DO
END FUNCTION GY_M_V
!
!
+#ifdef _OPENACC
+! ##################################################
+ SUBROUTINE GY_M_V_DEVICE(KKA,KKU,KL,PY,PDYY,PDZZ,PDZY,PGY_M_V)
+! ##################################################
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF, ONLY:LFLAT
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY !d*yy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY !d*zy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGY_M_V ! result at flux side
+!$acc declare present(PY,PDYY,PDZZ,PDZY,PGY_M_V)
+!
+INTEGER IJU,IKU,JJ,JK
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Y
+! ----------------------------
+!
+IJU=SIZE(PY,2)
+IKU=SIZE(PY,3)
+IF (.NOT. LFLAT) THEN
+!$acc kernels
+ DO JK=1+JPVEXT_TURB,IKU-JPVEXT_TURB
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,JK)= &
+ ( PY(:,JJ,JK)-PY(:,JJ-1,JK) &
+ -( (PY(:,JJ,JK)-PY(:,JJ,JK-KL)) / PDZZ(:,JJ,JK) &
+ +(PY(:,JJ-1,JK)-PY(:,JJ-KL,JK-KL)) / PDZZ(:,JJ-1,JK) &
+ ) * PDZY(:,JJ,JK)* 0.25 &
+ -( (PY(:,JJ,JK+KL)-PY(:,JJ,JK)) / PDZZ(:,JJ,JK+KL) &
+ +(PY(:,JJ-1,JK+KL)-PY(:,JJ-1,JK)) / PDZZ(:,JJ-1,JK+KL) &
+ ) * PDZY(:,JJ,JK+KL)* 0.25 &
+ ) / PDYY(:,JJ,JK)
+ END DO
+ END DO
+!
+ DO JJ=1+JPHEXT,IJU
+ PGY_M_V(:,JJ,KKU)= ( PY(:,JJ,KKU)-PY(:,JJ-1,KKU) ) / PDYY(:,JJ,KKU)
+ PGY_M_V(:,JJ,KKA)= -999.
+ END DO
+!
+ PGY_M_V(:,1,:)=PGY_M_V(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+ELSE
+!$acc kernels
+ PGY_M_V(:,1+JPHEXT:IJU,:) = ( PY(:,1+JPHEXT:IJU,:)-PY(:,JPHEXT:IJU-1,:) ) &
+ / PDYY(:,1+JPHEXT:IJU,:)
+!
+ PGY_M_V(:,1,:)=PGY_M_V(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GY_M_V_DEVICE
+#endif
+!
+!
! #########################################
FUNCTION GZ_M_W(KKA,KKU,KL,PY,PDZZ) RESULT(PGZ_M_W)
! #########################################
@@ -755,4 +1189,51 @@ PGZ_M_W(:,:,KKA)= PGZ_M_W(:,:,KKU) ! -999.
!-------------------------------------------------------------------------------
!
END FUNCTION GZ_M_W
+!
+!
+#ifdef _OPENACC
+! #########################################
+ SUBROUTINE GZ_M_W_DEVICE(KKA,KKU,KL,PY,PDZZ,PGZ_M_W)
+! #########################################
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments and results
+! -------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ !d*zz
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PY ! variable at mass localization
+!
+REAL, DIMENSION(SIZE(PY,1),SIZE(PY,2),SIZE(PY,3)),INTENT(OUT) :: PGZ_M_W ! result at flux side
+!$acc declare present(PY,PDZZ,PGZ_M_W)
+!
+INTEGER :: IKT,IKTB,IKTE
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE THE GRADIENT ALONG Z
+! -----------------------------
+!
+IKT=SIZE(PY,3)
+IKTB=1+JPVEXT_TURB
+IKTE=IKT-JPVEXT_TURB
+!$acc kernels
+PGZ_M_W(:,:,IKTB:IKTE) = (PY(:,:,IKTB:IKTE)-PY(:,:,IKTB-KL:IKTE-KL)) &
+ / PDZZ(:,:,IKTB:IKTE)
+PGZ_M_W(:,:,KKU)= (PY(:,:,KKU)-PY(:,:,KKU-KL)) &
+ / PDZZ(:,:,KKU)
+PGZ_M_W(:,:,KKA)=-999.
+!$acc end kernels
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_M_W_DEVICE
+#endif
diff --git a/src/MNH/gradient_u.f90 b/src/MNH/gradient_u.f90
index 20526e75efcfa6028c3bf69cfeda117598752815..9cd43ea9c10def9c3319449a72b3b8de99ba6450 100644
--- a/src/MNH/gradient_u.f90
+++ b/src/MNH/gradient_u.f90
@@ -28,6 +28,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_U_M ! result mass point
END FUNCTION GX_U_M
!
!
+#ifdef _OPENACC
+SUBROUTINE GX_U_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_U_M_DEVICE ! result mass point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
+!
+END SUBROUTINE GX_U_M_DEVICE
+#endif
+!
+!
FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
@@ -42,6 +58,22 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_U_UV ! result UV point
END FUNCTION GY_U_UV
!
!
+#ifdef _OPENACC
+SUBROUTINE GY_U_UV_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_U_UV_DEVICE ! result UV point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
+!
+END SUBROUTINE GY_U_UV_DEVICE
+#endif
+!
+!
FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
@@ -53,6 +85,21 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_U_UW ! result UW point
!
END FUNCTION GZ_U_UW
!
+!
+#ifdef _OPENACC
+SUBROUTINE GZ_U_UW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_U_UW_DEVICE)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_U_UW_DEVICE ! result UW point
+!$acc declare present(PA,PDZZ,PGZ_U_UW_DEVICE)
+!
+END SUBROUTINE GZ_U_UW_DEVICE
+#endif
+!
+!
END INTERFACE
!
END MODULE MODI_GRADIENT_U
@@ -158,6 +205,74 @@ END IF
END FUNCTION GX_U_M
!
!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GX_U_M_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_U_M_DEVICE ! result mass point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_U_M_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_U_M_DEVICE
+! --------------------
+IF (.NOT. LFLAT) THEN
+ CALL DXF_DEVICE(PA,ZTMP1_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = PDZX * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE / PDZZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL,ZTMP3_DEVICE,ZTMP2_DEVICE)
+ CALL MXF_DEVICE(PDXX,ZTMP3_DEVICE)
+ !$acc kernels
+ PGX_U_M_DEVICE(:,:,:)= ( ZTMP1_DEVICE - ZTMP2_DEVICE ) / ZTMP3_DEVICE
+ !$acc end kernels
+ELSE
+ CALL DXF_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(PDXX,ZTMP2_DEVICE)
+ !$acc kernels
+ PGX_U_M_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+ !$acc end kernels
+END IF
+!
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GX_U_M_DEVICE
+#endif
+!
+!
! #########################################################
FUNCTION GY_U_UV(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_U_UV)
! #########################################################
@@ -256,6 +371,76 @@ END IF
END FUNCTION GY_U_UV
!
!
+#ifdef _OPENACC
+! #########################################################
+ SUBROUTINE GY_U_UV_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
+! #########################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_U_UV_DEVICE ! result UV point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_U_UV_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_U_UV_DEVICE
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP1_DEVICE)
+ CALL MXM_DEVICE(PDZZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE/ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYM_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL MXM_DEVICE(PDZY,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL, ZTMP3_DEVICE,ZTMP2_DEVICE )
+ CALL DYM_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MXM_DEVICE(PDYY,ZTMP3_DEVICE)
+ !$acc kernels
+ PGY_U_UV_DEVICE(:,:,:)= ( ZTMP1_DEVICE - ZTMP2_DEVICE ) / ZTMP3_DEVICE
+ !$acc end kernels
+ELSE
+ CALL DYM_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MXM_DEVICE(PDYY,ZTMP2_DEVICE)
+ !$acc kernels
+ PGY_U_UV_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+ !$acc end kernels
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GY_U_UV_DEVICE
+#endif
+!
+!
! #######################################################
FUNCTION GZ_U_UW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_U_UW)
! #######################################################
@@ -337,3 +522,51 @@ PGZ_U_UW(:,:,:)= DZM(KKA,KKU,KL,PA) / MXM(PDZZ)
!----------------------------------------------------------------------------
!
END FUNCTION GZ_U_UW
+!
+!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GZ_U_UW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_U_UW_DEVICE)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the U point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_U_UW_DEVICE ! result UW point
+!$acc declare present(PA,PDZZ,PGZ_U_UW_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_U_UW_DEVICE
+! ---------------------
+!
+CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP1_DEVICE)
+CALL MXM_DEVICE(PDZZ,ZTMP2_DEVICE)
+!$acc kernels
+PGZ_U_UW_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_U_UW_DEVICE
+#endif
diff --git a/src/MNH/gradient_v.f90 b/src/MNH/gradient_v.f90
index 98a7349d7e7e75282666378f3a5d5b527bee7fac..be2265b84e0383c46596b6b333d5d5c008d2278a 100644
--- a/src/MNH/gradient_v.f90
+++ b/src/MNH/gradient_v.f90
@@ -27,6 +27,24 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_V_M ! result mass point
!
END FUNCTION GY_V_M
+!
+!
+#ifdef _OPENACC
+SUBROUTINE GY_V_M_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_V_M_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_V_M_DEVICE ! result mass point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_V_M_DEVICE)
+!
+END SUBROUTINE GY_V_M_DEVICE
+#endif
+!
!
FUNCTION GX_V_UV(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
!
@@ -41,6 +59,23 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_V_UV ! result UV point
!
END FUNCTION GX_V_UV
!
+!
+#ifdef _OPENACC
+SUBROUTINE GX_V_UV_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_V_UV_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_V_UV_DEVICE ! result UV point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_V_UV_DEVICE)
+!
+END SUBROUTINE GX_V_UV_DEVICE
+#endif
+!
!
FUNCTION GZ_V_VW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_V_VW)
!
@@ -54,6 +89,21 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_V_VW ! result VW point
END FUNCTION GZ_V_VW
!
!
+#ifdef _OPENACC
+SUBROUTINE GZ_V_VW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_V_VW_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_V_VW_DEVICE ! result VW point
+!$acc declare present(PA,PDZZ,PGZ_V_VW_DEVICE)
+!
+END SUBROUTINE GZ_V_VW_DEVICE
+#endif
+!
+!
END INTERFACE
!
END MODULE MODI_GRADIENT_V
@@ -156,6 +206,73 @@ END IF
!
END FUNCTION GY_V_M
!
+!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GY_V_M_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_V_M_DEVICE)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_V_M_DEVICE ! result mass point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_V_M_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_V_M_DEVICE
+! --------------------
+!
+IF (.NOT. LFLAT) THEN
+ CALL DYF_DEVICE(PA,ZTMP1_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = PDZY*ZTMP2_DEVICE
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE/PDZZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL,ZTMP3_DEVICE,ZTMP2_DEVICE)
+ CALL MYF_DEVICE(PDYY,ZTMP3_DEVICE)
+!$acc kernels
+ PGY_V_M_DEVICE(:,:,:)= (ZTMP1_DEVICE - ZTMP2_DEVICE) / ZTMP3_DEVICE
+!$acc end kernels
+ELSE
+ CALL DYF_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(PDYY,ZTMP2_DEVICE)
+!$acc kernels
+ PGY_V_M_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GY_V_M_DEVICE
+#endif
+!
!
! #########################################################
FUNCTION GX_V_UV(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_V_UV)
@@ -254,6 +371,77 @@ END IF
END FUNCTION GX_V_UV
!
!
+#ifdef _OPENACC
+! #########################################################
+ SUBROUTINE GX_V_UV_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_V_UV_DEVICE)
+! #########################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_V_UV_DEVICE ! result UV point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_V_UV_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+!
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_V_UV_DEVICE
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+
+ CALL DXM_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MYM_DEVICE(PDZZ,ZTMP2_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = ZTMP3_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP4_DEVICE,ZTMP2_DEVICE)
+ CALL MYM_DEVICE(PDZX,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = ZTMP2_DEVICE *ZTMP3_DEVICE
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KL,ZTMP4_DEVICE,ZTMP2_DEVICE)
+ CALL MYM_DEVICE(PDXX,ZTMP3_DEVICE)
+!$acc kernels
+ PGX_V_UV_DEVICE(:,:,:)= ( ZTMP1_DEVICE - ZTMP2_DEVICE ) / ZTMP3_DEVICE
+!$acc end kernels
+ELSE
+ CALL DXM_DEVICE(PA,ZTMP1_DEVICE)
+ CALL MYM_DEVICE(PDXX,ZTMP2_DEVICE)
+!$acc kernels
+ PGX_V_UV_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GX_V_UV_DEVICE
+#endif
+!
+!
! #######################################################
FUNCTION GZ_V_VW(KKA,KKU,KL,PA,PDZZ) RESULT(PGZ_V_VW)
! #######################################################
@@ -336,3 +524,50 @@ PGZ_V_VW(:,:,:)= DZM(KKA,KKU,KL,PA) / MYM(PDZZ)
!----------------------------------------------------------------------------
!
END FUNCTION GZ_V_VW
+!
+!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GZ_V_VW_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_V_VW_DEVICE)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the V point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_V_VW_DEVICE ! result VW point
+!$acc declare present(PA,PDZZ,PGZ_V_VW_DEVICE)
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!
+!* 0.2 declaration of local variables
+!
+! NONE
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_V_VW_DEVICE
+! ---------------------
+!
+CALL DZM_DEVICE(KKA,KKU,KL,PA,ZTMP1_DEVICE)
+CALL MYM_DEVICE(PDZZ,ZTMP2_DEVICE)
+!$acc kernels
+PGZ_V_VW_DEVICE(:,:,:)= ZTMP1_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_V_VW_DEVICE
+#endif
diff --git a/src/MNH/gradient_w.f90 b/src/MNH/gradient_w.f90
index 80bdd7dc86fce57b0f8351c86a7439d5bacb3178..7d8b2dc6ea8b91aa15a1ec69c15515fe9b2055ba 100644
--- a/src/MNH/gradient_w.f90
+++ b/src/MNH/gradient_w.f90
@@ -25,7 +25,23 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGZ_W_M ! result mass point
!
END FUNCTION GZ_W_M
-!
+!
+!
+#ifdef _OPENACC
+SUBROUTINE GZ_W_M_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_W_M_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_W_M_DEVICE ! result mass point
+!$acc declare present(PA,PDZZ,PGZ_W_M_DEVICE)
+!
+END SUBROUTINE GZ_W_M_DEVICE
+#endif
+!
+!
FUNCTION GX_W_UW(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
@@ -39,21 +55,55 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGX_W_UW ! result UW point
!
END FUNCTION GX_W_UW
!
+!
+#ifdef _OPENACC
+SUBROUTINE GX_W_UW_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_W_UW_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_W_UW_DEVICE ! result UW point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_W_UW_DEVICE)
+!
+END SUBROUTINE GX_W_UW_DEVICE
+#endif
+!
!
-FUNCTION GY_W_VW(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGY_W_VW)
+FUNCTION GY_W_VW(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
!
INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
!
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PGY_W_VW ! result VW point
!
END FUNCTION GY_W_VW
!
!
+#ifdef _OPENACC
+SUBROUTINE GY_W_VW_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_W_VW_DEVICE)
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_W_VW_DEVICE ! result VW point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_W_VW_DEVICE)
+!
+END SUBROUTINE GY_W_VW_DEVICE
+#endif
+!
+!
END INTERFACE
!
END MODULE MODI_GRADIENT_W
@@ -138,6 +188,51 @@ PGZ_W_M(:,:,:)= DZF(KKA,KKU,KL,PA(:,:,:))/(MZF(KKA,KKU,KL,PDZZ(:,:,:)))
END FUNCTION GZ_W_M
!
!
+#ifdef _OPENACC
+! #######################################################
+ SUBROUTINE GZ_W_M_DEVICE(KKA,KKU,KL,PA,PDZZ,PGZ_W_M_DEVICE)
+! #######################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGZ_W_M_DEVICE ! result mass point
+!$acc declare present(PA,PDZZ,PGZ_W_M_DEVICE)
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GZ_W_M_DEVICE
+! --------------------
+!
+CALL DZF_DEVICE(KKA,KKU,KL,PA(:,:,:),ZTMP1_DEVICE)
+CALL MZF_DEVICE(KKA,KKU,KL,PDZZ(:,:,:),ZTMP2_DEVICE)
+!$acc kernels
+PGZ_W_M_DEVICE(:,:,:)= ZTMP1_DEVICE/ZTMP2_DEVICE
+!$acc end kernels
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GZ_W_M_DEVICE
+#endif
+!
+!
! #########################################################
FUNCTION GX_W_UW(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX) RESULT(PGX_W_UW)
! #########################################################
@@ -226,6 +321,71 @@ END IF
END FUNCTION GX_W_UW
!
!
+#ifdef _OPENACC
+! #########################################################
+ SUBROUTINE GX_W_UW_DEVICE(KKA,KKU,KL,PA,PDXX,PDZZ,PDZX,PGX_W_UW_DEVICE)
+! #########################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGX_W_UW_DEVICE ! result UW point
+!$acc declare present(PA,PDXX,PDZZ,PDZX,PGX_W_UW_DEVICE)
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE)
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GX_W_UW_DEVICE
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ CALL DXM_DEVICE(PA(:,:,:),ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PDXX(:,:,:),ZTMP2_DEVICE)
+ !
+ CALL MZF_DEVICE(KKA,KKU,KL,PA(:,:,:),ZTMP3_DEVICE)
+ CALL MXM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KL,ZTMP4_DEVICE,ZTMP3_DEVICE)
+ !
+ CALL MZM_DEVICE(PDXX(:,:,:),ZTMP4_DEVICE)
+ CALL MXM_DEVICE(PDZZ(:,:,:),ZTMP5_DEVICE)
+!$acc kernels
+ PGX_W_UW_DEVICE(:,:,:)= ZTMP1_DEVICE/ZTMP2_DEVICE &
+ -ZTMP3_DEVICE*PDZX(:,:,:) &
+ /( ZTMP4_DEVICE*ZTMP5_DEVICE )
+!$acc end kernels
+ELSE
+ CALL DXM_DEVICE(PA(:,:,:),ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PDXX(:,:,:),ZTMP2_DEVICE)
+!$acc kernels
+ PGX_W_UW_DEVICE(:,:,:)= ZTMP1_DEVICE/ZTMP2_DEVICE
+!$acc end kernels
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GX_W_UW_DEVICE
+#endif
+!
+!
! #########################################################
FUNCTION GY_W_VW(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY) RESULT(PGY_W_VW)
! #########################################################
@@ -312,3 +472,68 @@ END IF
!----------------------------------------------------------------------------
!
END FUNCTION GY_W_VW
+!
+!
+#ifdef _OPENACC
+! #########################################################
+ SUBROUTINE GY_W_VW_DEVICE(KKA,KKU,KL,PA,PDYY,PDZZ,PDZY,PGY_W_VW_DEVICE)
+! #########################################################
+!
+!* 0. DECLARATIONS
+!
+!
+USE MODI_SHUMAN_DEVICE
+USE MODD_CONF
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments and result
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at the W point
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)), INTENT(OUT) :: PGY_W_VW_DEVICE ! result VW point
+!$acc declare present(PA,PDYY,PDZZ,PDZY,PGY_W_VW_DEVICE)
+!
+!* 0.2 declaration of local variables
+!
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE)
+!
+!----------------------------------------------------------------------------
+!
+!* 1. DEFINITION of GY_W_VW_DEVICE
+! ---------------------
+!
+IF (.NOT. LFLAT) THEN
+ CALL DYM_DEVICE(PA(:,:,:),ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PDYY(:,:,:),ZTMP2_DEVICE)
+ !
+ CALL MZF_DEVICE(KKA,KKU,KL,PA(:,:,:),ZTMP3_DEVICE)
+ CALL MYM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KL,ZTMP4_DEVICE,ZTMP3_DEVICE)
+ !
+ CALL MZM_DEVICE(PDYY(:,:,:),ZTMP4_DEVICE)
+ CALL MYM_DEVICE(PDZZ(:,:,:),ZTMP5_DEVICE)
+!$acc kernels
+ PGY_W_VW_DEVICE(:,:,:)= ZTMP1_DEVICE/ZTMP2_DEVICE &
+ -ZTMP3_DEVICE*PDZY(:,:,:) &
+ /( ZTMP4_DEVICE*ZTMP5_DEVICE )
+!$acc end kernels
+ELSE
+ CALL DYM_DEVICE(PA(:,:,:),ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PDYY(:,:,:),ZTMP2_DEVICE)
+!$acc kernels
+ PGY_W_VW_DEVICE(:,:,:)= ZTMP1_DEVICE/ZTMP2_DEVICE
+!$acc end kernels
+END IF
+!
+!----------------------------------------------------------------------------
+!
+END SUBROUTINE GY_W_VW_DEVICE
+#endif
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 0aba42873940d02b0667520e57521da23a6ad318..7c9ad622c52c5fa7779f3f354ea4c66f2482076e 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -384,12 +384,15 @@ END IF
! 1.3 Rotate the wind
! ---------------
!
+!$acc data copyin(XUT,XVT,XWT,XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
+!$acc & XCOSSLOPE,XSINSLOPE,XDXX,XDYY,XDZZ) &
+!$acc copyout(ZUA,ZVA)
CALL ROTATE_WIND(XUT,XVT,XWT, &
XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, &
XCOSSLOPE,XSINSLOPE, &
XDXX,XDYY,XDZZ, &
ZUA,ZVA )
-
+!$acc end data
!
! 1.4 zonal and meridian components of the wind parallel to the slope
! ---------------------------------------------------------------
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index 1643b0cc3208e2ee650eb6e56833d4296d42c1bd..5584d44dbd720b4e367918e4dc3ab7f8e3309b57 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -157,7 +157,6 @@ END MODULE MODI_INI_BUDGET
!! 04/2016 (C.LAC) negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
!! C. Barthe 01/2016 Add budget for LIMA
!! C.LAc 10/2016 Add budget for droplet deposition
-
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index e1ead4db5c89143430f996ff9874745859f1d741..0ee13afd6e8d692984e828e0de1e52918f815ce0 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -106,6 +106,9 @@ USE MODI_INI_SPECTRE_n
USE MODE_SPLITTINGZ_ll
!JUAN
!
+USE MODE_MNH_ZWORK
+!
+!
IMPLICIT NONE
!
!* 0.1 Local variables
@@ -218,6 +221,7 @@ DO JMI=1,NMODEL
ENDIF
ENDDO
!
+CALL MNH_ALLOC_ZWORK(NMODEL)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/les_mean_1proc.f90 b/src/MNH/les_mean_1proc.f90
index d80b9c2c55189c225fd3a36e01635f4ec3d2e287..560e5d59b7b125c82dd287198d223e4f2d690b2a 100644
--- a/src/MNH/les_mean_1proc.f90
+++ b/src/MNH/les_mean_1proc.f90
@@ -52,6 +52,49 @@ END SUBROUTINE LES_MEAN_1PROC_3DM
!
END INTERFACE
!
+!
+#ifdef _OPENACC
+INTERFACE LES_MEAN_1PROC_DEVICE
+!
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_2D(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK
+!
+REAL, INTENT(OUT) :: PA_MEAN
+INTEGER, INTENT(OUT) :: KAVG_PTS
+INTEGER, INTENT(OUT) :: KUND_PTS
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_2D
+!
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_3D(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OMASK
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PA_MEAN
+INTEGER, DIMENSION(:), INTENT(OUT) :: KAVG_PTS
+INTEGER, DIMENSION(:), INTENT(OUT) :: KUND_PTS
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_3D
+!
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_3DM(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PA_MEAN
+INTEGER, DIMENSION(:), INTENT(OUT) :: KAVG_PTS
+INTEGER, DIMENSION(:), INTENT(OUT) :: KUND_PTS
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_3DM
+!
+END INTERFACE
+#endif
+!
END MODULE MODI_LES_MEAN_1PROC
!
! ###########################################################
@@ -140,6 +183,100 @@ END IF
!
END SUBROUTINE LES_MEAN_1PROC_2D
!
+#ifdef _OPENACC
+! ###########################################################
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_2D(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+! ###########################################################
+!
+!
+!!**** *LES_MEAN_1PROC_DEVICE* computes the average of one field on one processor
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! V. Masson 06/11/02 optimization
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK
+!
+REAL, INTENT(OUT) :: PA_MEAN
+INTEGER, INTENT(OUT) :: KAVG_PTS
+INTEGER, INTENT(OUT) :: KUND_PTS
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: IIB, IIE, IJB, IJE ! physical domain boundary
+INTEGER :: JI, JJ ! loop counters
+!
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: LES_MEAN_1PROC_DEVICE_2D not yet tested'
+CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
+!
+PA_MEAN = 0.
+KAVG_PTS = 0
+KUND_PTS = 0
+!
+!$acc data present(PA,OMASK)
+!$acc kernels
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( OMASK(JI,JJ) ) THEN
+ IF ( PA(JI,JJ)/=XUNDEF ) THEN
+ PA_MEAN = PA_MEAN + PA(JI,JJ)
+ KAVG_PTS = KAVG_PTS + 1
+ ELSE
+ KUND_PTS = KUND_PTS + 1
+ END IF
+ END IF
+ END DO
+END DO
+!$acc end kernels
+!
+IF ( KAVG_PTS > 0 ) THEN
+ PA_MEAN = PA_MEAN / KAVG_PTS
+ELSE
+ PA_MEAN = XUNDEF
+END IF
+!$acc end data !present(PA,OMASK)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_2D
+#endif
+!
! ###########################################################
SUBROUTINE LES_MEAN_1PROC_3D(PA, OMASK, &
PA_MEAN, KAVG_PTS, KUND_PTS )
@@ -230,6 +367,121 @@ END WHERE
!
END SUBROUTINE LES_MEAN_1PROC_3D
!
+#ifdef _OPENACC
+! ###########################################################
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_3D(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+! ###########################################################
+!
+!
+!!**** *LES_MEAN_1PROC_DEVICE* computes the average of one field on one processor
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OMASK
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PA_MEAN
+INTEGER, DIMENSION(:), INTENT(OUT) :: KAVG_PTS
+INTEGER, DIMENSION(:), INTENT(OUT) :: KUND_PTS
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: IIB, IIE, IJB, IJE ! physical domain boundary
+INTEGER :: JI, JJ ! loop counters
+!
+INTEGER :: IK ! number of vertical levels
+INTEGER :: JK ! loop counter
+REAL :: PA_MEAN_JK
+INTEGER :: KAVG_PTS_JK, KUND_PTS_JK
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: LES_MEAN_1PROC_DEVICE_3D not yet tested'
+CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
+IK=SIZE(PA,3)
+!
+!$acc data present(PA,OMASK,PA_MEAN,KAVG_PTS,KUND_PTS)
+!
+!$acc kernels
+PA_MEAN = 0.
+KAVG_PTS = 0
+KUND_PTS = 0
+!$acc end kernels
+!
+!$acc kernels
+!$acc loop private(PA_MEAN_JK,KAVG_PTS_JK,KUND_PTS_JK)
+DO JK=1,IK
+ PA_MEAN_JK = 0.
+ KAVG_PTS_JK = 0
+ KUND_PTS_JK = 0
+ !$acc loop reduction(+:PA_MEAN_JK,KAVG_PTS_JK,KUND_PTS_JK)
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( OMASK(JI,JJ,JK) ) THEN
+ IF ( PA(JI,JJ,JK)/=XUNDEF ) THEN
+ PA_MEAN_JK = PA_MEAN_JK + PA(JI,JJ,JK)
+ KAVG_PTS_JK = KAVG_PTS_JK + 1
+ ELSE
+ KUND_PTS_JK = KUND_PTS_JK + 1
+ END IF
+ END IF
+ END DO
+ END DO
+ PA_MEAN(JK) = PA_MEAN_JK
+ KAVG_PTS(JK) = KAVG_PTS_JK
+ KUND_PTS(JK) = KUND_PTS_JK
+END DO
+!$acc end kernels
+!
+!$acc kernels
+WHERE ( KAVG_PTS(:) > 0 )
+ PA_MEAN(:) = PA_MEAN(:) / KAVG_PTS(:)
+ELSEWHERE
+ PA_MEAN(:) = XUNDEF
+END WHERE
+!$acc end kernels
+!
+!$acc end data !present(PA,OMASK,PA_MEAN,KAVG_PTS,KUND_PTS)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_3D
+#endif
+!
! ###########################################################
SUBROUTINE LES_MEAN_1PROC_3DM(PA, OMASK, &
PA_MEAN, KAVG_PTS, KUND_PTS )
@@ -289,6 +541,7 @@ INTEGER :: IK ! number of vertical levels
INTEGER :: JK ! loop counter
!-------------------------------------------------------------------------------
!
+PRINT *,'OPENACC: LES_MEAN_1PROC_DEVICE_3DM not yet tested'
CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
IK=SIZE(PA,3)
!
@@ -319,4 +572,107 @@ END WHERE
!-------------------------------------------------------------------------------
!
END SUBROUTINE LES_MEAN_1PROC_3DM
-
+!
+#ifdef _OPENACC
+! ###########################################################
+ SUBROUTINE LES_MEAN_1PROC_DEVICE_3DM(PA, OMASK, &
+ PA_MEAN, KAVG_PTS, KUND_PTS )
+! ###########################################################
+!
+!
+!!**** *LES_MEAN_1PROC_DEVICE* computes the average of one field on one processor
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODE_ll
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
+LOGICAL, DIMENSION(:,:), INTENT(IN) :: OMASK
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PA_MEAN
+INTEGER, DIMENSION(:), INTENT(OUT) :: KAVG_PTS
+INTEGER, DIMENSION(:), INTENT(OUT) :: KUND_PTS
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: IIB, IIE, IJB, IJE ! physical domain boundary
+INTEGER :: JI, JJ ! loop counters
+!
+INTEGER :: IK ! number of vertical levels
+INTEGER :: JK ! loop counter
+!-------------------------------------------------------------------------------
+!
+CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
+IK=SIZE(PA,3)
+!
+!$acc data present(PA,OMASK,PA_MEAN,KAVG_PTS,KUND_PTS)
+!
+!$acc kernels
+PA_MEAN = 0.
+KAVG_PTS = 0
+KUND_PTS = 0
+!$acc end kernels
+!
+DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( OMASK(JI,JJ) ) THEN
+ !$acc kernels
+ DO JK=1,IK
+ IF ( PA(JI,JJ,JK)/=XUNDEF ) THEN
+ PA_MEAN(JK) = PA_MEAN(JK) + PA(JI,JJ,JK)
+ KAVG_PTS(JK) = KAVG_PTS(JK) + 1
+ ELSE
+ KUND_PTS(JK) = KUND_PTS(JK) + 1
+ END IF
+ END DO
+ !$acc end kernels
+ END IF
+ END DO
+END DO
+!
+!$acc kernels
+WHERE ( KAVG_PTS(:) > 0 )
+ PA_MEAN(:) = PA_MEAN(:) / KAVG_PTS(:)
+ELSEWHERE
+ PA_MEAN(:) = XUNDEF
+END WHERE
+!$acc end kernels
+!
+!$acc end data !present(PA,OMASK,PA_MEAN,KAVG_PTS,KUND_PTS)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_MEAN_1PROC_DEVICE_3DM
+#endif
diff --git a/src/MNH/les_mean_subgrid.f90 b/src/MNH/les_mean_subgrid.f90
index 24895fdb06e56b851a2297c1c025eb9881da7c3c..5b89123f13e718efd5f501aa27ba115bb5041c88 100644
--- a/src/MNH/les_mean_subgrid.f90
+++ b/src/MNH/les_mean_subgrid.f90
@@ -19,17 +19,18 @@ INTERFACE LES_MEAN_SUBGRID
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PA_MEAN
+!$acc declare present(PA,PA_MEAN)
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
END SUBROUTINE LES_MEAN_SUBGRID_3D
!
-
SUBROUTINE LES_MEAN_SUBGRID_SURF(PA, PA_MEAN, OSUM)
REAL, DIMENSION(:,:), INTENT(IN) :: PA
!
REAL, DIMENSION(:), INTENT(INOUT) :: PA_MEAN
+!$acc declare present(PA,PA_MEAN)
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
@@ -68,6 +69,7 @@ END MODULE MODI_LES_MEAN_SUBGRID
!! Original 07/02/00
!! V. Masson 06/11/02 use of 2D masks
!! C.Lac 10/2014 : Correction on user masks
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
!! --------------------------------------------------------------------------
!
@@ -87,6 +89,7 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PA_MEAN
+!$acc declare present(PA,PA_MEAN)
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
@@ -100,19 +103,30 @@ LOGICAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA_MEAN,1)) :: GMASK
!
INTEGER, DIMENSION(SIZE(PA_MEAN,1)) :: IAVG_PTS
INTEGER, DIMENSION(SIZE(PA_MEAN,1)) :: IUND_PTS
+!$acc declare create(ZA_LES,ZA_MEAN,ZA_MEAN_OLD,GMASK,IAVG_PTS,IUND_PTS)
!
INTEGER :: IMASK ! mask counter
INTEGER :: JI ! loop control
!-------------------------------------------------------------------------------
!
IF (.NOT. LLES_CALL) RETURN
+#ifdef _OPENACC
+PRINT *,'OPENACC: LES_MEAN_SUBGRID_3D_DEVICE not yet tested'
+#endif
+!
!
+!$acc kernels
ZA_MEAN_OLD(:) = 0.
+!$acc end kernels
!-------------------------------------------------------------------------------
!
!* interpolation on LES vertical levels.
!
+#ifndef _OPENACC
CALL LES_VER_INT(PA,ZA_LES)
+#else
+CALL LES_VER_INT_DEVICE(PA,ZA_LES)
+#endif
!
!* subgrid computations on cartesian mask
! --------------------------------------
@@ -121,12 +135,18 @@ IMASK = 1
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, LLES_CURRENT_CART_MASK(:,:,:), ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+CALL LES_MEAN_1PROC_DEVICE(ZA_LES, LLES_CURRENT_CART_MASK(:,:,:), ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
@@ -140,32 +160,48 @@ IF (LLES_NEB_MASK) THEN
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_NEB_MASK (:,:,:) .AND. LLES_CURRENT_CART_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
!* on clear-sky mask
! -----------------
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = (.NOT. LLES_CURRENT_NEB_MASK (:,:,:)) .AND. LLES_CURRENT_CART_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
END IF
!
@@ -181,32 +217,48 @@ IF (LLES_CORE_MASK) THEN
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_CORE_MASK(:,:,:) .AND. LLES_CURRENT_CART_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
!* on NO core mask
! ------------------------
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = (.NOT. LLES_CURRENT_CORE_MASK(:,:,:)) .AND. LLES_CURRENT_CART_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
END IF
!
!-------------------------------------------------------------------------------
@@ -217,42 +269,66 @@ END IF
IF (LLES_CS_MASK) THEN
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_CS1_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_CS2_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
!
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_CS3_MASK(:,:,:)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
END IF
!
!-------------------------------------------------------------------------------
@@ -264,16 +340,24 @@ IF (LLES_MY_MASK) THEN
DO JI=1,NLES_MASKS_USER
IMASK = IMASK + 1
!
+!$acc kernels
GMASK(:,:,:) = LLES_CURRENT_MY_MASKS(:,:,:,JI)
+!$acc end kernels
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+ CALL LES_MEAN_1PROC_DEVICE(ZA_LES, GMASK, ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!$acc kernels
IF (PRESENT(OSUM)) THEN
IF (OSUM) ZA_MEAN_OLD(:) = PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK)
END IF
PA_MEAN(:,NLES_CURRENT_TCOUNT,IMASK) = ZA_MEAN_OLD(:) + ZA_MEAN(:)
+!$acc end kernels
END DO
END IF
!
@@ -281,6 +365,7 @@ END IF
!
END SUBROUTINE LES_MEAN_SUBGRID_3D
!
+!
! ##############################################
SUBROUTINE LES_MEAN_SUBGRID_SURF(PA, PA_MEAN, OSUM)
! ##############################################
@@ -308,6 +393,7 @@ END SUBROUTINE LES_MEAN_SUBGRID_3D
!! MODIFICATIONS
!! -------------
!! Original 07/02/00
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
!! --------------------------------------------------------------------------
!
@@ -326,6 +412,7 @@ IMPLICIT NONE
REAL, DIMENSION(:,:), INTENT(IN) :: PA
!
REAL, DIMENSION(:), INTENT(INOUT) :: PA_MEAN
+!$acc declare present(PA,PA_MEAN)
!
LOGICAL, OPTIONAL, INTENT(IN) :: OSUM
!
@@ -341,10 +428,18 @@ INTEGER :: IUND_PTS
!-------------------------------------------------------------------------------
!
IF (.NOT. LLES_CALL) RETURN
+#ifdef _OPENACC
+PRINT *,'OPENACC: LES_MEAN_SUBGRID_SURF not yet tested'
+#endif
!
ZA_MEAN_OLD = 0.
IF (PRESENT(OSUM)) THEN
+!TODO : verifier que ca se passe bien sur GPU, qu'on va bien chercher la bonne valeur dans le PA_MEAN sur GPU
+! sinon il faudra faire un update self(PA_MEAN(NLES_CURRENT_TCOUNT))
+! !$acc kernels
+!$acc update self(PA_MEAN(NLES_CURRENT_TCOUNT))
IF (OSUM) ZA_MEAN_OLD = PA_MEAN(NLES_CURRENT_TCOUNT)
+! !$acc end kernels
END IF
!-------------------------------------------------------------------------------
!
@@ -353,9 +448,18 @@ END IF
!
!* averaging on the current processor domain of the subgrid variable
!
+#ifndef _OPENACC
CALL LES_MEAN_1PROC(PA, LLES_CURRENT_CART_MASK(:,:,1), ZA_MEAN, IAVG_PTS, IUND_PTS)
+#else
+CALL LES_MEAN_1PROC_DEVICE(PA, LLES_CURRENT_CART_MASK(:,:,1), ZA_MEAN, IAVG_PTS, IUND_PTS)
+#endif
!
+!TODO : verifier que ca se passe bien sur GPU, qu'on va bien chercher la bonne valeur dans le PA_MEAN sur GPU
+! sinon il faudra faire un update device(PA_MEAN(NLES_CURRENT_TCOUNT))
+! !$acc kernels
PA_MEAN(NLES_CURRENT_TCOUNT) = ZA_MEAN_OLD + ZA_MEAN
+!$acc update device(PA_MEAN(NLES_CURRENT_TCOUNT))
+! !$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/les_ver_int.f90 b/src/MNH/les_ver_int.f90
index e4d3cd59d3a2b40d5dc74243cc990d4286c8060b..aa1b2ac0c5198ca2b6383f16c081d8e6443d0910 100644
--- a/src/MNH/les_ver_int.f90
+++ b/src/MNH/les_ver_int.f90
@@ -24,6 +24,21 @@ END SUBROUTINE LES_VER_INT
!
END INTERFACE
!
+#ifdef _OPENACC
+INTERFACE LES_VER_INT_DEVICE
+!
+ SUBROUTINE LES_VER_INT_DEVICE(PA_MNH, PA_LES)
+
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA_MNH
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PA_LES
+!$acc declare present(PA_MNH,PA_LES)
+!
+END SUBROUTINE LES_VER_INT_DEVICE
+!
+END INTERFACE
+#endif
+!
END MODULE MODI_LES_VER_INT
!
! ######################################
@@ -101,3 +116,90 @@ END IF
!-------------------------------------------------------------------------------
!
END SUBROUTINE LES_VER_INT
+!
+#ifdef _OPENACC
+! ######################################
+ SUBROUTINE LES_VER_INT_DEVICE(PA_MNH, PA_LES)
+! ######################################
+!
+!
+!!**** *LES_VER_INT_DEVICE* interpolates a MESONH field
+!! on the LES output levels
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/02/00
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
+!!
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LES
+USE MODD_PARAMETERS
+!
+USE MODE_ll
+!
+USE MODI_VER_INTERP_LIN
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA_MNH
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PA_LES
+!$acc declare present(PA_MNH,PA_LES)
+!
+!
+! 0.2 declaration of local variables
+!
+INTEGER :: JK ! vertical loop counter
+!
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: LES_VER_INT_DEVICE not yet tested'
+IF (CLES_LEVEL_TYPE=='K') THEN
+!$acc kernels present_or_copyin(NLES_LEVELS)
+ DO JK = 1, NLES_K
+ PA_LES(:,:,JK) = PA_MNH(:,:,NLES_LEVELS(JK))
+ END DO
+!$acc end kernels
+ELSE IF (CLES_LEVEL_TYPE=='Z') THEN
+!$acc data present_or_copyin(NKLIN_CURRENT_LES,XCOEFLIN_CURRENT_LES)
+ CALL VER_INTERP_LIN_DEVICE(PA_MNH,NKLIN_CURRENT_LES,XCOEFLIN_CURRENT_LES, PA_LES)
+ !
+!$acc kernels
+ WHERE(NKLIN_CURRENT_LES<2)
+ PA_LES = XUNDEF
+ END WHERE
+!$acc end kernels
+!$acc end data !present_or_copyin(NKLIN_CURRENT_LES,XCOEFLIN_CURRENT_LES)
+ELSE
+ PRINT*, '-------> STOP in LES_VER_INT_DEVICE <----------'
+!callabortstop
+CALL ABORT
+ STOP
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LES_VER_INT_DEVICE
+#endif
diff --git a/src/MNH/mnhget_surf_paramn.f90 b/src/MNH/mnhget_surf_paramn.f90
index f6d5bd927c1e0041bd4115ab3820511aa95ffd08..937bb89f3ef1c1aec697d1f68b0611ce4db30510 100644
--- a/src/MNH/mnhget_surf_paramn.f90
+++ b/src/MNH/mnhget_surf_paramn.f90
@@ -1,3 +1,4 @@
+
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
diff --git a/src/MNH/modd_conf.f90 b/src/MNH/modd_conf.f90
index 24c36a3c17fd89bd25768de92c28e65aa850c77a..0e793ac08e1dfeb38d215b2a84d48be526aea38d 100644
--- a/src/MNH/modd_conf.f90
+++ b/src/MNH/modd_conf.f90
@@ -67,7 +67,7 @@ LOGICAL,SAVE :: LTHINSHELL ! Logical for thinshell approximation
LOGICAL,SAVE :: LCARTESIAN ! Logical for cartesian geometry :
! .TRUE. = cartesian geometry
! .FALSE. = conformal projection
-LOGICAL,SAVE :: L2D ! Logical for 2D model version
+LOGICAL,SAVE :: L2D = .FALSE. ! Logical for 2D model version
! .TRUE. = 2D model version
! .FALSE. = 3D model version
LOGICAL,SAVE :: L1D ! Logical for 1D model version
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 1af0368756c539a2b8aed9f11f38a2b686634de5..5fcd79de0d16cce0196491ae7bd293cac30116db 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -115,8 +115,17 @@ TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
REAL, DIMENSION(:,:,:), POINTER :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), POINTER :: XTHT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTHS=>NULL()
+#else
+REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: XTHT
+!!$acc declare mirror (XTHT)
+!!$acc declare create(XTHT)
+REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: XRTHS
+!!$acc declare mirror (XRTHS)
+!!$acc declare create (XRTHS)
+#endif
REAL, DIMENSION(:,:,:), POINTER :: XRTHS_CLD=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSUPSAT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XNACT=>NULL()
@@ -125,8 +134,17 @@ REAL, DIMENSION(:,:,:), POINTER :: XSSPRO=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKET=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTKES=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL()
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS=>NULL()
+#else
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: XRT
+!!$acc declare mirror (XRT)
+!!$acc declare create (XRT)
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: XRRS
+!!$acc declare mirror (XRRS)
+!!$acc declare create (XRRS)
+#endif
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS_CLD=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XSVT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRSVS=>NULL()
@@ -157,8 +175,10 @@ FIELD_MODEL(KFROM)%XRWS=>XRWS
FIELD_MODEL(KFROM)%XRUS_PRES=>XRUS_PRES
FIELD_MODEL(KFROM)%XRVS_PRES=>XRVS_PRES
FIELD_MODEL(KFROM)%XRWS_PRES=>XRWS_PRES
+#ifndef _OPENACC
FIELD_MODEL(KFROM)%XTHT=>XTHT
FIELD_MODEL(KFROM)%XRTHS=>XRTHS
+#endif
FIELD_MODEL(KFROM)%XRTHS_CLD=>XRTHS_CLD
FIELD_MODEL(KFROM)%XSUPSAT=>XSUPSAT
FIELD_MODEL(KFROM)%XNACT=>XNACT
@@ -167,7 +187,9 @@ FIELD_MODEL(KFROM)%XSSPRO=>XSSPRO
FIELD_MODEL(KFROM)%XTKET=>XTKET
FIELD_MODEL(KFROM)%XRTKES=>XRTKES
FIELD_MODEL(KFROM)%XPABST=>XPABST
+#ifndef _OPENACC
FIELD_MODEL(KFROM)%XRT=>XRT
+#endif
FIELD_MODEL(KFROM)%XRRS=>XRRS
FIELD_MODEL(KFROM)%XRRS_CLD=>XRRS_CLD
FIELD_MODEL(KFROM)%XSVT=>XSVT
@@ -192,8 +214,10 @@ XRWS=>FIELD_MODEL(KTO)%XRWS
XRUS_PRES=>FIELD_MODEL(KTO)%XRUS_PRES
XRVS_PRES=>FIELD_MODEL(KTO)%XRVS_PRES
XRWS_PRES=>FIELD_MODEL(KTO)%XRWS_PRES
+#ifndef _OPENACC
XTHT=>FIELD_MODEL(KTO)%XTHT
XRTHS=>FIELD_MODEL(KTO)%XRTHS
+#endif
XRTHS_CLD=>FIELD_MODEL(KTO)%XRTHS_CLD
XSUPSAT=>FIELD_MODEL(KTO)%XSUPSAT
XNACT=>FIELD_MODEL(KTO)%XNACT
@@ -202,8 +226,10 @@ XNPRO=>FIELD_MODEL(KTO)%XNPRO
XTKET=>FIELD_MODEL(KTO)%XTKET
XRTKES=>FIELD_MODEL(KTO)%XRTKES
XPABST=>FIELD_MODEL(KTO)%XPABST
+#ifndef _OPENACC
XRT=>FIELD_MODEL(KTO)%XRT
XRRS=>FIELD_MODEL(KTO)%XRRS
+#endif
XRRS_CLD=>FIELD_MODEL(KTO)%XRRS_CLD
XSVT=>FIELD_MODEL(KTO)%XSVT
XRSVS=>FIELD_MODEL(KTO)%XRSVS
diff --git a/src/MNH/modd_metricsn.f90 b/src/MNH/modd_metricsn.f90
index 33cec104e0fcc1f51650c617136afecbb7f8edd0..e5450f2298660c88906b12ecc6018d5206be7253 100644
--- a/src/MNH/modd_metricsn.f90
+++ b/src/MNH/modd_metricsn.f90
@@ -51,8 +51,13 @@ END TYPE METRICS_t
TYPE(METRICS_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: METRICS_MODEL
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), POINTER :: XDXX=>NULL(),XDZX=>NULL(), &
XDYY=>NULL(),XDZY=>NULL(),XDZZ=>NULL()
+#else
+REAL, DIMENSION(:,:,:), ALLOCATABLE , TARGET :: XDXX,XDYY,XDZZ,XDZX,XDZY
+!$acc declare create(XDXX,XDYY,XDZZ,XDZX,XDZY)
+#endif
CONTAINS
@@ -67,11 +72,13 @@ METRICS_MODEL(KFROM)%XDZY=>XDZY
METRICS_MODEL(KFROM)%XDZZ=>XDZZ
!
! Current model is set to model KTO
+#ifndef _OPENACC
XDXX=>METRICS_MODEL(KTO)%XDXX
XDZX=>METRICS_MODEL(KTO)%XDZX
XDYY=>METRICS_MODEL(KTO)%XDYY
XDZY=>METRICS_MODEL(KTO)%XDZY
XDZZ=>METRICS_MODEL(KTO)%XDZZ
+#endif
END SUBROUTINE METRICS_GOTO_MODEL
diff --git a/src/MNH/modd_refn.f90 b/src/MNH/modd_refn.f90
index 3f3a72eaeaa6cb2813114325b9add8bb59775c51..438a2201b30b2a4d0974b6aca40352a21958e543 100644
--- a/src/MNH/modd_refn.f90
+++ b/src/MNH/modd_refn.f90
@@ -72,7 +72,12 @@ REAL, DIMENSION(:,:,:), POINTER :: XRHODREF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHVREF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRVREF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XEXNREF=>NULL()
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), POINTER :: XRHODJ=>NULL()
+#else
+REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: XRHODJ
+!$acc declare create (XRHODJ)
+#endif
REAL, POINTER :: XREFMASS=>NULL()
REAL, POINTER :: XMASS_O_PHI0=>NULL()
REAL, POINTER :: XLINMASS=>NULL()
@@ -94,7 +99,9 @@ XRHODREF=>REF_MODEL(KTO)%XRHODREF
XTHVREF=>REF_MODEL(KTO)%XTHVREF
XRVREF=>REF_MODEL(KTO)%XRVREF
XEXNREF=>REF_MODEL(KTO)%XEXNREF
+#ifndef _OPENACC
XRHODJ=>REF_MODEL(KTO)%XRHODJ
+#endif
XREFMASS=>REF_MODEL(KTO)%XREFMASS
XMASS_O_PHI0=>REF_MODEL(KTO)%XMASS_O_PHI0
XLINMASS=>REF_MODEL(KTO)%XLINMASS
diff --git a/src/MNH/mode_mnh_zwork.f90 b/src/MNH/mode_mnh_zwork.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dae0c10dbc0a644bb337bf24988654726520c1a8
--- /dev/null
+++ b/src/MNH/mode_mnh_zwork.f90
@@ -0,0 +1,300 @@
+MODULE MODE_MNH_ZWORK
+
+ IMPLICIT NONE
+
+ INTEGER, SAVE :: IIB,IJB,IKB ! Begining useful area in x,y,z directions
+ INTEGER, SAVE :: IIE,IJE,IKE ! End useful area in x,y,z directions
+
+ !
+ INTEGER,SAVE :: IJS,IJN, IIW,IIA
+ !
+ INTEGER, SAVE :: IIU,IJU,IKU
+ LOGICAL, SAVE :: GWEST , GEAST
+ LOGICAL, SAVE :: GSOUTH , GNORTH
+
+ LOGICAL, SAVE :: GFIRST_CALL_MNH_ALLOC_ZWORK = .TRUE.
+ !
+ REAL, SAVE, ALLOCATABLE , DIMENSION(:,:) :: ZPSRC_HALO2_WEST
+ REAL, SAVE, ALLOCATABLE , DIMENSION(:,:) :: ZPSRC_HALO2_SOUTH
+ !$acc declare mirror(ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
+!PW ne passe pas (PGI15.10/16.1) !$acc declare create(ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
+
+ REAL, SAVE, ALLOCATABLE , DIMENSION(:,:,:) :: ZUNIT3D
+ !$acc declare mirror(ZUNIT3D)
+!PW ne passe pas avec PGI 15.10/16.1 (call to cuStreamSynchronize returned error 700: Illegal address during kernel execution):
+! !$acc declare create(ZUNIT3D)
+
+ INTEGER :: JPMAX_T3D = 35
+ INTEGER , ALLOCATABLE, DIMENSION (:) :: NT3D_POOL
+ INTEGER :: NT3D_TOP , NT3D_TOP_MAX = 0
+ !REAL , ALLOCATABLE, DIMENSION(:,:,:,:) , TARGET :: ZT3D_A1,ZT3D_A2,ZT3D_A3,ZT3D_A4
+ !REAL , POINTER , DIMENSION(:,:,:,:) :: ZT3D
+ REAL,SAVE , ALLOCATABLE, DIMENSION(:,:,:,:) :: ZT3D
+ ! acc declare create(ZT3D_A1,ZT3D_A2,ZT3D_A3,ZT3D_A4)
+ !$acc declare mirror(ZT3D)
+!PW ne passe pas !$acc declare create(ZT3D)
+
+ TYPE TMODEL
+ REAL , POINTER, DIMENSION(:,:,:,:) :: X
+ END TYPE TMODEL
+
+ TYPE(TMODEL) , DIMENSION(10) :: MODEL
+
+CONTAINS
+
+ SUBROUTINE MNH_ALLOC_ZWORK(IMODEL)
+
+ USE MODE_TOOLS_ll, ONLY : LWEST_ll,LEAST_ll, LSOUTH_ll, LNORTH_ll
+
+ USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
+ USE MODD_DIM_n, ONLY : NKMAX
+
+ IMPLICIT NONE
+
+ INTEGER :: IMODEL
+
+ INTEGER :: JI
+
+ IF (GFIRST_CALL_MNH_ALLOC_ZWORK) THEN
+ GFIRST_CALL_MNH_ALLOC_ZWORK = .FALSE.
+ !
+ ! Array dim
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=NKMAX + 2* JPVEXT
+ !
+ ! Computation bound
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IJS=IJB
+ IJN=IJE
+ IIW=IIB
+ IIA=IIE
+ IKB = 1 + JPVEXT
+ IKE = NKMAX + JPVEXT
+ !
+ ! Lateral boundary
+ !
+ GWEST = LWEST_ll()
+ GEAST = LEAST_ll()
+
+ GSOUTH=LSOUTH_ll()
+ GNORTH=LNORTH_ll()
+
+ !
+ ! Work array
+ !
+ ALLOCATE (ZPSRC_HALO2_WEST(IJU,IKU))
+ ALLOCATE (ZPSRC_HALO2_SOUTH(IIU,IKU))
+ ! acc enter data create(ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
+
+ ALLOCATE (ZUNIT3D(IIU,IJU,IKU))
+ ! acc enter data create(ZUNIT3D)
+
+ !ALLOCATE (ZT3D_A1(IIU,IJU,IKU,JPMAX_T3D))
+ !MODEL(1)%X => ZT3D_A1
+ !ZT3D => MODEL(1)%X
+ ALLOCATE (ZT3D(IIU,IJU,IKU,JPMAX_T3D))
+ ! acc enter data create(ZT3D)
+
+ ALLOCATE (NT3D_POOL(JPMAX_T3D))
+ NT3D_TOP = 0
+ DO JI = 1, JPMAX_T3D
+ NT3D_POOL(JI) = JI
+ END DO
+
+ !$acc kernels
+
+ ZPSRC_HALO2_WEST = XUNDEF
+ ZPSRC_HALO2_SOUTH = XUNDEF
+
+ ZUNIT3D = 1.0
+
+ ZT3D = XUNDEF
+
+ !$acc end kernels
+
+ !$acc update host (ZPSRC_HALO2_WEST,ZPSRC_HALO2_SOUTH)
+ !$acc update host (ZUNIT3D)
+ !$acc update host (ZT3D)
+
+ END IF
+
+ END SUBROUTINE MNH_ALLOC_ZWORK
+
+ SUBROUTINE MNH_GET_ZT3D_N0(KTEMP)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP
+
+ IF (NT3D_TOP == JPMAX_T3D ) THEN
+ print*," MNH_GET_ZT3D JPMAX_T3D OVER FLOW=", JPMAX_T3D
+ call ABORT()
+ ELSE
+ NT3D_TOP = NT3D_TOP + 1
+ KTEMP = NT3D_POOL(NT3D_TOP)
+ IF ( NT3D_POOL(NT3D_TOP) == -1 ) THEN
+ PRINT *,'MNH_GET_ZT3D_N0 ERROR: slice already reserved'
+ STOP
+ END IF
+ NT3D_POOL(NT3D_TOP) = -1
+ IF ( NT3D_TOP > NT3D_TOP_MAX ) THEN
+ NT3D_TOP_MAX = NT3D_TOP
+ WRITE( *, '( " MNH_GET_ZT3D: NT3D_TOP_MAX=",I4," KTEMP=",I4 )' ) NT3D_TOP_MAX,KTEMP
+ END IF
+ ENDIF
+ !WRITE( *, '( "MNH_GET_ZT3D: reserving ZT3D (",I4,")" )' ) KTEMP
+
+ END SUBROUTINE MNH_GET_ZT3D_N0
+
+ SUBROUTINE MNH_GET_ZT3D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9, &
+ KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP1
+ INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9
+ INTEGER,OPTIONAL :: KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18
+
+ CALL MNH_GET_ZT3D_N0(KTEMP1)
+ IF (PRESENT(KTEMP2)) CALL MNH_GET_ZT3D_N0(KTEMP2)
+ IF (PRESENT(KTEMP3)) CALL MNH_GET_ZT3D_N0(KTEMP3)
+ IF (PRESENT(KTEMP4)) CALL MNH_GET_ZT3D_N0(KTEMP4)
+ IF (PRESENT(KTEMP5)) CALL MNH_GET_ZT3D_N0(KTEMP5)
+ IF (PRESENT(KTEMP6)) CALL MNH_GET_ZT3D_N0(KTEMP6)
+ IF (PRESENT(KTEMP7)) CALL MNH_GET_ZT3D_N0(KTEMP7)
+ IF (PRESENT(KTEMP8)) CALL MNH_GET_ZT3D_N0(KTEMP8)
+ IF (PRESENT(KTEMP9)) CALL MNH_GET_ZT3D_N0(KTEMP9)
+ IF (PRESENT(KTEMP10)) CALL MNH_GET_ZT3D_N0(KTEMP10)
+ IF (PRESENT(KTEMP11)) CALL MNH_GET_ZT3D_N0(KTEMP11)
+ IF (PRESENT(KTEMP12)) CALL MNH_GET_ZT3D_N0(KTEMP12)
+ IF (PRESENT(KTEMP13)) CALL MNH_GET_ZT3D_N0(KTEMP13)
+ IF (PRESENT(KTEMP14)) CALL MNH_GET_ZT3D_N0(KTEMP14)
+ IF (PRESENT(KTEMP15)) CALL MNH_GET_ZT3D_N0(KTEMP15)
+ IF (PRESENT(KTEMP16)) CALL MNH_GET_ZT3D_N0(KTEMP16)
+ IF (PRESENT(KTEMP17)) CALL MNH_GET_ZT3D_N0(KTEMP17)
+ IF (PRESENT(KTEMP18)) CALL MNH_GET_ZT3D_N0(KTEMP18)
+
+
+ END SUBROUTINE MNH_GET_ZT3D
+
+ SUBROUTINE MNH_GET_ZT4D(KSIZE,KBEG,KEND)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: KSIZE
+ INTEGER, INTENT(OUT) :: KBEG, KEND
+
+ INTEGER :: JI
+
+ IF (NT3D_TOP + KSIZE > JPMAX_T3D ) THEN
+ print *," MNH_GET_ZT4D JPMAX_T3D OVER FLOW=", JPMAX_T3D
+ call ABORT()
+ ELSE
+ KBEG = NT3D_TOP + 1
+ KEND = NT3D_TOP + KSIZE
+ NT3D_TOP = NT3D_TOP + KSIZE
+ DO JI = KBEG, KEND
+ IF (NT3D_POOL(JI) == -1) THEN
+ print *," MNH_GET_ZT4D ERROR: trying to use area already reserved"
+ call ABORT()
+ END IF
+ NT3D_POOL(JI) = -1
+ END DO
+ IF ( NT3D_TOP > NT3D_TOP_MAX ) THEN
+ NT3D_TOP_MAX = NT3D_TOP
+ WRITE( *, '( " MNH_GET_ZT4D: NT3D_TOP_MAX=",I4," KBEG=",I4," KEND=",I4 )' ) NT3D_TOP_MAX,KBEG,KEND
+ END IF
+ ENDIF
+ !WRITE( *, '( "MNH_GET_ZT4D: reserving ZT3D (",I4,I4,")" )' ) KBEG,KEND
+
+ END SUBROUTINE MNH_GET_ZT4D
+
+ SUBROUTINE MNH_REL_ZT3D_N0(KTEMP)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP
+
+ IF ( ( NT3D_TOP > JPMAX_T3D ) .OR. ( NT3D_TOP < 1 ) ) THEN
+ print*," MNH_REL_ZT3D NT3D_TOP OVER FLOW NT3D_TOP=", NT3D_TOP
+ call ABORT()
+ ELSE
+ NT3D_POOL(KTEMP) = KTEMP
+ IF (KTEMP == NT3D_TOP) THEN
+ NT3D_TOP = NT3D_TOP - 1
+ DO WHILE (NT3D_TOP > 0 .AND. NT3D_POOL(NT3D_TOP) /= -1 )
+ NT3D_TOP = NT3D_TOP - 1
+ END DO
+ END IF
+ ENDIF
+ !WRITE( *, '( "MNH_REL_ZT3D: releasing ZT3D (",I4,")" )' ) KTEMP
+
+ END SUBROUTINE MNH_REL_ZT3D_N0
+
+ SUBROUTINE MNH_REL_ZT3D(KTEMP1,KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9, &
+ KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18)
+
+ IMPLICIT NONE
+
+ INTEGER :: KTEMP1
+ INTEGER,OPTIONAL :: KTEMP2,KTEMP3,KTEMP4,KTEMP5,KTEMP6,KTEMP7,KTEMP8,KTEMP9
+ INTEGER,OPTIONAL :: KTEMP10,KTEMP11,KTEMP12,KTEMP13,KTEMP14,KTEMP15,KTEMP16,KTEMP17,KTEMP18
+
+ CALL MNH_REL_ZT3D_N0(KTEMP1)
+ IF (PRESENT(KTEMP2)) CALL MNH_REL_ZT3D_N0(KTEMP2)
+ IF (PRESENT(KTEMP3)) CALL MNH_REL_ZT3D_N0(KTEMP3)
+ IF (PRESENT(KTEMP4)) CALL MNH_REL_ZT3D_N0(KTEMP4)
+ IF (PRESENT(KTEMP5)) CALL MNH_REL_ZT3D_N0(KTEMP5)
+ IF (PRESENT(KTEMP6)) CALL MNH_REL_ZT3D_N0(KTEMP6)
+ IF (PRESENT(KTEMP7)) CALL MNH_REL_ZT3D_N0(KTEMP7)
+ IF (PRESENT(KTEMP8)) CALL MNH_REL_ZT3D_N0(KTEMP8)
+ IF (PRESENT(KTEMP9)) CALL MNH_REL_ZT3D_N0(KTEMP9)
+ IF (PRESENT(KTEMP10)) CALL MNH_REL_ZT3D_N0(KTEMP10)
+ IF (PRESENT(KTEMP11)) CALL MNH_REL_ZT3D_N0(KTEMP11)
+ IF (PRESENT(KTEMP12)) CALL MNH_REL_ZT3D_N0(KTEMP12)
+ IF (PRESENT(KTEMP13)) CALL MNH_REL_ZT3D_N0(KTEMP13)
+ IF (PRESENT(KTEMP14)) CALL MNH_REL_ZT3D_N0(KTEMP14)
+ IF (PRESENT(KTEMP15)) CALL MNH_REL_ZT3D_N0(KTEMP15)
+ IF (PRESENT(KTEMP16)) CALL MNH_REL_ZT3D_N0(KTEMP16)
+ IF (PRESENT(KTEMP17)) CALL MNH_REL_ZT3D_N0(KTEMP17)
+ IF (PRESENT(KTEMP18)) CALL MNH_REL_ZT3D_N0(KTEMP18)
+
+ END SUBROUTINE MNH_REL_ZT3D
+
+ SUBROUTINE MNH_REL_ZT4D(KSIZE,KBEG)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: KSIZE
+ INTEGER, INTENT(IN) :: KBEG
+
+ INTEGER :: JI
+
+ IF ( KBEG + KSIZE -1 /= NT3D_TOP ) THEN
+!PW TODO: implement holes management
+ WRITE(*,'("MNH_REL_ZT4D ERROR: trying to free area (",I4,I4,") not at the end of range (",I4,")")' ) &
+ KBEG,KBEG+KSIZE-1,NT3D_TOP
+ call ABORT()
+ END IF
+ IF ( ( KBEG + KSIZE > JPMAX_T3D ) .OR. ( KBEG < 1 ) ) THEN
+ print *," MNH_REL_ZT4D ERROR: out of range"
+ call ABORT()
+ END IF
+
+ DO JI = KBEG, KBEG+KSIZE-1
+ IF (NT3D_POOL(JI) /= -1) THEN
+ print *," MNH_REL_ZT4D ERROR: trying to free area not reserved"
+ call ABORT()
+ END IF
+ NT3D_POOL(JI) = JI
+ END DO
+ NT3D_TOP = NT3D_TOP - KSIZE
+ !WRITE( *, '( "MNH_REL_ZT4D: releasing ZT3D (",I4,I4,")" )' ) KBEG,KBEG+KSIZE-1
+
+ END SUBROUTINE MNH_REL_ZT4D
+
+
+
+END MODULE MODE_MNH_ZWORK
diff --git a/src/MNH/mode_prandtl.f90 b/src/MNH/mode_prandtl.f90
index 2215306e4cffe5e1f4f79323983001ebf4fe112f..d46e5218dee51eeba8c8a57c43171982c644728c 100644
--- a/src/MNH/mode_prandtl.f90
+++ b/src/MNH/mode_prandtl.f90
@@ -31,6 +31,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PF_LIM ! Value of F when Phi3 is
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PF ! function F to smooth
!
REAL, DIMENSION(SIZE(PF,1),SIZE(PF,2),SIZE(PF,3)) :: ZCOEF
+!$acc declare present(PPHI3,PF_LIM,PF) create(ZCOEF)
!
!* adds a artificial correction to smooth the function near the discontinuity
! point at Phi3 = Phi_lim
@@ -38,14 +39,20 @@ REAL, DIMENSION(SIZE(PF,1),SIZE(PF,2),SIZE(PF,3)) :: ZCOEF
! Note that in the Boundary layer, phi is usually between 0.8 and 1
!
!
+!$acc kernels
ZCOEF = MAX(MIN(( 10.*(1.-PPHI3/XPHI_LIM)) ,1.), 0.)
!
PF(:,:,:) = ZCOEF(:,:,:) * PF &
+ (1.-ZCOEF(:,:,:)) * PF_LIM
+!$acc end kernels
!
END SUBROUTINE SMOOTH_TURB_FUNCT
!----------------------------------------------------------------------------
-FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+#ifndef _OPENACC
+FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PPHI3)
+#else
+SUBROUTINE PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PPHI3)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
@@ -53,14 +60,22 @@ FUNCTION PHI3(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PHI3
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PPHI3
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PPHI3
+#endif
+!$acc declare present(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,PPHI3)
!
REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: ZW1, ZW2
+ LOGICAL,DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PHI3LOGIC
+!$acc declare create(ZW1,ZW2,PHI3LOGIC)
INTEGER :: IKB, IKE
!
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
+!$acc kernels
IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
@@ -68,10 +83,8 @@ IF (HTURBDIM=='3DIM') THEN
( 0.5 * (PREDTH1(:,:,:)**2+PREDR1(:,:,:)**2) &
+ PREDTH1(:,:,:) * PREDR1(:,:,:) &
)
-
ZW2(:,:,:) = 0.5 * (PRED2TH3(:,:,:)-PRED2R3(:,:,:))
-
- PHI3(:,:,:)= 1. - &
+ PPHI3(:,:,:)= 1. - &
( ( (1.+PREDR1(:,:,:)) * &
(PRED2THR3(:,:,:) + PRED2TH3(:,:,:)) / PREDTH1(:,:,:) &
) + ZW2(:,:,:) &
@@ -79,31 +92,43 @@ IF (HTURBDIM=='3DIM') THEN
ELSE
ZW1(:,:,:) = 1. + 1.5* PREDTH1(:,:,:) + &
0.5* PREDTH1(:,:,:)**2
-
ZW2(:,:,:) = 0.5* PRED2TH3(:,:,:)
-
- PHI3(:,:,:)= 1. - &
+ PPHI3(:,:,:)= 1. - &
(PRED2TH3(:,:,:) / PREDTH1(:,:,:) + ZW2(:,:,:)) / ZW1(:,:,:)
END IF
- WHERE( PHI3 <= 0. .OR. PHI3 > XPHI_LIM )
- PHI3 = XPHI_LIM
+!
+!WARNING: BUG PGI (tested up to PGI 16.09): necessary to use a logical mask
+!because the compiler does not manage correctly the .OR. in the WHERE
+ !WHERE( PPHI3 <= 0. .OR. PPHI3 > XPHI_LIM )
+ PHI3LOGIC = (PPHI3 <= 0. .OR. PPHI3 > XPHI_LIM)
+ WHERE( PHI3LOGIC )
+ PPHI3 = XPHI_LIM
END WHERE
ELSE
!* 1DIM case
IF (OUSERV) THEN
- PHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:)+PREDR1(:,:,:))
+ PPHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:)+PREDR1(:,:,:))
ELSE
- PHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:))
+ PPHI3(:,:,:)= 1./(1.+PREDTH1(:,:,:))
END IF
END IF
!
-PHI3(:,:,IKB-1)=PHI3(:,:,IKB)
-PHI3(:,:,IKE+1)=PHI3(:,:,IKE)
+PPHI3(:,:,IKB-1)=PPHI3(:,:,IKB)
+PPHI3(:,:,IKE+1)=PPHI3(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION PHI3
-!----------------------------------------------------------------------------
-FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
+#else
+END SUBROUTINE PHI3
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3) RESULT(PPSI_SV)
+#else
+SUBROUTINE PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3,PPSI_SV)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PREDS1
@@ -111,34 +136,55 @@ FUNCTION PSI_SV(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRED2RS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
- REAL, DIMENSION(SIZE(PRED2THS,1),SIZE(PRED2THS,2),SIZE(PRED2THS,3),SIZE(PRED2THS,4)) :: PSI_SV
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PRED2THS,1),SIZE(PRED2THS,2),SIZE(PRED2THS,3),SIZE(PRED2THS,4)) :: PPSI_SV
+#else
+ REAL, DIMENSION(SIZE(PRED2THS,1),SIZE(PRED2THS,2),SIZE(PRED2THS,3),SIZE(PRED2THS,4)), INTENT(OUT) :: PPSI_SV
+#endif
+!$acc declare present(PREDTH1,PREDR1,PREDS1,PRED2THS,PRED2RS,PPHI3,PPSI3,PPSI_SV)
+!
+ LOGICAL, DIMENSION(SIZE(PRED2THS,1),SIZE(PRED2THS,2),SIZE(PRED2THS,3)) :: PSILOGIC
+!$acc declare create(PSILOGIC)
INTEGER :: IKB, IKE
INTEGER :: JSV
!
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
-DO JSV=1,SIZE(PSI_SV,4)
- PSI_SV(:,:,:,JSV) = ( 1. &
+!$acc kernels
+DO JSV=1,SIZE(PPSI_SV,4)
+ PPSI_SV(:,:,:,JSV) = ( 1. &
- (XCPR3+XCPR5) * (PRED2THS(:,:,:,JSV)/PREDS1(:,:,:,JSV)-PREDTH1) &
- (XCPR4+XCPR5) * (PRED2RS (:,:,:,JSV)/PREDS1(:,:,:,JSV)-PREDR1 ) &
- XCPR3 * PREDTH1 * PPHI3 - XCPR4 * PREDR1 * PPSI3 &
) / ( 1. + XCPR5 * ( PREDTH1 + PREDR1 ) )
-! control of the PSI_SV positivity
- WHERE ( (PSI_SV(:,:,:,JSV) <=0.).AND. (PREDTH1+PREDR1) <= 0. )
- PSI_SV(:,:,:,JSV)=XPHI_LIM
+! control of the PPSI_SV positivity
+!WARNING: BUG PGI (tested up to PGI 16.09): necessary to use a logical mask
+!because the compiler does not manage correctly the .AND. in the WHERE
+ !WHERE ( (PPSI_SV(:,:,:,JSV) <=0.).AND. (PREDTH1+PREDR1) <= 0. )
+ PSILOGIC = ((PPSI_SV(:,:,:,JSV) <=0.).AND. (PREDTH1+PREDR1) <= 0. )
+ WHERE ( PSILOGIC )
+ PPSI_SV(:,:,:,JSV)=XPHI_LIM
END WHERE
- PSI_SV(:,:,:,JSV) = MAX( 1.E-4, MIN(XPHI_LIM,PSI_SV(:,:,:,JSV)) )
+ PPSI_SV(:,:,:,JSV) = MAX( 1.E-4, MIN(XPHI_LIM,PPSI_SV(:,:,:,JSV)) )
!
- PSI_SV(:,:,IKB-1,JSV)=PSI_SV(:,:,IKB,JSV)
- PSI_SV(:,:,IKE+1,JSV)=PSI_SV(:,:,IKE,JSV)
+ PPSI_SV(:,:,IKB-1,JSV)=PPSI_SV(:,:,IKB,JSV)
+ PPSI_SV(:,:,IKE+1,JSV)=PPSI_SV(:,:,IKE,JSV)
END DO
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION PSI_SV
-!----------------------------------------------------------------------------
-FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE PSI_SV
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PD_PHI3DTDZ_O_DDTDZ)
+#else
+SUBROUTINE D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DTDZ_O_DDTDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
@@ -146,17 +192,23 @@ FUNCTION D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PHI3DTDZ_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PD_PHI3DTDZ_O_DDTDZ
+#endif
+!$acc declare present(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PD_PHI3DTDZ_O_DDTDZ)
INTEGER :: IKB, IKE,JL,JK,JJ
!
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
+!$acc kernels
IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
* (1. - PREDTH1(:,:,:) * (3./2.+PREDTH1+PREDR1) &
/((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+ (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
@@ -164,53 +216,64 @@ IF (HTURBDIM=='3DIM') THEN
- (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
/ ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
ELSEWHERE
- D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+ PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
ENDWHERE
!
ELSE
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
* (1. - PREDTH1(:,:,:) * (3./2.+PREDTH1) &
/((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
+ PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
- 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
ELSEWHERE
- D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+ PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
ENDWHERE
!
END IF
ELSE
!* 1DIM case
! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
-! D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
! * (1. - PREDTH1(:,:,:)*PPHI3(:,:,:))
! ELSEWHERE
-! D_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
+! PD_PHI3DTDZ_O_DDTDZ(:,:,:) = PPHI3(:,:,:)
! ENDWHERE
DO JJ=1,SIZE(PPHI3,2)
DO JL=1,SIZE(PPHI3,1)
DO JK=1,SIZE(PPHI3,3)
IF ( ABS(PPHI3(JL,JJ,JK)-XPHI_LIM) < 1.E-12 ) THEN
- D_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)*&
+ PD_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)*&
& (1. - PREDTH1(JL,JJ,JK)*PPHI3(JL,JJ,JK))
ELSE
- D_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)
+ PD_PHI3DTDZ_O_DDTDZ(JL,JJ,JK)=PPHI3(JL,JJ,JK)
ENDIF
ENDDO
ENDDO
ENDDO
END IF
+!$acc end kernels
!
!* smoothing
-CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DTDZ_O_DDTDZ)
+CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,PD_PHI3DTDZ_O_DDTDZ)
!
-D_PHI3DTDZ_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKB)
-D_PHI3DTDZ_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ_O_DDTDZ(:,:,IKE)
+!$acc kernels
+PD_PHI3DTDZ_O_DDTDZ(:,:,IKB-1)=PD_PHI3DTDZ_O_DDTDZ(:,:,IKB)
+PD_PHI3DTDZ_O_DDTDZ(:,:,IKE+1)=PD_PHI3DTDZ_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_PHI3DTDZ_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE D_PHI3DTDZ_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PD_PHI3DRDZ_O_DDRDZ)
+#else
+SUBROUTINE D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PD_PHI3DRDZ_O_DDRDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
@@ -218,18 +281,24 @@ FUNCTION D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DRDZ_O_DDRDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PHI3DRDZ_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PD_PHI3DRDZ_O_DDRDZ
+#endif
+!$acc declare present(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PD_PHI3DRDZ_O_DDRDZ)
INTEGER :: IKB, IKE
!
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
!
+!$acc kernels
IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DRDZ_O_DDRDZ(:,:,:) = &
+ PD_PHI3DRDZ_O_DDRDZ(:,:,:) = &
PPHI3(:,:,:) * (1.-PREDR1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
/ ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
- PREDR1(:,:,:) * (PRED2THR3+PRED2TH3) / (PREDTH1 &
@@ -237,30 +306,41 @@ IF (HTURBDIM=='3DIM') THEN
+ PREDR1(:,:,:) * (1./2.+PREDTH1+PREDR1) &
/ ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
ELSEWHERE
- D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ PD_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
END WHERE
ELSE
- D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ PD_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
END IF
ELSE
!* 1DIM case
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:) &
+ PD_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:) &
* (1. - PREDR1(:,:,:)*PPHI3(:,:,:))
ELSEWHERE
- D_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
+ PD_PHI3DRDZ_O_DDRDZ(:,:,:) = PPHI3(:,:,:)
END WHERE
END IF
+!$acc end kernels
!
!* smoothing
-CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,D_PHI3DRDZ_O_DDRDZ)
+CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3,PD_PHI3DRDZ_O_DDRDZ)
!
-D_PHI3DRDZ_O_DDRDZ(:,:,IKB-1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKB)
-D_PHI3DRDZ_O_DDRDZ(:,:,IKE+1)=D_PHI3DRDZ_O_DDRDZ(:,:,IKE)
+!$acc kernels
+PD_PHI3DRDZ_O_DDRDZ(:,:,IKB-1)=PD_PHI3DRDZ_O_DDRDZ(:,:,IKB)
+PD_PHI3DRDZ_O_DDRDZ(:,:,IKE+1)=PD_PHI3DRDZ_O_DDRDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_PHI3DRDZ_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE D_PHI3DRDZ_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV) RESULT(PD_PHI3DTDZ2_O_DDTDZ)
+#else
+SUBROUTINE D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURBDIM,OUSERV,PD_PHI3DTDZ2_O_DDTDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPHI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
@@ -269,18 +349,26 @@ FUNCTION D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,HTURB
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PHI3DTDZ2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PHI3DTDZ2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)),INTENT(OUT) :: PD_PHI3DTDZ2_O_DDTDZ
+#endif
+!$acc declare present(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTDZ,PD_PHI3DTDZ2_O_DDTDZ)
INTEGER :: IKB, IKE
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
!
IKB = 1+JPVEXT_TURB
IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
!
+!$acc kernels
IF (HTURBDIM=='3DIM') THEN
!* 3DIM case
IF (OUSERV) THEN
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
* PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
/((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+ (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
@@ -288,82 +376,130 @@ IF (HTURBDIM=='3DIM') THEN
- (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
/ ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
ELSEWHERE
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
ENDWHERE
!
ELSE
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
* PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1) &
/((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
+ PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
- 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
ELSEWHERE
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
ENDWHERE
END IF
ELSE
!* 1DIM case
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:)*PDTDZ(:,:,:) &
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:)*PDTDZ(:,:,:) &
* (2. - PREDTH1(:,:,:)*PPHI3(:,:,:))
ELSEWHERE
- D_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
END WHERE
END IF
!
!* smoothing
-CALL SMOOTH_TURB_FUNCT(PPHI3,PPHI3*2.*PDTDZ,D_PHI3DTDZ2_O_DDTDZ)
+ZTMP1_DEVICE = PPHI3*2.*PDTDZ
+!$acc end kernels
+CALL SMOOTH_TURB_FUNCT(PPHI3,ZTMP1_DEVICE,PD_PHI3DTDZ2_O_DDTDZ)
!
!
-D_PHI3DTDZ2_O_DDTDZ(:,:,IKB-1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKB)
-D_PHI3DTDZ2_O_DDTDZ(:,:,IKE+1)=D_PHI3DTDZ2_O_DDTDZ(:,:,IKE)
+!$acc kernels
+PD_PHI3DTDZ2_O_DDTDZ(:,:,IKB-1)=PD_PHI3DTDZ2_O_DDTDZ(:,:,IKB)
+PD_PHI3DTDZ2_O_DDTDZ(:,:,IKE+1)=PD_PHI3DTDZ2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_PHI3DTDZ2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE D_PHI3DTDZ2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA) RESULT(PM3_WTH_WTH2)
+#else
+SUBROUTINE M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WTH2
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WTH_WTH2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_WTH_WTH2
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PM3_WTH_WTH2)
INTEGER :: IKB, IKE
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WTH_WTH2 not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_WTH2(:,:,:) = XCSHF*PBLL_O_E*PETHETA*0.5/XCTD &
+!$acc kernels
+PM3_WTH_WTH2(:,:,:) = XCSHF*PBLL_O_E*PETHETA*0.5/XCTD &
* (1.+0.5*PREDTH1+PREDR1) / PD
-M3_WTH_WTH2(:,:,IKB-1)=M3_WTH_WTH2(:,:,IKB)
-M3_WTH_WTH2(:,:,IKE+1)=M3_WTH_WTH2(:,:,IKE)
+PM3_WTH_WTH2(:,:,IKB-1)=PM3_WTH_WTH2(:,:,IKB)
+PM3_WTH_WTH2(:,:,IKE+1)=PM3_WTH_WTH2(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION M3_WTH_WTH2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE M3_WTH_WTH2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA) RESULT(PD_M3_WTH_WTH2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTH2_O_DDTDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WTH_WTH2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTH2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WTH_WTH2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_WTH_WTH2_O_DDTDZ
+#endif
+!$acc declare present(PM3_WTH_WTH2,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTH2_O_DDTDZ)
INTEGER :: IKB, IKE
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WTH_WTH2_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_WTH2_O_DDTDZ(:,:,:) = ( 0.5*XCSHF*PBLL_O_E*PETHETA*0.5/XCTD/PD &
+!$acc kernels
+PD_M3_WTH_WTH2_O_DDTDZ(:,:,:) = ( 0.5*XCSHF*PBLL_O_E*PETHETA*0.5/XCTD/PD &
- PM3_WTH_WTH2/PD*(1.5+PREDTH1+PREDR1) )&
* PBLL_O_E * PETHETA * XCTV
!
-D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKB)
-D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
+PD_M3_WTH_WTH2_O_DDTDZ(:,:,IKB-1)=PD_M3_WTH_WTH2_O_DDTDZ(:,:,IKB)
+PD_M3_WTH_WTH2_O_DDTDZ(:,:,IKE+1)=PD_M3_WTH_WTH2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_WTH_WTH2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
+#else
+END SUBROUTINE D_M3_WTH_WTH2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE) RESULT(PM3_WTH_W2TH)
+#else
+SUBROUTINE M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -372,21 +508,49 @@ FUNCTION M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2TH
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WTH_W2TH
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_WTH_W2TH
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PKEFF,PTKE,PM3_WTH_W2TH)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WTH_W2TH not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(KKA,KKU,KKL,PTKE) &
+#ifndef _OPENACC
+PM3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/MZM(KKA,KKU,KKL,PTKE) &
+ * (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
+#else
+CALL MZM_DEVICE(PTKE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_WTH_W2TH(:,:,:) = XCSHF*PKEFF*1.5/ZTMP1_DEVICE &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD ) / (1.+PREDTH1)
+#endif
!
-M3_WTH_W2TH(:,:,IKB-1)=M3_WTH_W2TH(:,:,IKB)
-M3_WTH_W2TH(:,:,IKE+1)=M3_WTH_W2TH(:,:,IKE)
+PM3_WTH_W2TH(:,:,IKB-1)=PM3_WTH_W2TH(:,:,IKB)
+PM3_WTH_W2TH(:,:,IKE+1)=PM3_WTH_W2TH(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION M3_WTH_W2TH
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE)
+#else
+END SUBROUTINE M3_WTH_W2TH
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE) RESULT(PD_M3_WTH_W2TH_O_DDTDZ)
+#else
+SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE,PD_M3_WTH_W2TH_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -397,22 +561,51 @@ FUNCTION D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PK
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2TH_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WTH_W2TH_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_WTH_W2TH_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PKEFF,PTKE,PD_M3_WTH_W2TH_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WTH_W2TH_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
+#ifndef _OPENACC
+PD_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
- XCSHF*PKEFF*1.5/MZM(KKA,KKU,KKL,PTKE)/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
* (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
+#else
+CALL MZM_DEVICE(PTKE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_WTH_W2TH_O_DDTDZ(:,:,:) = &
+ - XCSHF*PKEFF*1.5/ZTMP1_DEVICE/(1.+PREDTH1)**2*XCTV*PBLL_O_E*PETHETA &
+ * (1. - 0.5*PREDR1*(1.+PREDR1)/PD*( 1.+(1.+PREDTH1)*(1.5+PREDR1+PREDTH1)/PD) )
+#endif
!
-D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
-D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
+PD_M3_WTH_W2TH_O_DDTDZ(:,:,IKB-1)=PD_M3_WTH_W2TH_O_DDTDZ(:,:,IKB)
+PD_M3_WTH_W2TH_O_DDTDZ(:,:,IKE+1)=PD_M3_WTH_W2TH_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_WTH_W2TH_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_WTH_W2TH_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PM3_WTH_W2R)
+#else
+SUBROUTINE M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -424,20 +617,47 @@ FUNCTION M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_W2R
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WTH_W2R
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_WTH_W2R
+#endif
+!$acc declare present(PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_WTH_W2R)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WTH_W2R not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST*PDTDZ/PD
-!
-M3_WTH_W2R(:,:,IKB-1)=M3_WTH_W2R(:,:,IKB)
-M3_WTH_W2R(:,:,IKE+1)=M3_WTH_W2R(:,:,IKE)
-!
+#ifndef _OPENACC
+PM3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST*PDTDZ/PD
+#else
+CALL MZM_DEVICE(PTKE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_WTH_W2R(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/ZTMP1_DEVICE*PEMOIST*PDTDZ/PD
+#endif
+!
+PM3_WTH_W2R(:,:,IKB-1)=PM3_WTH_W2R(:,:,IKB)
+PM3_WTH_W2R(:,:,IKE+1)=PM3_WTH_W2R(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_WTH_W2R
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE M3_WTH_W2R
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST) RESULT(PD_M3_WTH_W2R_O_DDTDZ)
+#else
+SUBROUTINE D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD_M3_WTH_W2R_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -448,21 +668,49 @@ FUNCTION D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_W2R_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WTH_W2R_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_WTH_W2R_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PKEFF,PTKE,PBLL_O_E,PEMOIST,PD_M3_WTH_W2R_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WTH_W2R_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST/PD &
+#ifndef _OPENACC
+PD_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/MZM(KKA,KKU,KKL,PTKE)*PEMOIST/PD &
+ * (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+#else
+CALL MZM_DEVICE(PTKE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_WTH_W2R_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.75*XCTV*PBLL_O_E/ZTMP1_DEVICE*PEMOIST/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+#endif
!
-D_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
-D_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
+PD_M3_WTH_W2R_O_DDTDZ(:,:,IKB-1)=PD_M3_WTH_W2R_O_DDTDZ(:,:,IKB)
+PD_M3_WTH_W2R_O_DDTDZ(:,:,IKE+1)=PD_M3_WTH_W2R_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_WTH_W2R_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_WTH_W2R_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ) RESULT(PM3_WTH_WR2)
+#else
+SUBROUTINE M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ,PM3_WTH_WR2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -477,21 +725,52 @@ FUNCTION M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WTH_WR2
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WTH_WR2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_WTH_WR2
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTDZ,PM3_WTH_WR2)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WTH_WR2 not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+#ifndef _OPENACC
+PM3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
*MZM(KKA,KKU,KKL,PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD*PDTDZ/PD
-!
-M3_WTH_WR2(:,:,IKB-1)=M3_WTH_WR2(:,:,IKB)
-M3_WTH_WR2(:,:,IKE+1)=M3_WTH_WR2(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBETA*PLEPS/(PSQRT_TKE*PTKE)
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_WTH_WR2(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+ *ZTMP1_DEVICE/XCTD*PDTDZ/PD
+#endif
+!
+PM3_WTH_WR2(:,:,IKB-1)=PM3_WTH_WR2(:,:,IKB)
+PM3_WTH_WR2(:,:,IKE+1)=PM3_WTH_WR2(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_WTH_WR2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST)
+#else
+END SUBROUTINE M3_WTH_WR2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) RESULT(PD_M3_WTH_WR2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PD_M3_WTH_WR2_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -505,22 +784,54 @@ FUNCTION D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WR2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WTH_WR2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_WTH_WR2_O_DDTDZ
+#endif
+!$acc declare present(PTKE,PSQRT_TKE,PBETA,PLEPS,PREDTH1,PREDR1,PD,PKEFF,PBLL_O_E,PEMOIST,PD_M3_WTH_WR2_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WTH_WR2_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+#ifndef _OPENACC
+PD_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
*MZM(KKA,KKU,KKL,PBETA*PLEPS/(PSQRT_TKE*PTKE))/XCTD/PD &
* (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBETA*PLEPS/(PSQRT_TKE*PTKE)
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_WTH_WR2_O_DDTDZ(:,:,:) = - XCSHF*PKEFF*0.25*PBLL_O_E*XCTV*PEMOIST**2 &
+ *ZTMP1_DEVICE/XCTD/PD &
+ * (1. - PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+#endif
!
-D_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
-D_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
+PD_M3_WTH_WR2_O_DDTDZ(:,:,IKB-1)=PD_M3_WTH_WR2_O_DDTDZ(:,:,IKB)
+PD_M3_WTH_WR2_O_DDTDZ(:,:,IKE+1)=PD_M3_WTH_WR2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_WTH_WR2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
+#else
+END SUBROUTINE D_M3_WTH_WR2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST) RESULT(PM3_WTH_WTHR)
+#else
+SUBROUTINE M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST,PM3_WTH_WTHR)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -532,43 +843,89 @@ FUNCTION M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)) :: M3_WTH_WTHR
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)) :: PM3_WTH_WTHR
+#else
+ REAL, DIMENSION(SIZE(PREDR1,1),SIZE(PREDR1,2),SIZE(PREDR1,3)),INTENT(OUT) :: PM3_WTH_WTHR
+#endif
+!$acc declare present(PREDR1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PEMOIST,PM3_WTH_WTHR)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WTH_WTHR not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-!M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST/MZM(KKA,KKU,KKL,PBETA*PTKE*PSQRT_TKE) &
-! *0.5*PLEPS/XCTD*(1+PREDR1)/PD
-M3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(KKA,KKU,KKL,PBETA/PTKE*PSQRT_TKE) &
+#ifndef _OPENACC
+PM3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*MZM(KKA,KKU,KKL,PBETA/PTKE*PSQRT_TKE) &
*0.5*PLEPS/XCTD*(1+PREDR1)/PD
-!
-M3_WTH_WTHR(:,:,IKB-1)=M3_WTH_WTHR(:,:,IKB)
-M3_WTH_WTHR(:,:,IKE+1)=M3_WTH_WTHR(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBETA/PTKE*PSQRT_TKE
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_WTH_WTHR(:,:,:) = XCSHF*PKEFF*PEMOIST*ZTMP1_DEVICE*0.5*PLEPS/XCTD*(1+PREDR1)/PD
+#endif
+!
+PM3_WTH_WTHR(:,:,IKB-1)=PM3_WTH_WTHR(:,:,IKB)
+PM3_WTH_WTHR(:,:,IKE+1)=PM3_WTH_WTHR(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_WTH_WTHR
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE M3_WTH_WTHR
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA) RESULT(PD_M3_WTH_WTHR_O_DDTDZ)
+#else
+SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTHR_O_DDTDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WTH_WTHR
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WTH_WTHR_O_DDTDZ
- INTEGER :: IKB, IKE
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WTH_WTHR_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_WTH_WTHR_O_DDTDZ
+#endif
+!$acc declare present(PM3_WTH_WTHR,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,PD_M3_WTH_WTHR_O_DDTDZ)
+INTEGER :: IKB, IKE
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WTH_WTHR_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_WTH_WTHR_O_DDTDZ(:,:,:) = - PM3_WTH_WTHR * (1.5+PREDTH1+PREDR1)/PD*XCTV*PBLL_O_E*PETHETA
+!$acc kernels
+PD_M3_WTH_WTHR_O_DDTDZ(:,:,:) = - PM3_WTH_WTHR * (1.5+PREDTH1+PREDR1)/PD*XCTV*PBLL_O_E*PETHETA
!
-D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKB)
-D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
+PD_M3_WTH_WTHR_O_DDTDZ(:,:,IKB-1)=PD_M3_WTH_WTHR_O_DDTDZ(:,:,IKB)
+PD_M3_WTH_WTHR_O_DDTDZ(:,:,IKE+1)=PD_M3_WTH_WTHR_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_WTH_WTHR_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
+#else
+END SUBROUTINE D_M3_WTH_WTHR_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE) RESULT(PM3_TH2_W2TH)
+#else
+SUBROUTINE M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W2TH)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -579,21 +936,52 @@ FUNCTION M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2TH
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_TH2_W2TH
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_TH2_W2TH
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PDTDZ,PLM,PLEPS,PTKE,PM3_TH2_W2TH)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_TH2_W2TH not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2TH(:,:,:) = - MZF(KKA,KKU,KKL,(1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
+#ifndef _OPENACC
+PM3_TH2_W2TH(:,:,:) = - MZF(KKA,KKU,KKL,(1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ) &
* 1.5*PLM*PLEPS/PTKE*XCTV
+#else
+!$acc kernels
+ZTMP2_DEVICE = (1.-0.5*PREDR1*(1.+PREDR1)/PD)/(1.+PREDTH1)*PDTDZ
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_TH2_W2TH(:,:,:) = - ZTMP1_DEVICE &
+ * 1.5*PLM*PLEPS/PTKE*XCTV
+#endif
!
-M3_TH2_W2TH(:,:,IKB-1)=M3_TH2_W2TH(:,:,IKB)
-M3_TH2_W2TH(:,:,IKE+1)=M3_TH2_W2TH(:,:,IKE)
+PM3_TH2_W2TH(:,:,IKB-1)=PM3_TH2_W2TH(:,:,IKB)
+PM3_TH2_W2TH(:,:,IKE+1)=PM3_TH2_W2TH(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION M3_TH2_W2TH
-!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV)
+#else
+END SUBROUTINE M3_TH2_W2TH
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV) RESULT(PD_M3_TH2_W2TH_O_DDTDZ)
+#else
+SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_TH2_W2TH_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -604,30 +992,71 @@ FUNCTION D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,OUSE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
LOGICAL, INTENT(IN) :: OUSERV
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2TH_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_TH2_W2TH_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_TH2_W2TH_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3_TH2_W2TH_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_TH2_W2TH_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
+#ifndef _OPENACC
IF (OUSERV) THEN
-! D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL, &
-! (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)*(1.+PREDTH1)/PD ) &
-! / (1.+PREDTH1)**2 )
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL, &
+ PD_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL, &
(1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2 )
ELSE
- D_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL,1./(1.+PREDTH1)**2)
+ PD_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * MZF(KKA,KKU,KKL,1./(1.+PREDTH1)**2)
END IF
+#else
+IF (OUSERV) THEN
+!$acc kernels
+ZTMP2_DEVICE = (1.-0.5*PREDR1*(1.+PREDR1)/PD)*(1.-(1.5+PREDTH1+PREDR1)* &
+ PREDTH1*(1.+PREDTH1)/PD ) / (1.+PREDTH1)**2
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE, ZTMP1_DEVICE)
+!$acc kernels
+ PD_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * ZTMP1_DEVICE
+!$acc end kernels
+
+ELSE
+!$acc kernels
+ZTMP2_DEVICE = 1./(1.+PREDTH1)**2
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+ PD_M3_TH2_W2TH_O_DDTDZ(:,:,:) = - 1.5*PLM*PLEPS/PTKE*XCTV * ZTMP1_DEVICE
+!$acc end kernels
+END IF
+#endif
!
-D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
-D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
+!$acc kernels
+PD_M3_TH2_W2TH_O_DDTDZ(:,:,IKB-1)=PD_M3_TH2_W2TH_O_DDTDZ(:,:,IKB)
+PD_M3_TH2_W2TH_O_DDTDZ(:,:,IKE+1)=PD_M3_TH2_W2TH_O_DDTDZ(:,:,IKE)
+!$acc end kernels
!
+#ifndef _OPENACC
END FUNCTION D_M3_TH2_W2TH_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+#else
+END SUBROUTINE D_M3_TH2_W2TH_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE) RESULT(PM3_TH2_WTH2)
+#else
+SUBROUTINE M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -636,21 +1065,51 @@ FUNCTION M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTH2
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_TH2_WTH2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_TH2_WTH2
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_TH2_WTH2)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_TH2_WTH2 not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
+#ifndef _OPENACC
+PM3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE &
* MZF(KKA,KKU,KKL, (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD )
-!
-M3_TH2_WTH2(:,:,IKB-1)=M3_TH2_WTH2(:,:,IKB)
-M3_TH2_WTH2(:,:,IKE+1)=M3_TH2_WTH2(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = (1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE ,ZTMP1_DEVICE)
+!$acc kernels
+PM3_TH2_WTH2(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*ZTMP1_DEVICE
+#endif
+!
+PM3_TH2_WTH2(:,:,IKB-1)=PM3_TH2_WTH2(:,:,IKB)
+PM3_TH2_WTH2(:,:,IKE+1)=PM3_TH2_WTH2(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_TH2_WTH2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE M3_TH2_WTH2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) RESULT(PD_M3_TH2_WTH2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_TH2_WTH2_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -661,23 +1120,55 @@ FUNCTION D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTH2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_TH2_WTH2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_TH2_WTH2_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_TH2_WTH2_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_TH2_WTH2_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
+#ifndef _OPENACC
+PD_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV &
* MZF(KKA,KKU,KKL, PBLL_O_E*PETHETA* (0.5/PD &
- (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
) )
-!
-D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKB)
-D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PETHETA* (0.5/PD &
+ - (1.5+PREDTH1+PREDR1)*(1.+0.5*PREDTH1+1.5*PREDR1+0.5*PREDR1**2)/PD**2 &
+ )
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE ,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_TH2_WTH2_O_DDTDZ(:,:,:) = PLEPS*0.5/XCTD/PSQRT_TKE*XCTV*ZTMP1_DEVICE
+#endif
+!
+PD_M3_TH2_WTH2_O_DDTDZ(:,:,IKB-1)=PD_M3_TH2_WTH2_O_DDTDZ(:,:,IKB)
+PD_M3_TH2_WTH2_O_DDTDZ(:,:,IKE+1)=PD_M3_TH2_WTH2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_TH2_WTH2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_TH2_WTH2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PM3_TH2_W2R)
+#else
+SUBROUTINE M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_W2R)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -688,20 +1179,50 @@ FUNCTION M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_W2R
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_TH2_W2R
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_TH2_W2R
+#endif
+!$acc declare present(PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_W2R)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_TH2_W2R not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(KKA,KKU,KKL,PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
-!
-M3_TH2_W2R(:,:,IKB-1)=M3_TH2_W2R(:,:,IKB)
-M3_TH2_W2R(:,:,IKE+1)=M3_TH2_W2R(:,:,IKE)
-!
+#ifndef _OPENACC
+PM3_TH2_W2R(:,:,:) = 0.75*XCTV**2*MZF(KKA,KKU,KKL,PBLL_O_E*PEMOIST/PD*PDTDZ**2)*PLM*PLEPS/PTKE
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PEMOIST/PD*PDTDZ**2
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_TH2_W2R(:,:,:) = 0.75*XCTV**2*ZTMP1_DEVICE*PLM*PLEPS/PTKE
+#endif
+!
+PM3_TH2_W2R(:,:,IKB-1)=PM3_TH2_W2R(:,:,IKB)
+PM3_TH2_W2R(:,:,IKE+1)=PM3_TH2_W2R(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_TH2_W2R
-!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE M3_TH2_W2R
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PD_M3_TH2_W2R_O_DDTDZ)
+#else
+SUBROUTINE D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_W2R_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -714,21 +1235,52 @@ FUNCTION D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_W2R_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_TH2_W2R_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_TH2_W2R_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_W2R_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_TH2_W2R_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
+#ifndef _OPENACC
+PD_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
* MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
-!
-D_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
-D_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PEMOIST/PD*PDTDZ*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_TH2_W2R_O_DDTDZ(:,:,:) = 0.75*XCTV**2*PLM*PLEPS/PTKE &
+ * ZTMP1_DEVICE
+#endif
+!
+PD_M3_TH2_W2R_O_DDTDZ(:,:,IKB-1)=PD_M3_TH2_W2R_O_DDTDZ(:,:,IKB)
+PD_M3_TH2_W2R_O_DDTDZ(:,:,IKE+1)=PD_M3_TH2_W2R_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_TH2_W2R_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_TH2_W2R_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PM3_TH2_WR2)
+#else
+SUBROUTINE M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WR2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -738,20 +1290,50 @@ FUNCTION M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WR2
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_TH2_WR2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_TH2_WR2
+#endif
+!$acc declare present(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WR2)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_TH2_WR2 not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF(KKA,KKU,KKL,(PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
-!
-M3_TH2_WR2(:,:,IKB-1)=M3_TH2_WR2(:,:,IKB)
-M3_TH2_WR2(:,:,IKE+1)=M3_TH2_WR2(:,:,IKE)
-!
+#ifndef _OPENACC
+PM3_TH2_WR2(:,:,:) = 0.25*XCTV**2*MZF(KKA,KKU,KKL,(PBLL_O_E*PEMOIST*PDTDZ)**2/PD)*PLEPS/PSQRT_TKE/XCTD
+#else
+!$acc kernels
+ZTMP2_DEVICE = (PBLL_O_E*PEMOIST*PDTDZ)**2/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_TH2_WR2(:,:,:) = 0.25*XCTV**2*ZTMP1_DEVICE*PLEPS/PSQRT_TKE/XCTD
+#endif
+!
+PM3_TH2_WR2(:,:,IKB-1)=PM3_TH2_WR2(:,:,IKB)
+PM3_TH2_WR2(:,:,IKE+1)=PM3_TH2_WR2(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_TH2_WR2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE M3_TH2_WR2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PD_M3_TH2_WR2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WR2_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -763,21 +1345,52 @@ FUNCTION D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WR2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_TH2_WR2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_TH2_WR2_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WR2_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_TH2_WR2_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
+#ifndef _OPENACC
+PD_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
* MZF(KKA,KKU,KKL, (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
-!
-D_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
-D_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = (PBLL_O_E*PEMOIST)**2*PDTDZ/PD*(2.-PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_TH2_WR2_O_DDTDZ(:,:,:) = 0.25*XCTV**2*PLEPS/PSQRT_TKE/XCTD &
+ * ZTMP1_DEVICE
+#endif
+!
+PD_M3_TH2_WR2_O_DDTDZ(:,:,IKB-1)=PD_M3_TH2_WR2_O_DDTDZ(:,:,IKB)
+PD_M3_TH2_WR2_O_DDTDZ(:,:,IKE+1)=PD_M3_TH2_WR2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_TH2_WR2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_TH2_WR2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PM3_TH2_WTHR)
+#else
+SUBROUTINE M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WTHR)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -788,21 +1401,51 @@ FUNCTION M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_TH2_WTHR
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_TH2_WTHR
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_TH2_WTHR
+#endif
+!$acc declare present(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_TH2_WTHR)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_TH2_WTHR not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
+#ifndef _OPENACC
+PM3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
* MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD )
-!
-M3_TH2_WTHR(:,:,IKB-1)=M3_TH2_WTHR(:,:,IKB)
-M3_TH2_WTHR(:,:,IKE+1)=M3_TH2_WTHR(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PEMOIST*PDTDZ*(1.+PREDR1)/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_TH2_WTHR(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD*ZTMP1_DEVICE
+#endif
+!
+PM3_TH2_WTHR(:,:,IKB-1)=PM3_TH2_WTHR(:,:,IKB)
+PM3_TH2_WTHR(:,:,IKE+1)=PM3_TH2_WTHR(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_TH2_WTHR
-!----------------------------------------------------------------------------
-FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE M3_TH2_WTHR
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PD_M3_TH2_WTHR_O_DDTDZ)
+#else
+SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WTHR_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -814,21 +1457,52 @@ FUNCTION D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_TH2_WTHR_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_TH2_WTHR_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_TH2_WTHR_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_TH2_WTHR_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_TH2_WTHR_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
+#ifndef _OPENACC
+PD_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
* MZF(KKA,KKU,KKL, PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD) )
-!
-D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
-D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PEMOIST*(1.+PREDR1)/PD * (1. -PREDTH1*(1.5+PREDTH1+PREDR1)/PD)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_TH2_WTHR_O_DDTDZ(:,:,:) = - 0.5*XCTV*PLEPS/PSQRT_TKE/XCTD &
+ * ZTMP1_DEVICE
+#endif
+!
+PD_M3_TH2_WTHR_O_DDTDZ(:,:,IKB-1)=PD_M3_TH2_WTHR_O_DDTDZ(:,:,IKB)
+PD_M3_TH2_WTHR_O_DDTDZ(:,:,IKE+1)=PD_M3_TH2_WTHR_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_TH2_WTHR_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
+#else
+END SUBROUTINE D_M3_TH2_WTHR_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE) RESULT(PM3_THR_WTHR)
+#else
+SUBROUTINE M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -837,21 +1511,51 @@ FUNCTION M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTHR
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_THR_WTHR
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_THR_WTHR
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PM3_THR_WTHR)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_THR_WTHR not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
+#ifndef _OPENACC
+PM3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD &
* MZF(KKA,KKU,KKL, (1.+PREDTH1)*(1.+PREDR1)/PD )
-!
-M3_THR_WTHR(:,:,IKB-1)=M3_THR_WTHR(:,:,IKB)
-M3_THR_WTHR(:,:,IKE+1)=M3_THR_WTHR(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = (1.+PREDTH1)*(1.+PREDR1)/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_THR_WTHR(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD*ZTMP1_DEVICE
+#endif
+!
+PM3_THR_WTHR(:,:,IKB-1)=PM3_THR_WTHR(:,:,IKB)
+PM3_THR_WTHR(:,:,IKE+1)=PM3_THR_WTHR(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_THR_WTHR
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE M3_THR_WTHR
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) RESULT(PD_M3_THR_WTHR_O_DDTDZ)
+#else
+SUBROUTINE D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTHR_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -862,21 +1566,51 @@ FUNCTION D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WTHR_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_THR_WTHR_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTHR_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WTHR_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
+#ifndef _OPENACC
+PD_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV &
* MZF(KKA,KKU,KKL, PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD) )
-!
-D_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
-D_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PETHETA*PBLL_O_E/PD*(1.+PREDR1)*(1.-(1.+PREDTH1)*(1.5+PREDTH1+PREDR1)/PD)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_THR_WTHR_O_DDTDZ(:,:,:) = 0.5*PLEPS/PSQRT_TKE/XCTD * XCTV * ZTMP1_DEVICE
+#endif
+!
+PD_M3_THR_WTHR_O_DDTDZ(:,:,IKB-1)=PD_M3_THR_WTHR_O_DDTDZ(:,:,IKB)
+PD_M3_THR_WTHR_O_DDTDZ(:,:,IKE+1)=PD_M3_THR_WTHR_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WTHR_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_THR_WTHR_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PM3_THR_WTH2)
+#else
+SUBROUTINE M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_THR_WTH2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -887,21 +1621,51 @@ FUNCTION M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WTH2
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_THR_WTH2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_THR_WTH2
+#endif
+!$acc declare present(PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_THR_WTH2)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_THR_WTH2 not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
+#ifndef _OPENACC
+PM3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
* MZF(KKA,KKU,KKL, (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD )
-!
-M3_THR_WTH2(:,:,IKB-1)=M3_THR_WTH2(:,:,IKB)
-M3_THR_WTH2(:,:,IKE+1)=M3_THR_WTH2(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = (1.+PREDR1)*PBLL_O_E*PETHETA*PDRDZ/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_THR_WTH2(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV * ZTMP1_DEVICE
+#endif
+!
+PM3_THR_WTH2(:,:,IKB-1)=PM3_THR_WTH2(:,:,IKB)
+PM3_THR_WTH2(:,:,IKE+1)=PM3_THR_WTH2(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_THR_WTH2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE M3_THR_WTH2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PD_M3_THR_WTH2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_THR_WTH2_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -913,21 +1677,51 @@ FUNCTION D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WTH2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_THR_WTH2_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WTH2_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
+#ifndef _OPENACC
+PD_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 &
* MZF(KKA,KKU,KKL, -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1) )
-!
-D_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
-D_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = -(1.+PREDR1)*(PBLL_O_E*PETHETA/PD)**2*PDRDZ*(1.5+PREDTH1+PREDR1)
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_THR_WTH2_O_DDTDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV**2 * ZTMP1_DEVICE
+#endif
+!
+PD_M3_THR_WTH2_O_DDTDZ(:,:,IKB-1)=PD_M3_THR_WTH2_O_DDTDZ(:,:,IKB)
+PD_M3_THR_WTH2_O_DDTDZ(:,:,IKE+1)=PD_M3_THR_WTH2_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WTH2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE D_M3_THR_WTH2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) RESULT(PD_M3_THR_WTH2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTH2_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -938,23 +1732,54 @@ FUNCTION D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTH2_O_DDRDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WTH2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_THR_WTH2_O_DDRDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PD_M3_THR_WTH2_O_DDRDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WTH2_O_DDRDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
- * MZF(KKA,KKU,KKL, PBLL_O_E*PETHETA/PD &
+#ifndef _OPENACC
+PD_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV &
+ * MZF(KKA,KKU,KKL, PBLL_O_E*PETHETA/PD &
*(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1)) &
)
-!
-D_M3_THR_WTH2_O_DDRDZ(:,:,IKB-1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKB)
-D_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=D_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = PBLL_O_E*PETHETA/PD &
+ *(-(1.+PREDR1)*PREDR1/PD*(1.5+PREDTH1+PREDR1)+(1.+2.*PREDR1))
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_THR_WTH2_O_DDRDZ(:,:,:) = - 0.25*PLEPS/PSQRT_TKE/XCTD*XCTV * ZTMP1_DEVICE
+#endif
+!
+PD_M3_THR_WTH2_O_DDRDZ(:,:,IKB-1)=PD_M3_THR_WTH2_O_DDRDZ(:,:,IKB)
+PD_M3_THR_WTH2_O_DDRDZ(:,:,IKE+1)=PD_M3_THR_WTH2_O_DDRDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WTH2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
+#else
+END SUBROUTINE D_M3_THR_WTH2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ) RESULT(PM3_THR_W2TH)
+#else
+SUBROUTINE M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,PM3_THR_W2TH)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -964,21 +1789,51 @@ FUNCTION M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2TH
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_THR_W2TH
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PM3_THR_W2TH
+#endif
+!$acc declare present(PREDR1,PD,PLM,PLEPS,PTKE,PDRDZ,PM3_THR_W2TH)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_THR_W2TH not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-M3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
+#ifndef _OPENACC
+PM3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
* MZF(KKA,KKU,KKL, (1.+PREDR1)*PDRDZ/PD )
-!
-M3_THR_W2TH(:,:,IKB-1)=M3_THR_W2TH(:,:,IKB)
-M3_THR_W2TH(:,:,IKE+1)=M3_THR_W2TH(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = (1.+PREDR1)*PDRDZ/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PM3_THR_W2TH(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV * ZTMP1_DEVICE
+#endif
+!
+PM3_THR_W2TH(:,:,IKB-1)=PM3_THR_W2TH(:,:,IKB)
+PM3_THR_W2TH(:,:,IKE+1)=PM3_THR_W2TH(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION M3_THR_W2TH
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA)
+#else
+END SUBROUTINE M3_THR_W2TH
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA) RESULT(PD_M3_THR_W2TH_O_DDTDZ)
+#else
+SUBROUTINE D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA,PD_M3_THR_W2TH_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -991,22 +1846,51 @@ FUNCTION D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDTDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_W2TH_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDTDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDRDZ,PETHETA,PD_M3_THR_W2TH_O_DDTDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_W2TH_O_DDTDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
+#ifndef _OPENACC
+PD_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 &
* MZF(KKA,KKU,KKL, -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2 )
-
-!
-D_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
-D_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = -PETHETA*PBLL_O_E*(1.+PREDR1)*PDRDZ*(1.5+PREDTH1+PREDR1)/PD**2
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_THR_W2TH_O_DDTDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV**2 * ZTMP1_DEVICE
+#endif
+!
+PD_M3_THR_W2TH_O_DDTDZ(:,:,IKB-1)=PD_M3_THR_W2TH_O_DDTDZ(:,:,IKB)
+PD_M3_THR_W2TH_O_DDTDZ(:,:,IKE+1)=PD_M3_THR_W2TH_O_DDTDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_W2TH_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
+#else
+END SUBROUTINE D_M3_THR_W2TH_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE) RESULT(PD_M3_THR_W2TH_O_DDRDZ)
+#else
+SUBROUTINE D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2TH_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1016,27 +1900,57 @@ FUNCTION D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2TH_O_DDRDZ
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_W2TH_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)),INTENT(OUT) :: PD_M3_THR_W2TH_O_DDRDZ
+#endif
+!$acc declare present(PREDTH1,PREDR1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2TH_O_DDRDZ)
INTEGER :: IKB, IKE
-!
+#ifdef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_W2TH_O_DDRDZ not yet tested'
+#endif
IKB = 1+JPVEXT_TURB
IKE = SIZE(PD,3)-JPVEXT_TURB
-D_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
- * MZF(KKA,KKU,KKL, -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
- +(1.+2.*PREDR1)/PD &
+#ifndef _OPENACC
+PD_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV &
+ * MZF(KKA,KKU,KKL, -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ +(1.+2.*PREDR1)/PD &
)
-
-!
-D_M3_THR_W2TH_O_DDRDZ(:,:,IKB-1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKB)
-D_M3_THR_W2TH_O_DDRDZ(:,:,IKE+1)=D_M3_THR_W2TH_O_DDRDZ(:,:,IKE)
-!
+#else
+!$acc kernels
+ZTMP2_DEVICE = -(1.+PREDR1)*PREDR1*(1.5+PREDTH1+PREDR1)/PD**2 &
+ +(1.+2.*PREDR1)/PD
+!$acc end kernels
+CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+PD_M3_THR_W2TH_O_DDRDZ(:,:,:) = - 0.75*PLM*PLEPS/PTKE * XCTV * ZTMP1_DEVICE
+#endif
+!
+PD_M3_THR_W2TH_O_DDRDZ(:,:,IKB-1)=PD_M3_THR_W2TH_O_DDRDZ(:,:,IKB)
+PD_M3_THR_W2TH_O_DDRDZ(:,:,IKE+1)=PD_M3_THR_W2TH_O_DDRDZ(:,:,IKE)
+!$acc end kernels
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_W2TH_O_DDRDZ
+#else
+END SUBROUTINE D_M3_THR_W2TH_O_DDRDZ
+#endif
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!
-FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+#ifndef _OPENACC
+FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PPSI3)
+#else
+SUBROUTINE PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2TH3
@@ -1044,13 +1958,31 @@ FUNCTION PSI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PSI3
-!
-PSI3 = PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PPSI3
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)),INTENT(OUT) :: PPSI3
+#endif
+!
+#ifndef _OPENACC
+PPSI3 = PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+!$acc data present(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,PPSI3)
+CALL PHI3(PREDR1,PREDTH1,PRED2R3,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV,PPSI3)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PSI3
-!----------------------------------------------------------------------------
-FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE PSI3
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PD_PSI3DRDZ_O_DDRDZ)
+#else
+SUBROUTINE D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DRDZ_O_DDRDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
@@ -1058,15 +1990,33 @@ FUNCTION D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ_O_DDRDZ
-
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PSI3DRDZ_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PD_PSI3DRDZ_O_DDRDZ
+#endif
+!
+#ifndef _OPENACC
D_PSI3DRDZ_O_DDRDZ = D_PHI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+!$acc data present(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PD_PSI3DRDZ_O_DDRDZ)
+CALL D_PHI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DRDZ_O_DDRDZ)
+!$acc end data
+#endif
!
!C'est ok?!
!
+#ifndef _OPENACC
END FUNCTION D_PSI3DRDZ_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE D_PSI3DRDZ_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV) RESULT(PD_PSI3DTDZ_O_DDTDZ)
+#else
+SUBROUTINE D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DTDZ_O_DDTDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
@@ -1074,13 +2024,31 @@ FUNCTION D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRED2THR3
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DTDZ_O_DDTDZ
-!
-D_PSI3DTDZ_O_DDTDZ = D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PSI3DTDZ_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PD_PSI3DTDZ_O_DDTDZ
+#endif
+!
+#ifndef _OPENACC
+PD_PSI3DTDZ_O_DDTDZ = D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV)
+#else
+!$acc data present(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PD_PSI3DTDZ_O_DDTDZ)
+CALL D_PHI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,OUSERV,PD_PSI3DTDZ_O_DDTDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_PSI3DTDZ_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
+#else
+END SUBROUTINE D_PSI3DTDZ_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV) RESULT(PD_PSI3DRDZ2_O_DDRDZ)
+#else
+SUBROUTINE D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV,PD_PSI3DRDZ2_O_DDRDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPSI3
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
@@ -1089,38 +2057,98 @@ FUNCTION D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! 1DIM or 3DIM turb. scheme
LOGICAL, INTENT(IN) :: OUSERV ! flag to use vapor
- REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: D_PSI3DRDZ2_O_DDRDZ
-!
-D_PSI3DRDZ2_O_DDRDZ = D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)) :: PD_PSI3DRDZ2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PREDTH1,1),SIZE(PREDTH1,2),SIZE(PREDTH1,3)), INTENT(OUT) :: PD_PSI3DRDZ2_O_DDRDZ
+#endif
+!
+#ifndef _OPENACC
+PD_PSI3DRDZ2_O_DDRDZ = D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV)
+#else
+!$acc data present(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,PD_PSI3DRDZ2_O_DDRDZ)
+CALL D_PHI3DTDZ2_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDRDZ,HTURBDIM,OUSERV,PD_PSI3DRDZ2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_PSI3DRDZ2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE D_PSI3DRDZ2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST) RESULT(PM3_WR_WR2)
+#else
+SUBROUTINE M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WR2
-!
-M3_WR_WR2 = M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WR_WR2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_WR_WR2
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WR_WR2 not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_WR_WR2 = M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PM3_WR_WR2)
+CALL M3_WTH_WTH2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST, PM3_WR_WR2)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_WR_WR2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE M3_WR_WR2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST) RESULT(PD_M3_WR_WR2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_WR_WR2_O_DDRDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WR2_O_DDRDZ)
+#endif
REAL, DIMENSION(:,:,:), INTENT(IN) :: PM3_WR_WR2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDR1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PREDTH1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WR2_O_DDRDZ
-!
-D_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WR_WR2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_WR_WR2_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WR_WR2_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_WR_WR2_O_DDRDZ = D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WR2_O_DDRDZ)
+CALL D_M3_WTH_WTH2_O_DDTDZ(PM3_WR_WR2,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WR2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_WR_WR2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
+#else
+END SUBROUTINE D_M3_WR_WR2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE) RESULT(PM3_WR_W2R)
+#else
+SUBROUTINE M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1129,13 +2157,34 @@ FUNCTION M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2R
-!
-M3_WR_W2R = M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WR_W2R
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_WR_W2R
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WR_W2R not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_WR_W2R = M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
+CALL M3_WTH_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PM3_WR_W2R)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_WR_W2R
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+#else
+END SUBROUTINE M3_WR_W2R
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE) RESULT(PD_M3_WR_W2R_O_DDRDZ)
+#else
+SUBROUTINE D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE,PD_M3_WR_W2R_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1146,13 +2195,34 @@ FUNCTION D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PKEFF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2R_O_DDRDZ
-!
-D_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WR_W2R_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_WR_W2R_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WR_W2R_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_WR_W2R_O_DDRDZ = D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE,PD_M3_WR_W2R_O_DDRDZ)
+CALL D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PKEFF,PTKE,PD_M3_WR_W2R_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_WR_W2R_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_WR_W2R_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PM3_WR_W2TH)
+#else
+SUBROUTINE M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1164,13 +2234,34 @@ FUNCTION M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_W2TH
-!
-M3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WR_W2TH
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_WR_W2TH
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WR_W2TH not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_WR_W2TH = M3_WTH_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
+CALL M3_WTH_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_WR_W2TH)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_WR_W2TH
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+#else
+END SUBROUTINE M3_WR_W2TH
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA) RESULT(PD_M3_WR_W2TH_O_DDRDZ)
+#else
+SUBROUTINE D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD_M3_WR_W2TH_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1181,13 +2272,34 @@ FUNCTION D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_W2TH_O_DDRDZ
-!
-D_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WR_W2TH_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_WR_W2TH_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WR_W2TH_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_WR_W2TH_O_DDRDZ = D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD_M3_WR_W2TH_O_DDRDZ)
+CALL D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PBLL_O_E,PETHETA,PD_M3_WR_W2TH_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_WR_W2TH_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_WR_W2TH_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ) RESULT(PM3_WR_WTH2)
+#else
+SUBROUTINE M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ,PM3_WR_WTH2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1202,13 +2314,34 @@ FUNCTION M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTH2
-!
-M3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WR_WTH2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_WR_WTH2
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WR_WTH2 not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_WR_WTH2 = M3_WTH_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ,PM3_WR_WTH2)
+CALL M3_WTH_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDRDZ,PM3_WR_WTH2)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_WR_WTH2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+#else
+END SUBROUTINE M3_WR_WTH2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) RESULT(PD_M3_WR_WTH2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PD_M3_WR_WTH2_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1222,13 +2355,34 @@ FUNCTION D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTH2_O_DDRDZ
-!
-D_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WR_WTH2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_WR_WTH2_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WR_WTH2_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_WR_WTH2_O_DDRDZ = D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PD_M3_WR_WTH2_O_DDRDZ)
+CALL D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PD_M3_WR_WTH2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_WR_WTH2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+#else
+END SUBROUTINE D_M3_WR_WTH2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA) RESULT(PM3_WR_WTHR)
+#else
+SUBROUTINE M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1240,13 +2394,34 @@ FUNCTION M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETH
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_WR_WTHR
-!
-M3_WR_WTHR = M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_WR_WTHR
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_WR_WTHR
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_WR_WTHR not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_WR_WTHR = M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA)
+#else
+!$acc data present(PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
+CALL M3_WTH_WTHR(KKA,KKU,KKL,PREDTH1,PD,PKEFF,PTKE,PSQRT_TKE,PBETA,PLEPS,PETHETA,PM3_WR_WTHR)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_WR_WTHR
-!----------------------------------------------------------------------------
-FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE M3_WR_WTHR
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST) RESULT(PD_M3_WR_WTHR_O_DDRDZ)
+#else
+SUBROUTINE D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WTHR_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1256,13 +2431,34 @@ FUNCTION D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_WR_WTHR_O_DDRDZ
-!
-D_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_WR_WTHR_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_WR_WTHR_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_WR_WTHR_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_WR_WTHR_O_DDRDZ = D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WTHR_O_DDRDZ)
+CALL D_M3_WTH_WTHR_O_DDTDZ(PM3_WR_WTHR,PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,PD_M3_WR_WTHR_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_WR_WTHR_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+#else
+END SUBROUTINE D_M3_WR_WTHR_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE) RESULT(PM3_R2_W2R)
+#else
+SUBROUTINE M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1273,13 +2469,34 @@ FUNCTION M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2R
-!
-M3_R2_W2R = M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_R2_W2R
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_R2_W2R
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_R2_W2R not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_R2_W2R = M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
+CALL M3_TH2_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDRDZ,PLM,PLEPS,PTKE,PM3_R2_W2R)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_R2_W2R
-!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+#else
+END SUBROUTINE M3_R2_W2R
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV) RESULT(PD_M3_R2_W2R_O_DDRDZ)
+#else
+SUBROUTINE D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_R2_W2R_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1290,13 +2507,34 @@ FUNCTION D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
LOGICAL, INTENT(IN) :: OUSERV
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2R_O_DDRDZ
-!
-D_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_R2_W2R_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_R2_W2R_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_R2_W2R_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_R2_W2R_O_DDRDZ = D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_R2_W2R_O_DDRDZ)
+CALL D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,OUSERV,PD_M3_R2_W2R_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_R2_W2R_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+#else
+END SUBROUTINE D_M3_R2_W2R_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE) RESULT(PM3_R2_WR2)
+#else
+SUBROUTINE M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1305,13 +2543,34 @@ FUNCTION M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WR2
-!
-M3_R2_WR2 = M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_R2_WR2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_R2_WR2
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_R2_WR2 not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_R2_WR2 = M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
+CALL M3_TH2_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PM3_R2_WR2)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_R2_WR2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE M3_R2_WR2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) RESULT(PD_M3_R2_WR2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_R2_WR2_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1322,13 +2581,34 @@ FUNCTION D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WR2_O_DDRDZ
-!
-D_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_R2_WR2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_R2_WR2_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_R2_WR2_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_R2_WR2_O_DDRDZ = D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_R2_WR2_O_DDRDZ)
+CALL D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_R2_WR2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_R2_WR2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_R2_WR2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PM3_R2_W2TH)
+#else
+SUBROUTINE M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1339,13 +2619,34 @@ FUNCTION M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_W2TH
-!
-M3_R2_W2TH = M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_R2_W2TH
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_R2_W2TH
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_R2_W2TH not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_R2_W2TH = M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
+CALL M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_W2TH)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_R2_W2TH
-!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE M3_R2_W2TH
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PD_M3_R2_W2TH_O_DDRDZ)
+#else
+SUBROUTINE D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_W2TH_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1358,13 +2659,34 @@ FUNCTION D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_W2TH_O_DDRDZ
-!
-D_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_R2_W2TH_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_R2_W2TH_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_R2_W2TH_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_R2_W2TH_O_DDRDZ = D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_W2TH_O_DDRDZ)
+CALL D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_W2TH_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_R2_W2TH_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_R2_W2TH_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PM3_R2_WTH2)
+#else
+SUBROUTINE M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1374,13 +2696,34 @@ FUNCTION M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTH2
-!
-M3_R2_WTH2 = M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_R2_WTH2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_R2_WTH2
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_R2_WTH2 not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_R2_WTH2 = M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
+CALL M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTH2)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_R2_WTH2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE M3_R2_WTH2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PD_M3_R2_WTH2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTH2_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1392,13 +2735,34 @@ FUNCTION D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTH2_O_DDRDZ
-!
-D_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_R2_WTH2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_R2_WTH2_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_R2_WTH2_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_R2_WTH2_O_DDRDZ = D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTH2_O_DDRDZ)
+CALL D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTH2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_R2_WTH2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE D_M3_R2_WTH2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PM3_R2_WTHR)
+#else
+SUBROUTINE M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTHR)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1409,13 +2773,34 @@ FUNCTION M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_R2_WTHR
-!
-M3_R2_WTHR = M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_R2_WTHR
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_R2_WTHR
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_R2_WTHR not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_R2_WTHR = M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTHR)
+CALL M3_TH2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PM3_R2_WTHR)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_R2_WTHR
-!----------------------------------------------------------------------------
-FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+END SUBROUTINE M3_R2_WTHR
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ) RESULT(PD_M3_R2_WTHR_O_DDRDZ)
+#else
+SUBROUTINE D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTHR_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1427,13 +2812,34 @@ FUNCTION D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PETHETA
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDRDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_R2_WTHR_O_DDRDZ
-!
-D_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_R2_WTHR_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_R2_WTHR_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_R2_WTHR_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_R2_WTHR_O_DDRDZ = D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTHR_O_DDRDZ)
+CALL D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDRDZ,PD_M3_R2_WTHR_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_R2_WTHR_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE D_M3_R2_WTHR_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) RESULT(PD_M3_THR_WTHR_O_DDRDZ)
+#else
+SUBROUTINE D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WTHR_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1444,13 +2850,34 @@ FUNCTION D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WTHR_O_DDRDZ
-!
-D_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WTHR_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_THR_WTHR_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WTHR_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_THR_WTHR_O_DDRDZ = D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WTHR_O_DDRDZ)
+CALL D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WTHR_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WTHR_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE D_M3_THR_WTHR_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PM3_THR_WR2)
+#else
+SUBROUTINE M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_THR_WR2)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1461,13 +2888,34 @@ FUNCTION M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTD
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_WR2
-!
-M3_THR_WR2 = M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_THR_WR2
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_THR_WR2
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_THR_WR2 not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_THR_WR2 = M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+!$acc data present(PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_THR_WR2)
+CALL M3_THR_WTH2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PM3_THR_WR2)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_THR_WR2
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+END SUBROUTINE M3_THR_WR2
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ) RESULT(PD_M3_THR_WR2_O_DDRDZ)
+#else
+SUBROUTINE D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_THR_WR2_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1479,13 +2927,34 @@ FUNCTION D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDRDZ
-!
-D_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WR2_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_THR_WR2_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WR2_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_THR_WR2_O_DDRDZ = D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_THR_WR2_O_DDRDZ)
+CALL D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTDZ,PD_M3_THR_WR2_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WR2_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+END SUBROUTINE D_M3_THR_WR2_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) RESULT(PD_M3_THR_WR2_O_DDTDZ)
+#else
+SUBROUTINE D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WR2_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1496,13 +2965,34 @@ FUNCTION D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSQRT_TKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_WR2_O_DDTDZ
-!
-D_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_WR2_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_THR_WR2_O_DDTDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_WR2_O_DDTDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_THR_WR2_O_DDTDZ = D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WR2_O_DDTDZ)
+CALL D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PD_M3_THR_WR2_O_DDTDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_WR2_O_DDTDZ
-!----------------------------------------------------------------------------
-FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+#else
+END SUBROUTINE D_M3_THR_WR2_O_DDTDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ) RESULT(PM3_THR_W2R)
+#else
+SUBROUTINE M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1512,13 +3002,34 @@ FUNCTION M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: M3_THR_W2R
-!
-M3_THR_W2R = M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PM3_THR_W2R
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PM3_THR_W2R
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: M3_THR_W2R not yet tested'
+#endif
+#ifndef _OPENACC
+PM3_THR_W2R = M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ)
+#else
+!$acc data present(PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
+CALL M3_THR_W2TH(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKE,PDTDZ,PM3_THR_W2R)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION M3_THR_W2R
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+#else
+END SUBROUTINE M3_THR_W2R
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST) RESULT(PD_M3_THR_W2R_O_DDRDZ)
+#else
+SUBROUTINE D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST,PD_M3_THR_W2R_O_DDRDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1531,13 +3042,34 @@ FUNCTION D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_
REAL, DIMENSION(:,:,:), INTENT(IN) :: PBLL_O_E
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTDZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEMOIST
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDRDZ
-!
-D_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_W2R_O_DDRDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_THR_W2R_O_DDRDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_W2R_O_DDRDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_THR_W2R_O_DDRDZ = D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST,PD_M3_THR_W2R_O_DDRDZ)
+CALL D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PBLL_O_E,PDTDZ,PEMOIST,PD_M3_THR_W2R_O_DDRDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_W2R_O_DDRDZ
-!----------------------------------------------------------------------------
-FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+#else
+END SUBROUTINE D_M3_THR_W2R_O_DDRDZ
+#endif
+!----------------------------------------------------------------------------
+#ifndef _OPENACC
+FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE) RESULT(PD_M3_THR_W2R_O_DDTDZ)
+#else
+SUBROUTINE D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
+#endif
INTEGER, INTENT(IN) :: KKA
INTEGER, INTENT(IN) :: KKU
INTEGER, INTENT(IN) :: KKL
@@ -1547,11 +3079,28 @@ FUNCTION D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLEPS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
- REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: D_M3_THR_W2R_O_DDTDZ
-!
-D_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
-!
+#ifndef _OPENACC
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)) :: PD_M3_THR_W2R_O_DDTDZ
+#else
+ REAL, DIMENSION(SIZE(PD,1),SIZE(PD,2),SIZE(PD,3)), INTENT(OUT) :: PD_M3_THR_W2R_O_DDTDZ
+#endif
+!
+#ifdef _OPENACC
+PRINT *,'OPENACC: D_M3_THR_W2R_O_DDTDZ not yet tested'
+#endif
+#ifndef _OPENACC
+PD_M3_THR_W2R_O_DDTDZ = D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE)
+#else
+!$acc data present(PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
+CALL D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLM,PLEPS,PTKE,PD_M3_THR_W2R_O_DDTDZ)
+!$acc end data
+#endif
+!
+#ifndef _OPENACC
END FUNCTION D_M3_THR_W2R_O_DDTDZ
+#else
+END SUBROUTINE D_M3_THR_W2R_O_DDTDZ
+#endif
!----------------------------------------------------------------------------
!
END MODULE MODE_PRANDTL
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index becf21fdf5e42b50ecb8526ab9ac2b8a368ad703..e7895d7f2b145824b2f11ceaa743caa6cbb2370a 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1353,7 +1353,7 @@ END IF
XTSTEP,HFMFILE,CLUOUT, &
XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
- XRHODJ,XTHVREF,XRHODREF, &
+ XRHODJ,XTHVREF, &
ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV, &
XPABST,XUT,XVT,XWT,XTKET,XSVT,XSRCT,XBL_DEPTH,XSBL_DEPTH, &
XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
diff --git a/src/MNH/ppm.f90 b/src/MNH/ppm.f90
index 7f52edc77ef6ea6067c55bd8907c85db255d44df..d48a21a7ea45384653608c675326e1bb5331e7a4 100644
--- a/src/MNH/ppm.f90
+++ b/src/MNH/ppm.f90
@@ -8,166 +8,347 @@
! $Source$ $Revision$
! masdev4_7 BUG1 2007/06/15 17:47:18
!-----------------------------------------------------------------
+#ifdef _OPENACC
+!
+! inline shuman with macro
+!
+!#define dxf(PDXF,PA) PDXF(1:IIU-1,:,:) = PA(2:IIU,:,:) - PA(1:IIU-1,:,:) ; PDXF(IIU,:,:) = PDXF(2*JPHEXT,:,:) ! DXF(PDXF,PA)
+!#define dyf(PDYF,PA) PDYF(:,1:IJU-1,:) = PA(:,2:IJU,:) - PA(:,1:IJU-1,:); PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:) ! DYF(PDYF,PA)
+!!#define dyf(PDYF,PA) PDYF(1:IIU,1:IJU-1,IKB:IKE) = PA(1:IIU,2:IJU,IKB:IKE) - PA(1:IIU,1:IJU-1,IKB:IKE); ! PDYF(1:IIU,IJU,IKB:IKE) = PDYF(1:IIU,2*JPHEXT,IKB:IKE) ! DYF(PDYF,PA)
+!#define dzf(PDZF,PA) PDZF(:,:,1:IKU-1) = PA(:,:,2:IKU) - PA(:,:,1:IKU-1) ; PDZF(:,:,IKU) = -999. ! DZF(PDZF,PA)
+!
+!#define mxm(PMXM,PA) PMXM(2:IIU,:,:) = 0.5*( PA(2:IIU,:,:)+PA(1:IIU-1,:,:) ) ; PMXM(1,:,:) = PMXM(IIU-2*JPHEXT+1,:,:) ! MXM(PMXM,PA)
+!!#define mym(PMYM,PA) PMYM(1:IIU,2:IJU,IKB:IKE) = 0.5*( PA(1:IIU,2:IJU,IKB:IKE)+PA(1:IIU,1:IJU-1,IKB:IKE) ) ; ! PMYM(1:IIU,1,IKB:IKE) = PMYM(1:IIU,IJU-2*JPHEXT+1,IKB:IKE) ! MYM(PMYM,PA)
+!#define mzm(PMZM,PA) PMZM(:,:,2:IKU) = 0.5*( PA(:,:,2:IKU)+PA(:,:,1:IKU-1) ) ; PMZM(:,:,1) = -999. ! MZM(PMZM,PA)
+!#define mym(PMYM,PA) PMYM(:,2:IJU,:) = 0.5*( PA(:,2:IJU,:)+PA(:,1:IJU-1,:) ) ; PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:) ! MYM(PMYM,PA)
+!
+#define dif2x(DQ,PQ) DQ(IIB:IIE,:,:)=0.5*(PQ(IIB+1:IIE+1,:,:)-PQ(IIB-1:IIE-1,:,:));\
+DQ(IIB-1,:,:)=0.5*(PQ(IIB,:,:)-PQ(IIE-1,:,:));\
+DQ(IIE+1,:,:)=0.5*(PQ(IIB+1,:,:)-PQ(IIE,:,:)) ! DIF2X(DQ,PQ)
+!
+#define dif2y(DQ,PQ) DQ(1:IIU,IJB:IJE,IKB:IKE) = 0.5*(PQ(1:IIU,IJB+1:IJE+1,IKB:IKE) - PQ(1:IIU,IJB-1:IJE-1,IKB:IKE)) ; !
+! DQ(1:IIU,IJB-1,IKB:IKE) = 0.5*(PQ(1:IIU,IJB,IKB:IKE) - PQ(1:IIU,IJE-1,IKB:IKE)) ; \
+DQ(1:IIU,IJE+1,IKB:IKE) = 0.5*(PQ(1:IIU,IJB+1,IKB:IKE) - PQ(1:IIU,IJE,IKB:IKE)) ! DIF2Y(DQ,PQ)
+!
+#define dif2z(DQ,PQ) DQ(:,:,IKB:IKE) = 0.5*(PQ(:,:,IKB+1:IKE+1) - PQ(:,:,IKB-1:IKE-1)) ; \
+DQ(:,:,IKB-1) = -DQ(:,:,IKB) ;\
+DQ(:,:,IKE+1) = -DQ(:,:,IKE) ! DIF2Z(DQ,PQ)
+!
+#endif
! ###############
MODULE MODI_PPM
! ###############
!
INTERFACE
!
-FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+#ifndef _OPENACC
+FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_01_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_01_X
+#else
+END SUBROUTINE PPM_01_X
+#endif
!
-FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+!
+#ifndef _OPENACC
+FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_01_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_01_Y
+#else
+END SUBROUTINE PPM_01_Y
+#endif
!
-FUNCTION PPM_01_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) RESULT(PR)
+#ifndef _OPENACC
+FUNCTION PPM_01_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) RESULT(PR)
+#else
+SUBROUTINE PPM_01_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+#endif
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_01_Z
+#else
+END SUBROUTINE PPM_01_Z
+#endif
!
-FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+#ifndef _OPENACC
+FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_S0_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP &
+ , PR)
+#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S0_X
+#else
+END SUBROUTINE PPM_S0_X
+#endif
!
-FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+#ifndef _OPENACC
+FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_S0_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP &
+ , PR)
+#endif
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S0_Y
+#else
+END SUBROUTINE PPM_S0_Y
+#endif
!
-FUNCTION PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) &
+#ifndef _OPENACC
+FUNCTION PPM_S0_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_S0_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP &
+ , PR)
+#endif
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S0_Z
+#else
+END SUBROUTINE PPM_S0_Z
+#endif
!
-FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
+#ifndef _OPENACC
+FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
+#else
+SUBROUTINE PPM_S1_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR)
+#endif
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S1_X
+#else
+END SUBROUTINE PPM_S1_X
+#endif
!
-FUNCTION PPM_S1_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
+#ifndef _OPENACC
+FUNCTION PPM_S1_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
+#else
+SUBROUTINE PPM_S1_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR)
+#endif
!
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S1_Y
+#else
+END SUBROUTINE PPM_S1_Y
+#endif
!
-FUNCTION PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP) &
+#ifndef _OPENACC
+FUNCTION PPM_S1_Z(KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP) &
RESULT(PR)
+#else
+SUBROUTINE PPM_S1_Z(KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP, &
+ PR)
+#endif
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
-!
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
+!
+#ifndef _OPENACC
END FUNCTION PPM_S1_Z
+#else
+END SUBROUTINE PPM_S1_Z
+#endif
!
END INTERFACE
!
@@ -175,11 +356,63 @@ END MODULE MODI_PPM
!
!
!-------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
+!
+#ifdef _OPENACC
+! ########################################################################
+!!$ FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
+!!$ RESULT(PR)
+ SUBROUTINE PPM_01_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
! ########################################################################
- FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
+
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
+
+ CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+
+ CALL PPM_01_X_D(IIU,IJU,IKU,HLBCX, KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
+ & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
+ & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
+
+ CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+!
+CONTAINS
+!
+! ########################################################################
+ SUBROUTINE PPM_01_X_D(IIU,IJU,IKU,HLBCX, KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+
+! ########################################################################
+#else
+! ########################################################################
+ FUNCTION PPM_01_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_01_X - PPM_01 fully monotonic PPM advection scheme in X direction
!! Colella notation
@@ -194,7 +427,11 @@ END MODULE MODI_PPM
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_CONF
@@ -202,44 +439,76 @@ USE MODD_CONF
!BEG JUAN PPM_LL
USE MODD_LUNIT
!END JUAN PPM_LL
+USE MODE_MPPDB
+#ifdef _OPENACC
+USE MODD_PARAMETERS, ONLY : JPHEXT
+#endif
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+#ifdef _OPENACC
+INTEGER , INTENT(IN) :: IIU,IJU,IKU
+#endif
CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(IIU,IJU,IKU), INTENT(INOUT) :: PR
+!$acc declare present (PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
!
+#ifndef _OPENACC
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDQ,ZQ6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDMQ
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL,ZQR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDQ,ZQ6
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDMQ
!
! extra variables for the initial guess of parabolae parameters
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL0,ZQR0,ZQ60
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL0,ZQR0,ZQ60
!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
!
!BEG JUAN PPM_LL
-INTEGER :: ILUOUT,IRESP ! for prints
INTEGER :: IJS,IJN
!END JUAN PPM_LL
+#else
+INTEGER :: I,J,K
+!
+!!$!
+!!$! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+REAL , DIMENSION(IIU,IJU,IKU) :: &
+ ZQL,ZQR, ZDQ,ZQ6, ZDMQ &
+!!$!
+!!$! extra variables for the initial guess of parabolae parameters
+ , ZQL0,ZQR0,ZQ60 &
+!!$!
+!!$! advection fluxes
+ , ZFPOS, ZFNEG
+!$acc declare present (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+!
+INTEGER :: IJS,IJN
+#endif
+LOGICAL :: GWEST , GEAST
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
@@ -249,31 +518,29 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IJS=IJB
IJN=IJE
!
+GWEST = LWEST_ll()
+GEAST = LEAST_ll()
+!
!BEG JUAN PPM_LL
!
!* initialise & update halo & halo2 for PSRC
!
-!!$IF(NHALO /= 1) THEN
-!!$ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
-!!$ WRITE(ILUOUT,*) 'ERROR : PPM ppm_met.f90 --> Juan '
-!!$ WRITE(ILUOUT,*) 'PPM not yet implemented/tested with NHALO /= 1'
-!!$ !callabortstop
-!!$ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
-!!$ CALL ABORT
-!!$ STOP
-!!$ENDIF
+#ifndef _OPENACC
CALL GET_HALO(PSRC)
-PR=PSRC
-ZQL=PSRC
-ZQR=PSRC
-ZDQ=PSRC
-ZQ6=PSRC
-ZDMQ=PSRC
-ZQL0=PSRC
-ZQR0=PSRC
-ZQ60=PSRC
+!
ZFPOS=PSRC
ZFNEG=PSRC
+#else
+CALL GET_HALO_D(PSRC,HDIR="01_X")
+!
+!$acc kernels
+ZFPOS(:,1:IJS,:)=PSRC(:,1:IJS,:)
+ZFNEG(:,1:IJS,:)=PSRC(:,1:IJS,:)
+!
+ZFPOS(:,IJN:,:)=PSRC(:,IJN:,:)
+ZFNEG(:,IJN:,:)=PSRC(:,IJN:,:)
+!$acc end kernels
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -283,9 +550,16 @@ SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
! -----------------------------------------
!
CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_01_X CYCL/WALL boundaries not yet implemented'
+#endif
!
! calculate dmq
+#ifndef _OPENACC
ZDMQ = DIF2X(PSRC)
+#else
+ dif2x(ZDMQ,PSRC)
+#endif
!
! monotonize the difference followinq eq. 5 in Lin94
!
@@ -373,10 +647,10 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
!
! and finally calculate fluxes for the advection
!
-! ZFPOS(i) = Fct[ ZQR(i-1),PCR(i),ZDQ(i-1),ZQ6(i-1) ]
+! ZFPOS(i) = Fct[ ZQR(i-1),ZCR(i),ZDQ(i-1),ZQ6(i-1) ]
!
- ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZQR(IIB-1:IIE,IJS:IJN,:) - 0.5*PCR(IIB:IIE+1,IJS:IJN,:) * &
- (ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*PCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
+ ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZQR(IIB-1:IIE,IJS:IJN,:) - 0.5*ZCR(IIB:IIE+1,IJS:IJN,:) * &
+ (ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*ZCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
* ZQ6(IIB-1:IIE,IJS:IJN,:))
!
CALL GET_HALO(ZFPOS)
@@ -387,15 +661,20 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
! we set it to 0
!!$ ZFPOS(IIB-1,:,:) = 0.0 JUANPPMLL01
!
- ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*PCR(:,IJS:IJN,:) * &
- ( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*PCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
+ ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*ZCR(:,IJS:IJN,:) * &
+ ( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*ZCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
!
CALL GET_HALO(ZFNEG)
!
! advect the actual field in X direction by U*dt
!
- PR = DXF( PCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+#ifndef _OPENACC
+ PR = DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+PRINT *,'not yet implemented'
+STOP
+#endif
CALL GET_HALO(PR)
!
!
@@ -406,20 +685,25 @@ CASE('OPEN')
!
! calculate dmq
!
+!$acc kernels
+#ifndef _OPENACC
ZDMQ = DIF2X(PSRC)
+#else
+ dif2x(ZDMQ,PSRC)
+#endif
!
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
!
! WEST BOUND
!
- IF (LWEST_ll()) THEN
+ IF (GWEST) THEN
ZDMQ(IIB-1,IJS:IJN,:) = -ZDMQ(IIB,IJS:IJN,:)
ENDIF
!
! EAST BOUND
!
- IF (LEAST_ll()) THEN
+ IF (GEAST) THEN
ZDMQ(IIE+1,IJS:IJN,:) = -ZDMQ(IIE,IJS:IJN,:)
ENDIF
!
@@ -452,7 +736,13 @@ CASE('OPEN')
!
! update ZDMQ HALO before next/further utilisation
!
+#ifndef _OPENACC
CALL GET_HALO(ZDMQ)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZDMQ,HDIR="01_X")
+#endif
+!$acc kernels
!
! calculate qL and qR
!
@@ -461,23 +751,36 @@ CASE('OPEN')
ZQL0(IIB:IIE+1,IJS:IJN,:) = 0.5*(PSRC(IIB:IIE+1,IJS:IJN,:) + PSRC(IIB-1:IIE,IJS:IJN,:)) - &
(ZDMQ(IIB:IIE+1,IJS:IJN,:) - ZDMQ(IIB-1:IIE,IJS:IJN,:))/6.0
!
+#ifndef _OPENACC
CALL GET_HALO(ZQL0)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZQL0,HDIR="01_X")
+!$acc kernels
+#endif
!
! WEST BOUND
!
- IF (LWEST_ll()) THEN
+ IF (GWEST) THEN
ZQL0(IIB-1,IJS:IJN,:) = ZQL0(IIB,IJS:IJN,:)
ENDIF
!
ZQR0(IIB-1:IIE,IJS:IJN,:) = ZQL0(IIB:IIE+1,IJS:IJN,:)
!
+#ifndef _OPENACC
CALL GET_HALO(ZQR0)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZQR0,HDIR="01_X")
+!$acc kernels
+#endif
!
! EAST BOUND
!
- IF (LEAST_ll()) THEN
+ IF (GEAST) THEN
ZQR0(IIE+1,IJS:IJN,:) = ZQR0(IIE,IJS:IJN,:)
ENDIF
+#ifndef _OPENACC
!
! determine initial coefficients of the parabolae
!
@@ -488,7 +791,7 @@ CASE('OPEN')
!
ZQL = ZQL0
ZQR = ZQR0
- ZQ6 = ZQ60
+ ZQ6 = ZQ60
!
! eliminate over and undershoots and create qL and qR as in Lin96
!
@@ -509,59 +812,122 @@ CASE('OPEN')
! recalculate coefficients of the parabolae
!
ZDQ = ZQR - ZQL
+#else
+DO K=1,IKU
+ DO J = 1,IJU
+ ! acc loop vector(24)
+ DO I=1,IIU
+!
+! determine initial coefficients of the parabolae
+!
+ ZDQ (I,J,K)= ZQR0(I,J,K) - ZQL0(I,J,K)
+ ZQ60(I,J,K) = 6.0*(PSRC(I,J,K) - 0.5*(ZQL0(I,J,K) + ZQR0(I,J,K)))
+!
+! initialize final parabolae parameters
+!
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ ZQ6(I,J,K) = ZQ60(I,J,K)
+!
+! eliminate over and undershoots and create qL and qR as in Lin96
+!
+ IF ( ZDMQ(I,J,K) == 0.0 ) THEN
+ ZQL(I,J,K) = PSRC(I,J,K)
+ ZQR(I,J,K) = PSRC(I,J,K)
+ ZQ6(I,J,K) = 0.0
+ ELSEIF ( ZQ60(I,J,K)*ZDQ(I,J,K) < -(ZDQ(I,J,K))**2 ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQL0(I,J,K) - PSRC(I,J,K))
+ ZQR(I,J,K) = ZQL0(I,J,K) - ZQ6(I,J,K)
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ ELSEIF ( ZQ60(I,J,K)*ZDQ(I,J,K) > (ZDQ(I,J,K))**2 ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQR0(I,J,K) - PSRC(I,J,K))
+ ZQL(I,J,K) = ZQR0(I,J,K) - ZQ6(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ ENDIF
+!
+! recalculate coefficients of the parabolae
+!
+ ZDQ(I,J,K) = ZQR(I,J,K) - ZQL(I,J,K)
+ENDDO ; ENDDO ; ENDDO
+#endif
!
! and finally calculate fluxes for the advection
!
!
-! ZFPOS(i) = Fct[ ZQR(i-1),PCR(i),ZDQ(i-1),ZQ6(i-1) ]
+! ZFPOS(i) = Fct[ ZQR(i-1),ZCR(i),ZDQ(i-1),ZQ6(i-1) ]
!
-!!$ ZFPOS(IIB+1:IIE+1,:,:) = ZQR(IIB:IIE,:,:) - 0.5*PCR(IIB+1:IIE+1,:,:) * &
-!!$ (ZDQ(IIB:IIE,:,:) - (1.0 - 2.0*PCR(IIB+1:IIE+1,:,:)/3.0) &
+!!$ ZFPOS(IIB+1:IIE+1,:,:) = ZQR(IIB:IIE,:,:) - 0.5*ZCR(IIB+1:IIE+1,:,:) * &
+!!$ (ZDQ(IIB:IIE,:,:) - (1.0 - 2.0*ZCR(IIB+1:IIE+1,:,:)/3.0) &
!!$ * ZQ6(IIB:IIE,:,:))
- ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZQR(IIB-1:IIE,IJS:IJN,:) - 0.5*PCR(IIB:IIE+1,IJS:IJN,:) * &
- (ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*PCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
+
+ ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZQR(IIB-1:IIE,IJS:IJN,:) - 0.5*ZCR(IIB:IIE+1,IJS:IJN,:) * &
+ (ZDQ(IIB-1:IIE,IJS:IJN,:) - (1.0 - 2.0*ZCR(IIB:IIE+1,IJS:IJN,:)/3.0) &
* ZQ6(IIB-1:IIE,IJS:IJN,:))
!
+#ifndef _OPENACC
CALL GET_HALO(ZFPOS)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZFPOS,HDIR="01_X")
+!$acc kernels
+#endif
!
!
! WEST BOUND
!
! advection flux at open boundary when u(IIB) > 0
!
- IF (LWEST_ll()) THEN
- ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZQR(IIB-1,IJS:IJN,:))*PCR(IIB,IJS:IJN,:) + &
+ IF (GWEST) THEN
+ ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZQR(IIB-1,IJS:IJN,:))*ZCR(IIB,IJS:IJN,:) + &
ZQR(IIB-1,IJS:IJN,:)
! PPOSX(IIB-1,:,:) is not important for the calc of advection so
! we set it to 0
!!$ ZFPOS(IIB-1,:,:) = 0.0
ENDIF
!
-!!$ ZFNEG(IIB-1:IIE,:,:) = ZQL(IIB-1:IIE,:,:) - 0.5*PCR(IIB-1:IIE,:,:) * &
-!!$ (ZDQ(IIB-1:IIE,:,:) + (1.0 + 2.0*PCR(IIB-1:IIE,:,:)/3.0) &
+!!$ ZFNEG(IIB-1:IIE,:,:) = ZQL(IIB-1:IIE,:,:) - 0.5*ZCR(IIB-1:IIE,:,:) * &
+!!$ (ZDQ(IIB-1:IIE,:,:) + (1.0 + 2.0*ZCR(IIB-1:IIE,:,:)/3.0) &
!!$ * ZQ6(IIB-1:IIE,:,:))
- ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*PCR(:,IJS:IJN,:) * &
- ( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*PCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
+ ZFNEG(:,IJS:IJN,:) = ZQL(:,IJS:IJN,:) - 0.5*ZCR(:,IJS:IJN,:) * &
+ ( ZDQ(:,IJS:IJN,:) + (1.0 + 2.0*ZCR(:,IJS:IJN,:)/3.0) * ZQ6(:,IJS:IJN,:) )
!
+#ifndef _OPENACC
CALL GET_HALO(ZFNEG)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZFNEG,HDIR="01_X")
+!$acc kernels
+#endif
!
! EAST BOUND
!
! advection flux at open boundary when u(IIE+1) < 0
- IF (LEAST_ll()) THEN
- ZFNEG(IIE+1,IJS:IJN,:) = (ZQR(IIE,IJS:IJN,:)-PSRC(IIE+1,IJS:IJN,:))*PCR(IIE+1,IJS:IJN,:) + &
+ IF (GEAST) THEN
+ ZFNEG(IIE+1,IJS:IJN,:) = (ZQR(IIE,IJS:IJN,:)-PSRC(IIE+1,IJS:IJN,:))*ZCR(IIE+1,IJS:IJN,:) + &
ZQR(IIE,IJS:IJN,:)
ENDIF
!
! advect the actual field in X direction by U*dt
!
- PR = DXF( PCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+#ifndef _OPENACC
+ PR = DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
CALL GET_HALO(PR)
-!
+#else
+ !mxm(ZQL,PRHO)
+!$acc end kernels
+ CALL MXM_DEVICE(PRHO,ZQL)
+!$acc kernels
+ ZQR = ZCR* ZQL *( ZFPOS*(0.5+SIGN(0.5,ZCR)) + ZFNEG*(0.5-SIGN(0.5,ZCR)) )
+ !dxf(PR,ZQR)
+!$acc end kernels
+ CALL DXF_DEVICE(ZQR,PR)
+ CALL GET_HALO_D(PR,HDIR="01_X")
+#endif
!
END SELECT
!
+#ifndef _OPENACC
CONTAINS
!
!-------------------------------------------------------------------------------
@@ -617,17 +983,75 @@ DQ(IIE+1,:,:) = PQ(IIB+1,:,:) - PQ(IIE,:,:)
DQ = 0.5*DQ
!
END FUNCTION DIF2X
+#endif
!
+#ifdef _OPENACC
+END SUBROUTINE PPM_01_X_D
+
+END SUBROUTINE PPM_01_X
+#else
END FUNCTION PPM_01_X
+#endif
!
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+! ########################################################################
+!!$ FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
+!!$ RESULT(PR)
+ SUBROUTINE PPM_01_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
! ########################################################################
- FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
+
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR & ! Courant number
+ , PRHO ! density
+!$acc declare present(ZCR,PRHO)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
+
+ CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+
+ CALL PPM_01_Y_D(IIU,IJU,IKU,HLBCY, KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
+ & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
+ & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
+
+ CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+!
+CONTAINS
+!
+! ########################################################################
+ SUBROUTINE PPM_01_Y_D(IIU,IJU,IKU,HLBCY, KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+
+! ########################################################################
+#else
+! ########################################################################
+ FUNCTION PPM_01_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_01_Y - PPM_01 fully monotonic PPM advection scheme in Y direction
!! Colella notation
@@ -642,7 +1066,11 @@ END FUNCTION PPM_01_X
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_CONF
@@ -650,6 +1078,10 @@ USE MODD_CONF
!BEG JUAN PPM_LL
USE MODD_LUNIT
!END JUAN PPM_LL
+#ifdef _OPENACC
+USE MODD_PARAMETERS, ONLY : JPHEXT
+#endif
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -659,35 +1091,63 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(ZCR,PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(IIU,IJU,IKU), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
!
+INTEGER :: IIW,IIA
+!
+LOGICAL :: GSOUTH , GNORTH
+#ifndef _OPENACC
+!
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDQ,ZQ6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDMQ
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL,ZQR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDQ,ZQ6
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDMQ
!
! extra variables for the initial guess of parabolae parameters
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL0,ZQR0,ZQ60
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL0,ZQR0,ZQ60
!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
!
!BEG JUAN PPM_LL
-INTEGER :: ILUOUT,IRESP ! for prints
-INTEGER :: IIW,IIA
!END JUAN PPM_LL
+#else
+! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+REAL, DIMENSION(IIU,IJU,IKU) :: &
+ ZQL,ZQR , ZDQ,ZQ6 , ZDMQ &
+! extra variables for the initial guess of parabolae parameters
+ , ZQL0,ZQR0,ZQ60 &
+! advection fluxes
+ , ZFPOS, ZFNEG
+!$acc declare present (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+
+!
+!JUAN ACC
+INTEGER :: I,J,K ,IIU,IJU,IKU
+!
+INTEGER :: IKB,IKE
+INTEGER :: IJN,IJS
+!JUAN ACC
+#endif
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
@@ -696,32 +1156,42 @@ INTEGER :: IIW,IIA
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IIW=IIB
IIA=IIE
-!!$IF(NHALO /= 1) THEN
-!!$ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
-!!$ WRITE(ILUOUT,*) 'ERROR : PPM ppm_met.f90 --> Juan '
-!!$ WRITE(ILUOUT,*) 'PPM not yet implemented/tested with NHALO /= 1'
-!!$ !callabortstop
-!!$ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
-!!$ CALL ABORT
-!!$ STOP
-!!$ENDIF
+!
+GSOUTH=LSOUTH_ll()
+GNORTH=LNORTH_ll()
+!
+#ifndef _OPENACC
CALL GET_HALO(PSRC)
-
+#else
+IJS=1
+IJN=IJU
+IKB=1
+IKE=IKU
+!
+! For HALO >=2 all possible domaine computed
+!
+!IJB=2
+!IJE=IJU-1
+!IIB=2
+!IIE=IIU-1
+!
+CALL GET_HALO_D(PSRC,HDIR="01_Y")
+#endif
!
!-------------------------------------------------------------------------------
!
!
-PR=PSRC
-ZQL=PSRC
-ZQR=PSRC
-ZDQ=PSRC
-ZQ6=PSRC
-ZDMQ=PSRC
-ZQL0=PSRC
-ZQR0=PSRC
-ZQ60=PSRC
+#ifndef _OPENACC
ZFPOS=PSRC
ZFNEG=PSRC
+#else
+!$acc kernels
+ZFPOS(1:IIW,:,IKB:IKE)=PSRC(1:IIW,:,IKB:IKE)
+ZFNEG(1:IIW,:,IKB:IKE)=PSRC(1:IIW,:,IKB:IKE)
+ZFPOS(IIA:,:,IKB:IKE)=PSRC(IIA:,:,IKB:IKE)
+ZFNEG(IIA:,:,IKB:IKE)=PSRC(IIA:,:,IKB:IKE)
+!$acc end kernels
+#endif
!
SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
!
@@ -729,9 +1199,16 @@ SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
! ---------------------------------------------
!
CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_01_Y CYCL/WALL boundaries not yet implemented'
+#endif
!
! calculate dmq
+#ifndef _OPENACC
ZDMQ = DIF2Y(PSRC)
+#else
+ dif2y(ZDMQ,PSRC)
+#endif
!
! monotonize the difference followinq eq. 5 in Lin94
!BEG JUAN PPM_LL01
@@ -816,10 +1293,10 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
! and finally calculate fluxes for the advection
!
-! ZFPOS(j) = Fct[ ZQR(j-1),PCR(i),ZDQ(j-1),ZQ6(j-1) ]
+! ZFPOS(j) = Fct[ ZQR(j-1),ZCR(i),ZDQ(j-1),ZQ6(j-1) ]
!
- ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZQR(IIW:IIA,IJB-1:IJE,:) - 0.5*PCR(IIW:IIA,IJB:IJE+1,:) * &
- (ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*PCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
+ ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZQR(IIW:IIA,IJB-1:IJE,:) - 0.5*ZCR(IIW:IIA,IJB:IJE+1,:) * &
+ (ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*ZCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
* ZQ6(IIW:IIA,IJB-1:IJE,:))
!
CALL GET_HALO(ZFPOS)
@@ -830,15 +1307,20 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
! we set it to 0
!!$ ZFPOS(:,IJB-1,:) = 0.0 JUANPPMLL01
!
- ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*PCR(IIW:IIA,:,:) * &
- ( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*PCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
+ ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*ZCR(IIW:IIA,:,:) * &
+ ( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*ZCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
!
CALL GET_HALO(ZFNEG)
!
! advect the actual field in Y direction by V*dt
!
- PR = DYF( PCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+#ifndef _OPENACC
+ PR = DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+PRINT *,'not yet implemented'
+STOP
+#endif
CALL GET_HALO(PR)
!
!* 2.2 NON-CYCLIC BOUNDARY CONDITIONS IN THE Y DIRECTION
@@ -846,20 +1328,25 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
!
CASE('OPEN')
!
+#ifndef _OPENACC
! calculate dmq
ZDMQ = DIF2Y(PSRC)
+#else
+!$acc kernels
+ dif2y(ZDMQ,PSRC)
+#endif
! overwrite the values on the boundary to get second order difference
! for qL and qR at the boundary
!
! SOUTH BOUND
!
- IF (LSOUTH_ll()) THEN
+ IF (GSOUTH) THEN
ZDMQ(IIW:IIA,IJB-1,:) = -ZDMQ(IIW:IIA,IJB,:)
ENDIF
!
! NORTH BOUND
!
- IF (LNORTH_ll()) THEN
+ IF (GNORTH) THEN
ZDMQ(IIW:IIA,IJE+1,:) = -ZDMQ(IIW:IIA,IJE,:)
ENDIF
!
@@ -882,18 +1369,30 @@ CASE('OPEN')
!
! update ZDMQ HALO before next/further utilisation
!
+#ifndef _OPENACC
CALL GET_HALO(ZDMQ)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZDMQ,HDIR="01_Y")
+!$acc kernels
+#endif
!
! calculate qL and qR with the modified dmq
!
ZQL0(IIW:IIA,IJB:IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJB:IJE+1,:) + PSRC(IIW:IIA,IJB-1:IJE,:)) - &
(ZDMQ(IIW:IIA,IJB:IJE+1,:) - ZDMQ(IIW:IIA,IJB-1:IJE,:))/6.0
!
+#ifndef _OPENACC
CALL GET_HALO(ZQL0)
+#else
+!$acc end kernels
+CALL GET_HALO_D(ZQL0,HDIR="01_Y")
+!$acc kernels
+#endif
!
! SOUTH BOUND
!
- IF (LSOUTH_ll()) THEN
+ IF (GSOUTH) THEN
ZQL0(IIW:IIA,IJB-1,:) = ZQL0(IIW:IIA,IJB,:)
ENDIF
!
@@ -901,9 +1400,10 @@ CASE('OPEN')
!
! NORTH BOUND
!
- IF (LNORTH_ll()) THEN
+ IF (GNORTH) THEN
ZQR0(IIW:IIA,IJE+1,:) = ZQR0(IIW:IIA,IJE,:)
ENDIF
+#ifndef _OPENACC
!
! determine initial coefficients of the parabolae
!
@@ -936,23 +1436,78 @@ CASE('OPEN')
!
ZDQ = ZQR - ZQL
!
+#else
+ !$acc loop gang vector
+ DO K=IKB,IKE
+ !$acc loop gang vector
+ DO J=IJS,IJN
+ !$acc loop gang vector
+ DO I=1,IIU
+ !
+ ! determine initial coefficients of the parabolae
+ !
+ ZDQ(I,J,K) = ZQR0(I,J,K) - ZQL0(I,J,K)
+ ZQ60(I,J,K) = 6.0*(PSRC(I,J,K) - 0.5*(ZQL0(I,J,K) + ZQR0(I,J,K)))
+ !
+ ! initialize final parabolae parameters
+ !
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ ZQ6(I,J,K) = ZQ60(I,J,K)
+ !
+ ! eliminate over and undershoots and create qL and qR as in Lin96
+ !
+ IF ( ZDMQ(I,J,K) == 0.0 ) THEN
+ ZQL(I,J,K) = PSRC(I,J,K)
+ ZQR(I,J,K) = PSRC(I,J,K)
+ ZQ6(I,J,K) = 0.0
+ END IF
+ IF ( ( ZDMQ(I,J,K) /= 0.0 ) .AND. ( ZQ60(I,J,K)*ZDQ(I,J,K) < -(ZDQ(I,J,K))**2 ) ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQL0(I,J,K) - PSRC(I,J,K))
+ ZQR(I,J,K) = ZQL0(I,J,K) - ZQ6(I,J,K)
+ ZQL(I,J,K) = ZQL0(I,J,K)
+ END IF
+ IF ( ( ZDMQ(I,J,K) /= 0.0 ) .AND. ( ZQ60(I,J,K)*ZDQ(I,J,K) > (ZDQ(I,J,K))**2 ) ) THEN
+ ZQ6(I,J,K) = 3.0*(ZQR0(I,J,K) - PSRC(I,J,K))
+ ZQL(I,J,K) = ZQR0(I,J,K) - ZQ6(I,J,K)
+ ZQR(I,J,K) = ZQR0(I,J,K)
+ END IF
+ !
+ ! recalculate coefficients of the parabolae
+ !
+ ZDQ(I,J,K) = ZQR(I,J,K) - ZQL(I,J,K)
+ !
+ END DO
+ END DO
+ END DO
+#endif
+!
! and finally calculate fluxes for the advection
-!!$ ZFPOS(:,IJB+1:IJE+1,:) = ZQR(:,IJB:IJE,:) - 0.5*PCR(:,IJB+1:IJE+1,:) * &
-!!$ (ZDQ(:,IJB:IJE,:) - (1.0 - 2.0*PCR(:,IJB+1:IJE+1,:)/3.0) &
+!
+!!$ ZFPOS(:,IJB+1:IJE+1,:) = ZQR(:,IJB:IJE,:) - 0.5*ZCR(:,IJB+1:IJE+1,:) * &
+!!$ (ZDQ(:,IJB:IJE,:) - (1.0 - 2.0*ZCR(:,IJB+1:IJE+1,:)/3.0) &
!!$ * ZQ6(:,IJB:IJE,:))
- ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZQR(IIW:IIA,IJB-1:IJE,:) - 0.5*PCR(IIW:IIA,IJB:IJE+1,:) * &
- (ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*PCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
+ ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZQR(IIW:IIA,IJB-1:IJE,:) - 0.5*ZCR(IIW:IIA,IJB:IJE+1,:) * &
+ (ZDQ(IIW:IIA,IJB-1:IJE,:) - (1.0 - 2.0*ZCR(IIW:IIA,IJB:IJE+1,:)/3.0) &
* ZQ6(IIW:IIA,IJB-1:IJE,:))
!
+#ifndef _OPENACC
CALL GET_HALO(ZFPOS)
+#else
+!$acc end kernels
+CALL GET_HALO_D(ZFPOS,HDIR="01_Y")
+!$acc kernels
+#endif
+
+
!
!
! advection flux at open boundary when u(IJB) > 0
!
! SOUTH BOUND
!
- IF (LSOUTH_ll()) THEN
- ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZQR(IIW:IIA,IJB-1,:))*PCR(IIW:IIA,IJB,:) + &
+ IF (GSOUTH) THEN
+ ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZQR(IIW:IIA,IJB-1,:))*ZCR(IIW:IIA,IJB,:) + &
ZQR(IIW:IIA,IJB-1,:)
ENDIF
!
@@ -960,33 +1515,62 @@ CASE('OPEN')
! we set it to 0
!!$ ZFPOS(:,IJB-1,:) = 0.0 ! JUAN PPMLL01
!
-!!$ ZFNEG(:,IJB-1:IJE,:) = ZQL(:,IJB-1:IJE,:) - 0.5*PCR(:,IJB-1:IJE,:) * &
-!!$ ( ZDQ(:,IJB-1:IJE,:) + (1.0 + 2.0*PCR(:,IJB-1:IJE,:)/3.0) * &
+!!$ ZFNEG(:,IJB-1:IJE,:) = ZQL(:,IJB-1:IJE,:) - 0.5*ZCR(:,IJB-1:IJE,:) * &
+!!$ ( ZDQ(:,IJB-1:IJE,:) + (1.0 + 2.0*ZCR(:,IJB-1:IJE,:)/3.0) * &
!!$ ZQ6(:,IJB-1:IJE,:) )
- ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*PCR(IIW:IIA,:,:) * &
- ( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*PCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
+ ZFNEG(IIW:IIA,:,:) = ZQL(IIW:IIA,:,:) - 0.5*ZCR(IIW:IIA,:,:) * &
+ ( ZDQ(IIW:IIA,:,:) + (1.0 + 2.0*ZCR(IIW:IIA,:,:)/3.0) * ZQ6(IIW:IIA,:,:) )
!
+#ifndef _OPENACC
CALL GET_HALO(ZFNEG)
+#else
+!$acc end kernels
+ CALL GET_HALO_D(ZFNEG,HDIR="01_Y")
+!$acc kernels
+#endif
!
! advection flux at open boundary when u(IJE+1) < 0
!
! NORTH BOUND
!
- IF (LNORTH_ll()) THEN
- ZFNEG(IIW:IIA,IJE+1,:) = (ZQR(IIW:IIA,IJE,:)-PSRC(IIW:IIA,IJE+1,:))*PCR(IIW:IIA,IJE+1,:) + &
+ IF (GNORTH) THEN
+ ZFNEG(IIW:IIA,IJE+1,:) = (ZQR(IIW:IIA,IJE,:)-PSRC(IIW:IIA,IJE+1,:))*ZCR(IIW:IIA,IJE+1,:) + &
ZQR(IIW:IIA,IJE,:)
ENDIF
+#ifndef _OPENACC
!
! advect the actual field in X direction by U*dt
!
- PR = DYF( PCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ PR = DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+!
+#else
+!$acc end kernels
+ CALL MYM_DEVICE(PRHO,ZQL)
+!$acc kernels
+ DO K=IKB,IKE
+ DO J=IJS,IJN
+ DO I=1,IIU
+ ZQR(I,J,K) = ZCR(I,J,K)* ZQL(I,J,K) &
+ * ( ZFPOS(I,J,K)*(0.5+SIGN(0.5,ZCR(I,J,K))) &
+ + ZFNEG(I,J,K)*(0.5-SIGN(0.5,ZCR(I,J,K))) )
+ END DO
+ END DO
+ END DO
+!$acc end kernels
+ CALL DYF_DEVICE(ZQR,PR)
+#endif
!
+#ifndef _OPENACC
CALL GET_HALO(PR)
+#else
+ CALL GET_HALO_D(PR,HDIR="01_Y")
+#endif
!
!
END SELECT
!
+#ifndef _OPENACC
CONTAINS
!
!-------------------------------------------------------------------------------
@@ -1044,16 +1628,71 @@ DQ(:,IJE+1,:) = PQ(:,IJB+1,:) - PQ(:,IJE,:)
DQ = 0.5 * DQ
!
END FUNCTION DIF2Y
+#endif
!
+#ifdef _OPENACC
+END SUBROUTINE PPM_01_Y_D
+
+END SUBROUTINE PPM_01_Y
+#else
END FUNCTION PPM_01_Y
+#endif
!
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+! ########################################################################
+!!$ FUNCTION PPM_01_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_01_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+! ########################################################################
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : IIU,IJU,IKU
+
+
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR & ! Courant number
+ , PRHO ! density
+!$acc declare present(ZCR,PRHO)
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG
+
+ CALL MNH_GET_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+
+ CALL PPM_01_Z_D(IIU,IJU,IKU, KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZT3D(:,:,:,IZQL),ZT3D(:,:,:,IZQR),ZT3D(:,:,:,IZDQ),ZT3D(:,:,:,IZQ6), &
+ & ZT3D(:,:,:,IZDMQ),ZT3D(:,:,:,IZQL0),ZT3D(:,:,:,IZQR0), ZT3D(:,:,:,IZQ60), &
+ & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG) )
+
+ CALL MNH_REL_ZT3D(IZQL,IZQR,IZDQ,IZQ6,IZDMQ,IZQL0,IZQR0,IZQ60,IZFPOS,IZFNEG)
+!
+CONTAINS
+!
+! ########################################################################
+ SUBROUTINE PPM_01_Z_D(IIU,IJU,IKU,KGRID, &
+ & PSRC, ZCR, PRHO, PTSTEP, PR, &
+ & ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+! ########################################################################
+#else
! ########################################################################
- FUNCTION PPM_01_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) RESULT(PR)
+ FUNCTION PPM_01_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_01_Z - PPM_01 fully monotonic PPM advection scheme in Z direction
!! Colella notation
@@ -1066,12 +1705,17 @@ END FUNCTION PPM_01_Y
!-------------------------------------------------------------------------------
!
USE MODE_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_CONF
USE MODD_PARAMETERS
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1079,31 +1723,64 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(ZCR,PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(IIU,IJU,IKU), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
+#ifndef _OPENACC
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
INTEGER:: IKU
!
! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL,ZQR
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDQ,ZQ6
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZDMQ
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL,ZQR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDQ,ZQ6
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZDMQ
!
! extra variables for the initial guess of parabolae parameters
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZQL0,ZQR0,ZQ60
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZQL0,ZQR0,ZQ60
!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
+#else
+! terms used in parabolic interpolation, dmq, qL, qR, dq, q6
+REAL, DIMENSION(IIU,IJU,IKU) :: &
+ ZQL, ZQR, ZDQ, ZQ6, ZDMQ &
+!
+! extra variables for the initial guess of parabolae parameters
+ , ZQL0,ZQR0,ZQ60 &
+!
+! advection fluxes
+ , ZFPOS, ZFNEG
+!$acc declare present (ZQL,ZQR,ZDQ,ZQ6,ZDMQ,ZQL0,ZQR0,ZQ60,ZFPOS,ZFNEG)
+!
+INTEGER:: IKB ! Begining useful area in x,y,z directions
+INTEGER:: IKE ! End useful area in x,y,z directions
+!
+!JUAN ACC
+INTEGER :: IIU,IJU,IKU
+!
+INTEGER :: I,J,K
+!JUAN ACC
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -1112,7 +1789,9 @@ REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
!
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
+#ifndef _OPENACC
IKU = SIZE(PSRC,3)
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -1120,7 +1799,12 @@ IKU = SIZE(PSRC,3)
! --------------------------------
!
! calculate dmq
+#ifndef _OPENACC
ZDMQ = DIF2Z(PSRC)
+#else
+!$acc kernels
+ dif2z(ZDMQ,PSRC)
+#endif
!
! monotonize the difference followinq eq. 5 in Lin94
! use the periodic BC here, it doesn't matter for vertical (hopefully)
@@ -1163,6 +1847,7 @@ ZQ6 = ZQ60
!
! eliminate over and undershoots and create qL and qR as in Lin96
!
+#ifndef _OPENACC
WHERE ( ZDMQ == 0.0 )
ZQL = PSRC
ZQR = PSRC
@@ -1176,6 +1861,26 @@ ELSEWHERE ( ZQ60*ZDQ > (ZDQ)**2 )
ZQL = ZQR0 - ZQ6
ZQR = ZQR0
END WHERE
+#else
+!PW: BUG: done like that because if using PGI 16.04 (at least)
+! will cause crashes at run (address not mapped)
+! and problems at compilation
+WHERE ( ZDMQ == 0.0 )
+ ZQL = PSRC
+ ZQR = PSRC
+ ZQ6 = 0.0
+END WHERE
+WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ < -(ZDQ)**2 ) )
+ ZQ6 = 3.0*(ZQL0 - PSRC)
+ ZQR = ZQL0 - ZQ6
+ ZQL = ZQL0
+END WHERE
+WHERE ( ( ZDMQ /= 0.0 ) .AND. ( ZQ60*ZDQ > (ZDQ)**2 ) )
+ ZQ6 = 3.0*(ZQR0 - PSRC)
+ ZQL = ZQR0 - ZQ6
+ ZQR = ZQR0
+END WHERE
+#endif
!
! recalculate coefficients of the parabolae
!
@@ -1183,32 +1888,50 @@ ZDQ = ZQR - ZQL
!
! and finally calculate fluxes for the advection
!
-ZFPOS(:,:,IKB+1:IKE+1) = ZQR(:,:,IKB:IKE) - 0.5*PCR(:,:,IKB+1:IKE+1) * &
- (ZDQ(:,:,IKB:IKE) - (1.0 - 2.0*PCR(:,:,IKB+1:IKE+1)/3.0) &
+ZFPOS(:,:,IKB+1:IKE+1) = ZQR(:,:,IKB:IKE) - 0.5*ZCR(:,:,IKB+1:IKE+1) * &
+ (ZDQ(:,:,IKB:IKE) - (1.0 - 2.0*ZCR(:,:,IKB+1:IKE+1)/3.0) &
* ZQ6(:,:,IKB:IKE))
!
! advection flux at open boundary when u(IKB) > 0
-ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZQR(:,:,IKB-1))*PCR(:,:,IKB) + &
+ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZQR(:,:,IKB-1))*ZCR(:,:,IKB) + &
ZQR(:,:,IKB-1)
!
! PPOSX(IKB-1) is not important for the calc of advection so
! we set it to 0
ZFPOS(:,:,IKB-1) = 0.0
!
-ZFNEG(:,:,IKB-1:IKE) = ZQL(:,:,IKB-1:IKE) - 0.5*PCR(:,:,IKB-1:IKE) * &
- ( ZDQ(:,:,IKB-1:IKE) + (1.0 + 2.0*PCR(:,:,IKB-1:IKE)/3.0) * &
+ZFNEG(:,:,IKB-1:IKE) = ZQL(:,:,IKB-1:IKE) - 0.5*ZCR(:,:,IKB-1:IKE) * &
+ ( ZDQ(:,:,IKB-1:IKE) + (1.0 + 2.0*ZCR(:,:,IKB-1:IKE)/3.0) * &
ZQ6(:,:,IKB-1:IKE) )
!
! advection flux at open boundary when u(IKE+1) < 0
-ZFNEG(:,:,IKE+1) = (ZQR(:,:,IKE)-PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
+ZFNEG(:,:,IKE+1) = (ZQR(:,:,IKE)-PSRC(:,:,IKE+1))*ZCR(:,:,IKE+1) + &
ZQR(:,:,IKE)
!
! advect the actual field in Z direction by W*dt
!
-PR = DZF(1,IKU,1, PCR*MZM(1,IKU,1,PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+#ifndef _OPENACC
+PR = DZF(1,IKU,1, ZCR*MZM(1,IKU,1,PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+!$acc end kernels
+ CALL MZM_DEVICE(PRHO,ZQL)
+!$acc kernels
+ ZQR = ZCR* ZQL*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + ZFNEG*(0.5-SIGN(0.5,ZCR)) )
+ !dzf(PR,ZQR)
+!$acc end kernels
+ CALL DZF_DEVICE(1,1,1,ZQR,PR)
+#endif
+!
+#ifndef _OPENACC
CALL GET_HALO(PR)
+#else
+CALL GET_HALO_D(PR)
+#endif
+!
+CALL MPPDB_CHECK3DM("PPM::PPM_01_Z ::PR",PRECISION,PR)
!
+#ifndef _OPENACC
CONTAINS
!
!-------------------------------------------------------------------------------
@@ -1269,17 +1992,73 @@ DQ(:,:,IKE+1) = -DQ(:,:,IKE)
DQ = 0.5 * DQ
!
END FUNCTION DIF2Z
+#endif
+!
+#ifdef _OPENACC
+END SUBROUTINE PPM_01_Z_D
!
+END SUBROUTINE PPM_01_Z
+#else
END FUNCTION PPM_01_Z
+#endif
!
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
! ########################################################################
- FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+!!$ FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
+!!$ RESULT(PR)
+SUBROUTINE PPM_S0_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP , PR)
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : ZPSRC_HALO2_WEST
+
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+ !
+ INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+ REAL, INTENT(IN) :: PTSTEP ! Time step
+ !
+ ! output source term
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+
+ INTEGER :: IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF
+
+ CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF)
+
+ CALL PPM_S0_X_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP , PR, &
+ & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG),ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRHO_MXM), &
+ & ZT3D(:,:,:,IZCR_MXM),ZT3D(:,:,:,IZCR_DXF),ZPSRC_HALO2_WEST )
+
+ CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MXM,IZCR_MXM,IZCR_DXF)
+!
+CONTAINS
+!
+! ########################################################################
+ SUBROUTINE PPM_S0_X_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP , PR &
+ & ,ZFPOS,ZPHAT,ZFNEG &
+ & ,ZRHO_MXM,ZCR_MXM,ZCR_DXF,ZPSRC_HALO2_WEST )
+
+! ########################################################################
+#else
+! ########################################################################
+ FUNCTION PPM_S0_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S0_X - PPM advection scheme in X direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -1294,7 +2073,11 @@ END FUNCTION PPM_01_Z
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_CONF
@@ -1302,6 +2085,14 @@ USE MODD_CONF
USE MODD_LUNIT
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
!END JUAN PPM_LL
+#ifdef _OPENACC
+USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+USE MODE_MNH_ZWORK, ONLY : IIB,IIE, IIU,IJU,IKU , IJS,IJN, GWEST,GEAST
+!
+USE MODD_IO_ll, ONLY : GSMONOPROC
+#endif
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1311,62 +2102,80 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+#endif
+!$acc declare present (PSRC,ZCR,PRHO,PR)
!
!* 0.2 Declarations of local variables :
!
+#ifndef _OPENACC
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
+INTEGER :: IJS,IJN
!
+LOGICAL :: GWEST, GEAST
+#endif
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
+!$acc declare present (ZFPOS,ZFNEG)
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT
+!$acc declare present (ZPHAT)
!
!BEG JUAN PPM_LL
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
-INTEGER :: ILUOUT,IRESP ! for prints
-INTEGER :: IJS,IJN
!END JUAN PPM_LL
+!
+#ifdef _OPENACC
+!JUAN ACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZRHO_MXM, ZCR_MXM , ZCR_DXF
+!$acc declare present (ZRHO_MXM,ZCR_MXM,ZCR_DXF)
+INTEGER :: I,J,K
+!
+!JUAN ACC
+#endif
+REAL, DIMENSION(SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPSRC_HALO2_WEST
+!$acc declare present (ZPSRC_HALO2_WEST)
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+#ifndef _OPENACC
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IJS=IJB
IJN=IJE
!!$IJS=IJB-1
!!$IJN=IJE+1
!
+GWEST = LWEST_ll
+GEAST = LEAST_ll
+#endif
+!
!BEG JUAN PPM_LL
!
!* initialise & update halo & halo2 for PSRC
!
-!!$IF(NHALO /= 1) THEN
-!!$ CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT,IRESP)
-!!$ WRITE(ILUOUT,*) 'ERROR : PPM ppm_met.f90 --> Juan '
-!!$ WRITE(ILUOUT,*) 'PPM not yet implemented/tested with NHALO /= 1'
-!!$ !callabortstop
-!!$ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
-!!$ CALL ABORT
-!!$ STOP
-!!$ENDIF
-!
CALL GET_HALO2(PSRC,TZ_PSRC_HALO2_ll)
+ZPSRC_HALO2_WEST(:,:) = TZ_PSRC_HALO2_ll%HALO2%WEST(:,:)
+!$acc update device (ZPSRC_HALO2_WEST)
+!$acc kernels
ZPHAT=PSRC
ZFPOS=PSRC
ZFNEG=PSRC
PR=PSRC
-!!$!
!
!END JUAN PPM_LL
!-------------------------------------------------------------------------------
@@ -1375,16 +2184,22 @@ PR=PSRC
!
!BEG JUAN PPM_LL
!
-! ZPATH(i) = Fct[ PSRC(i),PSRC(i-1),PSRC(i+1),PSRC(i-2)]
+! i=IIB+1:IIE ( inner domain IIB exclude )
+! ZPATH(i) = Fct[ PSRC(i) ,PSRC(i-1),PSRC(i+1),PSRC(i-2) ]
!
-! inner domain
+! doc MNH ZPATH(i+1) = Fct[ PSRC(i+1),PSRC(i) ,PSRC(i+2),PSRC(i-1) ]
+!
!
ZPHAT(IIB+1:IIE,IJS:IJN,:) = ( 7.0 * &
( PSRC(IIB+1:IIE ,IJS:IJN,:) + PSRC(IIB :IIE-1,IJS:IJN,:) ) - &
( PSRC(IIB+2:IIE+1,IJS:IJN,:) + PSRC(IIB-1:IIE-2,IJS:IJN,:) ) ) / 12.0
+!$acc end kernels
!
SELECT CASE ( HLBCX(1) ) ! X direction LBC type: (1) for left side
CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_S0_X CYCL/WALL boundaries not yet implemented'
+#endif
!
!!$ ZPHAT(IIB,:,:) = (7.0 * &
!!$ (PSRC(IIB,:,:) + PSRC(IIB-1,:,:)) - &
@@ -1417,16 +2232,16 @@ CASE ('CYCL','WALL') ! In that case one must have HLBCX(1) == HLBCX(2
CALL GET_HALO(ZPHAT)
!
ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
- PCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
- PCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - PCR(IIB:IIE+1,IJS:IJN,:)) * &
+ ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
+ ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
(ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
!
!!$ ZFPOS(IIB-1,:,:) = ZFPOS(IIE,:,:) !JUAN
CALL GET_HALO(ZFPOS) ! JUAN
!
ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
- PCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
- PCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + PCR(IIB-1:IIE,IJS:IJN,:)) * &
+ ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
+ ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
(ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
!
! define fluxes for CYCL BC outside physical domain
@@ -1436,12 +2251,18 @@ CALL GET_HALO(ZFNEG) ! JUAN
!
! calculate the advection
!
+#ifndef _OPENACC
PR = PSRC * PRHO - &
- DXF( PCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+PRINT *,'not yet implemented'
+STOP
+#endif
CALL GET_HALO(PR) ! JUAN
!
CASE ('OPEN')
+!$acc kernels
!
!!$ ZPHAT(IIB,:,:) = 0.5*(PSRC(IIB-1,:,:) + PSRC(IIB,:,:))
!!$ ZPHAT(IIB-1,:,:) = ZPHAT(IIB,:,:) ! not used
@@ -1449,44 +2270,71 @@ CASE ('OPEN')
!
! WEST BOUND
!
- IF (.NOT. LWEST_ll()) THEN
+IF (.NOT. GWEST) THEN
ZPHAT(IIB ,IJS:IJN,:) = ( 7.0 * &
( PSRC(IIB ,IJS:IJN,:) + PSRC(IIB-1,IJS:IJN,:) ) - &
- ( PSRC(IIB+1,IJS:IJN,:) + TZ_PSRC_HALO2_ll%HALO2%WEST(IJS:IJN,:) ) ) / 12.0
+ ( PSRC(IIB+1,IJS:IJN,:) + ZPSRC_HALO2_WEST(IJS:IJN,:) ) ) / 12.0
! <=> WEST BOUND ( PSRC(IIB+1,IJS:IJN,:) + PSRC(IIB-2,IJS:IJN,:) ) ) / 12.0
- ENDIF
+ENDIF
+!$acc end kernels
!
-CALL GET_HALO(ZPHAT)
+! update ZPHAT HALO before next/further utilisation
!
- IF (LWEST_ll()) THEN
+#ifndef _OPENACC
+CALL GET_HALO(ZPHAT)
+#else
+!$acc update self(ZPHAT)
+CALL GET_HALO(ZPHAT(:,:,:),HDIR="Z0_X")
+!$acc update device(ZPHAT)
+#endif
+!
+!$acc kernels
+ IF (GWEST) THEN
ZPHAT(IIB ,IJS:IJN,:) = 0.5*(PSRC(IIB-1,IJS:IJN,:) + PSRC(IIB,IJS:IJN,:))
ZPHAT(IIB-1,IJS:IJN,:) = ZPHAT(IIB,IJS:IJN,:)
ENDIF
!
+!
! EAST BOUND
!
- IF (LEAST_ll()) THEN
+ IF (GEAST) THEN
ZPHAT(IIE+1,IJS:IJN,:) = 0.5*(PSRC(IIE,IJS:IJN,:) + PSRC(IIE+1,IJS:IJN,:))
ENDIF
!
-! update ZPHAT HALO before next/further utilisation
+! update ZPHAT HALO before next/further utilisation
!
!!$CALL GET_HALO(ZPHAT)
!
!!$ ZFPOS(IIB+1:IIE+1,:,:) = ZPHAT(IIB+1:IIE+1,:,:) - &
-!!$ PCR(IIB+1:IIE+1,:,:)*(ZPHAT(IIB+1:IIE+1,:,:) - PSRC(IIB:IIE,:,:)) - &
-!!$ PCR(IIB+1:IIE+1,:,:)*(1.0 - PCR(IIB+1:IIE+1,:,:)) * &
+!!$ ZCR(IIB+1:IIE+1,:,:)*(ZPHAT(IIB+1:IIE+1,:,:) - PSRC(IIB:IIE,:,:)) - &
+!!$ ZCR(IIB+1:IIE+1,:,:)*(1.0 - ZCR(IIB+1:IIE+1,:,:)) * &
!!$ (ZPHAT(IIB:IIE,:,:) - 2.0*PSRC(IIB:IIE,:,:) + ZPHAT(IIB+1:IIE+1,:,:))
+#ifndef _OPENACC
ZFPOS(IIB:IIE+1,IJS:IJN,:) = ZPHAT(IIB:IIE+1,IJS:IJN,:) - &
- PCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
- PCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - PCR(IIB:IIE+1,IJS:IJN,:)) * &
+ ZCR(IIB:IIE+1,IJS:IJN,:)*(ZPHAT(IIB:IIE+1,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) - &
+ ZCR(IIB:IIE+1,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE+1,IJS:IJN,:)) * &
(ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
-!
+#else
+!TODO PW: BUG? which one is correct? Both?
+ ZFPOS(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE-1,IJS:IJN,:)) - &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 - ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB-1:IIE-1,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE-1,IJS:IJN,:) + ZPHAT(IIB:IIE,IJS:IJN,:))
+!$acc end kernels
+#endif
+!
+#ifndef _OPENACC
CALL GET_HALO(ZFPOS) ! JUAN
+#else
+!$acc update self(ZFPOS)
+CALL GET_HALO(ZFPOS(:,:,:),HDIR="Z0_X") ! JUAN
+!$acc update device(ZFPOS)
+#endif
!
+!$acc kernels
! positive flux on the WEST boundary
- IF (LWEST_ll()) THEN
- ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZPHAT(IIB,IJS:IJN,:))*PCR(IIB,IJS:IJN,:) + &
+ IF (GWEST) THEN
+ ZFPOS(IIB,IJS:IJN,:) = (PSRC(IIB-1,IJS:IJN,:) - ZPHAT(IIB,IJS:IJN,:))*ZCR(IIB,IJS:IJN,:) + &
ZPHAT(IIB,IJS:IJN,:)
! this is not used
ZFPOS(IIB-1,IJS:IJN,:) = 0.0
@@ -1494,70 +2342,160 @@ CALL GET_HALO(ZFPOS) ! JUAN
!
! negative fluxes
!!$ ZFNEG(IIB:IIE,:,:) = ZPHAT(IIB:IIE,:,:) + &
-!!$ PCR(IIB:IIE,:,:)*(ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:)) + &
-!!$ PCR(IIB:IIE,:,:)*(1.0 + PCR(IIB:IIE,:,:)) * &
+!!$ ZCR(IIB:IIE,:,:)*(ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:)) + &
+!!$ ZCR(IIB:IIE,:,:)*(1.0 + ZCR(IIB:IIE,:,:)) * &
!!$ (ZPHAT(IIB:IIE,:,:) - 2.0*PSRC(IIB:IIE,:,:) + ZPHAT(IIB+1:IIE+1,:,:))
+#ifndef _OPENACC
ZFNEG(IIB-1:IIE,IJS:IJN,:) = ZPHAT(IIB-1:IIE,IJS:IJN,:) + &
- PCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
- PCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + PCR(IIB-1:IIE,IJS:IJN,:)) * &
+ ZCR(IIB-1:IIE,IJS:IJN,:)*(ZPHAT(IIB-1:IIE,IJS:IJN,:) - PSRC(IIB-1:IIE,IJS:IJN,:)) + &
+ ZCR(IIB-1:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB-1:IIE,IJS:IJN,:)) * &
(ZPHAT(IIB-1:IIE,IJS:IJN,:) - 2.0*PSRC(IIB-1:IIE,IJS:IJN,:) + ZPHAT(IIB:IIE+1,IJS:IJN,:))
-!
+#else
+!TODO PW: BUG? which one is correct? Both?
+!See also comment in IF(GEAST)
+ ZFNEG(IIB:IIE,IJS:IJN,:) = ZPHAT(IIB:IIE,IJS:IJN,:) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(ZPHAT(IIB:IIE,IJS:IJN,:) - PSRC(IIB:IIE,IJS:IJN,:)) + &
+ ZCR(IIB:IIE,IJS:IJN,:)*(1.0 + ZCR(IIB:IIE,IJS:IJN,:)) * &
+ (ZPHAT(IIB:IIE,IJS:IJN,:) - 2.0*PSRC(IIB:IIE,IJS:IJN,:) + ZPHAT(IIB+1:IIE+1,IJS:IJN,:))
+!$acc end kernels
+#endif
+!
+#ifndef _OPENACC
CALL GET_HALO(ZFNEG) ! JUAN
+#else
+!$acc update self(ZFNEG)
+CALL GET_HALO(ZFNEG,HDIR="Z0_X") ! JUAN
+!$acc update device(ZFNEG)
+#endif
!
- IF (LEAST_ll()) THEN
+!$acc kernels
+ IF (GEAST) THEN
!
-! in OPEN case PCR(IIB-1) is not used, so we also set ZFNEG(IIB-1) = 0
+! in OPEN case ZCR(IIB-1) is not used, so we also set ZFNEG(IIB-1) = 0
!
ZFNEG(IIB-1,IJS:IJN,:) = 0.0
!
! modified negative flux on EAST boundary. We use linear function instead of a
! parabola to represent the tracer field, so it simplifies the flux expresion
!
- ZFNEG(IIE+1,IJS:IJN,:) = (ZPHAT(IIE+1,IJS:IJN,:) - PSRC(IIE+1,IJS:IJN,:))*PCR(IIE+1,IJS:IJN,:) + &
+ ZFNEG(IIE+1,IJS:IJN,:) = (ZPHAT(IIE+1,IJS:IJN,:) - PSRC(IIE+1,IJS:IJN,:))*ZCR(IIE+1,IJS:IJN,:) + &
ZPHAT(IIE+1,IJS:IJN,:)
ENDIF
!
! calculate the advection
!
+#ifndef _OPENACC
PR = PSRC * PRHO - &
- DXF( PCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ DXF( ZCR*MXM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+!$acc end kernels
+ CALL MXM_DEVICE(PRHO,ZRHO_MXM)
+!$acc kernels
+ ZCR_MXM = ZCR * ZRHO_MXM * ( ZFPOS*(0.5+SIGN(0.5,ZCR)) + ZFNEG*(0.5-SIGN(0.5,ZCR)) )
+!$acc end kernels
+ CALL DXF_DEVICE(ZCR_MXM,ZCR_DXF)
+!$acc kernels
+ PR = PSRC * PRHO - ZCR_DXF
+#endif
!
! in OPEN case fix boundary conditions
!
- IF (LWEST_ll()) THEN
- WHERE ( PCR(IIB,IJS:IJN,:) <= 0. ) ! OUTFLOW condition
+ IF (GWEST) THEN
+ WHERE ( ZCR(IIB,IJS:IJN,:) <= 0. ) ! OUTFLOW condition
PR(IIB-1,IJS:IJN,:) = 2.*PR(IIB,IJS:IJN,:) - PR(IIB+1,IJS:IJN,:)
ELSEWHERE
PR(IIB-1,IJS:IJN,:) = PR(IIB,IJS:IJN,:)
END WHERE
ENDIF
!
- IF (LEAST_ll()) THEN
- WHERE ( PCR(IIE,IJS:IJN,:) >= 0. ) ! OUTFLOW condition
+ IF (GEAST) THEN
+ WHERE ( ZCR(IIE,IJS:IJN,:) >= 0. ) ! OUTFLOW condition
PR(IIE+1,IJS:IJN,:) = 2.*PR(IIE,IJS:IJN,:) - PR(IIE-1,IJS:IJN,:)
ELSEWHERE
PR(IIE+1,IJS:IJN,:) = PR(IIE,IJS:IJN,:)
END WHERE
ENDIF
!
+!$acc end kernels
+!
!
END SELECT
!
+#ifndef _OPENACC
CALL GET_HALO(PR)
+#else
+CALL GET_HALO_D(PR,HDIR="S0_X")
+#endif
+CALL MPPDB_CHECK3DM("PPM::PPM_S0_X OPEN ::PR",PRECISION,PR)
!
!-------------------------------------------------------------------------------
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
+#ifdef _OPENACC
+END SUBROUTINE PPM_S0_X_D
+
+END SUBROUTINE PPM_S0_X
+#else
END FUNCTION PPM_S0_X
+#endif
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
! ########################################################################
- FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PTSTEP) &
+!!$ FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
+!!$ RESULT(PR)
+ SUBROUTINE PPM_S0_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ USE MODE_MNH_ZWORK, ONLY : ZPSRC_HALO2_SOUTH
+
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+
+ INTEGER :: IZFPOS,IZPHAT,IZFNEG,IZRHO_MYM,IZCR_MYM,IZCR_DYF
+
+ CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MYM,IZCR_MYM,IZCR_DYF)
+
+ CALL PPM_S0_Y_D(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP , PR, &
+ & ZT3D(:,:,:,IZFPOS),ZT3D(:,:,:,IZFNEG),ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRHO_MYM), &
+ & ZT3D(:,:,:,IZCR_MYM),ZT3D(:,:,:,IZCR_DYF),ZPSRC_HALO2_SOUTH )
+
+ CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MYM,IZCR_MYM,IZCR_DYF)
+!
+CONTAINS
+!
+! ########################################################################
+ SUBROUTINE PPM_S0_Y_D(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP , PR &
+ & ,ZFPOS,ZPHAT,ZFNEG &
+ & ,ZRHO_MYM,ZCR_MYM,ZCR_DYF,ZPSRC_HALO2_SOUTH )
+
+! ########################################################################
+#else
+! ########################################################################
+ FUNCTION PPM_S0_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S0_Y - PPM advection scheme in Y direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -1571,12 +2509,25 @@ END FUNCTION PPM_S0_X
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_LUNIT
USE MODD_CONF
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+#ifdef _OPENACC
+USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODD_PARAMETERS, ONLY : JPHEXT
+!
+USE MODE_MNH_ZWORK, ONLY : IJB,IJE, IIU,IJU,IKU , IIW,IIA, GSOUTH , GNORTH
+!
+USE MODD_IO_ll, ONLY : GSMONOPROC
+#endif
+USE MODE_MPPDB
!
IMPLICIT NONE
!
@@ -1586,44 +2537,69 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
+#ifndef _OPENACC
INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE ! End useful area in x,y,z directions
+INTEGER :: IJS,IJN
+INTEGER :: IIW,IIA
+!
+LOGICAL :: GNORTH, GSOUTH
+#endif
!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT
!
!BEG JUAN PPM_LL
TYPE(HALO2LIST_ll), POINTER :: TZ_PSRC_HALO2_ll ! halo2 for PSRC
-TYPE(HALO2LIST_ll), POINTER :: TZ_PHAT_HALO2_ll ! halo2 for ZPHAT
-INTEGER :: ILUOUT,IRESP ! for prints
-INTEGER :: IIW,IIA
!END JUAN PPM_LL
+#ifdef _OPENACC
+!
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZRHO_MYM , ZCR_MYM , ZCR_DYF
+!$acc declare present (PSRC,ZCR,PRHO)
+!$acc declare present (ZFPOS, ZFNEG,ZPHAT ,ZRHO_MYM , ZCR_MYM , ZCR_DYF )
+!
+INTEGER :: I,J,K
+!
+#endif
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,3)) :: ZPSRC_HALO2_SOUTH
+!$acc declare present (ZPSRC_HALO2_SOUTH)
!
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+#ifndef _OPENACC
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IIW=IIB
IIA=IIE
!!$IIW=IIB-1
!!$IIA=IIE+1
!
+GNORTH = LNORTH_ll
+GSOUTH = LSOUTH_ll
+#endif
+!
!-------------------------------------------------------------------------------
!
IF ( L2D ) THEN
@@ -1632,9 +2608,12 @@ IF ( L2D ) THEN
END IF
!
CALL GET_HALO2(PSRC,TZ_PSRC_HALO2_ll)
+ZPSRC_HALO2_SOUTH(:,:) = TZ_PSRC_HALO2_ll%HALO2%SOUTH(:,:)
+!$acc update device (ZPSRC_HALO2_SOUTH)
!
! Initialize with relalistic value all work array
!
+!$acc kernels
ZPHAT=PSRC
ZFPOS=PSRC
ZFNEG=PSRC
@@ -1647,9 +2626,13 @@ PR=PSRC
ZPHAT(IIW:IIA,IJB+1:IJE,:) = (7.0 * &
(PSRC(IIW:IIA,IJB+1:IJE,:) + PSRC(IIW:IIA,IJB:IJE-1,:)) - &
(PSRC(IIW:IIA,IJB+2:IJE+1,:) + PSRC(IIW:IIA,IJB-1:IJE-2,:))) / 12.0
+!$acc end kernels
!
SELECT CASE ( HLBCY(1) ) ! Y direction LBC type: (1) for left side
CASE ('CYCL','WALL') ! In that case one must have HLBCY(1) == HLBCY(2)
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_S0_Y CYCL/WALL boundaries not yet implemented'
+#endif
!
!!$ ZPHAT(:,IJB,:) = (7.0 * &
!!$ (PSRC(:,IJB,:) + PSRC(:,IJB-1,:)) - &
@@ -1682,16 +2665,16 @@ CALL GET_HALO(ZPHAT)
! calculate the fluxes:
!
ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
- PCR(IIW:IIA,IJB:IJE+1,:)*(ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) - &
- PCR(IIW:IIA,IJB:IJE+1,:)*(1.0 - PCR(IIW:IIA,IJB:IJE+1,:)) * &
+ ZCR(IIW:IIA,IJB:IJE+1,:)*(ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) - &
+ ZCR(IIW:IIA,IJB:IJE+1,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE+1,:)) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
!
!!$ ZFPOS(:,IJB-1,:) = ZFPOS(:,IJE,:)
CALL GET_HALO(ZFPOS) ! JUAN
!
ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
- PCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
- PCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + PCR(IIW:IIA,IJB-1:IJE,:)) * &
+ ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
+ ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
!
@@ -1702,11 +2685,17 @@ CALL GET_HALO(ZFNEG) ! JUAN
!
! calculate the advection
!
+#ifndef _OPENACC
PR = PSRC * PRHO - &
- DYF( PCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+PRINT *,'not yet implemented'
+STOP
+#endif
!
CASE ('OPEN')
+!$acc kernels
!
!!$ ZPHAT(:,IJB,:) = 0.5*(PSRC(:,IJB-1,:) + PSRC(:,IJB,:))
!!$ ZPHAT(:,IJB-1,:) = ZPHAT(:,IJB,:) ! not used
@@ -1715,23 +2704,34 @@ CASE ('OPEN')
!
! SOUTH BOUND
!
- IF ( .NOT. LSOUTH_ll()) THEN
+ IF ( .NOT. GSOUTH) THEN
ZPHAT(IIW:IIA,IJB ,:) = (7.0 * &
(PSRC(IIW:IIA,IJB ,:) + PSRC(IIW:IIA,IJB-1,:)) - &
- (PSRC(IIW:IIA,IJB+1,:) + TZ_PSRC_HALO2_ll%HALO2%SOUTH(IIW:IIA,:) )) / 12.0
+ (PSRC(IIW:IIA,IJB+1,:) + ZPSRC_HALO2_SOUTH(IIW:IIA,:) )) / 12.0
+! (PSRC(IIW:IIA,IJB+1,:) + TZ_PSRC_HALO2_ll%HALO2%SOUTH(IIW:IIA,:) )) / 12.0
! <=> SOUTH BOUND (PSRC(IIW:IIA,IJB+1,:) + PSRC(IIW:IIA,IJB-2,:) )) / 12.0
ENDIF
!
-CALL GET_HALO(ZPHAT)
+!TEMPO_JUAN
+!$acc end kernels
!
- IF (LSOUTH_ll()) THEN
+#ifndef _OPENACC
+CALL GET_HALO(ZPHAT)
+#else
+!$acc update self(ZPHAT)
+CALL GET_HALO(ZPHAT(:,:,:),HDIR="Z0_Y")
+!$acc update device(ZPHAT)
+#endif
+!
+!$acc kernels
+ IF (GSOUTH) THEN
ZPHAT(IIW:IIA,IJB ,:) = 0.5*(PSRC(IIW:IIA,IJB-1,:) + PSRC(IIW:IIA,IJB,:))
ZPHAT(IIW:IIA,IJB-1,:) = ZPHAT(IIW:IIA,IJB,:)
ENDIF
!
! NORTH BOUND
!
- IF (LNORTH_ll()) THEN
+ IF (GNORTH) THEN
ZPHAT(IIW:IIA,IJE+1,:) = 0.5*(PSRC(IIW:IIA,IJE,:) + PSRC(IIW:IIA,IJE+1,:))
ENDIF
!
@@ -1743,19 +2743,35 @@ CALL GET_HALO(ZPHAT)
! calculate the fluxes:
! positive fluxes
!!$ ZFPOS(:,IJB+1:IJE+1,:) = ZPHAT(:,IJB+1:IJE+1,:) - &
-!!$ PCR(:,IJB+1:IJE+1,:)*(ZPHAT(:,IJB+1:IJE+1,:) - PSRC(:,IJB:IJE,:)) - &
-!!$ PCR(:,IJB+1:IJE+1,:)*(1.0 - PCR(:,IJB+1:IJE+1,:)) * &
+!!$ ZCR(:,IJB+1:IJE+1,:)*(ZPHAT(:,IJB+1:IJE+1,:) - PSRC(:,IJB:IJE,:)) - &
+!!$ ZCR(:,IJB+1:IJE+1,:)*(1.0 - ZCR(:,IJB+1:IJE+1,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) + ZPHAT(:,IJB+1:IJE+1,:))
-ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
- PCR(IIW:IIA,IJB:IJE+1,:)*( ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE ,:) ) - &
- PCR(IIW:IIA,IJB:IJE+1,:)*( 1.0 - PCR(IIW:IIA,IJB :IJE+1,:) ) * &
+#ifndef _OPENACC
+ ZFPOS(IIW:IIA,IJB:IJE+1,:) = ZPHAT(IIW:IIA,IJB:IJE+1,:) - &
+ ZCR(IIW:IIA,IJB:IJE+1,:)*( ZPHAT(IIW:IIA,IJB:IJE+1,:) - PSRC(IIW:IIA,IJB-1:IJE ,:) ) - &
+ ZCR(IIW:IIA,IJB:IJE+1,:)*( 1.0 - ZCR(IIW:IIA,IJB :IJE+1,:) ) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) + ZPHAT(IIW:IIA,IJB:IJE+1,:))
-!
+#else
+!TODO PW: BUG? which one is correct? Both?
+ ZFPOS(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE-1,:)) - &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 - ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB-1:IJE-1,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE-1,:) + ZPHAT(IIW:IIA,IJB:IJE,:))
+!$acc end kernels
+#endif
+!
+#ifndef _OPENACC
CALL GET_HALO(ZFPOS) ! JUAN
+#else
+!$acc update self(ZFPOS)
+CALL GET_HALO(ZFPOS(:,:,:),HDIR="Z0_Y") ! JUAN
+!$acc update device(ZFPOS)
+#endif
!
+!$acc kernels
! positive flux on the SOUTH boundary
- IF (LSOUTH_ll()) THEN
- ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZPHAT(IIW:IIA,IJB,:))*PCR(IIW:IIA,IJB,:) + &
+ IF (GSOUTH) THEN
+ ZFPOS(IIW:IIA,IJB,:) = (PSRC(IIW:IIA,IJB-1,:) - ZPHAT(IIW:IIA,IJB,:))*ZCR(IIW:IIA,IJB,:) + &
ZPHAT(IIW:IIA,IJB,:)
!
! this is not used
@@ -1764,67 +2780,150 @@ CALL GET_HALO(ZFPOS) ! JUAN
!
! negative fluxes
!!$ ZFNEG(:,IJB:IJE,:) = ZPHAT(:,IJB:IJE,:) + &
-!!$ PCR(:,IJB:IJE,:)*(ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:)) + &
-!!$ PCR(:,IJB:IJE,:)*(1.0 + PCR(:,IJB:IJE,:)) * &
+!!$ ZCR(:,IJB:IJE,:)*(ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:)) + &
+!!$ ZCR(:,IJB:IJE,:)*(1.0 + ZCR(:,IJB:IJE,:)) * &
!!$ (ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) +ZPHAT(:,IJB+1:IJE+1,:))
+#ifndef _OPENACC
ZFNEG(IIW:IIA,IJB-1:IJE,:) = ZPHAT(IIW:IIA,IJB-1:IJE,:) + &
- PCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
- PCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + PCR(IIW:IIA,IJB-1:IJE,:)) * &
+ ZCR(IIW:IIA,IJB-1:IJE,:)*(ZPHAT(IIW:IIA,IJB-1:IJE,:) - PSRC(IIW:IIA,IJB-1:IJE,:)) + &
+ ZCR(IIW:IIA,IJB-1:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB-1:IJE,:)) * &
(ZPHAT(IIW:IIA,IJB-1:IJE,:) - 2.0*PSRC(IIW:IIA,IJB-1:IJE,:) +ZPHAT(IIW:IIA,IJB:IJE+1,:))
-!
+#else
+!TODO PW: BUG? which one is correct? Both?
+ ZFNEG(IIW:IIA,IJB:IJE,:) = ZPHAT(IIW:IIA,IJB:IJE,:) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(ZPHAT(IIW:IIA,IJB:IJE,:) - PSRC(IIW:IIA,IJB:IJE,:)) + &
+ ZCR(IIW:IIA,IJB:IJE,:)*(1.0 + ZCR(IIW:IIA,IJB:IJE,:)) * &
+ (ZPHAT(IIW:IIA,IJB:IJE,:) - 2.0*PSRC(IIW:IIA,IJB:IJE,:) +ZPHAT(IIW:IIA,IJB+1:IJE+1,:))
+!$acc end kernels
+#endif
+!
+#ifndef _OPENACC
CALL GET_HALO(ZFNEG) ! JUAN
-!
- IF (LNORTH_ll()) THEN
+#else
+!$acc update self(ZFNEG)
+ CALL GET_HALO(ZFNEG,HDIR="Z0_Y") ! JUAN
+!$acc update device(ZFNEG)
+#endif
+!
+!$acc kernels
+ IF (GNORTH) THEN
! this is not used
ZFNEG(IIW:IIA,IJB-1,:) = 0.0
!
! negative flux on the NORTH boundary
- ZFNEG(IIW:IIA,IJE+1,:) = (ZPHAT(IIW:IIA,IJE+1,:) - PSRC(IIW:IIA,IJE+1,:))*PCR(IIW:IIA,IJE+1,:) + &
+ ZFNEG(IIW:IIA,IJE+1,:) = (ZPHAT(IIW:IIA,IJE+1,:) - PSRC(IIW:IIA,IJE+1,:))*ZCR(IIW:IIA,IJE+1,:) + &
ZPHAT(IIW:IIA,IJE+1,:)
ENDIF
!
! calculate the advection
!
+#ifndef _OPENACC
PR = PSRC * PRHO - &
- DYF( PCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ DYF( ZCR*MYM(PRHO)*( ZFPOS*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+!$acc end kernels
+ CALL MYM_DEVICE(PRHO,ZRHO_MYM)
+!$acc kernels
+ ZCR_MYM = ZCR* ZRHO_MYM*( ZFPOS(:,:,:)*(0.5+SIGN(0.5,ZCR)) + ZFNEG*(0.5-SIGN(0.5,ZCR)) )
+!$acc end kernels
+ CALL DYF_DEVICE(ZCR_MYM,ZCR_DYF)
+!$acc kernels
+ PR = PSRC * PRHO - ZCR_DYF
+#endif
!
! in OPEN case fix boundary conditions
!
- IF (LSOUTH_ll()) THEN
- WHERE ( PCR(IIW:IIA,IJB,:) <= 0. ) ! OUTFLOW condition
+ IF (GSOUTH) THEN
+ WHERE ( ZCR(IIW:IIA,IJB,:) <= 0. ) ! OUTFLOW condition
PR(IIW:IIA,IJB-1,:) = 1.0 * 2.*PR(IIW:IIA,IJB,:) - PR(IIW:IIA,IJB+1,:)
ELSEWHERE
PR(IIW:IIA,IJB-1,:) = PR(IIW:IIA,IJB,:)
END WHERE
ENDIF
!
- IF (LNORTH_ll()) THEN
- WHERE ( PCR(IIW:IIA,IJE,:) >= 0. ) ! OUTFLOW condition
+ IF (GNORTH) THEN
+ WHERE ( ZCR(IIW:IIA,IJE,:) >= 0. ) ! OUTFLOW condition
PR(IIW:IIA,IJE+1,:) = 1.0 * 2.*PR(IIW:IIA,IJE,:) - PR(IIW:IIA,IJE-1,:)
ELSEWHERE
PR(IIW:IIA,IJE+1,:) = PR(IIW:IIA,IJE,:)
END WHERE
ENDIF
!
-!
+!$acc end kernels
+!
!
END SELECT
!
+#ifndef _OPENACC
CALL GET_HALO(PR)
+#else
+CALL GET_HALO_D(PR,HDIR="S0_Y")
+#endif
+CALL MPPDB_CHECK3DM("PPM::PPM_S0_Y OPEN ::PR",PRECISION,PR)
!
CALL DEL_HALO2_ll(TZ_PSRC_HALO2_ll)
!
+#ifdef _OPENACC
+END SUBROUTINE PPM_S0_Y_D
+
+END SUBROUTINE PPM_S0_Y
+#else
END FUNCTION PPM_S0_Y
+#endif
!
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+! ########################################################################
+!!$ FUNCTION PPM_S0_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) &
+!!$ RESULT(PR)
+SUBROUTINE PPM_S0_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP, PR)
+
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(:,:,:),INTENT(INOUT):: PR
+!$acc declare present (PSRC,ZCR,PRHO,PR)
+
+ INTEGER :: IZFPOS,IZPHAT,IZFNEG,IZRHO_MZM,IZCR_MZM,IZCR_DZF
+
+ CALL MNH_GET_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MZM,IZCR_MZM,IZCR_DZF)
+
+ CALL PPM_S0_Z_D(KGRID, PSRC, ZCR, PRHO, PTSTEP , PR, &
+ & ZT3D(:,:,:,IZFPOS), ZT3D(:,:,:,IZFNEG), ZT3D(:,:,:,IZPHAT), &
+ & ZT3D(:,:,:,IZRHO_MZM),ZT3D(:,:,:,IZCR_MZM),ZT3D(:,:,:,IZCR_DZF) )
+
+ CALL MNH_REL_ZT3D(IZFPOS,IZFNEG,IZPHAT,IZRHO_MZM,IZCR_MZM,IZCR_DZF)
+!
+CONTAINS
+!
+! ########################################################################
+SUBROUTINE PPM_S0_Z_D(KGRID, PSRC, ZCR, PRHO, PTSTEP , PR &
+ & ,ZFPOS,ZFNEG,ZPHAT &
+ & ,ZRHO_MZM,ZCR_MZM,ZCR_DZF )
+
! ########################################################################
- FUNCTION PPM_S0_Z(KGRID, PSRC, PCR, PRHO, PTSTEP) &
+#else
+! ########################################################################
+ FUNCTION PPM_S0_Z(KGRID, PSRC, ZCR, PRHO, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S0_Z - PPM advection scheme in Z direction in Skamarock 2006
!! notation - NO CONSTRAINTS
@@ -1837,12 +2936,20 @@ END FUNCTION PPM_S0_Y
!-------------------------------------------------------------------------------
!
USE MODE_ll
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GET_HALO
!
USE MODD_CONF
USE MODD_PARAMETERS
-!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+USE MODE_MPPDB
+!
+#ifdef _OPENACC
+USE MODE_MNH_ZWORK, ONLY : IKB,IKE, IKU
+#endif
!
IMPLICIT NONE
!
@@ -1850,42 +2957,67 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present (PSRC,ZCR,PRHO)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:),INTENT(INOUT):: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
+#ifndef _OPENACC
INTEGER:: IKB ! Begining useful area in x,y,z directions
INTEGER:: IKE ! End useful area in x,y,z directions
INTEGER:: IKU
!
! advection fluxes
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFPOS, ZFNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFPOS, ZFNEG
!
! interpolated variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT
+#else
+! advection fluxes
+REAL, DIMENSION(:,:,:),INTENT(INOUT):: ZFPOS, ZFNEG &
+!
+! interpolated variable at cell edges
+ & , ZPHAT &
+ & , ZRHO_MZM ,ZCR_MZM,ZCR_DZF
+!$acc declare present (ZFPOS, ZFNEG, ZPHAT , ZRHO_MZM ,ZCR_MZM,ZCR_DZF )
+#endif
!
!-------------------------------------------------------------------------------
!
!* 0.3. COMPUTES THE DOMAIN DIMENSIONS
! ------------------------------
!
+#ifndef _OPENACC
IKB = 1 + JPVEXT
IKE = SIZE(PSRC,3) - JPVEXT
IKU = SIZE(PSRC,3)
+#endif
!
!-------------------------------------------------------------------------------
!
! calculate 4th order fluxes at cell edges in the inner domain
!
-CALL GET_HALO(PSRC)
+#ifndef _OPENACC
+ CALL GET_HALO(PSRC)
+#else
+ CALL GET_HALO_D(PSRC)
+#endif
!
+#ifdef _OPENACC
+!$acc kernels
+#endif
!
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
(PSRC(:,:,IKB+1:IKE) + PSRC(:,:,IKB:IKE-1)) - &
@@ -1896,20 +3028,20 @@ ZPHAT(:,:,IKB) = 0.5*(PSRC(:,:,IKB-1) + PSRC(:,:,IKB))
ZPHAT(:,:,IKB-1) = ZPHAT(:,:,IKB) ! not used
ZPHAT(:,:,IKE+1) = 0.5*(PSRC(:,:,IKE) + PSRC(:,:,IKE+1))
!
-!!$CALL GET_HALO(ZPHAT)
+!!$CALL GET_HALO(ZPHAT(:,:,:))
!
! calculate fluxes through cell edges for positive and negative Courant numbers
! (for inflow or outflow situation)
!
ZFPOS(:,:,IKB+1:IKE+1) = ZPHAT(:,:,IKB+1:IKE+1) - &
- PCR(:,:,IKB+1:IKE+1)*(ZPHAT(:,:,IKB+1:IKE+1) - PSRC(:,:,IKB:IKE)) - &
- PCR(:,:,IKB+1:IKE+1)*(1.0 - PCR(:,:,IKB+1:IKE+1)) * &
+ ZCR(:,:,IKB+1:IKE+1)*(ZPHAT(:,:,IKB+1:IKE+1) - PSRC(:,:,IKB:IKE)) - &
+ ZCR(:,:,IKB+1:IKE+1)*(1.0 - ZCR(:,:,IKB+1:IKE+1)) * &
(ZPHAT(:,:,IKB:IKE) - 2.0*PSRC(:,:,IKB:IKE) + ZPHAT(:,:,IKB+1:IKE+1))
!
-!!$CALL GET_HALO(ZFPOS) ! JUAN
+!!$CALL GET_HALO(ZFPOS(:,:,:)) ! JUAN
!
! positive flux on the BOTTOM boundary
-ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZPHAT(:,:,IKB))*PCR(:,:,IKB) + &
+ZFPOS(:,:,IKB) = (PSRC(:,:,IKB-1) - ZPHAT(:,:,IKB))*ZCR(:,:,IKB) + &
ZPHAT(:,:,IKB)
!
! below bottom flux - not used
@@ -1918,8 +3050,8 @@ ZFPOS(:,:,IKB-1) = 0.0
! negative fluxes:
!
ZFNEG(:,:,IKB:IKE) = ZPHAT(:,:,IKB:IKE) + &
- PCR(:,:,IKB:IKE)*(ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB:IKE)) + &
- PCR(:,:,IKB:IKE)*(1.0 + PCR(:,:,IKB:IKE)) * &
+ ZCR(:,:,IKB:IKE)*(ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB:IKE)) + &
+ ZCR(:,:,IKB:IKE)*(1.0 + ZCR(:,:,IKB:IKE)) * &
(ZPHAT(:,:,IKB:IKE) - 2.0*PSRC(:,:,IKB:IKE) +ZPHAT(:,:,IKB+1:IKE+1))
!
!!$ CALL GET_HALO(ZFNEG) ! JUAN
@@ -1928,31 +3060,131 @@ ZFNEG(:,:,IKB:IKE) = ZPHAT(:,:,IKB:IKE) + &
ZFNEG(:,:,IKB-1) = 0.0
!
! negative flux at the TOP
-ZFNEG(:,:,IKE+1) = (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1))*PCR(:,:,IKE+1) + &
+ZFNEG(:,:,IKE+1) = (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1))*ZCR(:,:,IKE+1) + &
ZPHAT(:,:,IKE+1)
!
! calculate the advection
!
+#ifndef _OPENACC
PR = PSRC * PRHO - &
- DZF(1,IKU,1, PCR*MZM(1,IKU,1,PRHO)*( ZFPOS*(0.5+SIGN(0.5,PCR)) + &
- ZFNEG*(0.5-SIGN(0.5,PCR)) ) )
+ DZF(1,IKU,1, ZCR*MZM(1,IKU,1,PRHO)*( ZFPOS(:,:,:)*(0.5+SIGN(0.5,ZCR)) + &
+ ZFNEG*(0.5-SIGN(0.5,ZCR)) ) )
+#else
+!$acc end kernels
+ CALL MZM_DEVICE(PRHO,ZRHO_MZM)
+!$acc kernels
+ ZCR_MZM = ZCR* ZRHO_MZM*( ZFPOS(:,:,:)*(0.5+SIGN(0.5,ZCR)) + ZFNEG*(0.5-SIGN(0.5,ZCR)) )
+ !dzf(ZCR_DZF,ZCR_MZM)
+!$acc end kernels
+ CALL DZF_DEVICE(1,1,1,ZCR_MZM,ZCR_DZF)
+!$acc kernels
+ PR = PSRC * PRHO - ZCR_DZF
+#endif
!
! in OPEN case fix boundary conditions
!
PR(:,:,IKB-1) = PR(:,:,IKB)
PR(:,:,IKE+1) = PR(:,:,IKE)
!
- CALL GET_HALO(PR) ! JUAN
+!$acc end kernels
!
+#ifndef _OPENACC
+ CALL GET_HALO(PR)
+#else
+!PW: BUG?: it is necessary to update self before call to get_halo_d
+!and update device after to get correct results on 4 processes and more with OpenACC
+!The reason is not clear, maybe a (compiler PGI 16.4?) bug in the updates of get_halo_d
+!$acc update self(PR)
+ CALL GET_HALO_D(PR)
+!$acc update device(PR)
+#endif
+CALL MPPDB_CHECK3DM("PPM::PPM_S0_Z ::PR",PRECISION,PR)
+!
+#ifdef _OPENACC
+END SUBROUTINE PPM_S0_Z_D
+
+END SUBROUTINE PPM_S0_Z
+#else
END FUNCTION PPM_S0_Z
+#endif
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
! ########################################################################
- FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, PCR, PRHO, PRHOT, &
+! FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+! PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_S1_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR)
+! ########################################################################
+USE MODE_ll
+USE MODE_IO_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
+!
+USE MODD_CONF
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG
+
+
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_S1_X not yet implemented'
+CALL ABORT
+#endif
+
+ CALL MNH_GET_ZT3D(IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+ CALL PPM_S1_X_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP, PR, &
+ ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRUT),ZT3D(:,:,:,IZFUP), &
+ ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
+
+ CALL MNH_REL_ZT3D(IZPHAT,IZRUT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+
+ CONTAINS
+!
+! ########################################################################
+! FUNCTION PPM_S1_X_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+! PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_S1_X_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR, ZPHAT,ZRUT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
+! ########################################################################
+#else
+! ########################################################################
+ FUNCTION PPM_S1_X(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S1_X - PPM advection scheme in X direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -1966,7 +3198,12 @@ END FUNCTION PPM_S0_Z
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
USE MODI_SHUMAN
+USE MODI_SHUMAN_DEVICE
+#endif
!
USE MODD_CONF
USE MODD_LUNIT
@@ -1981,15 +3218,27 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -1997,13 +3246,14 @@ INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT, ZRUT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT, ZRUT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZRPOS, ZRNEG
+!$acc declare present(ZPHAT,ZRUT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
!
! variables for limiting the correction flux
REAL :: ZSRCMAX, ZSRCMIN, ZFIN, ZFOUT
@@ -2026,7 +3276,7 @@ IKE = SIZE(PSRC,3) - JPVEXT
!
! Calculate contravariant component rho*u/dx
!
-ZRUT = PCR/PTSTEP * MXM(PRHO)
+ZRUT = ZCR/PTSTEP * MXM(PRHO)
!
! calculate 4th order fluxes at cell edges in the inner domain
!
@@ -2058,47 +3308,47 @@ END SELECT
! that makes it equivalent to the PPM flux
! flux_ppm = flux_up + flux_corr
!
-WHERE ( PCR(IIB:IIE,:,:) .GT. 0.0 )
+WHERE ( ZCR(IIB:IIE,:,:) .GT. 0.0 )
ZFUP(IIB:IIE,:,:) = ZRUT(IIB:IIE,:,:) * PSRC(IIB-1:IIE-1,:,:)
ZFCOR(IIB:IIE,:,:) = ZRUT(IIB:IIE,:,:) * &
- (1.0 - PCR(IIB:IIE,:,:)) * &
- (ZPHAT(IIB:IIE,:,:) - PSRC(IIB-1:IIE-1,:,:) - PCR(IIB:IIE,:,:) * &
+ (1.0 - ZCR(IIB:IIE,:,:)) * &
+ (ZPHAT(IIB:IIE,:,:) - PSRC(IIB-1:IIE-1,:,:) - ZCR(IIB:IIE,:,:) * &
(ZPHAT(IIB-1:IIE-1,:,:) - 2.0*PSRC(IIB-1:IIE-1,:,:)+ZPHAT(IIB:IIE,:,:)))
ELSEWHERE
ZFUP(IIB:IIE,:,:) = ZRUT(IIB:IIE,:,:) * PSRC(IIB:IIE,:,:)
ZFCOR(IIB:IIE,:,:) = ZRUT(IIB:IIE,:,:) * &
- (1.0 + PCR(IIB:IIE,:,:)) * &
- (ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:) + PCR(IIB:IIE,:,:) * &
+ (1.0 + ZCR(IIB:IIE,:,:)) * &
+ (ZPHAT(IIB:IIE,:,:) - PSRC(IIB:IIE,:,:) + ZCR(IIB:IIE,:,:) * &
(ZPHAT(IIB:IIE,:,:) - 2.0*PSRC(IIB:IIE,:,:) + ZPHAT(IIB+1:IIE+1,:,:)))
END WHERE
!
! set boundaries to CYCL
!
-WHERE ( PCR(IIB-1,:,:) .GT. 0.0 )
+WHERE ( ZCR(IIB-1,:,:) .GT. 0.0 )
ZFUP(IIB-1,:,:) = ZRUT(IIB-1,:,:) * PSRC(IIE-1,:,:)
ZFCOR(IIB-1,:,:) = ZRUT(IIB-1,:,:) * &
- (1.0 - PCR(IIB-1,:,:)) * &
- (ZPHAT(IIB-1,:,:) - PSRC(IIE-1,:,:) - PCR(IIB-1,:,:) * &
+ (1.0 - ZCR(IIB-1,:,:)) * &
+ (ZPHAT(IIB-1,:,:) - PSRC(IIE-1,:,:) - ZCR(IIB-1,:,:) * &
(ZPHAT(IIE-1,:,:) - 2.0*PSRC(IIE-1,:,:) + ZPHAT(IIB-1,:,:)))
ELSEWHERE
ZFUP(IIB-1,:,:) = ZRUT(IIB-1,:,:) * PSRC(IIB-1,:,:)
ZFCOR(IIB-1,:,:) = ZRUT(IIB-1,:,:) * &
- (1.0 + PCR(IIB-1,:,:)) * &
- (ZPHAT(IIB-1,:,:) - PSRC(IIB-1,:,:) + PCR(IIB-1,:,:) * &
+ (1.0 + ZCR(IIB-1,:,:)) * &
+ (ZPHAT(IIB-1,:,:) - PSRC(IIB-1,:,:) + ZCR(IIB-1,:,:) * &
(ZPHAT(IIB-1,:,:) - 2.0*PSRC(IIB-1,:,:) + ZPHAT(IIB,:,:)))
END WHERE
!
-WHERE ( PCR(IIE+1,:,:) .GT. 0.0 )
+WHERE ( ZCR(IIE+1,:,:) .GT. 0.0 )
ZFUP(IIE+1,:,:) = ZRUT(IIE+1,:,:) * PSRC(IIE,:,:)
ZFCOR(IIE+1,:,:) = ZRUT(IIE+1,:,:) * &
- (1.0 - PCR(IIE+1,:,:)) * &
- (ZPHAT(IIE+1,:,:) - PSRC(IIE,:,:) - PCR(IIE+1,:,:) * &
+ (1.0 - ZCR(IIE+1,:,:)) * &
+ (ZPHAT(IIE+1,:,:) - PSRC(IIE,:,:) - ZCR(IIE+1,:,:) * &
(ZPHAT(IIE,:,:) - 2.0*PSRC(IIE,:,:) + ZPHAT(IIE+1,:,:)))
ELSEWHERE
ZFUP(IIE+1,:,:) = ZRUT(IIE+1,:,:) * PSRC(IIE+1,:,:)
ZFCOR(IIE+1,:,:) = ZRUT(IIE+1,:,:) * &
- (1.0 + PCR(IIE+1,:,:)) * &
- (ZPHAT(IIE+1,:,:) - PSRC(IIE+1,:,:) + PCR(IIE+1,:,:) * &
+ (1.0 + ZCR(IIE+1,:,:)) * &
+ (ZPHAT(IIE+1,:,:) - PSRC(IIE+1,:,:) + ZCR(IIE+1,:,:) * &
(ZPHAT(IIE+1,:,:) - 2.0*PSRC(IIE+1,:,:) + ZPHAT(IIB+1,:,:)))
END WHERE
!
@@ -2198,15 +3448,90 @@ ZFCOR(IIB-1,:,:) = MIN( &
PR = PR - PTSTEP*DXF(ZFCOR)
!
!
+#ifdef _OPENACC
+ END SUBROUTINE PPM_S1_X_D
+END SUBROUTINE PPM_S1_X
+#else
END FUNCTION PPM_S1_X
+#endif
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+! ########################################################################
+! FUNCTION PPM_S1_Y(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+! PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_S1_Y(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR)
+! ########################################################################
+USE MODE_ll
+USE MODE_IO_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
+!
+USE MODD_CONF
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
+
+
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_S1_Y not yet implemented'
+CALL ABORT
+#endif
+
+ CALL MNH_GET_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+ CALL PPM_S1_Y_D(HLBCX, KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP, PR, &
+ ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRVT),ZT3D(:,:,:,IZFUP), &
+ ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
+
+ CALL MNH_REL_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+
+ CONTAINS
+!
+! ########################################################################
+! FUNCTION PPM_S1_Y_D(HLBCY, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+! PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_S1_Y_D(HLBCY, KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR, ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
! ########################################################################
- FUNCTION PPM_S1_Y(HLBCY, KGRID, PSRC, PCR, PRHO, PRHOT, &
+#else
+! ########################################################################
+ FUNCTION PPM_S1_Y(HLBCY, KGRID, PSRC, ZCR, PRHO, PRHOT, &
PTSTEP) RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S1_Y - PPM advection scheme in Y direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -2220,12 +3545,20 @@ END FUNCTION PPM_S1_X
!
USE MODE_ll
USE MODE_IO_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
USE MODI_SHUMAN
+USE MODI_SHUMAN_DEVICE
+#endif
!
USE MODD_LUNIT
USE MODD_CONF
USE MODD_PARAMETERS
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+#ifdef _OPENACC
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
!
IMPLICIT NONE
!
@@ -2235,15 +3568,27 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! X direction LBC type
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -2251,13 +3596,14 @@ INTEGER:: IIB,IJB,IKB ! Begining useful area in x,y,z directions
INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT, ZRVT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT, ZRVT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZRPOS, ZRNEG
+!$acc declare present(ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
!
! variables for limiting the correction flux
REAL :: ZSRCMAX, ZSRCMIN, ZFIN, ZFOUT
@@ -2286,7 +3632,7 @@ IKE = SIZE(PSRC,3) - JPVEXT
!
!-------------------------------------------------------------------------------
!
-ZRVT = PCR/PTSTEP * MYM(PRHO)
+ZRVT = ZCR/PTSTEP * MYM(PRHO)
!
! calculate 4th order fluxes at cell edges in the inner domain !
ZPHAT(:,IJB+1:IJE,:) = (7.0 * &
@@ -2317,47 +3663,47 @@ END SELECT
! that makes it equivalent to the PPM flux
! flux_ppm = flux_up + flux_corr
!
-WHERE ( PCR(:,IJB:IJE,:) .GT. 0.0 )
+WHERE ( ZCR(:,IJB:IJE,:) .GT. 0.0 )
ZFUP(:,IJB:IJE,:) = ZRVT(:,IJB:IJE,:) * PSRC(:,IJB-1:IJE-1,:)
ZFCOR(:,IJB:IJE,:) = ZRVT(:,IJB:IJE,:) * &
- (1.0 - PCR(:,IJB:IJE,:)) * &
- (ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB-1:IJE-1,:) - PCR(:,IJB:IJE,:) * &
+ (1.0 - ZCR(:,IJB:IJE,:)) * &
+ (ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB-1:IJE-1,:) - ZCR(:,IJB:IJE,:) * &
(ZPHAT(:,IJB-1:IJE-1,:) - 2.0*PSRC(:,IJB-1:IJE-1,:)+ZPHAT(:,IJB:IJE,:)))
ELSEWHERE
ZFUP(:,IJB:IJE,:) = ZRVT(:,IJB:IJE,:) * PSRC(:,IJB:IJE,:)
ZFCOR(:,IJB:IJE,:) = ZRVT(:,IJB:IJE,:) * &
- (1.0 + PCR(:,IJB:IJE,:)) * &
- (ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:) + PCR(:,IJB:IJE,:) * &
+ (1.0 + ZCR(:,IJB:IJE,:)) * &
+ (ZPHAT(:,IJB:IJE,:) - PSRC(:,IJB:IJE,:) + ZCR(:,IJB:IJE,:) * &
(ZPHAT(:,IJB:IJE,:) - 2.0*PSRC(:,IJB:IJE,:) + ZPHAT(:,IJB+1:IJE+1,:)))
END WHERE
!
! set boundaries to CYCL
!
-WHERE ( PCR(:,IJB-1,:) .GT. 0.0 )
+WHERE ( ZCR(:,IJB-1,:) .GT. 0.0 )
ZFUP(:,IJB-1,:) = ZRVT(:,IJB-1,:) * PSRC(:,IJE-1,:)
ZFCOR(:,IJB-1,:) = ZRVT(:,IJB-1,:) * &
- (1.0 - PCR(:,IJB-1,:)) * &
- (ZPHAT(:,IJB-1,:) - PSRC(:,IJE-1,:) - PCR(:,IJB-1,:) * &
+ (1.0 - ZCR(:,IJB-1,:)) * &
+ (ZPHAT(:,IJB-1,:) - PSRC(:,IJE-1,:) - ZCR(:,IJB-1,:) * &
(ZPHAT(:,IJE-1,:) - 2.0*PSRC(:,IJE-1,:) + ZPHAT(:,IJB-1,:)))
ELSEWHERE
ZFUP(:,IJB-1,:) = ZRVT(:,IJB-1,:) * PSRC(:,IJB-1,:)
ZFCOR(:,IJB-1,:) = ZRVT(:,IJB-1,:) * &
- (1.0 + PCR(:,IJB-1,:)) * &
- (ZPHAT(:,IJB-1,:) - PSRC(:,IJB-1,:) + PCR(:,IJB-1,:) * &
+ (1.0 + ZCR(:,IJB-1,:)) * &
+ (ZPHAT(:,IJB-1,:) - PSRC(:,IJB-1,:) + ZCR(:,IJB-1,:) * &
(ZPHAT(:,IJB-1,:) - 2.0*PSRC(:,IJB-1,:) + ZPHAT(:,IJB,:)))
END WHERE
!
-WHERE ( PCR(:,IJE+1,:) .GT. 0.0 )
+WHERE ( ZCR(:,IJE+1,:) .GT. 0.0 )
ZFUP(:,IJE+1,:) = ZRVT(:,IJE+1,:) * PSRC(:,IJE,:)
ZFCOR(:,IJE+1,:) = ZRVT(:,IJE+1,:) * &
- (1.0 - PCR(:,IJE+1,:)) * &
- (ZPHAT(:,IJE+1,:) - PSRC(:,IJE,:) - PCR(:,IJE+1,:) * &
+ (1.0 - ZCR(:,IJE+1,:)) * &
+ (ZPHAT(:,IJE+1,:) - PSRC(:,IJE,:) - ZCR(:,IJE+1,:) * &
(ZPHAT(:,IJE,:) - 2.0*PSRC(:,IJE,:) + ZPHAT(:,IJE+1,:)))
ELSEWHERE
ZFUP(:,IJE+1,:) = ZRVT(:,IJE+1,:) * PSRC(:,IJE+1,:)
ZFCOR(:,IJE+1,:) = ZRVT(:,IJE+1,:) * &
- (1.0 + PCR(:,IJE+1,:)) * &
- (ZPHAT(:,IJE+1,:) - PSRC(:,IJE+1,:) + PCR(:,IJE+1,:) * &
+ (1.0 + ZCR(:,IJE+1,:)) * &
+ (ZPHAT(:,IJE+1,:) - PSRC(:,IJE+1,:) + ZCR(:,IJE+1,:) * &
(ZPHAT(:,IJE+1,:) - 2.0*PSRC(:,IJE+1,:) + ZPHAT(:,IJB+1,:)))
END WHERE
!
@@ -2455,15 +3801,86 @@ ZFCOR(:,IJB-1,:) = MIN( &
PR = PR - PTSTEP*DYF(ZFCOR)
!
!
+#ifdef _OPENACC
+ END SUBROUTINE PPM_S1_Y_D
+END SUBROUTINE PPM_S1_Y
+#else
END FUNCTION PPM_S1_Y
+#endif
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
+#ifdef _OPENACC
+!
+! ########################################################################
+! FUNCTION PPM_S1_Z(KGRID, PSRC, ZCR, PRHO, PRHOT, &
+! PTSTEP) RESULT(PR)
+ SUBROUTINE PPM_S1_Z(KGRID, PSRC, ZCR, PRHO, PRHOT, &
+ PTSTEP, PR)
+! ########################################################################
+USE MODE_ll
+USE MODE_IO_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
+!
+USE MODD_CONF
+USE MODD_LUNIT
+USE MODD_PARAMETERS
+!
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KGRID ! C grid localisation
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
+REAL, INTENT(IN) :: PTSTEP ! Time step
+!
+! output source term
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+!$acc declare present(PR)
+
+INTEGER :: IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG
+
+
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm::PPM_S1_Z not yet implemented'
+CALL ABORT
+#endif
+
+ CALL MNH_GET_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+ CALL PPM_S1_Z_D(KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP, PR, &
+ ZT3D(:,:,:,IZPHAT),ZT3D(:,:,:,IZRVT),ZT3D(:,:,:,IZFUP), &
+ ZT3D(:,:,:,IZFCOR),ZT3D(:,:,:,IZRPOS),ZT3D(:,:,:,IZRNEG) )
+
+ CALL MNH_REL_ZT3D(IZPHAT,IZRVT,IZFUP,IZFCOR,IZRPOS,IZRNEG)
+
+
+ CONTAINS
+! ########################################################################
+ SUBROUTINE PPM_S1_Z_D(KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP, &
+ PR, ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
! ########################################################################
- FUNCTION PPM_S1_Z(KGRID, PSRC, PCR, PRHO, PRHOT, PTSTEP) &
+#else
+! ########################################################################
+ FUNCTION PPM_S1_Z(KGRID, PSRC, ZCR, PRHO, PRHOT, PTSTEP) &
RESULT(PR)
! ########################################################################
+#endif
!!
!!**** PPM_S1_Z - PPM advection scheme in Z direction in Skamarock 2006
!! notation - with flux limiting for monotonicity
@@ -2476,11 +3893,19 @@ END FUNCTION PPM_S1_Y
!-------------------------------------------------------------------------------
!
USE MODE_ll
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
USE MODI_SHUMAN
+USE MODI_SHUMAN_DEVICE
+#endif
!
USE MODD_CONF
USE MODD_PARAMETERS
!USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
+#ifdef _OPENACC
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
!
IMPLICIT NONE
!
@@ -2488,15 +3913,27 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KGRID ! C grid localisation
!
+#ifndef _OPENACC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSRC ! variable at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCR ! Courant number
-!
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSRC ! variable at t
+!$acc declare present(PSRC)
+#endif
+REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCR ! Courant number
+!$acc declare present(ZCR)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+!$acc declare present(PRHO)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOT ! density at t+dt
+!$acc declare present(PRHOT)
REAL, INTENT(IN) :: PTSTEP ! Time step
!
! output source term
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: PR
+#ifndef _OPENACC
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: PR
+#else
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PR
+!$acc declare present(PR)
+#endif
!
!* 0.2 Declarations of local variables :
!
@@ -2505,13 +3942,14 @@ INTEGER:: IIE,IJE,IKE ! End useful area in x,y,z directions
INTEGER:: IKU
!
! variable at cell edges
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZPHAT, ZRVT
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZPHAT, ZRVT
!
! advection fluxes, upwind and correction
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZFUP, ZFCOR
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZFUP, ZFCOR
!
! ratios for limiting the correction flux
-REAL, DIMENSION(SIZE(PCR,1),SIZE(PCR,2),SIZE(PCR,3)) :: ZRPOS, ZRNEG
+REAL, DIMENSION(SIZE(ZCR,1),SIZE(ZCR,2),SIZE(ZCR,3)) :: ZRPOS, ZRNEG
+!$acc declare present(ZPHAT,ZRVT,ZFUP,ZFCOR,ZRPOS,ZRNEG)
!
! variables for limiting the correction flux
REAL :: ZSRCMAX, ZSRCMIN, ZFIN, ZFOUT
@@ -2532,7 +3970,7 @@ IKU = SIZE(PSRC,3)
!
!-------------------------------------------------------------------------------
!
-ZRVT = PCR/PTSTEP * MZM(1,IKU,1,PRHO)
+ZRVT = ZCR/PTSTEP * MZM(1,IKU,1,PRHO)
!
! calculate 4th order fluxes at cell edges in the inner domain !
ZPHAT(:,:,IKB+1:IKE) = (7.0 * &
@@ -2560,78 +3998,78 @@ ZPHAT(:,:,IKE+1) = (7.0 * &
! that makes it equivalent to the PPM flux
! flux_ppm = flux_up + flux_corr
!
-WHERE ( PCR(:,:,IKB:IKE) .GT. 0.0 )
+WHERE ( ZCR(:,:,IKB:IKE) .GT. 0.0 )
ZFUP(:,:,IKB:IKE) = ZRVT(:,:,IKB:IKE) * PSRC(:,:,IKB-1:IKE-1)
ZFCOR(:,:,IKB:IKE) = ZRVT(:,:,IKB:IKE) * &
- (1.0 - PCR(:,:,IKB:IKE)) * &
- (ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB-1:IKE-1) - PCR(:,:,IKB:IKE) * &
+ (1.0 - ZCR(:,:,IKB:IKE)) * &
+ (ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB-1:IKE-1) - ZCR(:,:,IKB:IKE) * &
(ZPHAT(:,:,IKB-1:IKE-1) - 2.0*PSRC(:,:,IKB-1:IKE-1)+ZPHAT(:,:,IKB:IKE)))
ELSEWHERE
ZFUP(:,:,IKB:IKE) = ZRVT(:,:,IKB:IKE) * PSRC(:,:,IKB:IKE)
ZFCOR(:,:,IKB:IKE) = ZRVT(:,:,IKB:IKE) * &
- (1.0 + PCR(:,:,IKB:IKE)) * &
- (ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB:IKE) + PCR(:,:,IKB:IKE) * &
+ (1.0 + ZCR(:,:,IKB:IKE)) * &
+ (ZPHAT(:,:,IKB:IKE) - PSRC(:,:,IKB:IKE) + ZCR(:,:,IKB:IKE) * &
(ZPHAT(:,:,IKB:IKE) - 2.0*PSRC(:,:,IKB:IKE) + ZPHAT(:,:,IKB+1:IKE+1)))
END WHERE
!
! set BC to WALL
!
-WHERE ( PCR(:,:,IKB-1) .GT. 0.0 )
+WHERE ( ZCR(:,:,IKB-1) .GT. 0.0 )
ZFUP(:,:,IKB-1) = ZRVT(:,:,IKB-1) * PSRC(:,:,IKB+2)
ZFCOR(:,:,IKB-1) = ZRVT(:,:,IKB-1) * &
- (1.0 - PCR(:,:,IKB-1)) * &
- (ZPHAT(:,:,IKB+1) - PSRC(:,:,IKB+2) - PCR(:,:,IKB+1) * &
+ (1.0 - ZCR(:,:,IKB-1)) * &
+ (ZPHAT(:,:,IKB+1) - PSRC(:,:,IKB+2) - ZCR(:,:,IKB+1) * &
(ZPHAT(:,:,IKB+2) - 2.0*PSRC(:,:,IKB+2) + ZPHAT(:,:,IKB+1)))
ELSEWHERE
ZFUP(:,:,IKB-1) = ZRVT(:,:,IKB-1) * PSRC(:,:,IKB+1)
ZFCOR(:,:,IKB-1) = ZRVT(:,:,IKB-1) * &
- (1.0 + PCR(:,:,IKB-1)) * &
- (ZPHAT(:,:,IKB+1) - PSRC(:,:,IKB+1) + PCR(:,:,IKB+1) * &
+ (1.0 + ZCR(:,:,IKB-1)) * &
+ (ZPHAT(:,:,IKB+1) - PSRC(:,:,IKB+1) + ZCR(:,:,IKB+1) * &
(ZPHAT(:,:,IKB+1) - 2.0*PSRC(:,:,IKB+1) + ZPHAT(:,:,IKB)))
END WHERE
!
-WHERE ( PCR(:,:,IKE+1) .GT. 0.0 )
+WHERE ( ZCR(:,:,IKE+1) .GT. 0.0 )
ZFUP(:,:,IKE+1) = ZRVT(:,:,IKE+1) * PSRC(:,:,IKE)
ZFCOR(:,:,IKE+1) = ZRVT(:,:,IKE+1) * &
- (1.0 - PCR(:,:,IKE+1)) * &
- (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE) - PCR(:,:,IKE+1) * &
+ (1.0 - ZCR(:,:,IKE+1)) * &
+ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE) - ZCR(:,:,IKE+1) * &
(ZPHAT(:,:,IKE) - 2.0*PSRC(:,:,IKE) + ZPHAT(:,:,IKE+1)))
ELSEWHERE
ZFUP(:,:,IKE+1) = ZRVT(:,:,IKE+1) * PSRC(:,:,IKE+1)
ZFCOR(:,:,IKE+1) = ZRVT(:,:,IKE+1) * &
- (1.0 + PCR(:,:,IKE+1)) * &
- (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1) + PCR(:,:,IKE+1) * &
+ (1.0 + ZCR(:,:,IKE+1)) * &
+ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1) + ZCR(:,:,IKE+1) * &
(ZPHAT(:,:,IKE+1) - 2.0*PSRC(:,:,IKE+1) + ZPHAT(:,:,IKE)))
END WHERE
!
!
!!$! set boundaries to CYCL
!!$!
-!!$WHERE ( PCR(:,:,IKB-1) .GT. 0.0 )
+!!$WHERE ( ZCR(:,:,IKB-1) .GT. 0.0 )
!!$ ZFUP(:,:,IKB-1) = ZRVT(:,:,IKB-1) * PSRC(:,:,IKE-1)
!!$ ZFCOR(:,:,IKB-1) = ZRVT(:,:,IKB-1) * &
-!!$ (1.0 - PCR(:,:,IKB-1)) * &
-!!$ (ZPHAT(:,:,IKB-1) - PSRC(:,:,IKE-1) - PCR(:,:,IKB-1) * &
+!!$ (1.0 - ZCR(:,:,IKB-1)) * &
+!!$ (ZPHAT(:,:,IKB-1) - PSRC(:,:,IKE-1) - ZCR(:,:,IKB-1) * &
!!$ (ZPHAT(:,:,IKE-1) - 2.0*PSRC(:,:,IKE-1) + ZPHAT(:,:,IKB-1)))
!!$ELSEWHERE
!!$ ZFUP(:,:,IKB-1) = ZRVT(:,:,IKB-1) * PSRC(:,:,IKB-1)
!!$ ZFCOR(:,:,IKB-1) = ZRVT(:,:,IKB-1) * &
-!!$ (1.0 + PCR(:,:,IKB-1)) * &
-!!$ (ZPHAT(:,:,IKB-1) - PSRC(:,:,IKB-1) + PCR(:,:,IKB-1) * &
+!!$ (1.0 + ZCR(:,:,IKB-1)) * &
+!!$ (ZPHAT(:,:,IKB-1) - PSRC(:,:,IKB-1) + ZCR(:,:,IKB-1) * &
!!$ (ZPHAT(:,:,IKB-1) - 2.0*PSRC(:,:,IKB-1) + ZPHAT(:,:,IKB)))
!!$END WHERE
!!$!
-!!$WHERE ( PCR(:,:,IKE+1) .GT. 0.0 )
+!!$WHERE ( ZCR(:,:,IKE+1) .GT. 0.0 )
!!$ ZFUP(:,:,IKE+1) = ZRVT(:,:,IKE+1) * PSRC(:,:,IKE)
!!$ ZFCOR(:,:,IKE+1) = ZRVT(:,:,IKE+1) * &
-!!$ (1.0 - PCR(:,:,IKE+1)) * &
-!!$ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE) - PCR(:,:,IKE+1) * &
+!!$ (1.0 - ZCR(:,:,IKE+1)) * &
+!!$ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE) - ZCR(:,:,IKE+1) * &
!!$ (ZPHAT(:,:,IKE) - 2.0*PSRC(:,:,IKE) + ZPHAT(:,:,IKE+1)))
!!$ELSEWHERE
!!$ ZFUP(:,:,IKE+1) = ZRVT(:,:,IKE+1) * PSRC(:,:,IKE+1)
!!$ ZFCOR(:,:,IKE+1) = ZRVT(:,:,IKE+1) * &
-!!$ (1.0 + PCR(:,:,IKE+1)) * &
-!!$ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1) + PCR(:,:,IKE+1) * &
+!!$ (1.0 + ZCR(:,:,IKE+1)) * &
+!!$ (ZPHAT(:,:,IKE+1) - PSRC(:,:,IKE+1) + ZCR(:,:,IKE+1) * &
!!$ (ZPHAT(:,:,IKE+1) - 2.0*PSRC(:,:,IKE+1) + ZPHAT(:,:,IKB+1)))
!!$END WHERE
!
@@ -2770,4 +4208,9 @@ ZFCOR(:,:,IKB-1) = MIN( &
PR = PR - PTSTEP*DZF(1,IKU,1,ZFCOR)
!
!
+#ifdef _OPENACC
+ END SUBROUTINE PPM_S1_Z_D
+END SUBROUTINE PPM_S1_Z
+#else
END FUNCTION PPM_S1_Z
+#endif
diff --git a/src/MNH/ppm_met.f90 b/src/MNH/ppm_met.f90
index d97e2fd934972159f48356c3dcee125c185caf10..d3a91e8a4e08e75d115d6b8ced0af51934388255 100644
--- a/src/MNH/ppm_met.f90
+++ b/src/MNH/ppm_met.f90
@@ -27,20 +27,34 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! Courant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! numbers
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
!
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
+!PW: bug workaround with PGI 15.10
+!PTKET is present but if zero-size => not detected as present
+!!$acc declare present(PTHT,PTKET,PRT)
+!$acc declare present(PTHT,PRT)
+!$acc declare pcopyin(PTKET)
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTHS, PRTKES! Source terms
+!PW: bug workaround with PGI 15.10
+!PRTKES is present but if zero-size => not detected as present
+!!$acc declare present(PRTHS,PRTKES)
+!$acc declare present(PRTHS)
+!$acc declare pcopyout(PRTKES)
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRRS
+!$acc declare present(PRRS)
!
END SUBROUTINE PPM_MET
!
@@ -119,20 +133,34 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
!
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
+!PW: bug workaround with PGI 15.10
+!PTKET is present but if zero-size => not detected as present
+!!$acc declare present(PTHT,PTKET,PRT)
+!$acc declare present(PTHT,PRT)
+!$acc declare pcopyin(PTKET)
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRTHS, PRTKES! Source terms
+!PW: bug workaround with PGI 15.10
+!PRTKES is present but if zero-size => not detected as present
+!!$acc declare present(PRTHS,PRTKES)
+!$acc declare present(PRTHS)
+!$acc declare pcopyout(PRTKES)
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRRS
+!$acc declare present(PRRS)
!
!* 0.2 Declarations of local variables :
!
diff --git a/src/MNH/ppm_rhodj.f90 b/src/MNH/ppm_rhodj.f90
index 89d59a4de0789d89594f2598d0b622f05c6d1377..c274100d9ba3b5e8c53bc84fdf2052bd2767666a 100644
--- a/src/MNH/ppm_rhodj.f90
+++ b/src/MNH/ppm_rhodj.f90
@@ -20,13 +20,16 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! Contravariants compon.
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV !
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
!
REAL, INTENT(IN) :: PTSTEP ! Single Time step
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2, PRHOY1,PRHOY2, PRHOZ1,PRHOZ2)
!
END SUBROUTINE PPM_RHODJ
!
@@ -74,6 +77,13 @@ END MODULE MODI_PPM_RHODJ
! ------------
!
USE MODI_PPM
+#ifdef _OPENACC
+USE OPENACC
+
+USE MODE_DEVICE
+!
+USE MODE_MNH_ZWORK, ONLY : ZUNIT => ZUNIT3D
+#endif
!
!
!
@@ -87,11 +97,14 @@ CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2, PRHOY1,PRHOY2, PRHOZ1,PRHOZ2)
!
REAL, INTENT(IN) :: PTSTEP ! Time step
!
@@ -99,13 +112,17 @@ REAL, INTENT(IN) :: PTSTEP ! Time step
!
INTEGER :: IGRID ! localisation on the model grid
!
+!ZUNIT is always = 1. => use the one of mode_mnh_zwork if OpenACC
+#ifndef _OPENACC
REAL, DIMENSION(SIZE(PCRU,1),SIZE(PCRU,2),SIZE(PCRU,3)) :: ZUNIT
+#endif
!
!-------------------------------------------------------------------------------
!
!
IGRID = 1
!
+#ifndef _OPENACC
ZUNIT = 1.0
PRHOX1 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHODJ, PTSTEP)
PRHOY1 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOX1, PTSTEP)
@@ -113,6 +130,14 @@ PRHOZ1 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHOY1, PTSTEP)
PRHOZ2 = PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHODJ, PTSTEP)
PRHOY2 = PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOZ2, PTSTEP)
PRHOX2 = PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHOY2, PTSTEP)
+#else
+CALL PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHODJ, PTSTEP,PRHOX1)
+CALL PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOX1, PTSTEP,PRHOY1)
+CALL PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHOY1, PTSTEP,PRHOZ1)
+CALL PPM_S0_Z(IGRID, ZUNIT, PCRW, PRHODJ, PTSTEP,PRHOZ2)
+CALL PPM_S0_Y(HLBCY, IGRID, ZUNIT, PCRV, PRHOZ2, PTSTEP,PRHOY2)
+CALL PPM_S0_X(HLBCX, IGRID, ZUNIT, PCRU, PRHOY2, PTSTEP,PRHOX2)
+#endif
!
!
END SUBROUTINE PPM_RHODJ
diff --git a/src/MNH/ppm_scalar.f90 b/src/MNH/ppm_scalar.f90
index 0c6ab86c00e8e30fbf181322630f8b9c98326c0b..4b41ff4c6d018bf2093f9abe777fae6d0003d1fe 100644
--- a/src/MNH/ppm_scalar.f90
+++ b/src/MNH/ppm_scalar.f90
@@ -30,18 +30,29 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! Courant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! numbers
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW !
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
!
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
!
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Vars at t
+!PW: bug workaround with PGI 15.10
+!PSVT is present but if zero-size => not detected as present
+!!$acc declare present(PSVT)
+!$acc declare pcopyin(PSVT)
!
-REAL, DIMENSION(:,:,:,:), INTENT(OUT ) :: PRSVS ! Source terms
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRSVS ! Source terms
+!PW: bug workaround with PGI 15.10
+!PRSVS is present but if zero-size => not detected as present
+!!$acc declare present(PRSVS)
+!$acc declare pcopyout(PRSVS)
!
!
END SUBROUTINE PPM_SCALAR
@@ -51,11 +62,72 @@ END INTERFACE
END MODULE MODI_PPM_SCALAR
!
! ######################################################################
+#ifdef _OPENACC
SUBROUTINE PPM_SCALAR (HLBCX,HLBCY, KSV, TPDTCUR, &
PCRU, PCRV, PCRW, PTSTEP, PTSTEP_PPM, &
PRHODJ, PRHOX1, PRHOX2, PRHOY1, PRHOY2,&
PRHOZ1, PRHOZ2, &
PSVT, PRSVS, HSV_ADV_SCHEME )
+ USE MODD_TYPE_DATE, ONLY : DATE_TIME
+ USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+ IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
+CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
+CHARACTER (LEN=6), INTENT(IN) :: HSV_ADV_SCHEME
+!
+INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
+TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
+!$acc declare present(PCRU,PCRV,PCRW)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
+! Temporary advected rhodj
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
+!
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
+!PW: bug workaround with PGI 15.10
+!PSVT is present but if zero-size => not detected as present
+!!$acc declare present(PSVT)
+!$acc declare pcopyin(PSVT)
+!
+REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRSVS ! Source terms
+!PW: bug workaround with PGI 15.10
+!PRSVS is present but if zero-size => not detected as present
+!!$acc declare present(PRSVS)
+!$acc declare pcopyout(PRSVS)
+
+ CALL PPM_SCALAR_D (HLBCX,HLBCY, KSV, TPDTCUR, &
+ PCRU, PCRV, PCRW, PTSTEP, PTSTEP_PPM, &
+ PRHODJ, PRHOX1, PRHOX2, PRHOY1, PRHOY2,&
+ PRHOZ1, PRHOZ2, &
+ PSVT, PRSVS, HSV_ADV_SCHEME)
+
+CONTAINS
+
+ SUBROUTINE PPM_SCALAR_D (HLBCX,HLBCY, KSV, TPDTCUR, &
+ PCRU, PCRV, PCRW, PTSTEP, PTSTEP_PPM, &
+ PRHODJ, PRHOX1, PRHOX2, PRHOY1, PRHOY2,&
+ PRHOZ1, PRHOZ2, &
+ PSVT, PRSVS, HSV_ADV_SCHEME)
+#else
+ SUBROUTINE PPM_SCALAR (HLBCX,HLBCY, KSV, TPDTCUR, &
+ PCRU, PCRV, PCRW, PTSTEP, PTSTEP_PPM, &
+ PRHODJ, PRHOX1, PRHOX2, PRHOY1, PRHOY2,&
+ PRHOZ1, PRHOZ2, &
+ PSVT, PRSVS, HSV_ADV_SCHEME )
+#endif
! ######################################################################
!
!!**** *PPM_SCALAR *
@@ -118,18 +190,23 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRU ! contravariant
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRV ! components
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRW ! of momentum
+!$acc declare present(PCRU,PCRV,PCRW)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density
+!$acc declare present(PRHODJ)
! Temporary advected rhodj
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOX1,PRHOX2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOY1,PRHOY2
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHOZ1,PRHOZ2
+!$acc declare present(PRHOX1,PRHOX2,PRHOY1,PRHOY2,PRHOZ1,PRHOZ2)
!
REAL, INTENT(IN) :: PTSTEP ! Time step model
REAL, INTENT(IN) :: PTSTEP_PPM ! Time Step PPM
!
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
+!$acc declare present(PSVT)
!
REAL, DIMENSION(:,:,:,:), INTENT(OUT) :: PRSVS ! Source terms
+!$acc declare present(PRSVS)
!
!
!* 0.2 Declarations of local variables :
@@ -148,11 +225,18 @@ IGRID = 1
! Case with KSV tracers
!
DO JSV=1,KSV
+#ifdef _OPENACC
+PRINT *,'OPENACC: ppm_scalar::KSV>0 not yet tested'
+CALL ABORT
+#endif
CALL ADVEC_PPM_ALGO(HSV_ADV_SCHEME, HLBCX, HLBCY, IGRID, PSVT(:,:,:,JSV), &
PRHODJ, PTSTEP, PTSTEP_PPM, &
PRHOX1, PRHOX2, PRHOY1, PRHOY2, PRHOZ1, PRHOZ2, &
PRSVS(:,:,:,JSV), TPDTCUR, PCRU, PCRV, PCRW)
END DO
!
+#ifdef _OPENACC
+END SUBROUTINE PPM_SCALAR_D
+#endif
!
END SUBROUTINE PPM_SCALAR
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 9fedcde5c96b54351106c78a076f30c060f52807..119d39b69d3afe040a1e59233b0c913cb09b4bfb 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -74,6 +74,11 @@ REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PTHVREF,PLOCPEXNM,PATHETA,PAMOIST,PLM,PLEPS,PTHLM,PTKEM, &
+!$acc & PRM,PSVM,PSRCM, &
+!$acc & PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,PREDS1,PRED2THS3,PRED2RS3, &
+!$acc & PBLL_O_E,PETHETA,PEMOIST)
!
END SUBROUTINE PRANDTL
!
@@ -193,6 +198,7 @@ END MODULE MODI_PRANDTL
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed
!! vertical levels
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -206,7 +212,11 @@ USE MODD_PARAMETERS
USE MODI_GRADIENT_M
USE MODI_EMOIST
USE MODI_ETHETA
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODE_FMWRIT
!
IMPLICIT NONE
@@ -262,13 +272,19 @@ REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PRED2RS3 ! Redelsperger number R*2_qsv
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBLL_O_E! beta*Lk*Leps/tke
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PETHETA ! coefficient E_theta
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEMOIST ! coefficient E_moist
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PTHVREF,PLOCPEXNM,PATHETA,PAMOIST,PLM,PLEPS,PTHLM,PTKEM, &
+!$acc & PRM,PSVM,PSRCM, &
+!$acc & PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3,PREDS1,PRED2THS3,PRED2RS3, &
+!$acc & PBLL_O_E,PETHETA,PEMOIST)
!
!
! 0.2 declaration of local variables
!
REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
- ZW1, ZW2, ZW3
+ ZW1, ZW2
! working variables
+!$acc declare create(ZW1,ZW2)
!
INTEGER :: IKB ! vertical index value for the first inner mass point
INTEGER :: IKE ! vertical index value for the last inner mass point
@@ -283,6 +299,15 @@ INTEGER:: JSV ! loop index for the scalar variables
INTEGER :: JLOOP
REAL :: ZMINVAL
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP2_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP3_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP4_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP5_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!
@@ -294,15 +319,27 @@ IKE = KKU-JPVEXT_TURB*KKL
ILENG=SIZE(PTHLM,1)*SIZE(PTHLM,2)*SIZE(PTHLM,3)
ISV =SIZE(PSVM,4)
!
+#ifndef _OPENACC
PETHETA(:,:,:) = MZM(KKA,KKU,KKL, ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) )
PEMOIST(:,:,:) = MZM(KKA,KKU,KKL, EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) )
PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+#else
+CALL ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,ZTMP1_DEVICE)
+CALL MZM_DEVICE(ZTMP1_DEVICE,PETHETA)
+CALL EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,ZTMP2_DEVICE)
+CALL MZM_DEVICE(ZTMP2_DEVICE,PEMOIST)
+!$acc kernels
+PETHETA(:,:,KKA) = 2.*PETHETA(:,:,IKB) - PETHETA(:,:,IKB+KKL)
+PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
!---------------------------------------------------------------------------
!
! 1.3 1D Redelsperger numbers
!
+#ifndef _OPENACC
PBLL_O_E(:,:,:) = MZM(KKA,KKU,KKL, XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
IF (KRR /= 0) THEN ! moist case
PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
@@ -313,10 +350,34 @@ ELSE ! dry case
PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
PREDR1(:,:,:) = 0.
END IF
+#else
+!$acc kernels
+ZTMP1_DEVICE(:,:,:) = XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:)
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP1_DEVICE,PBLL_O_E)
+IF (KRR /= 0) THEN ! moist case
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels async
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * ZTMP1_DEVICE
+!$acc end kernels
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ,ZTMP2_DEVICE)
+!$acc kernels async
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * ZTMP2_DEVICE
+!$acc end kernels
+!$acc wait
+ELSE ! dry case
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * ZTMP1_DEVICE
+ PREDR1(:,:,:) = 0.
+!$acc end kernels
+END IF
+#endif
!
! 3. Limits on 1D Redelperger numbers
! --------------------------------
!
+!$acc kernels
ZMINVAL = (1.-1./XPHI_LIM)
!
ZW1 = 1.
@@ -355,19 +416,31 @@ IF (KRR /= 0) THEN ! dry case
ZW2=SIGN(1.,PREDR1(:,:,:))
PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
END IF
-!
+!$acc end kernels
!
!---------------------------------------------------------------------------
!
! For the scalar variables
+#ifndef _OPENACC
DO JSV=1,ISV
PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
END DO
+#else
+!TODO: il faudrait definir GZ_M_W_DEVICE comme 'acc routine' pour pouvoir paralleliser cette boucle
+DO JSV=1,ISV
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ PREDS1(:,:,:,JSV)=XCTV*PBLL_O_E(:,:,:)*ZTMP1_DEVICE
+!$acc end kernels
+END DO
+#endif
!
+!$acc kernels
DO JSV=1,ISV
ZW2=SIGN(1.,PREDS1(:,:,:,JSV))
PREDS1(:,:,:,JSV)= ZW2(:,:,:) * MAX(1.E-30, ZW2(:,:,:)*PREDS1(:,:,:,JSV))
END DO
+!$acc end kernels
!
!---------------------------------------------------------------------------
!
@@ -376,54 +449,150 @@ END DO
!
IF(HTURBDIM=='1DIM') THEN ! 1D case
!
+PRINT *,'OPENACC: prandtl::1DIM not yet tested'
!
+!$acc kernels async
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2
+!$acc end kernels
!
+!$acc kernels async
PRED2R3(:,:,:) = PREDR1(:,:,:) **2
+!$acc end kernels
!
+!$acc kernels async
PRED2THR3(:,:,:) = PREDTH1(:,:,:) * PREDR1(:,:,:)
+!$acc end kernels
+!$acc wait
!
ELSE IF (L2D) THEN ! 3D case in a 2D model
!
IF (KRR /= 0) THEN ! moist 3D case
+#ifndef _OPENACC
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels async
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2+(XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * ZTMP2_DEVICE
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
+#ifndef _OPENACC
PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels async
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * ZTMP2_DEVICE
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
+#ifndef _OPENACC
PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
PEMOIST(:,:,:) * PETHETA(:,:,:) * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX))
PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels async
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * ZTMP2_DEVICE
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!$acc end kernels
+!$acc wait
+#endif
!
ELSE ! dry 3D case in a 2D model
+PRINT *,'OPENACC: prandtl::L2D=.T. and KRR=0 not yet tested'
+#ifndef _OPENACC
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * ZTMP2_DEVICE
+!$acc end kernels
+!$acc kernels async
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
+!$acc kernels async
PRED2R3(:,:,:) = 0.
+!$acc end kernels
!
+!$acc kernels async
PRED2THR3(:,:,:) = 0.
+!$acc end kernels
+!$acc wait
!
END IF
!
ELSE ! 3D case in a 3D model
!
IF (KRR /= 0) THEN ! moist 3D case
+#ifndef _OPENACC
PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 &
+ GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)**2 )
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2 + ZTMP2_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2TH3(:,:,:)= PREDTH1(:,:,:)**2 + ( XCTV*PBLL_O_E(:,:,:)*PETHETA(:,:,:) )**2 * ZTMP2_DEVICE
+ PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
+#ifndef _OPENACC
PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY)**2 )
PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2 + ZTMP2_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2R3(:,:,:)= PREDR1(:,:,:)**2 + (XCTV*PBLL_O_E(:,:,:)*PEMOIST(:,:,:))**2 * ZTMP2_DEVICE
+!$acc end kernels
+!$acc kernels async
+ PRED2R3(:,:,IKB)=PRED2R3(:,:,IKB+KKL)
+!$acc end kernels
+#endif
!
+#ifndef _OPENACC
PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
PEMOIST(:,:,:) * PETHETA(:,:,:) * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX)* &
@@ -431,16 +600,54 @@ ELSE ! 3D case in a 3D model
GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY)* &
GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY) )
PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP3_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDYY,PDZZ,PDZY,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE+ZTMP3_DEVICE*ZTMP4_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2THR3(:,:,:)= PREDR1(:,:,:) * PREDTH1(:,:,:) + XCTV**2*PBLL_O_E(:,:,:)**2 * &
+ PEMOIST(:,:,:) * PETHETA(:,:,:) * ZTMP2_DEVICE
+!$acc end kernels
+!$acc kernels async
+ PRED2THR3(:,:,IKB)=PRED2THR3(:,:,IKB+KKL)
+!$acc end kernels
+!$acc wait
+#endif
!
ELSE ! dry 3D case in a 3D model
+PRINT *,'OPENACC: prandtl::L2D=.F. and KRR=0 not yet tested'
+#ifndef _OPENACC
PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * &
MZM(KKA,KKU,KKL, GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)**2 &
+ GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)**2 )
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE**2 + ZTMP2_DEVICE**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2TH3(:,:,:) = PREDTH1(:,:,:)**2 + XCTV**2*PBLL_O_E(:,:,:)**2 * ZTMP2_DEVICE
+!$acc end kernels
+#endif
+!$acc kernels async
PRED2TH3(:,:,IKB)=PRED2TH3(:,:,IKB+KKL)
+!$acc end kernels
!
+!$acc kernels async
PRED2R3(:,:,:) = 0.
+!$acc end kernels
!
+!$acc kernels async
PRED2THR3(:,:,:) = 0.
+!$acc end kernels
+!$acc wait
!
END IF
!
@@ -451,47 +658,109 @@ END IF ! end of the if structure on the turbulence dimensionnality
!
! 5. Prandtl numbers for scalars
! ---------------------------
-DO JSV=1,ISV
!
- IF(HTURBDIM=='1DIM') THEN
+IF(HTURBDIM=='1DIM') THEN
! 1D case
+!$acc kernels
+ DO JSV=1,ISV
PRED2THS3(:,:,:,JSV) = PREDS1(:,:,:,JSV) * PREDTH1(:,:,:)
IF (KRR /= 0) THEN
PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) *PREDS1(:,:,:,JSV)
ELSE
PRED2RS3(:,:,:,JSV) = 0.
END IF
+ ENDDO
+!$acc end kernels
!
- ELSE IF (L2D) THEN ! 3D case in a 2D model
+ELSE IF (L2D) THEN ! 3D case in a 2D model
!
+#ifndef _OPENACC
+ DO JSV=1,ISV
IF (KRR /= 0) THEN
ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
END IF
+#else
+ DO JSV=1,ISV
+!$acc kernels
+ ZTMP1_DEVICE = (XG / PTHVREF * PLM * PLEPS / PTKEM)**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZW1)
+ IF (KRR /= 0) THEN
+!$acc kernels
+ ZW1 = ZW1*PETHETA
+!$acc end kernels
+ END IF
+#endif
+!
+#ifndef _OPENACC
PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1* &
MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
GX_M_M(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX) &
)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + ZW1 * ZTMP2_DEVICE
+!$acc end kernels
+#endif
!
IF (KRR /= 0) THEN
+#ifndef _OPENACC
PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1 * PEMOIST * &
MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
GX_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1) ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * ZTMP2_DEVICE
+!$acc end kernels
+#endif
ELSE
+!$acc kernels
PRED2RS3(:,:,:,JSV) = 0.
+!$acc end kernels
END IF
+ ENDDO
!
- ELSE ! 3D case in a 3D model
+ELSE ! 3D case in a 3D model
!
+#ifndef _OPENACC
+ DO JSV=1,ISV
IF (KRR /= 0) THEN
ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
ZW1 = MZM(KKA,KKU,KKL, (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
END IF
+#else
+ DO JSV=1,ISV
+!$acc kernels
+ ZTMP1_DEVICE = (XG / PTHVREF * PLM * PLEPS / PTKEM)**2
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZW1)
+ IF (KRR /= 0) THEN
+!$acc kernels
+ ZW1 = ZW1*PETHETA
+!$acc end kernels
+ END IF
+#endif
+!
+#ifndef _OPENACC
PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1* &
MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
@@ -499,8 +768,22 @@ DO JSV=1,ISV
+GY_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
GY_M_M(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY) &
)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY,ZTMP3_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDYY,PDZZ,PDZY,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE+ZTMP3_DEVICE*ZTMP4_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + ZW1 * ZTMP2_DEVICE
+!$acc end kernels
+#endif
!
IF (KRR /= 0) THEN
+#ifndef _OPENACC
PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
ZW1 * PEMOIST * &
MZM(KKA,KKU,KKL,GX_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
@@ -508,13 +791,28 @@ DO JSV=1,ISV
+GY_M_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
GY_M_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
)
+#else
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1) ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY,ZTMP3_DEVICE)
+ CALL GY_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1) ,PDYY,PDZZ,PDZY,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE+ZTMP3_DEVICE*ZTMP4_DEVICE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * ZTMP2_DEVICE
+!$acc end kernels
+#endif
ELSE
+!$acc kernels
PRED2RS3(:,:,:,JSV) = 0.
+!$acc end kernels
END IF
+ ENDDO
!
- END IF ! end of HTURBDIM if-block
-!
-END DO
+END IF ! end of HTURBDIM if-block
!
!---------------------------------------------------------------------------
!
@@ -522,6 +820,7 @@ END DO
! ------------------------------
!
IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+!$acc update self(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3)
!
! stores the RED_TH1
YRECFM ='RED_TH1'
diff --git a/src/MNH/rotate_wind.f90 b/src/MNH/rotate_wind.f90
index 3c02a915cd8ad89cf2176d7b6f5e21d5b7ad29da..99de384a0a91cde9d49c4e6f0db5acd1739a7d0a 100644
--- a/src/MNH/rotate_wind.f90
+++ b/src/MNH/rotate_wind.f90
@@ -36,6 +36,8 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PUSLOPE ! wind component along
! the maximum slope direction
REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
! the direction normal to the maximum slope one
+!$acc declare present(PU,PV,PW,PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE,PDXX,PDYY,PDZZ,PUSLOPE,PVSLOPE)
!
!-------------------------------------------------------------------------------
!
@@ -132,6 +134,8 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PUSLOPE ! wind component along
! the maximum slope direction
REAL, DIMENSION(:,:), INTENT(OUT) :: PVSLOPE ! wind component along
! the direction normal to the maximum slope one
+!$acc declare present(PU,PV,PW,PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE,PDXX,PDYY,PDZZ,PUSLOPE,PVSLOPE)
!
!-------------------------------------------------------------------------------
!
@@ -147,6 +151,7 @@ REAL, DIMENSION(SIZE(PDIRCOSXW,1),SIZE(PDIRCOSXW,2)) :: ZCOEFF,ZCOEFM, &
! final values of the cartesian components after the 2 interp.
ZWGROUND
! vertical velocity at the surface
+!$acc declare create(ILOC,JLOC,ZCOEFF,ZCOEFM,ZUINT,ZVINT,ZWINT,ZUFIN,ZVFIN,ZWFIN,ZWGROUND)
INTEGER :: IIB,IIE,IJB,IJE,IKB
! index values for the Beginning or the End of the physical
! domain in x,y and z directions
@@ -159,6 +164,7 @@ INTEGER :: JI,JJ
!* 1. PRELIMINARIES
! -------------
!
+!$acc kernels
PUSLOPE=0.
PVSLOPE=0.
!
@@ -233,6 +239,7 @@ DO JJ = IJB,IJE
!
END DO
END DO
+!$acc end kernels
!
!
!
diff --git a/src/MNH/sbl_depth.f90 b/src/MNH/sbl_depth.f90
index b9add72367f32f69eb048d2f64dff7ad166df5c2..08bc9184168aaaa7df8e4e17f5a8f509d336e57c 100644
--- a/src/MNH/sbl_depth.f90
+++ b/src/MNH/sbl_depth.f90
@@ -99,6 +99,10 @@ REAL, DIMENSION(SIZE(PFLXU,1),SIZE(PFLXU,2),SIZE(PFLXU,3)) :: ZWIND
! intermediate wind for SBL calculation
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZSBL_THER! SBL wih thermal criteria
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZA ! ponderation coefficient
+#ifdef _OPENACC
+PRINT *,'OPENACC: SBL_DEPTH:: not yet implemented'
+CALL ABORT
+#endif
!----------------------------------------------------------------------------
!
!* initialisations
diff --git a/src/MNH/shuman.f90 b/src/MNH/shuman.f90
index 526fa0491afa685dc859a3b53a8c3ebddf493b11..5b76c5c0a81db3c491c872f69923c7d9e16ebade 100644
--- a/src/MNH/shuman.f90
+++ b/src/MNH/shuman.f90
@@ -14,68 +14,53 @@
INTERFACE
!
FUNCTION DXF(PA) RESULT(PDXF)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass localization
END FUNCTION DXF
!
FUNCTION DXM(PA) RESULT(PDXM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
- ! side
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux side
END FUNCTION DXM
!
FUNCTION DYF(PA) RESULT(PDYF)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass localization
END FUNCTION DYF
!
FUNCTION DYM(PA) RESULT(PDYM)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
- ! side
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux side
END FUNCTION DYM
!
FUNCTION DZF(KKA,KKU,KL,PA) RESULT(PDZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
! localization
END FUNCTION DZF
!
FUNCTION DZM(KKA,KKU,KL,PA) RESULT(PDZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
- ! side
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux side
END FUNCTION DZM
!
FUNCTION MXF(PA) RESULT(PMXF)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass localization
END FUNCTION MXF
!
FUNCTION MXM(PA) RESULT(PMXM)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux localization
END FUNCTION MXM
-
+!
FUNCTION MYF(PA) RESULT(PMYF)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass localization
END FUNCTION MYF
!
FUNCTION MYM(PA) RESULT(PMYM)
@@ -84,19 +69,17 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux loc
END FUNCTION MYM
!
FUNCTION MZF(KKA,KKU,KL,PA) RESULT(PMZF)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
- ! localization
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass localization
END FUNCTION MZF
!
FUNCTION MZM(KKA,KKU,KL,PA) RESULT(PMZM)
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
END FUNCTION MZM
!
END INTERFACE
@@ -163,20 +146,20 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JI ! Loop index in x direction
-INTEGER :: IIU ! upper bound in x direction of PA
-!
-INTEGER :: JJK,IJU,IKU
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
@@ -187,7 +170,18 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
-JIJKOR = 1 + 1
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK = 1, IKU
+ DO JJ = 1, IJU
+ DO JI = 1 + 1, IIU
+ PMXF(JI-1,JJ,JK) = 0.5*( PA(JI-1,JJ,JK)+PA(JI,JJ,JK) )
+ ENDDO
+ ENDDO
+ENDDO
+!
+PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:)
+#else
+JIJKOR = 1 + 1
JIJKEND = IIU*IJU*IKU
!
!CDIR NODEP
@@ -203,10 +197,12 @@ DO JI=1,JPHEXT
PMXF(IIU-JPHEXT+JI,JJK,1) = PMXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
END DO
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION MXF
+!
! ###############################
FUNCTION MXM(PA) RESULT(PMXM)
! ###############################
@@ -272,12 +268,14 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMXM ! result at flux loc
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JI ! Loop index in x direction
-INTEGER :: IIU ! Size of the array in the x direction
-!
-INTEGER :: JJK,IJU,IKU
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
@@ -288,7 +286,22 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
-JIJKOR = 1 + 1
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK = 1, IKU
+ DO JJ = 1, IJU
+ DO JI = 1 + 1, IIU
+ PMXM(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI-1,JJ,JK) )
+ ENDDO
+ ENDDO
+ENDDO
+!
+DO JK = 1, IKU
+ DO JJ=1,IJU
+ PMXM(1,JJ,JK) = PMXM(IIU-2*JPHEXT+1,JJ,JK) !TODO: voir si ce n'est pas plutot JPHEXT+1
+ ENDDO
+ENDDO
+#else
+JIJKOR = 1 + 1
JIJKEND = IIU*IJU*IKU
!
!CDIR NODEP
@@ -304,10 +317,12 @@ DO JI=1,JPHEXT
PMXM(JI,JJK,1) = PMXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
END DO
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION MXM
+!
! ###############################
FUNCTION MYF(PA) RESULT(PMYF)
! ###############################
@@ -367,20 +382,19 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JJ ! Loop index in y direction
-INTEGER :: IJU ! upper bound in y direction of PA
-!
-INTEGER :: IIU,IKU
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
@@ -391,6 +405,15 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=1,IJU-1
+ DO JI=1,IIU !TODO: remplacer le 1 par JPHEXT ?
+ PMYF(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI,JJ+1,JK) )
+ END DO
+ END DO
+END DO
+#else
JIJKOR = 1 + IIU
JIJKEND = IIU*IJU*IKU
!
@@ -399,6 +422,7 @@ JIJKEND = IIU*IJU*IKU
DO JIJK=JIJKOR , JIJKEND
PMYF(JIJK-IIU,1,1) = 0.5*( PA(JIJK-IIU,1,1)+PA(JIJK,1,1) )
END DO
+#endif
!
DO JJ=1,JPHEXT
PMYF(:,IJU-JPHEXT+JJ,:) = PMYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
@@ -408,6 +432,7 @@ END DO
!-------------------------------------------------------------------------------
!
END FUNCTION MYF
+!
! ###############################
FUNCTION MYM(PA) RESULT(PMYM)
! ###############################
@@ -473,13 +498,14 @@ REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMYM ! result at flux loc
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JJ ! Loop index in y direction
-INTEGER :: IJU ! Size of the array in the y direction
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: IIU,IKU
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF MYM
@@ -489,6 +515,15 @@ IIU=SIZE(PA,1)
IJU=SIZE(PA,2)
IKU=SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=2,IJU !TODO: remplacer le 1+1 par 1+JPHEXT ?
+ DO JI=1,IIU
+ PMYM(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI,JJ-1,JK) )
+ END DO
+ END DO
+END DO
+#else
JIJKOR = 1 + IIU
JIJKEND = IIU*IJU*IKU
!CDIR NODEP
@@ -496,6 +531,7 @@ JIJKEND = IIU*IJU*IKU
DO JIJK=JIJKOR , JIJKEND
PMYM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU,1,1) )
END DO
+#endif
!
DO JJ=1,JPHEXT
PMYM(:,JJ,:) = PMYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
@@ -504,6 +540,7 @@ END DO
!-------------------------------------------------------------------------------
!
END FUNCTION MYM
+!
! ###############################
FUNCTION MZF(KKA,KKU,KL,PA) RESULT(PMZF)
! ###############################
@@ -555,23 +592,22 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass
- ! localization
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-INTEGER :: IKU ! upper bound in z direction of PA
-!
-INTEGER :: IIU,IJU
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJ
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
@@ -582,6 +618,11 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+PMZF(:,:,1:IKU-1) = 0.5*( PA(:,:,1:IKU-1)+PA(:,:,2:) )
+!
+PMZF(:,:,IKU) = -999.
+#else
JIJKOR = 1 + IIU*IJU
JIJKEND = IIU*IJU*IKU
!
@@ -596,10 +637,12 @@ END DO
DO JIJ=1,IIU*IJU
PMZF(JIJ,1,IKU) = PMZF(JIJ,1,IKU-1) !-999.
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION MZF
+!
! ###############################
FUNCTION MZM(KKA,KKU,KL,PA) RESULT(PMZM)
! ###############################
@@ -651,27 +694,37 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PMZM ! result at flux localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-INTEGER :: IKU ! upper bound in z direction of PA
-!
-INTEGER :: IIU,IJU
-INTEGER :: JIJ,JI,JJ
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJ
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF MZM
! ------------------
!
+#ifndef _OPT_LINEARIZED_LOOPS
+IKU = SIZE(PA,3)
+!
+DO JK=2,IKU !TODO: remplacer le 2 par JPHEXT+1 ?
+ PMZM(:,:,JK) = 0.5* ( PA(:,:,JK) + PA(:,:,JK-1) )
+END DO
+!
+PMZM(:,:,1) = -999.
+#else
IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
@@ -691,9 +744,12 @@ DO JIJ=1,IIU*IJU
PMZM(JIJ,1,1) = -999.
END DO
!
+#endif
+!
!-------------------------------------------------------------------------------
!
END FUNCTION MZM
+!
! ###############################
FUNCTION DXF(PA) RESULT(PDXF)
! ###############################
@@ -753,20 +809,20 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JI ! Loop index in x direction
-INTEGER :: IIU ! upper bound in x direction of PA
-!
-INTEGER :: JJK,IJU,IKU
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!
!-------------------------------------------------------------------------------
!
@@ -777,6 +833,21 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1+1,IIU
+ PDXF(JI-1,JJ,JK) = PA(JI,JJ,JK) - PA(JI-1,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+DO JK=1,IKU
+ DO JJ=1,IJU
+ PDXF(IIU,JJ,JK) = PDXF(2*JPHEXT,JJ,JK)
+ ENDDO
+ENDDO
+#else
JIJKOR = 1 + 1
JIJKEND = IIU*IJU*IKU
!
@@ -793,10 +864,12 @@ DO JI=1,JPHEXT
PDXF(IIU-JPHEXT+JI,JJK,1) = PDXF(JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
END DO
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION DXF
+!
! ###############################
FUNCTION DXM(PA) RESULT(PDXM)
! ###############################
@@ -854,21 +927,20 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux
- ! side
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDXM ! result at flux side
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JI ! Loop index in x direction
-INTEGER :: IIU ! Size of the array in the x direction
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: JJK,IJU,IKU
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF DXM
@@ -878,6 +950,21 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1+1,IIU !TODO: remplacer le 1 par JPHEXT ?
+ PDXM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI-1,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+DO JK=1,IKU
+ DO JJ=1,IJU
+ PDXM(1,JJ,JK) = PDXM(IIU-2*JPHEXT+1,JJ,JK) !TODO: remplacer -2*JPHEXT+1 par -JPHEXT ?
+ ENDDO
+ENDDO
+#else
JIJKOR = 1 + 1
JIJKEND = IIU*IJU*IKU
!
@@ -894,10 +981,12 @@ DO JI=1,JPHEXT
PDXM(JI,JJK,1) = PDXM(IIU-2*JPHEXT+JI,JJK,1) ! for reprod JPHEXT <> 1
END DO
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION DXM
+!
! ###############################
FUNCTION DYF(PA) RESULT(PDYF)
! ###############################
@@ -957,21 +1046,19 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass
- ! localization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JJ ! Loop index in y direction
-INTEGER :: IJU ! upper bound in y direction of PA
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: IIU,IKU
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF DYF
@@ -981,6 +1068,15 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=1,IJU-1 !TODO: remplacer le 1 par JPHEXT ?
+ DO JI=1,IIU
+ PDYF(JI,JJ,JK) = PA(JI,JJ+1,JK) - PA(JI,JJ,JK)
+ END DO
+ END DO
+END DO
+#else
JIJKOR = 1 + IIU
JIJKEND = IIU*IJU*IKU
!
@@ -989,6 +1085,7 @@ JIJKEND = IIU*IJU*IKU
DO JIJK=JIJKOR , JIJKEND
PDYF(JIJK-IIU,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
END DO
+#endif
!
DO JJ=1,JPHEXT
PDYF(:,IJU-JPHEXT+JJ,:) = PDYF(:,JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
@@ -997,6 +1094,7 @@ END DO
!-------------------------------------------------------------------------------
!
END FUNCTION DYF
+!
! ###############################
FUNCTION DYM(PA) RESULT(PDYM)
! ###############################
@@ -1056,20 +1154,18 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux
- ! side
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDYM ! result at flux side
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JJ ! Loop index in y direction
-INTEGER :: IJU ! Size of the array in the y direction
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: IIU,IKU
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -1080,6 +1176,19 @@ IIU=SIZE(PA,1)
IJU=SIZE(PA,2)
IKU=SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU
+ DO JJ=2,IJU !TODO: remplacer le 2 par JPHEXT+1 ?
+ DO JI=1,IIU
+ PDYM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI,JJ-1,JK)
+ END DO
+ END DO
+END DO
+!
+DO JJ=1,JPHEXT
+ PDYM(:,JJ,:) = PDYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
+END DO
+#else
JIJKOR = 1 + IIU
JIJKEND = IIU*IJU*IKU
!
@@ -1092,11 +1201,13 @@ END DO
DO JJ=1,JPHEXT
PDYM(:,JJ,:) = PDYM(:,IJU-2*JPHEXT+JJ,:) ! for reprod JPHEXT <> 1
END DO
+#endif
!
!
!-------------------------------------------------------------------------------
!
END FUNCTION DYM
+!
! ###############################
FUNCTION DZF(KKA,KKU,KL,PA) RESULT(PDZF)
! ###############################
@@ -1148,24 +1259,22 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux
- ! side
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass
- ! localization
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZF ! result at mass localization
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-INTEGER :: IKU ! upper bound in z direction of PA
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: IIU,IJU
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJ
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF DZF
@@ -1175,6 +1284,17 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=1,IKU-1 !TODO: remplacer le 1 par JPHEXT ?
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ PDZF(JI,JJ,JK) = PA(JI,JJ,JK+1)-PA(JI,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+PDZF(:,:,IKU) = -999.
+#else
JIJKOR = 1 + IIU*IJU
JIJKEND = IIU*IJU*IKU
!
@@ -1189,10 +1309,12 @@ END DO
DO JIJ=1,IIU*IJU
PDZF(JIJ,1,IKU) = -999.
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
END FUNCTION DZF
+!
! ###############################
FUNCTION DZM(KKA,KKU,KL,PA) RESULT(PDZM)
! ###############################
@@ -1244,24 +1366,22 @@ IMPLICIT NONE
!* 0.1 Declarations of argument and result
! ------------------------------------
!
-INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
-INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass
- ! localization
-REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux
- ! side
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(SIZE(PA,1),SIZE(PA,2),SIZE(PA,3)) :: PDZM ! result at flux side
!
!* 0.2 Declarations of local variables
! -------------------------------
!
-INTEGER :: JK ! Loop index in z direction
-INTEGER :: IKU ! upper bound in z direction of PA
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
!
-!
-INTEGER :: IIU,IJU
+#ifdef _OPT_LINEARIZED_LOOPS
INTEGER :: JIJ
INTEGER :: JIJK,JIJKOR,JIJKEND
-!
+#endif
+!
!-------------------------------------------------------------------------------
!
!* 1. DEFINITION OF DZM
@@ -1271,20 +1391,32 @@ IIU = SIZE(PA,1)
IJU = SIZE(PA,2)
IKU = SIZE(PA,3)
!
+#ifndef _OPT_LINEARIZED_LOOPS
+DO JK=2,IKU !TODO: remplacer le 1+1 par 1+JPHEXT ?
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ PDZM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI,JJ,JK-1)
+ END DO
+ END DO
+END DO
+!
+PDZM(:,:,1) = -999.
+#else
JIJKOR = 1 + IIU*IJU
JIJKEND = IIU*IJU*IKU
!
!CDIR NODEP
!OCL NOVREC
DO JIJK=JIJKOR , JIJKEND
- PDZM(JIJK,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+ PDZM(JIJK,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
END DO
!
!CDIR NODEP
!OCL NOVREC
DO JIJ=1,IIU*IJU
- PDZM(JIJ,1,1) = -999.
+ PDZM(JIJ,1,1) = -999.
END DO
+#endif
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/shuman_device.f90 b/src/MNH/shuman_device.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5c10471b615f41267373d04db84a631193d1b03e
--- /dev/null
+++ b/src/MNH/shuman_device.f90
@@ -0,0 +1,1469 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 operators 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+#ifdef _OPENACC
+! #########################
+ MODULE MODI_SHUMAN_DEVICE
+! #########################
+!
+INTERFACE
+!
+SUBROUTINE DXF_DEVICE(PA,PDXF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXF ! result at mass localization
+!$acc declare present(PA,PDXM)
+END SUBROUTINE DXF_DEVICE
+!
+SUBROUTINE DXM_DEVICE(PA,PDXM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXM ! result at flux side
+!$acc declare present(PA,PDXM)
+END SUBROUTINE DXM_DEVICE
+!
+SUBROUTINE DYF_DEVICE(PA,PDYF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYF ! result at mass localization
+!$acc declare present(PA,PDYF)
+END SUBROUTINE DYF_DEVICE
+!
+SUBROUTINE DYM_DEVICE(PA,PDYM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYM ! result at flux side
+!$acc declare present(PA,PDYM)
+END SUBROUTINE DYM_DEVICE
+!
+SUBROUTINE DZF_DEVICE(KKA,KKU,KL,PA,PDZF)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZF ! result at mass localization
+!$acc declare present(PA,PDZF)
+END SUBROUTINE DZF_DEVICE
+!
+SUBROUTINE DZM_DEVICE(KKA,KKU,KL,PA,PDZM)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZM ! result at flux side
+!$acc declare present(PA,PDZM)
+END SUBROUTINE DZM_DEVICE
+!
+SUBROUTINE MXF_DEVICE(PA,PMXF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMXF ! result at mass localization
+!$acc declare present(PA,PMXF)
+END SUBROUTINE MXF_DEVICE
+!
+SUBROUTINE MXM_DEVICE(PA,PMXM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMXM ! result at flux localization
+!$acc declare present(PA,PMXM)
+END SUBROUTINE MXM_DEVICE
+!
+SUBROUTINE MYF_DEVICE(PA,PMYF)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMYF ! result at mass localization
+!$acc declare present(PA,PMYF)
+END SUBROUTINE MYF_DEVICE
+!
+SUBROUTINE MYM_DEVICE(PA,PMYM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMYM ! result at flux localization
+!$acc declare present(PA,PMYM)
+END SUBROUTINE MYM_DEVICE
+!
+SUBROUTINE MZF_DEVICE(KKA,KKU,KL,PA,PMZF)
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMZF ! result at mass localization
+!$acc declare present(PA,PMZF)
+END SUBROUTINE MZF_DEVICE
+!
+SUBROUTINE MZM_DEVICE(PA,PMZM)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMZM ! result at flux localization
+!$acc declare present(PA,PMZM)
+END SUBROUTINE MZM_DEVICE
+!
+END INTERFACE
+!
+END MODULE MODI_SHUMAN_DEVICE
+!
+!
+! ###############################
+ SUBROUTINE MXF_DEVICE(PA,PMXF)
+! ###############################
+!
+!!**** *MXF* - Shuman operator : mean operator in x direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMXF(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i+1,:,:))
+!! At i=size(PA,1), PMXF(i,:,:) are replaced by the values of PMXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMXF ! result at mass localization
+!$acc declare present(PA,PMXF)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PMXF,PA)
+DO JK = 1, IKU
+ DO JJ = 1, IJU
+ DO JI = 1 + JPHEXT, IIU
+ PMXF(JI-1,JJ,JK) = 0.5*( PA(JI-1,JJ,JK)+PA(JI,JJ,JK) )
+ ENDDO
+ ENDDO
+ENDDO
+!
+PMXF(IIU,:,:) = PMXF(2*JPHEXT,:,:)
+!$acc end kernels
+#else
+JIJKOR = 1 + JPHEXT
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PMXF,PA)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMXF(JIJK-1,1,1) = 0.5*( PA(JIJK-1,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JJK=1,IJU*IKU
+ PMXF(IIU,JJK,1) = PMXF(2*JPHEXT,JJK,1)
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MXF_DEVICE
+!
+! ###############################
+ SUBROUTINE MXM_DEVICE(PA,PMXM)
+! ###############################
+!
+!!**** *MXM* - Shuman operator : mean operator in x direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PMXM(i,:,:) is defined by 0.5*(PA(i,:,:)+PA(i-1,:,:))
+!! At i=1, PMXM(1,:,:) are replaced by the values of PMXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMXM ! result at flux localization
+!$acc declare present(PA,PMXM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
+INTEGER :: JIJK,JIJKOR,JIJKEND
+
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PMXM)
+DO JK = 1, IKU
+ DO JJ = 1, IJU
+ DO JI = 1 + JPHEXT, IIU
+ PMXM(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI-1,JJ,JK) )
+ ENDDO
+ ENDDO
+ENDDO
+!
+DO JK = 1, IKU
+ DO JJ=1,IJU
+ PMXM(1,JJ,JK) = PMXM(IIU-2*JPHEXT+1,JJ,JK) !TODO: voir si ce n'est pas plutot JPHEXT+1
+ ENDDO
+ENDDO
+!$acc end kernels
+#else
+JIJKOR = 1 + JPHEXT
+JIJKEND = IIU*IJU*IKU
+!
+!CDIR NODEP
+!OCL NOVREC
+!$acc kernels present(PA,PMXM)
+DO JIJK=JIJKOR , JIJKEND
+ PMXM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-1,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JJK=1,IJU*IKU
+ PMXM(1,JJK,1) = PMXM(IIU-2*JPHEXT+1,JJK,1)
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MXM_DEVICE
+!
+! ###############################
+ SUBROUTINE MYF_DEVICE(PA,PMYF)
+! ###############################
+!
+!!**** *MYF* - Shuman operator : mean operator in y direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMYF(i,:,:) is defined by 0.5*(PA(:,j,:)+PA(:,j+1,:))
+!! At j=size(PA,2), PMYF(:,j,:) are replaced by the values of PMYF,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMYF ! result at mass localization
+!$acc declare present(PA,PMYF)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PMYF)
+DO JK=1,IKU
+ DO JJ=1,IJU-1
+ DO JI=1,IIU !TODO: remplacer le 1 par JPHEXT ?
+ PMYF(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI,JJ+1,JK) )
+ END DO
+ END DO
+END DO
+!
+PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:)
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PMYF)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMYF(JIJK-IIU,1,1) = 0.5*( PA(JIJK-IIU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+PMYF(:,IJU,:) = PMYF(:,2*JPHEXT,:)
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYF_DEVICE
+!
+! ###############################
+ SUBROUTINE MYM_DEVICE(PA,PMYM)
+! ###############################
+!
+!!**** *MYM* - Shuman operator : mean operator in y direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PMYM(:,j,:) is defined by 0.5*(PA(:,j,:)+PA(:,j-1,:))
+!! At j=1, PMYM(:,j,:) are replaced by the values of PMYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMYM ! result at flux localization
+!$acc declare present(PA,PMYM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
+INTEGER :: JIJK,JIJKOR,JIJKEND
+
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MYM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PMYM)
+DO JK=1,IKU
+ DO JJ=2,IJU !TODO: remplacer le 1+1 par 1+JPHEXT ?
+ DO JI=1,IIU
+ PMYM(JI,JJ,JK) = 0.5*( PA(JI,JJ,JK)+PA(JI,JJ-1,JK) )
+ END DO
+ END DO
+END DO
+!
+PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!CDIR NODEP
+!OCL NOVREC
+!$acc kernels present(PA,PMYM)
+DO JIJK=JIJKOR , JIJKEND
+ PMYM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU,1,1) )
+END DO
+!
+PMYM(:,1,:) = PMYM(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MYM_DEVICE
+!
+! ###############################
+ SUBROUTINE MZF_DEVICE(KKA,KKU,KL,PA,PMZF)
+! ###############################
+!
+!!**** *MZF* - Shuman operator : mean operator in z direction for a
+!! variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PMZF(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k+1))
+!! At k=size(PA,3), PMZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMZF ! result at mass localization
+!$acc declare present(PA,PMZF)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PMZF)
+PMZF(:,:,1:IKU-1) = 0.5*( PA(:,:,1:IKU-1)+PA(:,:,2:) )
+!
+PMZF(:,:,IKU) = -999.
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PMZF)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZF(JIJK-IIU*IJU,1,1) = 0.5*( PA(JIJK-IIU*IJU,1,1)+PA(JIJK,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZF(JIJ,1,IKU) = -999.
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MZF_DEVICE
+!
+! ###############################
+ SUBROUTINE MZM_DEVICE(PA,PMZM)
+! ###############################
+!
+!!**** *MZM* - Shuman operator : mean operator in z direction for a
+!! mass variable
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a mean
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PMZM(:,:,k) is defined by 0.5*(PA(:,:,k)+PA(:,:,k-1))
+!! At k=1, PMZM(:,:,1) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMZM ! result at flux localization
+!$acc declare present(PA,PMZM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF MZM
+! ------------------
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+IKU = SIZE(PA,3)
+!
+!$acc kernels present(PA,PMZM)
+DO JK=2,IKU !TODO: remplacer le 2 par JPHEXT+1 ?
+ PMZM(:,:,JK) = 0.5* ( PA(:,:,JK) + PA(:,:,JK-1) )
+END DO
+!
+PMZM(:,:,1) = -999.
+!$acc end kernels
+#else
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PMZM)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PMZM(JIJK,1,1) = 0.5*( PA(JIJK,1,1)+PA(JIJK-IIU*IJU,1,1) )
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PMZM(JIJ,1,1) = -999.
+END DO
+!$acc end kernels
+!
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MZM_DEVICE
+!
+! ###############################
+ SUBROUTINE DXF_DEVICE(PA,PDXF)
+! ###############################
+!
+!!**** *DXF* - Shuman operator : finite difference operator in x direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a x-flux
+! point (u point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDXF(i,:,:) is defined by (PA(i+1,:,:)-PA(i,:,:))
+!! At i=size(PA,1), PDXF(i,:,:) are replaced by the values of PDXF,
+!! which are the right values in the x-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXF ! result at mass localization
+!$acc declare present(PA,PDXF)
+ !
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDXF)
+DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1+JPHEXT,IIU
+ PDXF(JI-1,JJ,JK) = PA(JI,JJ,JK) - PA(JI-1,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+DO JK=1,IKU
+ DO JJ=1,IJU
+ PDXF(IIU,JJ,JK) = PDXF(2*JPHEXT,JJ,JK)
+ ENDDO
+ENDDO
+!$acc end kernels
+#else
+JIJKOR = 1 + JPHEXT
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDXF)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXF(JIJK-1,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JJK=1,IJU*IKU
+ PDXF(IIU,JJK,1) = PDXF(2*JPHEXT,JJK,1)
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DXF_DEVICE
+!
+! ###############################
+ SUBROUTINE DXM_DEVICE(PA,PDXM)
+! ###############################
+!
+!!**** *DXM* - Shuman operator : finite difference operator in x direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the x direction (I index) for a field PA localized at a mass
+! point. The result is localized at a x-flux point (u point).
+!
+!!** METHOD
+!! ------
+!! The result PDXM(i,:,:) is defined by (PA(i,:,:)-PA(i-1,:,:))
+!! At i=1, PDXM(1,:,:) are replaced by the values of PDXM,
+!! which are the right values in the x-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDXM ! result at flux side
+!$acc declare present(PA,PDXM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JJK
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DXM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDXM)
+DO JK=1,IKU
+ DO JJ=1,IJU
+ DO JI=1+1,IIU !TODO: remplacer le 1 par JPHEXT ?
+ PDXM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI-1,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+DO JK=1,IKU
+ DO JJ=1,IJU
+ PDXM(1,JJ,JK) = PDXM(IIU-2*JPHEXT+1,JJ,JK) !TODO: remplacer -2*JPHEXT+1 par -JPHEXT ?
+ ENDDO
+ENDDO
+!$acc end kernels
+#else
+JIJKOR = 1 + 1
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDXM)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDXM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-1,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JJK=1,IJU*IKU
+ PDXM(1,JJK,1) = PDXM(IIU-2*JPHEXT+1,JJK,1)
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DXM_DEVICE
+!
+! ###############################
+ SUBROUTINE DYF_DEVICE(PA,PDYF)
+! ###############################
+!
+!!**** *DYF* - Shuman operator : finite difference operator in y direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a y-flux
+! point (v point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDYF(:,j,:) is defined by (PA(:,j+1,:)-PA(:,j,:))
+!! At j=size(PA,2), PDYF(:,j,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYF ! result at mass localization
+!$acc declare present(PA,PDYF)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDYF)
+DO JK=1,IKU
+ DO JJ=1,IJU-1 !TODO: remplacer le 1 par JPHEXT ?
+ DO JI=1,IIU
+ PDYF(JI,JJ,JK) = PA(JI,JJ+1,JK) - PA(JI,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:)
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDYF)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYF(JIJK-IIU,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+PDYF(:,IJU,:) = PDYF(:,2*JPHEXT,:)
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DYF_DEVICE
+!
+! ###############################
+ SUBROUTINE DYM_DEVICE(PA,PDYM)
+! ###############################
+!
+!!**** *DYM* - Shuman operator : finite difference operator in y direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the y direction (J index) for a field PA localized at a mass
+! point. The result is localized at a y-flux point (v point).
+!
+!!** METHOD
+!! ------
+!! The result PDYM(:,j,:) is defined by (PA(:,j,:)-PA(:,j-1,:))
+!! At j=1, PDYM(:,1,:) are replaced by the values of PDYM,
+!! which are the right values in the y-cyclic case.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: declaration of parameter variables
+!! JPHEXT: define the number of marginal points out of the
+!! physical domain along the horizontal directions.
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! Modification to include the periodic case 13/10/94 J.Stein
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDYM ! result at flux side
+!$acc declare present(PA,PDYM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DYM
+! ------------------
+!
+IIU=SIZE(PA,1)
+IJU=SIZE(PA,2)
+IKU=SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDYM)
+DO JK=1,IKU
+ DO JJ=2,IJU !TODO: remplacer le 2 par JPHEXT+1 ?
+ DO JI=1,IIU
+ PDYM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI,JJ-1,JK)
+ END DO
+ END DO
+END DO
+!
+PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDYM)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDYM(JIJK,1,1) = PA(JIJK,1,1) - PA(JIJK-IIU,1,1)
+END DO
+!
+PDYM(:,1,:) = PDYM(:,IJU-2*JPHEXT+1,:)
+!$acc end kernels
+#endif
+!
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DYM_DEVICE
+!
+! ###############################
+ SUBROUTINE DZF_DEVICE(KKA,KKU,KL,PA,PDZF)
+! ###############################
+!
+!!**** *DZF* - Shuman operator : finite difference operator in z direction
+!! for a variable at a flux side
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a z-flux
+! point (w point). The result is localized at a mass point.
+!
+!!** METHOD
+!! ------
+!! The result PDZF(:,:,k) is defined by (PA(:,:,k+1)-PA(:,:,k))
+!! At k=size(PA,3), PDZF(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at flux side
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZF ! result at mass localization
+!$acc declare present(PA,PDZF)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZF
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDZF)
+DO JK=1,IKU-1 !TODO: remplacer le 1 par JPHEXT ?
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ PDZF(JI,JJ,JK) = PA(JI,JJ,JK+1)-PA(JI,JJ,JK)
+ END DO
+ END DO
+END DO
+!
+PDZF(:,:,IKU) = -999.
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDZF)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZF(JIJK-IIU*IJU,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZF(JIJ,1,IKU) = -999.
+END DO
+!$acc end kernels
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DZF_DEVICE
+!
+! ###############################
+ SUBROUTINE DZM_DEVICE(KKA,KKU,KL,PA,PDZM)
+! ###############################
+!
+!!**** *DZM* - Shuman operator : finite difference operator in z direction
+!! for a variable at a mass localization
+!!
+!! PURPOSE
+!! -------
+! The purpose of this function is to compute a finite difference
+! along the z direction (K index) for a field PA localized at a mass
+! point. The result is localized at a z-flux point (w point).
+!
+!!** METHOD
+!! ------
+!! The result PDZM(:,j,:) is defined by (PA(:,:,k)-PA(:,:,k-1))
+!! At k=1, PDZM(:,:,k) is defined by -999.
+!!
+!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of documentation of Meso-NH (SHUMAN operators)
+!! Technical specifications Report of The Meso-NH (chapters 3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Ducrocq * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/07/94
+!! optimisation 20/08/00 J. Escobar
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of argument and result
+! ------------------------------------
+!
+INTEGER, INTENT(IN) :: KKA, KKU ! near ground and uppest atmosphere array indexes
+INTEGER, INTENT(IN) :: KL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PA ! variable at mass localization
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDZM ! result at flux side
+!$acc declare present(PA,PDZM)
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JI, JJ, JK ! Loop indices
+INTEGER :: IIU, IJU, IKU ! upper bounds of PA
+!
+#ifdef _OPT_LINEARIZED_LOOPS
+INTEGER :: JIJ
+INTEGER :: JIJK,JIJKOR,JIJKEND
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. DEFINITION OF DZM
+! ------------------
+!
+IIU = SIZE(PA,1)
+IJU = SIZE(PA,2)
+IKU = SIZE(PA,3)
+!
+#ifndef _OPT_LINEARIZED_LOOPS
+!$acc kernels present(PA,PDZM)
+DO JK=2,IKU !TODO: remplacer le 1+1 par 1+JPHEXT ?
+ DO JJ=1,IJU
+ DO JI=1,IIU
+ PDZM(JI,JJ,JK) = PA(JI,JJ,JK) - PA(JI,JJ,JK-1)
+ END DO
+ END DO
+END DO
+!
+PDZM(:,:,1) = -999.
+!$acc end kernels
+#else
+JIJKOR = 1 + IIU*IJU
+JIJKEND = IIU*IJU*IKU
+!
+!$acc kernels present(PA,PDZM)
+!CDIR NODEP
+!OCL NOVREC
+DO JIJK=JIJKOR , JIJKEND
+ PDZM(JIJK,1,1) = PA(JIJK,1,1)-PA(JIJK-IIU*IJU,1,1)
+END DO
+!
+!CDIR NODEP
+!OCL NOVREC
+DO JIJ=1,IIU*IJU
+ PDZM(JIJ,1,1) = -999.
+END DO
+#endif
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE DZM_DEVICE
+#endif
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index b07ae8d7fdf9d27b522258638f5d7370863cee89..5d7faa508fa40b28aca8b8d5524370092e502d37 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_sources.f90
@@ -44,8 +44,9 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP, PTRH ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Ther. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
@@ -53,6 +54,9 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+!$acc declare present(PTKEM,PLM,PLEPS,PDP,PTRH, &
+!$acc & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+!$acc & PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS)
!
!
!
@@ -190,8 +194,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
-USE MODI_TRIDIAG
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_TRIDIAG_TKE
USE MODI_BUDGET
USE MODE_FMWRIT
@@ -233,8 +240,9 @@ LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP, PTRH ! Dyn. prod. of TKE
-REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Ther. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTRH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTP ! Ther. prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTKES ! RHOD * Jacobian *
! TKE at t+deltat
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PRTHLS ! Source of Theta_l
@@ -242,6 +250,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEF_DISS ! 1/(Cph*Exner)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRTKESM ! Advection source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTR ! Transport prod. of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDISS ! Dissipati prod. of TKE
+!$acc declare present(PTKEM,PLM,PLEPS,PDP,PTRH, &
+!$acc & PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
+!$acc & PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS)
!
!
!
@@ -258,8 +269,8 @@ REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: &
ZSOURCE, & ! source of evolution for the treated variable
ZTR, & ! turbulent transport of TKE
ZKEFF ! effectif diffusion coeff = LT * SQRT( TKE )
-LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
- ! 3D mask .T. if TKE < XTKEMIN
+!LOGICAL,DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: GTKENEG
+! ! 3D mask .T. if TKE < XTKEMIN
INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
@@ -272,7 +283,12 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
TYPE(LIST_ll), POINTER :: TZFIELDDISS_ll ! list of fields to exchange
INTEGER :: IINFO_ll ! return code of parallel routine
+!$acc declare create(ZA,ZRES,ZFLX,ZSOURCE,ZTR,ZKEFF)
!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
!----------------------------------------------------------------------------
NULLIFY(TZFIELDDISS_ll)
!
@@ -281,6 +297,7 @@ NULLIFY(TZFIELDDISS_ll)
!
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+!$acc kernels
IIU=SIZE(PTKEM,1)
IJU=SIZE(PTKEM,2)
IKB=KKA+JPVEXT_TURB*KKL
@@ -320,6 +337,7 @@ ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) + PRTKESM(:,:,:) / PRHODJ(:,:,:) &
- PTKEM(:,:,:) / PTSTEP &
+ PDP(:,:,:) + PTP(:,:,:) + ZTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
+!$acc end kernels
!
!* 2.2 implicit vertical TKE transport
!
@@ -327,20 +345,41 @@ ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) + PRTKESM(:,:,:) / PRHODJ(:,:,:
! Compute the vector giving the elements just under the diagonal for the
! matrix inverted in TRIDIAG
!
+#ifndef _OPENACC
ZA(:,:,:) = - PTSTEP * XCET * &
MZM(KKA,KKU,KKL,ZKEFF) * MZM(KKA,KKU,KKL,PRHODJ) / PDZZ**2
+#else
+CALL MZM_DEVICE(ZKEFF, ZTMP1_DEVICE) !Warning: re-used later
+CALL MZM_DEVICE(PRHODJ,ZTMP2_DEVICE) !Warning: re-used later
+!$acc kernels
+ZA(:,:,:) = - PTSTEP * XCET * ZTMP1_DEVICE * ZTMP2_DEVICE / PDZZ**2
+!$acc end kernels
+#endif
!
! Compute TKE at time t+deltat: ( stored in ZRES )
!
+#ifndef _OPENACC
CALL TRIDIAG_TKE(KKA,KKU,KKL,PTKEM,ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,&
& ZSOURCE,PTSTEP*ZFLX,ZRES)
CALL GET_HALO(ZRES)
+#else
+!$acc kernels
+ZTMP3_DEVICE = PTSTEP*ZFLX
+!$acc end kernels
+CALL TRIDIAG_TKE(KKA,KKU,KKL,PTKEM,ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,&
+ & ZSOURCE,ZTMP3_DEVICE,ZRES)
+!$acc update self(ZRES)
+CALL GET_HALO(ZRES)
+!$acc update device(ZRES)
+#endif
!
!* diagnose the dissipation
!
IF (LDIAG_IN_RUN) THEN
+!$acc data copyout(XCURRENT_TKE_DISS)
XCURRENT_TKE_DISS = ZFLX(:,:,:) * PTKEM(:,:,:) &
*(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:))
+!$acc end data
CALL ADD3DFIELD_ll(TZFIELDDISS_ll,XCURRENT_TKE_DISS)
CALL UPDATE_HALO_ll(TZFIELDDISS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDDISS_ll)
@@ -359,22 +398,50 @@ IF ( LLES_CALL .OR. &
!
! Compute the cartesian vertical flux of TKE in ZFLX
!
-
+#ifndef _OPENACC
ZFLX(:,:,:) = - XCET * MZM(KKA,KKU,KKL,ZKEFF) * &
DZM(KKA,KKU,KKL,PIMPL * ZRES + PEXPL * PTKEM ) / PDZZ
+#else
+!$acc kernels
+ ZTMP3_DEVICE = PIMPL * ZRES + PEXPL * PTKEM
+!$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = - XCET * ZTMP1_DEVICE * ZTMP4_DEVICE / PDZZ !Re-use of ZTMP1_DEVICE
+#endif
!
ZFLX(:,:,IKB) = 0.
ZFLX(:,:,KKA) = 0.
!
! Compute the whole turbulent TRansport of TKE:
!
+#ifndef _OPENACC
ZTR(:,:,:)= ZTR - DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PRHODJ) * ZFLX / PDZZ ) /PRHODJ
+#else
+ ZTMP1_DEVICE = ZTMP2_DEVICE * ZFLX / PDZZ !Re-use of ZTMP2_DEVICE
+!$acc end kernels
+ CALL DZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZTR(:,:,:)= ZTR - ZTMP2_DEVICE / PRHODJ
+!$acc end kernels
+#endif
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLX), X_LES_SUBGRID_WTke )
CALL LES_MEAN_SUBGRID( -ZTR, X_LES_SUBGRID_ddz_WTke )
+#else
+!$acc data copy(X_LES_SUBGRID_WTke,X_LES_SUBGRID_ddz_WTke)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_WTke )
+!$acc kernels
+ ZTMP1_DEVICE = -ZTR
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ddz_WTke )
+#endif
+!$acc end data
END IF
!
END IF
@@ -385,28 +452,42 @@ IF (LBUDGET_TKE) THEN
!
! add the dynamical production
!
+!$acc kernels
PRTKES(:,:,:) = PRTKES(:,:,:) + PDP(:,:,:) * PRHODJ(:,:,:)
+!$acc end kernels
+!$acc update self(PRTKES)
CALL BUDGET (PRTKES(:,:,:),5,'DP_BU_RTKE')
!
! add the thermal production
!
+!$acc kernels
PRTKES(:,:,:) = PRTKES(:,:,:) + PTP(:,:,:) * PRHODJ(:,:,:)
+!$acc end kernels
+!$acc update self(PRTKES)
CALL BUDGET (PRTKES(:,:,:),5,'TP_BU_RTKE')
!
! add the dissipation
!
+!$acc kernels
PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:)
+!$acc end kernels
+!$acc update self(PRTKES)
CALL BUDGET (PRTKES(:,:,:),5,'DISS_BU_RTKE')
END IF
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
! with the removal of the advection part
+!$acc kernels
PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
+!$acc end kernels
!
! stores the whole turbulent transport
!
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),5,'TR_BU_RTKE')
+IF (LBUDGET_TKE) THEN
+!$acc update self(PRTKES)
+ CALL BUDGET (PRTKES(:,:,:),5,'TR_BU_RTKE')
+END IF
!
!
!----------------------------------------------------------------------------
@@ -414,8 +495,10 @@ IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),5,'TR_BU_RTKE')
!* 3. COMPUTE THE DISSIPATIVE HEATING
! -------------------------------
!
+!$acc kernels
PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
+!$acc end kernels
!
!----------------------------------------------------------------------------
!
@@ -426,6 +509,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the dynamic production
!
+!$acc update self(PDP)
YRECFM ='DP'
YCOMMENT='X_Y_Z_DP (M**2/S**3)'
IGRID = 1
@@ -434,6 +518,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the thermal production
!
+!$acc update self(PTP)
YRECFM ='TP'
YCOMMENT='X_Y_Z_TP (M**2/S**3)'
IGRID = 1
@@ -442,6 +527,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the whole turbulent transport
!
+!$acc update self(ZTR)
YRECFM ='TR'
YCOMMENT='X_Y_Z_TR (M**2/S**3)'
IGRID = 1
@@ -454,7 +540,10 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
YCOMMENT='X_Y_Z_DISS (M**2/S**3)'
IGRID = 1
ILENCH=LEN(YCOMMENT)
+!$acc kernels
ZFLX(:,:,:) =-XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+!$acc end kernels
+!$acc update self(ZFLX)
CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
@@ -462,8 +551,12 @@ END IF
! the dissipation of TKE
!
IF (LLES_CALL ) THEN
+!$acc kernels
ZFLX(:,:,:) =-XCED * (PTKEM(:,:,:)**1.5) / PLEPS(:,:,:)
+!$acc end kernels
+!$acc data copy(X_LES_SUBGRID_DISS_Tke)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_DISS_Tke )
+!$acc end data
END IF
!
PTR=0.
diff --git a/src/MNH/tm06_h.f90 b/src/MNH/tm06_h.f90
index 58f018554c2b444b1126f1d2f986c3e9cb3a4628..6f9842faf7fae9d0e07a73b2535f874e8e4df776 100644
--- a/src/MNH/tm06_h.f90
+++ b/src/MNH/tm06_h.f90
@@ -25,6 +25,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
!
+!$acc declare present(PZZ,PFLXZ,PBL_DEPTH)
+!
!-------------------------------------------------------------------------------
!
END SUBROUTINE TM06_H
@@ -66,6 +68,7 @@ END MODULE MODI_TM06_H
!! MODIFICATIONS
!! -------------
!! Original sept. 2005
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
!! --------------------------------------------------------------------------
!
@@ -89,6 +92,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! altitude of flux levels
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZ ! heat flux
REAL, DIMENSION(:,:), INTENT(INOUT) :: PBL_DEPTH ! boundary layer height
!
+!$acc declare present(PZZ,PFLXZ,PBL_DEPTH)
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
@@ -98,9 +102,11 @@ INTEGER :: JK ! loop counter
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZFLXZMIN ! minimum of temperature flux
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)) :: ZBL_DEPTH! BL depth at previous time-step
REAL :: ZGROWTH ! maximum BL growth rate
+!$acc declare create(ZFLXZMIN,ZBL_DEPTH)
!----------------------------------------------------------------------------
!
!* mixed boundary layer cannot grow more rapidly than 1800m/h
+!$acc kernels
ZGROWTH = 2.0 ! (m/s)
!
!----------------------------------------------------------------------------
@@ -110,15 +116,21 @@ WHERE(ZBL_DEPTH(:,:)==XUNDEF) ZBL_DEPTH(:,:)=0.
!
PBL_DEPTH(:,:) = XUNDEF
ZFLXZMIN (:,:) = PFLXZ(:,:,KKB)
+!$acc end kernels
!
+!TODO BUG: paralleliser la boucle aevc OpenACC. Avec pgi14.9/16.07, le DO...WHERE..ENDWHERE...ENDDO ne compile pas
DO JK=KKTB,KKTE
+!$acc kernels
WHERE (PFLXZ(:,:,KKB)>0. .AND. PFLXZ(:,:,JK)<ZFLXZMIN(:,:))
PBL_DEPTH(:,:) = PZZ (:,:,JK) - PZZ(:,:,KKB)
ZFLXZMIN (:,:) = PFLXZ(:,:,JK)
END WHERE
+!$acc end kernels
END DO
!
+!$acc kernels
WHERE(PBL_DEPTH(:,:)/=XUNDEF) PBL_DEPTH(:,:)=MIN(PBL_DEPTH(:,:),ZBL_DEPTH(:,:)+ZGROWTH*PTSTEP)
+!$acc end kernels
!
!----------------------------------------------------------------------------
END SUBROUTINE TM06_H
diff --git a/src/MNH/tridiag_thermo.f90 b/src/MNH/tridiag_thermo.f90
index 8239886c230ac037c548d740d58001b4c959a87c..2019c088a111c452e0ae903965a7d31def938906 100644
--- a/src/MNH/tridiag_thermo.f90
+++ b/src/MNH/tridiag_thermo.f90
@@ -29,6 +29,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass poi
!
REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
!
+!$acc declare present(PVARM,PF,PDFDDTDZ,PDZZ,PRHODJ,PVARP)
+!
END SUBROUTINE TRIDIAG_THERMO
!
END INTERFACE
@@ -146,13 +148,18 @@ END MODULE MODI_TRIDIAG_THERMO
!! MODIFICATIONS
!! -------------
!! Original 04/2003 (from tridiag.f90)
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! ---------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
!
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
!
IMPLICIT NONE
!
@@ -172,6 +179,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass poi
!
REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at mass point
!
+!$acc declare present(PVARM,PF,PDFDDTDZ,PDZZ,PRHODJ,PVARP)
!
!* 0.2 declarations of local variables
!
@@ -187,6 +195,12 @@ INTEGER :: IKB,IKE ! inner vertical limits
INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
!
+!$acc declare create(ZRHODJ_DFDDTDZ_O_DZ2,ZA,ZB,ZC,ZY,ZGAM,ZBET,ZMZM_RHODJ)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZTMP1_DEVICE
+!$acc declare create(ZTMP1_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. Preliminaries
@@ -199,40 +213,55 @@ IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
!
-ZMZM_RHODJ = MZM(KKA,KKU,KKL,PRHODJ)
+#ifndef _OPENACC
+ZMZM_RHODJ = MZM(KKA,KKU,KKL,PRHODJ)
+#else
+CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
+#endif
+!$acc kernels async
ZRHODJ_DFDDTDZ_O_DZ2 = ZMZM_RHODJ*PDFDDTDZ/PDZZ**2
+!$acc end kernels
!
+!$acc kernels async
ZA=0.
ZB=0.
ZC=0.
ZY=0.
+!$acc end kernels
+!$acc wait
!
!
!* 2. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
+!$acc kernels async
ZY(:,:,IKB) = PRHODJ(:,:,IKB)*PVARM(:,:,IKB)/PTSTEP &
- ZMZM_RHODJ(:,:,IKB+KKL) * PF(:,:,IKB+KKL)/PDZZ(:,:,IKB+KKL) &
+ ZMZM_RHODJ(:,:,IKB ) * PF(:,:,IKB )/PDZZ(:,:,IKB ) &
+ ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB+KKL) &
- ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL * PVARM(:,:,IKB )
-!
-DO JK=IKTB+1,IKTE-1
- ZY(:,:,JK) = PRHODJ(:,:,JK)*PVARM(:,:,JK)/PTSTEP &
- - ZMZM_RHODJ(:,:,JK+KKL) * PF(:,:,JK+KKL)/PDZZ(:,:,JK+KKL) &
- + ZMZM_RHODJ(:,:,JK ) * PF(:,:,JK )/PDZZ(:,:,JK ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK+KKL) * PIMPL * PVARM(:,:,JK+KKL) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK+KKL) * PIMPL * PVARM(:,:,JK ) &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK ) * PIMPL * PVARM(:,:,JK ) &
- + ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK ) * PIMPL * PVARM(:,:,JK-KKL)
-END DO
+!$acc end kernels
+!
+! array notation
+!$acc kernels async
+ ZY(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)*PVARM(:,:,IKTB+1:IKTE-1)/PTSTEP &
+ - ZMZM_RHODJ(:,:,IKTB+1+KKL:IKTE-1+KKL) * PF(:,:,IKTB+1+KKL:IKTE-1+KKL)/PDZZ(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+ + ZMZM_RHODJ(:,:,IKTB+1:IKTE-1 ) * PF(:,:,IKTB+1:IKTE-1 )/PDZZ(:,:,IKTB+1:IKTE-1 ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1:IKTE-1 ) &
+ + ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1 ) * PIMPL * PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)
+!$acc end kernels
!
+!$acc kernels async
ZY(:,:,IKE) = PRHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
- ZMZM_RHODJ(:,:,IKE+KKL) * PF(:,:,IKE+KKL)/PDZZ(:,:,IKE+KKL) &
+ ZMZM_RHODJ(:,:,IKE ) * PF(:,:,IKE )/PDZZ(:,:,IKE ) &
- ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE ) &
+ ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL * PVARM(:,:,IKE-KKL)
+!$acc end kernels
!
+!$acc wait
!
!* 3. INVERSION OF THE TRIDIAGONAL SYSTEM
! -----------------------------------
@@ -242,25 +271,38 @@ IF ( PIMPL > 1.E-10 ) THEN
!* 3.1 arrays A, B, C
! --------------
!
+!$acc kernels async
ZB(:,:,IKB) = PRHODJ(:,:,IKB)/PTSTEP &
- ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
+!$acc end kernels
+!
+!$acc kernels async
ZC(:,:,IKB) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKB+KKL) * PIMPL
- DO JK=IKTB+1,IKTE-1
- ZA(:,:,JK) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK ) * PIMPL
- ZB(:,:,JK) = PRHODJ(:,:,JK)/PTSTEP &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK+KKL) * PIMPL &
- - ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK ) * PIMPL
- ZC(:,:,JK) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,JK+KKL) * PIMPL
- END DO
+!$acc end kernels
+!
+!$acc kernels async
+ ZA(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
+ ZB(:,:,IKTB+1:IKTE-1) = PRHODJ(:,:,IKTB+1:IKTE-1)/PTSTEP &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL &
+ - ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1:IKTE-1) * PIMPL
+ ZC(:,:,IKTB+1:IKTE-1) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKTB+1+KKL:IKTE-1+KKL) * PIMPL
+!$acc end kernels
+!
+!$acc kernels async
ZA(:,:,IKE) = ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
ZB(:,:,IKE) = PRHODJ(:,:,IKE)/PTSTEP &
- ZRHODJ_DFDDTDZ_O_DZ2(:,:,IKE ) * PIMPL
+!$acc end kernels
+!
+!$acc wait
+!
!
!* 3.2 going up
! --------
!
+!$acc kernels
ZBET(:,:) = ZB(:,:,IKB) ! bet = b(ikb)
PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
@@ -287,10 +329,13 @@ IF ( PIMPL > 1.E-10 ) THEN
DO JK = IKE-KKL,IKB,-1*KKL
PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
END DO
+!$acc end kernels
!
ELSE
!
+!$acc kernels
PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE) * PTSTEP / PRHODJ(:,:,IKTB:IKTE)
+!$acc end kernels
!
END IF
!
@@ -298,8 +343,10 @@ END IF
!* 4. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
+!$acc kernels
PVARP(:,:,KKA)=PVARP(:,:,IKB)
PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/tridiag_tke.f90 b/src/MNH/tridiag_tke.f90
index 170f83f6c3bf867f5828d170c1c4dbede9218aef..c2cb749a103d7fa8e2f57bd5a50e8f0343edcf3f 100644
--- a/src/MNH/tridiag_tke.f90
+++ b/src/MNH/tridiag_tke.f90
@@ -28,7 +28,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
! the implicit dissipation
!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
+!
+!$acc declare present(PVARM,PA,PRHODJ,PSOURCE,PDIAG,PVARP)
!
END SUBROUTINE TRIDIAG_TKE
!
@@ -165,12 +167,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PDIAG ! diagonal term linked to
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
!
+!$acc declare present(PVARM,PA,PRHODJ,PSOURCE,PDIAG,PVARP)
+!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
! RHS of the equation, 3D work array
REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
! 2D work array
+!$acc declare create(ZY,ZGAM,ZBET)
INTEGER :: JK ! loop counter
INTEGER :: IKB,IKE ! inner vertical limits
INTEGER :: IKT ! array size in k direction
@@ -181,6 +186,7 @@ INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
!* 1. COMPUTE THE RIGHT HAND SIDE
! ---------------------------
!
+!$acc kernels
IKT=SIZE(PVARM,3)
IKTB=1+JPVEXT_TURB
IKTE=IKT-JPVEXT_TURB
@@ -260,6 +266,7 @@ END IF
!
PVARP(:,:,KKA)=PVARP(:,:,IKB)
PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/tridiag_w.f90 b/src/MNH/tridiag_w.f90
index f16bbd8ef6329be9fc390645c9804cb9babdf3c3..8050ede969321fc4019f0ed2efe06ff65e715229 100644
--- a/src/MNH/tridiag_w.f90
+++ b/src/MNH/tridiag_w.f90
@@ -19,6 +19,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass poi
!
REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at flux point
!
+!$acc declare present(PVARM,PF,PDFDDWDZ,PMZF_DZZ,PRHODJ,PVARP)
+!
END SUBROUTINE TRIDIAG_W
!
END INTERFACE
@@ -142,13 +144,18 @@ END MODULE MODI_TRIDIAG_W
!! -------------
!! Original 04/2011 (from tridiag_thermo.f90)
!! 03/2014 modification of upper boundary condition
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! ---------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
USE MODD_PARAMETERS, ONLY : JPVEXT
!
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
!
IMPLICIT NONE
!
@@ -164,6 +171,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! (dry rho)*J at mass poi
!
REAL, DIMENSION(:,:,:), INTENT(OUT):: PVARP ! variable at t+1 at flux point
!
+!$acc declare present(PVARM,PF,PDFDDWDZ,PMZF_DZZ,PRHODJ,PVARP)
!
!* 0.2 declarations of local variables
!
@@ -174,6 +182,9 @@ REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
! RHS of the equation, 3D work array
REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2)) :: ZBET
! 2D work array
+!
+!$acc declare create(ZRHODJ_DFDDWDZ_O_DZ2,ZMZM_RHODJ,ZA,ZB,ZC,ZY,ZGAM,ZBET)
+!
INTEGER :: JK ! loop counter
INTEGER :: IKB,IKE,IKU ! inner vertical limits
!
@@ -186,13 +197,23 @@ IKB=1+JPVEXT
IKE=SIZE(PVARM,3)-JPVEXT
IKU=SIZE(PVARM,3)
!
+#ifndef _OPENACC
ZMZM_RHODJ = MZM(1,IKU,1,PRHODJ)
+#else
+CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
+#endif
+!$acc kernels async
ZRHODJ_DFDDWDZ_O_DZ2 = PRHODJ*PDFDDWDZ/PMZF_DZZ**2
+!$acc end kernels
!
+!$acc kernels async
ZA=0.
ZB=0.
ZC=0.
ZY=0.
+!$acc end kernels
+!
+!$acc wait
!
!
!* 2. COMPUTE THE RIGHT HAND SIDE
@@ -206,29 +227,43 @@ ZY=0.
!! - PRHODJ(k-1) * PDFDDWDZ(k-1) * PVARM(k) /PMZF_DZZ(k-1)**2
!! + PRHODJ(k-1) * PDFDDWDZ(k-1) * PVARM(k-1)/PMZF_DZZ(k-1)**2
!
+!$acc kernels async
ZY(:,:,IKB) = ZMZM_RHODJ(:,:,IKB)*PVARM(:,:,IKB)/PTSTEP &
- PRHODJ(:,:,IKB ) * PF(:,:,IKB )/PMZF_DZZ(:,:,IKB ) &
+ PRHODJ(:,:,IKB-1) * PF(:,:,IKB-1)/PMZF_DZZ(:,:,IKB-1) &
+ ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB) * PVARM(:,:,IKB+1)&
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB) * PVARM(:,:,IKB )
-!
-DO JK=IKB+1,IKE-1
- ZY(:,:,JK) = ZMZM_RHODJ(:,:,JK)*PVARM(:,:,JK)/PTSTEP &
- - PRHODJ(:,:,JK ) * PF(:,:,JK )/PMZF_DZZ(:,:,JK ) &
- + PRHODJ(:,:,JK-1) * PF(:,:,JK-1)/PMZF_DZZ(:,:,JK-1) &
- + ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) * PVARM(:,:,JK+1) &
- - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) * PVARM(:,:,JK ) &
- - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1) * PVARM(:,:,JK ) &
- + ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1) * PVARM(:,:,JK-1)
-END DO
+!$acc end kernels
+!
+! DO JK=IKB+1,IKE-1
+! !$acc kernels
+! ZY(:,:,JK) = ZMZM_RHODJ(:,:,JK)*PVARM(:,:,JK)/PTSTEP &
+! - PRHODJ(:,:,JK ) * PF(:,:,JK )/PMZF_DZZ(:,:,JK ) &
+! + PRHODJ(:,:,JK-1) * PF(:,:,JK-1)/PMZF_DZZ(:,:,JK-1) &
+! + ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) * PVARM(:,:,JK+1) &
+! - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) * PVARM(:,:,JK ) &
+! - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1) * PVARM(:,:,JK ) &
+! + ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1) * PVARM(:,:,JK-1)
+! !$acc end kernels
+! END DO
+!$acc kernels async
+ ZY(:,:,IKB+1:IKE-1) = ZMZM_RHODJ(:,:,IKB+1:IKE-1)*PVARM(:,:,IKB+1:IKE-1)/PTSTEP &
+ - PRHODJ(:,:,IKB+1:IKE-1 ) * PF(:,:,IKB+1:IKE-1 )/PMZF_DZZ(:,:,IKB+1:IKE-1 ) &
+ + PRHODJ(:,:,IKB:IKE-2) * PF(:,:,IKB:IKE-2)/PMZF_DZZ(:,:,IKB:IKE-2) &
+ + ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB+1:IKE-1 ) * PVARM(:,:,IKB+2:IKE) &
+ - ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB+1:IKE-1 ) * PVARM(:,:,IKB+1:IKE-1 ) &
+ - ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB:IKE-2) * PVARM(:,:,IKB+1:IKE-1 ) &
+ + ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB:IKE-2) * PVARM(:,:,IKB:IKE-2)
+!$acc end kernels
!
+!$acc kernels async
ZY(:,:,IKE) = ZMZM_RHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
- PRHODJ(:,:,IKE ) * PF(:,:,IKE )/PMZF_DZZ(:,:,IKE ) &
+ PRHODJ(:,:,IKE-1) * PF(:,:,IKE-1)/PMZF_DZZ(:,:,IKE-1) &
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE ) * PVARM(:,:,IKE ) &
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE-1) * PVARM(:,:,IKE ) &
+ ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE-1) * PVARM(:,:,IKE-1)
-!
+!$acc end kernels
!
!* 3. INVERSION OF THE TRIDIAGONAL SYSTEM
! -----------------------------------
@@ -243,26 +278,47 @@ ZY(:,:,IKE) = ZMZM_RHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
!! - PRHODJ(k-1) * PDFDDWDZ(k-1)/PMZF_DZZ(k-1)**2
!! c(k) = + PRHODJ(k) * PDFDDWDZ(k)/PMZF_DZZ(k)**2
!
+!$acc kernels async
ZB(:,:,IKB) = ZMZM_RHODJ(:,:,IKB)/PTSTEP &
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB)
+!$acc end kernels
+!$acc kernels async
ZC(:,:,IKB) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB)
+!$acc end kernels
- DO JK=IKB+1,IKE-1
- ZA(:,:,JK) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1)
- ZB(:,:,JK) = ZMZM_RHODJ(:,:,JK)/PTSTEP &
- - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) &
- - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1)
- ZC(:,:,JK) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK )
- END DO
+! DO JK=IKB+1,IKE-1
+! !$acc kernels
+! ZA(:,:,JK) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1)
+! ZB(:,:,JK) = ZMZM_RHODJ(:,:,JK)/PTSTEP &
+! - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK ) &
+! - ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK-1)
+! ZC(:,:,JK) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,JK )
+! !$acc end kernels
+! END DO
+!$acc kernels async
+ ZA(:,:,IKB+1:IKE-1) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB:IKE-2)
+ ZB(:,:,IKB+1:IKE-1) = ZMZM_RHODJ(:,:,IKB+1:IKE-1)/PTSTEP &
+ - ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB+1:IKE-1 ) &
+ - ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB:IKE-2)
+ ZC(:,:,IKB+1:IKE-1) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKB+1:IKE-1 )
+!$acc end kernels
+!$acc kernels async
ZA(:,:,IKE) = ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE-1)
+!$acc end kernels
+!$acc kernels async
ZB(:,:,IKE) = ZMZM_RHODJ(:,:,IKE)/PTSTEP &
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE ) &
- ZRHODJ_DFDDWDZ_O_DZ2(:,:,IKE-1)
+!$acc end kernels
+!
+!
+!$acc wait
!
!* 3.2 going up
! --------
!
+!$acc kernels
ZBET(:,:) = ZB(:,:,IKB) ! bet = b(ikb)
PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
@@ -296,6 +352,7 @@ ZY(:,:,IKE) = ZMZM_RHODJ(:,:,IKE)*PVARM(:,:,IKE)/PTSTEP &
!
PVARP(:,:,IKB-1)=PVARP(:,:,IKB)
PVARP(:,:,IKE+1)=0.
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/tridiag_wind.f90 b/src/MNH/tridiag_wind.f90
index 7e1b2c7a151ddc9c7dd46a0c665b60459a665b0f..4550c6904e148b1de246df76cf34e01d8511a1e3 100644
--- a/src/MNH/tridiag_wind.f90
+++ b/src/MNH/tridiag_wind.f90
@@ -30,6 +30,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
!
+!$acc declare present(PVARM,PA,PCOEFS,PRHODJA,PSOURCE,PVARP )
+!
END SUBROUTINE TRIDIAG_WIND
!
END INTERFACE
@@ -145,6 +147,7 @@ END MODULE MODI_TRIDIAG_WIND
!! (Stein) February 28, 1995 no inversion in the explicit case
!! (Seity) February 2012 add possibility to run with reversed
!! vertical levels
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! ---------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -170,6 +173,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PSOURCE ! source term of PVAR
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVARP ! variable at t+1
!
+!$acc declare present(PVARM,PA,PCOEFS,PRHODJA,PSOURCE,PVARP )
+!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZY ,ZGAM
@@ -181,6 +186,13 @@ INTEGER :: IKB,IKE ! inner vertical limits
INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
!
+!$acc declare create(ZY,ZGAM,ZBET)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PVARM,1),SIZE(PVARM,2),SIZE(PVARM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
+
! ---------------------------------------------------------------------------
!
!* 1. COMPUTE THE RIGHT HAND SIDE
@@ -194,20 +206,35 @@ IKE=KKU-JPVEXT_TURB*KKL
!
!
+!$acc kernels async
ZY(:,:,IKB) = PVARM(:,:,IKB) + PTSTEP*PSOURCE(:,:,IKB) - &
PEXPL / PRHODJA(:,:,IKB) * PA(:,:,IKB+KKL) * (PVARM(:,:,IKB+KKL) - PVARM(:,:,IKB))
-!
-DO JK=IKTB+1,IKTE-1
- ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
- PEXPL / PRHODJA(:,:,JK) * &
- ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
- -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
- +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+!$acc end kernels
+!
+! DO JK=IKTB+1,IKTE-1
+! ZY(:,:,JK)= PVARM(:,:,JK) + PTSTEP*PSOURCE(:,:,JK) - &
+! PEXPL / PRHODJA(:,:,JK) * &
+! ( PVARM(:,:,JK-KKL)*PA(:,:,JK) &
+! -PVARM(:,:,JK)*(PA(:,:,JK)+PA(:,:,JK+KKL)) &
+! +PVARM(:,:,JK+KKL)*PA(:,:,JK+KKL) &
+! )
+! END DO
+ !array notation
+!$acc kernels async
+ ZY(:,:,IKTB+1:IKTE-1)= PVARM(:,:,IKTB+1:IKTE-1) + PTSTEP*PSOURCE(:,:,IKTB+1:IKTE-1) - &
+ PEXPL / PRHODJA(:,:,IKTB+1:IKTE-1) * &
+ ( PVARM(:,:,IKTB+1-KKL:IKTE-1-KKL)*PA(:,:,IKTB+1:IKTE-1) &
+ -PVARM(:,:,IKTB+1:IKTE-1)*(PA(:,:,IKTB+1:IKTE-1)+PA(:,:,IKTB+1+KKL:IKTE-1+KKL)) &
+ +PVARM(:,:,IKTB+1+KKL:IKTE-1+KKL)*PA(:,:,IKTB+1+KKL:IKTE-1+KKL) &
)
-END DO
+!$acc end kernels
!
+!$acc kernels async
ZY(:,:,IKE)= PVARM(:,:,IKE) + PTSTEP*PSOURCE(:,:,IKE) + &
PEXPL / PRHODJA(:,:,IKE) * PA(:,:,IKE) * (PVARM(:,:,IKE)-PVARM(:,:,IKE-KKL))
+!$acc end kernels
+!
+!$acc wait
!
!
!* 2. INVERSION OF THE TRIDIAGONAL SYSTEM
@@ -218,6 +245,7 @@ IF ( PIMPL > 1.E-10 ) THEN
!
! going up
!
+!$acc kernels
ZBET(:,:) = 1. - PIMPL * ( PA(:,:,IKB+KKL) / PRHODJA(:,:,IKB) &
+ PCOEFS(:,:) * PTSTEP ) ! bet = b(ikb)
PVARP(:,:,IKB) = ZY(:,:,IKB) / ZBET(:,:)
@@ -250,10 +278,13 @@ IF ( PIMPL > 1.E-10 ) THEN
DO JK = IKE-KKL,IKB,-1*KKL
PVARP(:,:,JK) = PVARP(:,:,JK) - ZGAM(:,:,JK+KKL) * PVARP(:,:,JK+KKL)
END DO
+!$acc end kernels
!
ELSE
!
+!$acc kernels
PVARP(:,:,IKTB:IKTE) = ZY(:,:,IKTB:IKTE)
+!$acc end kernels
!
END IF
!
@@ -261,8 +292,10 @@ END IF
!* 3. FILL THE UPPER AND LOWER EXTERNAL VALUES
! ----------------------------------------
!
+!$acc kernels
PVARP(:,:,KKA)=PVARP(:,:,IKB)
PVARP(:,:,KKU)=PVARP(:,:,IKE)
+!$acc end kernels
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index ba6694e45cef05ea17171521807b57c215a7c2fc..d4a9d0b420e2f0d00b0bc9f45d4f244d662971f0 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -14,7 +14,7 @@ INTERFACE
HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF,PRHODREF, &
+ PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
PBL_DEPTH, PSBL_DEPTH, &
@@ -70,8 +70,6 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
! normal surface fluxes of theta and Rv
@@ -142,7 +140,7 @@ END MODULE MODI_TURB
HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
PTSTEP,HFMFILE,HLUOUT,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
- PRHODJ,PTHVREF,PRHODREF, &
+ PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
PBL_DEPTH,PSBL_DEPTH, &
@@ -358,7 +356,13 @@ USE MODI_TURB_VER
USE MODI_ROTATE_WIND
USE MODI_TURB_HOR_SPLT
USE MODI_TKE_EPS_SOURCES
+#ifndef _OPENACC
USE MODI_SHUMAN
+#else
+!PW: TODO: remove use modi_shuman
+USE MODI_SHUMAN
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GRADIENT_M
USE MODI_BUDGET
USE MODI_LES_MEAN_SUBGRID
@@ -376,6 +380,12 @@ USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+!
+!! use, intrinsic :: ISO_C_BINDING
+!
IMPLICIT NONE
!
!
@@ -428,13 +438,11 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSINSLOPE ! sinus of the angle
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry density * Grid size
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
! Temperature of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
!
REAL, DIMENSION(:,:), INTENT(IN) :: PSFTH,PSFRV, &
! normal surface fluxes of theta and Rv
PSFU,PSFV
-! normal surface fluxes of (u,v) parallel to the orography
+! normal surface fluxes of (u,v) parallel to the orography
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSFSV
! normal surface fluxes of Scalar var.
!
@@ -460,7 +468,6 @@ REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coeff
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
! PRT(:,:,:,1) is the conservative mixing ratio
-!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
@@ -471,7 +478,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
! Source terms for all passive scalar variables
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
! Sigma_s at time t+1 : square root of the variance of the deviation to the
-! saturation
+! saturation
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PFLXZTHVMF
! MF contribution for vert. turb. transport
@@ -485,12 +492,42 @@ REAL, DIMENSION(:,:,:), INTENT(OUT):: PTR ! Transport production of TKE
REAL, DIMENSION(:,:,:), INTENT(OUT):: PDISS ! Dissipation of TKE
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PLEM ! Mixing length
!
+! IN variables
+!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PRHODJ) &
+!$acc & copyin (PZZ,PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE,PTHVREF,PSFTH,PSFRV,PSFU,PSFV,PSFSV, &
+!$acc & PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT,PCEI,PRTKEMS,PFLXZTHVMF)
+!
+! INOUT variables
+!
+!$acc declare create(PBL_DEPTH,PSBL_DEPTH,PTHLT,PRT, &
+!$acc & PRUS,PRVS,PRWS,PRTHLS,PRTKES,PRRS,PRSVS)
+!
+! OUT variables
+!
+!$acc declare create(PSIGS,PWTH,PWRC,PWSV)
+!
!
!-------------------------------------------------------------------------------
!
! 0.2 declaration of local variables
!
-REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
+! REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
+! ZCP, & ! Cp at t-1
+! ZEXN, & ! EXN at t-1
+! ZT, & ! T at t-1
+! ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
+! ZLM, & ! Turbulent mixing length
+! ZLEPS, & ! Dissipative length
+! ZDP,ZTP, ZTRH, & ! Dynamic and Thermal Production of TKE
+! ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
+! ZCOEF_DISS, & ! 1/(Cph*Exner) for dissipative heating
+! ZFRAC_ICE, & ! ri fraction of rc+ri
+! ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
+! ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
+! ZTHLM ! initial potential temp.
+REAL,DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) ::&
ZCP, & ! Cp at t-1
ZEXN, & ! EXN at t-1
ZT, & ! T at t-1
@@ -504,8 +541,14 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR,& ! 3rd order moments
ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,& ! opposite of verticale derivate of 3rd order moments
ZTHLM, ZTR, ZDISS ! initial potential temp.
+!$acc declare create(ZCP,ZEXN,ZT,ZLOCPEXNM,ZLM,ZLEPS,ZDP,ZTP,ZTRH, &
+!$acc & ZAMOIST,ZATHETA,ZCOEF_DISS,ZFRAC_ICE, &
+!$acc & ZMWTH,ZMWR,ZMTH2,ZMR2,ZMTHR, &
+!$acc & ZFWTH,ZFWR,ZFTH2,ZFR2,ZFTHR,ZTHLM )
+!
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
ZRM ! initial mixing ratio
+!$acc declare create(ZRM)
REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
ZTAU22M,ZTAU33M, &
! tangential surface fluxes in the axes following the orography
@@ -521,10 +564,12 @@ REAL, ALLOCATABLE, DIMENSION(:,:) :: ZTAU11M,ZTAU12M, &
!
! Virtual Potential Temp. used
! in the Deardorff mixing length computation
+!$acc declare create(ZTAU11M,ZTAU12M,ZTAU22M,ZTAU33M,ZUSLOPE,ZVSLOPE,ZCDUEFF,ZLMO)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZLVOCPEXNM,ZLSOCPEXNM, & ! Lv/Cp/EXNREF and Ls/Cp/EXNREF at t-1
ZATHETA_ICE,ZAMOIST_ICE ! coefficients for s = f (Thetal,Rnp)
!
+!$acc declare create(ZLVOCPEXNM,ZLSOCPEXNM,ZATHETA_ICE,ZAMOIST_ICE)
REAL :: ZEXPL ! 1-PIMPL deg of expl.
REAL :: ZRVORD ! RV/RD
!
@@ -546,32 +591,37 @@ REAL :: ZALPHA ! proportionnality constant between Dz/2 and
REAL :: ZTIME1, ZTIME2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH
!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE)
+#endif
+!
!------------------------------------------------------------------------------------------
-ALLOCATE ( &
- ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZDP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
- ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
+! ALLOCATE ( &
+! ZCP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZEXN(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZT(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZLOCPEXNM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZLEPS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZDP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZTP(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZTRH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZATHETA(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZAMOIST(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZCOEF_DISS(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFRAC_ICE(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZMWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZMWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZMTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZMR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZMTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFWTH(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFWR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFTH2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFR2(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZFTHR(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)), &
+! ZTHLM(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
@@ -606,8 +656,13 @@ ZEXPL = 1.- PIMPL
ZRVORD= XRV / XRD
!
!
-ZTHLM(:,:,:) = PTHLT(:,:,:)
-ZRM(:,:,:,:) = PRT(:,:,:,:)
+!$acc update device(PTHLT,PRT)
+!$acc kernels
+!Copy data into ZTHLM and ZRM only if needed
+IF (HTURBLEN=='BL89' .OR. ORMC01) THEN
+ ZTHLM(:,:,:) = PTHLT(:,:,:)
+ ZRM(:,:,:,:) = PRT(:,:,:,:)
+END IF
!
!
!
@@ -618,7 +673,7 @@ ZRM(:,:,:,:) = PRT(:,:,:,:)
!
!* 2.1 Cph at t
!
-ZCP=XCPD
+ZCP(:,:,:)=XCPD
!
IF (KRR > 0) ZCP(:,:,:) = ZCP(:,:,:) + XCPV * PRT(:,:,:,1)
DO JRR = 2,1+KRRL ! loop on the liquid components
@@ -631,7 +686,14 @@ END DO
!
!* 2.2 Exner function at t
!
+!PW: "BUG" PGI : results different on CPU and GPU due to the power function
+!See http://www.pgroup.com/userforum/viewtopic.php?t=5364&sid=ec7b762b17fb9bb3332a47f0db57af55
+!Use of own functions allows bit-reproducible results
+#ifndef MNH_BITREP
ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+#else
+ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
+#endif
!
!* 2.3 dissipative heating coeff a t
!
@@ -641,12 +703,15 @@ ZCOEF_DISS(:,:,:) = 1/(ZCP(:,:,:) * ZEXN(:,:,:))
ZFRAC_ICE(:,:,:) = 0.0
ZATHETA(:,:,:) = 0.0
ZAMOIST(:,:,:) = 0.0
+!$acc end kernels
!
IF (KRRL >=1) THEN
!
!* 2.4 Temperature at t
!
+!$acc kernels
ZT(:,:,:) = PTHLT(:,:,:) * ZEXN(:,:,:)
+!$acc end kernels
!
!* 2.5 Lv/Cph/Exn
!
@@ -661,6 +726,7 @@ IF (KRRL >=1) THEN
CALL COMPUTE_FUNCTION_THERMO(XALPI,XBETAI,XGAMI,XLSTT,XCI,ZT,ZEXN,ZCP, &
ZLSOCPEXNM,ZAMOIST_ICE,ZATHETA_ICE)
!
+!$acc kernels
WHERE(PRT(:,:,:,2)+PRT(:,:,:,4)>0.0)
ZFRAC_ICE(:,:,:) = PRT(:,:,:,4) / ( PRT(:,:,:,2)+PRT(:,:,:,4) )
END WHERE
@@ -671,7 +737,7 @@ IF (KRRL >=1) THEN
+ZFRAC_ICE(:,:,:) *ZAMOIST_ICE(:,:,:)
ZATHETA(:,:,:) = (1.0-ZFRAC_ICE(:,:,:))*ZATHETA(:,:,:) &
+ZFRAC_ICE(:,:,:) *ZATHETA_ICE(:,:,:)
-
+!$acc end kernels
DEALLOCATE(ZAMOIST_ICE)
DEALLOCATE(ZATHETA_ICE)
ELSE
@@ -681,6 +747,7 @@ IF (KRRL >=1) THEN
!
!
IF (OCLOSE_OUT .AND. OTURB_DIAG) THEN
+!$acc update self(ZAMOIST,ZATHETA)
YRECFM ='ATHETA'
YCOMMENT='X_Y_Z_ATHETA (M)'
IGRID = 1
@@ -695,13 +762,17 @@ IF (KRRL >=1) THEN
END IF
!
ELSE
+!$acc kernels
ZLOCPEXNM=0.
+!$acc end kernels
END IF ! loop end on KRRL >= 1
!
! computes conservative variables
!
+!$acc update device(PRRS,PRTHLS)
IF ( KRRL >= 1 ) THEN
- IF ( KRRI >= 1 ) THEN
+!$acc kernels
+ IF ( KRRI >= 1 ) THEN
! Rnp at t
PRT(:,:,:,1) = PRT(:,:,:,1) + PRT(:,:,:,2) + PRT(:,:,:,4)
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,2) + PRRS(:,:,:,4)
@@ -718,6 +789,7 @@ IF ( KRRL >= 1 ) THEN
PTHLT(:,:,:) = PTHLT(:,:,:) - ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
PRTHLS(:,:,:) = PRTHLS(:,:,:) - ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
END IF
+!$acc end kernels
END IF
!
!----------------------------------------------------------------------------
@@ -732,12 +804,20 @@ SELECT CASE (HTURBLEN)
! ------------------
CASE ('BL89')
+#ifdef _OPENACC
+ PRINT *,'OPENACC: TURB::HTURBLEN=BL89 not yet implemented'
+ CALL ABORT
+#endif
CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZLM)
!
!* 3.2 Delta mixing length
! -------------------
!
CASE ('DELT')
+#ifdef _OPENACC
+ PRINT *,'OPENACC: TURB::HTURBLEN=DELT not yet implemented'
+ CALL ABORT
+#endif
CALL DELT(ZLM)
!
!* 3.3 Deardorff mixing length
@@ -750,6 +830,10 @@ SELECT CASE (HTURBLEN)
! -----------------------
!
CASE ('BLKR')
+#ifdef _OPENACC
+ PRINT *,'OPENACC: TURB::HTURBLEN=BLKR not yet implemented'
+ CALL ABORT
+#endif
ZL0 = 100.
ZLM(:,:,:) = ZL0
@@ -772,19 +856,32 @@ END SELECT
!
!* 3.5 Mixing length modification for cloud
! -----------------------
-IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') CALL CLOUD_MODIF_LM
+IF (KMODEL_CL==KMI .AND. HTURBLEN_CL/='NONE') THEN
+#ifdef _OPENACC
+ PRINT *,'OPENACC: TURB::CLOUD_MODIF_LM not yet implemented'
+ CALL ABORT
+#endif
+ CALL CLOUD_MODIF_LM
+END IF
!
!* 3.6 Dissipative length
! ------------------
!
-ZLEPS=ZLM
+!$acc kernels
+ZLEPS(:,:,:)=ZLM(:,:,:)
!
!* 3.7 Correction in the Surface Boundary Layer (Redelsperger 2001)
! ----------------------------------------
!
ZLMO=XUNDEF
+!$acc end kernels
IF (ORMC01) THEN
+!$acc update self(ZLM,ZLEPS)
+#ifdef _OPENACC
+ PRINT *,'OPENACC: TURB::ORMC01 not yet implemented'
+ CALL ABORT
+#endif
ZUSTAR=(PSFU**2+PSFV**2)**(0.25)
IF (KRR>0) THEN
ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRM(:,:,IKB,1),PSFTH,PSFRV)
@@ -794,6 +891,7 @@ IF (ORMC01) THEN
ZLMO=LMO(ZUSTAR,ZTHLM(:,:,IKB),ZRVM,PSFTH,ZSFRV)
END IF
CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,ZLM,ZLEPS)
+!$acc update device(ZLM,ZLEPS)
END IF
!
!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
@@ -812,10 +910,7 @@ END IF
!
!
!
- IF (CPROGRAM=='AROME ') THEN
- ZUSLOPE=PUT(:,:,KKA)
- ZVSLOPE=PVT(:,:,KKA)
- ELSE
+ IF (CPROGRAM/='AROME ') THEN
CALL ROTATE_WIND(PUT,PVT,PWT, &
PDIRCOSXW, PDIRCOSYW, PDIRCOSZW, &
PCOSSLOPE,PSINSLOPE, &
@@ -823,17 +918,25 @@ END IF
ZUSLOPE,ZVSLOPE )
!
CALL UPDATE_ROTATE_WIND(ZUSLOPE,ZVSLOPE)
+ ELSE
+!$acc kernels
+ ZUSLOPE=PUT(:,:,KKA)
+ ZVSLOPE=PVT(:,:,KKA)
+!$acc end kernels
END IF
!
!
!* 4.2 compute the proportionality coefficient between wind and stress
!
+!$acc kernels
ZCDUEFF(:,:) =-SQRT ( (PSFU(:,:)**2 + PSFV(:,:)**2) / &
(XMNH_TINY + ZUSLOPE(:,:)**2 + ZVSLOPE(:,:)**2 ) &
)
+!$acc end kernels
!
!* 4.6 compute the surface tangential fluxes
!
+!$acc kernels
ZTAU11M(:,:) =2./3.*( (1.+ (PZZ (:,:,IKB+KKL)-PZZ (:,:,IKB)) &
/(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB)) &
) *PTKET(:,:,IKB) &
@@ -852,31 +955,66 @@ ZMWR = 0. ! w'2r'
ZMTH2 = 0. ! w'th'2
ZMR2 = 0. ! w'r'2
ZMTHR = 0. ! w'th'r'
+!$acc end kernels
-IF (HTOM=='TM06') CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
-!
-ZFWTH = -GZ_M_W(KKA,KKU,KKL,ZMWTH,PDZZ) ! -d(w'2th' )/dz
-ZFWR = -GZ_M_W(KKA,KKU,KKL,ZMWR, PDZZ) ! -d(w'2r' )/dz
-ZFTH2 = -GZ_W_M(KKA,KKU,KKL,ZMTH2,PDZZ) ! -d(w'th'2 )/dz
-ZFR2 = -GZ_W_M(KKA,KKU,KKL,ZMR2, PDZZ) ! -d(w'r'2 )/dz
-ZFTHR = -GZ_W_M(KKA,KKU,KKL,ZMTHR,PDZZ) ! -d(w'th'r')/dz
-!
-ZFWTH(:,:,IKTE:) = 0.
-ZFWTH(:,:,:IKTB) = 0.
-ZFWR (:,:,IKTE:) = 0.
-ZFWR (:,:,:IKTB) = 0.
-ZFTH2(:,:,IKTE:) = 0.
-ZFTH2(:,:,:IKTB) = 0.
-ZFR2 (:,:,IKTE:) = 0.
-ZFR2 (:,:,:IKTB) = 0.
-ZFTHR(:,:,IKTE:) = 0.
-ZFTHR(:,:,:IKTB) = 0.
+IF (HTOM=='TM06') THEN
+#ifndef _OPENACC
+ CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
+!
+ ZFWTH = -GZ_M_W(KKA,KKU,KKL,ZMWTH,PDZZ) ! -d(w'2th' )/dz
+ !ZFWR = -GZ_M_W(KKA,KKU,KKL,ZMWR, PDZZ) ! -d(w'2r' )/dz
+ ZFTH2 = -GZ_W_M(KKA,KKU,KKL,ZMTH2,PDZZ) ! -d(w'th'2 )/dz
+ !ZFR2 = -GZ_W_M(KKA,KKU,KKL,ZMR2, PDZZ) ! -d(w'r'2 )/dz
+ !ZFTHR = -GZ_W_M(KKA,KKU,KKL,ZMTHR,PDZZ) ! -d(w'th'r')/dz
+#else
+ PRINT *,'OPENACC: TURB::TM06 not yet implemented'
+ CALL ABORT
+ CALL TM06(KKA,KKU,KKL,PTHVREF,PBL_DEPTH,PZZ,PSFTH,ZMWTH,ZMTH2)
+!
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,ZMWTH,PDZZ,ZFWTH) ! -d(w'2th' )/dz
+ !CALL GZ_M_W_DEVICE(KKA,KKU,KKL,ZMWR, PDZZ,ZFWR) ! -d(w'2r' )/dz
+ CALL GZ_W_M_DEVICE(KKA,KKU,KKL,ZMTH2,PDZZ,ZFTH2) ! -d(w'th'2 )/dz
+ !CALL GZ_W_M_DEVICE(KKA,KKU,KKL,ZMR2, PDZZ,ZFR2) ! -d(w'r'2 )/dz
+ !CALL GZ_W_M_DEVICE(KKA,KKU,KKL,ZMTHR,PDZZ,ZFTHR) ! -d(w'th'r')/dz
+!$acc kernels
+ ZFWTH = -ZFWTH
+ !ZFWR = -ZFWR
+ ZFTH2 = -ZFTH2
+ !ZFR2 = -ZFR2
+ !ZFTHR = -ZFTHR
+#endif
+!
+ ZFWTH(:,:,IKTE:) = 0.
+ ZFWTH(:,:,:IKTB) = 0.
+ !ZFWR (:,:,IKTE:) = 0.
+ !ZFWR (:,:,:IKTB) = 0.
+ ZFWR = 0.
+ ZFTH2(:,:,IKTE:) = 0.
+ ZFTH2(:,:,:IKTB) = 0.
+ !ZFR2 (:,:,IKTE:) = 0.
+ !ZFR2 (:,:,:IKTB) = 0.
+ ZFR2 = 0.
+ !ZFTHR(:,:,IKTE:) = 0.
+ !ZFTHR(:,:,:IKTB) = 0.
+ ZFTHR = 0.
+!$acc end kernels
+ELSE
+!$acc kernels
+ ZFWTH = 0.
+ ZFWR = 0.
+ ZFTH2 = 0.
+ ZFR2 = 0.
+ ZFTHR = 0.
+!$acc end kernels
+ENDIF
!
!----------------------------------------------------------------------------
!
!* 5. TURBULENT SOURCES
! -----------------
!
+!$acc update device(PRHODJ)
+!$acc update device(PRUS,PRVS,PRWS,PRSVS)
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
OCLOSE_OUT,OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
@@ -893,21 +1031,41 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PSBL_DEPTH,ZLMO, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
ZDP,ZTP,PSIGS,PWTH,PWRC,PWSV )
+!$acc update self(PWTH,PWRC,PWSV)
!
-
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'VTURB_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'VTURB_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'VTURB_BU_RW')
+#ifdef _OPENACC
+IF ( ( LBUDGET_TH .AND. ( ( KRRI >= 1 .AND. KRRL >= 1 ) .OR. ( KRRL >= 1 ) ) ) .OR. &
+ LBUDGET_RV .OR. LBUDGET_RC .OR. LBUDGET_RI ) THEN
+!$acc update self(PRRS)
+ENDIF
+#endif
+!
+IF (LBUDGET_U) THEN
+!$acc update self(PRUS)
+ CALL BUDGET (PRUS,1,'VTURB_BU_RU')
+END IF
+IF (LBUDGET_V) THEN
+!$acc update self(PRVS)
+ CALL BUDGET (PRVS,2,'VTURB_BU_RV')
+END IF
+IF (LBUDGET_W) THEN
+!$acc update self(PRWS)
+ CALL BUDGET (PRWS,3,'VTURB_BU_RW')
+END IF
IF (LBUDGET_TH) THEN
+!$acc update self(PRTHLS)
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
+!$acc update self(ZLVOCPEXNM,ZLSOCPEXNM)
CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'VTURB_BU_RTH')
ELSE IF ( KRRL >= 1 ) THEN
+!$acc update self(ZLOCPEXNM)
CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'VTURB_BU_RTH')
ELSE
CALL BUDGET (PRTHLS,4,'VTURB_BU_RTH')
END IF
END IF
IF (LBUDGET_SV) THEN
+!$acc update self(PRSVS)
DO JSV = 1,NSV
CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'VTURB_BU_RSV')
END DO
@@ -942,12 +1100,21 @@ IF (HTURBDIM=='3DIM') THEN
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
END IF
+!$acc update self(PSIGS,PRUS,PRVS,PRWS,PRSVS)
!
!
+#ifdef _OPENACC
+IF ( ( LBUDGET_TH .AND. ( ( KRRI >= 1 .AND. KRRL >= 1 ) .OR. ( KRRL >= 1 ) ) ) .OR. &
+ LBUDGET_RV .OR. LBUDGET_RC .OR. LBUDGET_RI ) THEN
+!$acc update self(PRRS)
+ENDIF
+#endif
+!
IF (LBUDGET_U) CALL BUDGET (PRUS,1,'HTURB_BU_RU')
IF (LBUDGET_V) CALL BUDGET (PRVS,2,'HTURB_BU_RV')
IF (LBUDGET_W) CALL BUDGET (PRWS,3,'HTURB_BU_RW')
IF (LBUDGET_TH) THEN
+!$acc update self(PRTHLS)
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
,4,'HTURB_BU_RTH')
@@ -981,11 +1148,17 @@ IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'HTURB_BU_RRI')
!
! 6.1 Contribution of mass-flux in the TKE buoyancy production if
! cloud computation is not statistical
-
+#ifndef _OPENACC
ZTP = ZTP + XG / PTHVREF * MZF(KKA,KKU,KKL, PFLXZTHVMF )
+#else
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFLXZTHVMF,ZTMP1_DEVICE)
+!$acc kernels
+ ZTP(:,:,:) = ZTP(:,:,:) + XG / PTHVREF(:,:,:) * ZTMP1_DEVICE(:,:,:)
+!$acc end kernels
+#endif
! 6.2 TKE evolution equation
-
+!$acc update device(PRTKES)
CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,ZLM,ZLEPS,ZDP,ZTRH, &
PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
PTSTEP,PIMPL,ZEXPL, &
@@ -996,7 +1169,9 @@ CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,ZLM,ZLEPS,ZDP,ZTRH, &
PDYP = ZDP
PTHP = ZTP
!
+!$acc update self(PRTKES)
IF (LBUDGET_TH) THEN
+!$acc update self(PRTHLS)
IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
,4,'DISSH_BU_RTH')
@@ -1019,6 +1194,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the mixing length
!
+!$acc update self(ZLM)
YRECFM ='LM'
YCOMMENT='X_Y_Z_LM (M)'
IGRID = 1
@@ -1029,6 +1205,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the conservative potential temperature
!
+!$acc update self(PTHLT)
YRECFM ='THLM'
YCOMMENT='X_Y_Z_THLM (KELVIN)'
IGRID = 1
@@ -1037,6 +1214,7 @@ IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
!
! stores the conservative mixing ratio
!
+!$acc update self(PRT)
YRECFM ='RNPM'
YCOMMENT='X_Y_Z_RNPM (KG/KG)'
IGRID = 1
@@ -1053,22 +1231,29 @@ END IF
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
+!$acc kernels
PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2) - PRT(:,:,:,4)
PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2) - PRRS(:,:,:,4)
PTHLT(:,:,:) = PTHLT(:,:,:) + ZLVOCPEXNM(:,:,:) * PRT(:,:,:,2) &
+ ZLSOCPEXNM(:,:,:) * PRT(:,:,:,4)
PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLVOCPEXNM(:,:,:) * PRRS(:,:,:,2) &
+ ZLSOCPEXNM(:,:,:) * PRRS(:,:,:,4)
+!$acc end kernels
+!$acc update self(PRT(:,:,:,1))
!
DEALLOCATE(ZLVOCPEXNM)
DEALLOCATE(ZLSOCPEXNM)
ELSE
+!$acc kernels
PRT(:,:,:,1) = PRT(:,:,:,1) - PRT(:,:,:,2)
PRRS(:,:,:,1) = PRRS(:,:,:,1) - PRRS(:,:,:,2)
PTHLT(:,:,:) = PTHLT(:,:,:) + ZLOCPEXNM(:,:,:) * PRT(:,:,:,2)
PRTHLS(:,:,:) = PRTHLS(:,:,:) + ZLOCPEXNM(:,:,:) * PRRS(:,:,:,2)
+!$acc end kernels
+!$acc update self(PRT(:,:,:,1))
END IF
END IF
+!$acc update self(PRRS,PTHLT,PRTHLS)
!
IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
@@ -1104,6 +1289,7 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+!$acc data copy(X_LES_Q0,X_LES_E0,X_LES_SV0,X_LES_UW0,X_LES_VW0,X_LES_USTAR)
CALL LES_MEAN_SUBGRID(PSFTH,X_LES_Q0)
CALL LES_MEAN_SUBGRID(PSFRV,X_LES_E0)
DO JSV=1,NSV
@@ -1112,17 +1298,30 @@ IF (LLES_CALL) THEN
CALL LES_MEAN_SUBGRID(PSFU,X_LES_UW0)
CALL LES_MEAN_SUBGRID(PSFV,X_LES_VW0)
CALL LES_MEAN_SUBGRID((PSFU*PSFU+PSFV*PSFV)**0.25,X_LES_USTAR)
+#ifndef _OPENACC
+ CALL LES_MEAN_SUBGRID((PSFU*PSFU+PSFV*PSFV)**0.25,X_LES_USTAR)
+#else
+!$acc kernels
+ ZTMP1_DEVICE(:,:,1) = (PSFU*PSFU+PSFV*PSFV)**0.25
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE(:,:,1),X_LES_USTAR)
+#endif
+!$acc end data
!----------------------------------------------------------------------------
!
!* 10. LES for 3rd order moments
! -------------------------
!
+!$acc data copy(X_LES_SUBGRID_W2Thl,X_LES_SUBGRID_WThl2)
CALL LES_MEAN_SUBGRID(ZMWTH,X_LES_SUBGRID_W2Thl)
CALL LES_MEAN_SUBGRID(ZMTH2,X_LES_SUBGRID_WThl2)
+!$acc end data
IF (KRR>0) THEN
+!$acc data copy(X_LES_SUBGRID_W2Rt,X_LES_SUBGRID_WThlRt,X_LES_SUBGRID_WRt2)
CALL LES_MEAN_SUBGRID(ZMWR,X_LES_SUBGRID_W2Rt)
CALL LES_MEAN_SUBGRID(ZMTHR,X_LES_SUBGRID_WThlRt)
CALL LES_MEAN_SUBGRID(ZMR2,X_LES_SUBGRID_WRt2)
+!$acc end data
END IF
!
!----------------------------------------------------------------------------
@@ -1130,10 +1329,11 @@ IF (LLES_CALL) THEN
!* 11. LES quantities depending on <w'2> in "1DIM" mode
! ------------------------------------------------
!
+#ifndef _OPENACC
IF (HTURBDIM=="1DIM") THEN
CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_U2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_V2)
- CALL LES_MEAN_SUBGRID(2./3.*PTKET,X_LES_SUBGRID_W2)
+ X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
+ X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
CALL LES_MEAN_SUBGRID(2./3.*PTKET*MZF(KKA,KKU,KKL,&
& GZ_M_W(KKA,KKU,KKL,PTHLT,PDZZ)),X_LES_RES_ddz_Thl_SBG_W2)
IF (KRR>=1) &
@@ -1144,19 +1344,62 @@ IF (LLES_CALL) THEN
& GZ_M_W(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ)),X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
END IF
-
+#else
+ IF (HTURBDIM=="1DIM") THEN
+!$acc data copy(X_LES_SUBGRID_U2,X_LES_SUBGRID_V2,X_LES_SUBGRID_W2,X_LES_RES_ddz_Thl_SBG_W2)
+!$acc kernels
+ ZTMP1_DEVICE = 2./3.*PTKET
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE,X_LES_SUBGRID_U2)
+!$acc kernels
+ X_LES_SUBGRID_V2 = X_LES_SUBGRID_U2
+ X_LES_SUBGRID_W2 = X_LES_SUBGRID_U2
+!$acc end kernels
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLT,PDZZ,ZTMP2_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZTMP3_DEVICE
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP2_DEVICE,X_LES_RES_ddz_Thl_SBG_W2)
+!$acc end data
+ IF (KRR>=1) THEN
+!$acc data copy(X_LES_RES_ddz_Rt_SBG_W2)
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PRT(:,:,:,1),PDZZ,ZTMP2_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*PTKET*ZTMP3_DEVICE
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP2_DEVICE,X_LES_RES_ddz_Rt_SBG_W2)
+!$acc end data
+ END IF
+!$acc data copy(X_LES_RES_ddz_Sv_SBG_W2(:,:,:,1:NSV))
+ DO JSV=1,NSV
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PSVT(:,:,:,JSV),PDZZ,ZTMP2_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*PTKET*ZTMP3_DEVICE
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP2_DEVICE,X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ END DO
+!$acc end data
+ END IF
+#endif
!----------------------------------------------------------------------------
!
!* 12. LES mixing end dissipative lengths, presso-correlations
! -------------------------------------------------------
!
+!$acc data copy(X_LES_SUBGRID_LMix,X_LES_SUBGRID_LDiss,X_LES_SUBGRID_WP)
CALL LES_MEAN_SUBGRID(ZLM,X_LES_SUBGRID_LMix)
CALL LES_MEAN_SUBGRID(ZLEPS,X_LES_SUBGRID_LDiss)
!
!* presso-correlations for subgrid Tke are equal to zero.
!
+!$acc kernels
ZLM = 0.
+!$acc end kernels
CALL LES_MEAN_SUBGRID(ZLM,X_LES_SUBGRID_WP)
+!$acc end data
!
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -1200,6 +1443,7 @@ IMPLICIT NONE
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PUSLOPE,PVSLOPE
! tangential surface fluxes in the axes following the orography
+!$acc declare present(PUSLOPE,PVSLOPE)
!
!* 0.2 Declarations of local variables :
!
@@ -1216,14 +1460,17 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
! 2 Update halo if necessary
!
!!$IF (NHALO == 1) THEN
+!$acc update self(PUSLOPE,PVSLOPE)
CALL ADD2DFIELD_ll(TZFIELDS_ll,PUSLOPE)
CALL ADD2DFIELD_ll(TZFIELDS_ll,PVSLOPE)
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
+!$acc update device(PUSLOPE,PVSLOPE)
!!$ENDIF
!
! 3 Boundary conditions for non cyclic case
!
+!$acc kernels
IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
PUSLOPE(IIB-1,:)=PUSLOPE(IIB,:)
PVSLOPE(IIB-1,:)=PVSLOPE(IIB,:)
@@ -1240,6 +1487,7 @@ IF( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
PUSLOPE(:,IJE+1)=PUSLOPE(:,IJE)
PVSLOPE(:,IJE+1)=PVSLOPE(:,IJE)
END IF
+!$acc end kernels
!
END SUBROUTINE UPDATE_ROTATE_WIND
!
@@ -1269,17 +1517,19 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments
!
-REAL :: PALP,PBETA,PGAM,PLTT,PC
+REAL, INTENT(IN) :: PALP,PBETA,PGAM,PLTT,PC
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT,PEXN,PCP
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLOCPEXN
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PAMOIST,PATHETA
+!$acc declare present(PT,PEXN,PCP,PLOCPEXN,PAMOIST,PATHETA)
!
!* 0.2 Declarations of local variables
!
REAL :: ZEPS ! XMV / XMD
REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZRVSAT
REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
+!$acc declare create(ZRVSAT,ZDRVSATDT)
!
!-------------------------------------------------------------------------------
!
@@ -1287,11 +1537,19 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!
!* 1.1 Lv/Cph at t
!
+!$acc kernels
PLOCPEXN(:,:,:) = ( PLTT + (XCPV-PC) * (PT(:,:,:)-XTT) ) / PCP(:,:,:)
!
!* 1.2 Saturation vapor pressure at t
!
+!PW: "BUG" PGI : results different on CPU and GPU due to the EXP and LOG functions
+!See http://www.pgroup.com/userforum/viewtopic.php?t=5364&sid=ec7b762b17fb9bb3332a47f0db57af55
+!Use of own functions allows bit-reproducible results
+#ifndef MNH_BITREP
ZRVSAT(:,:,:) = EXP( PALP - PBETA/PT(:,:,:) - PGAM*ALOG( PT(:,:,:) ) )
+#else
+ ZRVSAT(:,:,:) = BR_EXP( PALP - PBETA/PT(:,:,:) - PGAM*BR_LOG( PT(:,:,:) ) )
+#endif
!
!* 1.3 saturation mixing ratio at t
!
@@ -1323,6 +1581,7 @@ REAL, DIMENSION(SIZE(PEXN,1),SIZE(PEXN,2),SIZE(PEXN,3)) :: ZDRVSATDT
!* 1.7 Lv/Cph/Exner at t-1
!
PLOCPEXN(:,:,:) = PLOCPEXN(:,:,:) / PEXN(:,:,:)
+!$acc end kernels
!
END SUBROUTINE COMPUTE_FUNCTION_THERMO
!
@@ -1420,40 +1679,86 @@ END SUBROUTINE DELT
!* 0.1 Declarations of dummy arguments
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+!$acc declare present(PLM)
!
!* 0.2 Declarations of local variables
!
REAL :: ZD ! distance to the surface
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2D
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: ZWORK2D
!
REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: &
ZDTHLDZ,ZDRTDZ, &!dtheta_l/dz, drt_dz used for computing the stablity
! ! criterion
ZETHETA,ZEMOIST !coef ETHETA and EMOIST
+!$acc declare create(ZWORK2D,ZDTHLDZ,ZDRTDZ,ZETHETA,ZEMOIST)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
!----------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
!
! initialize the mixing length with the mesh grid
+!$acc kernels
DO JK = IKTB,IKTE ! 1D turbulence scheme
PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
END DO
PLM(:,:,KKU) = PLM(:,:,IKE)
PLM(:,:,KKA) = PZZ(:,:,IKB) - PZZ(:,:,KKA)
+!$acc end kernels
IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
IF ( L2D) THEN
+#ifndef _OPENACC
PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+#else
+ CALL MXF_DEVICE(PDXX,ZTMP1_DEVICE)
+!$acc kernels
+ PLM(:,:,:) = SQRT( PLM(:,:,:)*ZTMP1_DEVICE )
+!$acc end kernels
+#endif
ELSE
+!PW: "BUG" PGI : results different on CPU and GPU due to the power function
+!See http://www.pgroup.com/userforum/viewtopic.php?t=5364&sid=ec7b762b17fb9bb3332a47f0db57af55
+!Use of own functions allows bit-reproducible results
+#ifndef MNH_BITREP
+!
+#ifndef _OPENACC
PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+#else
+ CALL MXF_DEVICE(PDXX,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(PDYY,ZTMP2_DEVICE)
+!$acc kernels
+ PLM(:,:,:) = (PLM(:,:,:)*ZTMP1_DEVICE*ZTMP2_DEVICE ) ** (1./3.)
+!$acc end kernels
+#endif
+!
+#else
+!
+#ifndef _OPENACC
+ PLM(:,:,:) = BR_POW( PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) , 1./3. )
+#else
+ CALL MXF_DEVICE(PDXX,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(PDYY,ZTMP2_DEVICE)
+!$acc kernels
+ PLM(:,:,:) = BR_POW( PLM(:,:,:)*ZTMP1_DEVICE *ZTMP2_DEVICE , 1./3. )
+!$acc end kernels
+#endif
+#endif
END IF
END IF
! compute a mixing length limited by the stability
!
-ALLOCATE(ZWORK2D(SIZE(PUT,1),SIZE(PUT,2)))
-!
+#ifndef _OPENACC
ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
+#else
+CALL ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT,ZETHETA)
+CALL EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT,ZEMOIST)
+#endif
!
+!$acc kernels present(PDIRCOSZW,PDZZ,PRT,PTHLT,PTHVREF,PTHLT,PZZ,PTKET)
DO JK = IKTB+1,IKTE-1
ZDTHLDZ(:,:,JK)= 0.5*((PTHLT(:,:,JK+KKL)-PTHLT(:,:,JK))/PDZZ(:,:,JK+KKL)+ &
(PTHLT(:,:,JK)-PTHLT(:,:,JK-KKL))/PDZZ(:,:,JK))
@@ -1488,8 +1793,6 @@ WHERE(ZWORK2D(:,:)>0.)
0.76* SQRT(PTKET(:,:,IKB)/ZWORK2D(:,:))))
END WHERE
!
-DEALLOCATE(ZWORK2D)
-!
! mixing length limited by the distance normal to the surface (with the same factor as for BL89)
!
IF (.NOT. ORMC01) THEN
@@ -1513,6 +1816,7 @@ END IF
PLM(:,:,KKA) = PLM(:,:,IKB )
PLM(:,:,IKE ) = PLM(:,:,IKE-KKL)
PLM(:,:,KKU ) = PLM(:,:,KKU-KKL)
+!$acc end kernels
!
END SUBROUTINE DEAR
!
diff --git a/src/MNH/turb_hor.f90 b/src/MNH/turb_hor.f90
index 88426783a8fe148500d111635b34953ff8b46be5..ee79dd993ed4af9100bb10c804e99708856da449 100644
--- a/src/MNH/turb_hor.f90
+++ b/src/MNH/turb_hor.f90
@@ -108,7 +108,17 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+!$acc & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF,PSFTHM,PSFRM, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PUSLOPEM,PVSLOPEM,PSFSVM, &
+!$acc & PDP,PTP,PRTHLS,PRSVS,PRRS, &
+!$acc & PRUS,PRVS,PRWS,PSIGS)
!
END SUBROUTINE TURB_HOR
!
@@ -253,6 +263,7 @@ END MODULE MODI_TURB_HOR
!! Nov 27, 1997 (V. Masson) clearing of the routine
!! Nov 06, 2002 (V. Masson) LES budgets
!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -362,7 +373,17 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+!$acc & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF,PSFTHM,PSFRM, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PUSLOPEM,PVSLOPEM,PSFSVM, &
+!$acc & PDP,PTP,PRTHLS,PRSVS,PRRS, &
+!$acc & PRUS,PRVS,PRWS,PSIGS)
!
!* 0.2 declaration of local variables
!
@@ -393,7 +414,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
PRTHLS,PRRS )
!
-!
!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
!
IF (KSPLT==1) &
@@ -408,7 +428,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
PSIGS )
!
-!
!* 9. < U'U'>
!* 10. < V'V'>
!* 11. < W'W'>
@@ -428,7 +447,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PDP,PTP, &
PRUS,PRVS,PRWS )
!
-!
!* 12. < U'V'>
!
CALL TURB_HOR_UV(KSPLT, &
@@ -471,7 +489,6 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
PTKEM,PLM, &
PDP, &
PRVS,PRWS )
-
!
!
!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
diff --git a/src/MNH/turb_hor_dyn_corr.f90 b/src/MNH/turb_hor_dyn_corr.f90
index 216f2f5d535e0337dc00e49b00382629801e8a10..1a3a6188e1b170bc653998b4d6ca588abf44778b 100644
--- a/src/MNH/turb_hor_dyn_corr.f90
+++ b/src/MNH/turb_hor_dyn_corr.f90
@@ -75,6 +75,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
!
+!$acc declare present(PINV_PDZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE,PRHODJ,PCDUEFF, &
+!$acc & PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PTHLM,PRM,PSVM,PUSLOPEM,PVSLOPEM,PTKEM,PLM, &
+!$acc & PRUS,PRVS,PRWS,PDP,PTP)
!
!
END SUBROUTINE TURB_HOR_DYN_CORR
@@ -140,6 +145,7 @@ END MODULE MODI_TURB_HOR_DYN_CORR
!! March 2014 (V.Masson) tridiag_w : bug between
!! mass and flux position
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -161,7 +167,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_COEFJ
USE MODI_LES_MEAN_SUBGRID
USE MODI_TRIDIAG_W
@@ -225,6 +235,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP,PTP ! TKE production terms
!
+!$acc declare present(PINV_PDZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE,PRHODJ,PCDUEFF, &
+!$acc & PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PTHLM,PRM,PSVM,PUSLOPEM,PVSLOPEM,PTKEM,PLM, &
+!$acc & PRUS,PRVS,PRWS,PDP,PTP)
!
!
!* 0.2 declaration of local variables
@@ -270,6 +285,16 @@ REAL :: ZTIME1, ZTIME2
REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF , ZDZZ
! coefficients for the uncentred gradient
! computation near the ground
+!
+!$acc declare create(ZFLX,ZWORK,ZDIRSINZW,ZCOEFF,ZDZZ, &
+!$acc & GX_U_M_PUM,GY_V_M_PVM,GZ_W_M_PWM,GZ_W_M_ZWP, &
+!$acc & ZMZF_DZZ,ZDFDDWDZ,ZWP, &
+!$acc & ZDU_DZ_DZS_DX,ZDV_DZ_DZS_DY,ZDU_DX,ZDV_DY,ZDW_DZ)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
! --------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -281,13 +306,27 @@ IKE = SIZE(PUM,3)-JPVEXT
IKU = SIZE(PUM,3)
!
!
+!$acc kernels async(1)
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
+!$acc end kernels
!
+#ifndef _OPENACC
GX_U_M_PUM = GX_U_M(1,IKU,1,PUM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_V_M_PVM = GY_V_M(1,IKU,1,PVM,PDYY,PDZZ,PDZY)
+IF (.NOT. L2D) THEN
+ GY_V_M_PVM = GY_V_M(1,IKU,1,PVM,PDYY,PDZZ,PDZY)
+END IF
GZ_W_M_PWM = GZ_W_M(1,IKU,1,PWM,PDZZ)
!
ZMZF_DZZ = MZF(1,IKU,1,PDZZ)
+#else
+CALL GX_U_M_DEVICE(1,IKU,1,PUM,PDXX,PDZZ,PDZX,GX_U_M_PUM)
+IF (.NOT. L2D) THEN
+ CALL GY_V_M_DEVICE(1,IKU,1,PVM,PDYY,PDZZ,PDZY,GY_V_M_PVM)
+END IF
+CALL GZ_W_M_DEVICE(1,IKU,1,PWM,PDZZ,GZ_W_M_PWM)
+!
+CALL MZF_DEVICE(1,IKU,1,PDZZ,ZMZF_DZZ)
+#endif
!
CALL ADD3DFIELD_ll(TZFIELDS_ll, ZFLX)
@@ -300,35 +339,48 @@ CALL ADD3DFIELD_ll(TZFIELDS_ll, ZFLX)
!
! Computes the U variance
IF (.NOT. L2D) THEN
+ !$acc kernels async(2)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GX_U_M_PUM &
-(2./3.) * ( GY_V_M_PVM &
+GZ_W_M_PWM ) )
+ !$acc end kernels
!! & to be tested later
!! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
ELSE
+ !$acc kernels async(2)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GX_U_M_PUM &
-(2./3.) * ( GZ_W_M_PWM ) )
+ !$acc end kernels
!! & to be tested later
!! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
END IF
!
+!$acc kernels async(2)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!$acc end kernels
!
!* prescription of du/dz and dv/dz with uncentered gradient at the surface
! prescription of dw/dz at Dz/2 above ground using the continuity equation
! using a Boussinesq hypothesis to remove the z dependance of rhod_ref
! (div u = 0)
!
+#ifndef _OPENACC
ZDZZ(:,:,:) = MXM(PDZZ(:,:,IKB:IKB+2))
+#else
+CALL MXM_DEVICE(PDZZ(:,:,IKB:IKB+2),ZDZZ(:,:,:))
+#endif
+!$acc kernels async(3)
ZCOEFF(:,:,IKB+2)= - ZDZZ(:,:,2) / &
( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,3) )
ZCOEFF(:,:,IKB+1)= (ZDZZ(:,:,3)+ZDZZ(:,:,2)) / &
( ZDZZ(:,:,2) * ZDZZ(:,:,3) )
ZCOEFF(:,:,IKB)= - (ZDZZ(:,:,3)+2.*ZDZZ(:,:,2)) / &
( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,2) )
+!$acc end kernels
!
+#ifndef _OPENACC
ZDU_DZ_DZS_DX(:,:,:)=MXF ((ZCOEFF(:,:,IKB+2:IKB+2)*PUM(:,:,IKB+2:IKB+2) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PUM(:,:,IKB+1:IKB+1) &
+ZCOEFF(:,:,IKB :IKB )*PUM(:,:,IKB :IKB ) &
@@ -336,33 +388,109 @@ ZDU_DZ_DZS_DX(:,:,:)=MXF ((ZCOEFF(:,:,IKB+2:IKB+2)*PUM(:,:,IKB+2:IKB+2) &
)/ MXF(PDXX(:,:,IKB:IKB))
!
ZDZZ(:,:,:) = MYM(PDZZ(:,:,IKB:IKB+2))
+#else
+!$acc kernels async(3)
+ZTMP1_DEVICE(:,:,1) = (ZCOEFF(:,:,IKB+2)*PUM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PUM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PUM(:,:,IKB) &
+ )* 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB))
+!$acc end kernels
+!
+!!! wait for the computation of ZCOEFF and ZTMP1_DEVICE
+!$acc wait(3)
+!
+CALL MXF_DEVICE(ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1))
+CALL MXF_DEVICE(PDXX(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels async(3)
+ZDU_DZ_DZS_DX(:,:,1) = ZTMP2_DEVICE(:,:,1) / ZTMP1_DEVICE(:,:,1)
+!$acc end kernels
+!
+CALL MYM_DEVICE(PDZZ(:,:,IKB:IKB+2),ZDZZ(:,:,:))
+#endif
+!$acc kernels async(4)
ZCOEFF(:,:,IKB+2)= - ZDZZ(:,:,2) / &
( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,3) )
ZCOEFF(:,:,IKB+1)= (ZDZZ(:,:,3)+ZDZZ(:,:,2)) / &
( ZDZZ(:,:,2) * ZDZZ(:,:,3) )
ZCOEFF(:,:,IKB)= - (ZDZZ(:,:,3)+2.*ZDZZ(:,:,2)) / &
( (ZDZZ(:,:,3)+ZDZZ(:,:,2)) * ZDZZ(:,:,2) )
+!$acc end kernels
!
-
+#ifndef _OPENACC
ZDV_DZ_DZS_DY(:,:,:)=MYF ((ZCOEFF(:,:,IKB+2:IKB+2)*PVM(:,:,IKB+2:IKB+2) &
+ZCOEFF(:,:,IKB+1:IKB+1)*PVM(:,:,IKB+1:IKB+1) &
+ZCOEFF(:,:,IKB :IKB )*PVM(:,:,IKB :IKB ) &
)* 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB)) &
)/ MYF(PDYY(:,:,IKB:IKB))
-!
-!
+#else
+!$acc kernels async(4)
+ZTMP3_DEVICE(:,:,1) = (ZCOEFF(:,:,IKB+2)*PVM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PVM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB)*PVM(:,:,IKB) &
+ )* 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB))
+!$acc end kernels
+!
+!!! wait for the computation of ZCOEFF and ZTMP3_DEVICE
+!$acc wait(4)
+#endif
+!
+#ifndef _OPENACC
ZDU_DX(:,:,:)= DXF(PUM(:,:,IKB:IKB)) / MXF(PDXX(:,:,IKB:IKB)) &
- ZDU_DZ_DZS_DX(:,:,:)
ZDV_DY(:,:,:)= DYF(PVM(:,:,IKB:IKB)) / MYF(PDYY(:,:,IKB:IKB)) &
- ZDV_DZ_DZS_DY(:,:,:)
+#else
+CALL MYF_DEVICE(ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1))
+CALL MYF_DEVICE(PDYY(:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels async(4)
+ZDV_DZ_DZS_DY(:,:,1)= ZTMP4_DEVICE(:,:,1) / ZTMP3_DEVICE(:,:,1)
+!$acc end kernels
+!
+!
+!!! wait for the computation of ZDU_DZ_DZS_DX
+!$acc wait(3)
+!
+CALL DXF_DEVICE(PUM(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1))
+CALL MXF_DEVICE(PDXX(:,:,IKB:IKB),ZTMP2_DEVICE(:,:,1:1))
+!$acc kernels async(3)
+ZDU_DX(:,:,1)= ZTMP1_DEVICE(:,:,1) / ZTMP2_DEVICE(:,:,1) - ZDU_DZ_DZS_DX(:,:,1)
+!$acc end kernels
+
+!!! wait for the computation of ZDV_DZ_DZS_DY
+!$acc wait(4)
!
+CALL DYF_DEVICE(PVM(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,1:1))
+CALL MYF_DEVICE(PDYY(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels! async(4)
+ZDV_DY(:,:,1)= ZTMP3_DEVICE(:,:,1) / ZTMP4_DEVICE(:,:,1) - ZDV_DZ_DZS_DY(:,:,1)
+!$acc end kernels
+!
+!
+!!! wait for the computation of ZDU_DX and ZDV_DY
+!$acc wait(3) async(4)
+#endif
+!
+!$acc kernels async(4)
ZDW_DZ(:,:,:)=-ZDU_DX(:,:,:)-ZDV_DY(:,:,:)
+!$acc end kernels
!
!* computation
!
-ZFLX(:,:,IKB:IKB) = (2./3.) * PTKEM(:,:,IKB:IKB) &
- - XCMFS * PK(:,:,IKB:IKB) * 2. * ZDU_DX(:,:,:)
+!!! wait for the computation of ZFLX
+!$acc wait(2) async(4)
+!!! wait for the computation of ZDW_DZ
+!$acc wait(4)
+!
+! ! !!! we can launch the update of ZFLX on the part that has already been computed
+! ! !$acc update self(ZFLX(:,:,IKB+1:)) async(10)
+!attention !!!!! je ne comprends pas pourquoi mais ce update plante à l'execution...
+! du coup je ne peux pas faire de update self asynchrone...
+!
+!$acc kernels async(3)
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDU_DX(:,:,1)
+!$acc end kernels
!! & to be tested later
@@ -370,6 +498,12 @@ ZFLX(:,:,IKB:IKB) = (2./3.) * PTKEM(:,:,IKB:IKB) &
!! (-2./3.) * PTP(:,:,IKB:IKB)
!
! extrapolates this flux under the ground with the surface flux
+!
+!
+!!! wait for the computation of ZDIRSINZW
+!$ acc wait(1)
+!
+!$acc kernels async(4)
ZFLX(:,:,IKB-1) = &
PTAU11M(:,:) * PCOSSLOPE(:,:)**2 * PDIRCOSZW(:,:)**2 &
-2. * PTAU12M(:,:) * PCOSSLOPE(:,:)* PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
@@ -379,10 +513,40 @@ ZFLX(:,:,IKB-1) = &
PVSLOPEM(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
- PUSLOPEM(:,:) * PCOSSLOPE(:,:)**2 * ZDIRSINZW(:,:) * PDIRCOSZW(:,:) &
)
+!$acc end kernels
!
-ZFLX(:,:,IKB-1:IKB-1) = 2. * ZFLX(:,:,IKB-1:IKB-1) - ZFLX(:,:,IKB:IKB)
+!!! wait for the computation of ZFLX(:,:,IKB) and ZFLX(:,:,IKB-1)
+!$acc wait(3) async(4)
+!
+!$acc kernels async(4)
+ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!$acc end kernels
+!
!
+!!! wait for the computation of ZFLX(:,:,IKB-1)
+!$acc wait(4)
+!
+
+
+! ! !!! we can launch the update of ZFLX on the rest
+! ! !$acc update self(ZFLX(:,:,1:IKB)) async(11)
+! ! !
+! ! !!! and wait for the update self(ZFLX(...)) to complete
+! ! !$acc wait(10)
+! ! !$acc wait(11)
+!attention !!!!! je ne comprends pas pourquoi mais le update self(ZFLX(:,:,IKB+1:)) plante à l'execution...
+! du coup je ne peux pas faire de update self asynchrone...
+
+
+!
+!!! at this point there are no more async operations running
+!!! to be absolutely sure, we do a wait
+!$acc wait
+!
+!$acc update self(ZFLX)
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
+!$acc update device(ZFLX) async(10)
+!
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
! stores <U U>
YRECFM ='U_VAR'
@@ -393,6 +557,7 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
END IF
!
! Complete the U tendency
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
CALL MPPDB_CHECK3DM("before turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PRECISION,&
& PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ )
@@ -405,24 +570,79 @@ CALL MPPDB_CHECK3DM("after turb_corr:PRUS,PRHODJ,ZFLX,PDXX,PDZX,PINV_PDZZ",PREC
ELSE
PRUS(:,:,:)=PRUS -DXM(PRHODJ * ZFLX / MXF(PDXX) )
END IF
+#else
+CALL MXF_DEVICE(PDXX, ZTMP1_DEVICE)
+!$acc kernels async(10)
+ZTMP2_DEVICE = PRHODJ * ZFLX / ZTMP1_DEVICE
+!$acc end kernels
+!
+!!! wait for the computation of ZTMP2_DEVICE and the update of ZFLX
+!$acc wait(10)
+!
+CALL DXM_DEVICE(ZTMP2_DEVICE, ZTMP3_DEVICE)
+IF (.NOT. LFLAT) THEN
+ CALL MZM_DEVICE(PDXX,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PRHODJ * ZFLX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP4_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP2_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = PDZX / ZTMP1_DEVICE * ZTMP4_DEVICE
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels async(1)
+ PRUS(:,:,:)=PRUS &
+ -ZTMP3_DEVICE &
+ +ZTMP1_DEVICE
+ !$acc end kernels
+ELSE
+ !$acc kernels async(1)
+ PRUS(:,:,:)=PRUS - ZTMP3_DEVICE
+ !$acc end kernels
+END IF
+#endif
!
IF (KSPLT==1) THEN
! Contribution to the dynamic production of TKE:
+ !$acc kernels async(2)
ZWORK(:,:,:) = - ZFLX(:,:,:) * GX_U_M_PUM
+ !$acc end kernels
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
!
+ !$acc kernels async(2)
ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDU_DX(:,:,1) + ZWORK(:,:,IKB+1) )
+ !$acc end kernels
!
+ !$acc kernels async(2)
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
END IF
!
! Storage in the LES configuration
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+!$acc data copy(X_LES_SUBGRID_U2,X_LES_RES_ddxa_U_SBG_UaU)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_U2 )
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+#else
+ !
+ !!! wait for the computation of ZWORK and PDP
+ !$acc wait(2)
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -ZWORK
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ !
+#endif
+!$acc end data
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -431,34 +651,50 @@ END IF
!* 10. < V'V'>
! -------
!
+!!! wait for the computation of ZWORK and PDP (that uses ZFLX)
+!$acc wait(2)
+!
! Computes the V variance
IF (.NOT. L2D) THEN
+ !$acc kernels async(3)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GY_V_M_PVM &
-(2./3.) * ( GX_U_M_PUM &
+GZ_W_M_PWM ) )
+ !$acc end kernels
!! & to be tested
!! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
!
ELSE
+ !$acc kernels async(3)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *(-(2./3.) * ( GX_U_M_PUM &
+GZ_W_M_PWM ) )
+ !$acc end kernels
!! & to be tested
!! + XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
!
END IF
!
+!$acc kernels async(3)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!$acc end kernels
+!
+! ! !!! wait for the computation of ZFLX to begin the update
+! ! !$acc wait(3)
+! ! !$acc update self(ZFLX(:,:,IKB+1:)) async(10)
!
-ZFLX(:,:,IKB:IKB) = (2./3.) * PTKEM(:,:,IKB:IKB) &
- - XCMFS * PK(:,:,IKB:IKB) * 2. * ZDV_DY(:,:,:)
+!$acc kernels async(3)
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDV_DY(:,:,1)
+!$acc end kernels
!! & to be tested
!! + XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
!! (-2./3.) * PTP(:,:,IKB:IKB)
!
! extrapolates this flux under the ground with the surface flux
+!$acc kernels async(3)
ZFLX(:,:,IKB-1) = &
PTAU11M(:,:) * PSINSLOPE(:,:)**2 * PDIRCOSZW(:,:)**2 &
+2. * PTAU12M(:,:) * PCOSSLOPE(:,:)* PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
@@ -468,10 +704,24 @@ ZFLX(:,:,IKB-1) = &
PUSLOPEM(:,:) * PSINSLOPE(:,:)**2 * ZDIRSINZW(:,:) * PDIRCOSZW(:,:) &
+ PVSLOPEM(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
)
+!$acc end kernels
!
-ZFLX(:,:,IKB-1:IKB-1) = 2. * ZFLX(:,:,IKB-1:IKB-1) - ZFLX(:,:,IKB:IKB)
+!$acc kernels async(3)
+ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!$acc end kernels
+!
+!
+! ! !!! wait for the computation of ZFLX(:,:,1:IKB) to begin the update
+! ! !$acc update self(ZFLX(:,:,IKB+1:)) async(3)
+! ! !
+! ! !!! and wait for the update self(ZFLX(...)) to complete
+! ! !$acc wait(10)
+! ! !$acc wait(3)
!
+!$acc wait(3)
+!$acc update self(ZFLX)
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
+!$acc update device(ZFLX) async(10)
!
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
! stores <V V>
@@ -482,8 +732,14 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
+!!! wait for the computation of PRUS (that uses ZTMP1_DEVICE and ZTMP3_DEVICE)
+!$acc wait(1)
+!
+!
+!
! Complete the V tendency
IF (.NOT. L2D) THEN
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRVS(:,:,:)=PRVS &
-DYM(PRHODJ * ZFLX / MYF(PDYY) ) &
@@ -495,25 +751,86 @@ IF (.NOT. L2D) THEN
!
! Contribution to the dynamic production of TKE:
IF (KSPLT==1) ZWORK(:,:,:) = - ZFLX(:,:,:) * GY_V_M_PVM
+#else
+ CALL MYF_DEVICE(PDYY, ZTMP1_DEVICE)
+ !$acc kernels async(10)
+ ZTMP2_DEVICE = PRHODJ * ZFLX / ZTMP1_DEVICE
+ !$acc end kernels
+ !
+ !!! wait for the computation of ZTMP2_DEVICE and the update of ZFLX
+ !$acc wait(10)
+ !
+ CALL DYM_DEVICE( ZTMP2_DEVICE,ZTMP3_DEVICE )
+ IF (.NOT. LFLAT) THEN
+ CALL MZM_DEVICE(PDYY,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PRHODJ * ZFLX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP4_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP2_DEVICE,ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = PDZY / ZTMP1_DEVICE * ZTMP4_DEVICE
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP4_DEVICE )
+ !$acc kernels async(1)
+ PRVS(:,:,:)=PRVS &
+ -ZTMP3_DEVICE &
+ +ZTMP4_DEVICE
+ !$acc end kernels
+ ELSE
+ !$acc kernels async(1)
+ PRVS(:,:,:)=PRVS - ZTMP3_DEVICE
+ !$acc end kernels
+ END IF
+! Contribution to the dynamic production of TKE:
+ IF (KSPLT==1) THEN
+ !$acc kernels async(2)
+ ZWORK(:,:,:) = - ZFLX(:,:,:) * GY_V_M_PVM
+ !$acc end kernels
+ ENDIF
+#endif
ELSE
+ !$acc kernels async(2)
ZWORK(:,:,:) = 0.
-END IF
+ !$acc end kernels
+END IF!
!
IF (KSPLT==1) THEN
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
!
+ !$acc kernels async(2)
ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDV_DY(:,:,1) + ZWORK(:,:,IKB+1) )
+ !$acc end kernels
!
+ !$acc kernels async(2)
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
END IF
!
! Storage in the LES configuration
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+!$acc data copy(X_LES_SUBGRID_V2,X_LES_RES_ddxa_V_SBG_UaV)
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_V2 )
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+#else
+ !
+ !!! wait for the computation of ZWORK and PDP
+ !$acc wait(2)
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -ZWORK
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ !
+#endif
+!$acc end data
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -523,38 +840,60 @@ END IF
!
! Computes the W variance
IF (.NOT. L2D) THEN
+ !$acc kernels async(2)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GZ_W_M_PWM &
-(2./3.) * ( GX_U_M_PUM &
+GY_V_M_PVM ) )
+ !$acc end kernels
!! & to be tested
!! -2.* XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
ELSE
+ !$acc kernels async(2)
ZFLX(:,:,:)= (2./3.) * PTKEM &
- XCMFS * PK *( (4./3.) * GZ_W_M_PWM &
-(2./3.) * ( GX_U_M_PUM ) )
+ !$acc end kernels
!! & to be tested
!! -2.* XCMFB * PLM / SQRT(PTKEM) * (-2./3.) * PTP
END IF
!
+!$acc kernels async(2)
ZFLX(:,:,IKE+1)= ZFLX(:,:,IKE)
+!$acc end kernels
+!
+!!! wait for the computation of ZWORK, PDP and ZFLX
+!$acc wait(2)
!
-ZFLX(:,:,IKB:IKB) = (2./3.) * PTKEM(:,:,IKB:IKB) &
- - XCMFS * PK(:,:,IKB:IKB) * 2. * ZDW_DZ(:,:,:)
-
-!! & to be tested
-!! - 2.* XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
-!! (-2./3.) * PTP(:,:,IKB:IKB)
!
+!$acc kernels async(2)
+ZFLX(:,:,IKB) = (2./3.) * PTKEM(:,:,IKB) &
+ - XCMFS * PK(:,:,IKB) * 2. * ZDW_DZ(:,:,1)
+!$acc end kernels
+!
+
+! & to be tested
+! - 2.* XCMFB * PLM(:,:,IKB:IKB) /SQRT(PTKEM(:,:,IKB:IKB)) * &
+! (-2./3.) * PTP(:,:,IKB:IKB)
! extrapolates this flux under the ground with the surface flux
+!$acc kernels async(3)
ZFLX(:,:,IKB-1) = &
PTAU11M(:,:) * ZDIRSINZW(:,:)**2 &
+ PTAU33M(:,:) * PDIRCOSZW(:,:)**2 &
+2. * PCDUEFF(:,:)* PUSLOPEM(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!$acc end kernels
!
+!
+!!! wait for the computation of ZFLX(:,:,IKB-1) and ZFLX(:,:,IKB)
+!$acc wait(2) async(3)
+!
+!$acc kernels async(3)
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
+!$acc end kernels
!
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ !$acc wait(3)
+ !$acc update self(ZFLX)
! stores <W W>
YRECFM ='W_VAR'
YCOMMENT='X_Y_Z_W_VAR ( (M/S)**2)'
@@ -562,33 +901,65 @@ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
ILENCH=LEN(YCOMMENT)
CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
+!
+!
+!!! wait for the computation of PRVS (that uses ZTMP1_DEVICE and ZTMP3_DEVICE)
+!$acc wait(1)
+!
+
!
! Complete the W tendency
!
!PRWS(:,:,:)=PRWS(:,:,:) - DZM(1,IKU,1, PRHODJ*ZFLX/MZF(1,IKU,1,PDZZ) )
+!$acc kernels async(2)
ZDFDDWDZ(:,:,:) = - XCMFS * PK(:,:,:) * (4./3.)
+!$acc end kernels
+!$acc kernels async(2)
ZDFDDWDZ(:,:,:IKB) = 0.
+!$acc end kernels
+!
+!!! wait for the computation of ZFLX(:,:,IKB-1) and ZDFDDWDZ
+!$acc wait(3) async(2)
+!$acc wait(2)
!
CALL TRIDIAG_W(PWM,ZFLX,ZDFDDWDZ,PTSTEP,ZMZF_DZZ,PRHODJ,ZWP)
!
+#ifndef _OPENACC
PRWS = PRWS(:,:,:) + MZM(1,IKU,1,PRHODJ(:,:,:))*(ZWP(:,:,:)-PWM(:,:,:))/PTSTEP
+#else
+CALL MZM_DEVICE(PRHODJ(:,:,:),ZTMP1_DEVICE)
+!$acc kernels async(1)
+PRWS = PRWS(:,:,:) + ZTMP1_DEVICE *(ZWP(:,:,:)-PWM(:,:,:))/PTSTEP
+!$acc end kernels
+#endif
!
!* recomputes flux using guess of W
!
+#ifndef _OPENACC
GZ_W_M_ZWP = GZ_W_M(1,IKU,1,ZWP,PDZZ)
+#else
+CALL GZ_W_M_DEVICE(1,IKU,1,ZWP,PDZZ,GZ_W_M_ZWP)
+#endif
+!$acc kernels async(2)
ZFLX(:,:,IKB+1:)=ZFLX(:,:,IKB+1:) &
- XCMFS * PK(:,:,IKB+1:) * (4./3.) * (GZ_W_M_ZWP(:,:,IKB+1:) - GZ_W_M_PWM(:,:,IKB+1:))
+!$acc end kernels
!
IF (KSPLT==1) THEN
!Contribution to the dynamic production of TKE:
-! ZWORK(:,:,:) = - ZFLX(:,:,:) * GZ_W_M_PWM
+ !$acc kernels async(2)
ZWORK(:,:,:) = - ZFLX(:,:,:) * GZ_W_M_ZWP
+ !$acc end kernels
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
!
+ !$acc kernels async(2)
ZWORK(:,:,IKB) = 0.5* ( -ZFLX(:,:,IKB)*ZDW_DZ(:,:,1) + ZWORK(:,:,IKB+1) )
+ !$acc end kernels
!
+ !$acc kernels async(2)
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
END IF
!
! Storage in the LES configuration
@@ -596,6 +967,7 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_W2 )
CALL LES_MEAN_SUBGRID( -ZWORK, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
CALL LES_MEAN_SUBGRID( GZ_M_M(1,IKU,1,PTHLM,PDZZ)*ZFLX, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
@@ -612,10 +984,88 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
CALL LES_MEAN_SUBGRID(ZFLX*MZF(1,IKU,1,GZ_M_W(1,IKU,1,PSVM(:,:,:,JSV),PDZZ)), &
X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
END DO
+#else
+!$acc data copy(X_LES_SUBGRID_W2,X_LES_RES_ddxa_W_SBG_UaW,X_LES_RES_ddxa_Thl_SBG_UaW,X_LES_RES_ddz_Thl_SBG_W2)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_W2 )
+ !
+ !
+ !!! wait for the computation of ZFLX, ZDP and ZWORK
+ !$acc wait(2)
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -ZWORK
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ !
+ CALL GZ_M_M_DEVICE(1,IKU,1,PTHLM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ !
+ CALL GZ_M_W_DEVICE(1,IKU,1,PTHLM,PDZZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLX*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP3_DEVICE,X_LES_RES_ddz_Thl_SBG_W2)
+ !
+!$acc end data
+ !
+ IF (KRR>=1) THEN
+!$acc data copy(X_LES_RES_ddxa_Rt_SBG_UaW,X_LES_RES_ddz_Rt_SBG_W2)
+ !
+ CALL GZ_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ !
+ CALL GZ_M_W_DEVICE(1,IKU,1,PRM(:,:,:,1),PDZZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLX*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP3_DEVICE, X_LES_RES_ddz_Rt_SBG_W2)
+ !
+!$acc end data
+ END IF
+!$acc data copy(X_LES_RES_ddxa_Sv_SBG_UaW,X_LES_RES_ddz_Sv_SBG_W2)
+ DO JSV=1,NSV
+ !
+ !
+ CALL GZ_M_M_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, &
+ X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ !
+ CALL GZ_M_W_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDZZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLX*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID(ZTMP3_DEVICE, X_LES_RES_ddz_Sv_SBG_W2(:,:,:,JSV))
+ !
+ !
+ END DO
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
!
+!
+!!! wait for the computation of ZFLX, ZDP and ZWORK
+!$acc wait(2)
+!!! wait for the computation of PRWS
+!$acc wait(1)
+!
+!!! et un dernier wait pour etre sur
+!$acc wait
+!
CALL CLEANLIST_ll(TZFIELDS_ll)
!
!
diff --git a/src/MNH/turb_hor_splt.f90 b/src/MNH/turb_hor_splt.f90
index 43daa0ffde539b2986c0a70239e9b89a9e0bb0bb..6ead214a165652c26e783aafe34760b82e1e8f75 100644
--- a/src/MNH/turb_hor_splt.f90
+++ b/src/MNH/turb_hor_splt.f90
@@ -102,7 +102,18 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+!$acc & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFSVM, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PDP,PTP,PSIGS, &
+!$acc & PTRH, &
+!$acc & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
!
END SUBROUTINE TURB_HOR_SPLT
!
@@ -264,7 +275,11 @@ USE MODD_CTURB
USE MODD_PARAMETERS
!
!
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_TURB_HOR
USE MODI_TURB_HOR_TKE
!
@@ -347,7 +362,18 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
+!$acc & PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFSVM, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PDP,PTP,PSIGS, &
+!$acc & PTRH, &
+!$acc & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
!
!* 0.2 declaration of local variables
!
@@ -371,9 +397,15 @@ REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ZRM, ZSVM
REAL,ALLOCATABLE,DIMENSION(:,:,:) :: ZRUS, ZRVS, ZRWS, ZRTHLS
REAL,ALLOCATABLE,DIMENSION(:,:,:,:) :: ZRRS, ZRSVS
!
+!$acc declare create(ZK,ZINV_PDXX,ZINV_PDYY,ZINV_PDZZ,ZMZM_PRHODJ, &
+!$acc & ZUM,ZVM,ZWM,ZTHLM,ZTKEM,ZRM,ZSVM,ZRUS,ZRVS,ZRWS,ZRTHLS,ZRRS,ZRSVS)
!
TYPE(LIST_ll), POINTER, SAVE :: TZFIELDS_ll
!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -391,12 +423,18 @@ ALLOCATE(ZINV_PDYY(SIZE(PDYY,1),SIZE(PDYY,2),SIZE(PDYY,3)))
ALLOCATE(ZINV_PDZZ(SIZE(PDZZ,1),SIZE(PDZZ,2),SIZE(PDZZ,3)))
ALLOCATE(ZMZM_PRHODJ(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)))
!
+!$acc kernels
ZINV_PDXX = 1./PDXX
ZINV_PDYY = 1./PDYY
ZINV_PDZZ = 1./PDZZ
-ZMZM_PRHODJ = MZM(1,IKU,1,PRHODJ)
!
ZK(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+!$acc end kernels
+#ifndef _OPENACC
+ZMZM_PRHODJ = MZM(1,IKU,1,PRHODJ)
+#else
+CALL MZM_DEVICE(PRHODJ,ZMZM_PRHODJ)
+#endif
!
NULLIFY(TZFIELDS_ll)
!
@@ -449,6 +487,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
! ---------------
!
!
+ !$acc kernels
ZUM=PUM
ZVM=PVM
ZWM=PWM
@@ -463,6 +502,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
IF (ISV>0) ZRSVS=PRSVS*KSPLIT
ZRTHLS=PRTHLS*KSPLIT
IF (KRR>0) ZRRS=PRRS*KSPLIT
+ !$acc end kernels
!
!* 2.4 split process
@@ -498,9 +538,16 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
!
! split temporal advance
-
+#ifndef _OPENACC
ZUM=PUM+(ZRUS/KSPLIT-PRUS)/MXM(PRHODJ)*PTSTEP
ZVM=PVM+(ZRVS/KSPLIT-PRVS)/MYM(PRHODJ)*PTSTEP
+#else
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ CALL MYM_DEVICE(PRHODJ,ZTMP2_DEVICE)
+!$acc kernels
+ ZUM=PUM+(ZRUS/KSPLIT-PRUS)/ZTMP1_DEVICE*PTSTEP
+ ZVM=PVM+(ZRVS/KSPLIT-PRVS)/ZTMP2_DEVICE*PTSTEP
+#endif
ZWM=PWM+(ZRWS/KSPLIT-PRWS)/ZMZM_PRHODJ*PTSTEP
DO JSV=1,ISV
ZSVM(:,:,:,JSV)=PSVM(:,:,:,JSV)+ &
@@ -512,12 +559,38 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZRM(:,:,:,JRR)=PRM(:,:,:,JRR)+ &
(ZRRS(:,:,:,JRR)/KSPLIT-PRRS(:,:,:,JRR))/PRHODJ*PTSTEP
END DO
+!$acc end kernels
!
! reinforce boundary conditions
!
+#ifndef _OPENACC
IF (JSPLT<KSPLIT-NHALO+1) CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+#else
+ !
+ ! Pour le update_halo_ll, on fait des update self, puis le update_halo_ll sur CPU
+ ! on copie ensuite les champs avec le halo a jour sur le device
+ !
+ IF (JSPLT<KSPLIT-NHALO+1) THEN
+ !$update self(ZUM,ZVM,ZWM,ZTHLM,ZTKEM)
+ IF (ISV>0) THEN
+ !$update self(ZSVM(:,:,:,1:ISV))
+ END IF
+ IF (KRR>0) THEN
+ !$update self(ZRM(:,:,:,1:KRR))
+ END IF
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ IF (KRR>0) THEN
+ !$update device(ZRM(:,:,:,1:KRR))
+ END IF
+ IF (ISV>0) THEN
+ !$update device(ZSVM(:,:,:,1:ISV))
+ END IF
+ !$update device(ZUM,ZVM,ZWM,ZTHLM,ZTKEM)
+ ENDIF
+#endif
!
IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
+!$acc kernels
ZUM(IIB ,:,:)=PUM(IIB ,:,:)
ZVM(IIB-1,:,:)=PVM(IIB-1,:,:)
ZWM(IIB-1,:,:)=PWM(IIB-1,:,:)
@@ -525,9 +598,11 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZTKEM(IIB-1,:,:)=PTKEM(IIB-1,:,:)
IF (ISV>0) ZSVM(IIB-1,:,:,:)=PSVM(IIB-1,:,:,:)
IF (KRR>0) ZRM (IIB-1,:,:,:)=PRM (IIB-1,:,:,:)
+!$acc end kernels
ENDIF
!
IF ( HLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
+!$acc kernels
ZUM(IIE+1,:,:)=PUM(IIE+1,:,:)
ZVM(IIE+1,:,:)=PVM(IIE+1,:,:)
ZWM(IIE+1,:,:)=PWM(IIE+1,:,:)
@@ -535,9 +610,11 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZTKEM(IIE+1,:,:)=PTKEM(IIE+1,:,:)
IF (ISV>0) ZSVM(IIE+1,:,:,:)=PSVM(IIE+1,:,:,:)
IF (KRR>0) ZRM (IIE+1,:,:,:)=PRM(IIE+1,:,:,:)
+!$acc end kernels
ENDIF
!
IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
+!$acc kernels
ZUM(:,IJB-1,:)=PUM(:,IJB-1,:)
ZVM(:,IJB ,:)=PVM(:,IJB ,:)
ZWM(:,IJB-1,:)=PWM(:,IJB-1,:)
@@ -545,9 +622,11 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZTKEM(:,IJB-1,:)=PTKEM(:,IJB-1,:)
IF (ISV>0) ZSVM(:,IJB-1,:,:)=PSVM(:,IJB-1,:,:)
IF (KRR>0) ZRM (:,IJB-1,:,:)=PRM (:,IJB-1,:,:)
+!$acc end kernels
ENDIF
!
IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
+!$acc kernels
ZUM(:,IJE+1,:)=PUM(:,IJE+1,:)
ZVM(:,IJE+1,:)=PVM(:,IJE+1,:)
ZWM(:,IJE+1,:)=PWM(:,IJE+1,:)
@@ -555,8 +634,10 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZTKEM(:,IJE+1,:)=PTKEM(:,IJE+1,:)
IF (ISV>0) ZSVM(:,IJE+1,:,:)=PSVM(:,IJE+1,:,:)
IF (KRR>0) ZRM (:,IJE+1,:,:)=PRM(:,IJE+1,:,:)
+!$acc end kernels
ENDIF
!
+!$acc kernels
ZUM(:,:,IKB-1)=ZUM(:,:,IKB)
ZVM(:,:,IKB-1)=ZVM(:,:,IKB)
ZWM(:,:,IKB-1)=ZWM(:,:,IKB)
@@ -572,12 +653,14 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ZTKEM(:,:,IKE+1)=ZTKEM(:,:,IKE)
IF (ISV>0) ZSVM(:,:,IKE+1,:)=ZSVM(:,:,IKE,:)
IF (KRR>0) ZRM (:,:,IKE+1,:)=ZRM (:,:,IKE,:)
+!$acc end kernels
!
END DO
!
!* 2.5 update the complete tendencies
! ------------------------------
!
+!$acc kernels
PRUS=ZRUS/KSPLIT
PRVS=ZRVS/KSPLIT
PRWS=ZRWS/KSPLIT
@@ -585,6 +668,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
PRTHLS=ZRTHLS/KSPLIT
IF (KRR>0) PRRS=ZRRS/KSPLIT
PTRH=(ZTKEM-PTKEM)/PTSTEP
+!$acc end kernels
!
!* 2.6 deallocations
! -------------
@@ -628,7 +712,6 @@ ELSE
PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
PDP,PTP,PSIGS, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-
! horizontal transport of Tke
!
diff --git a/src/MNH/turb_hor_sv_corr.f90 b/src/MNH/turb_hor_sv_corr.f90
index 715f6df352cd4fbef8078d274dacb1d4b2183e56..2f2f8f7b5cc0af628e82149a9ef4b7c68e45f9af 100644
--- a/src/MNH/turb_hor_sv_corr.f90
+++ b/src/MNH/turb_hor_sv_corr.f90
@@ -150,6 +150,10 @@ REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
! ---------------------------------------------------------------------------
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: TURB_HOR_SV_CORR:: not yet implemented'
+CALL ABORT
+#endif
IKU=SIZE(PTKEM,3)
CALL SECOND_MNH(ZTIME1)
!
@@ -176,7 +180,14 @@ DO JSV=1,NSV
! covariance SvThv
!
IF (LLES_CALL) THEN
+#ifndef _OPENACC
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+#else
+PRINT *,'OPENACC: TURB_HOR_SV_CORR:: LLES_CALL not yet tested'
+!$acc data copyin(PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) copyout(ZA)
+ CALL ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,ZA)
+!$acc end data
+#endif
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
@@ -191,7 +202,14 @@ DO JSV=1,NSV
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE. )
!
IF (KRR>=1) THEN
+#ifndef _OPENACC
ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+#else
+PRINT *,'OPENACC: TURB_HOR_SV_CORR:: LLES_CALL not yet tested'
+!$acc data copyin(PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) copyout(ZA)
+ CALL EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,ZA)
+!$acc end data
+#endif
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= PLM(:,:,:) * PLEPS(:,:,:) &
* ( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX) * GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX) &
diff --git a/src/MNH/turb_hor_sv_flux.f90 b/src/MNH/turb_hor_sv_flux.f90
index c60ad2b59d220960bcab0550dd30b0d9d01023db..9f3277298f165ef7c8851da6024c2d073a6e7d59 100644
--- a/src/MNH/turb_hor_sv_flux.f90
+++ b/src/MNH/turb_hor_sv_flux.f90
@@ -57,7 +57,13 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSXW,PDIRCOSYW, &
+!$acc & PRHODJ,PWM, &
+!$acc & PSFSVM, &
+!$acc & PSVM, &
+!$acc & PRSVS)
!
END SUBROUTINE TURB_HOR_SV_FLUX
!
@@ -113,6 +119,7 @@ END MODULE MODI_TURB_HOR_SV_FLUX
!! Nov 06, 2002 (V. Masson) LES budgets
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -130,7 +137,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_COEFJ
USE MODI_LES_MEAN_SUBGRID
!
@@ -174,7 +185,13 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-1
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! var. at t+1 -split-
!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSXW,PDIRCOSYW, &
+!$acc & PRHODJ,PWM, &
+!$acc & PSFSVM, &
+!$acc & PSVM, &
+!$acc & PRSVS)
!
!* 0.2 declaration of local variables
!
@@ -199,6 +216,12 @@ REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
!
INTEGER :: IKU
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,&
+ ZTMP4_DEVICE,ZTMP5_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE,ZTMP5_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -213,12 +236,14 @@ ISV = SIZE(PSVM,4)
!
! compute the coefficients for the uncentred gradient computation near the
! ground
+!$acc kernels
ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!$acc end kernels
!
!
!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
@@ -233,11 +258,20 @@ DO JSV=1,ISV
! ----------
!
! Computes the flux in the X direction
+#ifndef _OPENACC
ZFLXX(:,:,:) = -XCHF * MXM(PK) * GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)
+#else
+ CALL MXM_DEVICE(PK,ZTMP1_DEVICE)
+ CALL GX_M_U_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLXX(:,:,:) = -XCHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+#endif
ZFLXX(:,:,IKE+1) = ZFLXX(:,:,IKE)
+!$acc end kernels
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
+#ifndef _OPENACC
ZFLXX(:,:,IKB:IKB) = -XCHF * MXM( PK(:,:,IKB:IKB) ) * &
( DXM(PSVM(:,:,IKB:IKB,JSV)) * PINV_PDXX(:,:,IKB:IKB) &
-MXM ( ZCOEFF(:,:,IKB+2:IKB+2)*PSVM(:,:,IKB+2:IKB+2,JSV) &
@@ -246,13 +280,40 @@ DO JSV=1,ISV
) * 0.5 * ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB) ) &
* PINV_PDXX(:,:,IKB:IKB) &
)
+#else
+ CALL MXM_DEVICE( PK(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1) )
+ CALL DXM_DEVICE(PSVM(:,:,IKB:IKB,JSV),ZTMP2_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PSVM(:,:,IKB+2,JSV) &
+ +ZCOEFF(:,:,IKB+1)*PSVM(:,:,IKB+1,JSV) &
+ +ZCOEFF(:,:,IKB)*PSVM(:,:,IKB,JSV)
+!$acc end kernels
+ CALL MXM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZFLXX(:,:,IKB) = -XCHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB) &
+ - ZTMP4_DEVICE(:,:,1) * 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB) ) &
+ * PINV_PDXX(:,:,IKB) &
+ )
+!$acc end kernels
+#endif
! extrapolates the flux under the ground so that the vertical average with
! the IKB flux gives the ground value
+!$acc kernels
ZWORK2D(:,:,1)=PSFSVM(:,:,JSV) * PDIRCOSXW(:,:)
+!$acc end kernels
+#ifndef _OPENACC
ZFLXX(:,:,IKB-1:IKB-1) = 2. * MXM( ZWORK2D(:,:,1:1) ) - ZFLXX(:,:,IKB:IKB)
+#else
+ CALL MXM_DEVICE( ZWORK2D(:,:,1:1),ZTMP1_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZFLXX(:,:,IKB-1) = 2. * ZTMP1_DEVICE(:,:,1) - ZFLXX(:,:,IKB)
+!$acc end kernels
+#endif
!
! stores <U SVth>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLXX)
WRITE(YRECFM,'("USV_FLX_",I3.3)') JSV
YCOMMENT='X_Y_Z_'//YRECFM//' (SVUNIT*M/S)'
IGRID = 2
@@ -262,11 +323,37 @@ DO JSV=1,ISV
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(ZFLXX), X_LES_SUBGRID_USv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)*MZM(1,IKU,1,ZFLXX))), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MXF(ZFLXX), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_USv(:,:,:,JSV),X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV), &
+!$acc & X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV))
+ !
+ CALL MXF_DEVICE(ZFLXX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_USv(:,:,:,JSV) )
+ !
+ CALL GX_W_UW_DEVICE(1,IKU,1,PWM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLXX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ !
+ CALL GX_M_M_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(ZFLXX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV), .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -277,12 +364,21 @@ DO JSV=1,ISV
IF (.NOT. L2D) THEN
!
! Computes the flux in the Y direction
+#ifndef _OPENACC
ZFLXY(:,:,:)=-XCHF * MYM(PK) * GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)
+#else
+ CALL MYM_DEVICE(PK,ZTMP1_DEVICE)
+ CALL GY_M_V_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+ !$acc kernels
+ ZFLXY(:,:,:)=-XCHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+#endif
ZFLXY(:,:,IKE+1) = ZFLXY(:,:,IKE)
+ !$acc end kernels
!
! Compute the flux at the first inner V-point with an uncentred vertical
! gradient
!
+#ifndef _OPENACC
ZFLXY(:,:,IKB:IKB) = -XCHF * MYM( PK(:,:,IKB:IKB) ) * &
( DYM(PSVM(:,:,IKB:IKB,JSV)) * PINV_PDYY(:,:,IKB:IKB) &
-MYM ( ZCOEFF(:,:,IKB+2:IKB+2)*PSVM(:,:,IKB+2:IKB+2,JSV) &
@@ -291,13 +387,40 @@ DO JSV=1,ISV
) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
* PINV_PDYY(:,:,IKB:IKB) &
)
+#else
+ CALL MYM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DYM_DEVICE( PSVM(:,:,IKB:IKB,JSV), ZTMP2_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PSVM(:,:,IKB+2,JSV) &
+ +ZCOEFF(:,:,IKB+1)*PSVM(:,:,IKB+1,JSV) &
+ +ZCOEFF(:,:,IKB)*PSVM(:,:,IKB,JSV)
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZFLXY(:,:,IKB) = -XCHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB) &
+ - ZTMP4_DEVICE(:,:,1) * 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB) ) &
+ * PINV_PDYY(:,:,IKB) &
+ )
+ !$acc end kernels
+#endif
! extrapolates the flux under the ground so that the vertical average with
! the IKB flux gives the ground value
+!$acc kernels
ZWORK2D(:,:,1)=PSFSVM(:,:,JSV) * PDIRCOSYW(:,:)
+!$acc end kernels
+#ifndef _OPENACC
ZFLXY(:,:,IKB-1:IKB-1) = 2. * MYM( ZWORK2D(:,:,1:1) ) - ZFLXY(:,:,IKB:IKB)
+#else
+ CALL MYM_DEVICE( ZWORK2D(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZFLXY(:,:,IKB-1) = 2. * ZTMP1_DEVICE(:,:,1) - ZFLXY(:,:,IKB)
+ !$acc end kernels
+#endif
!
! stores <V SVth>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLXY)
WRITE(YRECFM,'("VSV_FLX_",I3.3)') JSV
YCOMMENT='X_Y_Z_'//YRECFM//' (SVUNIT*M/S)'
IGRID = 3
@@ -306,16 +429,44 @@ DO JSV=1,ISV
END IF
!
ELSE
+ !$acc kernels
ZFLXY=0.
+ !$acc end kernels
END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MYF(ZFLXY), X_LES_SUBGRID_VSv(:,:,:,JSV) )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*MZM(1,IKU,1,ZFLXY))), &
X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
CALL LES_MEAN_SUBGRID( GY_M_M(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MYF(ZFLXY), &
X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_VSv(:,:,:,JSV),X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV), &
+!$acc & X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV))
+ !
+ CALL MYF_DEVICE(ZFLXY,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_VSv(:,:,:,JSV) )
+ !
+ CALL GY_W_VW_DEVICE(1,IKU,1,PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLXY,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE,X_LES_RES_ddxa_W_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ !
+ CALL GY_M_M_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(ZFLXY,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Sv_SBG_UaSv(:,:,:,JSV) , .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -324,6 +475,7 @@ DO JSV=1,ISV
! 15.3 Horizontal source terms
! -----------------------
!
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRSVS(:,:,:,JSV)= PRSVS(:,:,:,JSV) &
@@ -349,6 +501,71 @@ DO JSV=1,ISV
-DXF( MXM(PRHODJ) *ZFLXX * PINV_PDXX )
END IF
END IF
+#else
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLXX * PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP2_DEVICE, ZTMP1_DEVICE )
+ IF (.NOT. L2D) THEN
+ CALL MYM_DEVICE(PRHODJ,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP4_DEVICE = ZTMP1_DEVICE * ZFLXY * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP4_DEVICE, ZTMP2_DEVICE )
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLXX * PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE * PDZX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLXY * PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP3_DEVICE,ZTMP5_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP5_DEVICE * PDZY
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP3_DEVICE,ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = PMZM_PRHODJ * PINV_PDZZ * ( ZTMP4_DEVICE + ZTMP5_DEVICE )
+ !$acc end kernels
+ CALL DZF_DEVICE( 1,IKU,1, ZTMP3_DEVICE, ZTMP4_DEVICE)
+ !$acc kernels
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZTMP1_DEVICE - ZTMP2_DEVICE + ZTMP4_DEVICE
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZTMP1_DEVICE - ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+ ELSE
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLXX * PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE * PDZX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = PMZM_PRHODJ * PINV_PDZZ * ZTMP4_DEVICE
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZTMP1_DEVICE + ZTMP2_DEVICE
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+#endif
!
!
END DO ! end loop JSV
diff --git a/src/MNH/turb_hor_thermo_corr.f90 b/src/MNH/turb_hor_thermo_corr.f90
index 07f2117060ac1daefd95f5ef9dc1a795c04bca47..2ac18385046c5ae6b39f1de50fbe111a475e2f66 100644
--- a/src/MNH/turb_hor_thermo_corr.f90
+++ b/src/MNH/turb_hor_thermo_corr.f90
@@ -67,6 +67,13 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
+!$acc declare present(PINV_PDXX,PINV_PDYY, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PTHVREF, &
+!$acc & PWM,PTHLM,PRM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+!$acc & PSIGS)
!
!
END SUBROUTINE TURB_HOR_THERMO_CORR
@@ -121,6 +128,7 @@ END MODULE MODI_TURB_HOR_THERMO_CORR
!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
@@ -140,7 +148,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_LES_MEAN_SUBGRID
!
USE MODI_EMOIST
@@ -178,7 +190,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state Virtual
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
! where PRM(:,:,:,1) = conservative mixing ratio
!
@@ -197,11 +209,20 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
! IN: Vertical part of Sigma_s at t
! OUT: Total Sigma_s at t
!
+!$acc declare present(PINV_PDXX,PINV_PDYY, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PTHVREF, &
+!$acc & PWM,PTHLM,PRM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+!$acc & PSIGS)
+!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) &
:: ZFLX,ZWORK,ZA
! work arrays
+!$acc declare create(ZFLX,ZWORK,ZA)
!
INTEGER :: IRESP ! Return code of FM routines
INTEGER :: IGRID ! C-grid indicator in LFIFM file
@@ -216,6 +237,13 @@ REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
! computation near the ground
REAL :: ZTIME1, ZTIME2
!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE, &
+!$acc & ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE)
+#endif
+!
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -229,12 +257,14 @@ IKU = SIZE(PTHLM,3)
!
! compute the coefficients for the uncentred gradient computation near the
! ground
+!$acc kernels
ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!$acc end kernels
!
!
!* 8. TURBULENT CORRELATIONS : <THl THl>, <THl Rnp>, <Rnp Rnp>, Sigma_s
@@ -248,6 +278,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!* 8.1 <THl THl>
!
! Computes the horizontal variance <THl THl>
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)**2 + GY_M_M(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)**2 )
@@ -255,10 +286,25 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * &
GX_M_M(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)**2
END IF
+#else
+ IF (.NOT. L2D) THEN
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GY_M_M_DEVICE(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * ( ZTMP1_DEVICE**2 + ZTMP2_DEVICE**2 )
+!$acc end kernels
+ ELSE
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = XCTV * PLM(:,:,:) * PLEPS(:,:,:) * ZTMP1_DEVICE**2
+!$acc end kernels
+ END IF
+#endif
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
!
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = XCTV * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
@@ -275,15 +321,50 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
/ MYF(PDYY(:,:,IKB:IKB)) &
) ** 2 )
+#else
+ CALL DXM_DEVICE(PTHLM(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB)
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE(:,:,1:1), ZTMP3_DEVICE(:,:,1:1))
+ CALL MXF_DEVICE(PDXX(:,:,IKB:IKB), ZTMP4_DEVICE(:,:,1:1))
+ !
+ CALL DYM_DEVICE(PTHLM(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB)
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1))
+ CALL MYF_DEVICE(PDYY(:,:,IKB:IKB), ZTMP2_DEVICE(:,:,1:1))
+ !
+!$acc kernels
+ ZFLX(:,:,IKB) = XCTV * PLM(:,:,IKB) &
+ * PLEPS(:,:,IKB) * ( &
+ ( ZTMP3_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB) ) &
+ / ZTMP4_DEVICE(:,:,1) &
+ ) ** 2 + &
+ ( ZTMP1_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB) ) &
+ / ZTMP2_DEVICE(:,:,1) &
+ ) ** 2 )
+#endif
!
ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
!
IF ( KRRL > 0 ) THEN
ZWORK(:,:,:) = ZFLX(:,:,:) * PATHETA(:,:,:) * PATHETA(:,:,:)
END IF
+!$acc end kernels
!
! stores <THl THl>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLX)
YRECFM ='THL_HVAR'
YCOMMENT='X_Y_Z_THL_HVAR (KELVIN**2)'
IGRID = 1
@@ -295,12 +376,43 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_Thl2, .TRUE. )
CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz, .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_Thl2,X_LES_RES_W_SBG_Thl2,X_LES_SUBGRID_DISS_Thl2, &
+!$acc & X_LES_SUBGRID_ThlThv,X_LES_SUBGRID_ThlPz)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Thl2, .TRUE. )
+ !
+ CALL MZF_DEVICE(1,IKU,1,PWM, ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_Thl2, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE ,X_LES_SUBGRID_DISS_Thl2, .TRUE. )
+ !
+ CALL ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM, ZA(:,:,:))
+!$acc kernels
+ ZTMP1_DEVICE = ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlThv, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -XG/PTHVREF/3.*ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlPz, .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -310,6 +422,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!* 8.3 <THl Rnp>
!
! Computes the horizontal correlation <THl Rnp>
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
ZFLX(:,:,:)= &
PLM(:,:,:) * PLEPS(:,:,:) * &
@@ -323,9 +436,27 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
) * (XCHT1+XCHT2)
END IF
+#else
+ IF (.NOT. L2D) THEN
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM ,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GY_M_M_DEVICE(1,IKU,1,PTHLM ,PDYY,PDZZ,PDZY,ZTMP3_DEVICE)
+ CALL GY_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP4_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:)=PLM(:,:,:) * PLEPS(:,:,:) * (ZTMP1_DEVICE*ZTMP2_DEVICE+ZTMP3_DEVICE*ZTMP4_DEVICE ) * (XCHT1+XCHT2)
+!$acc end kernels
+ ELSE
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM ,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:)=PLM(:,:,:) * PLEPS(:,:,:) * (ZTMP1_DEVICE*ZTMP2_DEVICE) * (XCHT1+XCHT2)
+!$acc end kernels
+ END IF
+#endif
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = (XCHT1+XCHT2) * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB)) &
@@ -356,16 +487,76 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
/ MYF(PDYY(:,:,IKB:IKB)) &
) )
+#else
+ CALL DXM_DEVICE(PTHLM(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDXX(:,:,IKB)
+!$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP3_DEVICE(:,:,1:1) )
+ CALL MXF_DEVICE(PDXX(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
+ !
+ CALL DXM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDXX(:,:,IKB)
+!$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP5_DEVICE(:,:,1:1) )
+ !
+ CALL DYM_DEVICE(PTHLM(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDYY(:,:,IKB)
+!$acc end kernels
+ CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP6_DEVICE(:,:,1:1) )
+ CALL MYF_DEVICE(PDYY(:,:,IKB:IKB),ZTMP7_DEVICE(:,:,1:1))
+ !
+ CALL DYM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDYY(:,:,IKB)
+!$acc end kernels
+ CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP8_DEVICE(:,:,1:1) )
+ !
+!$acc kernels
+ ZFLX(:,:,IKB) = (XCHT1+XCHT2) * PLM(:,:,IKB) &
+ * PLEPS(:,:,IKB) * ( &
+ ( ZTMP3_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB) ) &
+ / ZTMP4_DEVICE(:,:,1) &
+ ) * &
+ ( ZTMP5_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB) ) &
+ / ZTMP4_DEVICE(:,:,1) &
+ ) + &
+ ( ZTMP6_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB ) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB) ) &
+ / ZTMP7_DEVICE(:,:,1) &
+ ) * &
+ ( ZTMP8_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB) ) &
+ / ZTMP7_DEVICE(:,:,1) &
+ ) )
+#endif
!
ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
!
IF ( KRRL > 0 ) THEN
ZWORK(:,:,:) = ZWORK(:,:,:) + &
2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLX(:,:,:)
- END IF
- !
+ END IF
+!$acc end kernels
! stores <THl Rnp>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLX)
YRECFM ='THLR_HCOR'
YCOMMENT='X_Y_Z_THLR_HCOR (KELVIN*KG/KG)'
IGRID = 1
@@ -377,6 +568,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_ThlRt, .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_ThlRt, .TRUE. )
CALL LES_MEAN_SUBGRID( -XCTD*SQRT(PTKEM)*ZFLX/PLEPS ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
@@ -385,6 +577,46 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_ThlThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_ThlPz,.TRUE.)
+#else
+!$acc data copy(X_LES_SUBGRID_ThlRt,X_LES_RES_W_SBG_ThlRt,X_LES_SUBGRID_DISS_ThlRt, &
+!$acc & X_LES_SUBGRID_RtThv,X_LES_SUBGRID_RtPz,X_LES_SUBGRID_ThlThv,X_LES_SUBGRID_ThlPz)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_ThlRt, .TRUE. )
+ !
+ CALL MZF_DEVICE(1,IKU,1,PWM,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_ThlRt, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -XCTD*SQRT(PTKEM)*ZFLX/PLEPS
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE ,X_LES_SUBGRID_DISS_ThlRt, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtThv, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -XG/PTHVREF/3.*ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtPz,.TRUE.)
+ !
+ CALL EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,ZA(:,:,:))
+!$acc kernels
+ ZTMP1_DEVICE = ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlThv, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -XG/PTHVREF/3.*ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlPz,.TRUE.)
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -392,6 +624,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!* 8.4 <Rnp Rnp>
!
! Computes the horizontal variance <Rnp Rnp>
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 + &
@@ -400,9 +633,24 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * &
( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)**2 )
END IF
+#else
+ IF (.NOT. L2D) THEN
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GY_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * ( ZTMP1_DEVICE**2 + ZTMP2_DEVICE**2 )
+!$acc end kernels
+ ELSE
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = XCHV * PLM(:,:,:) * PLEPS(:,:,:) * ZTMP1_DEVICE**2
+!$acc end kernels
+ END IF
+#endif
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = XCHV * PLM(:,:,IKB:IKB) &
* PLEPS(:,:,IKB:IKB) * ( &
( MXF(DXM(PRM(:,:,IKB:IKB,1)) * PINV_PDXX(:,:,IKB:IKB)) &
@@ -419,15 +667,49 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
) * 0.5 * ( PDZY(:,:,IKB+1:IKB+1)+PDZY(:,:,IKB:IKB) ) &
/ MYF(PDYY(:,:,IKB:IKB)) &
) ** 2 )
+#else
+ CALL DXM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDXX(:,:,IKB)
+!$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP3_DEVICE(:,:,1:1) )
+ CALL MXF_DEVICE(PDXX(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
+ !
+ CALL DYM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP1_DEVICE(:,:,1)* PINV_PDYY(:,:,IKB)
+!$acc end kernels
+ CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP5_DEVICE(:,:,1:1) )
+ CALL MYF_DEVICE(PDYY(:,:,IKB:IKB),ZTMP6_DEVICE(:,:,1:1))
+ !
+!$acc kernels
+ ZFLX(:,:,IKB) = XCHV * PLM(:,:,IKB) &
+ * PLEPS(:,:,IKB) * ( &
+ ( ZTMP3_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1) &
+ ) * 0.5 * ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB) ) &
+ / ZTMP4_DEVICE(:,:,1) &
+ ) ** 2 + &
+ ( ZTMP5_DEVICE(:,:,1) &
+ - ( ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1) &
+ ) * 0.5 * ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB) ) &
+ / ZTMP6_DEVICE(:,:,1) &
+ ) ** 2 )
+#endif
!
ZFLX(:,:,IKB-1) = ZFLX(:,:,IKB)
!
IF ( KRRL > 0 ) THEN
ZWORK(:,:,:) = ZWORK(:,:,:)+ PAMOIST(:,:,:) * PAMOIST(:,:,:) * ZFLX(:,:,:)
END IF
- !
+!$acc end kernels
! stores <Rnp Rnp>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLX)
YRECFM ='R_HVAR'
YCOMMENT='X_Y_Z_R_HVAR (KG/KG **2)'
IGRID = 1
@@ -439,11 +721,41 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Rt2, .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,PWM)*ZFLX, X_LES_RES_W_SBG_Rt2, .TRUE. )
CALL LES_MEAN_SUBGRID( ZA*ZFLX, X_LES_SUBGRID_RtThv, .TRUE. )
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLX, X_LES_SUBGRID_RtPz,.TRUE.)
CALL LES_MEAN_SUBGRID( -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS, X_LES_SUBGRID_DISS_Rt2, .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_Rt2,X_LES_RES_W_SBG_Rt2,X_LES_SUBGRID_RtThv, &
+!$acc & X_LES_SUBGRID_RtPz,X_LES_SUBGRID_DISS_Rt2)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLX, X_LES_SUBGRID_Rt2, .TRUE. )
+ !
+ CALL MZF_DEVICE(1,IKU,1,PWM,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_Rt2, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtThv, .TRUE. )
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -XG/PTHVREF/3.*ZA*ZFLX
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtPz,.TRUE.)
+ !
+!$acc kernels
+ ZTMP1_DEVICE = -2.*XCTD*SQRT(PTKEM)*ZFLX/PLEPS
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_DISS_Rt2, .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -454,11 +766,13 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!
IF ( KRRL > 0 ) THEN
!
+ !$acc kernels
PSIGS(:,:,:)=PSIGS(:,:,:)*PSIGS(:,:,:) + ZWORK(:,:,:)
! Extrapolate PSIGS at the ground and at the top
PSIGS(:,:,IKB-1) = PSIGS(:,:,IKB)
PSIGS(:,:,IKE+1) = PSIGS(:,:,IKE)
PSIGS(:,:,:) = SQRT(MAX ( PSIGS(:,:,:),1.E-12) )
+ !$acc end kernels
END IF
!
END IF
diff --git a/src/MNH/turb_hor_thermo_flux.f90 b/src/MNH/turb_hor_thermo_flux.f90
index c61b7e549a42bfc6816cfddf36176b38272a747d..43eec804912ef7876a6dabbb730e3adf1b30e9de 100644
--- a/src/MNH/turb_hor_thermo_flux.f90
+++ b/src/MNH/turb_hor_thermo_flux.f90
@@ -75,6 +75,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSXW,PDIRCOSYW, &
+!$acc & PRHODJ, &
+!$acc & PSFTHM,PSFRM, &
+!$acc & PWM,PTHLM,PRM, &
+!$acc & PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PRTHLS,PRRS )
!
END SUBROUTINE TURB_HOR_THERMO_FLUX
!
@@ -131,6 +139,7 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
!! Feb 20, 2003 (JP Pinty) Add PFRAC_ICE
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -149,10 +158,12 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_LES_MEAN_SUBGRID
-!!USE MODI_EMOIST
-!!USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
@@ -194,7 +205,7 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSFTHM,PSFRM
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PWM
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHLM
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! mixing ratios at t-1,
! where PRM(:,:,:,1) = conservative mixing ratio
!
@@ -210,6 +221,14 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFRAC_ICE ! ri fraction of rc+ri
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHLS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! var. at t+1 -split-
!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
+!$acc & PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSXW,PDIRCOSYW, &
+!$acc & PRHODJ, &
+!$acc & PSFTHM,PSFRM, &
+!$acc & PWM,PTHLM,PRM, &
+!$acc & PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PRTHLS,PRRS )
!
!
!* 0.2 declaration of local variables
@@ -230,8 +249,16 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
! coefficients for the uncentred gradient
! computation near the ground
+!$acc declare create(ZFLX,ZFLXC,ZCOEFF)
!
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE, &
+!$acc & ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -244,22 +271,34 @@ IKU = SIZE(PTHLM,3)
!
! compute the coefficients for the uncentred gradient computation near the
! ground
+!$acc kernels
ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!$acc end kernels
!
!* 2. < U' THETA'l >
! --------------
!
!
+#ifndef _OPENACC
ZFLX(:,:,:) = -XCSHF * MXM( PK ) * GX_M_U(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+#else
+CALL MXM_DEVICE( PK, ZTMP1_DEVICE )
+CALL GX_M_U_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ZFLX(:,:,:) = -XCSHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!$acc end kernels
+#endif
!
! Compute the flux at the first inner U-point with an uncentred vertical
! gradient
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = -XCSHF * MXM( PK(:,:,IKB:IKB) ) * &
( DXM(PTHLM(:,:,IKB:IKB)) * PINV_PDXX(:,:,IKB:IKB) &
-MXM( ZCOEFF(:,:,IKB+2:IKB+2)*PTHLM(:,:,IKB+2:IKB+2) &
@@ -267,14 +306,41 @@ ZFLX(:,:,IKB:IKB) = -XCSHF * MXM( PK(:,:,IKB:IKB) ) * &
+ZCOEFF(:,:,IKB :IKB )*PTHLM(:,:,IKB :IKB )) &
*0.5* ( PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB)) &
* PINV_PDXX(:,:,IKB:IKB) )
+#else
+CALL MXM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+CALL DXM_DEVICE( PTHLM(:,:,IKB:IKB), ZTMP2_DEVICE(:,:,1:1) )
+!$acc kernels
+ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB )
+!$acc end kernels
+CALL MXM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ZFLX(:,:,IKB) = -XCSHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB) - ZTMP4_DEVICE(:,:,1) &
+ *0.5* ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB)) &
+ * PINV_PDXX(:,:,IKB) )
+!$acc end kernels
+#endif
! extrapolates the flux under the ground so that the vertical average with
! the IKB flux gives the ground value ( warning the tangential surface
! flux has been set to 0 for the moment !! to be improved )
+#ifndef _OPENACC
ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( SPREAD( PSFTHM(:,:)* PDIRCOSXW(:,:), 3,1) ) &
- ZFLX(:,:,IKB:IKB)
+#else
+!$acc kernels
+ ZTMP1_DEVICE(:,:,1) = PSFTHM(:,:)* PDIRCOSXW(:,:)
+!$acc end kernels
+ CALL MXM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
+!$acc end kernels
+#endif
!
! Add this source to the Theta_l sources
!
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRTHLS(:,:,:) = PRTHLS &
- DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX ) &
@@ -282,9 +348,43 @@ IF (.NOT. LFLAT) THEN
ELSE
PRTHLS(:,:,:) = PRTHLS - DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX )
END IF
+#else
+IF (.NOT. LFLAT) THEN
+ CALL MXM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+!$acc end kernels
+ CALL DXF_DEVICE(ZTMP2_DEVICE, ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZFLX * PINV_PDXX
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = PDZX*ZTMP4_DEVICE
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE, ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = PMZM_PRHODJ * ZTMP4_DEVICE * PINV_PDZZ
+!$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP4_DEVICE )
+!$acc kernels
+ PRTHLS(:,:,:) = PRTHLS - ZTMP3_DEVICE + ZTMP4_DEVICE
+!$acc end kernels
+ELSE
+ CALL MXM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+!$acc end kernels
+ CALL DXF_DEVICE(ZTMP2_DEVICE, ZTMP3_DEVICE)
+!$acc kernels
+ PRTHLS(:,:,:) = PRTHLS - ZTMP3_DEVICE
+!$acc end kernels
+END IF
+#endif
!
! Compute the equivalent tendancy for Rc and Ri
!
+#ifndef _OPENACC
IF ( KRRL >= 1 ) THEN
IF (.NOT. LFLAT) THEN
ZFLXC = 2.*( MXF( MXM( PRHODJ*PATHETA*PSRCM )*ZFLX ) &
@@ -322,12 +422,107 @@ IF ( KRRL >= 1 ) THEN
END IF
END IF
END IF
+#else
+IF ( KRRL >= 1 ) THEN
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP4_DEVICE )
+ CALL MXM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE *ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = PDZX*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP6_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1, ZTMP6_DEVICE,ZTMP7_DEVICE )
+ !$acc kernels
+ ZFLXC = 2.*( ZTMP2_DEVICE +ZTMP7_DEVICE )
+ !$acc end kernels
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP6_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE*PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP4_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP2_DEVICE + ZTMP4_DEVICE )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * (- ZTMP2_DEVICE + ZTMP4_DEVICE )*PFRAC_ICE(:,:,:)
+!$acc end kernels
+ ELSE
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE *ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP6_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE*PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP4_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP2_DEVICE + ZTMP4_DEVICE )
+!$acc end kernels
+ END IF
+ ELSE
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP1_DEVICE,ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZFLXC = 2.*ZTMP4_DEVICE
+ !$acc end kernels
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * ZTMP2_DEVICE*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+END IF
+#endif
!
!! stores this flux in ZWORK to compute later <U' VPT'>
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <U THl>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLX)
YRECFM ='UTHL_FLX'
YCOMMENT='X_Y_Z_UTHL_FLX (KELVIN*M/S) '
IGRID = 2
@@ -337,6 +532,7 @@ END IF
!
IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(ZFLX), X_LES_SUBGRID_UThl )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)*MZM(1,IKU,1,ZFLX))),&
X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
@@ -346,6 +542,38 @@ IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL LES_MEAN_SUBGRID( GX_M_M(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)*MXF(ZFLX), &
X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
END IF
+#else
+!$acc data copy(X_LES_SUBGRID_UThl,X_LES_RES_ddxa_W_SBG_UaThl, &
+!$acc & X_LES_RES_ddxa_Thl_SBG_UaThl,X_LES_RES_ddxa_Rt_SBG_UaThl)
+ !
+ CALL MXF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_UThl )
+ !
+ CALL GX_W_UW_DEVICE(1,IKU,1,PWM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE,X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ !
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE,X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ !
+ IF (KRR>=1) THEN
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE,X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+ END IF
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -354,6 +582,7 @@ END IF
! -----------
IF (KRR/=0) THEN
!
+#ifndef _OPENACC
ZFLX(:,:,:) = -XCHF * MXM( PK ) * GX_M_U(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
!
@@ -454,6 +683,212 @@ IF (KRR/=0) THEN
END IF
!
END IF
+#else
+ CALL MXM_DEVICE( PK, ZTMP1_DEVICE )
+ CALL GX_M_U_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = -XCHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+!$acc end kernels
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ CALL MXM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DXM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP2_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1)
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP3_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ ZFLX(:,:,IKB) = -XCHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB) &
+ -ZTMP4_DEVICE(:,:,1) &
+ *0.5* ( PDZX(:,:,IKB+1)+PDZX(:,:,IKB)) &
+ * PINV_PDXX(:,:,IKB) )
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ ZTMP1_DEVICE(:,:,1) = PSFRM(:,:)* PDIRCOSXW(:,:)
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+ !$acc kernels
+ ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
+ !$acc end kernels
+
+ !
+ ! Add this source to the conservative mixing ratio sources
+ !
+ IF (.NOT. LFLAT) THEN
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX * PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PDZX*ZTMP4_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PMZM_PRHODJ * ZTMP4_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP2_DEVICE, ZTMP4_DEVICE)
+ !$acc kernels
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - ZTMP3_DEVICE + ZTMP4_DEVICE
+ !$acc end kernels
+ ELSE
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - ZTMP3_DEVICE
+ !$acc end kernels
+ END IF
+ !
+ ! Compute the equivalent tendancy for Rc and Ri
+ !
+ IF ( KRRL >= 1 ) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PAMOIST*PSRCM
+ ZTMP2_DEVICE = ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP1_DEVICE, ZTMP8_DEVICE )
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP4_DEVICE = ZTMP8_DEVICE * ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP4_DEVICE, ZTMP3_DEVICE )
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP4_DEVICE )
+ CALL MZM_DEVICE( ZTMP2_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = PDZX*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP6_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1, ZTMP6_DEVICE, ZTMP7_DEVICE )
+ !$acc kernels
+ ZFLXC = ZFLXC + 2.*( ZTMP3_DEVICE + ZTMP7_DEVICE )
+ !$acc end kernels
+ !
+ !
+ !$acc kernels
+ ZTMP6_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE*PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP6_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP4_DEVICE = ZTMP8_DEVICE * ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE(ZTMP4_DEVICE, ZTMP5_DEVICE)
+ !
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP5_DEVICE+ ZTMP3_DEVICE)*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP5_DEVICE+ ZTMP3_DEVICE)*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP5_DEVICE + ZTMP3_DEVICE)
+ !$acc end kernels
+ END IF
+ ELSE
+ !$acc kernels
+ ZTMP4_DEVICE = ZTMP8_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL DXF_DEVICE(ZTMP4_DEVICE, ZTMP5_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP8_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZFLXC = ZFLXC + 2.*ZTMP4_DEVICE
+ !$acc end kernels
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP5_DEVICE*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * ZTMP5_DEVICE*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP5_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+ END IF
+ !
+ ! stores the horizontal <U Rnp>
+ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLX)
+ YRECFM ='UR_FLX'
+ YCOMMENT='X_Y_Z_UR_FLX (KG/KG * M/S) '
+ IGRID = 2
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
+ END IF
+ !
+ IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+!$acc data copy(X_LES_SUBGRID_URt,X_LES_RES_ddxa_W_SBG_UaRt, &
+!$acc & X_LES_RES_ddxa_Thl_SBG_UaRt,X_LES_RES_ddxa_Rt_SBG_UaRt)
+ !
+ CALL MXF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_URt )
+ !
+ CALL GX_W_UW_DEVICE(1,IKU,1,PWM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP4_DEVICE,ZTMP3_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ !
+ CALL GX_M_M_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ !
+ CALL GX_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ !
+!$acc end data
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ !
+ IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+ !$acc data copy(X_LES_SUBGRID_URc)
+ !
+ CALL MXF_DEVICE(ZFLXC,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE, X_LES_SUBGRID_URc )
+ !
+ !$acc end data
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+END IF
+#endif
!
!* 4. < U' TPV' >
! -----------
@@ -484,6 +919,7 @@ END IF
!
!
IF (.NOT. L2D) THEN
+#ifndef _OPENACC
ZFLX(:,:,:) = -XCSHF * MYM( PK ) * GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)
ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
ELSE
@@ -585,11 +1021,228 @@ IF (KSPLT==1 .AND. LLES_CALL) THEN
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
+#else
+ CALL MYM_DEVICE( PK, ZTMP1_DEVICE )
+ CALL GY_M_V_DEVICE(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+ !$acc kernels
+ ZFLX(:,:,:) = -XCSHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+ !$acc end kernels
+ELSE
+ !$acc kernels
+ ZFLX(:,:,:) = 0.
+ !$acc end kernels
+END IF
+!
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+CALL MYM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+CALL DYM_DEVICE(PTHLM(:,:,IKB:IKB), ZTMP2_DEVICE(:,:,1:1) )
+!$acc kernels
+ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PTHLM(:,:,IKB+2) &
+ +ZCOEFF(:,:,IKB+1)*PTHLM(:,:,IKB+1) &
+ +ZCOEFF(:,:,IKB )*PTHLM(:,:,IKB )
+!$acc end kernels
+CALL MYM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+!$acc kernels
+ZFLX(:,:,IKB) = -XCSHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB) &
+ - ZTMP4_DEVICE(:,:,1) &
+ *0.5* ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB)) &
+ * PINV_PDYY(:,:,IKB) )
+!$acc end kernels
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+!$acc kernels
+ZTMP1_DEVICE(:,:,1) = PSFTHM(:,:)* PDIRCOSYW(:,:)
+!$acc end kernels
+CALL MYM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
+!$acc kernels
+ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
+!$acc end kernels
+!
+! Add this source to the Theta_l sources
+!
+IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = PDZY*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = PMZM_PRHODJ * ZTMP2_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ PRTHLS(:,:,:) = PRTHLS - ZTMP3_DEVICE + ZTMP2_DEVICE
+ !$acc end kernels
+ ELSE
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ PRTHLS(:,:,:) = PRTHLS - ZTMP3_DEVICE
+ !$acc end kernels
+ END IF
+END IF
+!
+! Compute the equivalent tendancy for Rc and Ri
+!
+!IF ( OSUBG_COND .AND. KRRL > 0 .AND. .NOT. L2D) THEN
+IF ( KRRL >= 1 .AND. .NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP4_DEVICE = ZTMP2_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP4_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP4_DEVICE = ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE( ZTMP4_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP4_DEVICE = PDZY*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP4_DEVICE, ZTMP5_DEVICE)
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP6_DEVICE = ZTMP4_DEVICE*ZTMP5_DEVICE
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1, ZTMP6_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZFLXC = 2.*( ZTMP3_DEVICE + ZTMP4_DEVICE )
+ !$acc end kernels
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP6_DEVICE*PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP4_DEVICE + ZTMP5_DEVICE )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * (- ZTMP4_DEVICE + ZTMP5_DEVICE )*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP6_DEVICE*PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP4_DEVICE + ZTMP5_DEVICE )
+ !$acc end kernels
+ END IF
+ ELSE
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*PSRCM
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP1_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZFLXC = 2.*ZTMP3_DEVICE
+ !$acc end kernels
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * ZTMP2_DEVICE*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+END IF
+!! stores this flux in ZWORK to compute later <V' VPT'>
+!!ZWORK(:,:,:) = ZFLX(:,:,:)
+!
+! stores the horizontal <V THl>
+IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLX)
+ YRECFM ='VTHL_FLX'
+ YCOMMENT='X_Y_Z_VTHL_FLX (KELVIN*M/S) '
+ IGRID = 3
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
+END IF
+!
+IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+!$acc data copy(X_LES_SUBGRID_VThl,X_LES_RES_ddxa_W_SBG_UaThl,X_LES_RES_ddxa_Thl_SBG_UaThl)
+ !
+ CALL MYF_DEVICE(ZFLX, ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_VThl )
+ !
+ CALL GY_W_VW_DEVICE(1,IKU,1,PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE, ZTMP4_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP4_DEVICE, ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_W_SBG_UaThl , .TRUE. )
+ !
+ CALL GY_M_M_DEVICE(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaThl , .TRUE. )
+ !
+!$acc end data
+ !
+ IF (KRR>=1) THEN
+!$acc data copy(X_LES_RES_ddxa_Rt_SBG_UaThl)
+ CALL GY_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE,X_LES_RES_ddxa_Rt_SBG_UaThl , .TRUE. )
+!$acc end data
+ END IF
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+#endif
!
!
!* 6. < V' R'np >
! -----------
!
+#ifndef _OPENACC
IF (KRR/=0) THEN
!
IF (.NOT. L2D) THEN
@@ -699,6 +1352,229 @@ IF (KRR/=0) THEN
END IF
!
END IF
+#else
+IF (KRR/=0) THEN
+ !
+ IF (.NOT. L2D) THEN
+ CALL MYM_DEVICE( PK, ZTMP1_DEVICE )
+ CALL GY_M_V_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY, ZTMP2_DEVICE)
+ !$acc kernels
+ ZFLX(:,:,:) = -XCHF * ZTMP1_DEVICE * ZTMP2_DEVICE
+ ZFLX(:,:,IKE+1) = ZFLX(:,:,IKE)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ ZFLX(:,:,:) = 0.
+ !$acc end kernels
+ END IF
+!
+! Compute the flux at the first inner U-point with an uncentred vertical
+! gradient
+ CALL MYM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DYM_DEVICE(PRM(:,:,IKB:IKB,1), ZTMP2_DEVICE(:,:,1:1))
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZCOEFF(:,:,IKB+2)*PRM(:,:,IKB+2,1) &
+ +ZCOEFF(:,:,IKB+1)*PRM(:,:,IKB+1,1) &
+ +ZCOEFF(:,:,IKB )*PRM(:,:,IKB ,1)
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZFLX(:,:,IKB) = -XCHF * ZTMP1_DEVICE(:,:,1) * &
+ ( ZTMP2_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB) &
+ - ZTMP4_DEVICE(:,:,1) &
+ *0.5* ( PDZY(:,:,IKB+1)+PDZY(:,:,IKB)) &
+ * PINV_PDYY(:,:,IKB) )
+ !$acc end kernels
+! extrapolates the flux under the ground so that the vertical average with
+! the IKB flux gives the ground value ( warning the tangential surface
+! flux has been set to 0 for the moment !! to be improved )
+ !$acc kernels
+ ZTMP1_DEVICE(:,:,1) = PSFRM(:,:)* PDIRCOSYW(:,:)
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
+ !$acc end kernels
+ !
+ ! Add this source to the conservative mixing ratio sources
+ !
+ IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = PDZY*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = PMZM_PRHODJ * ZTMP2_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE )
+ !
+ !$acc kernels
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - ZTMP3_DEVICE + ZTMP2_DEVICE
+ !$acc end kernels
+ ELSE
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) - ZTMP3_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+ !
+ ! Compute the equivalent tendancy for Rc and Ri
+ !
+ IF ( KRRL >= 1 .AND. .NOT. L2D) THEN ! Sub-grid condensation
+ IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PAMOIST*PSRCM
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = PDZY*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP5_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1, ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZFLXC = ZFLXC + 2.*( ZTMP4_DEVICE + ZTMP2_DEVICE )
+ !$acc end kernels
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP3_DEVICE/PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE* PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP2_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP3_DEVICE + ZTMP4_DEVICE )*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) + 2. * (- ZTMP3_DEVICE + ZTMP4_DEVICE )*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) + 2. * (- ZTMP3_DEVICE + ZTMP4_DEVICE )
+ !$acc end kernels
+ END IF
+ ELSE
+ !$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PAMOIST*PSRCM
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZFLXC = ZFLXC + 2.*ZTMP4_DEVICE
+ !$acc end kernels
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP3_DEVICE/PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP1_DEVICE, ZTMP2_DEVICE )
+ IF ( KRRI >= 1 ) THEN
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE*(1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - 2. * ZTMP2_DEVICE*PFRAC_ICE(:,:,:)
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - 2. * ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+ END IF
+ !
+ ! stores the horizontal <V Rnp>
+ IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ !$acc update self(ZFLX)
+ YRECFM ='VR_FLX'
+ YCOMMENT='X_Y_Z_VR_FLX (KG/KG * M/S) '
+ IGRID = 3
+ ILENCH=LEN(YCOMMENT)
+ CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
+ END IF
+ !
+ IF (KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+!$acc data copy(X_LES_SUBGRID_VRt,X_LES_RES_ddxa_W_SBG_UaRt, &
+!$acc & X_LES_RES_ddxa_Thl_SBG_UaRt,X_LES_RES_ddxa_Rt_SBG_UaRt)
+ !
+ CALL MYF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_VRt )
+ !
+ CALL GY_W_VW_DEVICE(1,IKU,1,PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE, ZTMP4_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP4_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE,X_LES_RES_ddxa_W_SBG_UaRt , .TRUE. )
+ !
+ CALL GY_M_M_DEVICE(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaRt , .TRUE. )
+ !
+ CALL GY_M_M_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MYF_DEVICE(ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaRt , .TRUE. )
+ !
+!$acc end data
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+!
+ !
+ IF (KRRL>0 .AND. KSPLT==1 .AND. LLES_CALL) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+!$acc data copy(X_LES_SUBGRID_VRc)
+ !
+ CALL MYF_DEVICE(ZFLXC,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE, X_LES_SUBGRID_VRc )
+ !
+!$acc end data
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+ !
+END IF
+#endif
!
!* 7. < V' TPV' >
! -----------
diff --git a/src/MNH/turb_hor_tke.f90 b/src/MNH/turb_hor_tke.f90
index 24ad7f953b77d50852f4e9d0b3a0e0414d0c89a0..736392149ac18e1e534d0d5ee41a40241f60ed99 100644
--- a/src/MNH/turb_hor_tke.f90
+++ b/src/MNH/turb_hor_tke.f90
@@ -37,7 +37,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+!$acc & PK, PRHODJ, PTKEM, &
+!$acc & PTRH )
!
END SUBROUTINE TURB_HOR_TKE
!
@@ -82,6 +85,7 @@ END MODULE MODI_TURB_HOR_TKE
!! Original Aug 29, 1994
!! Mar 07 2001 (V. Masson and J. Stein) new routine
!! Nov 06, 2002 (V. Masson) LES budgets
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -94,7 +98,11 @@ USE MODD_PARAMETERS
USE MODD_LES
!
!
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_GRADIENT_M
USE MODI_LES_MEAN_SUBGRID
!
@@ -122,7 +130,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PTRH ! horizontal transport of Tke
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PINV_PDXX, PINV_PDYY, PINV_PDZZ, PMZM_PRHODJ, &
+!$acc & PK, PRHODJ, PTKEM, &
+!$acc & PTRH )
!
!* 0.2 declaration of local variables
!
@@ -134,7 +145,14 @@ REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1+JPVEXT:3+JPVEXT) :: ZCOEFF
!
REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)):: ZFLX
!
+!$acc declare create(ZCOEFF,ZFLX)
+!
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTKEM,1),SIZE(PTKEM,2),SIZE(PTKEM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -146,12 +164,14 @@ IKU = SIZE(PTKEM,3)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
+!$acc kernels
ZCOEFF(:,:,IKB+2)= - PDZZ(:,:,IKB+1) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB+1)= (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) / &
( PDZZ(:,:,IKB+1) * PDZZ(:,:,IKB+2) )
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
( (PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) * PDZZ(:,:,IKB+1) )
+!$acc end kernels
!
!--------------------------------------------------------------------
!
@@ -159,19 +179,39 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
! -------------------------------
!
!
+#ifndef _OPENACC
ZFLX = -XCET * MXM(PK) * GX_M_U(1,IKU,1,PTKEM,PDXX,PDZZ,PDZX) ! < u'e >
+#else
+CALL MXM_DEVICE(PK,ZTMP1_DEVICE)
+CALL GX_M_U_DEVICE(1,IKU,1,PTKEM,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+!$acc kernels
+ZFLX = -XCET * ZTMP1_DEVICE * ZTMP2_DEVICE ! < u'e >
+#endif
!
! special case near the ground ( uncentred gradient )
!
ZFLX(:,:,IKB) = ZCOEFF(:,:,IKB+2)*PTKEM(:,:,IKB+2) &
+ ZCOEFF(:,:,IKB+1)*PTKEM(:,:,IKB+1) &
+ ZCOEFF(:,:,IKB )*PTKEM(:,:,IKB )
+!$acc end kernels
!
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = &
- XCET * MXM( PK(:,:,IKB:IKB) ) * ( &
DXM ( PTKEM(:,:,IKB:IKB) ) * PINV_PDXX(:,:,IKB:IKB) &
-MXM ( ZFLX (:,:,IKB:IKB) ) * PINV_PDXX(:,:,IKB:IKB) &
* 0.5 * ( PDZX(:,:,IKB+1:IKB+1) + PDZX(:,:,IKB:IKB) ) )
+#else
+CALL MXM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+CALL DXM_DEVICE( PTKEM(:,:,IKB:IKB), ZTMP2_DEVICE(:,:,1:1) )
+CALL MXM_DEVICE( ZFLX (:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1) )
+!$acc kernels
+ZFLX(:,:,IKB) = &
+ - XCET * ZTMP1_DEVICE(:,:,1) * ( &
+ ZTMP2_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB) &
+ - ZTMP3_DEVICE(:,:,1) * PINV_PDXX(:,:,IKB) &
+ * 0.5 * ( PDZX(:,:,IKB+1) + PDZX(:,:,IKB) ) )
+#endif
!
! extrapolate the fluxes to obtain < u'e > = 0 at the ground
!
@@ -180,7 +220,9 @@ ZFLX(:,:,IKB-1) = - ZFLX(:,:,IKB)
! let the same flux at IKU-1 and IKU level
!
ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
+!$acc end kernels
!
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PTRH =-( DXF( MXM(PRHODJ) * ZFLX * PINV_PDXX)&
- DZF(1,IKU,1, PMZM_PRHODJ * MXF( PDZX * MZM(1,IKU,1,ZFLX*PINV_PDXX)) * PINV_PDZZ)&
@@ -196,6 +238,53 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
+#else
+IF (.NOT. LFLAT) THEN
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX*PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PDZX * ZTMP3_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PMZM_PRHODJ * ZTMP3_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ PTRH =-( ZTMP1_DEVICE - ZTMP3_DEVICE ) /PRHODJ
+ !$acc end kernels
+ELSE
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDXX
+ !$acc end kernels
+ CALL DXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels
+ PTRH =-( ZTMP1_DEVICE ) /PRHODJ
+ !$acc end kernels
+END IF
+!
+IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+!$acc data copy(X_LES_SUBGRID_UTke)
+ !
+ CALL MXF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_UTke )
+ !
+!$acc end data
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+END IF
+#endif
!
!
!--------------------------------------------------------------------
@@ -204,19 +293,39 @@ END IF
! -------------------------------
!
IF (.NOT. L2D) THEN
+#ifndef _OPENACC
ZFLX =-XCET * MYM(PK) * GY_M_V(1,IKU,1,PTKEM,PDYY,PDZZ,PDZY) ! < v'e >
+#else
+ CALL MYM_DEVICE(PK,ZTMP1_DEVICE)
+ CALL GY_M_V_DEVICE(1,IKU,1,PTKEM,PDYY,PDZZ,PDZY,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX =-XCET * ZTMP1_DEVICE * ZTMP2_DEVICE ! < v'e >
+#endif
!
! special case near the ground ( uncentred gradient )
!
ZFLX(:,:,IKB) = ZCOEFF(:,:,IKB+2)*PTKEM(:,:,IKB+2) &
+ ZCOEFF(:,:,IKB+1)*PTKEM(:,:,IKB+1) &
+ ZCOEFF(:,:,IKB )*PTKEM(:,:,IKB )
+!$acc end kernels
!
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = &
- XCET * MYM( PK(:,:,IKB:IKB) ) * ( &
DYM ( PTKEM(:,:,IKB:IKB) ) * PINV_PDYY(:,:,IKB:IKB) &
- MYM ( ZFLX (:,:,IKB:IKB) ) * PINV_PDYY(:,:,IKB:IKB) &
* 0.5 * ( PDZY(:,:,IKB+1:IKB+1) + PDZY(:,:,IKB:IKB) ) )
+#else
+ CALL MYM_DEVICE( PK(:,:,IKB:IKB), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DYM_DEVICE( PTKEM(:,:,IKB:IKB), ZTMP2_DEVICE(:,:,1:1) )
+ CALL MYM_DEVICE( ZFLX (:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZFLX(:,:,IKB) = &
+ - XCET * ZTMP1_DEVICE(:,:,1) * ( &
+ ZTMP2_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB) &
+ - ZTMP3_DEVICE(:,:,1) * PINV_PDYY(:,:,IKB) &
+ * 0.5 * ( PDZY(:,:,IKB+1) + PDZY(:,:,IKB) ) )
+#endif
!
! extrapolate the fluxes to obtain < v'e > = 0 at the ground
!
@@ -225,9 +334,11 @@ IF (.NOT. L2D) THEN
! let the same flux at IKU-1 and IKU level
!
ZFLX(:,:,IKU) = ZFLX(:,:,IKU-1)
+!$acc end kernels
!
! complete the explicit turbulent transport
!
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PTRH = PTRH - ( DYF( MYM(PRHODJ) * ZFLX * PINV_PDYY ) &
- DZF(1,IKU,1, PMZM_PRHODJ * MYF( PDZY * MZM(1,IKU,1,ZFLX*PINV_PDYY) ) * PINV_PDZZ ) &
@@ -243,6 +354,55 @@ IF (.NOT. L2D) THEN
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
+#else
+ IF (.NOT. LFLAT) THEN
+ CALL MYM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX*PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PDZY * ZTMP3_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PMZM_PRHODJ * ZTMP3_DEVICE * PINV_PDZZ
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ PTRH = PTRH - ( ZTMP1_DEVICE - ZTMP3_DEVICE ) /PRHODJ
+ !$acc end kernels
+ ELSE
+ CALL MYM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX * PINV_PDYY
+ !$acc end kernels
+ CALL DYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels
+ PTRH = PTRH - ( ZTMP1_DEVICE ) /PRHODJ
+ !$acc end kernels
+ END IF
+!
+ IF (LLES_CALL .AND. KSPLT==1) THEN
+ CALL SECOND_MNH(ZTIME1)
+ !
+ !$acc data create(X_LES_SUBGRID_VTke)
+ !$acc update device(X_LES_SUBGRID_VTke)
+ !
+ CALL MYF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_VTke )
+ !
+ !$acc update self(X_LES_SUBGRID_VTke)
+ !$acc end data !create(X_LES_SUBGRID_VTke)
+ !
+ CALL SECOND_MNH(ZTIME2)
+ XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
+ END IF
+#endif
!
END IF
!
diff --git a/src/MNH/turb_hor_uv.f90 b/src/MNH/turb_hor_uv.f90
index ead7858438727adf94a105695ed9ab948d845506..bb83050657fd1a4e6e391044ea4063ba1a0139ba 100644
--- a/src/MNH/turb_hor_uv.f90
+++ b/src/MNH/turb_hor_uv.f90
@@ -73,6 +73,10 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSZW,PCOSSLOPE,PSINSLOPE,PRHODJ,PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PUSLOPEM,PVSLOPEM, &
+!$acc & PRUS,PRVS,PDP)
!
END SUBROUTINE TURB_HOR_UV
!
@@ -126,6 +130,7 @@ END MODULE MODI_TURB_HOR_UV
!! Nov 27, 1997 (V. Masson) clearing of the routine
!! Oct 18, 2000 (V. Masson) LES computations + LFLAT switch
!! Nov 06, 2002 (V. Masson) LES budgets
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -144,7 +149,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_COEFJ
USE MODI_LES_MEAN_SUBGRID
!
@@ -202,6 +211,10 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PVSLOPEM ! wind component along
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! var. at t+1 -split-
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
!
+!$acc declare present(PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
+!$acc & PDIRCOSZW,PCOSSLOPE,PSINSLOPE,PRHODJ,PCDUEFF,PTAU11M,PTAU12M,PTAU22M,PTAU33M, &
+!$acc & PUM,PVM,PUSLOPEM,PVSLOPEM, &
+!$acc & PRUS,PRVS,PDP)
!
!
!* 0.2 declaration of local variables
@@ -223,8 +236,21 @@ CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: GY_U_UV_PUM
REAL, DIMENSION(SIZE(PVM,1),SIZE(PVM,2),SIZE(PVM,3)) :: GX_V_UV_PVM
+!$acc declare create(ZFLX,ZWORK,ZDIRSINZW,GY_U_UV_PUM,GX_V_UV_PVM)
!
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP1_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP2_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP3_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP4_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP5_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP6_DEVICE
+REAL, DIMENSION(SIZE(PUM,1),SIZE(PUM,2),SIZE(PUM,3)) :: ZTMP7_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE, &
+!$acc & ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -237,29 +263,55 @@ IKU = SIZE(PUM,3)
!
ILENCH=LEN(YCOMMENT)
!
+!$acc kernels
ZDIRSINZW(:,:) = SQRT( 1. - PDIRCOSZW(:,:)**2 )
+!$acc end kernels
!
+#ifndef _OPENACC
GX_V_UV_PVM = GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)
-IF (.NOT. L2D) GY_U_UV_PUM = GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)
+IF (.NOT. L2D) THEN
+ GY_U_UV_PUM = GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)
+END IF
+#else
+CALL GX_V_UV_DEVICE(1,IKU,1,PVM,PDXX,PDZZ,PDZX,GX_V_UV_PVM)
+IF (.NOT. L2D) THEN
+ CALL GY_U_UV_DEVICE(1,IKU,1,PUM,PDYY,PDZZ,PDZY,GY_U_UV_PUM)
+END IF
+#endif
!
!
!* 12. < U'V'>
! -------
!
!
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
- ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * &
- (GY_U_UV_PUM + GX_V_UV_PVM)
+ ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * (GY_U_UV_PUM + GX_V_UV_PVM)
ELSE
- ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * &
- (GX_V_UV_PVM)
+ ZFLX(:,:,:)= - XCMFS * MYM(MXM(PK)) * (GX_V_UV_PVM)
END IF
+#else
+CALL MXM_DEVICE(PK,ZTMP1_DEVICE)
+CALL MYM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+IF (.NOT. L2D) THEN
+ !$acc kernels
+ ZFLX(:,:,:)= - XCMFS * ZTMP2_DEVICE * (GY_U_UV_PUM + GX_V_UV_PVM)
+ !$acc end kernels
+ELSE
+ !$acc kernels
+ ZFLX(:,:,:)= - XCMFS * ZTMP2_DEVICE * (GX_V_UV_PVM)
+ !$acc end kernels
+END IF
+#endif
!
+!$acc kernels
ZFLX(:,:,IKE+1)= ZFLX(:,:,IKE)
+!$acc end kernels
!
!
! Compute the correlation at the first physical level with the following
! hypothesis du/dz vary in 1/z and w=0 at the ground
+#ifndef _OPENACC
ZFLX(:,:,IKB:IKB) = - XCMFS * MYM(MXM(PK(:,:,IKB:IKB))) * ( &
( DYM( PUM(:,:,IKB:IKB) ) &
-MYM( (PUM(:,:,IKB+1:IKB+1)-PUM(:,:,IKB:IKB)) &
@@ -270,9 +322,60 @@ ZFLX(:,:,IKB:IKB) = - XCMFS * MYM(MXM(PK(:,:,IKB:IKB))) * ( &
-MXM( (PVM(:,:,IKB+1:IKB+1)-PVM(:,:,IKB:IKB)) &
*(1./MYM(PDZZ(:,:,IKB+1:IKB+1))+1./MYM(PDZZ(:,:,IKB:IKB))))&
*0.5*MYM((PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB))) &
- ) / MYM(PDXX(:,:,IKB:IKB)) )
+ ) / MYM(PDXX(:,:,IKB:IKB)) )
+#else
+CALL DYM_DEVICE(PUM(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1))
+!
+CALL MXM_DEVICE(PDZZ(:,:,IKB+1:IKB+1),ZTMP2_DEVICE(:,:,1:1))
+CALL MXM_DEVICE(PDZZ(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,1:1))
+!
+!$acc kernels
+ZTMP5_DEVICE(:,:,1) = (PUM(:,:,IKB+1)-PUM(:,:,IKB))*(1./ZTMP2_DEVICE(:,:,1)+1./ZTMP3_DEVICE(:,:,1))
+!$acc end kernels
+CALL MYM_DEVICE(ZTMP5_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+!
+!$acc kernels
+ZTMP5_DEVICE(:,:,1) = PDZY(:,:,IKB+1) + PDZY(:,:,IKB)
+!$acc end kernels
+CALL MXM_DEVICE(ZTMP5_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+!
+CALL MXM_DEVICE(PDYY(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ZTMP5_DEVICE(:,:,1) = ( ZTMP1_DEVICE(:,:,1) - ZTMP4_DEVICE(:,:,1)*0.5*ZTMP2_DEVICE(:,:,1) ) &
+ / ZTMP3_DEVICE(:,:,1)
+!$acc end kernels
+!
+!
+CALL DXM_DEVICE(PVM(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1))
+!
+CALL MYM_DEVICE(PDZZ(:,:,IKB:IKB),ZTMP2_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(PDZZ(:,:,IKB+1:IKB+1),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ZTMP6_DEVICE(:,:,1) = (PVM(:,:,IKB+1)-PVM(:,:,IKB))*(1./ZTMP3_DEVICE(:,:,1)+1./ZTMP2_DEVICE(:,:,1))
+!$acc end kernels
+CALL MXM_DEVICE(ZTMP6_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+!
+!$acc kernels
+ZTMP6_DEVICE(:,:,1:1) = (PDZX(:,:,IKB+1:IKB+1)+PDZX(:,:,IKB:IKB))
+!$acc end kernels
+CALL MYM_DEVICE(ZTMP6_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+!
+CALL MYM_DEVICE(PDXX(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ZTMP6_DEVICE(:,:,1) = ( ZTMP1_DEVICE(:,:,1) - ZTMP4_DEVICE(:,:,1)*0.5*ZTMP2_DEVICE(:,:,1) ) &
+ / ZTMP3_DEVICE(:,:,1)
+!$acc end kernels
+!
+CALL MXM_DEVICE(PK(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+!
+!$acc kernels
+ZFLX(:,:,IKB) = - XCMFS * ZTMP2_DEVICE(:,:,1) * ( ZTMP5_DEVICE(:,:,1) + ZTMP6_DEVICE(:,:,1) )
+!$acc end kernels
+#endif
!
! extrapolates this flux under the ground with the surface flux
+!$acc kernels
ZFLX(:,:,IKB-1) = &
PTAU11M(:,:) * PCOSSLOPE(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:)**2 &
+PTAU12M(:,:) * (PCOSSLOPE(:,:)**2 - PSINSLOPE(:,:)**2) * &
@@ -284,21 +387,32 @@ ZFLX(:,:,IKB-1) = &
PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+PVSLOPEM(:,:) * (PCOSSLOPE(:,:)**2 - PSINSLOPE(:,:)**2) * ZDIRSINZW(:,:) &
)
+!$acc end kernels
!
+#ifndef _OPENACC
ZFLX(:,:,IKB-1:IKB-1) = 2. * MXM( MYM( ZFLX(:,:,IKB-1:IKB-1) ) ) &
- ZFLX(:,:,IKB:IKB)
+#else
+CALL MYM_DEVICE(ZFLX(:,:,IKB-1:IKB-1),ZTMP1_DEVICE(:,:,1:1))
+CALL MXM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+!$acc kernels
+ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
+!$acc end kernels
+#endif
!
! stores <U V>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
YRECFM ='UV_FLX'
YCOMMENT='X_Y_Z_UV_FLX ( (M/S) **2 ) '
IGRID = 5
+!$acc update self(ZFLX)
CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZFLX,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
!
!
!computation of the source for rho*V due to this flux
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRUS(:,:,:) = PRUS(:,:,:) &
- DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) ) &
@@ -307,8 +421,47 @@ IF (.NOT. LFLAT) THEN
ELSE
PRUS(:,:,:) = PRUS(:,:,:) - DYF(ZFLX * MXM(MYM(PRHODJ) * PINV_PDYY) )
END IF
+#else
+CALL MYM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZTMP1_DEVICE * PINV_PDYY
+!$acc end kernels
+CALL MXM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZFLX * ZTMP1_DEVICE
+!$acc end kernels
+CALL DYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+IF (.NOT. LFLAT) THEN
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ CALL MZM_DEVICE(PDYY,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = PDZY/ZTMP3_DEVICE
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP4_DEVICE,ZTMP5_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = ZTMP2_DEVICE*ZTMP5_DEVICE
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP4_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = PMZM_PRHODJ * PINV_PDZZ
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP5_DEVICE = ZTMP2_DEVICE*ZTMP4_DEVICE
+!$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP5_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ PRUS(:,:,:) = PRUS(:,:,:) - ZTMP1_DEVICE + ZTMP3_DEVICE
+!$acc end kernels
+ELSE
+!$acc kernels
+ PRUS(:,:,:) = PRUS(:,:,:) - ZTMP1_DEVICE
+!$acc end kernels
+END IF
+#endif
!
!computation of the source for rho*V due to this flux
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRVS(:,:,:) = PRVS(:,:,:) &
- DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) ) &
@@ -317,11 +470,50 @@ IF (.NOT. LFLAT) THEN
ELSE
PRVS(:,:,:) = PRVS(:,:,:) - DXF(ZFLX * MYM(MXM(PRHODJ) * PINV_PDXX) )
END IF
+#else
+CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZTMP1_DEVICE * PINV_PDXX
+!$acc end kernels
+CALL MYM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZFLX * ZTMP1_DEVICE
+!$acc end kernels
+CALL DXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+IF (.NOT. LFLAT) THEN
+ CALL MZM_DEVICE(ZFLX,ZTMP2_DEVICE)
+ CALL MZM_DEVICE(PDXX,ZTMP3_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = PDZX/ZTMP3_DEVICE
+!$acc end kernels
+ CALL MYM_DEVICE(ZTMP4_DEVICE,ZTMP5_DEVICE)
+!$acc kernels
+ ZTMP4_DEVICE = ZTMP2_DEVICE*ZTMP5_DEVICE
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP4_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = PMZM_PRHODJ * PINV_PDZZ
+!$acc end kernels
+ CALL MYM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ ZTMP5_DEVICE = ZTMP2_DEVICE*ZTMP4_DEVICE
+!$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1,ZTMP5_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ PRVS(:,:,:) = PRVS(:,:,:) - ZTMP1_DEVICE + ZTMP3_DEVICE
+!$acc end kernels
+ELSE
+!$acc kernels
+ PRVS(:,:,:) = PRVS(:,:,:) - ZTMP1_DEVICE
+!$acc end kernels
+END IF
+#endif
!
IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
ZWORK(:,:,:) = - MXF( MYF( ZFLX * &
(GY_U_UV_PUM + GX_V_UV_PVM) ) )
@@ -329,9 +521,26 @@ IF (KSPLT==1) THEN
ZWORK(:,:,:) = - MXF( MYF( ZFLX * &
(GX_V_UV_PVM) ) )
ENDIF
+#else
+ IF (.NOT. L2D) THEN
+!$acc kernels
+ ZTMP1_DEVICE = ZFLX * (GY_U_UV_PUM + GX_V_UV_PVM)
+!$acc end kernels
+ ELSE
+!$acc kernels
+ ZTMP1_DEVICE = ZFLX * GX_V_UV_PVM
+!$acc end kernels
+ ENDIF
+ CALL MYF_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+ ZWORK(:,:,:) = - ZTMP1_DEVICE
+!$acc end kernels
+#endif
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
!
+#ifndef _OPENACC
ZWORK(:,:,IKB:IKB) = - &
MXF ( MYF( 0.5 * (ZFLX(:,:,IKB+1:IKB+1)+ZFLX(:,:,IKB:IKB)) ) ) &
*(MXF ( MYF( &
@@ -347,9 +556,60 @@ IF (KSPLT==1) THEN
MYM(PDZZ(:,:,IKB+1:IKB+1)) * PDZX(:,:,IKB+1:IKB+1) &
) / MXF(MYM( 0.5*(PDXX(:,:,IKB:IKB)+PDXX(:,:,IKB+1:IKB+1)) ) )&
)
+#else
+!$acc kernels
+ ZTMP1_DEVICE(:,:,1) = 0.5 * (ZFLX(:,:,IKB+1)+ZFLX(:,:,IKB))
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+ CALL MXF_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP1_DEVICE(:,:,1:1))
+ !
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = 0.5 * (PUM(:,:,IKB+1)+PUM(:,:,IKB))
+!$acc end kernels
+ CALL DYM_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = 0.5*(PDYY(:,:,IKB)+PDYY(:,:,IKB+1))
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = 0.5 * (PVM(:,:,IKB+1)+PVM(:,:,IKB))
+!$acc end kernels
+ CALL DXM_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP5_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = 0.5*(PDXX(:,:,IKB)+PDXX(:,:,IKB+1))
+!$acc end kernels
+ CALL MYM_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP6_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZTMP3_DEVICE(:,:,1) / ZTMP4_DEVICE(:,:,1) + ZTMP5_DEVICE(:,:,1) / ZTMP6_DEVICE(:,:,1)
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+ CALL MXF_DEVICE(ZTMP3_DEVICE(:,:,1:1),ZTMP2_DEVICE(:,:,1:1))
+ !
+ CALL MXM_DEVICE(PDZZ(:,:,IKB+1:IKB+1),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP5_DEVICE(:,:,1) = (PUM(:,:,IKB+1)-PUM(:,:,IKB)) / ZTMP3_DEVICE(:,:,1) * PDZY(:,:,IKB+1)
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP5_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+ CALL MYF_DEVICE(ZTMP4_DEVICE(:,:,1:1),ZTMP5_DEVICE(:,:,1:1)) !Re-use of ZTMP4_DEVICE
+ !
+ CALL MYM_DEVICE(PDZZ(:,:,IKB+1:IKB+1),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP7_DEVICE(:,:,1) = (PVM(:,:,IKB+1)-PVM(:,:,IKB)) / ZTMP4_DEVICE(:,:,1) * PDZX(:,:,IKB+1)
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP7_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+ CALL MXF_DEVICE(ZTMP6_DEVICE(:,:,1:1),ZTMP7_DEVICE(:,:,1:1)) !Re-use of ZTMP6_DEVICE
+ !
+!$acc kernels
+ ZWORK(:,:,IKB) = - ZTMP1_DEVICE(:,:,1) * (ZTMP2_DEVICE(:,:,1) &
+ - ZTMP3_DEVICE(:,:,1) / ZTMP5_DEVICE(:,:,1) &
+ - ZTMP4_DEVICE(:,:,1) / ZTMP7_DEVICE(:,:,1) )
+!$acc end kernels
+#endif
!
! dynamic production
+ !$acc kernels
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
!
END IF
!
@@ -357,9 +617,33 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MXF(MYF(ZFLX)), X_LES_SUBGRID_UV )
CALL LES_MEAN_SUBGRID( MXF(MYF(GY_U_UV(1,IKU,1,PUM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MXF(MYF(GX_V_UV(1,IKU,1,PVM,PDXX,PDZZ,PDZX)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+#else
+!$acc data copy(X_LES_SUBGRID_UV,X_LES_RES_ddxa_U_SBG_UaU,X_LES_RES_ddxa_V_SBG_UaV)
+ CALL MYF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL MXF_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP2_DEVICE,X_LES_SUBGRID_UV)
+ !
+ CALL GY_U_UV_DEVICE(1,IKU,1,PUM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZFLX
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP2_DEVICE)
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ !
+ CALL GX_V_UV_DEVICE(1,IKU,1,PVM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZFLX
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP2_DEVICE)
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/turb_hor_uw.f90 b/src/MNH/turb_hor_uw.f90
index ef5ec34bdb80b0f37cd47232f33486146dda6a48..7b2eb036edded6c4728adafbcbfe2a0c9b8bde3e 100644
--- a/src/MNH/turb_hor_uw.f90
+++ b/src/MNH/turb_hor_uw.f90
@@ -60,8 +60,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
!
-!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ,PDXX,PDZZ,PDZX, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PUM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM, &
+!$acc & PRUS,PRWS,PDP)
!
END SUBROUTINE TURB_HOR_UW
!
@@ -118,6 +120,7 @@ END MODULE MODI_TURB_HOR_UW
!! Nov 06, 2002 (V. Masson) LES budgets
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -135,7 +138,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_COEFJ
USE MODI_LES_MEAN_SUBGRID
!
@@ -180,9 +187,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
-!
-!
-!
+!$acc declare present(PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ,PDXX,PDZZ,PDZX, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PUM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM, &
+!$acc & PRUS,PRWS,PDP)
!
!* 0.2 declaration of local variables
!
@@ -201,8 +209,17 @@ CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GX_W_UW_PWM
+!$acc declare create(ZFLX,ZWORK,GX_W_UW_PWM)
!
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP1_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP2_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP3_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -213,7 +230,11 @@ IKE = SIZE(PWM,3)-JPVEXT
IKU = SIZE(PWM,3)
!
!
+#ifndef _OPENACC
GX_W_UW_PWM = GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)
+#else
+CALL GX_W_UW_DEVICE(1,IKU,1,PWM,PDXX,PDZZ,PDZX,GX_W_UW_PWM)
+#endif
!
!
!* 13. < U'W'>
@@ -221,8 +242,15 @@ GX_W_UW_PWM = GX_W_UW(1,IKU,1,PWM,PDXX,PDZZ,PDZX)
!
! residual part of < U'W'> depending on dw/dx
!
+#ifndef _OPENACC
ZFLX(:,:,:) = &
- XCMFS * MXM(MZM(1,IKU,1,PK)) * GX_W_UW_PWM
+#else
+CALL MZM_DEVICE(PK,ZTMP1_DEVICE)
+CALL MXM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ZFLX(:,:,:) = - XCMFS * ZTMP2_DEVICE * GX_W_UW_PWM
+#endif
!! & to be tested
!! - (2./3.) * XCMFB * MZM( ZVPTU * MXM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
!
@@ -232,9 +260,11 @@ ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
! account in turb_ver and extrapolate the flux under the ground
ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)=2.*ZFLX(:,:,IKB)- ZFLX(:,:,IKB+1)
+!$acc end kernels
!
! stores <U W>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLX)
YRECFM ='UW_HFLX'
YCOMMENT='X_Y_Z_UW_HFLX ( (M/S) **2 ) '
IGRID = 6
@@ -245,9 +275,22 @@ END IF
!
! compute the source for rho*U due to this residual flux ( the other part is
! taken into account in TURB_VER)
+#ifndef _OPENACC
PRUS(:,:,:) = PRUS(:,:,:) - DZF(1,IKU,1, ZFLX* MXM( PMZM_PRHODJ ) / MXM( PDZZ ) )
+#else
+CALL MXM_DEVICE( PMZM_PRHODJ, ZTMP1_DEVICE )
+CALL MXM_DEVICE( PDZZ, ZTMP2_DEVICE )
+!$acc kernels
+ZTMP3_DEVICE = ZFLX* ZTMP1_DEVICE / ZTMP2_DEVICE
+!$acc end kernels
+CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP1_DEVICE )
+!$acc kernels
+PRUS(:,:,:) = PRUS(:,:,:) - ZTMP1_DEVICE(:,:,:)
+!$acc end kernels
+#endif
!
!computation of the source for rho*W due to this flux
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
-DXF( MZM(1,IKU,1, MXM(PRHODJ) * PINV_PDXX) * ZFLX) &
@@ -255,16 +298,64 @@ IF (.NOT. LFLAT) THEN
ELSE
PRWS(:,:,:) = PRWS(:,:,:) -DXF( MZM(1,IKU,1, MXM(PRHODJ) * PINV_PDXX) * ZFLX)
END IF
+#else
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * PINV_PDXX
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX
+ !$acc end kernels
+ CALL DXF_DEVICE( ZTMP2_DEVICE,ZTMP1_DEVICE)
+IF (.NOT. LFLAT) THEN
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX*PDZX
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1, ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP3_DEVICE*PINV_PDXX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ CALL MZF_DEVICE(1,IKU,1,PDZZ, ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP4_DEVICE = PRHODJ * ZTMP3_DEVICE / ZTMP2_DEVICE
+ !$acc end kernels
+ CALL DZM_DEVICE(1,IKU,1, ZTMP4_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ PRWS(:,:,:) = PRWS(:,:,:) &
+ - ZTMP1_DEVICE &
+ + ZTMP2_DEVICE
+ !$acc end kernels
+ELSE
+ !$acc kernels
+ PRWS(:,:,:) = PRWS(:,:,:) - ZTMP1_DEVICE
+ !$acc end kernels
+END IF
+#endif
!
IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
+#ifndef _OPENACC
ZWORK(:,:,:) =-MZF(1,IKU,1, MXF( &
ZFLX *( GZ_U_UW(1,IKU,1,PUM,PDZZ) + GX_W_UW_PWM ) ) )
+#else
+ CALL GZ_U_UW_DEVICE(1,IKU,1,PUM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX *( ZTMP1_DEVICE + GX_W_UW_PWM )
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE,ZTMP1_DEVICE )
+ CALL MZF_DEVICE(1,IKU,1, ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZWORK(:,:,:) = -ZTMP2_DEVICE(:,:,:)
+ !$acc end kernels
+#endif
!
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+#ifndef _OPENACC
ZWORK(:,:,IKB:IKB) = - MXF ( &
ZFLX(:,:,IKB+1:IKB+1) * &
( (PUM(:,:,IKB+1:IKB+1)-PUM(:,:,IKB:IKB)) / MXM(PDZZ(:,:,IKB+1:IKB+1))&
@@ -276,10 +367,36 @@ IF (KSPLT==1) THEN
) &
* PDZX(:,:,IKB+1:IKB+1) &
) / (0.5*(PDXX(:,:,IKB+1:IKB+1)+PDXX(:,:,IKB:IKB))) &
- ) )
+ ) )
+#else
+ CALL MXM_DEVICE( PDZZ(:,:,IKB+1:IKB+1), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DXM_DEVICE( PWM(:,:,IKB+1:IKB+1), ZTMP2_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = (PWM(:,:,IKB+2)-PWM(:,:,IKB+1)) &
+ /(PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) &
+ +(PWM(:,:,IKB+1)-PWM(:,:,IKB)) &
+ /(PDZZ(:,:,IKB+1)+PDZZ(:,:,IKB))
+ !$acc end kernels
+ CALL MXM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZFLX(:,:,IKB+1) * &
+ ( (PUM(:,:,IKB+1)-PUM(:,:,IKB)) / ZTMP1_DEVICE(:,:,1) &
+ + ( ZTMP2_DEVICE(:,:,1) &
+ - ZTMP4_DEVICE(:,:,1) &
+ * PDZX(:,:,IKB+1) &
+ ) / (0.5*(PDXX(:,:,IKB+1)+PDXX(:,:,IKB))) &
+ )
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZWORK(:,:,IKB) = - ZTMP1_DEVICE(:,:,1)
+ !$acc end kernels
+#endif
!
! dynamic production computation
+ !$acc kernels
PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
!
END IF
!
@@ -287,6 +404,7 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(ZFLX)), X_LES_SUBGRID_WU , .TRUE. )
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GZ_U_UW(1,IKU,1,PUM,PDZZ)*ZFLX)), X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MXF(GX_W_UW_PWM*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
@@ -300,6 +418,65 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)*MZF(1,IKU,1,ZFLX)), &
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
END DO
+#else
+!$acc data copy(X_LES_SUBGRID_WU,X_LES_RES_ddxa_U_SBG_UaU,X_LES_RES_ddxa_W_SBG_UaW, &
+!$acc & X_LES_RES_ddxa_Thl_SBG_UaW,X_LES_RES_ddxa_Sv_SBG_UaW)
+ !
+ CALL MXF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_WU , .TRUE. )
+ !
+ CALL GZ_U_UW_DEVICE(1,IKU,1,PUM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_U_SBG_UaU , .TRUE.)
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = GX_W_UW_PWM*ZFLX
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ !
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP1_DEVICE)
+ CALL GX_M_U_DEVICE(1,IKU,1,PTHLM,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZTMP1_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE,X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ !
+ IF (KRR>=1) THEN
+ !
+!$acc data copy(X_LES_RES_ddxa_Rt_SBG_UaW)
+ !
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP1_DEVICE)
+ CALL GX_M_U_DEVICE(1,IKU,1,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP1_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ !
+!$acc end data
+ !
+ END IF
+ !
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP1_DEVICE)
+ DO JSV=1,NSV
+ CALL GX_M_U_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) , .TRUE.)
+ END DO
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/turb_hor_vw.f90 b/src/MNH/turb_hor_vw.f90
index 2918dfc39bddc765a585b100c04efa8d443b4791..48352845892561558509c3a04d2641d4da201bb2 100644
--- a/src/MNH/turb_hor_vw.f90
+++ b/src/MNH/turb_hor_vw.f90
@@ -45,13 +45,17 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PINV_PDZZ ! 1./PDZZ
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMZM_PRHODJ ! MZM(PRHODJ)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY, PDZZ, PDZY
! Metric coefficients
+!$acc declare present(PDYY,PDZZ,PDZY)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density * grid volume
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! ref. state VPT
!
! Variables at t-1
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVM,PWM,PTHLM
+!$acc declare copyin(PVM,PTHLM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
+!$acc declare copyin(PRM)
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
+!$acc declare copyin(PSVM)
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKEM ! TKE at time t- dt
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
@@ -59,6 +63,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
!
+!$acc declare present(PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ,PDYY,PDZZ,PDZY, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PVM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM, &
+!$acc & PRVS,PRWS,PDP)
+!
END SUBROUTINE TURB_HOR_VW
!
END INTERFACE
@@ -114,6 +123,7 @@ END MODULE MODI_TURB_HOR_VW
!! Nov 06, 2002 (V. Masson) LES budgets
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -133,7 +143,11 @@ USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_COEFJ
USE MODI_LES_MEAN_SUBGRID
!
@@ -178,6 +192,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PLM ! Turb. mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS, PRWS ! var. at t+1 -split-
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDP ! TKE production terms
!
+!$acc declare present(PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ,PDYY,PDZZ,PDZY, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PVM,PWM,PTHLM,PRM,PSVM,PTKEM,PLM, &
+!$acc & PRVS,PRWS,PDP)
!
!
!* 0.2 declaration of local variables
@@ -198,8 +216,17 @@ CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
CHARACTER (LEN=16) :: YRECFM ! Name of the desired field in LFIFM file
!
REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: GY_W_VW_PWM
+!$acc declare create(GY_W_VW_PWM)
!
REAL :: ZTIME1, ZTIME2
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP1_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP2_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP3_DEVICE
+REAL, DIMENSION(SIZE(PWM,1),SIZE(PWM,2),SIZE(PWM,3)) :: ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
! ---------------------------------------------------------------------------
!
!* 1. PRELIMINARY COMPUTATIONS
@@ -210,7 +237,13 @@ IKE = SIZE(PWM,3)-JPVEXT
IKU = SIZE(PWM,3)
!
!
-IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)
+IF (.NOT. L2D) THEN
+#ifndef _OPENACC
+ GY_W_VW_PWM = GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)
+#else
+ CALL GY_W_VW_DEVICE(1,IKU,1,PWM,PDYY,PDZZ,PDZY,GY_W_VW_PWM)
+#endif
+END IF
!
!
!* 14. < V'W'>
@@ -218,6 +251,7 @@ IF (.NOT. L2D) GY_W_VW_PWM = GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)
!
! residual part of < V'W'> depending on dw/dy
!
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
ZFLX(:,:,:) = &
- XCMFS * MYM(MZM(1,IKU,1,PK)) * GY_W_VW_PWM
@@ -228,7 +262,25 @@ ELSE
!! & to be tested
!! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
END IF
+#else
+IF (.NOT. L2D) THEN
+ CALL MZM_DEVICE(PK,ZTMP1_DEVICE)
+ CALL MYM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLX(:,:,:) = - XCMFS * ZTMP2_DEVICE * GY_W_VW_PWM
+!$acc end kernels
+ !! & to be tested
+ !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+ELSE
+!$acc kernels
+ ZFLX(:,:,:) = 0.
+!$acc end kernels
+ !! & to be tested
+ !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+END IF
+#endif
!
+!$acc kernels
ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
!
!
@@ -236,9 +288,11 @@ ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
! account in turb_ver and extrapolate the flux under the ground
ZFLX(:,:,IKB) = 0.
ZFLX(:,:,IKB-1)= 2.*ZFLX(:,:,IKB) - ZFLX(:,:,IKB+1)
+!$acc end kernels
!
! stores <V W>
IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!$acc update self(ZFLX)
YRECFM ='VW_HFLX'
YCOMMENT='X_Y_Z_VW_HFLX ( (M/S) **2 ) '
IGRID = 7
@@ -248,10 +302,25 @@ END IF
!
! compute the source for rho*V due to this residual flux ( the other part is
! taken into account in TURB_VER)
+#ifndef _OPENACC
IF (.NOT. L2D) &
PRVS(:,:,:) = PRVS(:,:,:) - DZF(1,IKU,1, ZFLX* MYM( PMZM_PRHODJ ) / MYM ( PDZZ ) )
+#else
+IF (.NOT. L2D) THEN
+ CALL MYM_DEVICE( PMZM_PRHODJ, ZTMP1_DEVICE )
+ CALL MYM_DEVICE( PDZZ, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLX* ZTMP1_DEVICE / ZTMP2_DEVICE
+ !$acc end kernels
+ CALL DZF_DEVICE(1,IKU,1, ZTMP3_DEVICE, ZTMP1_DEVICE )
+ !$acc kernels
+ PRVS(:,:,:) = PRVS(:,:,:) - ZTMP1_DEVICE
+ !$acc end kernels
+ENDIF
+#endif
!
!computation of the source for rho*W due to this flux
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRWS(:,:,:) = PRWS(:,:,:) &
@@ -261,16 +330,75 @@ IF (.NOT. L2D) THEN
PRWS(:,:,:) = PRWS(:,:,:) - DYF( MZM(1,IKU,1, MYM(PRHODJ) * PINV_PDYY) * ZFLX)
END IF
END IF
+#else
+IF (.NOT. L2D) THEN
+ IF (.NOT. LFLAT) THEN
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP1_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX*PDZY
+ !$acc end kernels
+ CALL MZF_DEVICE(1,IKU,1,ZTMP2_DEVICE,ZTMP3_DEVICE )
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP3_DEVICE * PINV_PDYY
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,PDZZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP4_DEVICE = PRHODJ * ZTMP3_DEVICE / ZTMP2_DEVICE
+ !$acc end kernels
+ CALL DZM_DEVICE(1,IKU,1,ZTMP4_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ PRWS(:,:,:) = PRWS(:,:,:) &
+ - ZTMP1_DEVICE &
+ + ZTMP2_DEVICE
+ !$acc end kernels
+ ELSE
+ CALL MYM_DEVICE(PRHODJ, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * PINV_PDYY
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE, ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLX
+ !$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE, ZTMP1_DEVICE )
+ !$acc kernels
+ PRWS(:,:,:) = PRWS(:,:,:) - ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+END IF
+#endif
!
IF (KSPLT==1) THEN
!
!Contribution to the dynamic production of TKE:
!
IF (.NOT. L2D) THEN
+#ifndef _OPENACC
ZWORK(:,:,:) =-MZF(1,IKU,1, MYF( ZFLX *( GZ_V_VW(1,IKU,1,PVM,PDZZ) + GY_W_VW_PWM ) ) )
+#else
+ CALL GZ_V_VW_DEVICE(1,IKU,1,PVM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZFLX *( ZTMP1_DEVICE + GY_W_VW_PWM )
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZWORK(:,:,:) = -ZTMP2_DEVICE
+ !$acc end kernels
+#endif
!
!
! evaluate the dynamic production at w(IKB+1) in PDP(IKB)
+#ifndef _OPENACC
ZWORK(:,:,IKB:IKB) = - MYF ( &
ZFLX(:,:,IKB+1:IKB+1) * &
( (PVM(:,:,IKB+1:IKB+1)-PVM(:,:,IKB:IKB)) / MYM(PDZZ(:,:,IKB+1:IKB+1)) &
@@ -280,13 +408,39 @@ IF (KSPLT==1) THEN
+(PWM(:,:,IKB+1:IKB+1)-PWM(:,:,IKB :IKB )) &
/(PDZZ(:,:,IKB+1:IKB+1)+PDZZ(:,:,IKB :IKB )) &
) * PDZY(:,:,IKB+1:IKB+1) &
- ) / (0.5*(PDYY(:,:,IKB+1:IKB+1)+PDYY(:,:,IKB:IKB))) &
- ) )
+ ) / (0.5*(PDYY(:,:,IKB+1:IKB+1)+PDYY(:,:,IKB:IKB))) &
+ ) )
+#else
+ CALL MYM_DEVICE( PDZZ(:,:,IKB+1:IKB+1), ZTMP1_DEVICE(:,:,1:1) )
+ CALL DYM_DEVICE( PWM(:,:,IKB+1:IKB+1), ZTMP2_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = (PWM(:,:,IKB+2)-PWM(:,:,IKB+1)) &
+ /(PDZZ(:,:,IKB+2)+PDZZ(:,:,IKB+1)) &
+ +(PWM(:,:,IKB+1)-PWM(:,:,IKB)) &
+ /(PDZZ(:,:,IKB+1)+PDZZ(:,:,IKB))
+ !$acc end kernels
+ CALL MYM_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZTMP3_DEVICE(:,:,1) = ZFLX(:,:,IKB+1) * &
+ ( (PVM(:,:,IKB+1)-PVM(:,:,IKB)) / ZTMP1_DEVICE(:,:,1) &
+ + ( ZTMP2_DEVICE(:,:,1) &
+ - ZTMP4_DEVICE(:,:,1) * PDZY(:,:,IKB+1) &
+ ) / (0.5*(PDYY(:,:,IKB+1)+PDYY(:,:,IKB))) &
+ )
+ !$acc end kernels
+ CALL MYF_DEVICE( ZTMP3_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
+ !$acc kernels
+ ZWORK(:,:,IKB) = - ZTMP1_DEVICE(:,:,1)
+ !$acc end kernels
+#endif
ENDIF
!
! dynamic production computation
- IF (.NOT. L2D) &
- PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ IF (.NOT. L2D) THEN
+ !$acc kernels
+ PDP(:,:,:) = PDP(:,:,:) + ZWORK(:,:,:)
+ !$acc end kernels
+ ENDIF
!
END IF
!
@@ -294,12 +448,11 @@ END IF
!
IF (LLES_CALL .AND. KSPLT==1) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(ZFLX)), X_LES_SUBGRID_WV , .TRUE. )
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GZ_V_VW(1,IKU,1,PVM,PDZZ)*ZFLX)),&
- X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
- CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*ZFLX)),&
- X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
- CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)),&
+ CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GZ_V_VW(1,IKU,1,PVM,PDZZ)*ZFLX)), X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MZF(1,IKU,1,MYF(GY_W_VW(1,IKU,1,PWM,PDYY,PDZZ,PDZY)*ZFLX)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)), &
X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
IF (KRR>=1) THEN
CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)), &
@@ -309,6 +462,66 @@ IF (LLES_CALL .AND. KSPLT==1) THEN
CALL LES_MEAN_SUBGRID( MXF(GY_M_V(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)*MZF(1,IKU,1,ZFLX)), &
X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
END DO
+#else
+!$acc data copy(X_LES_SUBGRID_WV,X_LES_RES_ddxa_V_SBG_UaV,X_LES_RES_ddxa_W_SBG_UaW, &
+!$acc & X_LES_RES_ddxa_Thl_SBG_UaW,X_LES_RES_ddxa_Sv_SBG_UaW)
+ !
+ CALL MYF_DEVICE(ZFLX,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_WV , .TRUE. )
+ !
+ CALL GZ_V_VW_DEVICE(1,IKU,1,PVM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_V_SBG_UaV , .TRUE.)
+ !
+ CALL GY_W_VW_DEVICE(1,IKU,1,PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLX
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_W_SBG_UaW , .TRUE.)
+ !
+ CALL GY_M_V_DEVICE(1,IKU,1,PTHLM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE.)
+ !
+ IF (KRR>=1) THEN
+ !
+!$acc data copy(X_LES_RES_ddxa_Rt_SBG_UaW)
+ !
+ CALL GY_M_V_DEVICE(1,IKU,1,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE.)
+ !
+!$acc end data
+ !
+ END IF
+ !
+ CALL MZF_DEVICE(1,IKU,1,ZFLX,ZTMP2_DEVICE)
+ DO JSV=1,NSV
+ CALL GY_M_V_DEVICE(1,IKU,1,PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV), .TRUE.)
+ END DO
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index e4fb0967228b679ede06d592197ccd281c7e36e8..4e420062e82efae77d0d8961d1b03db8021c3494 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+! !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -114,8 +114,19 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+!$acc & PSBL_DEPTH,PLMO, &
+!$acc & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
+!$acc & PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
!
END SUBROUTINE TURB_VER
!
@@ -324,6 +335,7 @@ END MODULE MODI_TURB_VER
!! reversed vertical levels
!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -337,8 +349,6 @@ USE MODD_NSV, ONLY : NSV
USE MODD_BLANK
!
USE MODI_PRANDTL
-USE MODI_EMOIST
-USE MODI_ETHETA
USE MODI_GRADIENT_M
USE MODI_GRADIENT_W
USE MODI_TURB
@@ -446,16 +456,23 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
REAL, DIMENSION(:,:,:,:),INTENT(OUT) :: PWSV ! scalar flux
-
-!
-!
!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFSVM,PSFTHP,PSFRP,PSFSVP, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+!$acc & PUM,PVM,PWM,PUSLOPEM,PVSLOPEM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+!$acc & PSBL_DEPTH,PLMO, &
+!$acc & PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
+!$acc & PDP,PTP,PSIGS,PWTH,PWRC,PWSV )
!
!* 0.2 declaration of local variables
!
-!JUAN BUG PGI
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZBETA, & ! buoyancy coefficient
ZSQRT_TKE,& ! sqrt(e)
ZDTH_DZ, & ! d(th)/dz
@@ -477,8 +494,7 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
ZTHLP, & ! guess of potential temperature due to vert. turbulent flux
ZRP ! guess of total water due to vert. turbulent flux
-!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
-REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
ZPSI_SV, & ! Prandtl number for scalars
ZREDS1, & ! 1D Redeslperger number R_sv
ZRED2THS, & ! 3D Redeslperger number R*2_thsv
@@ -495,45 +511,20 @@ INTEGER :: IKB,IKE ! index value for the Beginning
INTEGER :: JSV ! loop counter on scalar variables
REAL :: ZTIME1
REAL :: ZTIME2
-!----------------------------------------------------------------------------
-ALLOCATE ( ZBETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZSQRT_TKE(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZDTH_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZDR_DZ(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2TH3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2R3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRED2THR3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)),&
- ZBLL_O_E(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZETHETA(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZEMOIST(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDTH1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZREDR1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPHI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZPSI3(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZD(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWTHV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWU(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZWV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZTHLP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) ,&
- ZRP(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) )
-
-ALLOCATE ( &
- ZPSI_SV(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZREDS1(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2THS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV), &
- ZRED2RS(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) )
-
+!
+!
+!$acc data create(ZBETA,ZSQRT_TKE,ZDTH_DZ,ZDR_DZ,ZRED2TH3,ZRED2R3,ZRED2THR3, &
+!$acc & ZBLL_O_E,ZETHETA,ZEMOIST,ZREDTH1,ZREDR1, &
+!$acc & ZPHI3,ZPSI3,ZD,ZWTHV,ZWU,ZWV,ZTHLP,ZRP, &
+!$acc & ZPSI_SV,ZREDS1,ZRED2THS,ZRED2RS)
+!
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
! -------------
!
-PTP (:,:,:) = 0.
-PDP (:,:,:) = 0.
-!
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
-
!
!
! 3D Redelsperger numbers
@@ -553,45 +544,76 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
!
! Buoyancy coefficient
!
+!$acc kernels
ZBETA = XG/PTHVREF
!
! Square root of Tke
!
ZSQRT_TKE = SQRT(PTKEM)
+!$acc end kernels
!
! gradients of mean quantities at previous time-step
!
+#ifndef _OPENACC
ZDTH_DZ = GZ_M_W(KKA,KKU,KKL,PTHLM(:,:,:),PDZZ)
ZDR_DZ = 0.
IF (KRR>0) THEN
ZDR_DZ = GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
ENDIF
+#else
+CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM(:,:,:),PDZZ,ZDTH_DZ)
+!$acc kernels
+ZDR_DZ = 0.
+!$acc end kernels
+IF (KRR>0) THEN
+CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ,ZDR_DZ)
+ENDIF
+#endif
!
!
! Denominator factor in 3rd order terms
!
+!$acc kernels
ZD(:,:,:) = (1.+ZREDTH1+ZREDR1) * (1.+0.5*(ZREDTH1+ZREDR1))
+!$acc end kernels
!
! Phi3 and Psi3 Prandtl numbers
!
GUSERV = KRR/=0
!
+#ifndef _OPENACC
ZPHI3 = PHI3(ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,HTURBDIM,GUSERV)
IF(KRR/=0) THEN
ZPSI3 = PSI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV)
ENDIF
+#else
+CALL PHI3(ZREDTH1,ZREDR1,ZRED2TH3,ZRED2R3,ZRED2THR3,HTURBDIM,GUSERV,ZPHI3)
+!
+IF(KRR/=0) THEN
+! CALL PHI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV,ZPSI3)
+ CALL PSI3(ZREDR1,ZREDTH1,ZRED2R3,ZRED2TH3,ZRED2THR3,HTURBDIM,GUSERV,ZPSI3)
+ENDIF
+#endif
!
! Prandtl numbers for scalars
!
+#ifndef _OPENACC
ZPSI_SV = PSI_SV(ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3)
+#else
+CALL PSI_SV(ZREDTH1,ZREDR1,ZREDS1,ZRED2THS,ZRED2RS,ZPHI3,ZPSI3,ZPSI_SV)
+#endif
!
! LES diagnostics
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+!$acc data copy(X_LES_SUBGRID_PHI3)
CALL LES_MEAN_SUBGRID(ZPHI3,X_LES_SUBGRID_PHI3)
+!$acc end data
IF(KRR/=0) THEN
+!$acc data copy(X_LES_SUBGRID_PSI3)
CALL LES_MEAN_SUBGRID(ZPSI3,X_LES_SUBGRID_PSI3)
+!$acc end data
END IF
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -610,6 +632,10 @@ END IF
!* 4. TURBULENT CORRELATIONS : <w Rc>, <THl THl>, <THl Rnp>, <Rnp Rnp>
! ----------------------------------------------------------------
!
+!
+!$acc kernels
+PTP (:,:,:) = 0.
+!$acc end kernels
!
CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
@@ -656,6 +682,11 @@ END IF
!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
! -----------------------------------------------
!
+!
+!$acc kernels
+PDP (:,:,:) = 0.
+!$acc end kernels
+!
CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
OCLOSE_OUT,OTURB_FLX,KRR, &
HTURBDIM,PIMPL,PEXPL,PTSTEP, &
@@ -715,6 +746,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
!
! stores the Turbulent Prandtl number
!
+ !$acc update self(ZPHI3)
YRECFM ='PHI3'
YCOMMENT='X_Y_Z_PHI3 (0)'
IGRID = 4
@@ -723,6 +755,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
!
! stores the Turbulent Schmidt number
!
+ !$acc update self(ZPSI3)
YRECFM ='PSI3'
YCOMMENT='X_Y_Z_PSI3 (0)'
IGRID = 4
@@ -733,6 +766,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
!
! stores the Turbulent Schmidt number for the scalar variables
!
+ !$acc update self(ZPSI_SV)
DO JSV=1,NSV
WRITE(YRECFM, '("PSI_SV_",I3.3)') JSV
YCOMMENT='X_Y_Z_'//YRECFM//' (0)'
@@ -744,6 +778,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
END IF
!
+!$acc end data
!
!----------------------------------------------------------------------------
END SUBROUTINE TURB_VER
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 3224c540bd41dc77553aa98c4eca0c6780202884..56ff5c7b27e934a86c97be677da641075e398d05 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -84,7 +84,14 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP,PTP ! Dynamic and thermal
! TKE production terms
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+!$acc & PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+!$acc & PTKEM,PLM,PWU,PWV, &
+!$acc & PRUS,PRVS,PRWS, &
+!$acc & PDP,PTP )
!
END SUBROUTINE TURB_VER_DYN_FLUX
!
@@ -286,6 +293,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! change of YCOMMENT
!! 2012-02 Y. Seity, add possibility to run with reversed vertical levels
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -303,7 +311,11 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_TRIDIAG
USE MODI_TRIDIAG_WIND
USE MODE_FMWRIT
@@ -374,7 +386,14 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP,PTP ! Dynamic and thermal
! TKE production terms
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PCOSSLOPE,PSINSLOPE, &
+!$acc & PRHODJ, &
+!$acc & PCDUEFF,PTAU11M,PTAU12M,PTAU33M, &
+!$acc & PTHLM,PRM,PSVM,PUM,PVM,PWM,PUSLOPEM,PVSLOPEM, &
+!$acc & PTKEM,PLM,PWU,PWV, &
+!$acc & PRUS,PRVS,PRWS, &
+!$acc & PDP,PTP )
!
!
!* 0.2 declaration of local variables
@@ -413,6 +432,13 @@ REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),1) :: ZCOEFFLXU, &
INTEGER :: IIU,IJU ! size of array in x,y,z directions
!
REAL :: ZTIME1, ZTIME2
+!
+!$acc declare create(ZDIRSINZW,ZCOEFS,ZA,ZRES,ZFLXZ,ZSOURCE,ZKEFF,ZCOEFFLXU,ZCOEFFLXV,ZUSLOPEM,ZVSLOPEM)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -426,20 +452,26 @@ IKE=KKU-JPVEXT_TURB*KKL
IKT=SIZE(PUM,3)
IKTB=1+JPVEXT_TURB
IKTE=IKT-JPVEXT_TURB
-
-
!
-ZSOURCE = 0.
-ZFLXZ = 0.
+!$acc kernels
+ZSOURCE(:,:,:) = 0.
!
ZDIRSINZW(:,:) = SQRT(1.-PDIRCOSZW(:,:)**2)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
+#ifndef _OPENACC
ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+#else
+ZTMP1_DEVICE = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP1_DEVICE,ZKEFF)
+#endif
!
+!$acc kernels
ZUSLOPEM(:,:,1)=PUSLOPEM(:,:)
ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
+!$acc end kernels
!
!----------------------------------------------------------------------------
!
@@ -451,16 +483,31 @@ ZVSLOPEM(:,:,1)=PVSLOPEM(:,:)
!
! Preparation of the arguments for TRIDIAG_WIND
!
+#ifndef _OPENACC
ZA(:,:,:) = -PTSTEP * XCMFS * &
MXM( ZKEFF ) * MXM(MZM(KKA,KKU,KKL, PRHODJ )) / &
MXM( PDZZ )**2
+#else
+CALL MXM_DEVICE( ZKEFF, ZTMP1_DEVICE )
+CALL MZM_DEVICE(PRHODJ, ZTMP2_DEVICE )
+CALL MXM_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+CALL MXM_DEVICE( PDZZ, ZTMP4_DEVICE )
+!$acc kernels
+ZA(:,:,:) = -PTSTEP * XCMFS * ZTMP1_DEVICE * ZTMP3_DEVICE / ZTMP4_DEVICE**2
+!$acc end kernels
+#endif
!
-IF (CPROGRAM/='AROME ') ZA(1,:,:)=ZA(IIE,:,:)
+IF (CPROGRAM/='AROME ') THEN
+!$acc kernels
+ ZA(1,:,:)=ZA(IIE,:,:)
+!$acc end kernels
+ENDIF
!
! Compute the source of U wind component
!
! compute the coefficient between the vertical flux and the 2 components of the
! wind following the slope
+!$acc kernels
ZCOEFFLXU(:,:,1) = PCDUEFF(:,:) * (PDIRCOSZW(:,:)**2 - ZDIRSINZW(:,:)**2) &
* PCOSSLOPE(:,:)
ZCOEFFLXV(:,:,1) = PCDUEFF(:,:) * PDIRCOSZW(:,:) * PSINSLOPE(:,:)
@@ -470,55 +517,114 @@ ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
+ZCOEFFLXV(:,:,1) * PSINSLOPE(:,:)
!
! average this flux to be located at the U,W vorticity point
+#ifndef _OPENACC
ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
+#else
+ZTMP1_DEVICE(:,:,1) = ZCOEFS(:,:,1) / PDZZ(:,:,IKB)
+!$acc end kernels
+CALL MXM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZCOEFS(:,:,1:1))
+#endif
!
! compute the explicit tangential flux at the W point
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
+!$acc kernels
+ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
-PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
!
! add the vertical part or the surface flux at the U,W vorticity point
-ZSOURCE(:,:,IKB:IKB) = &
- ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+#ifndef _OPENACC
+ZSOURCE(:,:,IKB:IKB) = &
+ ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
*ZUSLOPEM(:,:,1:1) &
- -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
+ -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+#else
+ZTMP1_DEVICE(:,:,IKB) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
+ZTMP2_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
+ *ZUSLOPEM(:,:,1) &
+ -ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
+ *ZVSLOPEM(:,:,1)
+!$acc end kernels
+CALL MXM_DEVICE( ZTMP1_DEVICE(:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1) )
+CALL MXM_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+CALL MXM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,KKA:KKA))
+CALL MXM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP2_DEVICE(:,:,IKB:IKB))
+!$acc kernels
+ZSOURCE(:,:,IKB) = ( ZTMP3_DEVICE(:,:,1) + ZTMP4_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PUM(:,:,IKB) * PIMPL &
+ ) * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,KKA) / ZTMP2_DEVICE(:,:,IKB) )
+#endif
!
ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
ZSOURCE(:,:,IKE) = 0.
+!$acc end kernels
!
! Obtention of the splitted U at t+ deltat
!
+#ifndef _OPENACC
CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
MXM(PRHODJ),ZSOURCE,ZRES)
+#else
+CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
+ ZTMP1_DEVICE,ZSOURCE,ZRES)
+#endif
!
! Compute the equivalent tendency for the U wind component
!
+#ifndef _OPENACC
PRUS(:,:,:)=PRUS(:,:,:)+MXM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
+#else
+!$acc kernels
+PRUS(:,:,:)=PRUS(:,:,:)+ZTMP1_DEVICE*(ZRES(:,:,:)-PUM(:,:,:))/PTSTEP
+#endif
!
!
!* 5.2 Partial Dynamic Production
!
! vertical flux of the U wind component
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = -XCMFS * MXM(ZKEFF) * &
DZM (KKA,KKU,KKL,PIMPL*ZRES + PEXPL*PUM) / MXM(PDZZ)
+#else
+ZTMP2_DEVICE = PIMPL*ZRES + PEXPL*PUM
+!$acc end kernels
+CALL MXM_DEVICE(ZKEFF,ZTMP1_DEVICE)
+CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+CALL MXM_DEVICE(PDZZ,ZTMP4_DEVICE)
+!$acc kernels
+ZFLXZ(:,:,:) = -XCMFS * ZTMP1_DEVICE * ZTMP3_DEVICE / ZTMP4_DEVICE
+!$acc end kernels
+#endif
!
! surface flux
+#ifndef _OPENACC
ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
( ZSOURCE(:,:,IKB:IKB) &
+ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
) / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+#else
+CALL MXM_DEVICE(PDZZ(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,IKB:IKB))
+CALL MXM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP2_DEVICE(:,:,KKA:KKA))
+CALL MXM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,IKB:IKB))
+!$acc kernels
+ZFLXZ(:,:,IKB:IKB) = ZTMP1_DEVICE(:,:,IKB:IKB) * &
+ ( ZSOURCE(:,:,IKB:IKB) &
+ +ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
+ ) / 0.5 / ( 1. + ZTMP2_DEVICE(:,:,KKA:KKA) / ZTMP3_DEVICE(:,:,IKB:IKB) )
+#endif
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+!$acc end kernels
!
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
! stores the U wind component vertical flux
YRECFM ='UW_VFLX'
YCOMMENT='X_Y_Z_UW_VFLX (M**2/S**2)'
@@ -529,27 +635,76 @@ END IF
!
! first part of total momentum flux
!
+!$acc kernels
PWU(:,:,:) = ZFLXZ(:,:,:)
+!$acc end kernels
!
! Contribution to the dynamic production of TKE
! compute the dynamic production at the mass point
!
+#ifndef _OPENACC
PDP(:,:,:) = - MZF(KKA,KKU,KKL, MXF ( ZFLXZ * GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) ) )
+#else
+CALL GZ_U_UW_DEVICE(KKA,KKU,KKL,PUM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZFLXZ * ZTMP1_DEVICE
+!$acc end kernels
+CALL MXF_DEVICE( ZTMP2_DEVICE,ZTMP3_DEVICE )
+CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP4_DEVICE )
+!$acc kernels
+PDP(:,:,:) = - ZTMP4_DEVICE
+!$acc end kernels
+#endif
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+#ifndef _OPENACC
PDP(:,:,IKB:IKB) = - MXF ( &
ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
/ MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
+ )
+#else
+CALL MXM_DEVICE(PDZZ(:,:,IKB+KKL:IKB+KKL),ZTMP1_DEVICE(:,:,IKB+KKL:IKB+KKL))
+!$acc kernels
+ZTMP2_DEVICE(:,:,IKB:IKB) = ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
+ / ZTMP1_DEVICE(:,:,IKB+KKL:IKB+KKL)
+!$acc end kernels
+CALL MXF_DEVICE(ZTMP2_DEVICE(:,:,IKB:IKB), ZTMP3_DEVICE(:,:,IKB:IKB))
+!$acc kernels
+PDP(:,:,IKB:IKB) = - ZTMP3_DEVICE(:,:,IKB:IKB)
+!$acc end kernels
+#endif
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(ZFLXZ)), X_LES_SUBGRID_WU )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(GZ_U_UW(KKA,KKU,KKL,PUM,PDZZ) &
& *ZFLXZ)), X_LES_RES_ddxa_U_SBG_UaU )
CALL LES_MEAN_SUBGRID( XCMFS * ZKEFF, X_LES_SUBGRID_Km )
+#else
+!$acc data copy(X_LES_SUBGRID_WU,X_LES_RES_ddxa_U_SBG_UaU,X_LES_SUBGRID_Km)
+ !
+ CALL MXF_DEVICE(ZFLXZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_WU )
+ !
+ CALL GZ_U_UW_DEVICE(KKA,KKU,KKL,PUM,PDZZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_RES_ddxa_U_SBG_UaU )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = XCMFS * ZKEFF
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_Km )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -559,9 +714,12 @@ END IF
!
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
+!$acc kernels
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
! used to compute the W source at the ground
+!$acc end kernels
!
+#ifndef _OPENACC
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS &
-DXF( MZM(KKA,KKU,KKL, MXM(PRHODJ) /PDXX ) * ZFLXZ ) &
@@ -571,13 +729,59 @@ IF(HTURBDIM=='3DIM') THEN
ELSE
PRWS(:,:,:)= PRWS -DXF( MZM(KKA,KKU,KKL, MXM(PRHODJ) /PDXX ) * ZFLXZ )
END IF
+#else
+ CALL MXM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE /PDXX
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE )
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP3_DEVICE * ZFLXZ
+!$acc end kernels
+ CALL DXF_DEVICE( ZTMP2_DEVICE,ZTMP1_DEVICE )
+ IF (.NOT. LFLAT) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PDZZ,ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLXZ*PDZX
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE,ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE / PDXX
+ !$acc end kernels
+ CALL MXF_DEVICE( ZTMP3_DEVICE,ZTMP4_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = PRHODJ / ZTMP2_DEVICE * ZTMP4_DEVICE
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ PRWS(:,:,:)= PRWS - ZTMP1_DEVICE + ZTMP2_DEVICE
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRWS(:,:,:)= PRWS -ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! Complete the Dynamical production with the W wind component
!
+#ifndef _OPENACC
ZA(:,:,:)=-MZF(KKA,KKU,KKL, MXF ( ZFLXZ * GX_W_UW(KKA,KKU,KKL, PWM,PDXX,PDZZ,PDZX) ) )
+#else
+ CALL GX_W_UW_DEVICE(KKA,KKU,KKL, PWM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZFLXZ * ZTMP1_DEVICE
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels
+ ZA(:,:,:)=-ZTMP2_DEVICE
+!$acc end kernels
+#endif
!
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+#ifndef _OPENACC
ZA(:,:,IKB:IKB) = - MXF ( &
ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
( DXM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
@@ -589,13 +793,33 @@ IF(HTURBDIM=='3DIM') THEN
* PDZX(:,:,IKB+KKL:IKB+KKL) &
) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
)
+#else
+ CALL DXM_DEVICE( PWM(:,:,IKB+KKL:IKB+KKL), ZTMP1_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = (PWM(:,:,IKB+2*KKL )-PWM(:,:,IKB+KKL)) &
+ /(PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) &
+ +(PWM(:,:,IKB+KKL)-PWM(:,:,IKB )) &
+ /(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB ))
+!$acc end kernels
+ CALL MXM_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZFLXZ(:,:,IKB+KKL) * &
+ ( ZTMP1_DEVICE(:,:,1) - ZTMP3_DEVICE(:,:,1) * PDZX(:,:,IKB+KKL) ) &
+ / (0.5*(PDXX(:,:,IKB+KKL)+PDXX(:,:,IKB)))
+!$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE(:,:,1:1),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ ZA(:,:,IKB:IKB) = - ZTMP4_DEVICE(:,:,1:1)
+#endif
!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!$acc end kernels
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MXF(GX_W_UW(KKA,KKU,KKL,PWM,PDXX,&
PDZZ,PDZX)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW )
CALL LES_MEAN_SUBGRID( MXF(GX_M_U(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX)&
@@ -608,6 +832,48 @@ IF(HTURBDIM=='3DIM') THEN
CALL LES_MEAN_SUBGRID( MXF(GX_U_M(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,&
PDZX)*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
END DO
+#else
+!$acc data copy(X_LES_RES_ddxa_W_SBG_UaW,X_LES_RES_ddxa_Thl_SBG_UaW, &
+!$acc & X_LES_RES_ddxa_Rt_SBG_UaW,X_LES_RES_ddxa_Sv_SBG_UaW)
+ !
+ CALL GX_W_UW_DEVICE(KKA,KKU,KKL,PWM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP4_DEVICE, X_LES_RES_ddxa_W_SBG_UaW )
+ !
+ CALL GX_M_U_DEVICE(KKA,KKU,KKL,PTHLM,PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaW )
+ !
+ IF (KRR>=1) THEN
+ CALL GX_U_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID(ZTMP4_DEVICE,X_LES_RES_ddxa_Rt_SBG_UaW )
+ END IF
+ !
+ DO JSV=1,NSV
+ CALL GX_U_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MXF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE,X_LES_RES_ddxa_Sv_SBG_UaW(:,:,:,JSV) )
+ END DO
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -623,9 +889,18 @@ END IF
!
! Preparation of the arguments for TRIDIAG_WIND
!!
+#ifndef _OPENACC
ZA(:,:,:) = - PTSTEP * XCMFS * &
- MYM( ZKEFF ) * MYM(MZM(KKA,KKU,KKL, PRHODJ )) / &
+ MYM( ZKEFF ) * MYM(MZM(KKA,KKU,KKL, PRHODJ )) / &
MYM( PDZZ )**2
+#else
+CALL MYM_DEVICE( ZKEFF, ZTMP1_DEVICE )
+CALL MYM_DEVICE( PDZZ, ZTMP2_DEVICE )
+CALL MZM_DEVICE(PRHODJ, ZTMP3_DEVICE )
+CALL MYM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ZA(:,:,:) = - PTSTEP * XCMFS * ZTMP1_DEVICE * ZTMP4_DEVICE / ZTMP2_DEVICE**2
+#endif
!
!
IF(CPROGRAM/='AROME ') ZA(:,1,:)=ZA(:,IJE,:)
@@ -642,40 +917,79 @@ ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
+ZCOEFFLXV(:,:,1) * PCOSSLOPE(:,:)
!
! average this flux to be located at the V,W vorticity point
+#ifndef _OPENACC
ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
+#else
+ZTMP1_DEVICE(:,:,1:1) = ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB)
+!$acc end kernels
+CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZCOEFS(:,:,1:1) )
+#endif
!
! compute the explicit tangential flux at the W point
+!$acc kernels
ZSOURCE(:,:,IKB) = &
PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
-PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
!
! add the vertical part or the surface flux at the V,W vorticity point
+#ifndef _OPENACC
ZSOURCE(:,:,IKB:IKB) = &
- ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
+ *ZUSLOPEM(:,:,1:1) &
+ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
+ *ZVSLOPEM(:,:,1:1) ) &
- ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+#else
+ZTMP1_DEVICE(:,:,1) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
+!$acc end kernels
+CALL MYM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
+!$acc kernels
+ZTMP1_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
+ *ZUSLOPEM(:,:,1) &
+ +ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
+ *ZVSLOPEM(:,:,1)
+!$acc end kernels
+CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
+!$acc kernels
+ZSOURCE(:,:,IKB) = ( ZTMP2_DEVICE(:,:,1) + ZTMP3_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PVM(:,:,IKB) * PIMPL ) &
+ * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,1) / ZTMP4_DEVICE(:,:,1) )
+#endif
!
ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
ZSOURCE(:,:,IKE) = 0.
+!$acc end kernels
!
! Obtention of the splitted V at t+ deltat
+#ifndef _OPENACC
CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
MYM(PRHODJ),ZSOURCE,ZRES)
+#else
+CALL MYM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
+ ZTMP1_DEVICE,ZSOURCE,ZRES)
+#endif
!
! Compute the equivalent tendency for the V wind component
!
+#ifndef _OPENACC
PRVS(:,:,:)=PRVS(:,:,:)+MYM(PRHODJ(:,:,:))*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
+#else
+!$acc kernels
+PRVS(:,:,:)=PRVS(:,:,:)+ZTMP1_DEVICE*(ZRES(:,:,:)-PVM(:,:,:))/PTSTEP
+!$acc end kernels
+#endif
!
!
!* 6.2 Complete 1D dynamic Production
!
! vertical flux of the V wind component
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = -XCMFS * MYM(ZKEFF) * &
DZM(KKA,KKU,KKL, PIMPL*ZRES + PEXPL*PVM ) / MYM(PDZZ)
!
@@ -683,11 +997,32 @@ ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
( ZSOURCE(:,:,IKB:IKB) &
+ZCOEFS(:,:,1:1) * ZRES(:,:,IKB:IKB) * PIMPL &
) / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
+#else
+!$acc kernels
+ZTMP1_DEVICE = PIMPL*ZRES + PEXPL*PVM
+!$acc end kernels
+CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+CALL MYM_DEVICE(PDZZ,ZTMP3_DEVICE)
+CALL MYM_DEVICE(ZKEFF,ZTMP1_DEVICE)
+!$acc kernels
+ZFLXZ(:,:,:) = -XCMFS * ZTMP1_DEVICE * ZTMP2_DEVICE / ZTMP3_DEVICE
+!$acc end kernels
+!
+CALL MYM_DEVICE(PDZZ(:,:,IKB:IKB),ZTMP1_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP2_DEVICE(:,:,1:1))
+CALL MYM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP3_DEVICE(:,:,1:1))
+!$acc kernels
+ZFLXZ(:,:,IKB) = ZTMP1_DEVICE(:,:,1) * &
+ ( ZSOURCE(:,:,IKB) &
+ +ZCOEFS(:,:,1) * ZRES(:,:,IKB) * PIMPL &
+ ) / 0.5 / ( 1. + ZTMP2_DEVICE(:,:,1) / ZTMP3_DEVICE(:,:,1) )
+#endif
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+!$acc end kernels
!
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
! stores the V wind component vertical flux
YRECFM ='VW_VFLX'
YCOMMENT='X_Y_Z_VW_VFLX (M**2/S**2)'
@@ -698,29 +1033,72 @@ END IF
!
! second part of total momentum flux
!
+!$acc kernels
PWV(:,:,:) = ZFLXZ(:,:,:)
+!$acc end kernels
!
! Contribution to the dynamic production of TKE
! compute the dynamic production contribution at the mass point
!
+#ifndef _OPENACC
ZA(:,:,:) = - MZF(KKA,KKU,KKL, MYF ( ZFLXZ * GZ_V_VW(KKA,KKU,KKL,PVM,PDZZ) ) )
+#else
+CALL GZ_V_VW_DEVICE(KKA,KKU,KKL,PVM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ZTMP2_DEVICE = ZFLXZ * ZTMP1_DEVICE
+!$acc end kernels
+CALL MYF_DEVICE( ZTMP2_DEVICE, ZTMP3_DEVICE )
+CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP1_DEVICE )
+!$acc kernels
+ZA(:,:,:) = - ZTMP1_DEVICE
+!$acc end kernels
+#endif
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+#ifndef _OPENACC
ZA(:,:,IKB:IKB) = &
- MYF ( &
ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
/ MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
)
+#else
+CALL MYM_DEVICE( PDZZ(:,:,IKB+KKL:IKB+KKL), ZTMP1_DEVICE(:,:,1:1) )
+!$acc kernels
+ZTMP2_DEVICE(:,:,1) = ZFLXZ(:,:,IKB+KKL) * (PVM(:,:,IKB+KKL)-PVM(:,:,IKB)) / ZTMP1_DEVICE(:,:,1)
+!$acc end kernels
+CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
+!$acc kernels
+ZA(:,:,IKB) = - ZTMP1_DEVICE(:,:,1)
+#endif
!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!$acc end kernels
!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(ZFLXZ)), X_LES_SUBGRID_WV )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(GZ_V_VW(KKA,KKU,KKL,PVM,PDZZ)*&
& ZFLXZ)), X_LES_RES_ddxa_V_SBG_UaV )
+#else
+!$acc data copy(X_LES_SUBGRID_WV,X_LES_RES_ddxa_V_SBG_UaV)
+ !
+ CALL MYF_DEVICE(ZFLXZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_WV )
+ !
+ CALL GZ_V_VW_DEVICE(KKA,KKU,KKL,PVM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_RES_ddxa_V_SBG_UaV )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -730,8 +1108,11 @@ END IF
!
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
+!$acc kernels
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+!$acc end kernels
!
+#ifndef _OPENACC
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS(:,:,:) &
@@ -743,12 +1124,60 @@ IF(HTURBDIM=='3DIM') THEN
PRWS(:,:,:)= PRWS(:,:,:) -DYF( MZM(KKA,KKU,KKL, MYM(PRHODJ) /PDYY ) * ZFLXZ )
END IF
END IF
+#else
+ IF (.NOT. L2D) THEN
+ CALL MYM_DEVICE(PRHODJ,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE /PDYY
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLXZ
+!$acc end kernels
+ CALL DYF_DEVICE( ZTMP2_DEVICE,ZTMP1_DEVICE )
+ IF (.NOT. LFLAT) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PDZZ,ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE = ZFLXZ*PDZY
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP4_DEVICE / PDYY
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = PRHODJ / ZTMP2_DEVICE * ZTMP4_DEVICE
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE, ZTMP4_DEVICE)
+ !$acc kernels
+ PRWS(:,:,:)= PRWS(:,:,:) - ZTMP1_DEVICE + ZTMP4_DEVICE
+ !$acc end kernels
+ ELSE
+ !$acc kernels
+ PRWS(:,:,:)= PRWS(:,:,:) - ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+ END IF
+#endif
!
! Complete the Dynamical production with the W wind component
IF (.NOT. L2D) THEN
+#ifndef _OPENACC
ZA(:,:,:) = - MZF(KKA,KKU,KKL, MYF ( ZFLXZ * GY_W_VW(KKA,KKU,KKL, PWM,PDYY,PDZZ,PDZY) ) )
+#else
+ CALL GY_W_VW_DEVICE(KKA,KKU,KKL, PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZFLXZ * ZTMP1_DEVICE
+!$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels
+ ZA(:,:,:) = - ZTMP2_DEVICE
+!$acc end kernels
+#endif
!
! evaluate the dynamic production at w(IKB+KKL) in PDP(IKB)
+#ifndef _OPENACC
ZA(:,:,IKB:IKB) = - MYF ( &
ZFLXZ(:,:,IKB+KKL:IKB+KKL) * &
( DYM( PWM(:,:,IKB+KKL:IKB+KKL) ) &
@@ -758,10 +1187,29 @@ IF(HTURBDIM=='3DIM') THEN
/(PDZZ(:,:,IKB+KKL:IKB+KKL)+PDZZ(:,:,IKB:IKB )) &
) &
* PDZY(:,:,IKB+KKL:IKB+KKL) &
- ) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
+ ) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
)
+#else
+ CALL DYM_DEVICE( PWM(:,:,IKB+KKL:IKB+KKL), ZTMP1_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = (PWM(:,:,IKB+2*KKL)-PWM(:,:,IKB+KKL)) &
+ /(PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) &
+ +(PWM(:,:,IKB+KKL)-PWM(:,:,IKB )) &
+ /(PDZZ(:,:,IKB+KKL)+PDZZ(:,:,IKB ))
+!$acc end kernels
+ CALL MYM_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP3_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZTMP2_DEVICE(:,:,1) = ZFLXZ(:,:,IKB+KKL) * &
+ ( ZTMP1_DEVICE(:,:,1) - ZTMP3_DEVICE(:,:,1) * PDZY(:,:,IKB+KKL) ) &
+ / (0.5*(PDYY(:,:,IKB+KKL)+PDYY(:,:,IKB)))
+!$acc end kernels
+ CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
+!$acc kernels
+ ZA(:,:,IKB:IKB) = - ZTMP1_DEVICE(:,:,1:1)
+#endif
!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
+!$acc end kernels
!
END IF
!
@@ -769,6 +1217,7 @@ IF(HTURBDIM=='3DIM') THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MYF(GY_W_VW(KKA,KKU,KKL,PWM,PDYY,&
PDZZ,PDZY)*ZFLXZ)), X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
CALL LES_MEAN_SUBGRID( MYF(GY_M_V(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY)&
@@ -777,6 +1226,37 @@ IF(HTURBDIM=='3DIM') THEN
CALL LES_MEAN_SUBGRID( MYF(GY_V_M(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,&
PDZY)*MZF(KKA,KKU,KKL,ZFLXZ)),X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
END IF
+#else
+!$acc data copy(X_LES_RES_ddxa_W_SBG_UaW,X_LES_RES_ddxa_Thl_SBG_UaW,X_LES_RES_ddxa_Rt_SBG_UaW)
+ !
+ CALL GY_W_VW_DEVICE(KKA,KKU,KKL,PWM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_RES_ddxa_W_SBG_UaW , .TRUE. )
+ !
+ CALL GY_M_V_DEVICE(KKA,KKU,KKL,PTHLM,PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaW , .TRUE. )
+ !
+ IF (KRR>=1) THEN
+ CALL GY_V_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDYY,PDZZ,PDZY,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ !$acc end kernels
+ CALL MYF_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE,X_LES_RES_ddxa_Rt_SBG_UaW , .TRUE. )
+ END IF
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -785,12 +1265,14 @@ END IF
!
! complete the dynamic production at the marginal points
IF (CPROGRAM/='AROME ') THEN
+!$acc kernels
PDP(:,:,KKA)= -999.
PDP(:,:,KKU)= -999.
PDP(:,1,:)= PDP(:,IJE,:)
PDP(:,IJE+1,:)= PDP(:,IJB,:)
PDP(1,:,:)= PDP(IIE,:,:)
PDP(IIE+1,:,:)= PDP(IIB,:,:)
+!$acc end kernels
END IF
!
!----------------------------------------------------------------------------
@@ -799,11 +1281,20 @@ END IF
! -----------------------------------------------
!
IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. HTURBDIM == '1DIM') THEN
+#ifndef _OPENACC
ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
-XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)
+#else
+ CALL GZ_W_M_DEVICE(KKA,KKU,KKL,PWM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
+ -XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*ZTMP1_DEVICE
+!$acc end kernels
+#endif
! to be tested &
! +XCMFB*(4./3.)*PLM(:,:,:)/SQRT(PTKEM(:,:,:))*PTP(:,:,:)
! stores the W variance
+!$acc update self(ZFLXZ)
YRECFM ='W_VVAR'
YCOMMENT='X_Y_Z_W_VVAR (M**2/S**2)'
IGRID = 1
diff --git a/src/MNH/turb_ver_sv_corr.f90 b/src/MNH/turb_ver_sv_corr.f90
index 75f63221398d2e9e8e1f1f76cdc7b06e14087349..48c502605082e2c9fc700ff5c012d232c9b6e776 100644
--- a/src/MNH/turb_ver_sv_corr.f90
+++ b/src/MNH/turb_ver_sv_corr.f90
@@ -169,6 +169,10 @@ REAL :: ZCTSVD = 2.4 ! constant for temperature - scalar covariance dissipation
REAL :: ZCQSVD = 2.4 ! constant for humidity - scalar covariance dissipation
!----------------------------------------------------------------------------
!
+#ifdef _OPENACC
+PRINT *,'OPENACC: TURB_VER_SV_CORR:: not yet implemented'
+CALL ABORT
+#endif
CALL SECOND_MNH(ZTIME1)
!
DO JSV=1,NSV
@@ -189,7 +193,14 @@ DO JSV=1,NSV
!
IF (LLES_CALL) THEN
! approximation: diagnosed explicitely (without implicit term)
+#ifndef _OPENACC
ZA(:,:,:) = ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM)
+#else
+PRINT *,'OPENACC: TURB_VER_SV_CORR:: LLES_CALL not yet tested'
+!$acc data copyin(PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) copyout(ZA)
+ CALL ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,ZA)
+!$acc end data
+#endif
ZFLXZ(:,:,:)= ( XCSHF * PPHI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
* GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ) &
* GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
@@ -198,7 +209,14 @@ DO JSV=1,NSV
CALL LES_MEAN_SUBGRID( -XG/PTHVREF/3.*ZA*ZFLXZ, X_LES_SUBGRID_SvPz(:,:,:,JSV), .TRUE.)
!
IF (KRR>=1) THEN
+#ifndef _OPENACC
ZA(:,:,:) = EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM)
+#else
+PRINT *,'OPENACC: TURB_VER_SV_CORR:: LLES_CALL not yet tested'
+!$acc data copyin(PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) copyout(ZA)
+ CALL EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,ZA)
+!$acc end data
+#endif
ZFLXZ(:,:,:)= ( XCHF * PPSI3 + XCHF * PPSI_SV(:,:,:,JSV) ) &
* GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ) &
* GZ_M_W(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDZZ)
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index c3ec5d032a87c555859d442c25e112aae11d74f0..e11beff64a0cac292d0f24290637c2a392f489f1 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -186,9 +186,6 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
-!! of a variable located at a wind point
-!!
!! FUNCTIONs ETHETA and EMOIST :
!! allows to compute:
!! - the coefficients for the turbulent correlation between
@@ -285,9 +282,6 @@ USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
USE MODI_SHUMAN
USE MODI_TRIDIAG
-USE MODI_TRIDIAG_WIND
-USE MODI_EMOIST
-USE MODI_ETHETA
USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
!
@@ -373,7 +367,10 @@ REAL :: ZCSVP = 4.0 ! constant for scalar flux presso-correlation (RS81)
!* 1. PRELIMINARIES
! -------------
!
-
+#ifdef _OPENACC
+PRINT *,'OPENACC: TURB_VER_SV_FLUX:: not yet implemented'
+CALL ABORT
+#endif
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
IKT=SIZE(PSVM,3)
diff --git a/src/MNH/turb_ver_thermo_corr.f90 b/src/MNH/turb_ver_thermo_corr.f90
index e3f63e18f7731c5d452166173725c46f3532e44d..a54aae89a5a7907bd29c515c3d6aabcc6d449874 100644
--- a/src/MNH/turb_ver_thermo_corr.f90
+++ b/src/MNH/turb_ver_thermo_corr.f90
@@ -106,7 +106,17 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFTHP,PSFRP, &
+!$acc & PWM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+!$acc & PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+!$acc & PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+!$acc & PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+!$acc & PTHLP,PRP,PSIGS )
!
END SUBROUTINE TURB_VER_THERMO_CORR
!
@@ -312,6 +322,7 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! change of YCOMMENT
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -327,12 +338,14 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_TRIDIAG
USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
-USE MODI_TRIDIAG_THERMO
!
USE MODE_PRANDTL
!
@@ -420,7 +433,17 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRP ! guess of r at t+ deltat
!
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGS ! Vert. part of Sigma_s at t
!
-!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFTHP,PSFRP, &
+!$acc & PWM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM, &
+!$acc & PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+!$acc & PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+!$acc & PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR, &
+!$acc & PTHLP,PRP,PSIGS )
!
!* 0.2 declaration of local variables
!
@@ -454,6 +477,15 @@ LOGICAL :: GFWTH ! flag to use w'2th'
LOGICAL :: GFR2 ! flag to use w'r'2
LOGICAL :: GFWR ! flag to use w'2r'
LOGICAL :: GFTHR ! flag to use w'th'r'
+!
+!$acc declare create(ZA,ZFLXZ,ZSOURCE,ZKEFF,ZF,ZDFDDTDZ,ZDFDDRDZ,Z3RDMOMENT,ZCOEFF)
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE, &
+!$acc & ZTMP5_DEVICE,ZTMP6_DEVICE,ZTMP7_DEVICE,ZTMP8_DEVICE)
+#endif
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -471,6 +503,7 @@ GUSERV = (KRR/=0)
!
! compute the coefficients for the uncentred gradient computation near the
! ground
+!$acc kernels
ZCOEFF(:,:,IKB+2*KKL)= - PDZZ(:,:,IKB+KKL) / &
( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+2*KKL) )
ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
@@ -478,7 +511,13 @@ ZCOEFF(:,:,IKB+KKL)= (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) / &
ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2*KKL)+2.*PDZZ(:,:,IKB+KKL)) / &
( (PDZZ(:,:,IKB+2*KKL)+PDZZ(:,:,IKB+KKL)) * PDZZ(:,:,IKB+KKL) )
!
+#ifndef _OPENACC
ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+#else
+ZTMP1_DEVICE = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP1_DEVICE, ZKEFF)
+#endif
!
! Flags for 3rd order quantities
!
@@ -505,59 +544,157 @@ END IF
!* 4.2 <THl THl>
!
! Compute the turbulent variance F and F' at time t-dt.
+#ifndef _OPENACC
ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,PPHI3*PDTH_DZ**2)
ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+#else
+ !$acc kernels
+ ZTMP1_DEVICE = PPHI3*PDTH_DZ**2
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF (:,:,:) = XCTV*PLM*PLEPS*ZTMP2_DEVICE
+ ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ !$acc end kernels
+#endif
!
! Effect of 3rd order terms in temperature flux (at mass point)
!
! d(w'th'2)/dz
+#ifndef _OPENACC
IF (GFTH2) THEN
ZF = ZF + M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,&
& PSQRT_TKE) * PFTH2
ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
END IF
+#else
+ IF (GFTH2) THEN
+ CALL M3_TH2_WTH2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,PSQRT_TKE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTH2
+ !$acc end kernels
+ CALL D_M3_TH2_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * PFTH2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2th')/dz
+#ifndef _OPENACC
IF (GFWTH) THEN
ZF = ZF + M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTH_DZ,&
& PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWTH)
ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
& PLM,PLEPS,PTKEM,GUSERV) * MZF(KKA,KKU,KKL,PFWTH)
END IF
+#else
+ IF (GFWTH) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWTH,ZTMP1_DEVICE)
+ CALL M3_TH2_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PDTH_DZ,&
+ & PLM,PLEPS,PTKEM,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_TH2_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,GUSERV,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
IF (KRR/=0) THEN
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFR2) THEN
ZF = ZF + M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
& PEMOIST,PDTH_DZ) * PFR2
ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
END IF
+#else
+ IF (GFR2) THEN
+ CALL M3_TH2_WR2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ CALL D_M3_TH2_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * PFR2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWR) THEN
ZF = ZF + M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
& PEMOIST,PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
& PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
END IF
+#else
+ IF (GFWR) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWR,ZTMP1_DEVICE)
+ CALL M3_TH2_W2R(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,PBLL_O_E,&
+ & PEMOIST,PDTH_DZ,ZTMP2_DEVICE)
+ CALL D_M3_TH2_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP3_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP3_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'th'r')/dz
+#ifndef _OPENACC
IF (GFTHR) THEN
ZF = ZF + M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
ZDFDDTDZ = ZDFDDTDZ + D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFTHR
END IF
+#else
+ IF (GFTHR) THEN
+ CALL M3_TH2_WTHR(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTHR
+ !$acc end kernels
+ CALL D_M3_TH2_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * PFTHR
+ !$acc end kernels
+ END IF
+#endif
END IF
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = ZF &
! + PIMPL * XCTV*PLM*PLEPS &
! *MZF(KKA,KKU,KKL,D_PHI3DTDZ2_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,PDTH_DZ,HTURBDIM,GUSERV) &
! *DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ ) &
+ PIMPL * ZDFDDTDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ )
+#else
+ ZTMP1_DEVICE = PTHLP - PTHLM
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ ZTMP3_DEVICE = ZTMP2_DEVICE / PDZZ
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE )
+
+!$acc kernels
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * ZDFDDTDZ * ZTMP4_DEVICE
+#endif
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = XCTV * PPHI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
@@ -579,10 +716,12 @@ END IF
IF (KRRL > 0) THEN
PSIGS(:,:,:) = ZFLXZ(:,:,:) * PATHETA(:,:,:)**2
END IF
+!$acc end kernels
!
!
! stores <THl THl>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
YRECFM ='THL_VVAR'
YCOMMENT='X_Y_Z_THL_VVAR (KELVIN**2)'
IGRID = 1
@@ -594,11 +733,40 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_Thl2 )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Thl2 )
CALL LES_MEAN_SUBGRID( PETHETA*ZFLXZ, X_LES_SUBGRID_ThlThv )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_Thl2,X_LES_RES_W_SBG_Thl2,X_LES_SUBGRID_DISS_Thl2, &
+!$acc & X_LES_SUBGRID_ThlThv,X_LES_SUBGRID_ThlPz)
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Thl2 )
+ !
+ CALL MZF_DEVICE(KKA,KKU,KKL,PWM,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_Thl2 )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_DISS_Thl2 )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = PETHETA*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlThv )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -XA3*PBETA*PETHETA*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlPz, .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -609,13 +777,24 @@ END IF
!
!
! Compute the turbulent variance F and F' at time t-dt.
+#ifndef _OPENACC
ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ)
+#else
+!$acc kernels
+ ZTMP1_DEVICE = 0.5*(PPHI3+PPSI3)*PDTH_DZ*PDR_DZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZF (:,:,:) = XCTV*PLM*PLEPS*ZTMP2_DEVICE
+#endif
ZDFDDTDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+!$acc end kernels
!
! Effect of 3rd order terms in temperature flux (at mass point)
!
! d(w'th'2)/dz
+#ifndef _OPENACC
IF (GFTH2) THEN
ZF = ZF + M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
@@ -624,8 +803,28 @@ END IF
ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA) * PFTH2
END IF
+#else
+ IF (GFTH2) THEN
+ CALL M3_THR_WTH2(KKA,KKU,KKL,PREDR1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTH2
+ !$acc end kernels
+ CALL D_M3_THR_WTH2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * PFTH2
+ !$acc end kernels
+ CALL D_M3_THR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFTH2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2th')/dz
+#ifndef _OPENACC
IF (GFWTH) THEN
ZF = ZF + M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKEM,&
& PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
@@ -634,8 +833,29 @@ END IF
ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWTH)
END IF
+#else
+ IF (GFWTH) THEN
+ CALL M3_THR_W2TH(KKA,KKU,KKL,PREDR1,PD,PLM,PLEPS,PTKEM,&
+ & PDR_DZ,ZTMP1_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWTH,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL D_M3_THR_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PDR_DZ,PETHETA,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL D_M3_THR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLM,PLEPS,PTKEM,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFR2) THEN
ZF = ZF + M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
@@ -644,8 +864,28 @@ END IF
ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
& PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ) * PFR2
END IF
+#else
+ IF (GFR2) THEN
+ CALL M3_THR_WR2(KKA,KKU,KKL,PREDTH1,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ CALL D_M3_THR_WR2_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ CALL D_M3_THR_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ & PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWR) THEN
ZF = ZF + M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKEM,&
& PDTH_DZ) * MZF(KKA,KKU,KKL,PFWR)
@@ -654,8 +894,29 @@ END IF
ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
& PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST) * MZF(KKA,KKU,KKL,PFWR)
END IF
+#else
+ IF (GFWR) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWR,ZTMP1_DEVICE)
+ CALL M3_THR_W2R(KKA,KKU,KKL,PREDTH1,PD,PLM,PLEPS,PTKEM,&
+ & PDTH_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_THR_W2R_O_DDTDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_THR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ & PLM,PLEPS,PTKEM,PBLL_O_E,PDTH_DZ,PEMOIST,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'th'r')/dz
+#ifndef _OPENACC
IF (GFTHR) THEN
ZF = ZF + M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,&
& PSQRT_TKE) * PFTHR
@@ -664,7 +925,27 @@ END IF
ZDFDDRDZ = ZDFDDRDZ + D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFTHR
END IF
+#else
+ IF (GFTHR) THEN
+ CALL M3_THR_WTHR(KKA,KKU,KKL,PREDTH1,PREDR1,PD,PLEPS,&
+ & PSQRT_TKE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTHR
+ !$acc end kernels
+ CALL D_M3_THR_WTHR_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * PFTHR
+ !$acc end kernels
+ CALL D_M3_THR_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFTHR
+ !$acc end kernels
+ END IF
+#endif
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = ZF &
+ PIMPL * XCTV*PLM*PLEPS*0.5 &
* MZF(KKA,KKU,KKL, ( D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV) & ! d(phi3*dthdz)/ddthdz term
@@ -676,6 +957,52 @@ END IF
) &
+ PIMPL * ZDFDDTDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PTHLP - PTHLM(:,:,:)) / PDZZ ) &
+ PIMPL * ZDFDDRDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ )
+#else
+ !$acc kernels
+ ZTMP1_DEVICE = PTHLP - PTHLM
+ ZTMP2_DEVICE = PRP - PRM(:,:,:,1)
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP3_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP3_DEVICE / PDZZ
+ ZTMP2_DEVICE = ZTMP4_DEVICE / PDZZ
+ !$acc end kernels
+ CALL D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV,ZTMP3_DEVICE) ! d(phi3*dthdz)/ddthdz term
+ CALL D_PSI3DTDZ_O_DDTDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV,ZTMP4_DEVICE) ! d(psi3*dthdz)/ddthdz term
+ CALL D_PHI3DRDZ_O_DDRDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV,ZTMP5_DEVICE) ! d(phi3*drdz )/ddrdz term
+ CALL D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV,ZTMP6_DEVICE) ! d(psi3*drdz )/ddrdz term
+ !$acc kernels
+ ZTMP1_DEVICE = PTHLP - PTHLM
+ ZTMP8_DEVICE = PRP - PRM(:,:,:,1)
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP8_DEVICE,ZTMP1_DEVICE)
+ !!!
+ !$acc kernels
+ ZTMP7_DEVICE = (ZTMP3_DEVICE +ZTMP4_DEVICE) *PDR_DZ *ZTMP2_DEVICE / PDZZ + (ZTMP5_DEVICE+ZTMP6_DEVICE) *PDTH_DZ *ZTMP1_DEVICE / PDZZ
+ !$acc end kernels
+ !!!
+ !$acc kernels
+ ZTMP1_DEVICE = PTHLP - PTHLM
+ ZTMP2_DEVICE = PRP - PRM(:,:,:,1)
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP3_DEVICE)
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP4_DEVICE)
+ !$acc kernels
+ ZTMP1_DEVICE = ZTMP3_DEVICE / PDZZ
+ ZTMP2_DEVICE = ZTMP4_DEVICE /PDZZ
+ !$acc end kernels
+ !!!
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP7_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE, ZTMP4_DEVICE )
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE, ZTMP5_DEVICE )
+ !$acc kernels
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * XCTV*PLM*PLEPS*0.5 * ZTMP3_DEVICE &
+ + PIMPL * ZDFDDTDZ * ZTMP4_DEVICE &
+ + PIMPL * ZDFDDRDZ * ZTMP5_DEVICE
+#endif
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = &
@@ -702,8 +1029,10 @@ END IF
PSIGS(:,:,:) = PSIGS(:,:,:) + &
2. * PATHETA(:,:,:) * PAMOIST(:,:,:) * ZFLXZ(:,:,:)
END IF
+!$acc end kernels
! stores <THl Rnp>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
YRECFM ='THLRCONS_VCOR'
YCOMMENT='X_Y_Z_THLRCONS_VCOR (KELVIN*KG/KG)'
IGRID = 1
@@ -715,6 +1044,7 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_ThlRt )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_ThlRt )
@@ -722,6 +1052,45 @@ END IF
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PETHETA*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlThv , .TRUE. )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_ThlPz, .TRUE. )
+#else
+!$acc data copy(X_LES_SUBGRID_THlRt,X_LES_RES_W_SBG_ThlRt,X_LES_SUBGRID_DISS_ThlRt, &
+!$acc & X_LES_SUBGRID_RtThv,X_LES_SUBGRID_RtPz,X_LES_SUBGRID_ThlThv,X_LES_SUBGRID_ThlPz)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_THlRt )
+ !
+ CALL MZF_DEVICE(KKA,KKU,KKL,PWM,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_ThlRt )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_DISS_ThlRt )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = PETHETA*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtThv )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -XA3*PBETA*PETHETA*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtPz, .TRUE. )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = PEMOIST*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlThv , .TRUE. )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = -XA3*PBETA*PEMOIST*ZFLXZ
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_ThlPz, .TRUE. )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -731,59 +1100,166 @@ END IF
!
!
! Compute the turbulent variance F and F' at time t-dt.
+#ifndef _OPENACC
ZF (:,:,:) = XCTV*PLM*PLEPS*MZF(KKA,KKU,KKL,PPSI3*PDR_DZ**2)
+#else
+ !$acc kernels
+ ZTMP1_DEVICE = PPSI3*PDR_DZ**2
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF (:,:,:) = XCTV*PLM*PLEPS*ZTMP2_DEVICE
+#endif
ZDFDDRDZ(:,:,:) = 0. ! this term, because of discretization, is treated separately
+ !$acc end kernels
!
! Effect of 3rd order terms in temperature flux (at mass point)
!
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFR2) THEN
ZF = ZF + M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,&
& PSQRT_TKE) * PFR2
ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST) * PFR2
END IF
+#else
+ IF (GFR2) THEN
+ CALL M3_R2_WR2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ CALL D_M3_R2_WR2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PEMOIST,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFR2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWR) THEN
ZF = ZF + M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDR_DZ,&
& PLM,PLEPS,PTKEM) * MZF(KKA,KKU,KKL,PFWR)
ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,PLM,PLEPS,PTKEM,GUSERV) * MZF(KKA,KKU,KKL,PFWR)
END IF
+#else
+ IF (GFWR) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWR,ZTMP1_DEVICE)
+ CALL M3_R2_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,PDR_DZ,&
+ & PLM,PLEPS,PTKEM,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_R2_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,GUSERV,ZTMP3_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP3_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
IF (KRR/=0) THEN
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFTH2) THEN
ZF = ZF + M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,&
& PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,&
& PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTH2
END IF
+#else
+ IF (GFTH2) THEN
+ CALL M3_R2_WTH2(KKA,KKU,KKL,PD,PLEPS,PSQRT_TKE,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTH2
+ !$acc end kernels
+ CALL D_M3_R2_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,&
+ & PREDTH1,PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP2_DEVICE * PFTH2
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWTH) THEN
ZF = ZF + M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,&
& PBLL_O_E,PETHETA,PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * MZF(KKA,KKU,KKL,PFWTH)
END IF
+#else
+ IF (GFWTH) THEN
+ CALL MZF_DEVICE(KKA,KKU,KKL,PFWTH,ZTMP1_DEVICE)
+ CALL M3_R2_W2TH(KKA,KKU,KKL,PD,PLM,PLEPS,PTKEM,&
+ & PBLL_O_E,PETHETA,PDR_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_R2_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,PLM,PLEPS,PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZTMP3_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP3_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'th'r')/dz
+#ifndef _OPENACC
IF (GFTHR) THEN
ZF = ZF + M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,&
& PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
ZDFDDRDZ = ZDFDDRDZ + D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ) * PFTHR
END IF
+#else
+ IF (GFTHR) THEN
+ CALL M3_R2_WTHR(KKA,KKU,KKL,PREDTH1,PD,PLEPS,&
+ & PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFTHR
+ !$acc end kernels
+ CALL D_M3_R2_WTHR_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,PLEPS,PSQRT_TKE,PBLL_O_E,PETHETA,PDR_DZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP2_DEVICE * PFTHR
+ !$acc end kernels
+ END IF
+#endif
END IF
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = ZF &
+ PIMPL * XCTV*PLM*PLEPS &
*MZF(KKA,KKU,KKL,D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV) &
*DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ ) &
+ PIMPL * ZDFDDRDZ * MZF(KKA,KKU,KKL,DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ )
+#else
+ CALL D_PSI3DRDZ2_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,PDR_DZ,HTURBDIM,GUSERV,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = PRP - PRM(:,:,:,1)
+ !$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZTMP3_DEVICE / PDZZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP3_DEVICE / PDZZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ !$acc kernels
+ ZFLXZ(:,:,:) = ZF &
+ + PIMPL * XCTV*PLM*PLEPS * ZTMP1_DEVICE &
+ + PIMPL * ZDFDDRDZ * ZTMP3_DEVICE
+#endif
!
! special case near the ground ( uncentred gradient )
ZFLXZ(:,:,IKB) = XCHV * PPSI3(:,:,IKB+KKL) * PLM(:,:,IKB) &
@@ -803,8 +1279,10 @@ END IF
IF ( KRRL > 0 ) THEN
PSIGS(:,:,:) = PSIGS(:,:,:) + PAMOIST(:,:,:) **2 * ZFLXZ(:,:,:)
END IF
+!$acc end kernels
! stores <Rnp Rnp>
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
YRECFM ='RTOT_VVAR'
YCOMMENT='X_Y_Z_RTOT_VVAR (KG/KG **2)'
IGRID = 1
@@ -816,11 +1294,33 @@ END IF
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM)*ZFLXZ, X_LES_RES_W_SBG_Rt2 )
CALL LES_MEAN_SUBGRID( PEMOIST*ZFLXZ, X_LES_SUBGRID_RtThv , .TRUE. )
CALL LES_MEAN_SUBGRID( -XA3*PBETA*PEMOIST*ZFLXZ, X_LES_SUBGRID_RtPz, .TRUE. )
CALL LES_MEAN_SUBGRID( -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS, X_LES_SUBGRID_DISS_Rt2 )
+#else
+!$acc data copy(X_LES_SUBGRID_Rt2,X_LES_RES_W_SBG_Rt2,X_LES_SUBGRID_RtThv, &
+!$acc & X_LES_SUBGRID_RtPz,X_LES_SUBGRID_DISS_Rt2)
+ !
+ CALL LES_MEAN_SUBGRID( ZFLXZ, X_LES_SUBGRID_Rt2 )
+ !
+ CALL MZF_DEVICE(KKA,KKU,KKL,PWM,ZTMP1_DEVICE)
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLXZ
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_W_SBG_Rt2 )
+ !
+ ZTMP1_DEVICE = PEMOIST*ZFLXZ
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtThv , .TRUE. )
+ !
+ ZTMP1_DEVICE = -XA3*PBETA*PEMOIST*ZFLXZ
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_RtPz, .TRUE. )
+ !
+ ZTMP1_DEVICE = -2.*XCTD*PSQRT_TKE*ZFLXZ/PLEPS
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_DISS_Rt2 )
+ !
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -832,9 +1332,11 @@ END IF
!
IF ( KRRL > 0 ) THEN
! Extrapolate PSIGS at the ground and at the top
+ !$acc kernels
PSIGS(:,:,KKA) = PSIGS(:,:,IKB)
PSIGS(:,:,KKU) = PSIGS(:,:,IKE)
PSIGS(:,:,:) = SQRT( MAX (PSIGS(:,:,:) , 1.E-12) )
+ !$acc end kernels
END IF
!
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 73c97baafcbea768520bf1e187c5e912883b9c64..19f671a979cdcd8afc66fb227516be6a04b2c93d 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -117,6 +117,17 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Dynamic and thermal
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFTHP,PSFRP, &
+!$acc & PWM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+!$acc & PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+!$acc & PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+!$acc & PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
!
END SUBROUTINE TURB_VER_THERMO_FLUX
!
@@ -329,6 +340,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! change of YCOMMENT
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -344,11 +356,14 @@ USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
-USE MODI_SHUMAN
+#ifndef _OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
USE MODI_TRIDIAG
USE MODE_FMWRIT
USE MODI_LES_MEAN_SUBGRID
-USE MODI_PRANDTL
USE MODI_TRIDIAG_THERMO
USE MODI_TM06_H
!
@@ -449,6 +464,17 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT):: PTP ! Dynamic and thermal
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTH ! heat flux
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWRC ! cloud water flux
!
+!$acc declare present(PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
+!$acc & PRHODJ,PTHVREF, &
+!$acc & PSFTHM,PSFRM,PSFTHP,PSFRP, &
+!$acc & PWM,PTHLM,PRM,PSVM, &
+!$acc & PTKEM,PLM,PLEPS, &
+!$acc & PLOCPEXNM,PATHETA,PAMOIST,PSRCM,PFRAC_ICE, &
+!$acc & PBETA, PSQRT_TKE, PDTH_DZ, PDR_DZ, PRED2TH3, &
+!$acc & PRED2R3, PRED2THR3, PBLL_O_E, PETHETA, &
+!$acc & PEMOIST, PREDTH1, PREDR1, PPHI3, PPSI3, PD, &
+!$acc & PFWTH,PFWR,PFTH2,PFR2,PFTHR,PBL_DEPTH, &
+!$acc & PWTHV,PRTHLS,PRRS,PTHLP,PRP,PTP,PWTH,PWRC )
!
!* 0.2 declaration of local variables
!
@@ -462,6 +488,7 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZDFDDTDZ, & ! dF/d(dTh/dz)
ZDFDDRDZ, & ! dF/d(dr/dz)
Z3RDMOMENT ! 3 order term in flux or variance equation
+!$acc declare create(ZA,ZFLXZ,ZSOURCE,ZKEFF,ZF,ZDFDDTDZ,ZDFDDRDZ,Z3RDMOMENT)
INTEGER :: IRESP ! Return code of FM routines
INTEGER :: IGRID ! C-grid indicator in LFIFM file
INTEGER :: ILENCH ! Length of comment string in LFIFM file
@@ -481,6 +508,11 @@ LOGICAL :: GFWTH ! flag to use w'2th'
LOGICAL :: GFR2 ! flag to use w'r'2
LOGICAL :: GFWR ! flag to use w'2r'
LOGICAL :: GFTHR ! flag to use w'th'r'
+!
+#ifdef _OPENACC
+REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
+!$acc declare create(ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE)
+#endif
!----------------------------------------------------------------------------
!
!* 1. PRELIMINARIES
@@ -497,7 +529,14 @@ GUSERV = (KRR/=0)
! compute the coefficients for the uncentred gradient computation near the
! ground
!
+#ifndef _OPENACC
ZKEFF(:,:,:) = MZM(KKA,KKU,KKL, PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
+#else
+!$acc kernels
+ZTMP1_DEVICE = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
+!$acc end kernels
+CALL MZM_DEVICE(ZTMP1_DEVICE, ZKEFF)
+#endif
!
! Flags for 3rd order quantities
!
@@ -524,13 +563,25 @@ END IF
!
! Compute the turbulent flux F and F' at time t-dt.
!
+#ifndef _OPENACC
ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(KKA,KKU,KKL,PTHLM)/PDZZ
ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
-
+#else
+CALL DZM_DEVICE(KKA,KKU,KKL,PTHLM,ZTMP1_DEVICE)
+!$acc kernels
+ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*ZTMP1_DEVICE/PDZZ
+!$acc end kernels
+!
+CALL D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV,ZTMP2_DEVICE)
+!$acc kernels
+ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*ZTMP2_DEVICE
+!$acc end kernels
+#endif
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2th')/dz
+#ifndef _OPENACC
IF (GFWTH) THEN
Z3RDMOMENT= M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM)
!
@@ -538,8 +589,23 @@ IF (GFWTH) THEN
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM) * PFWTH
END IF
+#else
+IF (GFWTH) THEN
+ CALL M3_WTH_W2TH(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+!
+!$acc kernels
+ ZF = ZF + Z3RDMOMENT * PFWTH
+!$acc end kernels
+ CALL D_M3_WTH_W2TH_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA,ZKEFF,PTKEM,ZTMP1_DEVICE)
+!$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * PFWTH
+!$acc end kernels
+END IF
+#endif
!
! d(w'th'2)/dz
+#ifndef _OPENACC
IF (GFTH2) THEN
Z3RDMOMENT= M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA)
!
@@ -547,32 +613,96 @@ IF (GFTH2) THEN
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
& PD,PBLL_O_E,PETHETA) * MZM(KKA,KKU,KKL,PFTH2)
END IF
+#else
+IF (GFTH2) THEN
+ CALL M3_WTH_WTH2(PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,Z3RDMOMENT)
+!
+ CALL MZM_DEVICE(PFTH2,ZTMP1_DEVICE)
+!$acc kernels
+ ZF = ZF + Z3RDMOMENT * ZTMP1_DEVICE
+!$acc end kernels
+ CALL D_M3_WTH_WTH2_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,&
+ & PD,PBLL_O_E,PETHETA,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PFTH2,ZTMP2_DEVICE)
+!$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+END IF
+#endif
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWR) THEN
ZF = ZF + M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ) * PFWR
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST) * PFWR
END IF
+#else
+IF (GFWR) THEN
+ CALL M3_WTH_W2R(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,&
+ & PTKEM,PBLL_O_E,PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+!$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFWR
+!$acc end kernels
+ CALL D_M3_WTH_W2R_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,&
+ & PD,ZKEFF,PTKEM,PBLL_O_E,PEMOIST,ZTMP2_DEVICE)
+!$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP2_DEVICE * PFWR
+!$acc end kernels
+END IF
+#endif
!
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFR2) THEN
ZF = ZF + M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,&
& PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ) * MZM(KKA,KKU,KKL,PFR2)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
& ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST) * MZM(KKA,KKU,KKL,PFR2)
END IF
+#else
+IF (GFR2) THEN
+ CALL M3_WTH_WR2(KKA,KKU,KKL,PREDTH1,PREDR1,PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,PDTH_DZ,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PFR2,ZTMP2_DEVICE)
+!$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+ CALL D_M3_WTH_WR2_O_DDTDZ(KKA,KKU,KKL,PREDTH1,PREDR1,PD,&
+ & ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PEMOIST,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PFR2,ZTMP2_DEVICE)
+!$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+END IF
+#endif
!
! d(w'th'r')/dz
+#ifndef _OPENACC
IF (GFTHR) THEN
- Z3RDMOMENT= M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
- & PLEPS,PEMOIST)
+ Z3RDMOMENT= M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,PLEPS,PEMOIST)
!
ZF = ZF + Z3RDMOMENT * MZM(KKA,KKU,KKL,PFTHR)
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
& PREDR1,PD,PBLL_O_E,PETHETA) * MZM(KKA,KKU,KKL,PFTHR)
END IF
+#else
+IF (GFTHR) THEN
+ CALL M3_WTH_WTHR(KKA,KKU,KKL,PREDR1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PEMOIST,Z3RDMOMENT)
+!
+ CALL MZM_DEVICE(PFTHR,ZTMP1_DEVICE)
+!$acc kernels
+ ZF = ZF + Z3RDMOMENT * ZTMP1_DEVICE
+!$acc end kernels
+ CALL D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,PREDR1,PD,PBLL_O_E,PETHETA,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PFTHR,ZTMP2_DEVICE)
+!$acc kernels
+ ZDFDDTDZ = ZDFDDTDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+END IF
+#endif
!
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
! (in presence of slopes)
@@ -580,13 +710,17 @@ END IF
! is taken into account in the vertical part
!
IF (HTURBDIM=='3DIM') THEN
+!$acc kernels
ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
* PDIRCOSZW(:,:) &
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
ELSE
+!$acc kernels
ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
/ PDIRCOSZW(:,:) &
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
END IF
!
! Compute the splitted conservative potential temperature at t+deltat
@@ -594,15 +728,26 @@ CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
PRHODJ,PTHLP)
!
! Compute the equivalent tendency for the conservative potential temperature
+!$acc kernels
PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+!$acc end kernels
!
!* 2.2 Partial Thermal Production
!
! Conservative potential temperature flux :
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDTDZ * DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ
+ + PIMPL * ZDFDDTDZ * DZM(KKA,KKU,KKL,PTHLP - PTHLM) / PDZZ
+#else
+!$acc kernels
+ZTMP1_DEVICE = PTHLP - PTHLM
+!$acc end kernels
+CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ZFLXZ(:,:,:) = ZF + PIMPL * ZDFDDTDZ * ZTMP2_DEVICE / PDZZ
+#endif
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
@@ -612,9 +757,10 @@ ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
-
-
+!$acc end kernels
+!
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
! stores the conservative potential temperature vertical flux
YRECFM ='THW_FLX'
YCOMMENT='X_Y_Z_THW_FLX (K*M/S)'
@@ -624,6 +770,7 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
+#ifndef _OPENACC
IF (KRR /= 0) THEN
PTP(:,:,:) = PBETA * MZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PETHETA) * ZFLXZ )
PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
@@ -631,14 +778,41 @@ IF (KRR /= 0) THEN
ELSE
PTP(:,:,:)= PBETA * MZF(KKA,KKU,KKL, ZFLXZ )
END IF
+#else
+IF (KRR /= 0) THEN
+ CALL MZM_DEVICE(PETHETA,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLXZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE,ZTMP3_DEVICE)
+!$acc kernels
+ PTP(:,:,:) = PBETA * ZTMP3_DEVICE
+ PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+!$acc end kernels
+ELSE
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZFLXZ,ZTMP1_DEVICE)
+!$acc kernels
+ PTP(:,:,:)= PBETA * ZTMP1_DEVICE
+!$acc end kernels
+END IF
+#endif
!
! Buoyancy flux at flux points
!
+#ifndef _OPENACC
PWTHV = MZM(KKA,KKU,KKL,PETHETA) * ZFLXZ
+#else
+CALL MZM_DEVICE(PETHETA,ZTMP1_DEVICE)
+!$acc kernels
+PWTHV = ZTMP1_DEVICE * ZFLXZ
+#endif
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
+!$acc end kernels
!
!* 2.3 Partial vertical divergence of the < Rc w > flux
!
+#ifndef _OPENACC
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
@@ -652,11 +826,42 @@ IF ( KRRL >= 1 ) THEN
DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ )
END IF
END IF
+#else
+IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+!$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*2.*PSRCM
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLXZ/PDZZ
+!$acc end kernels
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE,ZTMP3_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP3_DEVICE * (1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP3_DEVICE * PFRAC_ICE(:,:,:)
+!$acc end kernels
+ ELSE
+!$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PATHETA*2.*PSRCM
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
+!$acc kernels
+ ZTMP1_DEVICE = ZTMP2_DEVICE*ZFLXZ/PDZZ
+!$acc end kernels
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE,ZTMP3_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP3_DEVICE
+!$acc end kernels
+ END IF
+END IF
+#endif
!
!* 2.4 Storage in LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WThl )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
CALL LES_MEAN_SUBGRID( GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)*MZF(KKA,KKU,KKL,ZFLXZ),&
@@ -674,7 +879,60 @@ IF (LLES_CALL) THEN
ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
ZA = MZF(KKA,KKU,KKL, ZA )
ZA = MIN(MAX(ZA,-1000.),1000.)
+ CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
+#else
+!$acc data copy(X_LES_SUBGRID_WThl,X_LES_RES_W_SBG_WThl,X_LES_RES_ddxa_W_SBG_UaThl,X_LES_RES_ddxa_Thl_SBG_UaThl,&
+!$acc & X_LES_SUBGRID_ThlPz,X_LES_SUBGRID_WThv,X_LES_RES_ddxa_Rt_SBG_UaThl,X_LES_SUBGRID_Kh)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ, ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_WThl )
+!$acc kernels
+ ZTMP1_DEVICE = PWM*ZFLXZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE, ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_RES_W_SBG_WThl )
+ CALL GZ_W_M_DEVICE(KKA,KKU,KKL,PWM,PDZZ,ZTMP1_DEVICE )
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP1_DEVICE * ZTMP2_DEVICE
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_W_SBG_UaThl )
+!$acc kernels
+ ZTMP1_DEVICE = PDTH_DZ*ZFLXZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaThl )
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = -XCTP*PSQRT_TKE/PLM*ZTMP1_DEVICE
+!$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_ThlPz )
+ CALL MZM_DEVICE(PETHETA,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE*ZFLXZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_SUBGRID_WThv )
+ IF (KRR>=1) THEN
+!$acc kernels
+ ZTMP1_DEVICE = PDR_DZ*ZFLXZ
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaThl )
+ END IF
+ !* diagnostic of mixing coefficient for heat
+ CALL DZM_DEVICE(KKA,KKU,KKL,PTHLP,ZA)
+!$acc kernels
+ WHERE (ZA==0.) ZA=1.E-6
+ ZA = - ZFLXZ / ZA * PDZZ
+ ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZA, ZA )
+!$acc kernels
+ ZA = MIN(MAX(ZA,-1000.),1000.)
+!$acc end kernels
CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
+!$acc end data
+#endif
!
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
@@ -697,12 +955,25 @@ IF (HTOM=='TM06') CALL TM06_H(IKB,IKTB,IKTE,PTSTEP,PZZ,ZFLXZ,PBL_DEPTH)
IF (KRR /= 0) THEN
! Compute the turbulent flux F and F' at time t-dt.
!
+#ifndef _OPENACC
ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(KKA,KKU,KKL,PRM(:,:,:,1))/PDZZ
ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
+#else
+ CALL DZM_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),ZTMP1_DEVICE)
+ !$acc kernels
+ ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*ZTMP1_DEVICE/PDZZ
+ !$acc end kernels
+ CALL D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV,ZTMP1_DEVICE)
+!CALL D_PHI3DRDZ_O_DDRDZ_DEVICE(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*ZTMP1_DEVICE
+ !$acc end kernels
+#endif
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2r')/dz
+#ifndef _OPENACC
IF (GFWR) THEN
Z3RDMOMENT= M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM)
!
@@ -710,8 +981,23 @@ IF (KRR /= 0) THEN
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
& PBLL_O_E,PEMOIST,ZKEFF,PTKEM) * PFWR
END IF
+#else
+ IF (GFWR) THEN
+ CALL M3_WR_W2R(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,Z3RDMOMENT)
+ !
+ !$acc kernels
+ ZF = ZF + Z3RDMOMENT * PFWR
+ !$acc end kernels
+ CALL D_M3_WR_W2R_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ & PBLL_O_E,PEMOIST,ZKEFF,PTKEM,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFWR
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'r'2)/dz
+#ifndef _OPENACC
IF (GFR2) THEN
Z3RDMOMENT= M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST)
!
@@ -719,24 +1005,71 @@ IF (KRR /= 0) THEN
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
& PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(KKA,KKU,KKL,PFR2)
END IF
+#else
+ IF (GFR2) THEN
+ CALL M3_WR_WR2(PREDR1,PREDTH1,PD,PBLL_O_E,PEMOIST,Z3RDMOMENT)
+ !
+ CALL MZM_DEVICE(PFR2,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + Z3RDMOMENT * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_WR_WR2_O_DDRDZ(Z3RDMOMENT,PREDR1,&
+ & PREDTH1,PD,PBLL_O_E,PEMOIST,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'2th')/dz
+#ifndef _OPENACC
IF (GFWTH) THEN
ZF = ZF + M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,&
& PTKEM,PBLL_O_E,PETHETA,PDR_DZ) * PFWTH
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
& PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA) * PFWTH
END IF
+#else
+ IF (GFWTH) THEN
+ CALL M3_WR_W2TH(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,&
+ & PTKEM,PBLL_O_E,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * PFWTH
+ !$acc end kernels
+ CALL D_M3_WR_W2TH_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,&
+ & PD,ZKEFF,PTKEM,PBLL_O_E,PETHETA,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * PFWTH
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'th'2)/dz
+#ifndef _OPENACC
IF (GFTH2) THEN
ZF = ZF + M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,&
& PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ) * MZM(KKA,KKU,KKL,PFTH2)
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
&ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA) * MZM(KKA,KKU,KKL,PFTH2)
END IF
+#else
+ IF (GFTH2) THEN
+ CALL M3_WR_WTH2(KKA,KKU,KKL,PREDR1,PREDTH1,PD,ZKEFF,PTKEM,&
+ & PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,PDR_DZ,ZTMP1_DEVICE)
+ CALL MZM_DEVICE(PFTH2,ZTMP2_DEVICE)
+ !$acc kernels
+ ZF = ZF + ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ CALL D_M3_WR_WTH2_O_DDRDZ(KKA,KKU,KKL,PREDR1,PREDTH1,PD,&
+ &ZKEFF,PTKEM,PSQRT_TKE,PBLL_O_E,PBETA,PLEPS,PETHETA,ZTMP1_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP1_DEVICE * ZTMP2_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
! d(w'th'r')/dz
+#ifndef _OPENACC
IF (GFTHR) THEN
Z3RDMOMENT= M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
& PLEPS,PETHETA)
@@ -745,6 +1078,22 @@ IF (KRR /= 0) THEN
ZDFDDRDZ = ZDFDDRDZ + D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,Z3RDMOMENT,PREDR1, &
& PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(KKA,KKU,KKL,PFTHR)
END IF
+#else
+ IF (GFTHR) THEN
+ CALL M3_WR_WTHR(KKA,KKU,KKL,PREDTH1,PD,ZKEFF,PTKEM,PSQRT_TKE,PBETA,&
+ & PLEPS,PETHETA,Z3RDMOMENT)
+ !
+ CALL MZM_DEVICE(PFTHR,ZTMP1_DEVICE)
+ !$acc kernels
+ ZF = ZF + Z3RDMOMENT * ZTMP1_DEVICE
+ !$acc end kernels
+ CALL D_M3_WR_WTHR_O_DDRDZ(KKA,KKU,KKL,Z3RDMOMENT,PREDR1, &
+ & PREDTH1,PD,PBLL_O_E,PEMOIST,ZTMP2_DEVICE)
+ !$acc kernels
+ ZDFDDRDZ = ZDFDDRDZ + ZTMP2_DEVICE * ZTMP1_DEVICE
+ !$acc end kernels
+ END IF
+#endif
!
!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
! (in presence of slopes)
@@ -752,13 +1101,17 @@ IF (KRR /= 0) THEN
! is taken into account in the vertical part
!
IF (HTURBDIM=='3DIM') THEN
+!$acc kernels
ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
* PDIRCOSZW(:,:) &
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
ELSE
+!$acc kernels
ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
/ PDIRCOSZW(:,:) &
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
END IF
!
! Compute the splitted conservative potential temperature at t+deltat
@@ -766,16 +1119,29 @@ IF (KRR /= 0) THEN
PDZZ,PRHODJ,PRP)
!
! Compute the equivalent tendency for the conservative mixing ratio
+!$acc kernels
PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRHODJ(:,:,:) * &
(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+!$acc end kernels
!
!* 3.2 Complete thermal production
!
! cons. mixing ratio flux :
!
+#ifndef _OPENACC
ZFLXZ(:,:,:) = ZF &
- + PIMPL * ZDFDDRDZ * DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ
+ + PIMPL * ZDFDDRDZ * DZM(KKA,KKU,KKL,PRP - PRM(:,:,:,1)) / PDZZ
+#else
+!$acc kernels
+ ZTMP1_DEVICE = PRP - PRM(:,:,:,1)
+!$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZFLXZ(:,:,:) = ZF + PIMPL * ZDFDDRDZ *ZTMP2_DEVICE / PDZZ
+!$acc end kernels
+#endif
!
+!$acc kernels
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
DO JK=IKTB+1,IKTE-1
@@ -784,9 +1150,11 @@ IF (KRR /= 0) THEN
PWRC(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
PWRC(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
PWRC(:,:,IKE)=PWRC(:,:,IKE-KKL)
+!$acc end kernels
!
!
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
! stores the conservative mixing ratio vertical flux
YRECFM ='RCONSW_FLX'
YCOMMENT='X_Y_Z_RCONSW_FLX (KG*M/S/KG)'
@@ -796,18 +1164,37 @@ IF (KRR /= 0) THEN
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
+#ifndef _OPENACC
ZA(:,:,:) = PBETA * MZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL,PEMOIST) * ZFLXZ )
+#else
+ CALL MZM_DEVICE(PEMOIST,ZTMP1_DEVICE)
+ !$acc kernels
+ ZTMP2_DEVICE = ZTMP1_DEVICE * ZFLXZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
+ !$acc kernels
+ ZA(:,:,:) = PBETA * ZTMP3_DEVICE
+#endif
ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+ !$acc end kernels
!
! Buoyancy flux at flux points
!
+#ifndef _OPENACC
PWTHV = PWTHV + MZM(KKA,KKU,KKL,PEMOIST) * ZFLXZ
+#else
+ CALL MZM_DEVICE(PEMOIST,ZTMP1_DEVICE)
+ !$acc kernels
+ PWTHV = PWTHV + ZTMP1_DEVICE * ZFLXZ
+#endif
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
+ !$acc end kernels
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
!
+#ifndef _OPENACC
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
@@ -821,11 +1208,42 @@ IF (KRR /= 0) THEN
DZF(KKA,KKU,KKL, MZM(KKA,KKU,KKL, PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ )
END IF
END IF
+#else
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+!$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PAMOIST*2.*PSRCM
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE )
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLXZ/PDZZ
+!$acc end kernels
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP4_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP4_DEVICE * (1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP4_DEVICE * PFRAC_ICE(:,:,:)
+!$acc end kernels
+ ELSE
+!$acc kernels
+ ZTMP1_DEVICE = PRHODJ*PAMOIST*2.*PSRCM
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE )
+!$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLXZ/PDZZ
+!$acc end kernels
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP4_DEVICE )
+!$acc kernels
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP4_DEVICE
+!$acc end kernels
+ END IF
+ END IF
+#endif
!
!* 3.4 Storage in LES configuration
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WRt )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PWM*ZFLXZ), X_LES_RES_W_SBG_WRt )
CALL LES_MEAN_SUBGRID( GZ_W_M(KKA,KKU,KKL,PWM,PDZZ)*MZF(KKA,KKU,KKL,ZFLXZ),&
@@ -834,6 +1252,52 @@ IF (KRR /= 0) THEN
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaRt )
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,MZM(KKA,KKU,KKL,PEMOIST)*ZFLXZ), X_LES_SUBGRID_WThv , .TRUE. )
CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_RtPz )
+#else
+!$acc data copy(X_LES_SUBGRID_WRt,X_LES_RES_W_SBG_WRt,X_LES_RES_ddxa_W_SBG_UaRt,X_LES_RES_ddxa_Thl_SBG_UaRt,&
+!$acc & X_LES_RES_ddxa_Rt_SBG_UaRt,X_LES_SUBGRID_WThv,X_LES_SUBGRID_RtPz)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_WRt )
+ !
+ !$acc kernels
+ ZTMP2_DEVICE = PWM*ZFLXZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_W_SBG_WRt )
+ !
+ !$acc kernels
+ ZTMP1_DEVICE = PWM*ZFLXZ
+ !$acc end kernels
+ CALL GZ_W_M_DEVICE(KKA,KKU,KKL,PWM,PDZZ,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZTMP1_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_W_SBG_UaRt )
+ !
+ !$acc kernels
+ ZTMP2_DEVICE = PDTH_DZ*ZFLXZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Thl_SBG_UaRt )
+ !
+ !$acc kernels
+ ZTMP2_DEVICE = PDR_DZ*ZFLXZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP3_DEVICE, X_LES_RES_ddxa_Rt_SBG_UaRt )
+ !
+ CALL MZM_DEVICE(PEMOIST,ZTMP2_DEVICE)
+ !$acc kernels
+ ZTMP3_DEVICE = ZTMP2_DEVICE*ZFLXZ
+ !$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZTMP3_DEVICE,ZTMP4_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP4_DEVICE, X_LES_SUBGRID_WThv , .TRUE. )
+ !
+ !$acc kernels
+ ZTMP2_DEVICE = -XCTP*PSQRT_TKE/PLM*ZTMP1_DEVICE
+ !$acc end kernels
+ CALL LES_MEAN_SUBGRID( ZTMP2_DEVICE, X_LES_SUBGRID_RtPz )
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
@@ -852,18 +1316,47 @@ END IF
IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
! recover the Conservative potential temperature flux :
+#ifndef _OPENACC
ZA(:,:,:) = DZM(KKA,KKU,KKL,PIMPL * PTHLP + PEXPL * PTHLM) / PDZZ * &
(-PPHI3*MZM(KKA,KKU,KKL,PLM*PSQRT_TKE)) * XCSHF
- ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:)
+#else
+!$acc kernels
+ ZTMP1_DEVICE = PIMPL * PTHLP + PEXPL * PTHLM
+!$acc end kernels
+ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
+!$acc kernels
+ ZTMP3_DEVICE = PLM*PSQRT_TKE
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP3_DEVICE,ZTMP4_DEVICE)
+!$acc kernels
+ ZA(:,:,:) = ZTMP2_DEVICE / PDZZ * (-PPHI3*ZTMP4_DEVICE) * XCSHF
+#endif
+ ZA(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) * PDIRCOSZW(:,:)
+!$acc end kernels
!
! compute <w Rc>
+#ifndef _OPENACC
ZFLXZ(:,:,:) = MZM(KKA,KKU,KKL, PAMOIST * 2.* PSRCM ) * ZFLXZ(:,:,:) + &
MZM(KKA,KKU,KKL, PATHETA * 2.* PSRCM ) * ZA(:,:,:)
+#else
+ !$acc kernels
+ ZTMP1_DEVICE = PAMOIST * 2.* PSRCM
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE )
+ !$acc kernels
+ ZTMP3_DEVICE =PATHETA * 2.* PSRCM
+ !$acc end kernels
+ CALL MZM_DEVICE(ZTMP3_DEVICE, ZTMP4_DEVICE )
+ !$acc kernels
+ ZFLXZ(:,:,:) = ZTMP2_DEVICE * ZFLXZ(:,:,:) + &
+ ZTMP4_DEVICE * ZA(:,:,:)
+#endif
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+ !$acc end kernels
!
! store the liquid water mixing ratio vertical flux
IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+!$acc update self(ZFLXZ)
YRECFM ='RCW_FLX'
YCOMMENT='X_Y_Z_RCW_FLX (KG*M/S/KG)'
IGRID = 4
@@ -875,7 +1368,14 @@ IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
+#ifndef _OPENACC
CALL LES_MEAN_SUBGRID( MZF(KKA,KKU,KKL,ZFLXZ), X_LES_SUBGRID_WRc )
+#else
+!$acc data copy(X_LES_SUBGRID_WRc)
+ CALL MZF_DEVICE(KKA,KKU,KKL,ZFLXZ,ZTMP1_DEVICE)
+ CALL LES_MEAN_SUBGRID( ZTMP1_DEVICE, X_LES_SUBGRID_WRc )
+!$acc end data
+#endif
CALL SECOND_MNH(ZTIME2)
XTIME_LES = XTIME_LES + ZTIME2 - ZTIME1
END IF
diff --git a/src/MNH/update_lm.f90 b/src/MNH/update_lm.f90
index 5b8310ed7b5c13f672fa81b17dd65bf28827423b..bb3116ab38a9142dd7f8bcb8b77328a997e4dea6 100644
--- a/src/MNH/update_lm.f90
+++ b/src/MNH/update_lm.f90
@@ -19,6 +19,7 @@ CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
+!$acc declare present(PLM,PLEPS)
!
END SUBROUTINE UPDATE_LM
!
@@ -79,6 +80,7 @@ CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y boundary type
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM ! mixing length
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS ! dissipative length
+!$acc declare present(PLM,PLEPS)
!
!* 0.2 declarations of local variables
!
@@ -105,10 +107,12 @@ NULLIFY(TZLM_ll)
!
!
!!$IF(NHALO == 1) THEN
+!$acc update self(PLM,PLEPS)
CALL ADD3DFIELD_ll(TZLM_ll,PLM)
CALL ADD3DFIELD_ll(TZLM_ll,PLEPS)
CALL UPDATE_HALO_ll(TZLM_ll,IINFO_ll)
CALL CLEANLIST_ll(TZLM_ll)
+!$acc update device(PLM,PLEPS)
!!$END IF
!
!-------------------------------------------------------------------------------
@@ -116,6 +120,7 @@ NULLIFY(TZLM_ll)
!* 3. UPDATE EXTERNAL POINTS OF GLOBAL DOMAIN:
! ---------------------------------------
!
+!$acc kernels
IF ( HLBCX(1) /= "CYCL" .AND. LWEST_ll()) THEN
PLM (IIB-1,:,:) = PLM (IIB,:,:)
PLEPS(IIB-1,:,:) = PLEPS(IIB,:,:)
@@ -136,5 +141,6 @@ IF ( HLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
PLEPS(JI,IJE+1,:) = PLEPS(JI,IJE,:)
END DO
END IF
+!$acc end kernels
!-----------------------------------------------------------------------------
END SUBROUTINE UPDATE_LM
diff --git a/src/MNH/update_metrics.f90 b/src/MNH/update_metrics.f90
index a391aab9de57665f3dd0f852780b43738296f4c3..d5af55d7d6a92d79c6cfc1418fe64c92eb92b1d5 100644
--- a/src/MNH/update_metrics.f90
+++ b/src/MNH/update_metrics.f90
@@ -118,7 +118,6 @@ IF ( HLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
PDZY(JI,IJB-1,:) = PDZY(JI,IJB,:)
END DO
END IF
-
!-------------------------------------------------------------------------------
!
!* 2. UPDATE HALOs :
@@ -134,6 +133,6 @@ END IF
CALL UPDATE_HALO_ll(TZMETRICS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZMETRICS_ll)
!!$END IF
-
+!$acc update device (PDXX,PDYY,PDZZ,PDZX,PDZY)
!-----------------------------------------------------------------------------
END SUBROUTINE UPDATE_METRICS
diff --git a/src/MNH/ver_interp_lin.f90 b/src/MNH/ver_interp_lin.f90
index 83c057def4116b0e4058c4dab92f961e28f25bce..ec3434862c884a0f37dd02d29736136b59f4b00f 100644
--- a/src/MNH/ver_interp_lin.f90
+++ b/src/MNH/ver_interp_lin.f90
@@ -62,7 +62,66 @@ END FUNCTION VER_INTERP_LIN1D
!
!
END INTERFACE
+!
+!
+#ifdef _OPENACC
+INTERFACE VER_INTERP_LIN_DEVICE
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN3D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+! third dimension of the arrays is vertical
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+!
+REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)), INTENT(OUT) &
+ :: PVAR2 ! variable values on target
+! ! grid
+END SUBROUTINE VER_INTERP_LIN3D_DEVICE
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN2D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+! second dimension of the arrays is vertical
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+!
+REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)), INTENT(OUT) &
+ :: PVAR2 ! variable values on target
+! ! grid
+END SUBROUTINE VER_INTERP_LIN2D_DEVICE
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN1D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+! first dimension of the arrays is vertical
+!
+REAL, DIMENSION(:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+!
+REAL, DIMENSION(SIZE(KKLIN)), INTENT(OUT) :: PVAR2 ! variable values on target
+! ! grid
+END SUBROUTINE VER_INTERP_LIN1D_DEVICE
+!
+!
+END INTERFACE
+#endif
+!
+!
END MODULE MODI_VER_INTERP_LIN
+!
+!
! ############################
MODULE MODI_VER_INTERP_LIN3D
! ############################
@@ -82,6 +141,7 @@ REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)) &
! ! grid
END FUNCTION VER_INTERP_LIN3D
END INTERFACE
+!
END MODULE MODI_VER_INTERP_LIN3D
! ##############################################
FUNCTION VER_INTERP_LIN3D(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
@@ -155,6 +215,88 @@ END DO
!-------------------------------------------------------------------------------
!
END FUNCTION VER_INTERP_LIN3D
+!
+#ifdef _OPENACC
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN3D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+!!**** *VER_INTERP_LIN_DEVICE* - vertical linear interpolation
+!!
+!! PURPOSE
+!! -------
+! This function interpolates the 3D fields from one grid
+! to another using linear interpolation cofficients stored in module
+! MODD_VER_INTERP_LIN.
+!
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 18/07/97
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+!
+REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2),SIZE(KKLIN,3)), INTENT(OUT) &
+ :: PVAR2 ! variable values on target
+! ! grid
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: JI,JJ,JK2
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: VER_INTERP_LIN3D_DEVICE not yet tested'
+!$acc data present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!$acc kernels
+DO JK2=1,SIZE(KKLIN,3)
+ DO JJ=1,SIZE(KKLIN,2)
+ DO JI=1,SIZE(KKLIN,1)
+ PVAR2(JI,JJ,JK2)= PCOEFLIN(JI,JJ,JK2) *PVAR1(JI,JJ,KKLIN(JI,JJ,JK2) )&
+ +(1.-PCOEFLIN(JI,JJ,JK2))*PVAR1(JI,JJ,KKLIN(JI,JJ,JK2)+1)
+ END DO
+ END DO
+END DO
+!$acc end kernels
+!$acc end data !present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE VER_INTERP_LIN3D_DEVICE
+#endif
+!
! ##############################################
FUNCTION VER_INTERP_LIN2D(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
! ##############################################
@@ -237,6 +379,104 @@ PVAR2(:,:) =ZVAR2(1,:,:)
!-------------------------------------------------------------------------------
!
END FUNCTION VER_INTERP_LIN2D
+!
+#ifdef _OPENACC
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN2D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+!!**** *VER_INTERP_LIN_DEVICE* - vertical linear interpolation
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** METHOD
+!! ------
+!!
+!! This routine calls the 3D version of VER_INTERP_LIN_DEVICE after rewritting of
+!! the fields under 3D form.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! function VER_INTERP_LIN3D_DEVICE
+!! module MODI_VER_INTERP_LIN3D_DEVICE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/07/97
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+REAL, DIMENSION(:,:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:,:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+!
+REAL, DIMENSION(SIZE(KKLIN,1),SIZE(KKLIN,2)), INTENT(OUT) :: PVAR2 ! variable values on
+! ! target grid
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!REAL, DIMENSION(1,SIZE(PVAR1,1),SIZE(PVAR1,2)) :: ZVAR1 ! variable values on the initial
+! ! grid
+!REAL, DIMENSION(1,SIZE(KKLIN,1),SIZE(KKLIN,2)) :: ZVAR2 ! variable values on target
+!
+!INTEGER,DIMENSION(1,SIZE(KKLIN,1),SIZE(KKLIN,2)) :: IKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+!REAL, DIMENSION(1,SIZE(PCOEFLIN,1),SIZE(PCOEFLIN,2)):: ZCOEFLIN ! coefficient for level KKLIN
+!
+INTEGER :: JJ,JK2
+!
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: VER_INTERP_LIN2D_DEVICE not yet tested'
+!$acc data present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!ZVAR1(1,:,:)=PVAR1(:,:)
+!IKLIN(1,:,:)=KKLIN(:,:)
+!ZCOEFLIN(1,:,:)=PCOEFLIN(:,:)
+!
+!ZVAR2(:,:,:)=VER_INTERP_LIN3D_DEVICE(ZVAR1(:,:,:),IKLIN(:,:,:),ZCOEFLIN(:,:,:))
+!$acc kernels
+DO JK2=1,SIZE(KKLIN,2)
+ DO JJ=1,SIZE(KKLIN,1)
+ PVAR2(JJ,JK2)= PCOEFLIN(JJ,JK2) *PVAR1(JJ,KKLIN(JJ,JK2) )&
+ +(1.-PCOEFLIN(JJ,JK2))*PVAR1(JJ,KKLIN(JJ,JK2)+1)
+ END DO
+END DO
+!$acc end kernels
+!
+!PVAR2(:,:) =ZVAR2(1,:,:)
+!$acc end data !present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE VER_INTERP_LIN2D_DEVICE
+#endif
+!
! ##############################################
FUNCTION VER_INTERP_LIN1D(PVAR1,KKLIN,PCOEFLIN) RESULT(PVAR2)
! ##############################################
@@ -319,3 +559,96 @@ PVAR2(:) =ZVAR2(1,1,:)
!-------------------------------------------------------------------------------
!
END FUNCTION VER_INTERP_LIN1D
+!
+#ifdef _OPENACC
+! ##############################################
+ SUBROUTINE VER_INTERP_LIN1D_DEVICE(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+! ##############################################
+!
+!!**** *VER_INTERP_LIN_DEVICE* - vertical linear interpolation
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** METHOD
+!! ------
+!!
+!! This routine calls the 3D version of VER_INTERP_LIN_DEVICE after rewritting of
+!! the fields under 3D form.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! function VER_INTERP_LIN3D_DEVICE
+!! module MODI_VER_INTERP_LIN3D_DEVICE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/07/97
+!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+REAL, DIMENSION(:), INTENT(IN) :: PVAR1 ! variable values on the initial
+! ! grid
+INTEGER,DIMENSION(:), INTENT(IN) :: KKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+REAL, DIMENSION(:), INTENT(IN) :: PCOEFLIN ! coefficient for level KKLIN
+
+REAL, DIMENSION(SIZE(KKLIN)), INTENT(OUT) :: PVAR2 ! variable values on target
+! ! grid
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!INTEGER,DIMENSION(1,1,SIZE(KKLIN)) :: IKLIN ! lower interpolating level of
+! ! grid 1 for each level of grid 2
+!REAL, DIMENSION(1,1,SIZE(PCOEFLIN)) :: ZCOEFLIN ! coefficient for level KKLIN
+!
+!REAL, DIMENSION(1,1,SIZE(PVAR1)) :: ZVAR1 ! variable values on the initial
+! ! grid
+!REAL, DIMENSION(1,1,SIZE(KKLIN)) :: ZVAR2 ! variable values on target
+!
+INTEGER :: JK2
+!
+!-------------------------------------------------------------------------------
+!
+PRINT *,'OPENACC: VER_INTERP_LIN1D_DEVICE not yet tested'
+!$acc data present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!ZVAR1(1,1,:)=PVAR1(:)
+!IKLIN(1,1,:)=KKLIN(:)
+!ZCOEFLIN(1,1,:)=PCOEFLIN(:)
+!
+!ZVAR2(:,:,:)=VER_INTERP_LIN3D_DEVICE(ZVAR1(:,:,:),IKLIN(:,:,:),ZCOEFLIN(:,:,:))
+DO JK2=1,SIZE(KKLIN,1)
+ PVAR2(JK2)= PCOEFLIN(JK2) *PVAR1(KKLIN(JK2) )&
+ +(1.-PCOEFLIN(JK2))*PVAR1(KKLIN(JK2)+1)
+END DO
+!
+!PVAR2(:) =ZVAR2(1,1,:)
+!$acc end data !present(PVAR1,KKLIN,PCOEFLIN,PVAR2)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE VER_INTERP_LIN1D_DEVICE
+#endif
diff --git a/src/Makefile b/src/Makefile
index d2d234d361a5036d0dc55ade64dfe3f6635a2af5..334fc93102762dd59cfd482e473426531fb9cf07 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -166,7 +166,7 @@ DEP_ALL_USER = $(sort $(filter-out $(IGNORE_DEP_USER) ,$(DEP_USER)) )
.INTERMEDIATE: $(LIB_MASTER)
-.SECONDARY: mpi.mod netcdf.mod openacc.mod
+.SECONDARY: iso_fortran_env.mod mpi.mod netcdf.mod openacc.mod
##########################################################
# #
@@ -345,7 +345,7 @@ $(CDF_INC) :
cd ${DIR_HDF} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --with-zlib=no \
FC="$(FC)" FCFLAGS="$(HDF_OPT)" CPPFLAGS="-DpgiFortran" ${HDF_CONF} && make && make install && $(MAKE) -j 1 clean
cd ${DIR_CDF} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --disable-cxx --enable-f90 --disable-dap \
- FC="$(FC)" FCFLAGS="$(NETCDF_OPT)" CPPFLAGS="-DpgiFortran ${INC_NETCDF}" ${CDF_CONF} LDFLAGS=" -L${CDF_PATH}/lib64" && make && make install && $(MAKE) -j 1 clean
+ FC="$(FC)" FCFLAGS="$(NETCDF_OPT)" CPPFLAGS="-DpgiFortran ${INC_NETCDF}" ${CDF_CONF} LDFLAGS=" -L${CDF_PATH}/lib64" && make && make install && $(MAKE) -j 1 clean
cleanmaster : cleancdf
cleancdf :
@@ -542,6 +542,8 @@ ifeq "$(DO_COMP_USER)" "YES"
include filedepalluser
endif
+iso_fortran_env.mod:
+
mpi.mod:
netcdf.mod:
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index ea570334c3db1a9c7b23517c26c630e7c33ce1d9..0038e591894d898be389f0272aa8014e24471d94 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -565,6 +565,22 @@ INC += $(INC_NETCDF)
LIBS += $(LIB_NETCDF)
endif
+##########################################################
+# Librairie BITREP #
+##########################################################
+# Use to keep bit-reproductibility for mathematical
+# functions (EXP, LOG, POWER...) especially for
+# CPU / GPU comparisons
+#
+ifdef MNH_BITREP
+DIR_MASTER += LIB/BITREP
+VPATH += LIB/BITREP
+OBJS_LISTE_MASTER += br_transcendentals.o
+LIBS += -lstdc++
+%.o : %.cpp
+ $(CXX) $(INC) $(CXXFLAGS) $(CPPFLAGS) -c $< -o $(OBJDIR)/$(*F).o
+endif
+#
##########################################################
# Number of NESTED MODEL #
##########################################################
diff --git a/src/Rules.LXpgi.mk b/src/Rules.LXpgi.mk
index 76a7bb078fc2546d7853641392e0f13aecd4883f..87f0efb091e895274be8e2b2da1b92304b4c8bd6 100644
--- a/src/Rules.LXpgi.mk
+++ b/src/Rules.LXpgi.mk
@@ -9,17 +9,25 @@
##########################################################
#OBJDIR_PATH=${WORKDIR}
#
-OPT_BASE = -g -Ktrap=fp -Mbackslash
+#PW: if -Ktrap=fp: nvprof/pgprof do not work OPT_BASE = -Ktrap=fp ...
+#PW: warning: -Mvect=nosimd is necessary to prevent non reproductibility (i.e. for SUM intrinsic in SUM_1DFIELD_ll)
+OPT_BASE = -Mbackslash -Kieee -nofma -Mvect=nosimd
# -Munixlogical
# -Mrecursive -mcmodel=medium
-OPT_PERF0 = -O0 -Kieee
-OPT_PERF2 = -O2 -Kieee
+OPT_PERF0 = -O0 -g -Minfo=ccff,accel -Mprof=ccff
+OPT_PERF2 = -O2
#OPT_CUDA = -O2 -Mcuda=keepgpu -ta=nvidia,cc20,cuda3.1,host,time -Minfo=accel,intensity,all,ccff
#OPT_CUDA = -O3 -fast -ta=nvidia,cc20,cuda4.2,keepgpu,host -Minfo=accel,all,intensity,ccff
-OPT_CUDA = -O2 -Kieee -nofma -ta=host,nvidia,nofma,cc20,cc35,cuda5.5 -Minfo=ccff,all,intensity -Mprof=ccff
+OPT_MULTICORE = -g -O2 -ta=multicore -Minfo=ccff,accel
+OPT_CUDA = -O2 -Mcuda=cuda7.5,nofma -ta=host,tesla,nofma,cc35,cuda7.5 -Minfo=ccff,accel -Mprof=ccff
+OPT_NOCUDA = -g -O2 -ta=host -Minfo=ccff -Mprof=ccff
+#OPT_CUDA = -O2 -Kieee -nofma -Mcuda=nordc -ta=host,tesla,nofma,cc35,cuda6.5,nordc,managed -Minfo=ccff,accel -Mprof=ccff
+#OPT_CUDA = -O2 -Kieee -nofma -ta=host,tesla,nofma,cc35,cuda6.5,keepgpu,managed -Mcuda -Minfo=ccff,accel -Mprof=ccff
+#OPT_CUDA = -O2 -Kieee -nofma -ta=host,nvidia,nofma,cc20,cc35,cuda5.5,keepgpu -Minfo=ccff,accel -Mprof=ccff
+#OPT_CUDA = -O2 -Kieee -nofma -ta=host,nvidia,nofma,cc20,cc35,cuda5.0 -Minfo=ccff,all,intensity -Mprof=ccff
#OPT_CUDA = -O2 -Kieee -ta=host,nvidia,cc20,cuda4.2 -Minfo=ccff,all,intensity
-OPT_CHECK = -C
+OPT_CHECK = -C #-Mchkfpstk -Mchkptr
OPT_PROF = -Mprof=time,ccff
OPT_I8 = -i8
OPT_R8 = -r8
@@ -63,14 +71,40 @@ OPT0 = $(OPT_BASE) $(OPT_PERF0) $(OPT_CHECK)
OPT_NOCB = $(OPT_BASE) $(OPT_PERF0)
endif
+ifeq "$(OPTLEVEL)" "MULTICORE"
+OPT = $(OPT_BASE) $(OPT_MULTICORE)
+OPT0 = $(OPT_BASE) $(OPT_MULTICORE) $(OPT_PERF0)
+OPT_NOCB = $(OPT_BASE) $(OPT_MULTICORE)
+endif
+
ifeq "$(OPTLEVEL)" "CUDA"
+CPPFLAGS += -D_OPENACC
OPT = $(OPT_BASE) $(OPT_CUDA)
OPT0 = $(OPT_BASE) $(OPT_CUDA) $(OPT_PERF0)
OPT_NOCB = $(OPT_BASE) $(OPT_CUDA)
+#ifdef DO_COMP_USER
+#OPT = $(OPT_BASE) $(OPT_CUDA) -ta:tesla:managed
+CXXFLAGS = -acc -Kieee -Mnofma -Mvect=nosimd $(OPT_CUDA)
+endif
+
+ifeq "$(OPTLEVEL)" "OPENACCDEFONLY"
+CPPFLAGS += -D_OPENACC -D_FAKEOPENACC
+OPT = $(OPT_BASE) $(OPT_NOCUDA)
+OPT0 = $(OPT_BASE) $(OPT_NOCUDA) $(OPT_PERF0)
+OPT_NOCB = $(OPT_BASE) $(OPT_NOCUDA)
+CXXFLAGS = -Kieee -Mnofma -Mvect=nosimd $(OPT_NOCUDA)
+endif
+
+ifeq "$(OPTLEVEL)" "NOCUDA"
+OPT = $(OPT_BASE) $(OPT_NOCUDA)
+OPT0 = $(OPT_BASE) $(OPT_NOCUDA) $(OPT_PERF0)
+OPT_NOCB = $(OPT_BASE) $(OPT_NOCUDA)
+CXXFLAGS = -Kieee -Mnofma -Mvect=nosimd $(OPT_NOCUDA)
endif
ifeq "$(OPTLEVEL)" "CUDA_DB"
-OPT_CUDA = -O0 -Kieee -ta=host,nvidia,cc20,cuda4.2 -Minfo=ccff,all,intensity
+CPPFLAGS += -D_OPENACC
+OPT_CUDA = -g -O0 -Kieee -nofma -ta=host,nvidia,nofma,cc35,cuda6.5 -Minfo=ccff,all,intensity
OPT = $(OPT_BASE) $(OPT_CUDA)
OPT0 = $(OPT_BASE) $(OPT_CUDA)
OPT_NOCB = $(OPT_BASE) $(OPT_CUDA)
@@ -81,8 +115,12 @@ endif
FC = pgf90
ifeq "$(VER_MPI)" "MPIAUTO"
F90 = mpif90
+CC = mpicc
+CXX = mpicxx
else
F90 = pgf90
+CC = pgcc
+CXX = pgcxx
endif
#
F77FLAGS = $(OPT)
@@ -103,12 +141,23 @@ CPPFLAGS_SURCOUCHE += -DMNH_LINUX -DMNH_MPI_RANK_KIND=$(MNH_MPI_RANK_KIND)
CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT} -DLFI_RECL=${LFI_RECL}
CPPFLAGS_MNH = -DMNH -DMNH_PGI -DSFX_MNH
+CPPFLAGS_MNH += -Uvector -Upixel
#
# Gribex flags
#
TARGET_GRIBEX=linux
CNAME_GRIBEX=_pgf77
+GRIBAPI_CONF="CPP=cpp"
+CDF_CONF="CPP=cpp"
+#
+# BITREP flags
+#
+#if MNH_BITREP exists => compile with the BITREP library
+MNH_BITREP = YES
+ifeq "$(MNH_BITREP)" "YES"
+CPPFLAGS_MNH += -DMNH_BITREP
+endif
#
# LIBTOOLS flags
#
@@ -141,6 +190,12 @@ OBJS_O1= spll_modd_isba_n.o spll_pack_isba_patch_n.o spll_mode_construct_ll.o \
spll_phys_param_n.o \
spll_convect_updraft.o spll_convect_updraft_shal.o
$(OBJS_O1) : OPT = $(OPT_BASE) $(OPT_PERF1)
+OBJS_O0= spll_mode_mppdb.o \
+ spll_fast_terms.o
+$(OBJS_O0) : OPT = $(OPT_BASE) $(OPT_PERF0)
+
+OBJS_O2= spll_mode_device.o
+$(OBJS_O2) : OPT = $(OPT_BASE) $(OPT_CUDA)
#
#MODULE_SYSTEM = /opt/F95_42/lib/
diff --git a/src/configure b/src/configure
index 8f6ce93178628910eadcf35b96eef86b1879b564..29f549185edc5c4f20cc3b5b9e01ae8c76a0c08e 100755
--- a/src/configure
+++ b/src/configure
@@ -281,6 +281,20 @@ export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
"}
;;
+'Linux occigen'*)
+ export ARCH=${ARCH:-LXifort}
+ export VER_MPI=${VER_MPI:-MPIINTEL}
+ export OPTLEVEL=${OPTLEVEL:-O2}
+ export VER_CDF=${VER_CDF:-CDFAUTO}
+ export MNHENV=${MNHENV:-"
+ulimit -s unlimited
+module load intel/15.0.0.090
+module load intelmpi/5.0.1.035
+export SLURM_CPU_BIND=none
+export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
+"}
+ ;;
+
Linux*)
export ARCH=${ARCH:-LXgfortran}
export VER_MPI=${VER_MPI:-MPIVIDE}