LoopControl: Correct Fortran macros; provide Fortran wrappers

3 files changed, 146 insertions, 88 deletions

diff --git a/Carpet/LoopControl/src/loopcontrol.F90 b/Carpet/LoopControl/src/loopcontrol.F90
index 9d91ec407..a3f09c91b 100644
--- a/Carpet/LoopControl/src/loopcontrol.F90
+++ b/Carpet/LoopControl/src/loopcontrol.F90
@@ -10,10 +10,12 @@ module loopcontrol
   
   interface
      
-     subroutine lc_stats_init(stats, name)
+     subroutine lc_stats_init(stats, line, file, name)
        use loopcontrol_types
        implicit none
        CCTK_POINTER :: stats
+       integer      :: line
+       character(*) :: file
        character(*) :: name
      end subroutine lc_stats_init
      
@@ -27,10 +29,10 @@ module loopcontrol
        implicit none
        type(lc_control_t) :: control
        CCTK_POINTER       :: stats
-       CCTK_POINTER       :: imin, jmin, kmin
-       CCTK_POINTER       :: imax, jmax, kmax
-       CCTK_POINTER       :: iash, jash, kash
-       CCTK_POINTER       :: di, dj, dk
+       integer            :: imin, jmin, kmin
+       integer            :: imax, jmax, kmax
+       integer            :: iash, jash, kash
+       integer            :: di, dj, dk
      end subroutine lc_control_init
 
      subroutine lc_control_finish(control, stats)
@@ -46,7 +48,7 @@ module loopcontrol
        type(lc_control_t) :: control
      end subroutine lc_thread_init
      
-     logical function lc_thread_done(control)
+     integer function lc_thread_done(control)
        use loopcontrol_types
        implicit none
        type(lc_control_t) :: control
diff --git a/Carpet/LoopControl/src/loopcontrol.cc b/Carpet/LoopControl/src/loopcontrol.cc
index 1191a9b5c..f5ed9af91 100644
--- a/Carpet/LoopControl/src/loopcontrol.cc
+++ b/Carpet/LoopControl/src/loopcontrol.cc
@@ -831,3 +831,56 @@ void lc_statistics_maybe(CCTK_ARGUMENTS)
   
   lc_statistics(CCTK_PASS_CTOC);
 }
+
+
+
+extern "C" CCTK_FCALL
+void CCTK_FNAME(lc_stats_init)(CCTK_POINTER& stats,
+                               int& line,
+                               TWO_FORTSTRINGS_ARGS)
+{
+  TWO_FORTSTRINGS_CREATE(file, name);
+  lc_stats_init((lc_stats_t**)&stats, name, file, line);
+  free(name);
+  free(file);
+}
+
+extern "C" CCTK_FCALL
+void CCTK_FNAME(lc_control_init)(lc_control_t& restrict control,
+                                 CCTK_POINTER& stats,
+                                 int const& imin, int const& jmin, int const& kmin,
+                                 int const& imax, int const& jmax, int const& kmax,
+                                 int const& iash, int const& jash, int const& kash,
+                                 int const& di, int const& dj, int const& dk)
+{
+  lc_control_init(&control, (lc_stats_t*)stats,
+                  imin, jmin, kmin,
+                  imax, jmax, kmax,
+                  iash, jash, kash,
+                  di, dj, dk);
+}
+
+extern "C" CCTK_FCALL
+void CCTK_FNAME(lc_control_finish)(lc_control_t& restrict control,
+                                   CCTK_POINTER& stats)
+{
+  lc_control_finish(&control, (lc_stats_t*)stats);
+}
+
+extern "C"
+CCTK_FCALL void CCTK_FNAME(lc_thread_init)(lc_control_t& control)
+{
+  lc_thread_init(&control);
+}
+
+extern "C"
+CCTK_FCALL int CCTK_FNAME(lc_thread_done)(lc_control_t const& control)
+{
+  return lc_thread_done(&control);
+}
+
+extern "C"
+CCTK_FCALL void CCTK_FNAME(lc_thread_step)(lc_control_t& control)
+{
+  lc_thread_step(&control);
+}
diff --git a/Carpet/LoopControl/src/loopcontrol_fortran.h b/Carpet/LoopControl/src/loopcontrol_fortran.h
index 4788a7b7c..e7a5314a9 100644
--- a/Carpet/LoopControl/src/loopcontrol_fortran.h
+++ b/Carpet/LoopControl/src/loopcontrol_fortran.h
@@ -7,13 +7,12 @@
 
 
 
