!  Interactive drill concerning basic data-parallel programming
!  in Fortran 90.
!
!  Source file:  drill.f90		header:  drill.h

!  Maximum array dimensions are defined in drill.h:
!
!	Vectors:     Nh entries (currently Nh = 8)
!	2-D arrays:  Nv by Nh   (currently Nv = 8)

!  Print integer vector

      subroutine prn1vi(N, V)
      integer N
      integer, dimension(N) :: V

      print 21, V
 21   FORMAT (10(1X, I4))
      end subroutine prn1vi

!  Print 2 vectors on one line

      subroutine prn2vi(N1, V1, N2, V2)
      integer N1, N2
      integer V1(N1), V2(N2)

      INCLUDE 'drill.h'

      integer, parameter ::  Ns = 5*Nh

      character*80 S1, S2      
      integer i

      write (S1, 21) V1
      write (S2, 21) V2
      S1(Ns+1:80) = S2(1:Ns)			! Combined output
      print '(A80)', S1
 21   FORMAT (10(1X, I4))

      end subroutine prn2vi

!  Print 1 array

      subroutine prn1ai(M, N, A)
      integer M, N
      integer, dimension(M, N) :: A

      INTERFACE
      subroutine prn1vi(N, V)
      integer N
      integer, dimension(N) :: V
      END INTERFACE

      integer i
      do, i = 1, M
      call prn1vi(N, A(i,:))
      end do
      end subroutine prn1ai

!  Print 2 arrays side-by-side

      subroutine prn2ai(M1, N1, A1, M2, N2, A2)
      integer M1, N1, M2, N2
      integer A1(M1, N1), A2(M2, N2)
      INTERFACE
      subroutine prn1vi(N, V)
      integer N
      integer, dimension(N) :: V
      END INTERFACE

      INTERFACE
      subroutine prn2vi(N1, V1, N2, V2)
      integer N1, N2
      integer V1(N1), V2(N2)
      END INTERFACE

      integer i, minm

      minm = min(M1, M2)
      do, i = 1, minm				! Two rows side-by-side
      call prn2vi(N1, A1(i,:), N2, A2(i,:))
      end do
      if ( M1 > M2) then
	do, i = minm+1, M1			! Finish A1
	  call prn1vi(N1, A1(i,:))
	end do
      else if ( M1 < M2 ) then
	do, i = minm+1, M2			! Finish A2
          print '(40X, 10(1X, I4))', A2(i,:)
	end do
      end if
      end subroutine prn2ai

!  Pause until user input

      subroutine pause()

      character*4 c

      print *
      print '("Type any character and press return to proceed > "$)'
      read *, c
      print *
      end subroutine pause

!  Print instructions

      subroutine prinst()
      print *, &
      "    Welcome to the Fortran 90 drill.  All questions involve", &
      " arrays."
      print *, &
      "When printed, arrays are named and described as illustrated", &
      " by:"
      print *
      print *, "X(1:6):"
      print *, "  19  -17   23    2   -5  -10"
      print *
      print *, "A two-dimensional array might be printed as:"
      print *
      print *, "A(0:1, 1:4)."
      print *, "   4    3    2    1"
      print *, "  -4   -3   -2   -1"
      print *
      print *, &
      "In all cases the subscript range is shown explicitly, though it", &
      " may not"
      print *, "always be important."
      print *
      print *, &
      "    After each questions the program pauses so you can consi", &
      "der the answer,"
      print *, &
      "then it pauses again after printing the answer.  To continue,", &
      " type any"
      print *, "character and press return."
      call pause()
      endsubroutine prinst

!  Part I questions   --------------------------------------------------------

      subroutine partI()

      INTERFACE
      subroutine prn1vi(N, V)
      integer N
      integer, dimension(N) :: V
      END INTERFACE
      INTERFACE
      subroutine prn2vi(N1, V1, N2, V2)
      integer N1, N2
      integer V1(N1), V2(N2)
      END INTERFACE
      INTERFACE
      subroutine prn1ai(M, N, A)
      integer M, N
      integer, dimension(M, N) :: A
      END INTERFACE
      INTERFACE
      subroutine prn2ai(M1, N1, A1, M2, N2, A2)
      integer M1, N1, M2, N2
      integer A1(M1, N1), A2(M2, N2)
      END INTERFACE

      integer, dimension(1:5)      :: Vx, Vy
      integer V3(1:3), V4(1:4)
      integer, dimension(1:3, 1:3) :: Sx, Sy, Id, Is, Js
      integer, dimension(1:3, 1:4) :: Rx, Ry, Ir, Jr

!  Part I
      print *, "Part 1 - Array construction"
      print *
!  Question 1.
      print *, "I.1.  What is the value of  (/ (ii, ii=1,5) /)  (an array)?"
      Vx = (/ (ii, ii=1,5) /)
      call pause()
      print *, "Result(1:5):"
      call prn1vi(5, Vx)
      call pause()
