Actual source code: f90_alpha.c
1: /*$Id: f90_alpha.c,v 1.10 2001/03/23 23:20:56 balay Exp $*/
3: /*-------------------------------------------------------------*/
7: int F90GetID(PetscDataType type,int *id)
8: {
10: if (type == PETSC_INT) {
11: *id = F90_INT_ID;
12: } else if (type == PETSC_DOUBLE) {
13: *id = F90_DOUBLE_ID;
14: #if defined(PETSC_USE_COMPLEX)
15: } else if (type == PETSC_COMPLEX) {
16: *id = F90_COMPLEX_ID;
17: #endif
18: } else if (type == PETSC_LONG) {
19: *id = F90_LONG_ID;
20: } else if (type == PETSC_CHAR) {
21: *id = F90_CHAR_ID;
22: } else {
23: SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Unknown PETSc datatype");
24: }
25: return(0);
26: }
30: int F90Array1dCreate(void *array,PetscDataType type,int start,int len,F90Array1d *ptr)
31: {
32: int size,size_int,ierr,id;
37: PetscDataTypeGetSize(type,&size);
38: F90GetID(type,&id);
39: ptr->addr = array;
40: ptr->id = (char)id;
41: ptr->a = A_VAL;
42: ptr->b = B_VAL;
43: ptr->sd = size;
44: ptr->ndim = 1;
45: ptr->dim[0].upper = len+start;
46: ptr->dim[0].mult = size;
47: ptr->dim[0].lower = start;
48: ptr->addr_d = (void*)((long)array - (ptr->dim[0].lower*ptr->dim[0].mult));
50: return(0);
51: }
55: int F90Array2dCreate(void *array,PetscDataType type,int start1,int len1,int start2,int len2,F90Array2d *ptr)
56: {
58: int size,size_int,ierr,id;
63: PetscDataTypeGetSize(type,&size);
64: F90GetID(type,&id);
65: ptr->addr = array;
66: ptr->id = (char)id;
67: ptr->a = A_VAL;
68: ptr->b = B_VAL;
69: ptr->sd = size;
70: ptr->ndim = 2;
71: ptr->dim[1].upper = len1+start1;
72: ptr->dim[1].mult = size;
73: ptr->dim[1].lower = start1;
74: ptr->dim[0].upper = len2+start2;
75: ptr->dim[0].mult = len1*size;
76: ptr->dim[0].lower = start2;
77: ptr->addr_d = (void*)((long)array -(ptr->dim[0].lower*ptr->dim[0].mult+ptr->dim[1].lower*ptr->dim[1].mult));
78: return(0);
79: }
81: /*-------------------------------------------------------------*/