1c program DRSTCST 2c>> 1996-06-05 DRSTCST Krogh Fixes for conversion to C. 3c>> 1996-05-28 DRSTCST Krogh Moved formats up. 4c>> 1994-10-19 DRSTCST Krogh Changes to use M77CON 5c>> 1994-08-09 DRSTCST WVS Remove '0' from format 6c>> 1992-04-22 DRSTCST CAO commented program statement 7c>> 1989-05-08 DRSTCST FTK, CLL 8c>> 1989-05-04 DRSTCST FTK, CLL 9c Driver to demonstrate STCST 10c ------------------------------------------------------------------ 11c--S replaces "?": DR?TCST, ?TCST 12c ------------------------------------------------------------------ 13 real F(65), S(32), T, TTIME 14 real DELTAT, DELTAO, OMEGA, FTRUE, SIN1,COS1 15 real PI, ZERO, ONE 16 integer K, KSKIP, M, MS, N, ND, MA(1) 17 parameter (M = 6) 18c parameter (N = 2 ** M + 1) 19 parameter (N = 65) 20 parameter (ND = 1) 21 parameter (KSKIP = 10) 22 parameter (PI = 3.1415926535897932384E0) 23 parameter (ZERO = 0.E0) 24 parameter (ONE = 1.E0) 25 data TTIME / 10.E0 / 26 data MA / M / 27 1000 format (/' K', 4X, 'OMEGA', 8X, 'COMPUTED', 9X, 'TRUE') 28 1001 format (1X, I3, 1P,E13.5, 2E15.7) 29c ------------------------------------------------------------------ 30 SIN1 = SIN (ONE) 31 COS1 = COS (ONE) 32 DELTAT = TTIME / REAL(N - 1) 33 DELTAO = REAL(KSKIP) * (PI / TTIME) 34 T = ZERO 35c Compute (TTIME / 2 ) * F(T) 36 F(1) = TTIME / PI 37 do 10 K = 2, N 38 T = T + DELTAT 39 F(K) = TTIME * SINH(T) / SINH(PI * T) 40 10 continue 41c 42 MS = 0 43 call STCST (F, 'C', 'A', MA, ND, MS, S) 44c 45 OMEGA = ZERO 46 write (*, 1000) 47 do 20 K = 1, N, KSKIP 48 FTRUE = SIN1 / (COSH(OMEGA) + COS1) 49 write (*, 1001) K, OMEGA, F(K), FTRUE 50 OMEGA = OMEGA + DELTAO 51 20 continue 52 stop 53 end 54