Free cookie consent management tool by TermsFeed Policy Generator

source: branches/2789_MathNetNumerics-Exploration/HeuristicLab.Algorithms.DataAnalysis.Experimental/642_main.f @ 17185

Last change on this file since 17185 was 15443, checked in by gkronber, 7 years ago

#2789 added interface to CUBGCV using DllImport of Fortran library

File size: 3.2 KB
Line 
1       PROGRAM CUBGCVMAIN
2     USE MODCUBGCV
3C CUBGCV TEST DRIVER
4C ------------------
5C
6C AUTHOR          - M.F.HUTCHINSON
7C                   CSIRO DIVISION OF WATER AND LAND RESOURCES
8C                   GPO BOX 1666
9C                   CANBERRA ACT 2601
10C                   AUSTRALIA
11C
12C LATEST REVISION - 7 AUGUST 1986
13C
14C COMPUTER        - VAX/DOUBLE
15C
16C USAGE           - MAIN PROGRAM
17C
18C REQUIRED ROUTINES - CUBGCV,SPINT1,SPFIT1,SPCOF1,SPERR1,GGRAND
19C
20C REMARKS   USES SUBROUTINE CUBGCV TO FIT A CUBIC SMOOTHING SPLINE
21C           TO 50 DATA POINTS WHICH ARE GENERATED BY ADDING A RANDOM
22C           VARIABLE WITH UNIFORM DENSITY IN THE INTERVAL [-0.3,0.3]
23C           TO 50 POINTS SAMPLED FROM THE CURVE  Y=SIN(3*PI*X/2).
24C           RANDOM DEVIATES IN THE INTERVAL [0,1] ARE GENERATED BY THE
25C           DOUBLE PRECISION FUNCTION GGRAND (SIMILAR TO IMSL FUNCTION
26C           GGUBFS).  THE ABSCISSAE ARE UNEQUALLY SPACED IN [0,1].
27C
28C           POINT STANDARD ERROR ESTIMATES ARE RETURNED IN SE BY
29C           SETTING JOB=1.  THE ERROR VARIANCE ESTIMATE IS RETURNED
30C           IN VAR.  IT COMPARES FAVOURABLY WITH THE TRUE VALUE OF 0.03.
31C           SUMMARY STATISTICS FROM THE ARRAY WK ARE WRITTEN TO
32C           UNIT 6.  DATA VALUES AND FITTED VALUES WITH ESTIMATED
33C           STANDARD ERRORS ARE ALSO WRITTEN TO UNIT 6.
34C
35      PARAMETER (N=50, IC=49)
36C
37      INTEGER            JOB,IER
38      DOUBLE PRECISION   X(N),F(N),Y(N),DF(N),C(IC,3),WK(7*(N+2)),
39     *                   VAR,SE(N)
40      DOUBLE PRECISION   GGRAND,DSEED
41C
42C---INITIALIZE---
43      DSEED=1.2345D4
44      JOB=1
45      VAR=-1.0D0
46C
47C---CALCULATE DATA POINTS---
48      DO 10 I=1,N
49      X(I)=(I - 0.5)/N + (2.0*GGRAND(DSEED) - 1.0)/(3.0*N)
50      F(I)=DSIN(4.71238*X(I)) + (2.0*GGRAND(DSEED) - 1.0)*0.3
51      DF(I)=1.0D0
52  10  CONTINUE
53C
54C---FIT CUBIC SPLINE---
55      CALL CUBGCV(X,F,DF,N,Y,C,IC,VAR,JOB,SE,WK,IER)
56C
57C---WRITE OUT RESULTS---
58      WRITE(6,20)
59  20  FORMAT(' CUBGCV TEST DRIVER RESULTS:')
60      WRITE(6,30) IER,VAR,WK(3),WK(4),WK(2)
61  30  FORMAT(/' IER =',I4/' VAR =',F7.4/
62     *        ' GENERALIZED CROSS VALIDATION =',F7.4/
63     *        ' MEAN SQUARE RESIDUAL         =',F7.4/
64     *        ' RESIDUAL DEGREES OF FREEDOM  =',F7.2)
65      WRITE(6,40)
66  40  FORMAT(/' INPUT DATA',17X,'OUTPUT RESULTS'//
67     *         '   I    X(I)    F(I)',6X,'    Y(I)   SE(I)',
68     *          '      C(I,1)      C(I,2)      C(I,3)')
69      DO 60 I=1,N-1
70      WRITE(6,50) I,X(I),F(I),Y(I),SE(I),(C(I,J),J=1,3)
71  50  FORMAT(I4,2F8.4,6X,2F8.4,3E12.4)
72  60  CONTINUE
73      WRITE(6,50) N,X(N),F(N),Y(N),SE(N)
74      STOP
75      END
76      DOUBLE PRECISION FUNCTION GGRAND(DSEED)
77C
78C DOUBLE PRECISION UNIFORM RANDOM NUMBER GENERATOR
79C
80C CONSTANTS: A = 7**5
81C            B = 2**31 - 1
82C            C = 2**31
83C
84C REFERENCE: IMSL MANUAL, CHAPTER G - GENERATION AND TESTING OF
85C                                     RANDOM NUMBERS
86C
87C---SPECIFICATIONS FOR ARGUMENTS---
88      DOUBLE PRECISION DSEED
89C
90C---SPECIFICATIONS FOR LOCAL VARIABLES---
91      DOUBLE PRECISION A,B,C,S
92C
93      DATA A,B,C/16807.0D0, 2147483647.0D0, 2147483648.0D0/
94C
95      S=DSEED
96      S=DMOD(A*S, B)
97      GGRAND=S/C
98      DSEED=S
99      RETURN
100      END
Note: See TracBrowser for help on using the repository browser.