f90charm: Add preliminary support for reductions 79/4279/5
authorGengbin Zheng <zhenggb@gmail.com>
Tue, 1 Mar 2016 06:00:02 +0000 (00:00 -0600)
committerEvan Ramos <evan@hpccharm.com>
Tue, 24 Jul 2018 15:53:57 +0000 (10:53 -0500)
Caveats: Support is limited to reducing from a chare array to the first
member of the same array. Only basic built-in reducers are available.

Co-authored-by: Evan Ramos <evan@hpccharm.com>
Change-Id: Ia54bf9321111594064919f839b69c56adddbd3ad

doc/f90charm/manual.tex
examples/charm++/f90charm/ldbRedDemo/Makefile [new file with mode: 0644]
examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.C [new file with mode: 0644]
examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.ci [new file with mode: 0644]
examples/charm++/f90charm/ldbRedDemo/ldbRedDemof.f90 [new file with mode: 0644]
src/ck-core/charmmod.f90
src/ck-core/ckreduction.C
src/ck-core/ckreduction.h
src/xlat-i/xi-Chare.C
src/xlat-i/xi-Entry.C

index 3483a42adbdd6dc4f79515c90275831fe9b77499..3945c0b499a0ceebef9e9866263f75c96983b250 100644 (file)
@@ -190,7 +190,7 @@ functions. The syntax is same as in Charm++.
           entry void SayHi(int a, double b, int n, int arr[n]);
 
           // Other entry points go here
-
+          entry [reductiontarget] void MyReduction(int result);
         };              
       };
 \end{verbatim}
@@ -266,6 +266,18 @@ Now that you have the chare and the chare constructor function, you can start
       endif
 \end{verbatim}
 
+Preliminary support for reductions is available as well. Support is limited to
+reducing from a chare array to the first member of the same array. Only basic
+built-in reducers are available. For an entry method named MyReduction, tagged
+as a reduction target in the interface file, a contribution can be made as
+follows:
+
+\begin{verbatim}
+      external Hello_ReductionTarget_MyReduction
+
+      call Hello_contribute(objPtr%aid, myIndex, sizeof(myIndex), myValue, CHARM_SUM_INT, Hello_ReductionTarget_MyReduction)
+\end{verbatim}
+
 Now, you can write the main program to create the chare array and start the 
 program by sending the first message.
 \begin{verbatim}
