PROGRAM lab3 IMPLICIT NONE INTEGER :: asize, firstneg REAL(4), DIMENSION(:,:), ALLOCATABLE :: a REAL(4) :: bsum ! ! ====================================== ! Set size of array, asize ! asize must be an even number < = 100 ! ====================================== ! DO asize = 50 print*, "asize is set to ", asize if (MOD(asize,2) == 1) then write(6,"(a)") " WARNING: Size is odd number. Try again." else if (asize > 100) then write(6,"(a)") " WARNING: Size is too large. Try again." else if (asize < 0) then write(6,"(a)") " WARNING: Size is negative. Try again." else EXIT end if end DO allocate (a(1:asize,1:asize)) ! ! ==================== ! Initialize array ! ==================== ! call INITL(a) ! ! ===================================================================== ! Find first row whose sum is <= -3. (return 0 if all rowsums > -3.) ! ===================================================================== ! firstneg = 1 DO ! ------------------------------------------------------------ ! Sum the elements of row firstneg and terminate the loop ! if value <= -3.0 if (SUM(a(firstneg,1:asize)) <= -3.0) EXIT ! ------------------------------------------------------------ firstneg = firstneg + 1 ! ------------------------------------------------------------ ! If firstneg is greater than the size of the array, set ! firstneg to zero and terminate the loop. Put all your ! statements on one line if (firstneg > asize) then; firstneg = 0; EXIT; end if ! ------------------------------------------------------------ end DO ! ! =========================================== ! Call routine to operate on the matrix ! =========================================== ! call multiply(a,bsum) write(6,"(a,i3,f10.3)") " (firstneg,bsum) = ",firstneg,bsum !+++++++++++++++++++++++++++++++++++++++++++++ CONTAINS !+++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE initl(a) IMPLICIT NONE REAL(4), DIMENSION(:,:), INTENT(OUT) :: a INTEGER :: asize INTEGER, DIMENSION(3), PARAMETER :: inv = (/ 999, 12345, 34101 /) call RANDOM_SEED(put=inv) a = 0. asize = SIZE(a,1) call RANDOM_NUMBER(a(1:asize,1:asize)) a(1:asize,1:asize) = 2.*a(1:asize,1:asize) - 1. end SUBROUTINE initl !--------------------------------------------- SUBROUTINE multiply(a,bsum) IMPLICIT NONE ! ------------------------------------------------------------------------ ! Declare "a" as an assumed-shape, REAL(4), 2-D array with proper INTENT REAL(4), DIMENSION(:,:), INTENT(IN) :: a ! ------------------------------------------------------------------------ REAL(4), INTENT(OUT) :: bsum ! ------------------------------------------------------------------- ! Declare an array "b" to be half as big as "a" in both dimensions REAL(4), DIMENSION(SIZE(a,1)/2,SIZE(a,2)/2) :: b ! ------------------------------------------------------------------- INTEGER :: asize, i, j asize = SIZE(a,1) ! ------------------------------------------------------------------- ! Since "a" has even dimensions, i.e., a(2n,2n), it can be written ! ! a1 | a2 ! a = ----+---- ! a3 | a4 ! ! where a1, a2, a3 and a4 are dimension (n,n). ! ! Insert code setting b = a3*a2, where * is the matrix multiply operation ! b = MATMUL(a(asize/2+1:asize,1:asize/2), a(1:asize/2,asize/2+1:asize)) ! -------------------------------------------------------------------------- ! The following is the loop that is to be replaced in this exercise ! -------------------------------------------------------------------------- ! bsum = 0. ! DO i=1,asize/2 ! bsum = bsum + b(i,i) ! end DO ! -------------------------------------------------------------------------- ! Put the single statement that replaces it here ! -------------------------------------------------------------------------- bsum = SUM( (/ (b(i,i),i=1,asize/2) /) ) ! ! -------------------------------------------------------------------------- ! Of course, there's more that one way to do it. Here's a sampling of ! alternatives that make use of the MASK optional argument to SUM: ! -------------------------------------------------------------------------- ! bsum = SUM( b, MASK = SPREAD( (/ (i,i=1,asize/2) /), 2, asize/2 ) == & ! SPREAD( (/ (i,i=1,asize/2) /), 1, asize/2 ) ) ! bsum = SUM( b, MASK = RESHAPE( SOURCE = (/ (MOD(i,asize/2+1), & ! i=1,(asize/2)**2) /), SHAPE = SHAPE(b) ) == 1 ) ! bsum = SUM( b, MASK = RESHAPE( SOURCE = SPREAD ( (/ 1,(0,i=1, & ! asize/2) /), 2, asize/2), SHAPE = SHAPE(b), PAD = (/ 1 /) ) == 1 ) ! bsum = SUM( b, MASK = RESHAPE( SOURCE = (/ 1,((i/(asize/2+1),i=1, & ! asize/2+1),j=1,asize/2-1) /), SHAPE = SHAPE(b) ) == 1 ) ! bsum = SUM( b, MASK = CSHIFT( SPREAD( & ! (/ 1,(0,i=1,asize/2-1) /), 2, asize/2), & ! (/ (-j+1,j=1,asize/2) /) ) == 1 ) ! -------------------------------------------------------------------------- ! Note: it is probable that *none* of these works as efficiently as ! the original, simple DO loop! ! -------------------------------------------------------------------------- ! end SUBROUTINE multiply !--------------------------------------------- end PROGRAM lab3