Actual source code: f90_alpha.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 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: size_t size;
32: PetscInt id;
38: PetscDataTypeGetSize(type,&size);
39: F90GetID(type,&id);
40: ptr->addr = array;
41: ptr->id = (char)id;
42: ptr->a = A_VAL;
43: ptr->b = B_VAL;
44: ptr->sd = size;
45: ptr->ndim = 1;
46: ptr->dim[0].upper = len+start;
47: ptr->dim[0].mult = size;
48: ptr->dim[0].lower = start;
49: ptr->addr_d = (void*)((long)array - (ptr->dim[0].lower*ptr->dim[0].mult));
51: return(0);
52: }
56: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
57: {
58: size_t size;
59: PetscInt id;
65: PetscDataTypeGetSize(type,&size);
66: F90GetID(type,&id);
67: ptr->addr = array;
68: ptr->id = (char)id;
69: ptr->a = A_VAL;
70: ptr->b = B_VAL;
71: ptr->sd = size;
72: ptr->ndim = 2;
73: ptr->dim[1].upper = len1+start1;
74: ptr->dim[1].mult = size;
75: ptr->dim[1].lower = start1;
76: ptr->dim[0].upper = len2+start2;
77: ptr->dim[0].mult = len1*size;
78: ptr->dim[0].lower = start2;
79: ptr->addr_d = (void*)((long)array -(ptr->dim[0].lower*ptr->dim[0].mult+
80: ptr->dim[1].lower*ptr->dim[1].mult));
81: return(0);
82: }
86: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr)
87: {
88: size_t size;
89: PetscInt id;
95: PetscDataTypeGetSize(type,&size);
96: F90GetID(type,&id);
97: ptr->addr = array;
98: ptr->id = (char)id;
99: ptr->a = A_VAL;
100: ptr->b = B_VAL;
101: ptr->sd = size;
102: ptr->ndim = 3;
103: ptr->dim[2].upper = len1+start1;
104: ptr->dim[2].mult = size;
105: ptr->dim[2].lower = start1;
106: ptr->dim[1].upper = len2+start2;
107: ptr->dim[1].mult = len1*size;
108: ptr->dim[1].lower = start2;
109: ptr->dim[0].upper = len3+start3;
110: ptr->dim[0].mult = len2*len1*size;
111: ptr->dim[0].lower = start3;
112: ptr->addr_d = (void*)((long)array -(ptr->dim[0].lower*ptr->dim[0].mult+
113: ptr->dim[1].lower*ptr->dim[1].mult+
114: ptr->dim[2].lower*ptr->dim[2].mult));
115: return(0);
116: }
120: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr)
121: {
122: size_t size;
123: PetscInt id;
129: PetscDataTypeGetSize(type,&size);
130: F90GetID(type,&id);
131: ptr->addr = array;
132: ptr->id = (char)id;
133: ptr->a = A_VAL;
134: ptr->b = B_VAL;
135: ptr->sd = size;
136: ptr->ndim = 4;
137: ptr->dim[3].upper = len1+start1;
138: ptr->dim[3].mult = size;
139: ptr->dim[3].lower = start1;
140: ptr->dim[2].upper = len2+start2;
141: ptr->dim[2].mult = len1*size;
142: ptr->dim[2].lower = start2;
143: ptr->dim[1].upper = len3+start3;
144: ptr->dim[1].mult = len2*len1*size;
145: ptr->dim[1].lower = start4;
146: ptr->dim[0].upper = len4+start4;
147: ptr->dim[0].mult = len3*len2*len1*size;
148: ptr->dim[0].lower = start4;
149: ptr->addr_d = (void*)((long)array -(ptr->dim[0].lower*ptr->dim[0].mult+
150: ptr->dim[1].lower*ptr->dim[1].mult+
151: ptr->dim[2].lower*ptr->dim[2].mult+
152: ptr->dim[3].lower*ptr->dim[3].mult));
153: return(0);
154: }
155: /*-------------------------------------------------------------*/