Exemplo n.º 1
0
EXPORT_MPI_API void FORTRAN_API mpi_attr_get_ ( MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attr_value, MPI_Fint *found, MPI_Fint *__ierr )
{
    void *vval;
    int  l_found;

    *__ierr = MPI_Attr_get( MPI_Comm_f2c(*comm), (int)*keyval, &vval,
                            &l_found);

    /* Convert attribute value to integer.  This code handles the case
       where sizeof(int) < sizeof(void *), and the value was stored as a
       void * 
     */
    if ((int)*__ierr || l_found == 0)
	*attr_value = 0;
    else {
	MPI_Aint lvval = (MPI_Aint)vval;
	*attr_value = (int)lvval;
    }

    *found = MPIR_TO_FLOG(l_found);
    return;
}
Exemplo n.º 2
0
void mpi_reduce_f(char *sendbuf, char *recvbuf, MPI_Fint *count,
		  MPI_Fint *datatype, MPI_Fint *op, 
		  MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr)
{
    MPI_Datatype c_type;
    MPI_Op c_op;
    MPI_Comm c_comm;

    c_type = MPI_Type_f2c(*datatype);
    c_op = MPI_Op_f2c(*op);
    c_comm = MPI_Comm_f2c(*comm);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    *ierr = OMPI_INT_2_FINT(MPI_Reduce(sendbuf, recvbuf,
				       OMPI_FINT_2_INT(*count),
				       c_type, c_op, 
				       OMPI_FINT_2_INT(*root),
				       c_comm));
}
Exemplo n.º 3
0
void mpi_gather_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
		  char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype, 
		  MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr)
{
    MPI_Comm c_comm;
    MPI_Datatype c_sendtype, c_recvtype;

    c_comm = MPI_Comm_f2c(*comm);
    c_sendtype = MPI_Type_f2c(*sendtype);
    c_recvtype = MPI_Type_f2c(*recvtype);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    *ierr = OMPI_INT_2_FINT(MPI_Gather(sendbuf, OMPI_FINT_2_INT(*sendcount),
				       c_sendtype, recvbuf, 
				       OMPI_FINT_2_INT(*recvcount),
				       c_recvtype,
				       OMPI_FINT_2_INT(*root),
				       c_comm));
}
Exemplo n.º 4
0
void mpi_recv_f(char *buf, MPI_Fint *count, MPI_Fint *datatype, 
                MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, 
                MPI_Fint *status, MPI_Fint *ierr)
{
   MPI_Status *c_status;
#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
   MPI_Status c_status2;
#endif
   MPI_Comm c_comm = MPI_Comm_f2c(*comm);
   MPI_Datatype c_type = MPI_Type_f2c(*datatype);

   /* See if we got MPI_STATUS_IGNORE */
   if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
      c_status = MPI_STATUS_IGNORE;
   } else {
      /* If sizeof(int) == sizeof(INTEGER), then there's no
         translation necessary -- let the underlying functions write
         directly into the Fortran status */

#if OMPI_SIZEOF_FORTRAN_INTEGER == SIZEOF_INT
      c_status = (MPI_Status *) status;
#else
      c_status = &c_status2;
#endif
   }

   /* Call the C function */
   *ierr = OMPI_INT_2_FINT(MPI_Recv(OMPI_F2C_BOTTOM(buf), OMPI_FINT_2_INT(*count),
                                    c_type, OMPI_FINT_2_INT(*source), 
                                    OMPI_FINT_2_INT(*tag), c_comm,
                                    c_status));
#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
   if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) &&
       MPI_STATUS_IGNORE != c_status) {
       MPI_Status_c2f(c_status, status);
   }
