!----------------------------------------------------------------------------
!                              VBDEMO.F90
!
!                       Lahey Computer Systems, Inc.
!                                PO Box 6091
!                         Incline Village, NV 89450
!                            voice: 702-831-2500
!                              fax: 702-831-8123
!                              bbs: 702-831-8023
!                        e-mail: support@lahey.com
!
!              Copyright(c) 1995 - 1998, Lahey Computer Systems, Inc.
!
!----------------------------------------------------------------------------
 
!
!   my_lf90_function_1( i)
!
!   Calculates the factorial of the argument
!
function my_lf90_function_1( i) result( fact)
   dll_export my_lf90_function_1
   integer :: fact
   integer :: i
   integer :: k
   fact = 1
   do k = 2,i
      fact = fact * k
   end do
end      

!
!   my_lf90_subroutine_2( )
!
!   Adds the first two arguments and stores it in the third argument
!
subroutine my_lf90_subroutine_2( x, y, z) 
   dll_export my_lf90_subroutine_2
   real :: x,y,z
   z = x + y
end      

!
!   my_lf90_subroutine_3( )
!
!   Demonstrates string argument passing 
!
subroutine my_lf90_subroutine_3( str, up_down) 
  dll_export my_lf90_subroutine_3
  character(len=*) :: str
  integer :: up_down

  if( up_down .eq. 1) then  ! change to uppercase
     do i = 1,len(str)
        if( iachar(str(i:i)) .ge. iachar('a') .and.      &
            iachar(str(i:i)) .le. iachar('z') )    then
           str(i:i) = char(iachar(str(i:i)) - 32) 
        end if
     end do
  else                      ! change to lowercase
     do i = 1,len(str)
        if( iachar(str(i:i)) .ge. iachar('A') .and.      &
            iachar(str(i:i)) .le. iachar('Z') )    then
           str(i:i) = char(iachar(str(i:i)) + 32) 
        end if
     end do
  endif

end

!
!   my_lf90_subroutine_4(i,z)
!
!   Gets an integer array, and passes back the square of the value of each element
!   in the real array.
!
subroutine my_lf90_subroutine_4( i, z)
   dll_export my_lf90_subroutine_4
   integer :: i(10)
   integer :: k
   real    :: z(10)

   do k = 1,10
      z(k) = i(k) * i(k)
   end do
end