Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(*), | intent(inout) | :: | lhs | The variable which the container contents will be assigned to. |
||
class(container), | intent(in) | :: | rhs | The container variable. |
Transfers the contents of the container to another variable.
If the other variable is another container of the same type
then the contents will be transferred. If the other variable is
the same type as the contents of the container (as determined
by the typeguard routine provided for that
concrete type extension) then it will be given the value held by
the container. Otherwise, an error message will be printed and
the program stopped. If compiled with gfortran
then a backtrace
will also be printed. In the event that the container was never
set to a value, then this also constitutes an error.
subroutine assign_container(lhs, rhs)
!! Author: Chris MacMackin
!! Date: December 2015
!!
!! Transfers the contents of the container to another variable.
!! If the other variable is another container of the same type
!! then the contents will be transferred. If the other variable is
!! the same type as the contents of the container (as determined
!! by the [[container:typeguard]] routine provided for that
!! concrete type extension) then it will be given the value held by
!! the container. Otherwise, an error message will be printed and
!! the program stopped. If compiled with `gfortran` then a backtrace
!! will also be printed. In the event that the container was never
!! set to a value, then this also constitutes an error.
class(*), intent(inout) :: lhs
!! The variable which the container contents will be assigned to.
class(container), intent(in) :: rhs
!! The container variable.
!-------------------------------------------------------------------
select type(lhs)
class is(container)
if (same_type_as(lhs, rhs)) then
if (rhs%filled) then
lhs%storage = rhs%storage
lhs%filled = .true.
else if (lhs%filled) then
deallocate(lhs%storage)
lhs%filled = .false.
end if
return
else
write(stderr,*) "ERROR: Can not assign to a different container subclass"
#ifdef __GFORTRAN__
call backtrace
#endif
stop
end if
class default
if (rhs%filled) then
if (rhs%typeguard(lhs)) return
write(stderr,*) "ERROR: Can not assign this container's contents to given variable"
#ifdef __GFORTRAN__
call backtrace
#endif
stop
else
write(stderr,*) "ERROR: Container is empty."
#ifdef __GFORTRAN__
call backtrace
#endif
stop
end if
end select
end subroutine assign_container