diff --git a/examples/charm++/f90charm/ldbRedDemo/Makefile b/examples/charm++/f90charm/ldbRedDemo/Makefile
new file mode 100644 (file)
index 0000000..437cc93
--- /dev/null
@@ -0,0 +1,24 @@
+-include ../../../common.mk
+CHARMC=../../../../bin/charmc $(OPTS)
+
+OBJS = ldbRedDemo.o ldbRedDemof.o
+
+all: ldbRedDemo
+
+ldbRedDemo: $(OBJS)
+       $(CHARMC) -language f90charm -module CommonLBs -o ldbRedDemo $(OBJS)
+
+ldbRedDemo.o: ldbRedDemo.C balanceDemo.decl.h
+       $(CHARMC) -O -c ldbRedDemo.C
+
+ldbRedDemof.o: ldbRedDemof.f90
+       $(CHARMC) -c ldbRedDemof.f90
+
+balanceDemo.decl.h: ldbRedDemo.ci
+       $(CHARMC) -language f90charm ldbRedDemo.ci
+
+test: ldbRedDemo
+       $(call run, +p2 ./ldbRedDemo +balancer RotateLB +LBDebug 1)
+
+clean:
+       rm -f *.decl.h *.def.h conv-host *.o ldbRedDemo charmrun *.mod
diff --git a/examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.C b/examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.C
new file mode 100644 (file)
index 0000000..4d49579
--- /dev/null
@@ -0,0 +1,3 @@
+#include "balanceDemo.decl.h"
+int nElements;
+#include "balanceDemo.def.h"
diff --git a/examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.ci b/examples/charm++/f90charm/ldbRedDemo/ldbRedDemo.ci
new file mode 100644 (file)
index 0000000..23c2d97
--- /dev/null
@@ -0,0 +1,10 @@
+mainmodule balanceDemo {
+  readonly int nElements;
+
+  array [1D] BalanceMe {
+    entry BalanceMe(void);
+    entry void nbrData(int size, float D[size], int k);
+    entry void nextStep();
+    entry [reductiontarget] void barrier(int result);
+ };
+};
diff --git a/examples/charm++/f90charm/ldbRedDemo/ldbRedDemof.f90 b/examples/charm++/f90charm/ldbRedDemo/ldbRedDemof.f90
new file mode 100644 (file)
index 0000000..bfa4669
--- /dev/null
@@ -0,0 +1,164 @@
+      MODULE  LdbDemoMod
+        USE charm
+        TYPE LdbDemo
+          integer iterations
+          REAL*8  t0
+          integer next, iteration, n, count
+          REAL*4, pointer :: myData(:)
+        END TYPE
+
+          ! define Object Pointer used to communicate with charm kernel
+        TYPE LdbDemoPtr
+          TYPE (LdbDemo), POINTER ::  obj
+          integer*8 aid
+        END TYPE
+      END MODULE
+
+!  user MUST write this subroutine to allocate the object data
+      SUBROUTINE BalanceMe_allocate(objPtr, aid, index)
+        USE LdbDemoMod
+        IMPLICIT NONE
+        TYPE(LdbDemoPtr) objPtr
+        INTEGER*8 aid
+        INTEGER index, nElements
+
+        allocate(objPtr%obj)
+        objPtr%aid = aid
+          ! initialize Chare data here in constructor
+        objPtr%obj%iterations = 0
+        objPtr%obj%t0 =  CmiWallTimer()
+
+        objPtr%obj%n = 200+MOD(index*31757, 2000)
+        call CkPrintf("Constructor of element %d n: %d \n$$", index, objPtr%obj%n)
+        allocate(objPtr%obj%myData(objPtr%obj%n))
+        call get_nElements(nElements)
+        objPtr%obj%next = MOD( index+1, nElements)
+        objPtr%obj%iteration = 0
+        objPtr%obj%count = 0
+
+        call nextStep(objPtr, index)
+      END SUBROUTINE
+
+!   user MUST write this puper subroutine
+      SUBROUTINE BalanceMe_pup(p, objPtr, aid)
+        USE LdbDemoMod
+        IMPLICIT NONE
+        INCLUDE 'pupf.h'
+        INTEGER p
+        TYPE(LdbDemoPtr),target :: objPtr
+        INTEGER*8 aid
+
+        if (fpup_isUnpacking(p)) then
+            ! allocate chare and restore aid
+          allocate(objPtr%obj)
+          objPtr%aid = aid;
+        endif
+        CALL fpup_int(p, objPtr%obj%iterations)
+        CALL fpup_double(p, objPtr%obj%t0)
+        CALL fpup_int(p, objPtr%obj%next)
+        CALL fpup_int(p, objPtr%obj%iteration)
+        CALL fpup_int(p, objPtr%obj%n)
+        CALL fpup_int(p, objPtr%obj%count)
+        if (fpup_isUnpacking(p)) then
+            ! allocate array
+          allocate(objPtr%obj%myData(objPtr%obj%n))
+        ENDIF
+        CALL fpup_reals(p, objPtr%obj%myData, objPtr%obj%n)
+           ! free up memory
+        if (fpup_isDeleting(p)) deallocate(objPtr%obj%myData)
+      END SUBROUTINE
+
+! user MUST write this for load balancing
+      SUBROUTINE BalanceMe_resumefromsync(objPtr, aid, index)
+        USE LdbDemoMod
+        TYPE(LdbDemoPtr) objPtr
+        integer*8 aid
+        integer index
+
+          ! load balancing finish, start next step
+        call nextStep(objPtr, index)
+      END SUBROUTINE
+
+      INTEGER FUNCTION doWork(workTime)
+        USE charm
+        IMPLICIT NONE
+        REAL*8 workTime, recvTimeStamp
+        INTEGER k
+
+        recvTimeStamp = CmiWallTimer()
+        DO WHILE (CmiWallTimer() - recvTimeStamp < workTime )
+          k = k+1;
+        END DO
+
+        doWork = k;
+     END FUNCTION
+
+!    define fortran entry function
+      SUBROUTINE nbrData(objPtr, myIndex, size, D, k)
+        USE LdbDemoMod
+        IMPLICIT NONE
+        INTEGER doWork
+
+        TYPE(LdbDemoPtr) objPtr
+        integer myIndex
+        integer size, k, res
+        REAL*4  D(size)
+        REAL*8  n
+        external BalanceMe_ReductionTarget_barrier
+
+        n = objPtr%obj%n
+        res = doWork(n * 0.00001)
+
+        objPtr%obj%iteration = objPtr%obj%iteration+1
+        IF (MOD(objPtr%obj%iteration, 5) .eq. 0) THEN
+           ! AtSync to start load balancing
+          call BalanceMe_atSync(objPtr%aid, myIndex)
+        ELSE
+          call BalanceMe_contribute(objPtr%aid, myIndex, sizeof(myIndex), myIndex, CHARM_SUM_INT, BalanceMe_ReductionTarget_barrier)
+        ENDIF
+      END SUBROUTINE
+
+      SUBROUTINE nextStep(objPtr, myIndex)
+        USE LdbDemoMod
+        IMPLICIT NONE
+
+        TYPE(LdbDemoPtr) objPtr
+        integer myIndex
+
+        call SendTo_BalanceMe_nbrData(objPtr%aid, objPtr%obj%next, objPtr%obj%n, objPtr%obj%myData, myIndex)
+
+      END SUBROUTINE
+
+      SUBROUTINE barrier(objPtr, myIndex, result)
+        USE LdbDemoMod
+        IMPLICIT NONE
+
+        TYPE(LdbDemoPtr) objPtr
+        INTEGER myIndex
+        INTEGER result
+
+        INTEGER mype
+        double precision  t1
+        INTEGER nElements
+
+        call CkMyPe(mype)
+        print *, mype, result
+
+        objPtr%obj%iterations = objPtr%obj%iterations + 1
+        IF (objPtr%obj%iterations .eq. 18) THEN
+          t1 = CmiWallTimer()
+          call CkPrintf("ALL done in %F seconds.\n$$", t1-objPtr%obj%t0)
+          call CkExit()
+        ELSE
+           ! broadcast using "-1"
+          call SendTo_BalanceMe_nextStep(objPtr%aid, -1);
+        ENDIF
+      END SUBROUTINE
+
+
+!   MAIN subroutine, user MUST write
+!   called once only on processor 0
+      SUBROUTINE f90charmmain()
+        call set_nElements(5)
+        call BalanceMe_CkNew(5)
+      END SUBROUTINE
index 964211c21e6d23eeaa75f864ec52b0e91093cd73..63629eade8345567a0ddbdb7cb8c8a38c5d6627e 100644 (file)
@@ -6,6 +6,76 @@ module charm
   real*8,    external :: CmiCpuTimer
   real*8,    external :: CkCpuTimer
 
