Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Archives
dmm
Commits
27d32e7a
Commit
27d32e7a
authored
Nov 03, 2014
by
Alessandro Rossi
Browse files
Merge branch 'master' of
https://github.com/rossial/DMM
parents
00a42d2c
698a38e2
Changes
37
Expand all
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
27d32e7a
...
...
@@ -2,4 +2,14 @@
.deps
.dirstamp
*.mod
*~
\ No newline at end of file
*~
dmm
*.nml
*.m
*.PRI
*.DIS
*.FST
*.INN
*.ML
*.PAR
*.UNB
Makefile
View file @
27d32e7a
...
...
@@ -106,30 +106,43 @@ RANDLIB_OBJS = \
sexpo.o
\
spofa.o
MATLAB_OBJS
=
ReadMatLabDesign.o
EXEC
=
dmm
VPATH
:=
$(VPATH)
randlib
LIBS
=
-llapack
-ldl
all
:
$(MOD_OBJS) $(OBJS) $(RANDLIB_OBJS)
ifdef
DLL
UNAME_S
:=
$(
shell
uname
-s
)
ifeq
($(UNAME_S), Linux)
MATLAB_LIBS
=
-L
$(MATLABROOT)
/bin/glnxa64
-Wl
,-rpath-link,
$(MATLABROOT)
/bin/glnxa64
-Wl
,-rpath,
$(MATLABROOT)
/bin/glnxa64
endif
ifeq
($(UNAME_S), Darwin)
MATLAB_LIBS
=
-L
$(MATLABROOT)
/bin/maci64
endif
LIBS
=
$(MATLAB_LIBS)
-llapack
-leng
-lmx
DLL_OBJS
+=
design.o setfilem.o geterrstr.o
INCLUDE
=
-I
$(MATLABROOT)
/extern/include
DEFINE
=
-DORIGDLL
else
LIBS
=
-llapack
endif
all
:
$(MOD_OBJS) $(OBJS) $(RANDLIB_OBJS) $(DLL_OBJS)
$(FC)
$(FCFLAGS)
$^
$(LIBS)
-o
$(EXEC)
%.o
:
%.f90 %.mod
$(FC)
$(FCFLAGS)
-c
$<
$(FC)
$(FCFLAGS)
$(INCLUDE)
$(DEFINE)
-c
$<
%.o
:
%.f90
$(FC)
$(FCFLAGS)
-c
$<
$(FC)
$(FCFLAGS)
$(INCLUDE)
$(DEFINE)
-c
$<
%.mod
:
%.f90 %.o
@
true
%.o
:
%.f
$(FC)
$(FFFLAGS)
-c
$<
$(FC)
$(FFFLAGS)
$(INCLUDE)
$(DEFINE)
-c
$<
%.o
:
%.for
$(FC)
$(FFFLAGS)
-c
$<
$(FC)
$(FFFLAGS)
$(INCLUDE)
$(DEFINE)
-c
$<
clean
:
rm
-f
*
.o
$(EXEC)
rm
-f
*
.o
$(EXEC)
*
.mod
*
.PRI
*
.DIS
*
.FST
*
.INN
*
.ML
*
.PAR
*
.UNB
amh.for
View file @
27d32e7a
...
...
@@ -58,7 +58,7 @@ C You should have received a copy of the GNU General Public License
C along with DMM. If not, see <http://www.gnu.org/licenses/>.
C -------------------------------------------------------------
SUBROUTINE AMH(HFIX,nobs,d,ny,nz,nx,nu,nv,ns,nstot,nt,np,
1 yk,IYK,theta,psi,PTR,PM,INFOS,
pdll,
Z,S,ACCRATE)
1 yk,IYK,theta,psi,PTR,PM,INFOS,Z,S,ACCRATE)
#if defined(__CYGWIN32__) || defined(_WIN32)
#ifdef __INTEL_COMPILER
USE dfwin
...
...
@@ -68,22 +68,6 @@ C -------------------------------------------------------------
USE ISO_C_UTILITIES
USE DLFCN
#endif
INTERFACE
SUBROUTINE DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
INTEGER ny,nz,nx,nu,ns(6),nt
DOUBLE PRECISION theta(nt)
DOUBLE PRECISION c(ny,max(1,nz),ns(1)),H(ny,nx,ns(2)),
1 G(ny,nu,ns(3)),a(nx,ns(4)),F(nx,nx,ns(5)),R(nx,nu,ns(6))
END SUBROUTINE
END INTERFACE
#if defined(__CYGWIN32__) || defined(_WIN32)
POINTER (pdll,fittizia)
POINTER (pdesign,DESIGN)
#else
TYPE(C_PTR) :: pdll
TYPE(C_FUNPTR) :: pdesign
PROCEDURE(DESIGN), POINTER :: ptrdesign=>NULL()
#endif
C INPUT
INTEGER HFIX,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np,
...
...
@@ -123,16 +107,9 @@ C LOCALS
id1 = max(1,d(1))
Z0 = Z
delta = 1.D-3
#if defined(__CYGWIN32__) || defined(_WIN32)
pdesign = getprocaddress(pdll, "design_"C)
#if defined(ORIGDLL) || defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#else
pdesign = DLSym(pdll, 'design_'//C_NULL_CHAR)
IF(.NOT.C_ASSOCIATED(pdesign)) THEN
WRITE(*,*) ' Error in dlsym: ', C_F_STRING(DLError())
END IF
CALL C_F_PROCPOINTER(CPTR=pdesign, FPTR=ptrdesign)
CALL ptrdesign(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#endif
CALL DESIGNZ(nv,np,psi,INFOS,P1,P2,P3,P4,P5,P6)
C PALL(i,j) = Pr[Z(t+1)=i|Z(t)=j], Z = S1 x S2 x ... x Snv
...
...
amh2.for
View file @
27d32e7a
...
...
@@ -58,7 +58,7 @@ C You should have received a copy of the GNU General Public License
C along with DMM. If not, see <http://www.gnu.org/licenses/>.
C -------------------------------------------------------------
SUBROUTINE AMH2(HFIX,nobs,d,ny,nz,nx,nu,nv,ns,nstot,nt,np,yk,
1 theta,psi,PTR,PM,INFOS,
pdll,
Z,S,ACCRATE)
1 theta,psi,PTR,PM,INFOS,Z,S,ACCRATE)
#if defined(__CYGWIN32__) || defined(_WIN32)
#ifdef __INTEL_COMPILER
USE dfwin
...
...
@@ -68,22 +68,6 @@ C -------------------------------------------------------------
USE ISO_C_UTILITIES
USE DLFCN
#endif
INTERFACE
SUBROUTINE DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
INTEGER ny,nz,nx,nu,ns(6),nt
DOUBLE PRECISION theta(nt)
DOUBLE PRECISION c(ny,max(1,nz),ns(1)),H(ny,nx,ns(2)),
1 G(ny,nu,ns(3)),a(nx,ns(4)),F(nx,nx,ns(5)),R(nx,nu,ns(6))
END SUBROUTINE
END INTERFACE
#if defined(__CYGWIN32__) || defined(_WIN32)
POINTER (pdll,fittizia) ! ASSOCIATE pointer P alla DLL ad una varibile fittizia
POINTER (pdesign,DESIGN) ! IMPORTANT associo il puntatore pdesign alla Interface definita
#else
TYPE(C_PTR) :: pdll
TYPE(C_FUNPTR) :: pdesign=C_NULL_FUNPTR
PROCEDURE(DESIGN), POINTER :: ptrdesign=>NULL()
#endif
C INPUT
INTEGER HFIX,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np,
...
...
@@ -123,16 +107,9 @@ C LOCALS
id1 = max(d(1),1)
Z0 = Z
delta = 1.D-3
#if defined(__CYGWIN32__) || defined(_WIN32)
pdesign = getprocaddress(pdll, "design_"C)
#if defined(ORIGDLL) || defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#else
pdesign = DLSym(pdll, 'design_'//C_NULL_CHAR)
IF(.NOT.C_ASSOCIATED(pdesign)) THEN
WRITE(*,*) ' Error in dlsym: ', C_F_STRING(DLError())
END IF
CALL C_F_PROCPOINTER(CPTR=pdesign, FPTR=ptrdesign)
CALL ptrdesign(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#endif
CALL DESIGNZ(nv,np,psi,INFOS,P1,P2,P3,P4,P5,P6)
C PMAT(i,j) = Pr[Z(t+1)=i|Z(t)=j], Z = S1 x S2 x ... x Snv
...
...
checkdesign.for
View file @
27d32e7a
...
...
@@ -34,7 +34,7 @@ C
C You should have received a copy of the GNU General Public License
C along with DMM. If not, see <http://www.gnu.org/licenses/>.
C -------------------------------------------------------------
SUBROUTINE CHECKDESIGN(ny,nz,nx,nu,ns,nt,d,theta,
pdll,
PATH,NMLNAME)
SUBROUTINE CHECKDESIGN(ny,nz,nx,nu,ns,nt,d,theta,PATH,NMLNAME)
#if defined(__CYGWIN32__) || defined(_WIN32)
#ifdef __INTEL_COMPILER
USE dfwin
...
...
@@ -48,23 +48,6 @@ C -------------------------------------------------------------
USE DLFCN
#endif
INTERFACE
SUBROUTINE DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
INTEGER ny,nz,nx,nu,ns(6),nt
DOUBLE PRECISION theta(nt)
DOUBLE PRECISION c(ny,max(1,nz),ns(1)),H(ny,nx,ns(2)),
1 G(ny,nu,ns(3)),a(nx,ns(4)),F(nx,nx,ns(5)),R(nx,nu,ns(6))
END SUBROUTINE
END INTERFACE
#if defined(__CYGWIN32__) || defined(_WIN32)
POINTER (pdll,fittizia) ! ASSOCIATE pointer pdll alla DLL ad una varibile fittizia
POINTER (pdesign,DESIGN)
#else
TYPE(C_PTR) :: pdll
TYPE(C_FUNPTR) :: pdesign=C_NULL_FUNPTR
PROCEDURE(DESIGN), POINTER :: ptrdesign=>NULL()
#endif
C INPUT
INTEGER ny,nz,nx,nu,ns(6),nt,d(2)
DOUBLE PRECISION theta(nt)
...
...
@@ -87,16 +70,9 @@ C EXTERNAL SUBROUTINES
ALLOCATE(c(ny,max(nz,1),ns(1)),H(ny,nx,ns(2)),
1 G(ny,nu,ns(3)),a(nx,ns(4)),F(nx,nx,ns(5)),R(nx,nu,ns(6))) !,HRG(ny,nu),HRGRH(ny,ny))
#if defined(__CYGWIN32__) || defined(_WIN32)
pdesign = getprocaddress(pdll, "design_"C)
#if defined(ORIGDLL) || defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL DESIGN(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#else
pdesign = DLSym(pdll, 'design_'//C_NULL_CHAR)
IF(.NOT.C_ASSOCIATED(pdesign)) THEN
WRITE(*,*) ' Error in dlsym: ', C_F_STRING(DLError())
END IF
CALL C_F_PROCPOINTER(CPTR=pdesign, FPTR=ptrdesign)
CALL ptrdesign(ny,nz,nx,nu,ns,nt,theta,c,H,G,a,F,R)
#endif
maxnz = max(1,nz)
...
...
chi2inv.for
View file @
27d32e7a
...
...
@@ -430,10 +430,19 @@ C LOCALS
DATA T(198,6:10)/199.8400, 205.0857, 211.0344, 218.6401, 231.8292/
DATA T(199,6:10)/200.8463, 206.1051, 212.0684, 219.6922, 232.9118/
DATA T(200,6:10)/201.8526,207.1244, 213.1022, 220.7441, 233.9943/
#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CHARACTER(len=200) :: MEXPRINT
INTEGER*4 mexPrintf
INTEGER*4 mpfout
#endif
IF (V.GT.200) THEN
#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
WRITE(MEXPRINT,*) 'CHI2INV: Too many degrees of freedom'
mpfout = mexPrintf(MEXPRINT//achar(13))
#else
WRITE(*,*) 'CHI2INV: Too many degrees of freedom'
PAUSE
#endif
RETURN
ENDIF
...
...
ReadMatLabD
esign.
F
→
d
esign.
for
View file @
27d32e7a
...
...
@@ -50,18 +50,36 @@ C
DOUBLE PRECISION nsd(6)
INTEGER ny_ptr,nz_ptr,nx_ptr,nu_ptr,ns_ptr,nt_ptr,theta_ptr
INTEGER C_ptr, H_ptr, G_ptr, A_ptr, F_ptr, R_ptr
CHARACTER*1024 matlaberror
C Try to open MatLab (just the first time)
IF (ep .eq.0 ) THEN
ep
=
engOpen
(
'matlab '
)
IF
(
ep
.eq.
0
)
THEN
ny
=
0
! ' Can''t start MatLab engine'
RETURN
ep = engOpen('/Applications/MATLAB_R2014b.app/bin/matlab ')
IF (ep .eq. 0) THEN ! Can''t start Matlab engine
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t start MATLAB engine'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t start MATLAB engine'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
IF
(
engEvalString
(
ep
,
'cd '
//
pathmfile
)
.ne.
0
)
then
ny
=
-7
! ' Can''t find or open the MatLab funtion'
RETURN
IF (engEvalString(ep,'cd ' // pathmfile).ne. 0) then ! Can''t find or open the MatLab funtion
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t find or open the MatLab function'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t find or open the MatLab function'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
ENDIF
...
...
@@ -74,20 +92,37 @@ C
#else
status = engPutVariable(ep, 'ny'C, ny_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-1
! ' Can''t read ny in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read ny in the Matlab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read ny in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read ny in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
nz_ptr = mxCreateDoubleScalar(nz*1.0d0)
#ifdef __GFORTRAN__
status = engPutVariable(ep, 'nz', nz_ptr)
#else
status = engPutVariable(ep, 'nz'C, nz_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-2
! ' Can''t read nz in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read nz in the Matlab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read nz in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read nz in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
nx_ptr = mxCreateDoubleScalar(nx*1.0d0)
...
...
@@ -96,9 +131,18 @@ C
#else
status = engPutVariable(ep, 'nx'C, nx_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-3
! ' Can''t read nx in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read nx in the Matlab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read nx in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read nx in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
nu_ptr = mxCreateDoubleScalar(nu*1.0d0)
...
...
@@ -107,9 +151,18 @@ C
#else
status = engPutVariable(ep, 'nu'C, nu_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-4
! ' Can''t read nu in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read nu in the MatLab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read nu in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read nu in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
ns_ptr = mxCreateDoubleMatrix(1, 6, 0)
...
...
@@ -122,9 +175,18 @@ C
#else
status = engPutVariable(ep, 'ns'C, ns_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-5
! ' Can''t read ns in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read ns in the Matlab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read ns in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read ns in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
theta_ptr = mxCreateDoubleMatrix(1, nt, 0)
...
...
@@ -134,9 +196,18 @@ C
#else
status = engPutVariable(ep, 'theta'C, theta_ptr)
#endif
IF
(
status
.ne.
0
)
THEN
ny
=
-6
! ' Can''t read theta in the MatLab file'
RETURN
IF (status .ne. 0) THEN ! Can''t read theta in the Matlab file
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' Can''t read nt in the MATLAB file'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' Can''t read nt in the MATLAB file'
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
C
...
...
@@ -146,19 +217,51 @@ C
status = engOutputBuffer(ep, buffer1)
IF (engEvalString(ep, 'clear success;'//
& '[C,H,G,A,F,R]='//TRIM(mfile)//'( ny,nz,nx,'//
&
'nu,ns,theta);'
//
'success=1;'
)
.ne.
0
)
then
ny
=
-8
! engEvalString failed
RETURN
& 'nu,ns,theta);'//'success=1;') .ne. 0) then ! engEvalString failed
#if defined(ORIGDLL) || defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL GETERRSTR(matlaberror)
#else
#endif
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' the MATLAB funtion can not be executed:'
WRITE(*,*) trim(matlaberror)
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' the MATLAB funtion can not be executed:'
TYPE *, trim(matlaberror)
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
C_ptr = engGetVariable(ep, 'success')
#else
C_ptr = engGetVariable(ep, 'success'C)
#endif
IF
(
C_ptr
.eq.
0
)
then
IF (C_ptr .eq. 0) then
! engEvalString failed
buffer=buffer1
ny
=
-8
! engEvalString failed
RETURN
#if defined(ORIGDLL) || defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL GETERRSTR(matlaberror)
#else
#endif
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' the MATLAB funtion can not be executed:'
WRITE(*,*) trim(matlaberror)
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' the MATLAB funtion can not be executed:'
TYPE *, trim(matlaberror)
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
C
...
...
@@ -172,7 +275,17 @@ C
IF(C_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(C_ptr), c, ny*max(1,nz)*ns(1))
ELSE
ny
=
-101
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' C could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' C could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
...
...
@@ -183,7 +296,17 @@ C
IF(H_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(H_ptr), H, ny*nx*ns(2))
ELSE
ny
=
-102
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' H could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' H could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
...
...
@@ -194,7 +317,17 @@ C
IF(G_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(G_ptr), G, ny*nu*ns(3))
ELSE
ny
=
-103
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' G could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' G could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
...
...
@@ -205,7 +338,17 @@ C
IF(A_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(A_ptr), a, nx*ns(4))
ELSE
ny
=
-104
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' A could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' A could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
...
...
@@ -216,20 +359,39 @@ C
IF(F_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(F_ptr), F, nx*nx*ns(5))
ELSE
ny
=
-105
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' F could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' F could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
#ifdef __GFORTRAN__
r_ptr
=
enggetvariable
(
ep
,
'
r
'
)
r_ptr = enggetvariable(ep, '
R
')
#else
r_ptr
=
enggetvariable
(
ep
,
'
r
'
c
)
r_ptr = enggetvariable(ep, '
R
'c)
#endif
IF(R_ptr.NE.0) THEN
CALL mxCopyPtrToReal8(mxGetPr(R_ptr), R, nx*nu*ns(6))
ELSE
ny
=
-106
#ifdef __GFORTRAN__
WRITE(*,*) ' '
WRITE(*,*) ' R could not be assigned during the call'
WRITE(*,*) ' Program aborting'
#else
TYPE *, ' '
TYPE *, ' R could not be assigned during the call '
TYPE *, ' Program aborting'
PAUSE
#endif
STOP
ENDIF
C
C Free dynamic memory allocated by MXCREATE function
C
...
...
@@ -248,27 +410,3 @@ C
RETURN
END
C
-----------------------------------------
C
To
make
dynamic
the
name
of
the
.
m
file
C
-----------------------------------------
SUBROUTINE
SETFILEM
(
string1
,
string2
)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS:'setfilem_' :: SETFILEM
CHARACTER
*
200
string1
,
string2
,
mfile
,
pathmfile
COMMON
/
M
/
mfile
,
pathmfile
mfile
=
string1
pathmfile
=
string2
RETURN
END
C
--------------------
C
To
get
MatLab
errors
C
--------------------
SUBROUTINE
GETERRSTR
(
matlaberror
)
!DEC$ ATTRIBUTES DLLEXPORT, ALIAS:'geterrstr_' :: GETERRSTR
CHARACTER
*
1024
matlaberror
CHARACTER
*
1024
buffer
COMMON
/
ERRBUFFER
/
buffer
matlaberror
=
buffer
RETURN
END
drawtheta.for
View file @
27d32e7a
...
...
@@ -105,7 +105,9 @@ C CHEK theta
IF (NN.LE.1000) THEN
GOTO 7777
ELSE
#ifdef __GFORTRAN__
#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL mexErrMsgTxt('\nReduce skcriterium or use Slice sampling\nProgram aborting\n')
#elif defined(__GFORTRAN__)
WRITE(*,*) ' '
WRITE(*,*) 'Reduce skcriterium or use Slice sampling'
WRITE(*,*) 'Program aborting'
...
...
drawtheta2.for
View file @
27d32e7a
...
...
@@ -105,7 +105,9 @@ C CHEK theta
IF (NN.LE.1000) THEN
GOTO 7777
ELSE
#ifdef __GFORTRAN__
#if defined(MATLAB_MEX_FILE) || defined(OCTAVE_MEX_FILE)
CALL mexErrMsgTxt('\nReduce skcriterium or use Slice sampling\nProgram aborting\n')
#elif defined(__GFORTRAN__)
WRITE(*,*) ' '
WRITE(*,*) 'Reduce skcriterium or use Slice sampling'
WRITE(*,*) 'Program aborting'
...
...
examples/NILE.NML
View file @
27d32e7a
...
...
@@ -36,7 +36,7 @@
check = to debug the system matrices c, H, G, a, F, and R
&ssm
nx=1 nu=2 d=1 1 nv=2 check=
n
estimation=BA dllname = path\NILE1.m
nx=1 nu=2 d=1 1 nv=2 check=
'n'
estimation=
'
BA
'
dllname =
'
path\NILE1.m
'
&end
Namelist Sj describes discrete latent variables Sj, j = 1,...,nv:
...
...
@@ -47,9 +47,9 @@
of dimension k ordered by columns
matSj = matrices impacted by Sj (one or more of c H G a F R)
&S1 dynS1=
I
nS1=2 hypS1(1,1)=16 2 matS1=