Skip to content
GitLab
Commit a58ee984 authored by Houtan Bastani's avatar Houtan Bastani
Browse files

remove gfortran module, replacing logical2integer with a subroutine

parent b177cc6e
Hide whitespace changes
Inline Side-by-side
Makefile
View file @ a58ee984
......@@ -3,7 +3,6 @@ FCFLAGS = -cpp -fcray-pointer -ffixed-line-length-none -fdefault-integer-8
FFFLAGS = $(FCFLAGS) -std=legacy
MOD_OBJS = \
gfortran.o \
iso_c_utilities.o \
dlfcn.o
......@@ -75,7 +74,8 @@ OBJS = \
input.o \
logmvnpdf.o \
openfiles.o \
schollu.o
schollu.o \
logical2integer.o
RANDLIB_OBJS = \
advnst.o \
......
drawpsi.for
View file @ a58ee984
......@@ -55,9 +55,6 @@ 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 DRAWPSI(nobs,nv,np,INFOS,Z,psiprior,psi0,psi)
#ifdef __GFORTRAN__
USE gfortran
#endif
C INPUT
INTEGER nobs,nv,np(3),Z(nobs),INFOS(9,6)
DOUBLE PRECISION psiprior(np(2),np(3)),psi0(np(1))
......@@ -72,7 +69,11 @@ C LOCALS
DOUBLE PRECISION uv,v,AG
DOUBLE PRECISION genunf,gengam
C DOUBLE PRECISION G05CAF
#ifdef __GFORTRAN__
EXTERNAL LOGICAL2INTEGER
INTEGER ARR(nobs)
INTEGER ARR1(nobs-1)
#endif
ALLOCATE(P1(INFOS(8,1),INFOS(8,1)),
1 P2(INFOS(8,2),INFOS(8,2)),P3(INFOS(8,3),INFOS(8,3)),
2 P4(INFOS(8,4),INFOS(8,4)),P5(INFOS(8,5),INFOS(8,5)),
......@@ -91,7 +92,8 @@ C DOUBLE PRECISION G05CAF
C SAMPLING FROM DIRICHLET
DO 5 ii = 1,NSI
#ifdef __GFORTRAN__
AG = SUM(ABS(LOGICAL2INTEGER(SEQ(1:nobs,I).EQ.ii)))
CALL LOGICAL2INTEGER(SEQ(1:nobs,I).EQ.ii,nobs,ARR)
AG = SUM(ABS(ARR))
# +psiprior(K+1,ii)
#else
AG = SUM(ABS((SEQ(1:nobs,I).EQ.ii)))+psiprior(K+1,ii)
......@@ -108,8 +110,8 @@ C 5 CALL G05FFF(AG,1.D0,1,GAM(ii),IFAIL)
DO 50 jj = 1,NSI
DO 10 ii = 1,NSI
#ifdef __GFORTRAN__
10 NIJ(ii,jj) = SUM(ABS(LOGICAL2INTEGER((
# SEQ(2:nobs,I).EQ.ii).AND.(SEQ(1:nobs-1,I).EQ.jj))))
CALL LOGICAL2INTEGER((SEQ(2:nobs,I).EQ.ii).AND.(SEQ(1:nobs-1,I).EQ.jj),nobs-1,ARR1)
10 NIJ(ii,jj) = SUM(ABS(ARR1))
#else
10 NIJ(ii,jj) = SUM(ABS((SEQ(2:nobs,I).EQ.ii).AND.
#(SEQ(1:nobs-1,I).EQ.jj)))
......
harmonic.for
View file @ a58ee984
......@@ -29,10 +29,6 @@ C --------------------------------------------------------------------------
1 INFOS,yk,IYK,gibpar,gibZ,thetaprior,
2 psiprior,tipo,MLH)
#ifdef __GFORTRAN__
USE gfortran
#endif
C INPUT
INTEGER G,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np(3)
INTEGER INFOS(9,6),gibZ(G,nobs),IYK(nobs,ny+1)
......@@ -64,6 +60,10 @@ C EXTERNAL FUNCTIONS
DOUBLE PRECISION PTHETA,PRIOR,PRIORDIR,CHI2INV !PPCHI2 or G01FCF
C EXTERNAL SUBROUTINES
EXTERNAL NEWEYWESTCOV2,DPOTRF,DPOTRI,DESIGNZ,PPROD,ERGODIC,INT2SEQ
#ifdef __GFORTRAN__
EXTERNAL LOGICAL2INTEGER
INTEGER ARR(G)
#endif
NPARTH = 0
DO I = 1,nt
......@@ -121,7 +121,8 @@ C40 ub(I) = PPCHI2(pval(I),DFLOAT(NPARTH),IFAIL) !G01FCF(pval(I),DFLOAT(NPA
C Transition prob for QS
DO 55 I = 1,nstot-1
#ifdef __GFORTRAN__
55 PTR(1,I,1)=SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,1).EQ.I)))/DFLOAT(G)
CALL LOGICAL2INTEGER(gibZ(1:G,1).EQ.I,G,ARR)
55 PTR(1,I,1)=SUM(ABS(ARR))/DFLOAT(G)
#else
55 PTR(1,I,1)=SUM(ABS(gibZ(1:G,1).EQ.I))/DFLOAT(G)
#endif
......@@ -131,15 +132,15 @@ C Transition prob for QS
DO 57 I = 1,nstot-1
DO 57 J = 1,nstot
#ifdef __GFORTRAN__
COM(1,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J)))
CALL LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J,G,ARR)
COM(1,1) = SUM(ABS(ARR))
#else
COM(1,1) = SUM(ABS(gibZ(1:G,K-1).EQ.J))
#endif
IF (COM(1,1).GT.ZERO) THEN
#ifdef __GFORTRAN__
PTR(K,I,J) = SUM(ABS(LOGICAL2INTEGER(
+ (gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J
+ ))))/COM(1,1)
CALL LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J),G,ARR)
PTR(K,I,J) = SUM(ABS(ARR))/COM(1,1)
#else
PTR(K,I,J) = SUM(ABS((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J
# )))/COM(1,1)
......
harmonic2.for
View file @ a58ee984
......@@ -29,9 +29,6 @@ C --------------------------------------------------------------------------
SUBROUTINE HARMONIC2(G,nobs,d,ny,nz,nx,nu,nv,ns,nstot,nt,np,
1 INFOS,yk,gibpar,gibZ,thetaprior,psiprior,
2 tipo,MLH)
#ifdef __GFORTRAN__
USE gfortran
#endif
C INPUT
INTEGER G,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np(3),
1 INFOS(9,6),gibZ(G,nobs)
......@@ -63,6 +60,10 @@ C EXTERNAL FUNCTIONS
DOUBLE PRECISION PTHETA2,PRIOR,PRIORDIR,CHI2INV !PPCHI2,G01FCF
C EXTERNAL SUBROUTINES
EXTERNAL NEWEYWESTCOV2,DPOTRF,DPOTRI,DESIGNZ,PPROD,ERGODIC,INT2SEQ
#ifdef __GFORTRAN__
EXTERNAL LOGICAL2INTEGER
INTEGER ARR(G)
#endif
NPARTH = 0
DO I = 1,nt
......@@ -120,7 +121,8 @@ C40 ub(I) = PPCHI2(pval(I),DFLOAT(NPARTH),IFAIL) ! G01FCF(pval(I),DFLOAT(NPAR
C Transition prob for QS
DO 55 I = 1,nstot-1
#ifdef __GFORTRAN__
55 PTR(1,I,1)=SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,1).EQ.I)))/DFLOAT(G)
CALL LOGICAL2INTEGER(gibZ(1:G,1).EQ.I,G,ARR)
55 PTR(1,I,1)=SUM(ABS(ARR))/DFLOAT(G)
#else
55 PTR(1,I,1)=SUM(ABS(gibZ(1:G,1).EQ.I))/DFLOAT(G)
#endif
......@@ -130,15 +132,15 @@ C Transition prob for QS
DO 57 I = 1,nstot-1
DO 57 J = 1,nstot
#ifdef __GFORTRAN__
COM(1,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J)))
CALL LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J,G,ARR)
COM(1,1) = SUM(ABS(ARR))
#else
COM(1,1) = SUM(ABS(gibZ(1:G,K-1).EQ.J))
#endif
IF (COM(1,1).GT.ZERO) THEN
#ifdef __GFORTRAN__
PTR(K,I,J) = SUM(ABS(LOGICAL2INTEGER(
+(gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J
+))))/COM(1,1)
CALL LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J),G,ARR)
PTR(K,I,J) = SUM(ABS(ARR))/COM(1,1)
#else
PTR(K,I,J) = SUM(ABS((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J
# )))/COM(1,1)
......
gfortran.f90 → logical2integer.for
View file @ a58ee984
......@@ -14,24 +14,17 @@
! You should have received a copy of the GNU General Public License
! along with Dynare. If not, see <http://www.gnu.org/licenses/>.
!
MODULE GFORTRAN
IMPLICIT NONE
CONTAINS
FUNCTION LOGICAL2INTEGER(V)
#if defined(OCTAVE_MEX_FILE)
LOGICAL*4, DIMENSION(:), INTENT(IN) :: V
#else
LOGICAL, DIMENSION(:), INTENT(IN) :: V
#endif
INTEGER :: I
INTEGER, DIMENSION(SIZE(V)) :: LOGICAL2INTEGER
DO I=1,SIZE(V)
IF (V(I)) THEN
LOGICAL2INTEGER(I) = 1
ELSE
LOGICAL2INTEGER(I) = 0
END IF
END DO
END FUNCTION LOGICAL2INTEGER
END MODULE GFORTRAN
SUBROUTINE LOGICAL2INTEGER(INV, dim, OUTV)
IMPLICIT NONE
INTEGER, INTENT(IN) :: dim
LOGICAL, DIMENSION(dim), INTENT(IN) :: INV
INTEGER, DIMENSION(dim), INTENT(OUT) :: OUTV
INTEGER :: I
DO I=1,dim
IF (INV(I)) THEN
OUTV(I) = 1
ELSE
OUTV(I) = 0
END IF
END DO
END SUBROUTINE LOGICAL2INTEGER
mengwong.for
View file @ a58ee984
......@@ -35,9 +35,6 @@ C -------------------------------------------------------------------
SUBROUTINE MENGWONG(G,nobs,d,ny,nz,nx,nu,nv,ns,nstot,nt,np,
1 INFOS,yk,IYK,gibpar,gibZ,thetaprior,psiprior,
2 tipo,MLSTART,MLMW)
#ifdef __GFORTRAN__
USE gfortran
#endif
C INPUT
INTEGER G,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np(3),
1 INFOS(9,6),gibZ(G,nobs),IYK(nobs,ny+1)
......@@ -73,7 +70,10 @@ C EXTERNAL SUBROUTINES
C EXTERNAL FUNCTIONS
DOUBLE PRECISION PTHETA,PRIOR,PRIORDIR,genunf,gengam
#ifdef __GFORTRAN__
EXTERNAL LOGICAL2INTEGER
INTEGER ARR(G)
#endif
PAR(:) = GIBPAR(1,:) ! set constant values
NPARTH = 0
......@@ -103,7 +103,8 @@ C EXTERNAL FUNCTIONS
C Transition prob for QS
DO I = 1,nstot-1
#ifdef __GFORTRAN__
PTR(1,I,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,1).EQ.I)))/DFLOAT(G)
CALL LOGICAL2INTEGER(gibZ(1:G,1).EQ.I,G,ARR)
PTR(1,I,1) = SUM(ABS(ARR))/DFLOAT(G)
#else
PTR(1,I,1) = SUM(ABS(gibZ(1:G,1).EQ.I))/DFLOAT(G)
#endif
......@@ -114,13 +115,15 @@ C Transition prob for QS
DO 50 I = 1,nstot-1
DO 50 J = 1,nstot
#ifdef __GFORTRAN__
COM(1,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J)))
CALL LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J,G,ARR)
COM(1,1) = SUM(ABS(ARR))
#else
COM(1,1) = SUM(ABS(gibZ(1:G,K-1).EQ.J))
#endif
IF (COM(1,1).GT.ZERO) THEN
#ifdef __GFORTRAN__
PTR(K,I,J) = SUM(ABS(LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J))))/COM(1,1)
CALL LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J),G,ARR)
PTR(K,I,J) = SUM(ABS(ARR))/COM(1,1)
#else
PTR(K,I,J) = SUM(ABS((gibZ(1:G,K).EQ.I).AND.
# (gibZ(1:G,K-1).EQ.J)))/COM(1,1)
......
mengwong2.for
View file @ a58ee984
......@@ -35,9 +35,6 @@ C -------------------------------------------------------------------
SUBROUTINE MENGWONG2(G,nobs,d,ny,nz,nx,nu,nv,ns,nstot,nt,np,
1 INFOS,yk,gibpar,gibZ,thetaprior,psiprior,
2 tipo,MLSTART,MLMW)
#ifdef __GFORTRAN__
USE gfortran
#endif
C INPUT
INTEGER G,nobs,d(2),ny,nz,nx,nu,nv,ns(6),nstot,nt,np(3),
1 INFOS(9,6),gibZ(G,nobs)
......@@ -73,6 +70,10 @@ C EXTERNAL SUBROUTINES
C EXTERNAL FUNCTIONS
DOUBLE PRECISION PTHETA2,PRIOR,PRIORDIR,genunf,gengam
#ifdef __GFORTRAN__
EXTERNAL LOGICAL2INTEGER
INTEGER ARR(G)
#endif
PAR(:) = GIBPAR(1,:) ! set constant values
NPARTH = 0
......@@ -102,7 +103,8 @@ C EXTERNAL FUNCTIONS
C Transition prob for QS
DO I = 1,nstot-1
#ifdef __GFORTRAN__
PTR(1,I,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,1).EQ.I)))/DFLOAT(G)
CALL LOGICAL2INTEGER(gibZ(1:G,1).EQ.I,G,ARR)
PTR(1,I,1) = SUM(ABS(ARR))/DFLOAT(G)
#else
PTR(1,I,1) = SUM(ABS(gibZ(1:G,1).EQ.I))/DFLOAT(G)
#endif
......@@ -113,13 +115,15 @@ C Transition prob for QS
DO 50 I = 1,nstot-1
DO 50 J = 1,nstot
#ifdef __GFORTRAN__
COM(1,1) = SUM(ABS(LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J)))
CALL LOGICAL2INTEGER(gibZ(1:G,K-1).EQ.J,G,ARR)
COM(1,1) = SUM(ABS(ARR))
#else
COM(1,1) = SUM(ABS(gibZ(1:G,K-1).EQ.J))
#endif
IF (COM(1,1).GT.ZERO) THEN
#ifdef __GFORTRAN__
PTR(K,I,J) = SUM(ABS(LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J))))/COM(1,1)
CALL LOGICAL2INTEGER((gibZ(1:G,K).EQ.I).AND.(gibZ(1:G,K-1).EQ.J),G,ARR)
PTR(K,I,J) = SUM(ABS(ARR))/COM(1,1)
#else
PTR(K,I,J) = SUM(ABS((gibZ(1:G,K).EQ.I).AND.
# (gibZ(1:G,K-1).EQ.J)))/COM(1,1)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment