! 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 !OUTPUT:
+--------------------------------------------------+ | 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
{$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.DATA:
0.0 0.1
Last modified: 08/07/97