1 #include <R.h>
2 #include <R_ext/Print.h>
3
cnlprt_C(char * msg,int * plen)4 void cnlprt_C(char *msg, int *plen)
5 {
6 char buf[1000];
7 int len = *plen;
8
9 memmove(buf, msg, len);
10 buf[len] = '\0';
11 Rprintf("\n%s\n", buf);
12 }
13
14 /* 30 FORMAT(/10H IT NF,6X,1HF,7X,5HRELDF,3X,6HPRELDF,3X,5HRELDX,
15 1 2X,13HMODEL STPPAR) */
F77_SUB(h30)16 void F77_SUB(h30)(void)
17 {
18 Rprintf("\n IT NF F RELDF PRELDF RELDX MODEL STPPAR\n");
19 }
20 /* 40 FORMAT(/11H IT NF,7X,1HF,8X,5HRELDF,4X,6HPRELDF,4X,5HRELDX,
21 1 3X,6HSTPPAR) */
F77_SUB(h40)22 void F77_SUB(h40)(void)
23 {
24 Rprintf("\n IT NF F RELDF PRELDF RELDX STPPAR");
25 }
26
27 /* 70 FORMAT(/11H IT NF,6X,1HF,7X,5HRELDF,3X,6HPRELDF,3X,5HRELDX,
28 1 2X,13HMODEL STPPAR,2X,6HD*STEP,2X,7HNPRELDF) */
F77_SUB(h70)29 void F77_SUB(h70)(void)
30 {
31 Rprintf("\n IT NF F RELDF PRELDF RELDX MODEL STPPAR");
32 Rprintf(" D*STEP NPRELDF\n");
33 }
34
35 /* 80 FORMAT(/11H IT NF,7X,1HF,8X,5HRELDF,4X,6HPRELDF,4X,5HRELDX,
36 1 3X,6HSTPPAR,3X,6HD*STEP,3X,7HNPRELDF) */
F77_SUB(h80)37 void F77_SUB(h80)(void)
38 {
39 Rprintf("\n IT NF F RELDF PRELDF RELDX STPPAR");
40 Rprintf(" D*STEP NPRELDF\n");
41 }
42
43 /* 100 FORMAT(I6,I5,D10.3,2D9.2,D8.1,A3,A4,2D8.1,D9.2) */
h100s_C(int * i1,int * i2,double * d1,double * d2,double * d3,double * d4,char * a1,char * a2,double * d5)44 void h100s_C(int *i1, int *i2, double *d1, double *d2, double *d3,
45 double *d4, char *a1, char *a2,
46 double *d5)
47 {
48 Rprintf("%6d%5d%10.3e%9.2e%9.2e%8.1e%3s%4s%8.1e\n",
49 *i1, *i2, *d1, *d2, *d3, *d4, a1, a2, *d5);
50 }
51
h100l_C(int * i1,int * i2,double * d1,double * d2,double * d3,double * d4,char * a1,char * a2,double * d5,double * d6,double * d7)52 void h100l_C(int *i1, int *i2, double *d1, double *d2, double *d3,
53 double *d4, char *a1, char *a2,
54 double *d5, double *d6, double *d7)
55 {
56 Rprintf("%6d%5d%10.3e%9.2e%9.2e%8.1e%3s%4s%8.1e%8.1e%e9.2\n",
57 *i1, *i2, *d1, *d2, *d3, *d4, a1, a2, *d5, *d6, *d7);
58 }
59
60 /* 110 FORMAT(I6,I5,D11.3,2D10.2,3D9.1,D10.2) */
F77_SUB(h110s)61 void F77_SUB(h110s)(int *i1, int *i2, double *d1, double *d2, double *d3,
62 double *d4, double *d5)
63 {
64 Rprintf("%6d%5d%11.3e%10.2e%10.2e%9.1e%9.1e\n",
65 *i1, *i2, *d1, *d2, *d3, *d4, *d5);
66 }
F77_SUB(h110l)67 void F77_SUB(h110l)(int *i1, int *i2, double *d1, double *d2, double *d3,
68 double *d4, double *d5, double *d6, double *d7)
69 {
70 Rprintf("%6d%5d%11.3e%10.2e%10.2e%9.1e%9.1e%9.1e%10.2e\n",
71 *i1, *i2, *d1, *d2, *d3, *d4, *d5, *d6, *d7);
72 }
73
F77_SUB(h380)74 void F77_SUB(h380)(int *i)
75 {
76 Rprintf(" ***** IV(1) =%i5 *****\n", *i);
77 }
78
F77_SUB(h400)79 void F77_SUB(h400)(int *p, double *x, double *d)
80 {
81 int i;
82
83 Rprintf("\n I INITIAL X(I) D(I)\n\n");
84 for (i = 0; i < *p; i++)
85 Rprintf(" %5i%17.6e%14.3e\n", i+1, x[i], d[i]);
86 }
87
F77_SUB(h410)88 void F77_SUB(h410)(double *x)
89 {
90 Rprintf(" 0 1%10.3e\n", *x);
91 }
92
F77_SUB(h420)93 void F77_SUB(h420)(double *x)
94 {
95 Rprintf(" 0 1%11.3e\n", *x);
96 }
97
F77_SUB(h450)98 void F77_SUB(h450)(double *d1, double *d2, int *i1, int *i2,
99 double *d3, double *d4)
100 {
101 Rprintf("\n FUNCTION%17.6e RELDX%17.3e\n", *d1, *d2);
102 Rprintf(" FUNC. EVALS%8i GRAD. EVALS%8u\n", *i1, *i2);
103 Rprintf(" PRELDF%16.3e NPRELDF%15.3e\n", *d3, *d4);
104 }
105
F77_SUB(h460)106 void F77_SUB(h460)(int *i)
107 {
108 Rprintf("\n %4d EXTRA FUNC. EVALS FOR COVARIANCE AND DIAGNOSTICS\n", *i);
109 }
110
F77_SUB(h470)111 void F77_SUB(h470)(int *i)
112 {
113 Rprintf("\n %4d EXTRA GRAD. EVALS FOR COVARIANCE AND DIAGNOSTICS\n", *i);
114 }
115
F77_SUB(h500)116 void F77_SUB(h500)(int *p, double *x, double *d, double *g)
117 {
118 int i;
119
120 Rprintf("\n");
121 for (i = 0; i < *p; i++)
122 Rprintf(" %5i%16.6e%14.3e%14.3e\n", i+1, x[i], d[i], g[i]);
123 }
124