tem_load_sphere_single Subroutine

private subroutine tem_load_sphere_single(me, transform, conf, thandle)

This routine single sphere from object table

Arguments

Type IntentOptional Attributes Name
type(tem_sphere_type), intent(out) :: me

single sphere
type(tem_transformation_type), intent(in) :: transform

transformation for spatial object
type(flu_State) :: conf

lua state
integer, intent(in) :: thandle

Calls

proc~~tem_load_sphere_single~~CallsGraph proc~tem_load_sphere_single tem_load_sphere_single aot_get_val aot_get_val proc~tem_load_sphere_single->aot_get_val proc~tem_abort tem_abort proc~tem_load_sphere_single->proc~tem_abort mpi_abort mpi_abort proc~tem_abort->mpi_abort

Called by

proc~~tem_load_sphere_single~~CalledByGraph proc~tem_load_sphere_single tem_load_sphere_single interface~tem_load_sphere tem_load_sphere interface~tem_load_sphere->proc~tem_load_sphere_single interface~tem_load_sphere->interface~tem_load_sphere proc~tem_load_sphere tem_load_sphere proc~tem_load_sphere->proc~tem_load_sphere_single

Source Code

  subroutine tem_load_sphere_single(me, transform, conf, thandle )
    ! -------------------------------------------------------------------------!
    !inferface variables
    !> single sphere
    type(tem_sphere_type), intent(out) :: me
    !> transformation for spatial object
    type(tem_transformation_type), intent(in) :: transform
    !> lua state
    type(flu_state) :: conf
    integer, intent(in) :: thandle !< handle for canonical objects
    ! -------------------------------------------------------------------------!
    integer :: iError, vError(3), errFatal(3)
    ! -------------------------------------------------------------------------!
    errFatal = aoterr_fatal

    ! read origin of sphere
    call aot_get_val(L=conf, thandle=thandle, val=me%origin, &
      &              ErrCode=vError, key='origin', pos = 1)
    if (any(btest(vError, errFatal))) then
      write(logunit(0),*) &
        &  ' Error in configuration: origin is not given to define a sphere'
      call tem_abort()
    end if

    !read radius of  sphere
    call aot_get_val(L=conf, thandle=thandle, val=me%radius, &
      &              ErrCode=iError, key='radius', pos=2 )
    if (btest(iError, aoterr_Fatal)) then
      write(logunit(0),*) 'FATAL Error occured, while retrieving radius'
      if (btest(iError, aoterr_NonExistent)) &
        &  write(logunit(0),*) 'Variable not existent!'
      if (btest(iError, aoterr_WrongType)) &
        &  write(logunit(0),*) 'Variable has wrong type!'
      call tem_abort()
    end if

    call aot_get_val(L=conf, thandle=thandle, val=me%only_surface, &
      &              ErrCode=iError, key='only_surface', &
      &              pos=3, default=.false.)

    if (btest(iError, aoterr_WrongType)) then
      write(logunit(0),*) 'Error occured, while retrieving sphere only_surface'
      write(logunit(0),*) 'Variable has wrong type!'
      write(logunit(0),*) 'Should be a LOGICAL!'
      call tem_abort()
    endif

    write(logunit(1),"(A,3E12.5)") '        origin: ', me%origin
    write(logunit(1),"(A,3E12.5)") '        radius: ', me%radius
    write(logunit(1),"(A,L5    )") '  only_surface: ', me%only_surface

    !apply transformation to sphere
    if(transform%active) then
      if(transform%deform%active) then
        write(logunit(1),*) 'WARNING: Sphere deformation is only applied to'
        write(logunit(1),*) '         its radius as a scaling factor of '
        write(logunit(1),*) '         first entry in the deformation table.'
        me%radius = me%radius * transform%deform%matrix(1,1)
        me%origin = matmul(transform%deform%matrix, me%origin)
      endif
      if(transform%translate%active) then
        me%origin = me%origin + transform%translate%vec
      endif
    endif

  end subroutine tem_load_sphere_single