Actual source code: f90_win32.c

  2: /*-------------------------------------------------------------*/
  5: PetscErrorCode F90GetID(PetscDataType type,PetscInt *id)
  6: {
  8:   if (type == PETSC_INT) {
  9:     *id = F90_INT_ID;
 10:   } else if (type == PETSC_DOUBLE) {
 11:     *id = F90_DOUBLE_ID;
 12: #if defined(PETSC_USE_COMPLEX)
 13:   } else if (type == PETSC_COMPLEX) {
 14:     *id = F90_COMPLEX_ID;
 15: #endif
 16:   } else if (type == PETSC_LONG) {
 17:     *id = F90_INT_ID;
 18:   } else if (type == PETSC_CHAR) {
 19:     *id = F90_CHAR_ID;
 20:   } else {
 21:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Unknown PETSc datatype");
 22:   }
 23:   return(0);
 24: }

 28: PetscErrorCode F90Array1dCreate(void *array,PetscDataType type,PetscInt start,PetscInt len,F90Array1d *ptr)
 29: {
 30:   PetscInt size,id;

 36:   PetscDataTypeGetSize(type,&size);
 37:   F90GetID(type,&id);
 38:   ptr->addr          = array;
 39:   ptr->id            = id;
 40:   ptr->sd            = size;
 41:   ptr->ndim          = 1;
 42:   ptr->dim[0].extent = len;
 43:   ptr->dim[0].mult   = size;
 44:   ptr->dim[0].lower  = start;
 45:   ptr->sum_d         = -(ptr->dim[0].lower*ptr->dim[0].mult);

 47:   return(0);
 48: }

 52: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
 53: {
 54:   PetscInt size,id;

 60:   PetscDataTypeGetSize(type,&size);
 61:   F90GetID(type,&id);
 62:   ptr->addr          = array;
 63:   ptr->id            = id;
 64:   ptr->sd            = size;
 65:   ptr->ndim          = 2;
 66:   ptr->dim[0].extent = len1;
 67:   ptr->dim[0].mult   = size;
 68:   ptr->dim[0].lower  = start1;
 69:   ptr->dim[1].extent = len2;
 70:   ptr->dim[1].mult   = len1*size;
 71:   ptr->dim[1].lower  = start2;
 72:   ptr->sum_d         = -(ptr->dim[0].lower*ptr->dim[0].mult+ptr->dim[1].lower*ptr->dim[1].mult);

 74:   return(0);
 75: }
 76: /*-------------------------------------------------------------*/