#endif
}
Exemplo n.º 5
0
void ompi_unpack_f(char *inbuf, MPI_Fint *insize, MPI_Fint *position,
		  char *outbuf, MPI_Fint *outcount, MPI_Fint *datatype,
		  MPI_Fint *comm, MPI_Fint *ierr)
{
   int c_ierr;
   MPI_Comm c_comm;
   MPI_Datatype c_type;
   OMPI_SINGLE_NAME_DECL(position);

   c_comm = MPI_Comm_f2c(*comm);
   c_type = MPI_Type_f2c(*datatype);
   OMPI_SINGLE_FINT_2_INT(position);

   c_ierr = MPI_Unpack(inbuf, OMPI_FINT_2_INT(*insize),
                       OMPI_SINGLE_NAME_CONVERT(position),
                       OMPI_F2C_BOTTOM(outbuf), OMPI_FINT_2_INT(*outcount),
                       c_type, c_comm);
   if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

   if (MPI_SUCCESS == c_ierr) {
        OMPI_SINGLE_INT_2_FINT(position);
    }
}
Exemplo n.º 6
0
void nbc_ialltoallv_f(void *sendbuf, int *sendcounts, int *sdispls, int *sendtype,
    void *recvbuf, int *recvcounts, int *rdispls, int *recvtype, int *fcomm, int *fhandle, int *ierr) {
#else
void NBC_F77_FUNC_(nbc_ialltoallv,NBC_IALLTOALLV)(void *sendbuf, int *sendcounts, int *sdispls, int *sendtype,
    void *recvbuf, int *recvcounts, int *rdispls, int *recvtype, int *fcomm, int *fhandle, int *ierr);
void NBC_F77_FUNC_(nbc_ialltoallv,NBC_IALLTOALLV)(void *sendbuf, int *sendcounts, int *sdispls, int *sendtype,
    void *recvbuf, int *recvcounts, int *rdispls, int *recvtype, int *fcomm, int *fhandle, int *ierr)  {
#endif
  MPI_Datatype rtype, stype;
  MPI_Comm comm;
  NBC_Handle *handle;

  /* this is the only MPI-2 we need :-( */
  rtype = MPI_Type_f2c(*recvtype);
  stype = MPI_Type_f2c(*sendtype);
  comm = MPI_Comm_f2c(*fcomm);

  /* create a new handle in handle table */
  NBC_Create_fortran_handle(fhandle, &handle);

  /* call NBC function */
  *ierr = NBC_Ialltoallv(sendbuf, sendcounts, sdispls, stype, recvbuf, recvcounts, rdispls, rtype, comm, handle);
}
Exemplo n.º 7
0
void ompi_cart_shift_f(MPI_Fint *comm, MPI_Fint *direction, MPI_Fint *disp,
		      MPI_Fint *rank_source, MPI_Fint *rank_dest,
		      MPI_Fint *ierr)
{
    int c_ierr;
    MPI_Comm c_comm;
    OMPI_SINGLE_NAME_DECL(rank_source);
    OMPI_SINGLE_NAME_DECL(rank_dest);

    c_comm = MPI_Comm_f2c(*comm);

    c_ierr = MPI_Cart_shift(c_comm, 
                            OMPI_FINT_2_INT(*direction),
                            OMPI_FINT_2_INT(*disp),
                            OMPI_SINGLE_NAME_CONVERT(rank_source),
                            OMPI_SINGLE_NAME_CONVERT(rank_dest));
    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

    if (MPI_SUCCESS == c_ierr) {
        OMPI_SINGLE_INT_2_FINT(rank_source);
        OMPI_SINGLE_INT_2_FINT(rank_dest);
    }
}
Exemplo n.º 8
0
/* Fortran needs to pass MPI comm/info as integers. */
int
nc_open_par_fortran(const char *path, int mode, int comm,
		    int info, int *ncidp)
{
#ifndef USE_PARALLEL
   return NC_ENOPAR;
#else
   MPI_Comm comm_c;
   MPI_Info info_c;

   /* Convert fortran comm and info to C comm and info, if there is a
    * function to do so. Otherwise just pass them. */
#ifdef HAVE_MPI_COMM_F2C
   comm_c = MPI_Comm_f2c(comm);
   info_c = MPI_Info_f2c(info);
#else
   comm_c = (MPI_Comm)comm;
   info_c = (MPI_Info)info;
#endif

   return nc_open_par(path, mode, comm_c, info_c, ncidp);
#endif
}
Exemplo n.º 9
0
/**
 * ADIOS init and create group etc.
 * Return: pointer to the ADIOS group structure
 */
SEXP R_create(SEXP R_groupname,
              SEXP R_buffersize,
              SEXP R_comm)
{
    const char *groupname = CHARPT(R_groupname, 0);
    int buffer = asInteger(R_buffersize);
    MPI_Comm comm = MPI_Comm_f2c(INTEGER(R_comm)[0]);

    int64_t m_adios_group;
    
    adios_init_noxml (comm);
    adios_set_max_buffer_size (buffer); // Default buffer size for write is 20. User can change this value

    adios_declare_group (&m_adios_group, groupname, "", adios_flag_yes);
    adios_select_method (m_adios_group, "MPI", "", ""); // Default method is MPI. Let users choose different methods later.

    // Pass group pointer to R
    SEXP R_group = PROTECT(allocVector(REALSXP, 1));
    REAL(R_group)[0] = (double)m_adios_group;
    UNPROTECT(1);

    return R_group;
}
Exemplo n.º 10
0
void NAME_ROUTINE_C2F(mpi_reduce) (void *sendbuf, void *recvbuf, MPI_Fint *count,
	MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *root, MPI_Fint *comm,
	MPI_Fint *ierror)
#endif
{
	MPI_Comm c = MPI_Comm_f2c(*comm);

#if defined(ENABLE_LOAD_BALANCING)
	DLB_MPI_Reduce_F_enter (MPI3_VOID_P_CAST sendbuf, recvbuf, count, datatype, op, root, comm, ierror);
#endif

	Extrae_MPI_ProcessCollectiveCommunicator (c);

	if (mpitrace_on)
	{
		DEBUG_INTERFACE(ENTER)
		Backend_Enter_Instrumentation (2+Caller_Count[CALLER_MPI]);
		PMPI_Reduce_Wrapper (MPI3_VOID_P_CAST sendbuf, recvbuf, count, datatype, op, root, comm,
                         ierror);
		Backend_Leave_Instrumentation ();
		DEBUG_INTERFACE(LEAVE)
	}
	else
Exemplo n.º 11
0
void MUMPS_CALL
MUMPS_PARMETIS_64(MUMPS_INT8 *first,      MUMPS_INT8 *vertloctab,
                  MUMPS_INT8 *edgeloctab,
#if defined(parmetis3)
                  MUMPS_INT  *numflag, MUMPS_INT  *options,
#else
                  MUMPS_INT8 *numflag, MUMPS_INT8 *options,
#endif
                  MUMPS_INT8 *order,
                  MUMPS_INT8 *sizes,         MUMPS_INT *comm,
                  MUMPS_INT  *ierr)
{
  MPI_Comm  int_comm;
#if defined(parmetis)
#  if (IDXTYPEWIDTH == 64)
  int iierr;
#endif
#endif
  int_comm = MPI_Comm_f2c(*comm);
#if defined(parmetis3)
  /* Prototype may not match with 32-bit integers and Parmetis3 */
  ParMETIS_V3_NodeND(first, vertloctab, edgeloctab, numflag, options, order, sizes, &int_comm);
#elif defined(parmetis)
#  if (IDXTYPEWIDTH == 64)
      *ierr=0;
      iierr=ParMETIS_V3_NodeND(first, vertloctab, edgeloctab, numflag, options, order, sizes, &int_comm);
      if(iierr != METIS_OK)
        *ierr=1;
#  else
      /* SHOULD NEVER BE CALLED */
      printf("** Error: ParMETIS version >= 4, IDXTYPE WIDTH !=64, but MUMPS_PARMETIS_64 was called\n");
      *ierr=1;
#  endif
#endif
  return;
}
Exemplo n.º 12
0
void mpi_sendrecv_replace_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
			    MPI_Fint *dest, MPI_Fint *sendtag,
			    MPI_Fint *source, MPI_Fint *recvtag,
			    MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr)
{
   MPI_Datatype c_type = MPI_Type_f2c(*datatype);
   MPI_Comm c_comm;
   MPI_Status c_status;

   c_comm = MPI_Comm_f2c (*comm);
   
   *ierr = OMPI_INT_2_FINT(MPI_Sendrecv_replace(OMPI_F2C_BOTTOM(buf),
                                                OMPI_FINT_2_INT(*count),
                                                c_type, 
                                                OMPI_FINT_2_INT(*dest), 
                                                OMPI_FINT_2_INT(*sendtag), 
                                                OMPI_FINT_2_INT(*source), 
                                                OMPI_FINT_2_INT(*recvtag),
                                                c_comm, &c_status));
    if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) &&
        !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
      MPI_Status_c2f(&c_status, status);
   }
}
Exemplo n.º 13
0
RSL_LITE_EXCH_X ( int * Fcomm0, int *me0, int * np0 , int * np_x0 , int * np_y0 ,
                  int * sendw_m, int * sendw_p, int * recvw_m , int * recvw_p )
{
  int me, np, np_x, np_y ;
  int yp, ym, xp, xm ;
#ifndef STUBMPI
  MPI_Status stat ;
  MPI_Comm comm, *comm0, dummy_comm ;

  comm0 = &dummy_comm ;
  *comm0 = MPI_Comm_f2c( *Fcomm0 ) ;
  comm = *comm0 ; me = *me0 ; np = *np0 ; np_x = *np_x0 ; np_y = *np_y0 ;
  if ( np_x > 1 ) {
    MPI_Cart_shift( *comm0, 1, 1, &xm, &xp ) ;
    if ( xp != MPI_PROC_NULL && *recvw_p > 0 ) {
      MPI_Irecv ( buffer_for_proc( xp, xp_curs_recv, RSL_RECVBUF ), xp_curs_recv, MPI_CHAR, xp, me, comm, &xp_recv ) ;
    }
    if ( xm != MPI_PROC_NULL && *recvw_m > 0 ) {
      MPI_Irecv ( buffer_for_proc( xm, xm_curs_recv, RSL_RECVBUF ), xm_curs_recv, MPI_CHAR, xm, me, comm, &xm_recv ) ;
    }
    if ( xp != MPI_PROC_NULL && *sendw_p > 0 ) {
      MPI_Isend ( buffer_for_proc( xp, 0,       RSL_SENDBUF ), xp_curs, MPI_CHAR, xp, xp, comm, &xp_send ) ;
    }
    if ( xm != MPI_PROC_NULL && *sendw_m > 0 ) {
      MPI_Isend ( buffer_for_proc( xm, 0,       RSL_SENDBUF ), xm_curs, MPI_CHAR, xm, xm, comm, &xm_send ) ;
    }
    if ( xp != MPI_PROC_NULL && *recvw_p > 0 ) {  MPI_Wait( &xp_recv, &stat ) ;  }
    if ( xm != MPI_PROC_NULL && *recvw_m > 0 ) {  MPI_Wait( &xm_recv, &stat ) ;  }
    if ( xp != MPI_PROC_NULL && *sendw_p > 0 ) {  MPI_Wait( &xp_send, &stat ) ;  }
    if ( xm != MPI_PROC_NULL && *sendw_m > 0 ) {  MPI_Wait( &xm_send, &stat ) ;  }
  }
  yp_curs = 0 ; ym_curs = 0 ; xp_curs = 0 ; xm_curs = 0 ;
  yp_curs_recv = 0 ; ym_curs_recv = 0 ; 
  xp_curs_recv = 0 ; xm_curs_recv = 0 ;
#endif
}
Exemplo n.º 14
0
void ompi_comm_accept_f(char *port_name, MPI_Fint *info, MPI_Fint *root, 
		       MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *ierr, 
		       int port_name_len)
{
    int c_ierr;
    MPI_Comm c_comm, c_new_comm;
    MPI_Info c_info;
    char *c_port_name;

    c_comm = MPI_Comm_f2c(*comm);
    c_info = MPI_Info_f2c(*info);
    ompi_fortran_string_f2c(port_name, port_name_len, &c_port_name);


    c_ierr = MPI_Comm_accept(c_port_name, c_info, 
                             OMPI_FINT_2_INT(*root), 
                             c_comm, &c_new_comm);
    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

    if (MPI_SUCCESS == c_ierr) {
        *newcomm = MPI_Comm_c2f(c_new_comm);
    }
    free ( c_port_name );
}
Exemplo n.º 15
0
#define petsclogstagepop_         petsclogstagepop  
#define petsclogstageregister_    petsclogstageregister
#define petsccookieregister_      petsccookieregister
#define petsclogstagepush_        petsclogstagepush
#define petscgetflops_            petscgetflops 
#define petsclogstagegetid_       petsclogstagegetid
#endif

