From a58ee9845df900fd532fec8bc91839f720fa8193 Mon Sep 17 00:00:00 2001 From: Houtan Bastani <houtan@dynare.org> Date: Wed, 10 Dec 2014 12:12:44 +0100 Subject: [PATCH] remove gfortran module, replacing logical2integer with a subroutine --- Makefile | 4 ++-- drawpsi.for | 16 +++++++------ harmonic.for | 19 ++++++++-------- harmonic2.for | 18 ++++++++------- gfortran.f90 => logical2integer.for | 35 ++++++++++++----------------- mengwong.for | 17 ++++++++------ mengwong2.for | 16 ++++++++----- 7 files changed, 65 insertions(+), 60 deletions(-) rename gfortran.f90 => logical2integer.for (58%) diff --git a/Makefile b/Makefile index 1863a68..372ac6f 100644 --- a/Makefile +++ b/Makefile @@ -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 \ diff --git a/drawpsi.for b/drawpsi.for index 34b1119..ce6a677 100644 --- a/drawpsi.for +++ b/drawpsi.for @@ -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))) diff --git a/harmonic.for b/harmonic.for index 3ae3e25..206f8c8 100644 --- a/harmonic.for +++ b/harmonic.for @@ -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) diff --git a/harmonic2.for b/harmonic2.for index 72f17f9..1b0bd79 100644 --- a/harmonic2.for +++ b/harmonic2.for @@ -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) diff --git a/gfortran.f90 b/logical2integer.for similarity index 58% rename from gfortran.f90 rename to logical2integer.for index 3c66c91..c873a29 100644 --- a/gfortran.f90 +++ b/logical2integer.for @@ -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 diff --git a/mengwong.for b/mengwong.for index e68c1e0..add457e 100644 --- a/mengwong.for +++ b/mengwong.for @@ -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) diff --git a/mengwong2.for b/mengwong2.for index 3c33370..1d224ca 100644 --- a/mengwong2.for +++ b/mengwong2.for @@ -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) -- GitLab