next up previous contents
Next: Parameters Up: Appendix Previous: Example: C code   Contents


Example: Fortran90 code

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

#include "SpaceMask.h"

!
! Sets each point of the mask to the 'normal' state. Here, 'normal'
! is one of the states of the 'excision' type, which should have
! been registered previously using the C SpaceMask_RegisterType()
! function.
!
subroutine Eg_SetStateByName(CCTK_ARGUMENTS)
  implicit none

  integer ni, nj, nk
  integer i, j, k, ijk

  ni = cctk_lsh(1)
  nj = cctk_lsh(2)
  nk = cctk_lsh(3)

  do k=1,nk
     do j=1,nj
        do i=1,ni
           
           ijk = (i-1) + ni*((j-1) + nj*(k-1))

           call SpaceMask_SetState(space_mask, ijk, "excision", "normal")
  
        end do
     end do
  end do

end subroutine Eg_SetStateByName

!
! Sets the mask values within a radius of 1 to the 'excise' state,
! then does a check of the state of each point.  The bitwise macros
! are used in this case for greater efficiency in setting/checking
! the mask.
!
subroutine Eg_SetExcisedRegionByBitmask(CCTK_ARGUMENTS)
  implicit none

  integer ni, nj, nk
  integer i, j, k, ijk

  CCTK_INT type_bits, excised

  ni = cctk_lsh(1)
  nj = cctk_lsh(2)
  nk = cctk_lsh(3)

  call SpaceMask_GetTypeBits(type_bits, "excision")
  call SpaceMask_GetStateBits(excised, "excision", "excised")

  do k=1,nk
     do j=1,nj
        do i=1,ni

           if (r(i,j,k).lt.1.d0) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bits, &
                   excised)
           end if

        end do
     end do
  end do

  do k=1,nk
     do j=1,nj
        do i=1,ni
           if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, &
                excised)) then
              write(*,*) "The point (", i, j, k, ") has been excised."
           end if
        end do
     end do
  end do

end subroutine Eg_SetExcisedRegionByBitmask