tem_load_ellipsoid_single Subroutine

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

This routine single ellipsoid from object table

Arguments

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

single ellipsoid
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_ellipsoid_single~2~~CallsGraph proc~tem_load_ellipsoid_single~2 tem_load_ellipsoid_single proc~aot_get_val~2 aot_get_val proc~tem_load_ellipsoid_single~2->proc~aot_get_val~2 proc~tem_abort tem_abort proc~tem_load_ellipsoid_single~2->proc~tem_abort mpi_abort mpi_abort proc~tem_abort->mpi_abort

Called by

proc~~tem_load_ellipsoid_single~2~~CalledByGraph proc~tem_load_ellipsoid_single~2 tem_load_ellipsoid_single proc~tem_load_ellipsoid~2 tem_load_ellipsoid proc~tem_load_ellipsoid~2->proc~tem_load_ellipsoid_single~2 interface~tem_load_ellipsoid~2 tem_load_ellipsoid interface~tem_load_ellipsoid~2->proc~tem_load_ellipsoid_single~2 interface~tem_load_ellipsoid~2->proc~tem_load_ellipsoid_single~2 interface~tem_load_ellipsoid~2->interface~tem_load_ellipsoid~2 interface~tem_load_ellipsoid~2->interface~tem_load_ellipsoid~2

Contents

Source Code

tem_load_ellipsoid_single

Source Code

  subroutine tem_load_ellipsoid_single(me, transform, conf, thandle )
    ! --------------------------------------------------------------------------!
    !inferface variables
    !> single ellipsoid
    type(tem_ellipsoid_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 :: ii, iError, vError(3), errFatal(3)
    ! --------------------------------------------------------------------------!
    errFatal = aoterr_fatal

    ! read origin of ellipsoid
    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 ellipsoid'
      call tem_abort()
    end if

    !read radius of  ellipsoid
    call aot_get_val(L=conf, thandle=thandle, val=me%radius, &
      &              ErrCode=vError, key='radius', pos=2 )
    if (any(btest(vError, errFatal))) then
      write(logunit(0),*) &
        &  ' Error in configuration: radius is not given to define a ellipsoid'
      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 ellipsoid 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 ellipsoid
    if(transform%active) then
      if(transform%deform%active) then
        write(logunit(5),"(A)")   '  apply deformation ...'
        do ii = 1, 3
          me%radius(ii) = me%radius(ii)     &
            &                      * transform%deform%matrix(ii,ii)
        end do
        me%origin = matmul(transform%deform%matrix, me%origin)
      endif
      if(transform%translate%active) then
        write(logunit(5),"(A)")   '  apply translation ...'
        me%origin = me%origin + transform%translate%vec
      endif
    endif

  end subroutine tem_load_ellipsoid_single