Actual source code: f90_t3e.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;
 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:   F90GetID(type,&id);
 39:   ptr->addr          = array;
 40:   ptr->id            = id;
 41:   ptr->cookie        = F90_COOKIE;
 42:   ptr->sd            = size*8;
 43:   ptr->ndim          = 1;
 44:   ptr->dim[0].extent = len;
 45:   ptr->dim[0].mult   = 1;
 46:   ptr->dim[0].lower  = start;

 48:   return(0);
 49: }

 53: PetscErrorCode F90Array2dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,F90Array2d *ptr)
 54: {

 56:   PetscInt size,size_int,id;

 62:   PetscDataTypeGetSize(type,&size);
 63:   F90GetID(type,&id);
 64:   ptr->addr          = array;
 65:   ptr->id            = id;
 66:   ptr->cookie        = F90_COOKIE;
 67:   ptr->sd            = size*8;
 68:   ptr->ndim          = 2;
 69:   ptr->dim[0].extent = len1;
 70:   ptr->dim[0].mult   = 1;
 71:   ptr->dim[0].lower  = start1;
 72:   ptr->dim[1].extent = len2;
 73:   ptr->dim[1].mult   = len1*1;
 74:   ptr->dim[1].lower  = start2;

 76:   return(0);
 77: }


 82: PetscErrorCode F90Array3dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,F90Array3d *ptr)
 83: {

 85:   PetscInt size,size_int,id;

 91:   PetscDataTypeGetSize(type,&size);
 92:   F90GetID(type,&id);
 93:   ptr->addr          = array;
 94:   ptr->id            = id;
 95:   ptr->cookie        = F90_COOKIE;
 96:   ptr->sd            = size*8;
 97:   ptr->ndim          = 3;
 98:   ptr->dim[0].extent = len1;
 99:   ptr->dim[0].mult   = 1;
100:   ptr->dim[0].lower  = start1;
101:   ptr->dim[1].extent = len2;
102:   ptr->dim[1].mult   = len1*1;
103:   ptr->dim[1].lower  = start2;
104:   ptr->dim[2].extent = len3;
105:   ptr->dim[2].mult   = len2*len1*1;
106:   ptr->dim[2].lower  = start3;

108:   return(0);
109: }

113: PetscErrorCode F90Array4dCreate(void *array,PetscDataType type,PetscInt start1,PetscInt len1,PetscInt start2,PetscInt len2,PetscInt start3,PetscInt len3,PetscInt start4,PetscInt len4,F90Array4d *ptr)
114: {

116:   PetscInt size,size_int,id;

122:   PetscDataTypeGetSize(type,&size);
123:   F90GetID(type,&id);
124:   ptr->addr          = array;
125:   ptr->id            = id;
126:   ptr->cookie        = F90_COOKIE;
127:   ptr->sd            = size*8;
128:   ptr->ndim          = 4;
129:   ptr->dim[0].extent = len1;
130:   ptr->dim[0].mult   = 1;
131:   ptr->dim[0].lower  = start1;
132:   ptr->dim[1].extent = len2;
133:   ptr->dim[1].mult   = len1*1;
134:   ptr->dim[1].lower  = start2;
135:   ptr->dim[2].extent = len3;
136:   ptr->dim[2].mult   = len2*len1*1;
137:   ptr->dim[2].lower  = start3;
138:   ptr->dim[3].extent = len4;
139:   ptr->dim[3].mult   = len3*len2*len1*1;
140:   ptr->dim[3].lower  = start4;

142:   return(0);
143: }
144: /*-------------------------------------------------------------*/