Actual source code: f90_absoft.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, size_int;
32: PetscInt id;
38: PetscDataTypeGetSize(type,&size);
39: PetscDataTypeGetSize(PETSC_INT,&size_int);
40: F90GetID(type,&id);
42: ptr->addr = array;
43: ptr->sd = size*8;
44: ptr->cookie = F90_COOKIE;
45: ptr->dim_id = 1024*8*1;
46: ptr->id = id;
47: ptr->a = 0;
48: ptr->b = 0;
49: ptr->dim[0].extent = len;
50: ptr->dim[0].mult = size/size_int;
51: ptr->dim[0].lower = start;
53: return(0);
54: }
58: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
59: {
60: size_t size, size_int;
61: PetscInt id;
67: PetscDataTypeGetSize(type,&size);
68: PetscDataTypeGetSize(PETSC_INT,&size_int);
69: F90GetID(type,&id);
71: ptr->addr = array;
72: ptr->sd = size*8;
73: ptr->cookie = F90_COOKIE;
74: ptr->dim_id = 1024*8*2;
75: ptr->id = id;
76: ptr->a = 0;
77: ptr->b = 0;
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: }
89: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr)
90: {
91: size_t size, size_int;
92: PetscInt id;
98: PetscDataTypeGetSize(type,&size);
99: PetscDataTypeGetSize(PETSC_INT,&size_int);
100: F90GetID(type,&id);
102: ptr->addr = array;
103: ptr->sd = size*8;
104: ptr->cookie = F90_COOKIE;
105: ptr->dim_id = 1024*8*3;
106: ptr->id = id;
107: ptr->a = 0;
108: ptr->b = 0;
109: ptr->dim[0].extent = len1;
110: ptr->dim[0].mult = size/size_int;
111: ptr->dim[0].lower = start1;
112: ptr->dim[1].extent = len2;
113: ptr->dim[1].mult = len1*size/size_int;
114: ptr->dim[1].lower = start2;
115: ptr->dim[2].extent = len3;
116: ptr->dim[2].mult = len1*len2*size/size_int;
117: ptr->dim[2].lower = start3;
118: return(0);
119: }
123: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr)
124: {
125: size_t size, size_int;
126: PetscInt id;
132: PetscDataTypeGetSize(type,&size);
133: PetscDataTypeGetSize(PETSC_INT,&size_int);
134: F90GetID(type,&id);
136: ptr->addr = array;
137: ptr->sd = size*8;
138: ptr->cookie = F90_COOKIE;
139: ptr->dim_id = 1024*8*4;
140: ptr->id = id;
141: ptr->a = 0;
142: ptr->b = 0;
143: ptr->dim[0].extent = len1;
144: ptr->dim[0].mult = size/size_int;
145: ptr->dim[0].lower = start1;
146: ptr->dim[1].extent = len2;
147: ptr->dim[1].mult = len1*size/size_int;
148: ptr->dim[1].lower = start2;
149: ptr->dim[2].extent = len3;
150: ptr->dim[2].mult = len1*len2*size/size_int;
151: ptr->dim[2].lower = start3;
152: ptr->dim[3].extent = len4;
153: ptr->dim[3].mult = len1*len2*len3*size/size_int;
154: ptr->dim[3].lower = start4;
155: return(0);
156: }
158: /*-------------------------------------------------------------*/