EXTERN_C_BEGIN

void PETSC_STDCALL petsclogprintsummary_(MPI_Comm *comm,CHAR filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
#if defined(PETSC_USE_LOG)
  char *t;
  FIXCHAR(filename,len,t);
  *ierr = PetscLogPrintSummary(MPI_Comm_f2c(*(MPI_Fint *)&*comm),t);
  FREECHAR(filename,t);
#endif
}

void PETSC_STDCALL petsclogprintDetailed_(MPI_Comm *comm,CHAR filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
{
#if defined(PETSC_USE_LOG)
  char *t;
  FIXCHAR(filename,len,t);
  *ierr = PetscLogPrintDetailed(MPI_Comm_f2c(*(MPI_Fint *)&*comm),t);
  FREECHAR(filename,t);
#endif
}

Exemplo n.º 16
0
PETSC_EXTERN void PETSC_STDCALL  petscsplitownership_(MPI_Fint * comm,PetscInt *n,PetscInt *N, int *__ierr ){
*__ierr = PetscSplitOwnership(
	MPI_Comm_f2c( *(comm) ),n,N);
}
Exemplo n.º 17
0
void PETSC_STDCALL   petsccommgetnewtag_(MPI_Fint * comm,PetscMPIInt *tag, int *__ierr ){
*__ierr = PetscCommGetNewTag(
	MPI_Comm_f2c( *(comm) ),tag);
}
Exemplo n.º 18
0
void PETSC_STDCALL  dmcartesiancreate_(MPI_Fint * comm,DM *mesh, int *__ierr ){
*__ierr = DMCartesianCreate(
	MPI_Comm_f2c( *(comm) ),mesh);
}
Exemplo n.º 19
0
int HPDDM_F77(hpddmcustomoperatorsolve)(const int* n, void (**mv)(const int*, const K*, K*, const int*), void (**precond)(const int*, const K*, K*, const int*), const K* const b, K* const sol, const int* mu, const int* comm) {
    return HPDDM::IterativeMethod::solve(CustomOperator<K>(*n, *mv, *precond), b, sol, *mu, MPI_Comm_f2c(*comm));
}
Exemplo n.º 20
0
PETSC_EXTERN void PETSC_STDCALL  iscreategeneral_(MPI_Fint * comm,PetscInt *n, PetscInt idx[],PetscCopyMode *mode,IS *is, int *__ierr ){
*__ierr = ISCreateGeneral(
	MPI_Comm_f2c( *(comm) ),*n,idx,*mode,is);
}
Exemplo n.º 21
0
Arquivo: fft2d.c Projeto: LeeJH/pde
void init_fft2d_(void )
{
  int i,j,k;
  double vm2,vm1,v,vp1,vp2,vb;
  
  commx = MPI_Comm_f2c(topo_.commxc);
  MPI_Comm_rank(commx, &irankx);
  MPI_Comm_size(commx, &isizex);

  commyz = MPI_Comm_f2c(topo_.commyzc);
  MPI_Comm_rank(commyz, &irankyz);
  MPI_Comm_size(commyz, &isizeyz);

  fftw_mpi_init();

  howmany = topo_.mxlc;
//***********  
  alloc_ly = fftw_mpi_local_size_2d(my, mz, commx, &ly, &lys);
/*  alloc_ly=fftw_mpi_local_size_many(rnk, myz, howmany,
           FFTW_MPI_DEFAULT_BLOCK, commx, &ly, &lys);
*/
//***********
  
  if(((ly-topo_.mylc)!=0) || topo_.npzc>1) {
  printf("Error,npz should equal to 1, or %d\t%d\n",irankx,ly-topo_.mylc);
  MPI_Abort(commx,1);
  }

  minp = fftw_alloc_complex(alloc_ly);
  mout = fftw_alloc_complex(alloc_ly);
  
  if( !(freq = r3tensor(topo_.mxlc, topo_.mylc*topo_.mzlc, 2)) ) 
  	printf("Malloc error!\n");  
  if( !(data = r3tensor(topo_.mxlc, topo_.mylc*topo_.mzlc, 2)) ) 
  	printf("Malloc error!\n");
/*  if( !(dar = r3tensor(topo_.mxlc, topo_.mylc, topo_.mzlc)) ) 
  	printf("Malloc error!\n");
  if( !(dai = r3tensor(topo_.mxlc, topo_.mylc, topo_.mzlc)) ) 
  	printf("Malloc error!\n");
*/
//***********
  mplanF = fftw_mpi_plan_dft_2d(my, mz, minp, mout, commx, FFTW_FORWARD, FFTW_MEASURE);
  mplanR = fftw_mpi_plan_dft_2d(my, mz, minp, mout, commx, FFTW_BACKWARD, FFTW_MEASURE);
/*  mplanF = fftw_mpi_plan_many_dft(rnk, myz, howmany,
        FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,
        minp, mout, commx, FFTW_FORWARD, FFTW_MEASURE);
  mplanR = fftw_mpi_plan_many_dft(rnk, myz, howmany,
        FFTW_MPI_DEFAULT_BLOCK,FFTW_MPI_DEFAULT_BLOCK,
        minp, mout, commx, FFTW_BACKWARD, FFTW_MEASURE);
*/
//***********
//***** Solver part ******

  dxs = topo_.dx0*topo_.dx0;
  dys = topo_.dy0*topo_.dy0;
  dzs = topo_.dz0*topo_.dz0;

  vm2=-1.0/12.0;
  vm1=16.0/12.0;
  v  =-30.0/12.0;
  vp1=16.0/12.0;
  vp2=-1.0/12.0;

  MatCreateMPIAIJ(commyz, PETSC_DECIDE, PETSC_DECIDE, mx, mx, 5, PETSC_NULL, 5, PETSC_NULL, &A);

  ierr = MatGetOwnershipRange(A,&Istart,&Iend);

  
  for (Ii=Istart; Ii<Iend; Ii++) {
    i = Ii; j = Ii;
    if ((i>1)&&(i<mx-2))   {

	J = Ii - 2; MatSetValues(A,1,&Ii,1,&J,&vm2,INSERT_VALUES);
	J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&vm1,INSERT_VALUES);CHKERRQ(ierr);
	J = Ii; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);
	J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&vp1,INSERT_VALUES);CHKERRQ(ierr);
	J = Ii + 2; ierr = MatSetValues(A,1,&Ii,1,&J,&vp2,INSERT_VALUES);CHKERRQ(ierr);
    }

    if (i==0) {
	J = Ii; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);}
    if (i==1)   {
	J = Ii - 1; vb = 11.0/12.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);CHKERRQ(ierr);
	J = Ii ; vb = -5.0/3.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
	J = Ii + 1; vb = 0.5; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
	J = Ii + 2; vb = 1.0/3.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
	J = Ii + 3; vb = -1.0/12.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
}

    if (i==mx-2) {
        J = Ii + 1; vb = 11.0/12.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);CHKERRQ(ierr);
        J = Ii ; vb = -5.0/3.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
        J = Ii - 1; vb = 0.5; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
        J = Ii - 2; vb = 1.0/3.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
        J = Ii - 3; vb = -1.0/12.0; ierr = MatSetValues(A,1,&Ii,1,&J,&vb,INSERT_VALUES);
}
    if (i==mx-1) {J = Ii; ierr = MatSetValues(A,1,&Ii,1,&J,&v,INSERT_VALUES);CHKERRQ(ierr);} 

    }

  ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  ierr = VecCreate(commyz,&br);CHKERRQ(ierr);
  ierr = VecSetSizes(br,PETSC_DECIDE,mx);CHKERRQ(ierr);
  ierr = VecSetFromOptions(br);CHKERRQ(ierr);
  ierr = VecDuplicate(br,&xr);CHKERRQ(ierr);
  ierr = VecDuplicate(br,&bi);CHKERRQ(ierr);
  ierr = VecDuplicate(br,&xi);CHKERRQ(ierr);


  ierr = KSPCreate(commyz,&ksp);CHKERRQ(ierr);

  ierr = KSPSetOperators(ksp,A,A,SAME_PRECONDITIONER);CHKERRQ(ierr);
  ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
  ierr = KSPGetPC(ksp,&pc);
  PCSetType(pc,PCJACOBI);
  ierr = KSPSetTolerances(ksp,1.e-7,1.e-50,PETSC_DEFAULT,
                          PETSC_DEFAULT);CHKERRQ(ierr);

