Enable R_NO_REMAP for a cleaner namespace
[openmx:openmx.git] / src / omxSadmvnWrapper.cpp
1 /*
2  *  Copyright 2007-2014 The OpenMx Project
3  *
4  *  Licensed under the Apache License, Version 2.0 (the "License");
5  *  you may not use this file except in compliance with the License.
6  *  You may obtain a copy of the License at
7  *
8  *       http://www.apache.org/licenses/LICENSE-2.0
9  *
10  *  Unless required by applicable law or agreed to in writing, software
11  *  distributed under the License is distributed on an "AS IS" BASIS,
12  *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13  *  See the License for the specific language governing permissions and
14  *  limitations under the License.
15  */
16
17 #include "omxDefines.h"
18 #include "omxAlgebraFunctions.h"
19 #include "omxSymbolTable.h"
20 #include "omxData.h"
21 #include "omxFIMLFitFunction.h"
22 #include "omxOpenmpWrap.h"
23 #include "omxSadmvnWrapper.h"
24
25 void omxSadmvnWrapper(omxFitFunction *oo, omxMatrix *cov, omxMatrix *ordCov, 
26         double *corList, double *lThresh, double *uThresh, int *Infin, double *likelihood, int *inform) {
27     // SADMVN calls Alan Genz's sadmvn.f--see appropriate file for licensing info.
28         // TODO: Check with Genz: should we be using sadmvn or sadmvn?
29         // Parameters are:
30         //      N               int                     # of vars
31         //      Lower   double*         Array of lower bounds
32         //      Upper   double*         Array of upper bounds
33         //      Infin   int*            Array of flags: 0 = (-Inf, upper] 1 = [lower, Inf), 2 = [lower, upper]
34         //      Correl  double*         Array of correlation coeffs: in row-major lower triangular order
35         //      MaxPts  int                     Maximum # of function values (use 1000*N or 1000*N*N)
36         //      Abseps  double          Absolute Rf_error tolerance.  Yick.
37         //      Releps  double          Relative Rf_error tolerance.  Use EPSILON.
38         //      Error   &double         On return: absolute real Rf_error, 99% confidence
39         //      Value   &double         On return: evaluated value
40         //      Inform  &int            On return: 0 = OK; 1 = Rerun, increase MaxPts; 2 = Bad input
41         // TODO: Separate block diagonal covariance matrices into pieces for integration separately
42         double Error;
43         double absEps = 1e-3;
44         double relEps = 0;
45         int MaxPts = 100000*cov->rows;
46         int numVars = ordCov->rows;
47         int fortranThreadId = omx_absolute_thread_num() + 1;
48         /* FOR DEBUGGING PURPOSES */
49     /*  numVars = 2;
50         lThresh[0] = -2;
51         uThresh[0] = -1.636364;
52         Infin[0] = 2;
53         lThresh[1] = 0;
54         uThresh[1] = 0;
55         Infin[1] = 0;
56         smallCor[0] = 1.0; smallCor[1] = 0; smallCor[2] = 1.0; */
57         F77_CALL(sadmvn)(&numVars, lThresh, uThresh, Infin, corList, &MaxPts, 
58                 &absEps, &relEps, &Error, likelihood, inform, &fortranThreadId);
59
60         if(OMX_DEBUG && !oo->matrix->currentState->currentRow) {
61                 char infinCodes[3][20];
62                 strcpy(infinCodes[0], "(-INF, upper]");
63                 strcpy(infinCodes[1], "[lower, INF)");
64                 strcpy(infinCodes[2], "[lower, upper]");
65                 mxLog("Input to sadmvn is (%d rows):", numVars); //:::DEBUG:::
66                 omxPrint(ordCov, "Ordinal Covariance Matrix"); //:::DEBUG:::
67                 for(int i = 0; i < numVars; i++) {
68                         mxLog("Row %d: %f, %f, %d(%s)", i, lThresh[i], uThresh[i], Infin[i], infinCodes[Infin[i]]);
69                 }
70
71                 mxLog("Cor: (Lower %d x %d):", cov->rows, cov->cols); //:::DEBUG:::
72                 for(int i = 0; i < cov->rows*(cov->rows-1)/2; i++) {
73                         // mxLog("Row %d of Cor: ", i);
74                         // for(int j = 0; j < i; j++)
75                         mxLog(" %f", corList[i]); // (i*(i-1)/2) + j]);
76                         // mxLog("");
77                 }
78         }
79
80         if(OMX_DEBUG) {
81                 mxLog("Output of sadmvn is %f, %f, %d.", Error, *likelihood, *inform); 
82         }
83