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: /*-------------------------------------------------------------*/