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: /*-------------------------------------------------------------*/