-
 #define LC_COARSE_DECLARE(name, D)                              \
-   CCTK_POINTER :: name/**/_cmin/**/D, name/**/_cmax/**/D,      \
-                   name/**/_cstep/**/D, name/**/_cpos/**/D
-#define LC_COARSE_OMP_PRIVATE(name, D)          \
-   name/**/_cmin/**/D, name/**/_cmax/**/D,      \
-   name/**/_cstep/**/D, name/**/_cpos/**/D
+   integer :: name/**/_cmin/**/D, name/**/_cmax/**/D,           \
+              name/**/_cstep/**/D, name/**/_cpos/**/D
+#define LC_COARSE_OMP_PRIVATE(name, D)                          \
+   !$omp private (name/**/_cmin/**/D, name/**/_cmax/**/D)       \
+   !$omp private (name/**/_cstep/**/D, name/**/_cpos/**/D)
 #define LC_COARSE_SETUP(name, D)                                        \
    name/**/_control%coarse%min%v(D) = name/**/_control%thread%pos%v(D)  && \
    name/**/_control%coarse%max%v(D) =                                   \
@@ -27,53 +26,57 @@
    do name/**/_cpos/**/D = name/**/_cmin/**/D, name/**/_cmax/**/D,      \
                            name/**/_cstep/**/D
 
-#define LC_FINE_DECLARE(name, I, D)                             \
-   CCTK_POINTER :: name/**/_fmin/**/D, name/**/_fmax/**/D,      \
-                   name/**/_fstep/**/D, I
-#define LC_FINE_OMP_PRIVATE(name, I, D)         \
-   name/**/_fmin/**/D, name/**/_fmax/**/D,      \
-   name/**/_fstep/**/D, I
-#define LC_FINE_SETUP(name, D)                                  \
-   name/**/_control%fine%min%v(D) = name/**/_cpos/**/D          && \
-   name/**/_control%fine%max%v(D) =                             \
-     min(name/**/_control%coarse%max%v(D),                      \
-         name/**/_control%fine%min%v(D) +                       \
-         name/**/_control%coarse%step%v(D))                     && \
-   name/**/_fmin/**/D = name/**/_control%fine%min%v(D)          && \
-   name/**/_fmax/**/D = name/**/_control%fine%max%v(D)          && \
+#define LC_FINE_DECLARE(name, D)                                        \
+   integer :: name/**/_fmin/**/D, name/**/_fmax/**/D, name/**/_fstep/**/D
+#define LC_FINE_OMP_PRIVATE(name, I, NI, D)                             \
+   name/**/_fmin/**/D, name/**/_fmax/**/D, name/**/_fstep/**/D, I, NI
+#define LC_FINE_SETUP(name, D)                                          \
+   name/**/_control%fine%min%v(D) = name/**/_cpos/**/D               && \
+   name/**/_control%fine%max%v(D) =                                     \
+     min(name/**/_control%coarse%max%v(D),                              \
+         name/**/_control%fine%min%v(D) +                               \
+         name/**/_control%coarse%step%v(D))                          && \
+   name/**/_fmin/**/D = name/**/_control%fine%min%v(D)               && \
+   name/**/_fmax/**/D = name/**/_control%fine%max%v(D)               && \
    name/**/_fstep/**/D = name/**/_control%fine%step%v(D)