!  Question 2.
      print *, "I.2.  What is the value of  (/ (ii, ii=0,8,2) /) ?"
      Vx = (/ (ii, ii=0,8,2) /)
      call pause()
      print *, "Result(1:5):"
      call prn1vi(5, Vx)
      call pause
!  Question I.3.
      print *, &
      "I.3.  What is the result of  SPREAD((/ (ii, ii=1,3) /), 2, 4) ?"
      Ir = SPREAD((/ (ii, ii=1,3) /), 2, 4)
      call pause
      print *, "Result(1:3, 1:4):"
      call prn1ai(3, 4, Ir)
      call pause
!  Question 4.
      print *, &
      "I.4.  What is the result of  SPREAD((/ (ii, ii=1,4) /), 1, 3) ?"
      Jr = SPREAD((/ (ii, ii=1,4) /), 1, 3)
      call pause()
      print *, "Result(1:3, 1:4):"
      call prn1Ai(3, 4, Jr)
      call pause()
!  Question 5.
      print *, "I.5.  Consider the program fragment:"
      print *
      print *, "      integer, dimension(1:3, 1:3) :: Id, I, J"
      print *, "      . . ."
      print *, "      I  = SPREAD((/ (ii, ii=1,3) /), 2, 3)"
      print *, "      J  = SPREAD((/ (ii, ii=1,3) /), 1, 3)"
      print *, "      Id = 0"
      print *, "      WHERE ( I == J ) Id = 1"
      print *
      print *, "What are I, J, Id, I+J?"
      Is = SPREAD((/ (ii, ii=1,3) /), 2, 3)
      Js = SPREAD((/ (ii, ii=1,3) /), 1, 3)
      Id = 0
      WHERE ( Is == Js ) Id = 1
      call pause
      print *, "I(1:3, 1:3):                            J(1:3, 1:3):"
      call prn2ai(3, 3, Is, 3, 3, Js)
      print *, "Id(1:3, 1:3):                       (I+J)(1:3, 1:3):"
      call prn2ai(3, 3, Id, 3, 3, Is+Js)
      call pause
      end subroutine partI

!  Part II questions  --------------------------------------------------------

      subroutine partII()

      INTERFACE
      subroutine prn1vi(N, V)
      integer N
      integer, dimension(N) :: V
      END INTERFACE
      INTERFACE
      subroutine prn2vi(N1, V1, N2, V2)
      integer N1, N2
      integer V1(N1), V2(N2)
      END INTERFACE
      INTERFACE
      subroutine prn1ai(M, N, A)
      integer M, N
      integer, dimension(M, N) :: A
      END INTERFACE
      INTERFACE
      subroutine prn2ai(M1, N1, A1, M2, N2, A2)
      integer M1, N1, M2, N2
      integer A1(M1, N1), A2(M2, N2)
      END INTERFACE

      integer, dimension(8) :: V
      integer, dimension(1:4, 1:5) :: Ax, Rx

!  Part II
      print *,"Part II - Subarrays and related topics"
!  Question 1
      V = (/ 10, 9, 8, 6, -1, -2, -3, -4 /)
      print *, "II.1  Given"
      print *
      print *, "V(1:8):"
      call prn1vi(8, V)
      print *
      print*, "  what is V(2:5)?   V(6:7)?"
      call pause()
      print *, "V(2:5):                                 V(6:7):"
      call prn2vi(4, V(2:5), 2, V(6:7))
      call pause()
!  Question 2
      Ax = 5*SPREAD((/ (ii, ii=0,3) /), 2, 5) &
                         + SPREAD((/ (ii, ii=1,5) /) , 1, 4)
      print *, "II.2.  Given"
      print *, "A(1:4, 1:5):"
      call prn1ai(4, 5, Ax)
      print *, "what is A(1:2, 3:4)?    A(2:4, 1:4)?"
      call pause()
      print *, "A(1:2, 3:4)                             A(2:4, 1:4)"
      call prn2ai(2, 2, Ax(1:2, 3:4), 3, 4, Ax(2:4, 1:4))
      print *, "what is SPREAD(A(:,2), 2, 5)?  SPREAD(A(:,4), 1, 4)?"
      call pause()
      print *, "SPREAD(A(:,2), 2, 5)                    ", &
               "SPREAD(A(:,4), 1, 4)"
      call prn2ai(4, 5, SPREAD(Ax(:,2), 2, 5), &
                  4, 4, SPREAD(Ax(:,4), 1, 4))
      call pause()
!  Question 3
      end subroutine partII


!  The drill program. --------------------------------------------------------

      program drill

      print 21
 21   FORMAT (1X, 78("-"))		! Horizontal line
      call prinst()			! Overall instructions
      call partI()
      call partII()
      print *, "That's all for now."
      print 21
      end program drill
