store_double_into_lala Subroutine

public subroutine store_double_into_lala(varname, realxx, imagxx, ierr)

NAME

 put_from_lala(3f) - [M_matrix] return data from lala(3f) to calling program
 LICENSE(MIT)

SYNOPSIS

subroutine put_into_lala(varname,A,IERR)

character(len=*),intent(in)              :: varname
[INTRINSIC_TYPE],allocatable,intent(in)  :: a(:,:)
integer,intent(out)                      :: ierr

DESCRIPTION

Define a variable in the lala(3f) utility with a variable declared
in the calling program.

OPTIONS

VARNAME Name of lala(3f) variable to retrieve
  A     May be of TYPE INTEGER, REAL, CHARACTER, LOGICAL or COMPLEX.
        May be a scalar, vector, or MxN matrix.

RETURNS

IERR   Zero if no error occurred

EXAMPLE

sample program:

program demo_put_into_lala
use M_matrix, only : lala, get_from_lala, put_into_lala
implicit none
integer :: ierr

   ! store some data from the program into lala(3f)
   call put_into_lala('A',[1,2,3,4,5,6,7,8,9],ierr)
   call put_into_lala('B',[1.1,2.2,3.3],ierr)
   call put_into_lala('C',"This is my title",ierr)

   ! call lala(3f) and display the values
   call lala([character(len=80) :: &
   & 'who,A,B', &
   & 'display(C);', &
   & '', &
   & ''])

end program demo_put_into_lala

Results:

  > Your current variables are...
  > C  B  A  eps  flops  eye  rand
  >using 33 out of 200000 elements
  >
  > A  =
  >     1.    2.    3.    4.    5.    6.    7.    8.    9.
  >
  > B  =
  >    1.1000    2.2000    3.3000
  >This is my title

assume input arrays can be one or two dimension but lala stores everything as a vector and store m and n ??? why ??? why ???? if(G_ERR.ne.0) ???? check if varname is an acceptable name ???? if(G_ERR.ne.0)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: varname
doubleprecision, intent(in) :: realxx(:,:)
doubleprecision, intent(in), optional :: imagxx(:,:)
integer, intent(out) :: ierr

Contents

Variables

Source Code

store_double_into_lala

Variables

Type Visibility Attributes Name Initial
integer, public :: id(GG_MAX_NAME_LENGTH)
integer, public :: img
integer, public :: location
integer, public :: m
integer, public :: n
integer, public :: space_left

Source Code

subroutine store_double_into_lala(varname,realxx,imagxx,ierr)

! ident_34="@(#) M_matrix _store_double_into_lala(3f) put a variable name and its data onto LALA stack"

character(len=*),intent(in)          :: varname                ! the name of realxx.
doubleprecision,intent(in)           :: realxx(:,:)            ! inputarray is an M by N matrix
doubleprecision,intent(in),optional  :: imagxx(:,:)            ! inputarray is an M by N matrix
integer,intent(out)                  :: ierr                   ! return with nonzero ierr after LALA error message.

integer                              :: img
integer                              :: space_left
integer                              :: id(GG_MAX_NAME_LENGTH) ! ID = name, in numeric format
integer                              :: location
integer                              :: m,n                    ! m, n = dimensions

   if(GM_BIGMEM.LT.0) then
      call lala_init(200000) ! if not initialized initialize
   else
   endif

   ierr=0
   if(present(imagxx))then
      img=1
      if(size(realxx,dim=1).ne.size(imagxx,dim=1).or.size(realxx,dim=2).ne.size(imagxx,dim=2))then
         call journal('sc','<ERROR>*lala_put* real and imaginary parts have different sizes')
         ierr=-1
         return
      endif
   else
      img=0
   endif

   if(G_ARGUMENT_POINTER.ne.0)then
      location = G_VAR_DATALOC(G_ARGUMENT_POINTER) ! location of bottom of used scratch space
   else
     !call journal('sc','<WARNING>G_ARGUMENT_POINTER=',G_ARGUMENT_POINTER)
     G_ARGUMENT_POINTER= 1
     G_VAR_DATALOC(G_ARGUMENT_POINTER)=1
     location=1
   endif
   space_left = G_VAR_DATALOC(G_TOP_OF_SAVED) - location
   !! assume input arrays can be one or two dimension but lala stores everything as a vector and store m and n
   m=size(realxx,dim=1)
   n=size(realxx,dim=2)
   if (m*n .gt. space_left) then
      call journal('sc','<ERROR>*lala_put* insufficient space to save data to LALA')
      ierr=-2
      return
   elseif(m*n.eq.0)then ! check for zero-size input array
      call journal('sc','<ERROR>*lala_put* cannot save empty arrays to LALA')
      ierr=-3
      return
   else
      if (img .eq. 0)then
         call mat_rset(m*n,0.0d0,GM_IMAGS(location),1) ! set imaginary values to zero
      else
         GM_IMAGS(location:location+m*n-1)=rowpack(imagxx)
      endif
      GM_REALS(location:location+m*n-1)=rowpack(realxx)
   endif
   G_VAR_ROWS(G_ARGUMENT_POINTER)=m
   G_VAR_COLS(G_ARGUMENT_POINTER)=n
   G_SYM = semi   !! ??? why
   G_RHS = 0      !! ??? why
   call mat_str2buf(varname,id,GG_MAX_NAME_LENGTH)                        ! convert character string to an ID
   !! ???? if(G_ERR.ne.0)
   !! ???? check if varname is an acceptable name
   call mat_stack_put(id)
   !! ???? if(G_ERR.ne.0)
   G_ARGUMENT_POINTER = G_ARGUMENT_POINTER + 1
   G_VAR_ROWS(G_ARGUMENT_POINTER) = 0
   G_VAR_COLS(G_ARGUMENT_POINTER) = 0
end subroutine store_double_into_lala