Example 8.1

FORTRAN Version

!
      PROGRAM P81
!
!     Shows use of passing data via COMMON
!
      IMPLICIT NONE
      REAL :: X,Y(10),START,STEP
      INTEGER :: K
!
      INTERFACE
      SUBROUTINE CALC(K,X,Y)
      IMPLICIT NONE
      REAL, INTENT(IN OUT) :: X,Y(:)
      INTEGER, INTENT(IN OUT) :: K
      END SUBROUTINE CALC
      END INTERFACE
!
      PRINT *, 'This is Program >> P81  - SUBROUTINE'
!
      START=0.0
      STEP=0.1
      X=START
!
      PRINT 16,START,STEP
16    FORMAT(' INITIAL VALUE =',F5.2/  &
             ' INCREMENT     =',F5.2/)
!
L1:   DO K=1,10
         CALL CALC(K,X,Y)
         PRINT 17,X,Y(K)  ! Y values are stored and
         X=X+STEP
      END DO L1           ! could be used again
17    FORMAT(2F10.4)
      STOP
      END PROGRAM P81
!
      SUBROUTINE CALC(K,X,Y)
      IMPLICIT NONE
      REAL, INTENT(IN OUT) :: X,Y(:)
      INTEGER, INTENT(IN OUT) :: K     
      REAL :: SD,PI,U,C,GAUSS
      U=0.0
      SD=1.0
      PI=3.14159
      C=1.0/(SD*SQRT(2.0*PI))
      GAUSS=C*EXP(-(X-U)**2/(2.0*SD**2))
      Y(K)=GAUSS
      RETURN
      END SUBROUTINE CALC
!     

              +--------------------------------------------------+
              |     32-bit Power for Lahey Computer Systems      |
              |   Phar Lap's 386|DOS-Extender(tm) Version 7.0    |
              |  Copyright (C) 1986-94 Phar Lap Software, Inc.   |
              |           Available Memory = 14880 Kb            |
              +--------------------------------------------------+


This is Program >> P81  - SUBROUTINE
INITIAL VALUE = 0.00
INCREMENT     = 0.10

   0.0000    0.3989
   0.1000    0.3970
   0.2000    0.3910
   0.3000    0.3814
   0.4000    0.3683
   0.5000    0.3521
   0.6000    0.3332
   0.7000    0.3123
   0.8000    0.2897
   0.9000    0.2661

Pascal Version

{$P256}
{$G512}
{$D+}
PROGRAM p81 (input, output);
CONST
  pi = 3.14159;
  u = 0.0;
  sd = 1.0;
TYPE
  list = ARRAY[1..10] OF REAL;
VAR
  y : list;
  k : INTEGER;
  x, start, step : REAL;

PROCEDURE calc (i : INTEGER; x : REAL; VAR z : list);
VAR
  c, gauss : REAL;
BEGIN
  c := 1.0/(sd * sqrt(2.0 * pi));
  gauss := c * exp (-sqr(x - u) / (2.0 * sqr(sd)));
  z[i] := gauss
END;

BEGIN
  readln (start, step);
  x := start;
  FOR k := 1 TO 10 DO
    BEGIN
      calc (k, x, y);
      x := x + step
    END;
  writeln;
  writeln ('Initial Value =', start : 5:2);
  writeln ('Increment =', step : 5:2);
  writeln;
  FOR k := 1 TO 10 DO
    writeln ( y[k] : 10:4)
END.

0.0   0.1

Last modified: 08/07/97