Actual source code: f90_IRIX.c
2: /*-------------------------------------------------------------*/
6: PetscErrorCode 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_LONG_ID;
19: } else {
20: SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Unknown PETSc datatype");
21: }
22: return(0);
23: }
27: PetscErrorCode F90Array1dCreate(void *array,PetscDataType type,PetscInt start,PetscInt len,F90Array1d *ptr)
28: {
29: PetscInt size,size_int,id;
35: PetscDataTypeGetSize(type,&size);
36: PetscDataTypeGetSize(PETSC_INT,&size_int);
37: F90GetID(type,&id);
39: ptr->addr = array;
40: ptr->sd = size*8;
41: ptr->cookie = F90_COOKIE;
42: ptr->ndim = 1;
43: ptr->id = id;
44: ptr->a = 0;
45: ptr->addr_r = ptr->addr;
46: ptr->size = ptr->sd * len;
47: ptr->dim[0].extent = len;
48: ptr->dim[0].mult = size/size_int;
49: ptr->dim[0].lower = start;
51: return(0);
52: }
56: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
57: {
58: PetscInt size,size_int,id;
64: PetscDataTypeGetSize(type,&size);
65: PetscDataTypeGetSize(PETSC_INT,&size_int);
66: F90GetID(type,&id);
68: ptr->addr = array;
69: ptr->sd = size*8;
70: ptr->cookie = F90_COOKIE;
71: ptr->ndim = 2;
72: ptr->id = id;
73: ptr->a = 0;
74: ptr->addr_r = ptr->addr;
75: ptr->size = ptr->sd*len1*len2;
76: ptr->dim[0].extent = len1;
77: ptr->dim[0].mult = size/size_int;
78: ptr->dim[0].lower = start1;
79: ptr->dim[1].extent = len2;
80: ptr->dim[1].mult = len1*size/size_int;
81: ptr->dim[1].lower = len2;
82: return(0);
83: }
85: /*-------------------------------------------------------------*/