//******* End  *******
}
Exemplo n.º 22
0
PETSC_EXTERN void PETSC_STDCALL  dmpatchcreate_(MPI_Fint * comm,DM *mesh, int *__ierr ){
*__ierr = DMPatchCreate(
	MPI_Comm_f2c( *(comm) ),mesh);
}
Exemplo n.º 23
0
#include "private/fortranimpl.h"

#if defined(PETSC_HAVE_FORTRAN_CAPS)
#define petscdrawopenx_           PETSCDRAWOPENX
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define petscdrawopenx_           petscdrawopenx
#endif

EXTERN_C_BEGIN
void PETSC_STDCALL petscdrawopenx_(MPI_Comm *comm,CHAR display PETSC_MIXED_LEN(len1),
                    CHAR title PETSC_MIXED_LEN(len2),int *x,int *y,int *w,int *h,PetscDraw* inctx,
                    PetscErrorCode *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2))
{
  char *t1,*t2;

  FIXCHAR(display,len1,t1);
  FIXCHAR(title,len2,t2);
  *ierr = PetscDrawOpenX(MPI_Comm_f2c(*(MPI_Fint *)&*comm),t1,t2,*x,*y,*w,*h,inctx);
  FREECHAR(display,t1);
  FREECHAR(title,t2);
}

