Skip to content

GitLab

Commit 27d32e7a authored by Alessandro Rossi's avatar Alessandro Rossi
Browse files

Merge branch 'master' of https://github.com/rossial/DMM

parents 00a42d2c 698a38e2
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
......
ReadMatLabDesign.F → design.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=