Actual source code: f90_win32.c

      1: #define PETSC_DLL

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

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

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

     48:   return(0);
     49: }

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

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

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