!===========================================================
!     arraydemo90.f:  Fortran 90 version of arraydemo.f
!
!     Fortran 90 implements run-time allocation of arrays 
!     and other data objects.
! 
!     Array names are identified as dynamically allocated 
!     via the 'allocatable' attribute in the array 
!     declaration.  Storage is allocated via the 'allocate'
!     statement, and freed with 'deallocate'.
!===========================================================
      program         arraydemo90

      implicit        none

      integer         iargc,    i4arg

!-----------------------------------------------------------
!     Identify a1, a2 and a3 as rank-2 allocatable arrays.
!
!     Alternate equivalent declaration:
!
!     real*8, allocatable:: a1(:,:), a2(:,:), a3(:,:)
!-----------------------------------------------------------
      real*8,  allocatable, dimension( : , : ) ::
     &                a1,       a2,       a3

!-----------------------------------------------------------
!     Run-time array bounds.
!-----------------------------------------------------------
      integer         n1,       n2

!-----------------------------------------------------------
!     Get the desired array bounds from the command-line 
!     and perform superficial check for validity.
!-----------------------------------------------------------
      if( iargc() .ne. 2 ) go to 900
      n1 = i4arg(1,-1)
      n2 = i4arg(2,-1)
      if( n1 .le. 0  .or.  n2 .le.  0 ) go to 900
!-----------------------------------------------------------
!     Allocate the arrays
!-----------------------------------------------------------
      allocate( a1(n1,n2) )
      allocate( a2(n1,n2) )
      allocate( a3(n1,n2) )

!-----------------------------------------------------------
!     Define and manipulate the 2-d arrays using various 
!     subroutines.
!-----------------------------------------------------------
      call load2d( a1, n1, n2,  1.0d0 )
      call load2d( a2, n1, n2, -1.0d0 )
      call add2d(  a1, a2, a3, n1, n2 )

!-----------------------------------------------------------
!     Dump the 3 arrays to standard error.
!-----------------------------------------------------------
      call dump2d( a1, n1, n2, 'a1' )
      call dump2d( a2, n1, n2, 'a2' )
      call dump2d( a3, n1, n2, 'a1 + a2' )

!-----------------------------------------------------------
!     Deallocate the arrays
!-----------------------------------------------------------
      deallocate(a1)
      deallocate(a2)
      deallocate(a3)
   
      stop

900   continue
         write(0,*) 'usage: arraydemo90 <n1> <n2>'
      stop

      end

!-----------------------------------------------------------
!     Loads a 2-D array with the values:
!
!     a(i,j) = sc * (100 * j + i)
!-----------------------------------------------------------
      subroutine load2d(a,d1,d2,sc)
         implicit      none

         integer       d1,        d2
         real*8        a(d1,d2)
         real*8        sc

         integer       i,         j

         do j = 1 , d2
            do i = 1 , d1
               a(i,j) = sc * (100.0d0 * j + i)
            end do
         end do

         return

      end

!-----------------------------------------------------------
!     Adds 2-D arrays 'a1' and 'a2' element-wise and returns
!     result in 'a3'
!-----------------------------------------------------------
      subroutine add2d(a1,a2,a3,d1,d2)
         implicit      none

         integer       d1,        d2
         real*8        a1(d1,d2), a2(d1,d2), a3(d1,d2)

         integer       i,         j

         do j = 1 , d2
            do i = 1 , d1
               a3(i,j) = a1(i,j) + a2(i,j)
            end do
         end do

         return

      end

!-----------------------------------------------------------
!     Dumps 2-d array labelled with 'label' on stderr
!-----------------------------------------------------------
      subroutine dump2d(a,d1,d2,label)
         implicit       none

         integer        d1,       d2
         real*8         a(d1,d2)
         character*(*)  label
         integer        i,        j,        st
 
         if( d1 .gt. 0  .and.  d2 .gt. 0 ) then
            write(0,100) label
 100        format( /' <<< ',A,' >>>'/)
            do j = 1 , d2
               st = 1
 110           continue
                  write(0,120) ( a(i,j) , i = st , min(st+7,d1))
 120              format(' ',8F9.3)
                  st = st + 8
               if( st .le. d1 ) go to 110
               if( j .lt. d2 ) write(0,*)
            end do
         end if

         return

      end