mat_funs Subroutine

public subroutine mat_funs(id)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: id(GG_MAX_NAME_LENGTH)

Contents

Source Code


Variables

Type Visibility Attributes Name Initial
integer, public :: i
character(len=GG_MAX_NAME_LENGTH), public :: name
integer, public :: selector

Source Code

subroutine mat_funs(id)

! ident_12="@(#) M_matrix ml_funcs(3fp) scan function list and set G_FUN and G_FIN"

integer,intent(in)                :: id(GG_MAX_NAME_LENGTH)
integer                           :: selector
character(len=GG_MAX_NAME_LENGTH) :: name
integer                           :: i

   name=' '
   do i=1,size(id)
      if(id(i).le.0)exit
      if(id(i).le.G_CHARSET_SIZE)then
         name(i:i)=achar(id(i))
      else
         call journal('sc',' function name contains unacceptable characters:',name,'... ADE=',id(i),'position=',i)
         G_FIN = 0
         return
      endif
   enddo
   !
   !  find value for given function name to determine what to call for each name.
   !     o first digit indicates which routine to call (SUBROUTINE MAT_MATFN[1-6])
   !     o remaining digits indicate nth number in computed goto in called routine
   select case(name)
   case('eps');             selector=000
   case('flop');            selector=000

   case('inv');             selector=101
   case('det');             selector=102
   case('rcond');           selector=103
   case('lu');              selector=104
   case('invh','inverse_hilbert','invhilb');  selector=105
   case('chol');            selector=106
   case('rref');            selector=107

   case('sin');             selector=201
   case('cos');             selector=202
   case('atan');            selector=203
   case('exp');             selector=204
   case('sqrt');            selector=205
   case('log');             selector=206
   case('eig');             selector=211
   case('schur');           selector=212
   case('hess');            selector=213
   case('poly');            selector=214
   case('roots');           selector=215
   case('abs');             selector=221  !  calling  codes  corresponding  to  the  function  names
   case('round');           selector=222
   case('real');            selector=223
   case('imag','aimag');    selector=224
   case('conjg');           selector=225

   case('svd');             selector=301
   case('pinv');            selector=302
   case('cond');            selector=303
   case('norm');            selector=304
   case('rank');            selector=305

   case('qr');              selector=401
   case('orth');            selector=402

   case('exec','include','source','script');  selector=501
   case('save');            selector=502
   case('load');            selector=503
   case('print');           selector=504
   case('diary');           selector=505
   case('disp','display','echo');  selector=506
   case('base');            selector=507
   case('lines');           selector=508
   case('char');            selector=509
   case('plot');            selector=510
   case('rat');             selector=511
   case('debug');           selector=512
   case('show');            selector=513
   case('delete');          selector=514

   case('magic');           selector=601
   case('diag');            selector=602
   case('sum');             selector=603
   case('prod');            selector=604
   case('user');            selector=605
   case('eye');             selector=606
   case('rand','random');   selector=607
   case('ones');            selector=608
   case('chop');            selector=609
   case('shape');           selector=610
   case('kron');            selector=611
   case('tril');            selector=614
   case('triu');            selector=615
   case('zeros');           selector=616
   case('getenv');          selector=617
   case('dat','date_and_time');   selector=618

   case default !  function name was not found
      G_FIN = 0
      return
   end select

!  found name so get G_FIN and G_FUN value from corresponding code

   G_FIN = mod(selector,100) ! which case to select in called procedure
   G_FUN = selector/100      ! which routine to call (SUBROUTINE MAT_MATFN[1-6])

   if (G_RHS.eq.0 .and. selector.eq.606) G_FIN = 0
   if (G_RHS.eq.0 .and. selector.eq.607) G_FIN = 0
end subroutine mat_funs