-#define LC_FINE_LOOP(name, I, D)                                        \
-   do I = name/**/_fmin/**/D, name/**/_fmax/**/D, name/**/_fstep/**/D
-
-
-
-#define LC_DECLARE3(name, i,j,k)                                        \
-   CCTK_POINTER :: name/**/_ash1, name/**/_ash2, name/**/_ash3          && \
-   CCTK_POINTER :: name/**/_align1, name/**/_align2, name/**/_align3    && \
-   CCTK_POINTER, save :: name/**/_stats = 0                             && \
-   type(lc_control_t) :: name/**/_control                               && \
-   LC_COARSE_DECLARE(name, 1)                                           && \
-   LC_COARSE_DECLARE(name, 2)                                           && \
-   LC_COARSE_DECLARE(name, 3)                                           && \
-   LC_FINE_DECLARE(name, i, 1)                                          && \
-   LC_FINE_DECLARE(name, j, 2)                                          && \
-   LC_FINE_DECLARE(name, k, 3)
-
-#define LC_OMP_PRIVATE(name, i,j,k)                     \
-   name/**/_ash1, name/**/_ash2, name/**/_ash3,         \
-   name/**/_align1, name/**/_align2, name/**/_align3,   \
+#define LC_FINE_LOOP(name, I, NI, D)                                    \
+   do I = name/**/_fmin/**/D, name/**/_fmax/**/D, name/**/_fstep/**/D   && \
+      NI = 0                                                            && \
+      if (name/**/_dir/**/D<0) NI = I                                   && \
+      if (name/**/_dir/**/D>0) NI = name/**/_control%loop%max%v(D)+1-I
+
+
+
+#define LC_LOOP3STR_NORMAL_DECLARE(name)                                \
+   integer :: name/**/_dir1, name/**/_dir2, name/**/_dir3            && \
+   integer :: name/**/_ash1, name/**/_ash2, name/**/_ash3            && \
+   integer :: name/**/_align1, name/**/_align2, name/**/_align3      && \
+   CCTK_POINTER, save :: name/**/_stats = 0                          && \
+   type(lc_control_t) :: name/**/_control                            && \
+   LC_COARSE_DECLARE(name,1)                                         && \
+   LC_COARSE_DECLARE(name,2)                                         && \
+   LC_COARSE_DECLARE(name,3)                                         && \
+   LC_FINE_DECLARE(name,1)                                           && \
+   LC_FINE_DECLARE(name,2)                                           && \
+   LC_FINE_DECLARE(name,3)
+
+#define LC_LOOP3STR_NORMAL_OMP_PRIVATE(name, i,j,k)     \
    name/**/_control,                                    \
-   LC_COARSE_OMP_PRIVATE(name, 1),                      \
-   LC_COARSE_OMP_PRIVATE(name, 2),                      \
-   LC_COARSE_OMP_PRIVATE(name, 3),                      \
-   LC_FINE_OMP_PRIVATE(name, i, 1),                     \
-   LC_FINE_OMP_PRIVATE(name, j, 2),                     \
-   LC_FINE_OMP_PRIVATE(name, k, 3)
+   LC_COARSE_OMP_PRIVATE(name,1),                       \
+   LC_COARSE_OMP_PRIVATE(name,2),                       \
+   LC_COARSE_OMP_PRIVATE(name,3),                       \
+   LC_FINE_OMP_PRIVATE(name, i, ni,1),                  \
+   LC_FINE_OMP_PRIVATE(name, j, nj,2),                  \
+   LC_FINE_OMP_PRIVATE(name, k, nk,3)
 
 
 
-#define LC_LOOP3STR(name, i,j,k, imin_,jmin_,kmin_, imax_,jmax_,kmax_,  \
-                    iash_,jash_,kash_, imin,imax, di_)                  \
+#define LC_LOOP3STR_NORMAL(name, i,j,k, ni,nj,nk, idir_,jdir_,kdir_,    \
+                           imin_,jmin_,kmin_, imax_,jmax_,kmax_,        \
+                           iash_,jash_,kash_, imin,imax, di_)           \
+   name/**/_dir1 = (idir_)                                              && \
+   name/**/_dir2 = (jdir_)                                              && \
+   name/**/_dir3 = (kdir_)                                              && \
    name/**/_ash1 = (iash_)                                              && \
    name/**/_ash2 = (jash_)                                              && \
    name/**/_ash3 = (kash_)                                              && \
@@ -81,43 +84,43 @@
    name/**/_align2 = 1                                                  && \
    name/**/_align3 = 1                                                  && \
                                                                         && \