+! KEEPINSYNC: ckreduction.h
+  integer, parameter :: CHARM_NOP = 1
+  integer, parameter :: CHARM_SUM_CHAR = 2
+  integer, parameter :: CHARM_SUM_SHORT = 3
+  integer, parameter :: CHARM_SUM_INT = 4
+  integer, parameter :: CHARM_SUM_LONG = 5
+  integer, parameter :: CHARM_SUM_LONG_LONG = 6
+  integer, parameter :: CHARM_SUM_UCHAR = 7
+  integer, parameter :: CHARM_SUM_USHORT = 8
+  integer, parameter :: CHARM_SUM_UINT = 9
+  integer, parameter :: CHARM_SUM_ULONG = 10
+  integer, parameter :: CHARM_SUM_ULONG_LONG = 11
+  integer, parameter :: CHARM_SUM_FLOAT = 12
+  integer, parameter :: CHARM_SUM_DOUBLE = 13
+  integer, parameter :: CHARM_PRODUCT_CHAR = 14
+  integer, parameter :: CHARM_PRODUCT_SHORT = 15
+  integer, parameter :: CHARM_PRODUCT_INT = 16
+  integer, parameter :: CHARM_PRODUCT_LONG = 17
+  integer, parameter :: CHARM_PRODUCT_LONG_LONG = 18
+  integer, parameter :: CHARM_PRODUCT_UCHAR = 19
+  integer, parameter :: CHARM_PRODUCT_USHORT = 20
+  integer, parameter :: CHARM_PRODUCT_UINT = 21
+  integer, parameter :: CHARM_PRODUCT_ULONG = 22
+  integer, parameter :: CHARM_PRODUCT_ULONG_LONG = 23
+  integer, parameter :: CHARM_PRODUCT_FLOAT = 24
+  integer, parameter :: CHARM_PRODUCT_DOUBLE = 25
+  integer, parameter :: CHARM_MAX_CHAR = 26
+  integer, parameter :: CHARM_MAX_SHORT = 27
+  integer, parameter :: CHARM_MAX_INT = 28
+  integer, parameter :: CHARM_MAX_LONG = 29
+  integer, parameter :: CHARM_MAX_LONG_LONG = 30
+  integer, parameter :: CHARM_MAX_UCHAR = 31
+  integer, parameter :: CHARM_MAX_USHORT = 32
+  integer, parameter :: CHARM_MAX_UINT = 33
+  integer, parameter :: CHARM_MAX_ULONG = 34
+  integer, parameter :: CHARM_MAX_ULONG_LONG = 35
+  integer, parameter :: CHARM_MAX_FLOAT = 36
+  integer, parameter :: CHARM_MAX_DOUBLE = 37
+  integer, parameter :: CHARM_MIN_CHAR = 38
+  integer, parameter :: CHARM_MIN_SHORT = 39
+  integer, parameter :: CHARM_MIN_INT = 40
+  integer, parameter :: CHARM_MIN_LONG = 41
+  integer, parameter :: CHARM_MIN_LONG_LONG = 42
+  integer, parameter :: CHARM_MIN_UCHAR = 43
+  integer, parameter :: CHARM_MIN_USHORT = 44
+  integer, parameter :: CHARM_MIN_UINT = 45
+  integer, parameter :: CHARM_MIN_ULONG = 46
+  integer, parameter :: CHARM_MIN_ULONG_LONG = 47
+  integer, parameter :: CHARM_MIN_FLOAT = 48
+  integer, parameter :: CHARM_MIN_DOUBLE = 49
+!  integer, parameter :: CHARM_LOGICAL_AND = 50
+  integer, parameter :: CHARM_LOGICAL_AND_INT = 51
+  integer, parameter :: CHARM_LOGICAL_AND_BOOL = 52
+!  integer, parameter :: CHARM_LOGICAL_OR = 53
+  integer, parameter :: CHARM_LOGICAL_OR_INT = 54
+  integer, parameter :: CHARM_LOGICAL_OR_BOOL = 55
+! CHARM_LOGICAL_XOR does not exist
+  integer, parameter :: CHARM_LOGICAL_XOR_INT = 56
+  integer, parameter :: CHARM_LOGICAL_XOR_BOOL = 57
+!  integer, parameter :: CHARM_BITVEC_AND = 58
+  integer, parameter :: CHARM_BITVEC_AND_INT = 59
+  integer, parameter :: CHARM_BITVEC_AND_BOOL = 60
+!  integer, parameter :: CHARM_BITVEC_OR = 61
+  integer, parameter :: CHARM_BITVEC_OR_INT = 62
+  integer, parameter :: CHARM_BITVEC_OR_BOOL = 63
+!  integer, parameter :: CHARM_BITVEC_XOR = 64
+  integer, parameter :: CHARM_BITVEC_XOR_INT = 65
+  integer, parameter :: CHARM_BITVEC_XOR_BOOL = 66
+  integer, parameter :: CHARM_RANDOM = 67
+
   INTERFACE
       SUBROUTINE initbigsimtrace(outputParams, outputtiming)
          INTEGER outputParams, outputtiming
