store_vector_into_lala Subroutine

public subroutine store_vector_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
integer, public :: i

Source Code

subroutine store_vector_into_lala(varname,anything,ierr)
character(len=*),intent(in)  :: varname
class(*)                     :: anything(:)
integer,intent(out)          :: ierr
integer                      :: i
   select type(anything)
    type is (character(len=*));
       associate ( &
                   & letters  => [( real(str2ade(anything(i)),kind=dp),i=1,size(anything,dim=1))] , &
                   & r=> size(anything), &
                   & c=> len(anything) &
                 )
          call store_double_into_lala(varname,reshape(letters,[r,c],order=[2,1]),ierr=ierr)
       end associate
    type is (complex)
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]), &
                                          & reshape(real(aimag(anything),kind=dp),[1,size(anything)]), ierr=ierr)
    type is (complex(kind=dp))
       call store_double_into_lala(varname,reshape(real(anything),[1,size(anything)]), &
                                          & reshape(aimag(anything),[1,size(anything)]), ierr=ierr)
    type is (integer(kind=int8))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (integer(kind=int16))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (integer(kind=int32))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (integer(kind=int64))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (real(kind=real32))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (real(kind=real64))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (real(kind=real128))
       call store_double_into_lala(varname,reshape(real(anything,kind=dp),[1,size(anything)]),ierr=ierr)
    type is (logical)
       call store_double_into_lala(varname,reshape(merge(0.1d0,0.0d0,anything),[1,size(anything)]),ierr=ierr)
    class default
      stop 'crud. store_vector_into_lala(1) does not know about this type'
      ierr=-20
   end select
end subroutine store_vector_into_lala