Actual source code: f90_solaris_old.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_INT_ID; /* True for 32 bit only */
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 F90Array1dCreate(void *array,PetscDataType type,PetscInt start,PetscInt len,F90Array1d *ptr)
30: {
31: PetscInt size,size_int,id;
37: PetscDataTypeGetSize(type,&size);
38: PetscDataTypeGetSize(PETSC_INT,&size_int);
39: F90GetID(type,&id);
40: ptr->addr = array;
41: ptr->id = id;
42: ptr->cookie = F90_COOKIE;
43: ptr->sd = size*8;
44: ptr->ndim = 1;
45: ptr->dim[0].extent = len;
46: ptr->dim[0].mult = size/size_int;
47: ptr->dim[0].lower = start;
49: return(0);
50: }
54: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
55: {
57: PetscInt size,size_int,id;
63: PetscDataTypeGetSize(type,&size);
64: PetscDataTypeGetSize(PETSC_INT,&size_int);
65: F90GetID(type,&id);
66: ptr->addr = array;
67: ptr->id = id;
68: ptr->cookie = F90_COOKIE;
69: ptr->sd = size*8;
70: ptr->ndim = 2;
71: ptr->dim[0].extent = len1;
72: ptr->dim[0].mult = size/size_int;
73: ptr->dim[0].lower = start1;
74: ptr->dim[1].extent = len2;
75: ptr->dim[1].mult = len1*size/size_int;
76: ptr->dim[1].lower = start2;
78: return(0);
79: }
83: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr)
84: {
86: PetscInt size,size_int,id;
92: PetscDataTypeGetSize(type,&size);
93: PetscDataTypeGetSize(PETSC_INT,&size_int);
94: F90GetID(type,&id);
95: ptr->addr = array;
96: ptr->id = id;
97: ptr->cookie = F90_COOKIE;
98: ptr->sd = size*8;
99: ptr->ndim = 3;
100: ptr->dim[0].extent = len1;
101: ptr->dim[0].mult = size/size_int;
102: ptr->dim[0].lower = start1;
103: ptr->dim[1].extent = len2;
104: ptr->dim[1].mult = len1*size/size_int;
105: ptr->dim[1].lower = start2;
106: ptr->dim[2].extent = len3;
107: ptr->dim[2].mult = len2*len1*size/size_int;
108: ptr->dim[2].lower = start3;
110: return(0);
111: }
115: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr)
116: {
118: PetscInt size,size_int,id;
124: PetscDataTypeGetSize(type,&size);
125: PetscDataTypeGetSize(PETSC_INT,&size_int);
126: F90GetID(type,&id);
127: ptr->addr = array;
128: ptr->id = id;
129: ptr->cookie = F90_COOKIE;
130: ptr->sd = size*8;
131: ptr->ndim = 4;
132: ptr->dim[0].extent = len1;
133: ptr->dim[0].mult = size/size_int;
134: ptr->dim[0].lower = start1;
135: ptr->dim[1].extent = len2;
136: ptr->dim[1].mult = len1*size/size_int;
137: ptr->dim[1].lower = start2;
138: ptr->dim[2].extent = len3;
139: ptr->dim[2].mult = len2*len1*size/size_int;
140: ptr->dim[2].lower = start3;
141: ptr->dim[3].extent = len4;
142: ptr->dim[3].mult = len3*len2*len1*size/size_int;
143: ptr->dim[3].lower = start4;
145: return(0);
146: }
147: /*-------------------------------------------------------------*/