308-208 - Computers in Engineering - Previous Midterms

Midterm Winter 1993


1. (10 min., 12 points)

What will the following program write? (Remember that integers are real numbers are printed differently)

    INTEGER a,b,c            
    REAL d,e,g

    a = 28/2**2
    b = 4.5-(7/3)*3.0
    c = 5/7*7
    d = mod(7,2)
    e = (3/2)*4.5-3.5*2.0
    f = b
    PRINT *,a,b,c,d,e,f
    STOP
    END


2. (10 min., 12 points)

What will the following program print.
    REAL w,v,u
    INTEGER z,y,x

    y = 2.7E1-3.1E-1
    v = 18/3.0
    x = 25/3**2/3*2
    z = 14.5-2.1*3
    w = y
    u = (5/2)**2-6.5
    PRINT *,u
    PRINT *,v,w
    PRINT *,x,y
    PRINT *,z
    STOP
    END


3. (10 minutes, 10 points)

What will the following program print?

        I = 4
        J = 5
        K = 2.4
        A = 1.2
        B = 2.3
        C = 4.8
        CALL FOOBAR (B,C,A)
        CALL FOOBAZ (J,I,K)
        CALL FOOBAZ (I,I,7)
        E = C/4
        F = B * K
        CALL FOOBAR (D,E,F)
        PRINT *, I, J, K, L
        PRINT *, A, B, C, D
        PRINT *, E, F
        STOP
        END

        SUBROUTINE FOOBAZ (I,J,K)
        I = J + K / 2
        RETURN
        END

        SUBROUTINE FOOBAR (A, B, C)
        A = (B - C) * 2
        RETURN
        END


4. (10 minutes, 14 points)

What will the following program print?

      INTEGER K,A(20),N,X,Y,Z,W
      READ *,N
      READ *,(A(K),K=1,N)
      PRINT *,(A(K),K=1,N,2)
      CALL FINDME(A,N,X,Y)
      PRINT *,X,Y
      CALL FOO (A,N,Z,W)
      PRINT *,Z,W
      STOP
      END
       
      SUBROUTINE FINDME(A,N,X,Y)
      INTEGER A(20),N,X,Y,I,TOTAL
      TOTAL = -999
      DO 200 I=1,N
         IF (A(I).GT.TOTAL) THEN
            TOTAL=A(I)
            X=I
            Y=TOTAL
         ENDIF
200 CONTINUE
      RETURN
      END
      

      SUBROUTINE FOO(A,N,Z,W)
      INTEGER A(20),N,Z,W,I,TOTAL
      TOTAL = 100
      DO 300 I=1,N
         IF (A(I).LT.TOTAL) THEN
            TOTAL=A(I)
            Z=I
            W=TOTAL
         ENDIF
300 CONTINUE
      RETURN
      END
 /DATA
 5
 7 9 10 2 1 13 45


5. (10 minutes, 14 points)

What will the following program print?


       INTEGER A,B
       DO 22 A=13,23,4
          DO 33 B=1,3
             IF (MOD(A,B).GT.B/3) THEN
                IF (A/6.GE.B) THEN
                   PRINT *,'HEGEL'
                ELSE
                   PRINT *,'NIETZSCHE'
                ENDIF
             ELSE
                PRINT *,'SPINOZA'
             ENDIF
33        CONTINUE
22     CONTINUE
       STOP
       END


6. (40 minutes, 38 points)

Write a simple FORTRAN 77 program to accept data in the following format:

Columns Description                                 Example

1-7             Student ID                                  9512345
11-35           Student Name                        St. Louis, Rejean
41-45           Total Course Assignments (100)    78
46-50           Mid Term also out of 100            67
51-55           Final exam out of 100               73

Your program should read a group of records with the above data, terminated by 9999999. For each input record, print the input data, under appropriate headings, and calculate and print the final course mark for each student, all on the same line. The course mark is calculated by counting the assignments for 30%, the midterm for 20%, and the final exam for 50%. The course mark should be printed to one decimal place for each student (e.g. 73.3 for the above example).

At the end of the class list, print the Student ID and Name of the TOP THREE students in the class.

Your program does NOT need to use 2-D arrays nor subprograms.

WRITE your program, with Control Lines, neatly:


End of Midterm