EXTERN_C_END
Exemplo n.º 24
0
void PETSC_STDCALL  islisttopair_(MPI_Fint * comm,PetscInt *listlen,IS islist[],IS *xis,IS *yis, int *__ierr ){
*__ierr = ISListToPair(
	MPI_Comm_f2c( *(comm) ),*listlen,islist,xis,yis);
}
Exemplo n.º 25
0
void PETSC_STDCALL  isconcatenate_(MPI_Fint * comm,PetscInt *len, IS islist[],IS *isout, int *__ierr ){
*__ierr = ISConcatenate(
	MPI_Comm_f2c( *(comm) ),*len,islist,isout);
}
Exemplo n.º 26
0
#include <petsc-private/fortranimpl.h>
#include <petscdmplex.h>

#if defined(PETSC_HAVE_FORTRAN_CAPS)
#define dmplexcreategmshfromfile_  DMPLEXCREATEGMSHFROMFILE
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) && !defined(FORTRANDOUBLEUNDERSCORE)
#define dmplexcreategmshfromfile_  dmplexcreategmshfromfile
#endif

/* Definitions of Fortran Wrapper routines */

PETSC_EXTERN void PETSC_STDCALL dmplexcreategmshfromfile_(MPI_Fint *comm, CHAR name PETSC_MIXED_LEN(lenN), PetscBool *interpolate, DM *dm, int *ierr PETSC_END_LEN(lenN))
{
  char *filename;

  FIXCHAR(name, lenN, filename);
  *ierr = DMPlexCreateGmshFromFile(MPI_Comm_f2c(*(comm)), filename, *interpolate, dm);
  FREECHAR(name, filename);
}
Exemplo n.º 27
0
void csetmpi2_( MPI_Fint *fcomm, MPI_Fint *fkey, MPI_Aint *val, MPI_Fint *errs )
{
    MPI_Comm comm = MPI_Comm_f2c( *fcomm );
    
    MPI_Comm_set_attr( comm, *fkey, (void *)*val );
}
Exemplo n.º 28
0
EXPORT_MPI_API void FORTRAN_API mpi_attr_put_ ( MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attr_value, MPI_Fint *__ierr )
{
    *__ierr = MPI_Attr_put( MPI_Comm_f2c(*comm), (int)*keyval,
                            (void *)(MPI_Aint)((int)*attr_value));
}
Exemplo n.º 29
0
void pmr_comm_eigvals_
(MPI_Fint *comm, int *nz, int *myfirstp, double *W, int *info)
{
  MPI_Comm c_comm = MPI_Comm_f2c(*comm);
  *info = PMR_comm_eigvals(c_comm, nz, myfirstp, W);
}
Exemplo n.º 30
0
EXPORT_MPI_API void FORTRAN_API mpi_comm_test_inter_ ( MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *__ierr )
{
    int l_flag;
    *__ierr = MPI_Comm_test_inter( MPI_Comm_f2c(*comm), &l_flag);
    *flag = MPIR_TO_FLOG(l_flag);
}