/*@C PetscInitializeFortran - Routine that should be called soon AFTER the call to PetscInitialize() if one is using a C main program that calls Fortran routines that in turn call PETSc routines. Collective on PETSC_COMM_WORLD Level: beginner Notes: PetscInitializeFortran() initializes some of the default viewers, communicators, etc. for use in the Fortran if a user's main program is written in C. PetscInitializeFortran() is NOT needed if a user's main program is written in Fortran; in this case, just calling PetscInitialize() in the main (Fortran) program is sufficient. .seealso: PetscInitialize() .keywords: Mixing C and Fortran, passing PETSc objects to Fortran @*/ PetscErrorCode PetscInitializeFortran(void) { MPI_Fint c1=0,c2=0; if (PETSC_COMM_WORLD) c1 = MPI_Comm_c2f(PETSC_COMM_WORLD); c2 = MPI_Comm_c2f(PETSC_COMM_SELF); petscsetcommonblock_(&c1,&c2); #if defined(PETSC_USE_REAL___FLOAT128) { MPI_Fint freal,fscalar,fsum; freal = MPI_Type_c2f(MPIU_REAL); fscalar = MPI_Type_c2f(MPIU_SCALAR); fsum = MPI_Op_c2f(MPIU_SUM); petscsetcommonblockmpi_(&freal,&fscalar,&fsum); } #endif { PetscReal pi = PETSC_PI; PetscReal maxreal = PETSC_MAX_REAL; PetscReal minreal = PETSC_MIN_REAL; PetscReal eps = PETSC_MACHINE_EPSILON; PetscReal seps = PETSC_SQRT_MACHINE_EPSILON; PetscReal small = PETSC_SMALL; PetscReal pinf = PETSC_INFINITY; PetscReal pninf = PETSC_NINFINITY; petscsetcommonblocknumeric_(&pi,&maxreal,&minreal,&eps,&seps,&small,&pinf,&pninf); } return 0; }
__FRET__ __FFNAME__(__FPARAMS__) { double tstart, tstop; #if HAVE_CREQ /* HAVE _CREQ */ MPI_Request creq; #endif #if HAVE_CSTAT /* HAVE _CSTAT */ MPI_Status cstat; #endif #if HAVE_CCOMM_OUT MPI_Comm ccomm_out; #endif /* HAVE _CCOMM_OUT */ #if HAVE_CCOMM_INOUT MPI_Comm ccomm_inout; #endif /* HAVE _CCOMM_INOUT */ #if HAVE_CCOMM_INOUT ccomm_inout = MPI_Comm_f2c(*comm_inout); #endif #if HAVE_CGROUP_OUT /* HAVE _CGROUP_OUT */ MPI_Group cgroup_out; #endif IPM_TIMESTAMP(tstart); p__FFNAME__(__FARGS__); IPM_TIMESTAMP(tstop); if( ipm_state!=STATE_ACTIVE ) { return; } #if HAVE_CSTAT /* HAVE_CSTAT */ if (*info==MPI_SUCCESS) MPI_Status_c2f(&cstat, status); #endif #if HAVE_CREQ /* HAVE_CREQ */ if( *info==MPI_SUCCESS ) *req=MPI_Request_c2f(creq); #endif #if HAVE_CCOMM_OUT /* HAVE _CCOMM_OUT */ if( *info==MPI_SUCCESS ) *comm_out=MPI_Comm_c2f(ccomm_out); #endif #if HAVE_CCOMM_INOUT /* HAVE _CCOMM_INOUT */ if( *info==MPI_SUCCESS ) *comm_inout=MPI_Comm_c2f(ccomm_inout); #endif #if HAVE_CGROUP_OUT /* HAVE _CGROUP_OUT */ if( *info==MPI_SUCCESS ) *group_out=MPI_Group_c2f(cgroup_out); #endif IPM___CFNAME__(__F2CARGS__, tstart, tstop); }
void numfact(unsigned int nz, int* I, int* J, K* C) { _id = new typename MUMPS_STRUC_C<K>::trait(); _id->job = -1; _id->par = 1; _id->comm_fortran = MPI_Comm_c2f(DMatrix::_communicator); const Option& opt = *Option::get(); if(S == 'S') _id->sym = opt.val<char>("master_not_spd", 0) ? 2 : 1; else _id->sym = 0; MUMPS_STRUC_C<K>::mumps_c(_id); _id->n = _id->lrhs = DMatrix::_n; _id->nz_loc = nz; _id->irn_loc = I; _id->jcn_loc = J; _id->a_loc = reinterpret_cast<typename MUMPS_STRUC_C<K>::mumps_type*>(C); _id->nrhs = 1; _id->icntl[4] = 0; for(unsigned short i = 5; i < 40; ++i) { int val = opt.val<int>("master_mumps_icntl_" + to_string(i + 1)); if(val != std::numeric_limits<int>::lowest()) _id->icntl[i] = val; } _id->job = 4; if(opt.val<char>("verbosity", 0) < 3) _id->icntl[2] = 0; MUMPS_STRUC_C<K>::mumps_c(_id); if(DMatrix::_rank == 0 && _id->infog[0] != 0) std::cerr << "BUG MUMPS, INFOG(1) = " << _id->infog[0] << std::endl; _id->icntl[2] = 0; delete [] I; }
void ompi_cart_create_f(MPI_Fint *old_comm, MPI_Fint *ndims, MPI_Fint *dims, ompi_fortran_logical_t *periods, ompi_fortran_logical_t *reorder, MPI_Fint *comm_cart, MPI_Fint *ierr) { MPI_Comm c_comm1, c_comm2; int size, c_ierr; OMPI_ARRAY_NAME_DECL(dims); OMPI_LOGICAL_ARRAY_NAME_DECL(periods); c_comm1 = MPI_Comm_f2c(*old_comm); size = OMPI_FINT_2_INT(*ndims); OMPI_ARRAY_FINT_2_INT(dims, size); OMPI_ARRAY_LOGICAL_2_INT(periods, size); c_ierr = MPI_Cart_create(c_comm1, OMPI_FINT_2_INT(*ndims), OMPI_ARRAY_NAME_CONVERT(dims), OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods), OMPI_LOGICAL_2_INT(*reorder), &c_comm2); if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); if (MPI_SUCCESS == c_ierr) { *comm_cart = MPI_Comm_c2f(c_comm2); } /* * Need to convert back into Fortran, to not surprise the user */ OMPI_ARRAY_FINT_2_INT_CLEANUP(dims); OMPI_ARRAY_INT_2_LOGICAL(periods, size); }
int main(int argc,char **args) { PetscErrorCode ierr; PetscInt m = 10; int fcomm; Vec vec; ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr; /* This function should be called to be able to use PETSc routines from the FORTRAN subroutines needed by this program */ PetscInitializeFortran(); ierr = VecCreate(PETSC_COMM_WORLD,&vec);CHKERRQ(ierr); ierr = VecSetSizes(vec,PETSC_DECIDE,m);CHKERRQ(ierr); ierr = VecSetFromOptions(vec);CHKERRQ(ierr); /* Call Fortran routine - the use of MPI_Comm_c2f() allows translation of the MPI_Comm from C so that it can be properly interpreted from Fortran. */ fcomm = MPI_Comm_c2f(PETSC_COMM_WORLD); ex7f_(&vec,&fcomm); ierr = VecView(vec,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecDestroy(&vec);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
void ompi_graph_create_f(MPI_Fint *comm_old, MPI_Fint *nnodes, MPI_Fint *indx, MPI_Fint *edges, ompi_fortran_logical_t *reorder, MPI_Fint *comm_graph, MPI_Fint *ierr) { int c_ierr; MPI_Comm c_comm_old, c_comm_graph; OMPI_ARRAY_NAME_DECL(indx); OMPI_ARRAY_NAME_DECL(edges); c_comm_old = MPI_Comm_f2c(*comm_old); OMPI_ARRAY_FINT_2_INT(indx, *nnodes); /* Number of edges is equal to the last entry in the index array */ OMPI_ARRAY_FINT_2_INT(edges, indx[*nnodes - 1]); c_ierr = MPI_Graph_create(c_comm_old, OMPI_FINT_2_INT(*nnodes), OMPI_ARRAY_NAME_CONVERT(indx), OMPI_ARRAY_NAME_CONVERT(edges), OMPI_LOGICAL_2_INT(*reorder), &c_comm_graph); if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); if (OMPI_SUCCESS == c_ierr) { *comm_graph = MPI_Comm_c2f(c_comm_graph); } OMPI_ARRAY_FINT_2_INT_CLEANUP(indx); OMPI_ARRAY_FINT_2_INT_CLEANUP(edges); }
LIS_INT lis_psolvet_saamg(LIS_SOLVER solver, LIS_VECTOR b, LIS_VECTOR x) { #if defined(USE_SAAMG) LIS_INT n; LIS_PRECON precon; LIS_MATRIX A; #ifdef USE_MPI LIS_MPI_Fint comm; #endif LIS_DEBUG_FUNC_IN; A = solver->A; precon = solver->precon; #ifdef USE_MPI comm = MPI_Comm_c2f(A->comm); n = b->np; (*(void (*)())f_v_cycle_ptr)(b->value,x->value,precon->temp->value,&precon->level_num, &comm,A->commtable->ws,A->commtable->wr,&n,&precon->wsize); #else n = b->n; (*(void (*)())f_v_cycle_ptr)(&n,b->value,x->value,&precon->level_num,precon->temp->value); #endif LIS_DEBUG_FUNC_OUT; return LIS_SUCCESS; #else LIS_DEBUG_FUNC_IN; lis_vector_copy(b,x); LIS_DEBUG_FUNC_OUT; return LIS_SUCCESS; #endif }
int geopm_comm_split_ppn1_f(int comm, int *ppn1_comm) { MPI_Comm ppn1_comm_c; int err = geopm_comm_split_ppn1(MPI_Comm_f2c(comm), &ppn1_comm_c); *ppn1_comm = MPI_Comm_c2f(ppn1_comm_c); return err; }
void cxios_init_client(const char* client_id , int len_client_id, MPI_Fint* f_local_comm, MPI_Fint* f_return_comm ) { std::string str; ep_lib::MPI_Comm local_comm; ep_lib::MPI_Comm return_comm; //ep_lib::fc_comm_map.clear(); if (!cstr2string(client_id, len_client_id, str)) return; int initialized; MPI_Initialized(&initialized); #ifdef _usingMPI if (initialized) local_comm=MPI_Comm_f2c(*f_local_comm); else local_comm=MPI_COMM_NULL; #elif _usingEP ep_lib::fc_comm_map.clear(); if (initialized) local_comm=ep_lib::EP_Comm_f2c(static_cast<int>(*f_local_comm)); else local_comm=MPI_COMM_NULL; #endif CXios::initClientSide(str, local_comm, return_comm); #ifdef _usingMPI *f_return_comm=MPI_Comm_c2f(return_comm); #elif _usingEP *f_return_comm=ep_lib::EP_Comm_c2f(return_comm); #endif CTimer::get("XIOS init").suspend(); CTimer::get("XIOS").suspend(); }
int geopm_comm_split_shared_f(int comm, int *split_comm) { MPI_Comm split_comm_c; int err = geopm_comm_split_shared(MPI_Comm_f2c(comm), &split_comm_c); *split_comm = MPI_Comm_c2f(split_comm_c); return err; }
int geopm_comm_split_f(int comm, int *split_comm, int *is_ctl_comm) { MPI_Comm split_comm_c; int err = geopm_comm_split(MPI_Comm_f2c(comm), &split_comm_c, is_ctl_comm); *split_comm = MPI_Comm_c2f(split_comm_c); return err; }
void mpi_cart_sub_f(MPI_Fint *comm, ompi_fortran_logical_t *remain_dims, MPI_Fint *new_comm, MPI_Fint *ierr) { MPI_Comm c_comm, c_new_comm; /* * Just in the case, when sizeof(logical)!=sizeof(int) and * Fortran TRUE-value != 1, we have to convert -- then we need * to know the number of dimensions, for the size of remain_dims */ #if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1 int ndims; #endif OMPI_LOGICAL_ARRAY_NAME_DECL(remain_dims); c_comm = MPI_Comm_f2c(*comm); c_new_comm = MPI_Comm_f2c(*new_comm); #if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1 *ierr = OMPI_INT_2_FINT(MPI_Cartdim_get(c_comm, &ndims)); if (MPI_SUCCESS != OMPI_FINT_2_INT(*ierr)) { return; } #endif OMPI_ARRAY_LOGICAL_2_INT(remain_dims, ndims); *ierr = OMPI_INT_2_FINT(MPI_Cart_sub(c_comm, OMPI_LOGICAL_ARRAY_NAME_CONVERT(remain_dims), &c_new_comm)); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { *new_comm = MPI_Comm_c2f(c_new_comm); } OMPI_ARRAY_INT_2_LOGICAL(remain_dims, ndims); }
EXTERN_C_BEGIN void PETSC_STDCALL petscobjectgetcomm_(PetscObject *obj,int *comm,PetscErrorCode *ierr) { MPI_Comm c; *ierr = PetscObjectGetComm(*obj,&c); *(int*)comm = MPI_Comm_c2f(c); }
EXPORT_MPI_API void FORTRAN_API mpi_comm_dup_ ( MPI_Fint *comm, MPI_Fint *comm_out, MPI_Fint *__ierr ) { MPI_Comm l_comm_out; *__ierr = MPI_Comm_dup( MPI_Comm_f2c(*comm), &l_comm_out ); *comm_out = MPI_Comm_c2f(l_comm_out); }
/* initialization function for basic pepc parameters */ FCSResult fcs_pepc_init(FCS handle) { handle->shift_positions = 1; handle->destroy = fcs_pepc_destroy; handle->set_parameter = fcs_pepc_set_parameter; handle->print_parameters = fcs_pepc_print_parameters; handle->tune = fcs_pepc_tune; handle->run = fcs_pepc_run; handle->set_compute_virial = fcs_pepc_require_virial; handle->get_virial = fcs_pepc_get_virial; handle->pepc_param = malloc(sizeof(*handle->pepc_param)); handle->pepc_param->theta = 0.6; handle->pepc_param->epsilon = 0.0; handle->pepc_param->require_virial = 0; handle->pepc_param->num_walk_threads = 3; handle->pepc_param->load_balancing = 0; handle->pepc_param->dipole_correction = 1; handle->pepc_param->npm = -45.0; handle->pepc_param->debug_level = 0; fcs_pepc_internal_t *pepc_internal; MPI_Comm comm = fcs_get_communicator(handle); MPI_Fint fcomm = MPI_Comm_c2f(comm); pepc_scafacos_initialize(&fcomm); handle->method_context = malloc(sizeof(fcs_pepc_internal_t)); pepc_internal = (fcs_pepc_internal_t*) handle->method_context; pepc_internal->work_length = -1; pepc_internal->work = NULL; return FCS_RESULT_SUCCESS; }
void mpif_cart_sub_(MPI_Fint *old_comm, int *belongs, MPI_Fint *new_comm, int *error) { MPI_Comm old_comm_c = MPI_Comm_f2c(*old_comm); MPI_Comm new_comm_c; *error = MPI_Cart_sub(old_comm_c, belongs, &new_comm_c); *new_comm = MPI_Comm_c2f(new_comm_c); }
EXPORT_MPI_API void FORTRAN_API mpi_intercomm_merge_ ( MPI_Fint *comm, MPI_Fint *high, MPI_Fint *comm_out, MPI_Fint *__ierr ) { MPI_Comm l_comm_out; *__ierr = MPI_Intercomm_merge( MPI_Comm_f2c(*comm), (int)*high, &l_comm_out); *comm_out = MPI_Comm_c2f(l_comm_out); }
void mpif_intercomm_merge_(MPI_Fint *intercomm, int *high, MPI_Fint *newintracomm, int *error) { MPI_Comm intercomm_c = MPI_Comm_f2c(*intercomm); MPI_Comm newintracomm_c; *error = MPI_Intercomm_merge(intercomm_c, *high, &newintracomm_c); *newintracomm = MPI_Comm_c2f(newintracomm_c); }
int PNX(create_procmesh_2d_f03)(MPI_Fint f_comm, int np0, int np1, MPI_Fint * f_comm_cart_2d) { MPI_Comm comm, comm_cart_2d; comm = MPI_Comm_f2c(f_comm); int ret = PNX(create_procmesh_2d)(comm, np0, np1, &comm_cart_2d); *f_comm_cart_2d = MPI_Comm_c2f(comm_cart_2d); return ret; }
int PNX(create_procmesh_f03)(int rnk, MPI_Fint f_comm, const int * np, MPI_Fint * f_comm_cart) { MPI_Comm comm, comm_cart; comm = MPI_Comm_f2c(f_comm); int ret = PNX(create_procmesh)(rnk, comm, np, &comm_cart); *f_comm_cart = MPI_Comm_c2f(comm_cart); return ret; }
void mpif_comm_dup_(MPI_Fint *comm, MPI_Fint *newcomm, int *error) { MPI_Comm comm_c = MPI_Comm_f2c(*comm); MPI_Comm newcomm_c; *error = MPI_Comm_dup(comm_c, &newcomm_c); *newcomm = MPI_Comm_c2f(newcomm_c); }
void mpif_comm_split_(MPI_Fint *comm, int *color, int *key, MPI_Fint *newcomm, int *error) { MPI_Comm comm_c = MPI_Comm_f2c(*comm); MPI_Comm newcomm_c; *error = MPI_Comm_split(comm_c, *color, *key, &newcomm_c); *newcomm = MPI_Comm_c2f(newcomm_c); }
void mpi_comm_get_parent_f(MPI_Fint *parent, MPI_Fint *ierr) { MPI_Comm c_parent; *ierr = OMPI_INT_2_FINT(MPI_Comm_get_parent(&c_parent)); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { *parent = MPI_Comm_c2f(c_parent); } }
void mpif_graph_create_(MPI_Fint *comm_old, int *nnodes, int *index, int *edges, int *reorder, MPI_Fint *comm_graph, int *error) { MPI_Comm comm_old_c = MPI_Comm_f2c(*comm_old); MPI_Comm comm_graph_c; *error = MPI_Graph_create(comm_old_c, *nnodes, index, edges, *reorder, &comm_graph_c); *comm_graph = MPI_Comm_c2f(comm_graph_c); }
void mpif_intercomm_create_(MPI_Fint *local_comm, int *local_leader, MPI_Fint *peer_comm, int *remote_leader, int *tag, MPI_Fint *newintercomm, int *error) { MPI_Comm local_comm_c = MPI_Comm_f2c(*local_comm); MPI_Comm peer_comm_c = MPI_Comm_f2c(*peer_comm); MPI_Comm newintercomm_c; *error = MPI_Intercomm_create(local_comm_c, *local_leader, peer_comm_c, *remote_leader, *tag, &newintercomm_c); *newintercomm = MPI_Comm_c2f(newintercomm_c); }
void mpif_cart_create_(MPI_Fint *comm_old, int *ndims, int *dims, int *periods, int *reorder, MPI_Fint *comm_cart, int *error) { MPI_Comm comm_old_c = MPI_Comm_f2c(*comm_old); MPI_Comm comm_cart_c; *error = MPI_Cart_create(comm_old_c, *ndims, dims, periods, *reorder, &comm_cart_c); *comm_cart = MPI_Comm_c2f(comm_cart_c); }
void mpi_comm_join_f(MPI_Fint *fd, MPI_Fint *intercomm, MPI_Fint *ierr) { MPI_Comm c_intercomm; *ierr = OMPI_INT_2_FINT(MPI_Comm_join(OMPI_FINT_2_INT(*fd), &c_intercomm)); if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) { *intercomm = MPI_Comm_c2f(c_intercomm); } }
void mpif_comm_create_(MPI_Fint *comm, MPI_Fint *group, MPI_Fint *newcomm, int *error) { MPI_Comm comm_c = MPI_Comm_f2c(*comm); MPI_Comm newcomm_c; MPI_Group group_c = MPI_Group_f2c(*group); *error = MPI_Comm_create(comm_c, group_c, &newcomm_c); *newcomm = MPI_Comm_c2f(newcomm_c); }
void numfact(MatrixCSR<K>* const& A, bool detection = false, K* const& schur = nullptr) { static_assert(N == 'C' || N == 'F', "Unknown numbering"); const Option& opt = *Option::get(); if(!_id) { _id = new typename MUMPS_STRUC_C<K>::trait(); _id->job = -1; _id->par = 1; _id->comm_fortran = MPI_Comm_c2f(MPI_COMM_SELF); _id->sym = A->_sym ? 1 + (opt.val<char>("local_operators_not_spd", 0) || detection) : 0; MUMPS_STRUC_C<K>::mumps_c(_id); } _id->icntl[23] = detection; _id->cntl[2] = -1.0e-6; if(N == 'C') std::for_each(A->_ja, A->_ja + A->_nnz, [](int& i) { ++i; }); _id->jcn = A->_ja; _id->a = reinterpret_cast<typename MUMPS_STRUC_C<K>::mumps_type*>(A->_a); int* listvar = nullptr; if(_id->job == -1) { _id->nrhs = 1; std::fill_n(_id->icntl, 5, 0); _id->n = A->_n; for(unsigned short i = 5; i < 40; ++i) { int val = opt.val<int>("mumps_icntl_" + to_string(i + 1)); if(val != std::numeric_limits<int>::lowest()) _id->icntl[i] = val; } _id->lrhs = A->_n; _I = new int[A->_nnz]; _id->nz = A->_nnz; for(int i = 0; i < A->_n; ++i) std::fill(_I + A->_ia[i] - (N == 'F'), _I + A->_ia[i + 1] - (N == 'F'), i + 1); _id->irn = _I; if(schur) { listvar = new int[static_cast<int>(std::real(schur[0]))]; std::iota(listvar, listvar + static_cast<int>(std::real(schur[0])), static_cast<int>(std::real(schur[1]))); _id->size_schur = _id->schur_lld = static_cast<int>(std::real(schur[0])); _id->icntl[18] = 2; _id->icntl[25] = 0; _id->listvar_schur = listvar; _id->nprow = _id->npcol = 1; _id->mblock = _id->nblock = 100; _id->schur = reinterpret_cast<typename MUMPS_STRUC_C<K>::mumps_type*>(schur); } _id->job = 4; } else _id->job = 2; MUMPS_STRUC_C<K>::mumps_c(_id); delete [] listvar; if(_id->infog[0] != 0) std::cerr << "BUG MUMPS, INFOG(1) = " << _id->infog[0] << std::endl; if(N == 'C') std::for_each(A->_ja, A->_ja + A->_nnz, [](int& i) { --i; }); }
EXPORT_MPI_API void FORTRAN_API mpi_intercomm_create_ ( MPI_Fint *local_comm, MPI_Fint *local_leader, MPI_Fint *peer_comm, MPI_Fint *remote_leader, MPI_Fint *tag, MPI_Fint *comm_out, MPI_Fint *__ierr ) { MPI_Comm l_comm_out; *__ierr = MPI_Intercomm_create( MPI_Comm_f2c(*local_comm), (int)*local_leader, MPI_Comm_f2c(*peer_comm), (int)*remote_leader, (int)*tag, &l_comm_out); *comm_out = MPI_Comm_c2f(l_comm_out); }