setup_indices_spacetime Subroutine

public recursive subroutine setup_indices_spacetime(fun, varSys, point, offset_bit, iLevel, tree, nPnts, idx)

This routine stores provided points in method_data of spacetime_listElem and return the indices of points or evaluated value in the growing array. If spacetime function is time-independent then pre-compute values and store in growing array of evalVal in tem_pointData_type.

! Store spatial value for unique points depends on stFun type

Arguments

Type IntentOptional Attributes Name
class(tem_varSys_op_type), intent(in) :: fun

Description of the method to obtain the variables, here some preset values might be stored, like the space time function to use or the required variables.
type(tem_varSys_type), intent(in) :: varSys

The variable system to obtain the variable from.
real(kind=rk), intent(in) :: point(:,:)

List of space coordinate points to store as growing array in method_data
character(len=1), intent(in), optional :: offset_bit(:)

Offset bit encoded as character for every point.

Offset integer coord(3) is converted into a character with offset_bit = achar( (coord(1)+1) + (coord(2)+1)4 + (coord(3)+1)16 ) Backward transformation form character to 3 integer: coord(1) = mod(ichar(offset_bit),4) - 1 coord(2) = mod(ichar(offset_bit),16)/4 - 1 coord(3) = ichar(offset_bit)/16 - 1

If not present default is to center i.e offset_bit = achar(1+4+16)
integer, intent(in) :: iLevel

Level to which input points belong to
type(treelmesh_type), intent(in) :: tree

global treelm mesh info
integer, intent(in) :: nPnts

Number of points to add in method_data of this variable
integer, intent(out) :: idx(:)

Index of points in the growing array and variable val array. Size: nPoints

This must be stored in boundary or source depends on who calls this routine. This index is required to return a value using getValOfIndex.

Calls

proc~~setup_indices_spacetime~~CallsGraph proc~setup_indices_spacetime setup_indices_spacetime interface~append~29 append proc~setup_indices_spacetime->interface~append~29 interface~positionofval~5 positionofval proc~setup_indices_spacetime->interface~positionofval~5 interface~tem_spatial_storeval tem_spatial_storeVal proc~setup_indices_spacetime->interface~tem_spatial_storeval interface~truncate~18 truncate proc~setup_indices_spacetime->interface~truncate~18 names names proc~setup_indices_spacetime->names proc~tem_abort tem_abort proc~setup_indices_spacetime->proc~tem_abort proc~tem_coordofreal tem_CoordOfReal proc~setup_indices_spacetime->proc~tem_coordofreal proc~tem_idofcoord tem_IdOfCoord proc~setup_indices_spacetime->proc~tem_idofcoord proc~tem_posofid tem_PosOfId proc~setup_indices_spacetime->proc~tem_posofid tem_positioninsorted tem_positioninsorted proc~setup_indices_spacetime->tem_positioninsorted varpos varpos proc~setup_indices_spacetime->varpos proc~append_da_label append_da_label interface~append~29->proc~append_da_label proc~append_da_veclabel append_da_veclabel interface~append~29->proc~append_da_veclabel proc~posofval_label posofval_label interface~positionofval~5->proc~posofval_label proc~tem_spatial_scalar_storeval tem_spatial_scalar_storeVal interface~tem_spatial_storeval->proc~tem_spatial_scalar_storeval proc~tem_spatial_vector_storeval tem_spatial_vector_storeVal interface~tem_spatial_storeval->proc~tem_spatial_vector_storeval proc~truncate_ga_char truncate_ga_char interface~truncate~18->proc~truncate_ga_char mpi_abort mpi_abort proc~tem_abort->mpi_abort proc~tem_pathcomparison tem_PathComparison proc~tem_posofid->proc~tem_pathcomparison proc~tem_pathof tem_PathOf proc~tem_posofid->proc~tem_pathof interface~expand~27 expand proc~append_da_label->interface~expand~27 interface~sortedposofval~5 sortedposofval proc~append_da_label->interface~sortedposofval~5 proc~append_da_veclabel->interface~expand~27 proc~posofval_label->interface~sortedposofval~5 proc~tem_spatial_scalar_storeval->interface~truncate~18 interface~append~24 append proc~tem_spatial_scalar_storeval->interface~append~24 interface~tem_spatial_for tem_spatial_for proc~tem_spatial_scalar_storeval->interface~tem_spatial_for proc~tem_spatial_vector_storeval->interface~truncate~18 proc~tem_spatial_vector_storeval->interface~append~24 proc~tem_spatial_vector_storeval->interface~tem_spatial_for

