16dd63270SBarry Smith #include <petsc/private/ftnimpl.h> 2af0996ceSBarry Smith #include <petsc/private/dmdaimpl.h> 3af0996ceSBarry Smith #include <petsc/private/snesimpl.h> 42219e2e3SSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 52219e2e3SSatish Balay #define dmdasnessetjacobianlocal_ DMDASNESSETJACOBIANLOCAL 62219e2e3SSatish Balay #define dmdasnessetfunctionlocal_ DMDASNESSETFUNCTIONLOCAL 72219e2e3SSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 82219e2e3SSatish Balay #define dmdasnessetjacobianlocal_ dmdasnessetjacobianlocal 92219e2e3SSatish Balay #define dmdasnessetfunctionlocal_ dmdasnessetfunctionlocal 102219e2e3SSatish Balay #endif 112219e2e3SSatish Balay 12f6291634SJed Brown static struct { 13f6291634SJed Brown PetscFortranCallbackId lf1d; 14f6291634SJed Brown PetscFortranCallbackId lf2d; 15f6291634SJed Brown PetscFortranCallbackId lf3d; 16f6291634SJed Brown PetscFortranCallbackId lj1d; 17f6291634SJed Brown PetscFortranCallbackId lj2d; 18f6291634SJed Brown PetscFortranCallbackId lj3d; 19f6291634SJed Brown } _cb; 20f6291634SJed Brown 212219e2e3SSatish Balay /************************************************/ 22d1e9a80fSBarry Smith static PetscErrorCode sourlj1d(DMDALocalInfo *info, PetscScalar *in, Mat A, Mat m, void *ptr) 232219e2e3SSatish Balay { 2419caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, Mat *, Mat *, void *, PetscErrorCode *), *ctx; 25f6291634SJed Brown DMSNES sdm; 26f6291634SJed Brown 27f6291634SJed Brown PetscFunctionBegin; 289566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 29*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj1d, (PetscFortranCallbackFn **)&func, &ctx)); 309566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->dof * info->gxs], &A, &m, ctx, &ierr)); 313ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 322219e2e3SSatish Balay } 332219e2e3SSatish Balay 34d1e9a80fSBarry Smith static PetscErrorCode sourlj2d(DMDALocalInfo *info, PetscScalar **in, Mat A, Mat m, void *ptr) 352219e2e3SSatish Balay { 3619caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, Mat *, Mat *, void *, PetscErrorCode *), *ctx; 37f6291634SJed Brown DMSNES sdm; 38f6291634SJed Brown 39f6291634SJed Brown PetscFunctionBegin; 409566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 41*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj2d, (PetscFortranCallbackFn **)&func, &ctx)); 429566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->gys][info->dof * info->gxs], &A, &m, ctx, &ierr)); 433ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 442219e2e3SSatish Balay } 452219e2e3SSatish Balay 46d1e9a80fSBarry Smith static PetscErrorCode sourlj3d(DMDALocalInfo *info, PetscScalar ***in, Mat A, Mat m, void *ptr) 472219e2e3SSatish Balay { 4819caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, Mat *, Mat *, void *, PetscErrorCode *), *ctx; 49f6291634SJed Brown DMSNES sdm; 50f6291634SJed Brown 51f6291634SJed Brown PetscFunctionBegin; 529566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 53*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lj2d, (PetscFortranCallbackFn **)&func, &ctx)); 549566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->gzs][info->gys][info->dof * info->gxs], &A, &m, ctx, &ierr)); 553ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 562219e2e3SSatish Balay } 572219e2e3SSatish Balay 5819caf8f3SSatish Balay PETSC_EXTERN void dmdasnessetjacobianlocal_(DM *da, void (*jac)(DMDALocalInfo *, void *, void *, void *, void *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 592219e2e3SSatish Balay { 60f6291634SJed Brown DMSNES sdm; 612219e2e3SSatish Balay PetscInt dim; 622219e2e3SSatish Balay 633ba16761SJacob Faibussowitsch *ierr = DMGetDMSNESWrite(*da, &sdm); 643ba16761SJacob Faibussowitsch if (*ierr) return; 65dfef5ea7SSatish Balay *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL); 663ba16761SJacob Faibussowitsch if (*ierr) return; 672219e2e3SSatish Balay if (dim == 2) { 68*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj2d, (PetscFortranCallbackFn *)jac, ctx); 693ba16761SJacob Faibussowitsch if (*ierr) return; 70d1e9a80fSBarry Smith *ierr = DMDASNESSetJacobianLocal(*da, (PetscErrorCode (*)(DMDALocalInfo *, void *, Mat, Mat, void *))sourlj2d, NULL); 712219e2e3SSatish Balay } else if (dim == 3) { 72*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj3d, (PetscFortranCallbackFn *)jac, ctx); 733ba16761SJacob Faibussowitsch if (*ierr) return; 74d1e9a80fSBarry Smith *ierr = DMDASNESSetJacobianLocal(*da, (PetscErrorCode (*)(DMDALocalInfo *, void *, Mat, Mat, void *))sourlj3d, NULL); 752219e2e3SSatish Balay } else if (dim == 1) { 76*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lj1d, (PetscFortranCallbackFn *)jac, ctx); 773ba16761SJacob Faibussowitsch if (*ierr) return; 78d1e9a80fSBarry Smith *ierr = DMDASNESSetJacobianLocal(*da, (PetscErrorCode (*)(DMDALocalInfo *, void *, Mat, Mat, void *))sourlj1d, NULL); 793ba16761SJacob Faibussowitsch } else *ierr = PETSC_ERR_ARG_OUTOFRANGE; 802219e2e3SSatish Balay } 812219e2e3SSatish Balay 822219e2e3SSatish Balay /************************************************/ 832219e2e3SSatish Balay 842219e2e3SSatish Balay static PetscErrorCode sourlf1d(DMDALocalInfo *info, PetscScalar *in, PetscScalar *out, void *ptr) 852219e2e3SSatish Balay { 8619caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, PetscScalar *, void *, PetscErrorCode *), *ctx; 87f6291634SJed Brown DMSNES sdm; 88f6291634SJed Brown 89f6291634SJed Brown PetscFunctionBegin; 909566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 91*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf1d, (PetscFortranCallbackFn **)&func, &ctx)); 929566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->dof * info->gxs], &out[info->dof * info->xs], ctx, &ierr)); 933ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 942219e2e3SSatish Balay } 952219e2e3SSatish Balay 962219e2e3SSatish Balay static PetscErrorCode sourlf2d(DMDALocalInfo *info, PetscScalar **in, PetscScalar **out, void *ptr) 972219e2e3SSatish Balay { 9819caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, PetscScalar *, void *, PetscErrorCode *), *ctx; 99f6291634SJed Brown DMSNES sdm; 100f6291634SJed Brown 101f6291634SJed Brown PetscFunctionBegin; 1029566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 103*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf2d, (PetscFortranCallbackFn **)&func, &ctx)); 1049566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->gys][info->dof * info->gxs], &out[info->ys][info->dof * info->xs], ctx, &ierr)); 1053ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 1062219e2e3SSatish Balay } 1072219e2e3SSatish Balay 1082219e2e3SSatish Balay static PetscErrorCode sourlf3d(DMDALocalInfo *info, PetscScalar ***in, PetscScalar ***out, void *ptr) 1092219e2e3SSatish Balay { 11019caf8f3SSatish Balay void (*func)(DMDALocalInfo *, PetscScalar *, PetscScalar *, void *, PetscErrorCode *), *ctx; 111f6291634SJed Brown DMSNES sdm; 112f6291634SJed Brown 113f6291634SJed Brown PetscFunctionBegin; 1149566063dSJacob Faibussowitsch PetscCall(DMGetDMSNES(info->da, &sdm)); 115*5ebfa9e9SBarry Smith PetscCall(PetscObjectGetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, _cb.lf3d, (PetscFortranCallbackFn **)&func, &ctx)); 1169566063dSJacob Faibussowitsch PetscCallFortranVoidFunction((*func)(info, &in[info->gzs][info->gys][info->dof * info->gxs], &out[info->zs][info->ys][info->dof * info->xs], ctx, &ierr)); 1173ba16761SJacob Faibussowitsch PetscFunctionReturn(PETSC_SUCCESS); 1182219e2e3SSatish Balay } 1192219e2e3SSatish Balay 12019caf8f3SSatish Balay PETSC_EXTERN void dmdasnessetfunctionlocal_(DM *da, InsertMode *mode, void (*func)(DMDALocalInfo *, void *, void *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 1212219e2e3SSatish Balay { 122f6291634SJed Brown DMSNES sdm; 1232219e2e3SSatish Balay PetscInt dim; 1242219e2e3SSatish Balay 1253ba16761SJacob Faibussowitsch *ierr = DMGetDMSNESWrite(*da, &sdm); 1263ba16761SJacob Faibussowitsch if (*ierr) return; 127dfef5ea7SSatish Balay *ierr = DMDAGetInfo(*da, &dim, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL); 1283ba16761SJacob Faibussowitsch if (*ierr) return; 1292219e2e3SSatish Balay if (dim == 2) { 130*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf2d, (PetscFortranCallbackFn *)func, ctx); 1313ba16761SJacob Faibussowitsch if (*ierr) return; 1320298fd71SBarry Smith *ierr = DMDASNESSetFunctionLocal(*da, *mode, (PetscErrorCode (*)(DMDALocalInfo *, void *, void *, void *))sourlf2d, NULL); 1332219e2e3SSatish Balay } else if (dim == 3) { 134*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf3d, (PetscFortranCallbackFn *)func, ctx); 1353ba16761SJacob Faibussowitsch if (*ierr) return; 1360298fd71SBarry Smith *ierr = DMDASNESSetFunctionLocal(*da, *mode, (PetscErrorCode (*)(DMDALocalInfo *, void *, void *, void *))sourlf3d, NULL); 1372219e2e3SSatish Balay } else if (dim == 1) { 138*5ebfa9e9SBarry Smith *ierr = PetscObjectSetFortranCallback((PetscObject)sdm, PETSC_FORTRAN_CALLBACK_SUBTYPE, &_cb.lf1d, (PetscFortranCallbackFn *)func, ctx); 1393ba16761SJacob Faibussowitsch if (*ierr) return; 1400298fd71SBarry Smith *ierr = DMDASNESSetFunctionLocal(*da, *mode, (PetscErrorCode (*)(DMDALocalInfo *, void *, void *, void *))sourlf1d, NULL); 1413ba16761SJacob Faibussowitsch } else *ierr = PETSC_ERR_ARG_OUTOFRANGE; 1422219e2e3SSatish Balay } 143