store_scalar_into_lala Subroutine

public subroutine store_scalar_into_lala(varname, anything, ierr)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: varname
class(*) :: anything
integer, intent(out) :: ierr

Contents


Variables

Type Visibility Attributes Name Initial
logical, public, parameter :: T = .true.

Source Code

subroutine store_scalar_into_lala(varname,anything,ierr)
character(len=*),intent(in)  :: varname
class(*)                     :: anything
integer,intent(out)          :: ierr
logical,parameter            :: T=.true.
   select type(anything)
    type is (character(len=*))
       call store_double_into_lala(varname,reshape(real(str2ade(anything),kind=dp),[1,len(anything)]),ierr=ierr)
    type is (complex)
       call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]), &
                                          & reshape([real(aimag(anything),kind=dp)],[1,1]), ierr=ierr)
    type is (complex(kind=dp))
             call store_double_into_lala(varname,reshape([real(anything)],[1,1]), reshape([aimag(anything)],[1,1]), ierr=ierr)
    type is (integer(kind=int8));  call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (integer(kind=int16)); call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (integer(kind=int32)); call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (integer(kind=int64)); call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (real(kind=real32));   call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (real(kind=real64));   call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    type is (real(kind=real128));  call store_double_into_lala(varname,reshape([real(anything,kind=dp)],[1,1]),ierr=ierr)
    ! arbitrarily, 0 is false and not 0 is true, although I prefer the opposite
    type is (logical);             call store_double_into_lala(varname,reshape([merge(1.0d0,0.0d0,anything)],[1,1]),ierr=ierr)
    class default
      stop 'crud. store_scalar_into_lala(1) does not know about this type'
   end select
end subroutine store_scalar_into_lala