index bfee8a140ce8fa5645222a419e2a313c6ad9f0cc..dff493a310cb355bde8c94389534ecd997ad90f6 100644 (file)
@@ -1887,6 +1887,7 @@ std::vector<CkReduction::reducerStruct> CkReduction::initReducerTable()
 
   //Compute the logical XOR of the values passed by each element.
   // The resulting value will be 1 if an odd number of source values is nonzero.
+  // logical_xor does not exist
   vec.emplace_back(logical_xor_int_fn, true, "CkReduction::logical_xor_int");
   vec.emplace_back(logical_xor_bool_fn, true, "CkReduction::logical_xor_bool");
 
index 9ebe66e88c323380d6d4587288b2b7050a0375dc..02084234ab059ac79a08c655ff150c75a4d648f9 100644 (file)
@@ -123,6 +123,7 @@ public:
             !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
             !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  */
 
+  // KEEPINSYNC: charmmod.f90
        typedef enum {
        //A placeholder invalid reduction type
                invalid=0,
@@ -159,6 +160,7 @@ public:
 
        //Compute the logical XOR of the values passed by each element.
        // The resulting value will be 1 if an odd number of source value is nonzero.
+       // logical_xor does not exist
                 logical_xor_int,logical_xor_bool,
 
                 // Compute the logical bitvector AND of the values passed by each element.
index 7c532243e91c3b699dbe2bf0bf8ab074dc00a9ec..23535baa41266538c583d7b992d4bdc95dab3aa8 100644 (file)
@@ -687,6 +687,36 @@ void Chare::genDefs(XStr& str) {
     }
     str << "}\n";
 
+    // define reduction interface function
+    if (dim == (const char*)"1D") {
+      str << "extern \"C\" void "
+          << fortranify(baseName(), "_contribute")
+          << "(long* aindex, int *index1, int *size, void *data, int *op, int (*target)())\n";
+      str << "{\n";
+      str << "  CkArrayID *aid = (CkArrayID *)*aindex;\n";
+      str << "  CProxy_" << baseName() << " h(*aid);\n";
+      str << "  h[*index1].ckLocal()->contribute(*size, data, CkReduction::reducerType(*op), CkCallback(target(), h[0]));\n";
+    }
+    else if (dim == (const char*)"2D") {
+      str << "extern \"C\" void "
+          << fortranify(baseName(), "_contribute")
+          << "(long* aindex, int *index1, int *index2, int *size, void *data, int *op, int (*target)())\n";
+      str << "{\n";
+      str << "  CkArrayID *aid = (CkArrayID *)*aindex;\n";
+      str << "  CProxy_" << baseName() << " h(*aid);\n";
+      str << "  h(*index1, *index2).ckLocal()->contribute(*size, data, CkReduction::reducerType(*op), CkCallback(target(), h(0, 0)));\n";
+    }
+    else if (dim == (const char*)"3D") {
+      str << "extern \"C\" void "
+          << fortranify(baseName(), "_contribute")
+          << "(long* aindex, int *index1, int *index2, int *index3, int *size, void *data, int *op, int (*target)())\n";
+      str << "{\n";
+      str << "  CkArrayID *aid = (CkArrayID *)*aindex;\n";
+      str << "  CProxy_" << baseName() << " h(*aid);\n";
+      str << "  h(*index1, *index2, *index3).ckLocal()->contribute(*size, data, CkReduction::reducerType(*op), CkCallback(target(), h(0, 0, 0)));\n";
+    }
+    str << "}\n";
+
     str << "/* FORTRAN END */\n\n";
   } // fortranMode
 
index 021a1c22e63aae41e437b69a7bc5177a1bb6325d..f6ebd81834be256513c32471f88759c16d5d3774 100644 (file)
@@ -2660,6 +2660,16 @@ void Entry::genDefs(XStr& str) {
     str << ");\n";
     str << "}\n";
 
+    if (isReductionTarget()) {
+      str << "extern \"C\" ";
+      str << "int ";
+      str << fortranify(container->baseName(), "_ReductionTarget_", name);
+      str << "(void)\n";
+      str << "{\n";
+      str << "  return CkReductionTarget(" << container->baseName() << ", " << name << ");\n";
+      str << "}\n";
+    }
+
     str << "/* FORTRAN SECTION END */\n";
   }