-   call lc_stats_init(name/**/stats, #name)                             && \
-   call lc_control_init(name/**/control, name/**/stats,                 \
+   call lc_stats_init(name/**/_stats, __LINE__, __FILE__, "name")       && \
+   call lc_control_init(name/**/_control, name/**/_stats,               \
                         (imin_), (jmin_), (kmin_),                      \
                         (imax_), (jmax_), (kmax_),                      \
-                        name/**/ash1, name/**/ash2, name/**/ash3,       \
-                        name/**/align1, name/**/align2, name/**/align3) && \
+                        name/**/_ash1, name/**/_ash2, name/**/_ash3,    \
+                        name/**/_align1, name/**/_align2, name/**/_align3) && \
                                                                         && \
    /* Multithreading */                                                 && \
-   call lc_thread_init(name/**/control)                                 && \
-   do while (.not. lc_thread_done(name/**/control))                     && \
+   call lc_thread_init(name/**/_control)                                && \
+   do while (lc_thread_done(name/**/_control) == 0)                     && \
                                                                         && \
       /* Coarse loops */                                                && \
-      LC_COARSE_SETUP(3)                                                && \
-      LC_COARSE_SETUP(2)                                                && \
-      LC_COARSE_SETUP(1)                                                && \
-      LC_COARSE_LOOP(3)                                                 && \
-      LC_COARSE_LOOP(2)                                                 && \
-      LC_COARSE_LOOP(1)                                                 && \
+      LC_COARSE_SETUP(name,3)                                           && \
+      LC_COARSE_SETUP(name,2)                                           && \
+      LC_COARSE_SETUP(name,1)                                           && \
+      LC_COARSE_LOOP(name,3)                                            && \
+      LC_COARSE_LOOP(name,2)                                            && \
+      LC_COARSE_LOOP(name,1)                                            && \
                                                                         && \
          /* Fine loops */                                               && \
-         LC_FINE_SETUP(3)                                               && \
-         LC_FINE_SETUP(2)                                               && \
-         LC_FINE_SETUP(1)                                               && \
-         LC_FINE_LOOP(3)                                                && \
-         LC_FINE_LOOP(2)                                                && \
-         LC_FINE_LOOP(1)
-
-#define LC_ENDLOOP3STR(name)                                    && \
-         end do                                                 && \
-         end do                                                 && \
-         end do                                                 && \
-      end do                                                    && \
-      end do                                                    && \
-      end do                                                    && \
-      call lc_thread_step(name/**/control)                      && \
-   end do                                                       && \
-   call lc_control_finish(name/**/control, name/**/stats)
+         LC_FINE_SETUP(name,3)                                          && \
+         LC_FINE_SETUP(name,2)                                          && \
+         LC_FINE_SETUP(name,1)                                          && \
+         LC_FINE_LOOP(name, k, nk,3)                                    && \
+         LC_FINE_LOOP(name, j, nj,2)                                    && \
+         LC_FINE_LOOP(name, i, ni,1)
+
+#define LC_ENDLOOP3STR_NORMAL(name)                                  && \
+         end do                                                      && \
+         end do                                                      && \
+         end do                                                      && \
+      end do                                                         && \
+      end do                                                         && \
+      end do                                                         && \
+      call lc_thread_step(name/**/_control)                          && \
+   end do                                                            && \
+   call lc_control_finish(name/**/_control, name/**/_stats)
 
 
 
@@ -130,7 +133,7 @@
 
 /* Replace CCTK_LOOP macros */
 #if (!defined CCTK_LOOP3STR_NORMAL_DECLARE ||           \
-     !defined CCTK_ENDLOOP3STR_NORMAL_OMP_PRIVATE ||    \
+     !defined CCTK_LOOP3STR_NORMAL_OMP_PRIVATE ||       \
      !defined CCTK_LOOP3STR_NORMAL ||                   \
      !defined CCTK_ENDLOOP3STR_NORMAL)
 #  error "internal error"
@@ -139,10 +142,10 @@
 #undef CCTK_LOOP3STR_NORMAL_OMP_PRIVATE
 #undef CCTK_LOOP3STR_NORMAL
 #undef CCTK_ENDLOOP3STR_NORMAL
-#define CCTK_LOOP3STR_NORMAL_DECLARE     LC_LOOP3_DECLARE
-#define CCTK_LOOP3STR_NORMAL_OMP_PRIVATE LC_LOOP3_OMP_PRIVATE
-#define CCTK_LOOP3STR_NORMAL             LC_LOOP3
-#define CCTK_ENDLOOP3STR_NORMAL          LC_ENDLOOP3
+#define CCTK_LOOP3STR_NORMAL_DECLARE     LC_LOOP3STR_NORMAL_DECLARE
+#define CCTK_LOOP3STR_NORMAL_OMP_PRIVATE LC_LOOP3STR_NORMAL_OMP_PRIVATE
+#define CCTK_LOOP3STR_NORMAL             LC_LOOP3STR_NORMAL
+#define CCTK_ENDLOOP3STR_NORMAL          LC_ENDLOOP3STR_NORMAL