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: size_t size,size_int;
30: PetscInt id;
36: PetscDataTypeGetSize(type,&size);
37: PetscDataTypeGetSize(PETSC_INT,&size_int);
38: F90GetID(type,&id);
40: ptr->addr = array;
41: ptr->sd = size*8;
42: ptr->cookie = F90_COOKIE;
43: ptr->ndim = 1;
44: ptr->id = id;
45: ptr->a = 0;
46: ptr->addr_r = ptr->addr;
47: ptr->size = ptr->sd * len;
48: ptr->dim[0].extent = len;
49: ptr->dim[0].mult = size/size_int;
50: ptr->dim[0].lower = start;
52: return(0);
53: }
57: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
58: {
59: size_t size,size_int;
60: PetscInt id;
66: PetscDataTypeGetSize(type,&size);
67: PetscDataTypeGetSize(PETSC_INT,&size_int);
68: F90GetID(type,&id);
70: ptr->addr = array;
71: ptr->sd = size*8;
72: ptr->cookie = F90_COOKIE;
73: ptr->ndim = 2;
74: ptr->id = id;
75: ptr->a = 0;
76: ptr->addr_r = ptr->addr;
77: ptr->size = ptr->sd*len1*len2;
78: ptr->dim[0].extent = len1;
79: ptr->dim[0].mult = size/size_int;
80: ptr->dim[0].lower = start1;
81: ptr->dim[1].extent = len2;
82: ptr->dim[1].mult = len1*size/size_int;
83: ptr->dim[1].lower = len2;
84: return(0);
85: }
90: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr)
91: {
92: size_t size,size_int;
93: PetscInt id;
99: PetscDataTypeGetSize(type,&size);
100: PetscDataTypeGetSize(PETSC_INT,&size_int);
101: F90GetID(type,&id);
103: ptr->addr = array;
104: ptr->sd = size*8;
105: ptr->cookie = F90_COOKIE;
106: ptr->ndim = 3;
107: ptr->id = id;
108: ptr->a = 0;
109: ptr->addr_r = ptr->addr;
110: ptr->size = ptr->sd*len1*len2*len3;
111: ptr->dim[0].extent = len1;
112: ptr->dim[0].mult = size/size_int;
113: ptr->dim[0].lower = start1;
114: ptr->dim[1].extent = len2;
115: ptr->dim[1].mult = len1*size/size_int;
116: ptr->dim[1].lower = len2;
117: ptr->dim[2].extent = len3;
118: ptr->dim[2].mult = len2*len1*size/size_int;
119: ptr->dim[2].lower = len3;
120: return(0);
121: }
125: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr)
126: {
127: size_t size,size_int;
128: PetscInt id;
134: PetscDataTypeGetSize(type,&size);
135: PetscDataTypeGetSize(PETSC_INT,&size_int);
136: F90GetID(type,&id);
138: ptr->addr = array;
139: ptr->sd = size*8;
140: ptr->cookie = F90_COOKIE;
141: ptr->ndim = 4;
142: ptr->id = id;
143: ptr->a = 0;
144: ptr->addr_r = ptr->addr;
145: ptr->size = ptr->sd*len1*len2*len3*len4;
146: ptr->dim[0].extent = len1;
147: ptr->dim[0].mult = size/size_int;
148: ptr->dim[0].lower = start1;
149: ptr->dim[1].extent = len2;
150: ptr->dim[1].mult = len1*size/size_int;
151: ptr->dim[1].lower = len2;
152: ptr->dim[2].extent = len3;
153: ptr->dim[2].mult = len2*len1*size/size_int;
154: ptr->dim[2].lower = len3;
155: ptr->dim[3].extent = len4;
156: ptr->dim[3].mult = len3*len2*len1*size/size_int;
157: ptr->dim[3].lower = len4;
158: return(0);
159: }
161: /*-------------------------------------------------------------*/