File: blacs_get_.c

package info (click to toggle)
blacs-mpi 1.1-28.2
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 2,320 kB
  • ctags: 2,031
  • sloc: fortran: 14,968; ansic: 12,353; makefile: 531; sh: 1
file content (111 lines) | stat: -rw-r--r-- 2,676 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#include "Bdef.h"
#if (INTFACE == C_CALL)
void Cblacs_get(int ConTxt, int what, int *val)
#else
F_VOID_FUNC blacs_get_(int *ConTxt, int *what, int *val)
#endif
{
   int Csys2blacs_handle(MPI_Comm);
   int ierr, *iptr;
#ifdef UseF77Mpi
   MPI_Comm comm;
#else
   int comm;
#endif
   BLACSCONTEXT *ctxt;

   switch( Mpval(what) )
   {
   case SGET_SYSCONTXT:
      if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(val, &ierr);
#if (INTFACE == C_CALL)
      *val = Csys2blacs_handle(MPI_COMM_WORLD);
#else
      *val = *BI_F77_MPI_COMM_WORLD;
#endif
      break;
   case SGET_MSGIDS:
      if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(val, &val[1]);
      iptr = &val[1];
      BI_MPI_Attr_get(BI_MPI_COMM_WORLD, BI_MPI_TAG_UB, (BVOID **) &iptr,
                      val, ierr);
      val[0] = 0;
      val[1] = *iptr;
      break;
   case SGET_DEBUGLVL:
      *val = BlacsDebugLvl;
      break;
   case SGET_BLACSCONTXT:
      MGetConTxt(Mpval(ConTxt), ctxt);
#if (INTFACE == C_CALL)

#ifdef UseF77Mpi

#if (BI_TransComm == BONEHEAD)
   if (ctxt->C_comm == MPI_COMM_NULL)
   {
      BI_MPI_F77_to_c_trans_comm(ctxt->pscp.comm, &ctxt->C_comm);
   }
   *val = Csys2blacs_handle(ctxt->C_comm);
#else
   BI_MPI_F77_to_c_trans_comm(ctxt->pscp.comm, &comm);
   *val = Csys2blacs_handle(comm);
#endif

#else  /* we are returning a C handle, and using the C MPI interface */
   *val = Csys2blacs_handle(ctxt->pscp.comm);
#endif

#else  /* if user called the fortran interface to the BLACS */

#ifdef UseF77Mpi

   *val = ctxt->pscp.comm;

#else  /* User called F77 interface, but we're using C interface MPI */

#if (BI_TransComm == BONEHEAD)
   if (ctxt->F77_comm == NULL)
   {
      ctxt->F77_comm = (int *) malloc(sizeof(int));
      BI_MPI_C_to_f77_trans_comm(ctxt->pscp.comm, ctxt->F77_comm);
   }
   *val = *ctxt->F77_comm;
#else
   BI_MPI_C_to_f77_trans_comm(ctxt->pscp.comm, &comm);
   *val = comm;
#endif

#endif

#endif
      break;
   case SGET_NR_BS:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->Nr_bs;
      break;
   case SGET_NB_BS:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->Nb_bs - 1;
      break;
   case SGET_NR_CO:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->Nr_co;
      break;
   case SGET_NB_CO:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->Nb_co - 1;
      break;
   case SGET_TOPSREPEAT:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->TopsRepeat;
      break;
   case SGET_TOPSCOHRNT:
      MGetConTxt(Mpval(ConTxt), ctxt);
      *val = ctxt->TopsCohrnt;
      break;
   default:
      BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Unknown WHAT (%d)",
                Mpval(what));
   }
}