From 035edd303e8c6d1bb0fed0e92e4a29a37e41446c Mon Sep 17 00:00:00 2001
From: Houtan Bastani <houtan@dynare.org>
Date: Thu, 25 Sep 2014 15:40:52 +0200
Subject: [PATCH] remove dll from slice and ptheta
---
main.for | 4 ++--
ptheta.for | 28 ++--------------------------
slice.for | 16 +++++++---------
3 files changed, 11 insertions(+), 37 deletions(-)
diff --git a/main.for b/main.for
index 48b0727..72e7879 100644
--- a/main.for
+++ b/main.for
@@ -619,7 +619,7 @@ C MCMC BURN-IN
IF (thetaprior(it,3).LT.thetaprior(it,4)) THEN
CALL SLICE(it,nobs,d,ny,nz,nx,nu,ns,nt,S,
1 yk(1:nobs,:),IYK(1:nobs,:),theta0,
- 2 thetaprior(it,:),pdftheta(it),pdll,
+ 2 thetaprior(it,:),pdftheta(it),
3 NEVAL(it),theta(it))
theta0(it) = theta(it)
ENDIF
@@ -706,7 +706,7 @@ C MCMC RECORDING phase
IF (thetaprior(it,3).LT.thetaprior(it,4)) THEN
CALL SLICE(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk(1:nobs,:),
1 IYK(1:nobs,:),theta0,thetaprior(it,:),
- 2 pdftheta(it),pdll,NEVAL(it),theta(it))
+ 2 pdftheta(it),NEVAL(it),theta(it))
theta0(it) = theta(it)
ENDIF
END DO
diff --git a/ptheta.for b/ptheta.for
index 51ea229..0265c78 100644
--- a/ptheta.for
+++ b/ptheta.for
@@ -21,7 +21,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 ----------------------------------------------------------------
DOUBLE PRECISION FUNCTION PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,
- 1 S,yk,IYK,theta,thetaprior,tipo,pdll)
+ 1 S,yk,IYK,theta,thetaprior,tipo)
#if defined(__CYGWIN32__) || defined(_WIN32)
#ifdef __INTEL_COMPILER
USE dfwin
@@ -31,23 +31,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
- CHARACTER*1 fittizia
-#if defined(__CYGWIN32__) || defined(_WIN32)
- POINTER (pdll,fittizia) ! ASSOCIATE pointer pdll 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 it,nobs,d(2),ny,nz,nx,nu,ns(6),nt,S(nobs,6),
@@ -66,16 +49,9 @@ C LOCALS
3 Pdd(max(d(1),1),nx,nx))
C computes the log-posterior
-#if defined(__CYGWIN32__) || defined(_WIN32)
- pdesign = getprocaddress(pdll, "design_"C)
+#if defined(ORIGDLL)
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 IKF(d,ny,nz,nx,nu,ns,S(1:max(d(1),1),1:6),
1 yk(1:max(d(1),1),1:ny+nz),IYK(1:max(d(1),1),1:ny+1),
diff --git a/slice.for b/slice.for
index 616a433..9d4f571 100644
--- a/slice.for
+++ b/slice.for
@@ -22,14 +22,12 @@ 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 SLICE(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll,NEVAL,XSIM)
+ 1 theta,thetaprior,tipo,NEVAL,XSIM)
C INPUT
INTEGER it,nobs,d(2),ny,nz,nx,nu,ns(6),nt,S(nobs,6),
1 IYK(nobs,ny+1)
DOUBLE PRECISION yk(nobs,ny+nz),theta(nt),thetaprior(4)
CHARACTER*2 tipo
- CHARACTER*1 fittizia
- POINTER (pdll,fittizia)
C OUTPUT
INTEGER NEVAL
@@ -51,7 +49,7 @@ C THIS DEFINES THE SLICE S={x: z < ln(f(x))}
C -------------------------------------------------------
theta(it) = XOLD
FXOLD=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
U = genunf(0.D0,1.D0)
Z = FXOLD + DLOG(U)
@@ -72,14 +70,14 @@ C U = G05CAF(U)
DO 100 WHILE(L.GT.XLB)
theta(it) = L
FXL=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
IF (FXL.LE.Z) GOTO 110
100 L = L - W
110 DO 200 WHILE(R.LT.XUB)
theta(it) = R
FXR=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
IF (FXR.LE.Z) GOTO 210
200 R = R + W
@@ -93,7 +91,7 @@ C U = G05CAF(U)
IF (L.LE.XLB) GOTO 310
theta(it) = L
FXL=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
IF (FXL.LE.Z) GOTO 310
L = L - W
@@ -103,7 +101,7 @@ C U = G05CAF(U)
IF (R.GE.XLB) GOTO 410
theta(it) = R
FXR=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
IF (FXR.LE.Z) GOTO 410
R = R + W
@@ -123,7 +121,7 @@ C U = G05CAF(U)
XSIM = L + U*(R - L)
theta(it) = XSIM
FXSIM=PTHETA(it,nobs,d,ny,nz,nx,nu,ns,nt,S,yk,IYK,
- 1 theta,thetaprior,tipo,pdll)
+ 1 theta,thetaprior,tipo)
NEVAL = NEVAL + 1
IF (FXSIM.GE.Z) OK = 1
IF(XSIM.GT.XOLD) THEN
--
GitLab