PROGRAM Oceanograpic_Data_Analysis !----------------------------------------------------------------------- ! Program to find the average ocean depth in each half (separated by ! the diagonal) of a square section of the ocean. Variables used are: ! Depth : a two-dimensional allocatable array of ! depth readings ! FileName : name of the file containing depth readings ! N : the number of rows (or columns) ! I : subscript ! NorthSum : the sum of the northern depths ! SouthSum : the sum of the southern depths ! DiagonalSum : the sum of the depths on the diagonal ! OverallSum : the overall sum ! NorthAverage : the average of the northern depths ! SouthAverage : the average of the southern depths ! OverallAverage : the overall average ! Readings_per_Half : number of elements in each half ! Note: It is assumed that the elements on the diagonal are ! included in the overall average but not in either half. ! Also, the first line of the data file must contain ! the value of N ! ! Input (keyboard): The file name ! Input (file): The elements of array Depth ! Output (screen): The array Depth in table format, NorthAverage, ! SouthAverage, and OverallAverage !----------------------------------------------------------------------- CHARACTER(20) :: FileName INTEGER :: N, I, J, Readings_per_Half REAL, DIMENSION(:, :), ALLOCATABLE :: Depth REAL :: NorthSum = 0.0, NorthAverage, SouthSum = 0.0, SouthAverage, & OverallSum = 0.0, OverallAverage ! Get the name of the input file, open it for input WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter name of data file: " READ *, FileName OPEN (UNIT = 10, FILE = FileName, STATUS = "OLD") ! Read N, allocate the N x N array Depth, and ! read values for its entries from the file READ (10,*) N ALLOCATE(Depth(N,N)) DO I = 1, N READ (10,*) (Depth(I,J), J = 1, N) END DO DiagonalSum = Depth(1,1) DO I = 2,N ! Add entries in I-th column above diagonal to North NorthSum = NorthSum + SUM(Depth(1:I-1, I)) ! Add entries in I-th row below diagonal to SouthSum SouthSum = SouthSum + SUM(Depth(I, 1:I-1)) ! Add diagonal entry to DiagonalSum DiagonalSum = DiagonalSum + Depth(I,I) END DO OverallSum = NorthSum + SouthSum + DiagonalSum ! Calculate the north, south, and overall average depths Readings_per_Half = (N**2 - N) / 2 NorthAverage = NorthSum / REAL(Readings_per_Half) SouthAverage = SouthSum / REAL(Readings_per_Half) OverallAverage = OverallSum / REAL(N**2) ! Display the Depth array and the average depths PRINT '(/ 1X, T29, "Ocean Depths")' DO I = 1, N PRINT '(/1X, 13F6.1)', (Depth(I,J), J = 1, N) END DO PRINT * PRINT 10, "Northern half average depth", NorthAverage PRINT 10, "Southern half average depth", SouthAverage PRINT 10, "Overall average depth", OverallAverage 10 FORMAT(/ 1X, A, T30, F6.2, " feet") END PROGRAM Oceanograpic_Data_Analysis