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