Actual source code: ex1f90.F90

      1: ! Example program demonstrating projection between particle and finite element spaces
      2: #include <petsc/finclude/petscdmplex.h>
      3: #include <petsc/finclude/petscdmswarm.h>
      4: #include <petsc/finclude/petscksp.h>
      5: program DMSwarmTestProjection
      6:   use petscdmplex
      7:   use petscdmswarm
      8:   use petscksp
      9:   implicit none

     11:   DM ::       dm, sw
     12:   PetscFE ::  fe
     13:   KSP ::      ksp
     14:   Mat ::      M_p, M
     15:   Vec ::      f, rho, rhs
     16:   PetscInt :: dim
     17:   PetscInt :: p, bs
     18:   PetscInt, parameter :: Np = 100, field = 0, Nc = 1, degree = 1, timestep = 0
     19:   PetscReal, parameter :: time = 0.0
     20:   PetscReal :: norm
     21:   PetscBool :: removePoints = PETSC_TRUE
     22:   PetscDataType :: dtype
     23:   PetscReal, pointer :: coords(:)
     24:   PetscReal, pointer :: wq(:)
     25:   PetscErrorCode :: ierr

     27:   PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))
     28:   PetscCallA(DMCreate(PETSC_COMM_WORLD, dm, ierr))
     29:   PetscCallA(DMSetType(dm, DMPLEX, ierr))
     30:   PetscCallA(DMSetFromOptions(dm, ierr))
     31:   PetscCallA(DMGetDimension(dm, dim, ierr))
     32:   PetscCallA(DMViewFromOptions(dm, PETSC_NULL_OBJECT, '-dm_view', ierr))

     34: ! Create finite element space
     35:   PetscCallA(PetscFECreateLagrange(PETSC_COMM_SELF, dim, Nc, PETSC_FALSE, degree, PETSC_DETERMINE, fe, ierr))
     36:   PetscCallA(DMSetField(dm, field, PETSC_NULL_DMLABEL, PetscObjectCast(fe), ierr))
     37:   PetscCallA(DMCreateDS(dm, ierr))
     38:   PetscCallA(PetscFEDestroy(fe, ierr))

     40: ! Create particle swarm
     41:   PetscCallA(DMCreate(PETSC_COMM_WORLD, sw, ierr))
     42:   PetscCallA(DMSetType(sw, DMSWARM, ierr))
     43:   PetscCallA(DMSetDimension(sw, dim, ierr))
     44:   PetscCallA(DMSwarmSetType(sw, DMSWARM_PIC, ierr))
     45:   PetscCallA(DMSwarmSetCellDM(sw, dm, ierr))
     46:   PetscCallA(DMSwarmRegisterPetscDatatypeField(sw, 'w_q', Nc, PETSC_REAL, ierr))
     47:   PetscCallA(DMSwarmFinalizeFieldRegister(sw, ierr))
     48:   PetscCallA(DMSwarmSetLocalSizes(sw, Np, 0_PETSC_INT_KIND, ierr))
     49:   PetscCallA(DMSetFromOptions(sw, ierr))
     50:   PetscCallA(DMSwarmGetField(sw, 'w_q', bs, dtype, wq, ierr))
     51:   PetscCallA(DMSwarmGetField(sw, 'DMSwarmPIC_coor', bs, dtype, coords, ierr))
     52:   do p = 1, Np
     53:     coords(p*2 - 1) = -cos(real(p, PETSC_REAL_KIND)/real(Np + 1, PETSC_REAL_KIND)*PETSC_PI)
     54:     coords(p*2 - 0) = sin(real(p, PETSC_REAL_KIND)/real(Np + 1, PETSC_REAL_KIND)*PETSC_PI)
     55:     wq(p) = 1.0
     56:   end do
     57:   PetscCallA(DMSwarmRestoreField(sw, 'DMSwarmPIC_coor', bs, dtype, coords, ierr))
     58:   PetscCallA(DMSwarmRestoreField(sw, 'w_q', bs, dtype, wq, ierr))
     59:   PetscCallA(DMSwarmMigrate(sw, removePoints, ierr))
     60:   PetscCallA(DMSwarmVectorDefineField(sw, 'w_q', ierr))
     61:   PetscCallA(DMViewFromOptions(sw, PETSC_NULL_OBJECT, '-swarm_view', ierr))

     63: ! Project particles to field
     64: !   This gives M f = \int_\Omega \phi f, which looks like a rhs for a PDE
     65:   PetscCallA(DMCreateMassMatrix(sw, dm, M_p, ierr))
     66:   PetscCallA(DMCreateGlobalVector(dm, rho, ierr))
     67:   PetscCallA(DMSwarmCreateGlobalVectorFromField(sw, 'w_q', f, ierr))
     68:   PetscCallA(MatMultTranspose(M_p, f, rho, ierr))

     70: ! Visualize mesh field
     71:   PetscCallA(DMSetOutputSequenceNumber(dm, timestep, time, ierr))
     72:   PetscCallA(PetscObjectViewFromOptions(PetscObjectCast(rho), PETSC_NULL_OBJECT, '-rho_view', ierr))

     74: ! Project field to particles
     75: !   This gives f_p = M_p^+ M f
     76:   PetscCallA(DMCreateMassMatrix(dm, dm, M, ierr))
     77:   PetscCallA(DMCreateGlobalVector(dm, rhs, ierr))
     78:   if (.false.) then
     79:     PetscCallA(MatMult(M, rho, rhs, ierr)) ! this is what you would do for and FE solve
     80:   else
     81:     PetscCallA(VecCopy(rho, rhs, ierr)) ! Identity: M^1 M rho
     82:   end if
     83:   PetscCallA(KSPCreate(PETSC_COMM_WORLD, ksp, ierr))
     84:   PetscCallA(KSPSetOptionsPrefix(ksp, 'ftop_', ierr))
     85:   PetscCallA(KSPSetFromOptions(ksp, ierr))
     86:   PetscCallA(KSPSetOperators(ksp, M_p, M_p, ierr))
     87:   PetscCallA(KSPSolveTranspose(ksp, rhs, f, ierr))
     88:   PetscCallA(KSPDestroy(ksp, ierr))
     89:   PetscCallA(VecDestroy(rhs, ierr))
     90:   PetscCallA(MatDestroy(M_p, ierr))
     91:   PetscCallA(MatDestroy(M, ierr))

     93: ! Visualize particle field
     94:   PetscCallA(DMSetOutputSequenceNumber(sw, timestep, time, ierr))
     95:   PetscCallA(PetscObjectViewFromOptions(PetscObjectCast(f), PETSC_NULL_OBJECT, '-weights_view', ierr))
     96:   PetscCallA(VecNorm(f, NORM_1, norm, ierr))
     97:   print *, 'Total number density = ', norm
     98: ! Cleanup
     99:   PetscCallA(DMSwarmDestroyGlobalVectorFromField(sw, 'w_q', f, ierr))
    100:   PetscCallA(VecDestroy(rho, ierr))
    101:   PetscCallA(DMDestroy(sw, ierr))
    102:   PetscCallA(DMDestroy(dm, ierr))

    104:   PetscCallA(PetscFinalize(ierr))
    105: end program DMSwarmTestProjection

    107: !/*TEST
    108: !
    109: !  build:
    110: !    requires: double !complex
    111: !
    112: !  test:
    113: !    suffix: 0
    114: !    requires: double
    115: !    args: -dm_plex_simplex 0 -dm_plex_box_faces 40,20 -dm_plex_box_lower -2.0,0.0 -dm_plex_box_upper 2.0,2.0 -ftop_ksp_type lsqr -ftop_pc_type none -dm_view -swarm_view
    116: !    filter: grep -v DM_ | grep -v atomic
    117: !    filter_output: grep -v atomic
    118: !
    119: !TEST*/