modif reduce_subvector + select_subvector

Author: jvdp1

src/common.fypp

@@ -160,25 +160,26 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
 #! Generates an array rank suffix for subarrays along a dimension
 #!
 #! Args:
+#!   varname (str): Name of the variable to be used as origin
 #!   rank (int): Rank of the original variable
 #!   dim (int): Dimension of the variable
 #!
 #! Returns:
 #!   Array rank suffix string enclosed in braces
 #!
 #! E.g.,
-#!  select_subvector(5, 2)
+#!  select_subvector('j', 5, 2)
 #!   -> (j_, :, j___, j____, j_____)
 #!
-#:def select_subvector(rank, idim)
+#:def select_subvector(varname, rank, idim)
   #:assert rank > 0
   #:call join_lines(joinstr=", ", prefix="(", suffix=")")
     #:for i in range(1, idim)
-      ${"j" + "_" * (i) }$
+      ${varname}$${ "_" * (i) }$
     #:endfor
     :
     #:for i in range(idim + 1, rank + 1)
-      ${"j" + "_" * (i) }$
+      ${varname}$${ "_" * (i) }$
     #:endfor
   #:endcall
 #:enddef
@@ -187,25 +188,26 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
 #! Generates an array rank suffix for arrays
 #!
 #! Args:
+#!   varname (str): Name of the variable to be used as origin
 #!   rank (int): Rank of the original variable
 #!   idim (int): Dimension of the variable
 #!
 #! Returns:
 #!   Array rank suffix string enclosed in braces
 #!
 #! E.g.,
-#!  select_subvector(5, 2)
+#!  reduce_subvector('j', 5, 2)
 #!   -> (j_, j___, j____, j_____)
 #!
-#:def reduce_subvector(rank, idim)
+#:def reduce_subvector(varname, rank, idim)
   #:assert rank > 0
   #:if rank > 1
     #:call join_lines(joinstr=", ", prefix="(", suffix=")")
       #:for i in range(1, idim)
-        ${"j" + "_" * (i) }$
+        ${varname}$${ "_" * (i) }$
       #:endfor
       #:for i in range(idim + 1, rank + 1)
-        ${"j" + "_" * (i) }$
+        ${varname}$${ "_" * (i) }$
       #:endfor
     #:endcall
   #:endif

src/stdlib_stats_median.fypp

@@ -86,18 +86,18 @@ contains
               #:for fj in range(fi+1, rank+1)
                 do j${"_" * fj}$ = 1, size(x, ${fj}$)
               #:endfor
-                  x_tmp(:) = x${select_subvector(rank, fi)}$
+                  x_tmp(:) = x${select_subvector('j', rank, fi)}$
                   call sort(x_tmp)
 
                   if (mod(n, 2) == 0) then
-                      res${reduce_subvector(rank, fi)}$ = &
+                      res${reduce_subvector('j', rank, fi)}$ = &
                       #:if t1[0] == 'r'
                           sum(x_tmp(c:c+1)) / 2._${o1}$
                       #:else
                           sum(real(x_tmp(c:c+1), kind=${o1}$) ) / 2._${o1}$
                       #:endif
                   else
-                      res${reduce_subvector(rank, fi)}$ = x_tmp(c)
+                      res${reduce_subvector('j', rank, fi)}$ = x_tmp(c)
                   end if
             #:for fj in range(1, rank)
               end do
@@ -180,25 +180,25 @@ contains
               #:for fj in range(fi+1, rank+1)
                 do j${"_" * fj}$ = 1, size(x, ${fj}$)
               #:endfor
-                  x_tmp = pack(x${select_subvector(rank, fi)}$, &
-                                mask${select_subvector(rank, fi)}$)
+                  x_tmp = pack(x${select_subvector('j', rank, fi)}$, &
+                                mask${select_subvector('j', rank, fi)}$)
                   call sort(x_tmp)
 
                   n = size(x_tmp, kind=int64)
                   c = floor( (n + 1) / 2._${o1}$, kind=int64 )
 
                   if (n == 0) then
-                      res${reduce_subvector(rank, fi)}$ = &
+                      res${reduce_subvector('j', rank, fi)}$ = &
                           ieee_value(1._${o1}$, ieee_quiet_nan)
                   else if (mod(n, 2_int64) == 0) then
-                      res${reduce_subvector(rank, fi)}$ = &
+                      res${reduce_subvector('j', rank, fi)}$ = &
                       #:if t1[0] == 'r'
                           sum(x_tmp(c:c+1)) / 2._${o1}$
                       #:else
                           sum(real(x_tmp(c:c+1), kind=${o1}$)) / 2._${o1}$
                       #:endif
                   else if (mod(n, 2_int64) == 1) then
-                      res${reduce_subvector(rank, fi)}$ = x_tmp(c)
+                      res${reduce_subvector('j', rank, fi)}$ = x_tmp(c)
                   end if
 
                   deallocate(x_tmp)