Source Code

  recursive subroutine setup_indices_spacetime( fun, varSys, point, &
    & offset_bit, iLevel, tree, nPnts, idx                          )
    !---------------------------`-----------------------------------------------!
    !> Description of the method to obtain the variables, here some preset
    !! values might be stored, like the space time function to use or the
    !! required variables.
    class(tem_varSys_op_type), intent(in) :: fun

    !> The variable system to obtain the variable from.
    type(tem_varSys_type), intent(in) :: varSys

    !> List of space coordinate points to store as growing array in
    !! method_data
    real(kind=rk), intent(in) :: point(:,:)

    !> Offset bit encoded as character for every point.
    !!
    !! Offset integer coord(3) is converted into a character with
    !! offset_bit = achar( (coord(1)+1) + (coord(2)+1)*4 + (coord(3)+1)*16 )
    !! Backward transformation form character to 3 integer:
    !! coord(1) = mod(ichar(offset_bit),4) - 1
    !! coord(2) = mod(ichar(offset_bit),16)/4 - 1
    !! coord(3) = ichar(offset_bit)/16 - 1
    !!
    !! If not present default is to center i.e offset_bit = achar(1+4+16)
    character, optional, intent(in) :: offset_bit(:)

    !> Level to which input points belong to
    integer, intent(in) :: iLevel

    !> global treelm mesh info
    type(treelmesh_type), intent(in) :: tree

    !> Number of points to add in method_data of this variable
    integer, intent(in) :: nPnts

    !> Index of points in the growing array and variable val array.
    !! Size: nPoints
    !!
    !! This must be stored in boundary or source depends on who
    !! calls this routine.
    !! This index is required to return a value using getValOfIndex.
    integer, intent(out) :: idx(:)
    !--------------------------------------------------------------------------!
    ! -------------------------------------------------------------------------!
    type(tem_st_fun_listElem_type), pointer :: fPtr
    integer :: iStFun, iPnt, posInTree, nUniquePnts, iVar
    character :: offset_bit_local
    logical, allocatable :: storePnt(:), storeOffsetBit(:), storeVal(:)
    integer :: elemPos
    integer(kind=long_k) :: treeID
    logical :: addPoint, wasAdded
    real(kind=rk) :: uniquePnts(nPnts,3)
    ! -------------------------------------------------------------------------!


    call C_F_POINTER( fun%method_Data, fPtr )

    allocate(storePnt(fPtr%nVals))
    allocate(storeVal(fPtr%nVals))
    allocate(storeOffsetBit(fPtr%nVals))

    ! Store points only for time dependent spacetime functions
    do iStFun = 1, fPtr%nVals
      select case (trim(fPtr%val(iStFun)%fun_kind))
      case ('none', 'const')
        ! time independent and no need to store points
        storePnt(iStFun) = .false.
        storeOffsetBit(iStFun) = .false.
        storeVal(iStFun) = .false.
      case ('combined')
        ! spatial is time independent so compute spatial value and store it.
        storePnt(iStFun) = .false.
        storeOffsetBit(iStFun) = .false.
        storeVal(iStFun) = .true.

      case ('lua_fun', 'miescatter_displacementfieldz',               &
        &   'miescatter_magneticfieldx', 'miescatter_magneticfieldy', &
        &   'cylindrical_wave')
        storePnt(iStFun) = .true.
        storeOffsetBit(iStFun) = .false.
        storeVal(iStFun) = .false.
      case ('apesmate')
        storePnt(iStFun) = .true.
        storeOffsetBit(iStFun) = (fPtr%val(iStFun)%aps_coupling%isSurface==0)
        storeVal(iStFun) = .false.
      case ('precice')
        storePnt(iStFun) = .true.
        storeOffsetBit(iStFun) = .true.
        storeVal(iStFun) = .true.
        ! for writing to precice, we need the position of the variables in
        ! the variable system
        do iVar = 1, fPtr%val(iStFun)%precice_coupling%writeVar%nVars
          fPtr%val(iStFun)%precice_coupling%writeVar%varPos(iVar) =     &
             PositionOfVal( me = varSys%varName,                        &
               &            val = fPtr%val(iStFun)%precice_coupling     &
               &                                  %writeVar%names(iVar) )
             if (fPtr%val(iStFun)%precice_coupling%writeVar%varPos(iVar) == 0) &
               & then
               write(*,*) 'position in Varsys for writing variable ',          &
                 & trim(fPtr%val(iStFun)%precice_coupling%writeVar%names(iVar)),&
                 & ' not found'
                 call tem_abort()
             end if
        end do

        ! same for reading from precice
        do iVar = 1, fPtr%val(iStFun)%precice_coupling%readVar%nVars
          fPtr%val(iStFun)%precice_coupling%readVar%varPos(iVar) =     &
             PositionOfVal( me = varSys%varName,                       &
               &            val = fPtr%val(iStFun)%precice_coupling    &
               &                                  %readVar%names(iVar) )
             if (fPtr%val(iStFun)%precice_coupling%readVar%varPos(iVar) == 0) &
               & then
               write(*,*) 'position in Varsys for reading ',                   &
                 & trim(fPtr%val(iStFun)%precice_coupling%readVar%names(iVar)),&
                 & 'not found'
                 call tem_abort()
             end if
        end do

      case default
        write(logUnit(1),*)'ERROR: Unknown spatial function in '// &
          &                'setup_indices.'
        call tem_abort()
      end select
    end do !iStFun

    ! initialize index with zero to identify points which does not
    ! belong to subTree
    idx = 0

    ! number of unique points added
    nUniquePnts = 0
    do iPnt = 1, nPnts
      addPoint = .false.

      ! get treeID from globalmaxLevel since points from ghost elements are
      ! also passed to this routine
      treeID = tem_IdOfCoord( tem_CoordOfReal(tree, point(iPnt, :)) )
      elemPos = tem_PosOfId( treeID, tree%treeID )
      !if (elemPos == 0)  then
       ! call tem_abort('Error: treeID not found in st-fun setup_indices')
     ! end if

      ! if any spacetime function has useGlobalMesh then store all points
      ! else store only points which belong to subTree of spacetime variable.
      if ( any(fPtr%val(:)%subTree%useGlobalMesh) ) then
        addPoint = .true.
      else
        stFunLoop: do iStFun = 1, fPtr%nVals
          posInTree = tem_PositionInSorted(                                &
            &                 me    = fPtr%val(iStFun)%subTree%map2global, &
            &                 val   = elemPos                              )
          if (posInTree > 0) then
            addPoint = .true.
            exit stFunLoop
          end if
        end do stFunLoop
      end if !use global mesh

      if (addPoint) then
        ! use center offset bit as default
        if (present(offset_bit)) then
          offset_bit_local = offset_bit(iPnt)
        else
          offset_bit_local = qOffset_inChar(q000)
        end if

        ! append point, offset_bit and elemPos to pointData type
        call append(me             = fPtr%pntData%pntLvl(iLevel), &
          &         point          = point(iPnt,:),               &
          &         storePnt       = any(storePnt),               &
          &         offset_bit     = offset_bit_local,            &
          &         storeOffsetBit = any(storeOffsetBit),         &
          &         elemPos        = elemPos,                     &
          &         tree           = tree,                        &
          &         pos            = idx(iPnt),                   &
          &         wasAdded       = wasAdded                     )

        if (wasAdded) then
          nUniquePnts = nUniquePnts + 1
          uniquePnts(nUniquePnts,:) = point(iPnt,:)
        end if

      end if ! add point
    end do !iPnt

    if (any(storePnt)) call truncate(fPtr%pntData%pntLvl(iLevel)%grwPnt)
    if (any(storeOffsetBit)) &
      & call truncate(fPtr%pntData%pntLvl(iLevel)%offset_bit)

    deallocate(storePnt)
    deallocate(storeOffsetBit)
    call truncate(fPtr%pntData%pntLvl(iLevel)%treeID)
    call truncate(fPtr%pntData%pntLvl(iLevel)%elemPos)

    !!! Store spatial value for unique points depends on stFun type
    if ( any(storeVal) .and. nUniquePnts > 0 ) then
      do iStFun = 1, fPtr%nVals
        select case (trim(fPtr%val(iStFun)%fun_kind))
        case ('combined')
          if (fun%nComponents == 1) then
            call tem_spatial_storeVal( me     = fPtr%val(iStFun)%spatial,    &
              &                        coord  = uniquePnts(1:nUniquePnts,:), &
              &                        nVals  = nUniquePnts,                 &
              &                        iLevel = iLevel                       )
          else
            call tem_spatial_storeVal( me     = fPtr%val(iStFun)%spatial,    &
              &                        coord  = uniquePnts(1:nUniquePnts,:), &
              &                        nVals  = nUniquePnts,                 &
              &                        iLevel = iLevel,                      &
              &                        nComps = fun%nComponents              )
          end if
        end select
      end do !iStFun
    end if !store spatial value
    deallocate(storeVal)

  end subroutine setup_indices_spacetime