Actual source code: zda.c
2: #include src/dm/da/daimpl.h
3: #include src/fortran/custom/zpetsc.h
4: #include petscmat.h
5: #include petscda.h
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define dasetblockfills_ DASETBLOCKFILLS
9: #define dasetlocalfunction_ DASETLOCALFUNCTION
10: #define dasetLocaladiforfunction_ DASETLOCALADIFORFUNCTION
11: #define dasetlocaladiformffunction_ DASETLOCALADIFORMFFUNCTION
12: #define dasetlocaljacobian_ DASETLOCALJACOBIAN
13: #define dagetlocalinfo_ DAGETLOCALINFO
14: #define dagetinterpolation_ DAGETINTERPOLATION
15: #define dacreate1d_ DACREATE1D
16: #define dacreate3d_ DACREATE3D
17: #define dacreate2d_ DACREATE2D
18: #define dadestroy_ DADESTROY
19: #define dacreateglobalvector_ DACREATEGLOBALVECTOR
20: #define dacreatenaturalvector_ DACREATENATURALVECTOR
21: #define dacreatelocalvector_ DACREATELOCALVECTOR
22: #define dagetlocalvector_ DAGETLOCALVECTOR
23: #define dagetglobalvector_ DAGETGLOBALVECTOR
24: #define darestorelocalvector_ DARESTORELOCALVECTOR
25: #define darestoreglobalvector_ DARESTOREGLOBALVECTOR
26: #define dagetscatter_ DAGETSCATTER
27: #define dagetglobalindices_ DAGETGLOBALINDICES
28: #define daview_ DAVIEW
29: #define dagetinfo_ DAGETINFO
30: #define dagetcoloring_ DAGETCOLORING
31: #define dagetmatrix_ DAGETMATRIX
32: #define dagetislocaltoglobalmapping_ DAGETISLOCALTOGLOBALMAPPING
33: #define dagetislocaltoglobalmappingblck_ DAGETISLOCALTOGLOBALMAPPINGBLCK
34: #define daload_ DALOAD
35: #define dasetfieldname_ DASETFIELDNAME
36: #define dagetfieldname_ DAGETFIELDNAME
37: #define darefine_ DAREFINE
38: #define dagetao_ DAGETAO
39: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
40: #define dasetblockfills_ dasetblockfills
41: #define dagetlocalinfo_ dagetlocalinfo
42: #define dagetlocalvector_ dagetlocalvector
43: #define dagetglobalvector_ dagetglobalvector
44: #define darestorelocalvector_ darestorelocalvector
45: #define darestoreglobalvector_ darestoreglobalvector
46: #define dagetinterpolation_ dagetinterpolation
47: #define daload_ daload
48: #define dacreateglobalvector_ dacreateglobalvector
49: #define dacreatenaturalvector_ dacreatenaturalvector
50: #define dacreatelocalvector_ dacreatelocalvector
51: #define daview_ daview
52: #define dacreate1d_ dacreate1d
53: #define dacreate3d_ dacreate3d
54: #define dacreate2d_ dacreate2d
55: #define dadestroy_ dadestroy
56: #define dagetscatter_ dagetscatter
57: #define dagetglobalindices_ dagetglobalindices
58: #define dagetinfo_ dagetinfo
59: #define dagetcoloring_ dagetcoloring
60: #define dagetmatrix_ dagetmatrix
61: #define dagetislocaltoglobalmapping_ dagetislocaltoglobalmapping
62: #define dagetislocaltoglobalmappingblck_ dagetislocaltoglobalmappingblck
63: #define dasetfieldname_ dasetfieldname
64: #define dagetfieldname_ dagetfieldname
65: #define darefine_ darefine
66: #define dagetao_ dagetao
67: #define dasetlocalfunction_ dasetlocalfunction
68: #define dasetlocaladiforfunction_ dasetlocaladiforfunction
69: #define dasetlocaladiformffunction_ dasetlocaladiformffunction
70: #define dasetlocaljacobian_ dasetlocaljacobian
71: #endif
77: void PETSC_STDCALL dasetblockfills_(DA *da,PetscInt *dfill,PetscInt *ofill,PetscErrorCode *ierr)
78: {
79: *DASetBlockFills(*da,dfill,ofill);
80: }
82: static void (PETSC_STDCALL *j1d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
83: static PetscErrorCode ourlj1d(DALocalInfo *info,PetscScalar *in,Mat m,void *ptr)
84: {
85: PetscErrorCode 0;
86: (*j1d)(info,&in[info->dof*info->gxs],&m,ptr,&ierr);
87: return 0;
88: }
90: static void (PETSC_STDCALL *j2d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
91: static PetscErrorCode ourlj2d(DALocalInfo *info,PetscScalar **in,Mat m,void *ptr)
92: {
93: PetscErrorCode 0;
94: (*j2d)(info,&in[info->gys][info->dof*info->gxs],&m,ptr,&ierr);
95: return 0;
96: }
98: static void (PETSC_STDCALL *j3d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
99: static PetscErrorCode ourlj3d(DALocalInfo *info,PetscScalar ***in,Mat m,void *ptr)
100: {
101: PetscErrorCode 0;
102: (*j3d)(info,&in[info->gzs][info->gys][info->dof*info->gxs],&m,ptr,&ierr);
103: return 0;
104: }
106: static void (PETSC_STDCALL *f1d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
107: static PetscErrorCode ourlf1d(DALocalInfo *info,PetscScalar *in,PetscScalar *out,void *ptr)
108: {
109: PetscErrorCode 0;
110: (*f1d)(info,&in[info->dof*info->gxs],&out[info->dof*info->xs],ptr,&ierr);
111: return 0;
112: }
114: static void (PETSC_STDCALL *f2d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
115: static PetscErrorCode ourlf2d(DALocalInfo *info,PetscScalar **in,PetscScalar **out,void *ptr)
116: {
117: PetscErrorCode 0;
118: (*f2d)(info,&in[info->gys][info->dof*info->gxs],&out[info->ys][info->dof*info->xs],ptr,&ierr);
119: return 0;
120: }
122: static void (PETSC_STDCALL *f3d)(DALocalInfo*,void*,void*,void*,PetscErrorCode*);
123: static PetscErrorCode ourlf3d(DALocalInfo *info,PetscScalar ***in,PetscScalar ***out,void *ptr)
124: {
125: PetscErrorCode 0;
126: (*f3d)(info,&in[info->gzs][info->gys][info->dof*info->gxs],&out[info->zs][info->ys][info->dof*info->xs],ptr,&ierr);
127: return 0;
128: }
130: void PETSC_STDCALL dasetlocalfunction_(DA *da,void (PETSC_STDCALL *func)(DALocalInfo*,void*,void*,void*,PetscErrorCode*),PetscErrorCode *ierr)
131: {
132: PetscInt dim;
134: *DAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0); if (*ierr) return;
135: if (dim == 2) {
136: f2d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))func;
137: *DASetLocalFunction(*da,(DALocalFunction1)ourlf2d);
138: } else if (dim == 3) {
139: f3d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))func;
140: *DASetLocalFunction(*da,(DALocalFunction1)ourlf3d);
141: } else if (dim == 1) {
142: f1d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))func;
143: *DASetLocalFunction(*da,(DALocalFunction1)ourlf1d);
144: } else *1;
145: }
148: void PETSC_STDCALL dasetlocaladiforfunction_(DA *da,
149: void (PETSC_STDCALL *jfunc)(PetscInt*,DALocalInfo*,void*,void*,PetscInt*,void*,void*,PetscInt*,void*,PetscErrorCode*),PetscErrorCode *ierr)
150: {
151: (*da)->adifor_lf = (DALocalFunction1)jfunc;
152: }
154: void PETSC_STDCALL dasetlocaladiformffunction_(DA *da,
155: void (PETSC_STDCALL *jfunc)(DALocalInfo*,void*,void*,void*,void*,void*,PetscErrorCode*),PetscErrorCode *ierr)
156: {
157: (*da)->adiformf_lf = (DALocalFunction1)jfunc;
158: }
160: void PETSC_STDCALL dasetlocaljacobian_(DA *da,void (PETSC_STDCALL *jac)(DALocalInfo*,void*,void*,void*,PetscErrorCode*),PetscErrorCode *ierr)
161: {
162: PetscInt dim;
164: *DAGetInfo(*da,&dim,0,0,0,0,0,0,0,0,0,0); if (*ierr) return;
165: if (dim == 2) {
166: j2d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))jac;
167: *DASetLocalJacobian(*da,(DALocalFunction1)ourlj2d);
168: } else if (dim == 3) {
169: j3d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))jac;
170: *DASetLocalJacobian(*da,(DALocalFunction1)ourlj3d);
171: } else if (dim == 1) {
172: j1d = (void (PETSC_STDCALL *)(DALocalInfo*,void*,void*,void*,PetscErrorCode*))jac;
173: *DASetLocalJacobian(*da,(DALocalFunction1)ourlj1d);
174: } else *1;
175: }
177: void PETSC_STDCALL dagetlocalinfo_(DA *da,DALocalInfo *ao,PetscErrorCode *ierr)
178: {
179: *DAGetLocalInfo(*da,ao);
180: }
182: void PETSC_STDCALL dagetao_(DA *da,AO *ao,PetscErrorCode *ierr)
183: {
184: *DAGetAO(*da,ao);
185: }
187: void PETSC_STDCALL darefine_(DA *da,MPI_Comm *comm,DA *daref, PetscErrorCode *ierr)
188: {
189: *DARefine(*da,(MPI_Comm)PetscToPointerComm(*comm),daref);
190: }
192: void PETSC_STDCALL dagetinterpolation_(DA *dac,DA *daf,Mat *A,Vec *scale,PetscErrorCode *ierr)
193: {
194: CHKFORTRANNULLOBJECT(scale);
195: *DAGetInterpolation(*dac,*daf,A,scale);
196: }
198: void PETSC_STDCALL dasetfieldname_(DA *da,PetscInt *nf,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
199: {
200: char *t;
201: FIXCHAR(name,len,t);
202: *DASetFieldName(*da,*nf,t);
203: FREECHAR(name,t);
204: }
205: void PETSC_STDCALL dagetfieldname(DA *da,PetscInt *nf,CHAR name PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
206: {
207: char *tname;
209: *DAGetFieldName(*da,*nf,&tname);
210: #if defined(PETSC_USES_CPTOFCD)
211: {
212: char *t = _fcdtocp(name); int len1 = _fcdlen(name);
213: *PetscStrncpy(t,tname,len1);
214: }
215: #else
216: *PetscStrncpy(name,tname,len);
217: #endif
218: }
220: void PETSC_STDCALL daload_(PetscViewer *viewer,PetscInt *M,PetscInt *N,PetscInt *P,DA *da,PetscErrorCode *ierr)
221: {
222: PetscViewer v;
223: PetscPatchDefaultViewers_Fortran(viewer,v);
224: *DALoad(v,*M,*N,*P,da);
225: }
227: void PETSC_STDCALL dagetislocaltoglobalmapping_(DA *da,ISLocalToGlobalMapping *map,PetscErrorCode *ierr)
228: {
229: *DAGetISLocalToGlobalMapping(*da,map);
230: }
232: void PETSC_STDCALL dagetislocaltoglobalmappingblck_(DA *da,ISLocalToGlobalMapping *map,PetscErrorCode *ierr)
233: {
234: *DAGetISLocalToGlobalMappingBlck(*da,map);
235: }
237: void PETSC_STDCALL dagetcoloring_(DA *da,ISColoringType *ctype,ISColoring *coloring,PetscErrorCode *ierr PETSC_END_LEN(len))
238: {
239: *DAGetColoring(*da,*ctype,coloring);
240: }
242: void PETSC_STDCALL dagetmatrix_(DA *da,CHAR mat_type PETSC_MIXED_LEN(len),Mat *J,PetscErrorCode *ierr PETSC_END_LEN(len))
243: {
244: char *t;
245: FIXCHAR(mat_type,len,t);
246: *DAGetMatrix(*da,t,J);
247: FREECHAR(mat_type,t);
248: }
250: void PETSC_STDCALL daview_(DA *da,PetscViewer *vin,PetscErrorCode *ierr)
251: {
252: PetscViewer v;
253: PetscPatchDefaultViewers_Fortran(vin,v);
254: *DAView(*da,v);
255: }
257: void PETSC_STDCALL dagetglobalindices_(DA *da,PetscInt *n,PetscInt *indices,size_t *ia,PetscErrorCode *ierr)
258: {
259: PetscInt *idx;
260: *DAGetGlobalIndices(*da,n,&idx);
261: *ia = PetscIntAddressToFortran(indices,idx);
262: }
264: void PETSC_STDCALL dacreateglobalvector_(DA *da,Vec* g,PetscErrorCode *ierr)
265: {
266: *DACreateGlobalVector(*da,g);
267: }
269: void PETSC_STDCALL dacreatenaturalvector_(DA *da,Vec* g,PetscErrorCode *ierr)
270: {
271: *DACreateNaturalVector(*da,g);
272: }
274: void PETSC_STDCALL dacreatelocalvector_(DA *da,Vec* l,PetscErrorCode *ierr)
275: {
276: *DACreateLocalVector(*da,l);
277: }
279: void PETSC_STDCALL dagetlocalvector_(DA *da,Vec* l,PetscErrorCode *ierr)
280: {
281: *DAGetLocalVector(*da,l);
282: }
284: void PETSC_STDCALL dagetglobalvector_(DA *da,Vec* l,PetscErrorCode *ierr)
285: {
286: *DAGetGlobalVector(*da,l);
287: }
289: void PETSC_STDCALL darestorelocalvector_(DA *da,Vec* l,PetscErrorCode *ierr)
290: {
291: *DARestoreLocalVector(*da,l);
292: }
294: void PETSC_STDCALL darestoreglobalvector_(DA *da,Vec* g,PetscErrorCode *ierr)
295: {
296: *DARestoreGlobalVector(*da,g);
297: }
299: void PETSC_STDCALL dagetscatter_(DA *da,VecScatter *ltog,VecScatter *gtol,VecScatter *ltol,PetscErrorCode *ierr)
300: {
301: CHKFORTRANNULLOBJECT(ltog);
302: CHKFORTRANNULLOBJECT(gtol);
303: CHKFORTRANNULLOBJECT(ltol);
304: *DAGetScatter(*da,ltog,gtol,ltol);
305: }
307: void PETSC_STDCALL dadestroy_(DA *da,PetscErrorCode *ierr)
308: {
309: *DADestroy(*da);
310: }
312: void PETSC_STDCALL dacreate2d_(MPI_Comm *comm,DAPeriodicType *wrap,DAStencilType
313: *stencil_type,PetscInt *M,PetscInt *N,PetscInt *m,PetscInt *n,PetscInt *w,
314: PetscInt *s,PetscInt *lx,PetscInt *ly,DA *inra,PetscErrorCode *ierr)
315: {
316: CHKFORTRANNULLINTEGER(lx);
317: CHKFORTRANNULLINTEGER(ly);
318: *DACreate2d((MPI_Comm)PetscToPointerComm(*comm),*wrap,
319: *stencil_type,*M,*N,*m,*n,*w,*s,lx,ly,inra);
320: }
322: void PETSC_STDCALL dacreate1d_(MPI_Comm *comm,DAPeriodicType *wrap,PetscInt *M,PetscInt *w,PetscInt *s,
323: PetscInt *lc,DA *inra,PetscErrorCode *ierr)
324: {
325: CHKFORTRANNULLINTEGER(lc);
326: *DACreate1d((MPI_Comm)PetscToPointerComm(*comm),*wrap,*M,*w,*s,lc,inra);
327: }
329: void PETSC_STDCALL dacreate3d_(MPI_Comm *comm,DAPeriodicType *wrap,DAStencilType
330: *stencil_type,PetscInt *M,PetscInt *N,PetscInt *P,PetscInt *m,PetscInt *n,PetscInt *p,
331: PetscInt *w,PetscInt *s,PetscInt *lx,PetscInt *ly,PetscInt *lz,DA *inra,PetscErrorCode *ierr)
332: {
333: CHKFORTRANNULLINTEGER(lx);
334: CHKFORTRANNULLINTEGER(ly);
335: CHKFORTRANNULLINTEGER(lz);
336: *DACreate3d((MPI_Comm)PetscToPointerComm(*comm),*wrap,*stencil_type,
337: *M,*N,*P,*m,*n,*p,*w,*s,lx,ly,lz,inra);
338: }
340: void PETSC_STDCALL dagetinfo_(DA *da,PetscInt *dim,PetscInt *M,PetscInt *N,PetscInt *P,PetscInt *m,PetscInt *n,PetscInt *p,PetscInt *w,PetscInt *s,
341: DAPeriodicType *wrap,DAStencilType *st,PetscErrorCode *ierr)
342: {
343: CHKFORTRANNULLINTEGER(dim);
344: CHKFORTRANNULLINTEGER(M);
345: CHKFORTRANNULLINTEGER(N);
346: CHKFORTRANNULLINTEGER(P);
347: CHKFORTRANNULLINTEGER(m);
348: CHKFORTRANNULLINTEGER(n);
349: CHKFORTRANNULLINTEGER(p);
350: CHKFORTRANNULLINTEGER(w);
351: CHKFORTRANNULLINTEGER(s);
352: CHKFORTRANNULLINTEGER(wrap);
353: CHKFORTRANNULLINTEGER(st);
354: *DAGetInfo(*da,dim,M,N,P,m,n,p,w,s,wrap,st);
355: }