Commits

Daniel Reynolds  committed 9d871a2 Merge

merged fortran_types branch in with main development branch

  • Participants
  • Parent commits efd0b80, d639cd2

Comments (0)

Files changed (158)

File src/enzo/BlockSolve.F

 c
 c  OUTPUT ARGUMENTS: 
 c     xvec       - solution NxM matrix
-c     ier        - integer return flag (0=>failure, 1=>success)
+c     ier        - INTG_PREC return flag (0=>failure, 1=>success)
 c
 c=======================================================================
       implicit none
+#include "fortran_types.def"
 c
 c  argument declarations
-      integer  N, M
-      integer  ier
-      REALSUB  Amat(N*N), xvec(N*M), bvec(N*M)
+      INTG_PREC  N, M
+      INTG_PREC  ier
+      R_PREC  Amat(N*N), xvec(N*M), bvec(N*M)
 c
 c  locals
-      integer  i, ierr, ipiv(N)
+      INTG_PREC  i, ierr, ipiv(N)
 c
 c=======================================================================
 c
       SUBROUTINE UGEMM ( TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB,
      $                   BETA, C, LDC )
 *     .. Scalar Arguments ..
+      implicit none
+#include "fortran_types.def"
       CHARACTER*1        TRANSA, TRANSB
-      INTEGER            M, N, K, LDA, LDB, LDC
-      REALSUB            ALPHA, BETA
+      INTG_PREC          M, N, K, LDA, LDB, LDC
+      R_PREC             ALPHA, BETA
 *     .. Array Arguments ..
-      REALSUB            A( LDA, * ), B( LDB, * ), C( LDC, * )
+      R_PREC             A( LDA, * ), B( LDB, * ), C( LDC, * )
 *     ..
 *
 *  Purpose
 *
 *           Unchanged on exit.
 *
-*  M      - INTEGER.
+*  M      - INTG_PREC.
 *           On entry,  M  specifies  the number  of rows  of the  matrix
 *           op( A )  and of the  matrix  C.  M  must  be at least  zero.
 *           Unchanged on exit.
 *
-*  N      - INTEGER.
+*  N      - INTG_PREC.
 *           On entry,  N  specifies the number  of columns of the matrix
 *           op( B ) and the number of columns of the matrix C. N must be
 *           at least zero.
 *           Unchanged on exit.
 *
-*  K      - INTEGER.
+*  K      - INTG_PREC.
 *           On entry,  K  specifies  the number of columns of the matrix
 *           op( A ) and the number of rows of the matrix op( B ). K must
 *           be at least  zero.
 *           Unchanged on exit.
 *
-*  ALPHA  - REALSUB.
+*  ALPHA  - R_PREC.
 *           On entry, ALPHA specifies the scalar alpha.
 *           Unchanged on exit.
 *
-*  A      - REALSUB array of DIMENSION ( LDA, ka ), where ka is
+*  A      - R_PREC array of DIMENSION ( LDA, ka ), where ka is
 *           k  when  TRANSA = 'N' or 'n',  and is  m  otherwise.
 *           Before entry with  TRANSA = 'N' or 'n',  the leading  m by k
 *           part of the array  A  must contain the matrix  A,  otherwise
 *           matrix A.
 *           Unchanged on exit.
 *
-*  LDA    - INTEGER.
+*  LDA    - INTG_PREC.
 *           On entry, LDA specifies the first dimension of A as declared
 *           in the calling (sub) program. When  TRANSA = 'N' or 'n' then
 *           LDA must be at least  max( 1, m ), otherwise  LDA must be at
 *           least  max( 1, k ).
 *           Unchanged on exit.
 *
-*  B      - REALSUB array of DIMENSION ( LDB, kb ), where kb is
+*  B      - R_PREC array of DIMENSION ( LDB, kb ), where kb is
 *           n  when  TRANSB = 'N' or 'n',  and is  k  otherwise.
 *           Before entry with  TRANSB = 'N' or 'n',  the leading  k by n
 *           part of the array  B  must contain the matrix  B,  otherwise
 *           matrix B.
 *           Unchanged on exit.
 *
-*  LDB    - INTEGER.
+*  LDB    - INTG_PREC.
 *           On entry, LDB specifies the first dimension of B as declared
 *           in the calling (sub) program. When  TRANSB = 'N' or 'n' then
 *           LDB must be at least  max( 1, k ), otherwise  LDB must be at
 *           least  max( 1, n ).
 *           Unchanged on exit.
 *
-*  BETA   - REALSUB.
+*  BETA   - R_PREC.
 *           On entry,  BETA  specifies the scalar  beta.  When  BETA  is
 *           supplied as zero then C need not be set on input.
 *           Unchanged on exit.
 *
-*  C      - REALSUB array of DIMENSION ( LDC, n ).
+*  C      - R_PREC array of DIMENSION ( LDC, n ).
 *           Before entry, the leading  m by n  part of the array  C must
 *           contain the matrix  C,  except when  beta  is zero, in which
 *           case C need not be set on entry.
 *           On exit, the array  C  is overwritten by the  m by n  matrix
 *           ( alpha*op( A )*op( B ) + beta*C ).
 *
-*  LDC    - INTEGER.
+*  LDC    - INTG_PREC.
 *           On entry, LDC specifies the first dimension of C as declared
 *           in  the  calling  (sub)  program.   LDC  must  be  at  least
 *           max( 1, m ).
       INTRINSIC          MAX
 *     .. Local Scalars ..
       LOGICAL            NOTA, NOTB
-      INTEGER            I, INFO, J, L, NCOLA, NROWA, NROWB
-      REALSUB            TEMP
+      INTG_PREC          I, INFO, J, L, NCOLA, NROWA, NROWB
+      R_PREC             TEMP
 *     .. Parameters ..
-      REALSUB            ONE         , ZERO
-      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      R_PREC             ONE         , ZERO
+      PARAMETER        ( ONE = 1._RKIND, ZERO = 0._RKIND )
 *     ..
 *     .. Executable Statements ..
 *
          INFO = 4
       ELSE IF( K  .LT.0               )THEN
          INFO = 5
-      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, NROWA ) )THEN
          INFO = 8
-      ELSE IF( LDB.LT.MAX( 1, NROWB ) )THEN
+      ELSE IF( LDB.LT.MAX( 1_IKIND, NROWB ) )THEN
          INFO = 10
-      ELSE IF( LDC.LT.MAX( 1, M     ) )THEN
+      ELSE IF( LDC.LT.MAX( 1_IKIND, M     ) )THEN
          INFO = 13
       END IF
       IF( INFO.NE.0 )THEN
 c
       SUBROUTINE UGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX,
      $                   BETA, Y, INCY )
+      implicit none
+#include "fortran_types.def"
 *     .. Scalar Arguments ..
-      REALSUB            ALPHA, BETA
-      INTEGER            INCX, INCY, LDA, M, N
+      R_PREC             ALPHA, BETA
+      INTG_PREC          INCX, INCY, LDA, M, N
       CHARACTER*1        TRANS
 *     .. Array Arguments ..
-      REALSUB            A( LDA, * ), X( * ), Y( * )
+      R_PREC             A( LDA, * ), X( * ), Y( * )
 *     ..
 *
 *  Purpose
 *
 *           Unchanged on exit.
 *
-*  M      - INTEGER.
+*  M      - INTG_PREC.
 *           On entry, M specifies the number of rows of the matrix A.
 *           M must be at least zero.
 *           Unchanged on exit.
 *
-*  N      - INTEGER.
+*  N      - INTG_PREC.
 *           On entry, N specifies the number of columns of the matrix A.
 *           N must be at least zero.
 *           Unchanged on exit.
 *
-*  ALPHA  - REALSUB.
+*  ALPHA  - R_PREC.
 *           On entry, ALPHA specifies the scalar alpha.
 *           Unchanged on exit.
 *
-*  A      - REALSUB array of DIMENSION ( LDA, n ).
+*  A      - R_PREC array of DIMENSION ( LDA, n ).
 *           Before entry, the leading m by n part of the array A must
 *           contain the matrix of coefficients.
 *           Unchanged on exit.
 *
-*  LDA    - INTEGER.
+*  LDA    - INTG_PREC.
 *           On entry, LDA specifies the first dimension of A as declared
 *           in the calling (sub) program. LDA must be at least
 *           max( 1, m ).
 *           Unchanged on exit.
 *
-*  X      - REALSUB array of DIMENSION at least
+*  X      - R_PREC array of DIMENSION at least
 *           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
 *           and at least
 *           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
 *           vector x.
 *           Unchanged on exit.
 *
-*  INCX   - INTEGER.
+*  INCX   - INTG_PREC.
 *           On entry, INCX specifies the increment for the elements of
 *           X. INCX must not be zero.
 *           Unchanged on exit.
 *
-*  BETA   - REALSUB.
+*  BETA   - R_PREC.
 *           On entry, BETA specifies the scalar beta. When BETA is
 *           supplied as zero then Y need not be set on input.
 *           Unchanged on exit.
 *
-*  Y      - REALSUB array of DIMENSION at least
+*  Y      - R_PREC array of DIMENSION at least
 *           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
 *           and at least
 *           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
 *           must contain the vector y. On exit, Y is overwritten by the
 *           updated vector y.
 *
-*  INCY   - INTEGER.
+*  INCY   - INTG_PREC.
 *           On entry, INCY specifies the increment for the elements of
 *           Y. INCY must not be zero.
 *           Unchanged on exit.
 *
 *
 *     .. Parameters ..
-      REALSUB            ONE         , ZERO
-      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      R_PREC             ONE         , ZERO
+      PARAMETER        ( ONE = 1._RKIND, ZERO = 0._RKIND )
 *     .. Local Scalars ..
-      REALSUB            TEMP
-      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
+      R_PREC             TEMP
+      INTG_PREC          I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY
 *     .. External Functions ..
       LOGICAL            LSAME
       EXTERNAL           LSAME
          INFO = 2
       ELSE IF( N.LT.0 )THEN
          INFO = 3
-      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, M ) )THEN
          INFO = 6
       ELSE IF( INCX.EQ.0 )THEN
          INFO = 8
 c=======================================================================
 c
       SUBROUTINE UGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+      implicit none
+#include "fortran_types.def"
 *     .. Scalar Arguments ..
-      REALSUB            ALPHA
-      INTEGER            INCX, INCY, LDA, M, N
+      R_PREC             ALPHA
+      INTG_PREC          INCX, INCY, LDA, M, N
 *     .. Array Arguments ..
-      REALSUB            A( LDA, * ), X( * ), Y( * )
+      R_PREC             A( LDA, * ), X( * ), Y( * )
 *     ..
 *
 *  Purpose
 *  Parameters
 *  ==========
 *
-*  M      - INTEGER.
+*  M      - INTG_PREC.
 *           On entry, M specifies the number of rows of the matrix A.
 *           M must be at least zero.
 *           Unchanged on exit.
 *
-*  N      - INTEGER.
+*  N      - INTG_PREC.
 *           On entry, N specifies the number of columns of the matrix A.
 *           N must be at least zero.
 *           Unchanged on exit.
 *
-*  ALPHA  - REALSUB.
+*  ALPHA  - R_PREC.
 *           On entry, ALPHA specifies the scalar alpha.
 *           Unchanged on exit.
 *
-*  X      - REALSUB array of dimension at least
+*  X      - R_PREC array of dimension at least
 *           ( 1 + ( m - 1 )*abs( INCX ) ).
 *           Before entry, the incremented array X must contain the m
 *           element vector x.
 *           Unchanged on exit.
 *
-*  INCX   - INTEGER.
+*  INCX   - INTG_PREC.
 *           On entry, INCX specifies the increment for the elements of
 *           X. INCX must not be zero.
 *           Unchanged on exit.
 *
-*  Y      - REALSUB array of dimension at least
+*  Y      - R_PREC array of dimension at least
 *           ( 1 + ( n - 1 )*abs( INCY ) ).
 *           Before entry, the incremented array Y must contain the n
 *           element vector y.
 *           Unchanged on exit.
 *
-*  INCY   - INTEGER.
+*  INCY   - INTG_PREC.
 *           On entry, INCY specifies the increment for the elements of
 *           Y. INCY must not be zero.
 *           Unchanged on exit.
 *
-*  A      - REALSUB array of DIMENSION ( LDA, n ).
+*  A      - R_PREC array of DIMENSION ( LDA, n ).
 *           Before entry, the leading m by n part of the array A must
 *           contain the matrix of coefficients. On exit, A is
 *           overwritten by the updated matrix.
 *
-*  LDA    - INTEGER.
+*  LDA    - INTG_PREC.
 *           On entry, LDA specifies the first dimension of A as declared
 *           in the calling (sub) program. LDA must be at least
 *           max( 1, m ).
 *
 *
 *     .. Parameters ..
-      REALSUB            ZERO
-      PARAMETER        ( ZERO = 0.0D+0 )
+      R_PREC             ZERO
+      PARAMETER        ( ZERO = 0._RKIND )
 *     .. Local Scalars ..
-      REALSUB            TEMP
-      INTEGER            I, INFO, IX, J, JY, KX
+      R_PREC             TEMP
+      INTG_PREC          I, INFO, IX, J, JY, KX
 *     .. External Subroutines ..
       EXTERNAL           E_XERBLA
 *     .. Intrinsic Functions ..
          INFO = 5
       ELSE IF( INCY.EQ.0 )THEN
          INFO = 7
-      ELSE IF( LDA.LT.MAX( 1, M ) )THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, M ) )THEN
          INFO = 9
       END IF
       IF( INFO.NE.0 )THEN
 *     Courant Institute, Argonne National Lab, and Rice University
 *     June 30, 1992
 *
+      implicit none
+#include "fortran_types.def"
 *     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
+      INTG_PREC          INFO, LDA, M, N
 *     ..
 *     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      REALSUB            A( LDA, * )
+      INTG_PREC          IPIV( * )
+      R_PREC             A( LDA, * )
 *     ..
 *
 *  Purpose
 *  Arguments
 *  =========
 *
-*  M       (input) INTEGER
+*  M       (input) INTG_PREC
 *          The number of rows of the matrix A.  M >= 0.
 *
-*  N       (input) INTEGER
+*  N       (input) INTG_PREC
 *          The number of columns of the matrix A.  N >= 0.
 *
-*  A       (input/output) REALSUB array, dimension (LDA,N)
+*  A       (input/output) R_PREC array, dimension (LDA,N)
 *          On entry, the m by n matrix to be factored.
 *          On exit, the factors L and U from the factorization
 *          A = P*L*U; the unit diagonal elements of L are not stored.
 *
-*  LDA     (input) INTEGER
+*  LDA     (input) INTG_PREC
 *          The leading dimension of the array A.  LDA >= max(1,M).
 *
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
+*  IPIV    (output) INTG_PREC array, dimension (min(M,N))
 *          The pivot indices; for 1 <= i <= min(M,N), row i of the
 *          matrix was interchanged with row IPIV(i).
 *
-*  INFO    (output) INTEGER
+*  INFO    (output) INTG_PREC
 *          = 0: successful exit
 *          < 0: if INFO = -k, the k-th argument had an illegal value
 *          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
 *  =====================================================================
 *
 *     .. Parameters ..
-      REALSUB            ONE, ZERO
-      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      R_PREC             ONE, ZERO
+      PARAMETER          ( ONE = 1._RKIND, ZERO = 0._RKIND )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            J, JP
+      INTG_PREC          J, JP
 *     ..
 *     .. External Functions ..
-      INTEGER            e_idamax
+      INTG_PREC          e_idamax
       EXTERNAL           e_idamax
 *     ..
 *     .. External Subroutines ..
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, M ) ) THEN
          INFO = -4
       END IF
       IF( INFO.NE.0 ) THEN
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
+      implicit none
+#include "fortran_types.def"
 *
 *     .. Scalar Arguments ..
-      INTEGER            INFO, LDA, M, N
+      INTG_PREC          INFO, LDA, M, N
 *     ..
 *     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      REALSUB            A( LDA, * )
+      INTG_PREC          IPIV( * )
+      R_PREC             A( LDA, * )
 *     ..
 *
 *  Purpose
 *  Arguments
 *  =========
 *
-*  M       (input) INTEGER
+*  M       (input) INTG_PREC
 *          The number of rows of the matrix A.  M >= 0.
 *
-*  N       (input) INTEGER
+*  N       (input) INTG_PREC
 *          The number of columns of the matrix A.  N >= 0.
 *
-*  A       (input/output) REALSUB array, dimension (LDA,N)
+*  A       (input/output) R_PREC array, dimension (LDA,N)
 *          On entry, the M-by-N matrix to be factored.
 *          On exit, the factors L and U from the factorization
 *          A = P*L*U; the unit diagonal elements of L are not stored.
 *
-*  LDA     (input) INTEGER
+*  LDA     (input) INTG_PREC
 *          The leading dimension of the array A.  LDA >= max(1,M).
 *
-*  IPIV    (output) INTEGER array, dimension (min(M,N))
+*  IPIV    (output) INTG_PREC array, dimension (min(M,N))
 *          The pivot indices; for 1 <= i <= min(M,N), row i of the
 *          matrix was interchanged with row IPIV(i).
 *
-*  INFO    (output) INTEGER
+*  INFO    (output) INTG_PREC
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
 *          > 0:  if INFO = i, U(i,i) is exactly zero. The factorization
 *  =====================================================================
 *
 *     .. Parameters ..
-      REALSUB            ONE
-      PARAMETER          ( ONE = 1.0D+0 )
+      R_PREC             ONE
+      PARAMETER          ( ONE = 1._RKIND )
 *     ..
 *     .. Local Scalars ..
-      INTEGER            I, IINFO, J, JB, NB
+      INTG_PREC          I, IINFO, J, JB, NB
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           UGEMM, UGETF2, ULASWP, UTRSM, E_XERBLA
 *     ..
 *     .. External Functions ..
-      INTEGER            ILAENV
+      INTG_PREC          ILAENV
       EXTERNAL           ILAENV
 *     ..
 *     .. Intrinsic Functions ..
          INFO = -1
       ELSE IF( N.LT.0 ) THEN
          INFO = -2
-      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, M ) ) THEN
          INFO = -4
       END IF
       IF( INFO.NE.0 ) THEN
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     March 31, 1993
+      implicit none
+#include "fortran_types.def"
 *
 *     .. Scalar Arguments ..
       CHARACTER          TRANS
-      INTEGER            INFO, LDA, LDB, N, NRHS
+      INTG_PREC          INFO, LDA, LDB, N, NRHS
 *     ..
 *     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      REALSUB            A( LDA, * ), B( LDB, * )
+      INTG_PREC          IPIV( * )
+      R_PREC             A( LDA, * ), B( LDB, * )
 *     ..
 *
 *  Purpose
 *          = 'T':  A'* X = B  (Transpose)
 *          = 'C':  A'* X = B  (Conjugate transpose = Transpose)
 *
-*  N       (input) INTEGER
+*  N       (input) INTG_PREC
 *          The order of the matrix A.  N >= 0.
 *
-*  NRHS    (input) INTEGER
+*  NRHS    (input) INTG_PREC
 *          The number of right hand sides, i.e., the number of columns
 *          of the matrix B.  NRHS >= 0.
 *
-*  A       (input) REALSUB array, dimension (LDA,N)
+*  A       (input) R_PREC array, dimension (LDA,N)
 *          The factors L and U from the factorization A = P*L*U
 *          as computed by UGETRF.
 *
-*  LDA     (input) INTEGER
+*  LDA     (input) INTG_PREC
 *          The leading dimension of the array A.  LDA >= max(1,N).
 *
-*  IPIV    (input) INTEGER array, dimension (N)
+*  IPIV    (input) INTG_PREC array, dimension (N)
 *          The pivot indices from UGETRF; for 1<=i<=N, row i of the
 *          matrix was interchanged with row IPIV(i).
 *
-*  B       (input/output) REALSUB array, dimension (LDB,NRHS)
+*  B       (input/output) R_PREC array, dimension (LDB,NRHS)
 *          On entry, the right hand side matrix B.
 *          On exit, the solution matrix X.
 *
-*  LDB     (input) INTEGER
+*  LDB     (input) INTG_PREC
 *          The leading dimension of the array B.  LDB >= max(1,N).
 *
-*  INFO    (output) INTEGER
+*  INFO    (output) INTG_PREC
 *          = 0:  successful exit
 *          < 0:  if INFO = -i, the i-th argument had an illegal value
 *
 *  =====================================================================
 *
 *     .. Parameters ..
-      REALSUB            ONE
+      R_PREC             ONE
       PARAMETER          ( ONE = 1.0D+0 )
 *     ..
 *     .. Local Scalars ..
          INFO = -2
       ELSE IF( NRHS.LT.0 ) THEN
          INFO = -3
-      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, N ) ) THEN
          INFO = -5
-      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
+      ELSE IF( LDB.LT.MAX( 1_IKIND, N ) ) THEN
          INFO = -8
       END IF
       IF( INFO.NE.0 ) THEN
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     June 30, 1999
+      implicit none
+#include "fortran_types.def"
 *
 *     .. Scalar Arguments ..
-      INTEGER            INCX, K1, K2, LDA, N
+      INTG_PREC          INCX, K1, K2, LDA, N
 *     ..
 *     .. Array Arguments ..
-      INTEGER            IPIV( * )
-      REALSUB            A( LDA, * )
+      INTG_PREC          IPIV( * )
+      R_PREC             A( LDA, * )
 *     ..
 *
 *  Purpose
 *  Arguments
 *  =========
 *
-*  N       (input) INTEGER
+*  N       (input) INTG_PREC
 *          The number of columns of the matrix A.
 *
-*  A       (input/output) REALSUB array, dimension (LDA,N)
+*  A       (input/output) R_PREC array, dimension (LDA,N)
 *          On entry, the matrix of column dimension N to which the row
 *          interchanges will be applied.
 *          On exit, the permuted matrix.
 *
-*  LDA     (input) INTEGER
+*  LDA     (input) INTG_PREC
 *          The leading dimension of the array A.
 *
-*  K1      (input) INTEGER
+*  K1      (input) INTG_PREC
 *          The first element of IPIV for which a row interchange will
 *          be done.
 *
-*  K2      (input) INTEGER
+*  K2      (input) INTG_PREC
 *          The last element of IPIV for which a row interchange will
 *          be done.
 *
-*  IPIV    (input) INTEGER array, dimension (M*abs(INCX))
+*  IPIV    (input) INTG_PREC array, dimension (M*abs(INCX))
 *          The vector of pivot indices.  Only the elements in positions
 *          K1 through K2 of IPIV are accessed.
 *          IPIV(K) = L implies rows K and L are to be interchanged.
 *
-*  INCX    (input) INTEGER
+*  INCX    (input) INTG_PREC
 *          The increment between successive values of IPIV.  If IPIV
 *          is negative, the pivots are applied in reverse order.
 *
 * =====================================================================
 *
 *     .. Local Scalars ..
-      INTEGER            I, I1, I2, INC, IP, IX, IX0, J, K, N32
-      REALSUB            TEMP
+      INTG_PREC          I, I1, I2, INC, IP, IX, IX0, J, K, N32
+      R_PREC             TEMP
 *     ..
 *     .. Executable Statements ..
 *
 c     uses unrolled loops for increments equal one.
 c     jack dongarra, linpack, 3/11/78.
 c     modified 12/3/93, array(1) declarations changed to array(*)
+      implicit none
+#include "fortran_types.def"
 c
-      REALSUB dx(*),dy(*),dtemp
-      integer i,incx,incy,ix,iy,m,mp1,n
+      R_PREC dx(*),dy(*),dtemp
+      INTG_PREC i,incx,incy,ix,iy,m,mp1,n
 c
       if(n.le.0)return
       if(incx.eq.1.and.incy.eq.1)go to 20
 c
 c       clean-up loop
 c
-   20 m = mod(n,3)
+   20 m = mod(n,3_IKIND)
       if( m .eq. 0 ) go to 40
       do 30 i = 1,m
         dtemp = dx(i)
 c     jack dongarra, linpack, 3/11/78.
 c     modified 3/93 to return if incx .le. 0.
 c     modified 12/3/93, array(1) declarations changed to array(*)
+      implicit none
+#include "fortran_types.def"
 c
-      REALSUB da,dx(*)
-      integer i,incx,m,mp1,n,nincx
+      R_PREC da,dx(*)
+      INTG_PREC i,incx,m,mp1,n,nincx
 c
       if( n.le.0 .or. incx.le.0 )return
       if(incx.eq.1)go to 20
 c
 c        clean-up loop
 c
-   20 m = mod(n,5)
+   20 m = mod(n,5_IKIND)
       if( m .eq. 0 ) go to 40
       do 30 i = 1,m
         dx(i) = da*dx(i)
 c
       SUBROUTINE UTRSM ( SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA,
      $                   B, LDB )
+      implicit none
+#include "fortran_types.def"
 *     .. Scalar Arguments ..
       CHARACTER*1        SIDE, UPLO, TRANSA, DIAG
-      INTEGER            M, N, LDA, LDB
-      REALSUB            ALPHA
+      INTG_PREC          M, N, LDA, LDB
+      R_PREC             ALPHA
 *     .. Array Arguments ..
-      REALSUB            A( LDA, * ), B( LDB, * )
+      R_PREC             A( LDA, * ), B( LDB, * )
 *     ..
 *
 *  Purpose
 *
 *           Unchanged on exit.
 *
-*  M      - INTEGER.
+*  M      - INTG_PREC.
 *           On entry, M specifies the number of rows of B. M must be at
 *           least zero.
 *           Unchanged on exit.
 *
-*  N      - INTEGER.
+*  N      - INTG_PREC.
 *           On entry, N specifies the number of columns of B.  N must be
 *           at least zero.
 *           Unchanged on exit.
 *
-*  ALPHA  - REALSUB.
+*  ALPHA  - R_PREC.
 *           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
 *           zero then  A is not referenced and  B need not be set before
 *           entry.
 *           Unchanged on exit.
 *
-*  A      - REALSUB array of DIMENSION ( LDA, k ), where k is m
+*  A      - R_PREC array of DIMENSION ( LDA, k ), where k is m
 *           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
 *           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
 *           upper triangular part of the array  A must contain the upper
 *           A  are not referenced either,  but are assumed to be  unity.
 *           Unchanged on exit.
 *
-*  LDA    - INTEGER.
+*  LDA    - INTG_PREC.
 *           On entry, LDA specifies the first dimension of A as declared
 *           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
 *           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
 *           then LDA must be at least max( 1, n ).
 *           Unchanged on exit.
 *
-*  B      - REALSUB array of DIMENSION ( LDB, n ).
+*  B      - R_PREC array of DIMENSION ( LDB, n ).
 *           Before entry,  the leading  m by n part of the array  B must
 *           contain  the  right-hand  side  matrix  B,  and  on exit  is
 *           overwritten by the solution matrix  X.
 *
-*  LDB    - INTEGER.
+*  LDB    - INTG_PREC.
 *           On entry, LDB specifies the first dimension of B as declared
 *           in  the  calling  (sub)  program.   LDB  must  be  at  least
 *           max( 1, m ).
       INTRINSIC          MAX
 *     .. Local Scalars ..
       LOGICAL            LSIDE, NOUNIT, UPPER
-      INTEGER            I, INFO, J, K, NROWA
-      REALSUB            TEMP
+      INTG_PREC          I, INFO, J, K, NROWA
+      R_PREC             TEMP
 *     .. Parameters ..
-      REALSUB            ONE         , ZERO
-      PARAMETER        ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+      R_PREC             ONE         , ZERO
+      PARAMETER        ( ONE = 1._RKIND, ZERO = 0._RKIND )
 *     ..
 *     .. Executable Statements ..
 *
          INFO = 5
       ELSE IF( N  .LT.0               )THEN
          INFO = 6
-      ELSE IF( LDA.LT.MAX( 1, NROWA ) )THEN
+      ELSE IF( LDA.LT.MAX( 1_IKIND, NROWA ) )THEN
          INFO = 9
-      ELSE IF( LDB.LT.MAX( 1, M     ) )THEN
+      ELSE IF( LDB.LT.MAX( 1_IKIND, M     ) )THEN
          INFO = 11
       END IF
       IF( INFO.NE.0 )THEN
 c
 c=======================================================================
 c
-      integer function e_idamax(n,dx,incx)
+      INTG_PREC function e_idamax(n,dx,incx)
 c
 c     finds the index of element having max. absolute value.
 c     jack dongarra, linpack, 3/11/78.
 c     modified 3/93 to return if incx .le. 0.
 c     modified 12/3/93, array(1) declarations changed to array(*)
 c
-      REALSUB dx(*),dmax
-      integer i,incx,ix,n
+      R_PREC dx(*),dmax
+      INTG_PREC i,incx,ix,n
 c
       e_idamax = 0
       if( n.lt.1 .or. incx.le.0 ) return
 c
 c=======================================================================
 c
-      INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
+      INTG_PREC        FUNCTION IEEECK( ISPEC, ZERO, ONE )
 *
 *  -- LAPACK auxiliary routine (version 3.0) --
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     June 30, 1998
 *
 *     .. Scalar Arguments ..
-      INTEGER            ISPEC
-      REAL               ONE, ZERO
+      INTG_PREC        ISPEC
+      R_PREC           ONE, ZERO
 *     ..
 *
 *  Purpose
 *  Arguments
 *  =========
 *
-*  ISPEC   (input) INTEGER
+*  ISPEC   (input) INTG_PREC
 *          Specifies whether to test just for inifinity arithmetic
 *          or whether to test for infinity and NaN arithmetic.
 *          = 0: Verify infinity arithmetic only.
 *          = 1: Verify infinity and NaN arithmetic.
 *
-*  ZERO    (input) REAL
+*  ZERO    (input) R_PREC
 *          Must contain the value 0.0
 *          This is passed to prevent the compiler from optimizing
 *          away this code.
 *
-*  ONE     (input) REAL
+*  ONE     (input) R_PREC
 *          Must contain the value 1.0
 *          This is passed to prevent the compiler from optimizing
 *          away this code.
 *
-*  RETURN VALUE:  INTEGER
+*  RETURN VALUE:  INTG_PREC
 *          = 0:  Arithmetic failed to produce the correct answers
 *          = 1:  Arithmetic produced the correct answers
 *
 *     .. Local Scalars ..
-      REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
+      R_PREC               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
      $                   NEGZRO, NEWZRO, POSINF
 *     ..
 *     .. Executable Statements ..
 c
 c=======================================================================
 c
-      INTEGER          FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
+      INTG_PREC        FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3,
      $                 N4 )
 *
 *  -- LAPACK auxiliary routine (version 3.0) --
 *     Courant Institute, Argonne National Lab, and Rice University
 *     June 30, 1999
 *
+      IMPLICIT NONE
+#include "fortran_types.def"      
 *     .. Scalar Arguments ..
       CHARACTER*( * )    NAME, OPTS
-      INTEGER            ISPEC, N1, N2, N3, N4
+      INTG_PREC          ISPEC, N1, N2, N3, N4
 *     ..
 *
 *  Purpose
 *  Arguments
 *  =========
 *
-*  ISPEC   (input) INTEGER
+*  ISPEC   (input) INTG_PREC
 *          Specifies the parameter to be returned as the value of
 *          ILAENV.
 *          = 1: the optimal blocksize; if this value is 1, an unblocked
 *          TRANS = 'T', and DIAG = 'N' for a triangular routine would
 *          be specified as OPTS = 'UTN'.
 *
-*  N1      (input) INTEGER
-*  N2      (input) INTEGER
-*  N3      (input) INTEGER
-*  N4      (input) INTEGER
+*  N1      (input) INTG_PREC
+*  N2      (input) INTG_PREC
+*  N3      (input) INTG_PREC
+*  N4      (input) INTG_PREC
 *          Problem dimensions for the subroutine NAME; these may not all
 *          be required.
 *
-* (ILAENV) (output) INTEGER
+* (ILAENV) (output) INTG_PREC
 *          >= 0: the value of the parameter specified by ISPEC
 *          < 0:  if ILAENV = -k, the k-th argument had an illegal value.
 *
       CHARACTER*2        C2, C4
       CHARACTER*3        C3
       CHARACTER*6        SUBNAM
-      INTEGER            I, IC, IZ, NB, NBMIN, NX
+      INTG_PREC          I, IC, IZ, NB, NBMIN, NX
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          CHAR, ICHAR, INT, MIN, REAL
 *     ..
 *     .. External Functions ..
-      INTEGER            IEEECK
+      INTG_PREC          IEEECK
       EXTERNAL           IEEECK
 *     ..
 *     .. Executable Statements ..
 *     ISPEC = 1:  block size
 *
 *     In these examples, separate code is provided for setting NB for
-*     real and complex.  We assume that NB will take the same value in
+*     R_PREC and CMPLX_PREC.  We assume that NB will take the same value in
 *     single or double precision.
 *
       NB = 1
 *
 *     ISPEC = 6:  crossover point for SVD (used by xGELSS and xGESVD)
 *
-      ILAENV = INT( REAL( MIN( N1, N2 ) )*1.6E0 )
+      ILAENV = INT( REAL( MIN( N1, N2 ), RKIND)*1.6_RKIND, IKIND)
       RETURN
 *
   700 CONTINUE
 C     ILAENV = 0
       ILAENV = 1
       IF( ILAENV.EQ.1 ) THEN
-         ILAENV = IEEECK( 0, 0.0, 1.0 ) 
+         ILAENV = IEEECK( 0, 0._RKIND, 1._RKIND ) 
       END IF
       RETURN
 *
 C     ILAENV = 0
       ILAENV = 1
       IF( ILAENV.EQ.1 ) THEN
-         ILAENV = IEEECK( 1, 0.0, 1.0 ) 
+         ILAENV = IEEECK( 1, 0._RKIND, 1._RKIND ) 
       END IF
       RETURN
 *
       INTRINSIC          ICHAR
 *     ..
 *     .. Local Scalars ..
-      INTEGER            INTA, INTB, ZCODE
+      INTG_PREC          INTA, INTB, ZCODE
 *     ..
 *     .. Executable Statements ..
 *
 *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
 *     Courant Institute, Argonne National Lab, and Rice University
 *     February 29, 1992
+      implicit none
+#include "fortran_types.def"
 *
 *     .. Scalar Arguments ..
       CHARACTER*6        SRNAME
-      INTEGER            INFO
+      INTG_PREC          INFO
 *     ..
 *
 *  Purpose
 *  SRNAME  (input) CHARACTER*6
 *          The name of the routine which called E_XERBLA.
 *
-*  INFO    (input) INTEGER
+*  INFO    (input) INTG_PREC
 *          The position of the invalid parameter in the parameter list
 *          of the calling routine.
 *

File src/enzo/FOF_allvars.h

 #define  SEC_PER_MEGAYEAR   3.155e13
 #define  SEC_PER_YEAR       3.155e7
 
+#ifndef __GAMMA_DEFINED_
+#define __GAMMA_DEFINED_
 #define  GAMMA         (5.0/3)
 #define  GAMMA_MINUS1  (GAMMA-1)
+#endif
 
 /************************************************************************
    STRUCTURES

File src/enzo/FSProb_InitialGuess.F90

 !
 !=======================================================================
   implicit none
+#include "fortran_types.def"
 
   !--------------
   ! argument declarations
-  integer, intent(in) :: iguess, kappa_h2on
-  integer, intent(in) :: Nx, NGxl, NGxr
-  integer, intent(in) :: Ny, NGyl, NGyr
-  integer, intent(in) :: Nz, NGzl, NGzr
-  integer, intent(out) :: ier
-  REALSUB, intent(in) :: a, adot
-  real,    intent(in) :: dt, kappa_c, dx, dy, dz
-  real,    intent(in) :: aUn, lUn, tUn, EUn, dUn
-  real,    intent(in) :: eta(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
-  real,    intent(in) :: Ef0(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
-  real,    intent(in) :: kappa(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
-  real,    intent(out) :: Ef(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
+  INTG_PREC, intent(in) :: iguess, kappa_h2on
+  INTG_PREC, intent(in) :: Nx, NGxl, NGxr
+  INTG_PREC, intent(in) :: Ny, NGyl, NGyr
+  INTG_PREC, intent(in) :: Nz, NGzl, NGzr
+  INTG_PREC, intent(out) :: ier
+  P_PREC, intent(in) :: a, adot
+  R_PREC,    intent(in) :: dt, kappa_c, dx, dy, dz
+  R_PREC,    intent(in) :: aUn, lUn, tUn, EUn, dUn
+  R_PREC,    intent(in) :: eta(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
+  R_PREC,    intent(in) :: Ef0(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
+  R_PREC,    intent(in) :: kappa(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
+  R_PREC,    intent(out) :: Ef(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
   
   !--------------
   ! locals
-  integer :: i, j, k
-  real :: P, c, pi
+  INTG_PREC :: i, j, k
+  R_PREC :: P, c, pi
 
   !=======================================================================
 
                  ! if attenuation is negligible, use simpler analytical 
                  ! solution to avoid division by zero 
                  P = adot/a + c*kappa(i,j,k)
-                 if (P < 1.d-14) then
-                    Ef(i,j,k) = Ef0(i,j,k) + dt*eta(i,j,k)*4.d0*pi
+                 if (P < 1.e-14_RKIND) then
+                    Ef(i,j,k) = Ef0(i,j,k) + dt*eta(i,j,k)*4._RKIND*pi
                  ! solution to avoid flt pt overflow
-                 elseif (P*dt > 7.0d2) then
-                    Ef(i,j,k) = eta(i,j,k)*4.d0*pi/P
+                 elseif (P*dt > 7.e2_RKIND) then
+                    Ef(i,j,k) = eta(i,j,k)*4._RKIND*pi/P
                  ! otherwise use full analytical solution
                  else
-                    Ef(i,j,k) = (Ef0(i,j,k) - eta(i,j,k)*4.d0*pi/P)*exp(-P*dt) &
-                              + eta(i,j,k)*4.d0*pi/P
+                    Ef(i,j,k) = (Ef0(i,j,k) - eta(i,j,k)*4._RKIND*pi/P)*exp(-P*dt) &
+                              + eta(i,j,k)*4._RKIND*pi/P
                  endif
               enddo
            enddo
                  ! if attenuation is negligible, use simpler analytical 
                  ! solution to avoid division by zero 
                  P = adot/a + c*kappa_c
-                 if (P < 1.d-14) then
-                    Ef(i,j,k) = Ef0(i,j,k) + dt*eta(i,j,k)*4.d0*pi
+                 if (P < 1.e-14_RKIND) then
+                    Ef(i,j,k) = Ef0(i,j,k) + dt*eta(i,j,k)*4._RKIND*pi
                  ! solution to avoid flt pt overflow
-                 elseif (P*dt > 7.0d2) then
-                    Ef(i,j,k) = eta(i,j,k)*4.d0*pi/P
+                 elseif (P*dt > 7.e2_RKIND) then
+                    Ef(i,j,k) = eta(i,j,k)*4._RKIND*pi/P
                  ! otherwise use full analytical solution
                  else
-                    Ef(i,j,k) = (Ef0(i,j,k) - eta(i,j,k)*4.d0*pi/P)*exp(-P*dt) &
-                              + eta(i,j,k)*4.d0*pi/P
+                    Ef(i,j,k) = (Ef0(i,j,k) - eta(i,j,k)*4._RKIND*pi/P)*exp(-P*dt) &
+                              + eta(i,j,k)*4._RKIND*pi/P
                  endif
               enddo
            enddo

File src/enzo/FSProb_RadiationSource.F90

 !
 !=======================================================================
   implicit none
+#include "fortran_types.def"
 
 !--------------
 ! argument declarations
-  integer, intent(in) :: ProbType
-  integer, intent(in) :: Nx, NGxl, NGxr
-  integer, intent(in) :: Ny, NGyl, NGyr
-  integer, intent(in) :: Nz, NGzl, NGzr
-  integer, intent(out) :: ier
-  real*8,  intent(in) :: NGammaDot
-  REALSUB, intent(in) :: a
-  real,    intent(in) :: time, EtaRadius, EtaCenter(3)
-  real,    intent(in) :: aUn, lUn, tUn, rUn
-  real,    intent(in) :: x0L, x0R, x1L, x1R, x2L, x2R
-  real,    intent(out) :: eta(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
+  INTG_PREC, intent(in) :: ProbType
+  INTG_PREC, intent(in) :: Nx, NGxl, NGxr
+  INTG_PREC, intent(in) :: Ny, NGyl, NGyr
+  INTG_PREC, intent(in) :: Nz, NGzl, NGzr
+  INTG_PREC, intent(out) :: ier
+  REAL*8,  intent(in) :: NGammaDot
+  P_PREC, intent(in) :: a
+  R_PREC,    intent(in) :: time, EtaRadius, EtaCenter(3)
+  R_PREC,    intent(in) :: aUn, lUn, tUn, rUn
+  R_PREC,    intent(in) :: x0L, x0R, x1L, x1R, x2L, x2R
+  R_PREC,    intent(out) :: eta(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr)
   
 !--------------
 ! locals
-  integer :: i, j, k, l, nsrc, seed(12)
-  real    :: h_nu0, etaconst, rnums(10)
-  real    :: dx, dy, dz, cellXl, cellXr, cellYl, cellYr, cellZl, cellZr
-  real    :: cellXc, cellYc, cellZc
-  real*8  :: dV
+  INTEGER   :: seed(12)
+  INTG_PREC :: i, j, k, l, nsrc
+  R_PREC    :: h_nu0, etaconst, rnums(10)
+  R_PREC    :: dx, dy, dz, cellXl, cellXr, cellYl, cellYr, cellZl, cellZr
+  R_PREC    :: cellXc, cellYc, cellZc
+  REAL*8    :: dV
 
 !=======================================================================
 
   ! initialize output to have all zero values, flag to success
-  eta = 0.d0
+  eta = 0._RKIND
   ier = 1
   
   ! initialize constants
   dy    = (x1R-x1L)/Ny                ! mesh spacing (comoving), x1 direction
   dz    = (x2R-x2L)/Nz                ! mesh spacing (comoving), x2 direction
   dV    = dx*dy*dz*(dble(lUn))**3     ! cell volume (proper)
-  h_nu0 = 13.6d0*ev2erg               ! ionization energy of HI [ergs]
+  h_nu0 = 13.6_RKIND*ev2erg               ! ionization energy of HI [ergs]
 
   ! compute point source emissivity for various problems
 
   if (ProbType == 450) then
 
      ! get the number of sources from EtaRadius
-     nsrc = EtaRadius   ! cast to an integer
+     nsrc = EtaRadius   ! cast to an INTG_PREC
 
-     ! set the seed by casting the time to an integer
-     seed(1) = 5.d0*time/tUn + x0L/dx + x1L/dy + x2L/dz
+     ! set the seed by casting the time to an INTG_PREC
+     seed(1) = 5._RKIND*time/tUn + x0L/dx + x1L/dy + x2L/dz
      seed(1) = seed(1) + 13
 !     print *,'random seed = ',seed(1),' time = ',time
      call random_seed(PUT=seed)
 
         ! get 4 random numbers for each source (3 location, 1 strength)
         call random_number(rnums)
-        i = max(min(int(rnums(4)*Nx), Nx-1), 2)
-        j = max(min(int(rnums(6)*Ny), Ny-1), 2)
-        k = max(min(int(rnums(8)*Nz), Nz-1), 2)
-!        eta(i,j,k) = rnums(10)*h_nu0*real(NGammaDot/dV)
+        i = max(min(int(rnums(4)*Nx,IKIND), Nx-1), 2_IKIND)
+        j = max(min(int(rnums(6)*Ny,IKIND), Ny-1), 2_IKIND)
+        k = max(min(int(rnums(8)*Nz,IKIND), Nz-1), 2_IKIND)
+!        eta(i,j,k) = rnums(10)*h_nu0*REAL(NGammaDot/dV,RKIND)
         eta(i,j,k) = rnums(10)*h_nu0*NGammaDot/dV
 !        print '(A,3(i2,1x),A,es9.2)', '   setting source at ',i,j,k,' with strength ',eta(i,j,k)
 
   else if ((ProbType > 450) .and. (ProbType <= 460)) then
 
      ! one-cell source
-     if (EtaRadius == 0.d0) then
+     if (EtaRadius == 0._RKIND) then
         
         ! compute eta factor for given ionization source
         etaconst = h_nu0*NGammaDot/dV
      else
 
         ! compute eta factor for given ionization source
-        etaconst = h_nu0*NGammaDot/dV/8.d0/(EtaRadius**3)
+        etaconst = h_nu0*NGammaDot/dV/8._RKIND/(EtaRadius**3)
         
         ! place ionization source in center of domain
         do k=1,Nz,1
            
            ! z-center (comoving) for this cell
-           cellZc = x2L + (k-0.5d0)*dz
+           cellZc = x2L + (k-0.5_RKIND)*dz
            
            do j=1,Ny,1
               
               ! y-center (comoving) for this cell
-              cellYc = x1L + (j-0.5d0)*dy
+              cellYc = x1L + (j-0.5_RKIND)*dy
               
               do i=1,Nx,1
                  
                  ! x-center (comoving) for this cell
-                 cellXc = x0L + (i-0.5d0)*dx
+                 cellXc = x0L + (i-0.5_RKIND)*dx
                  
                  ! see if cell is within source region
                  if ( (abs(cellXc-EtaCenter(1)) < EtaRadius*dx) .and. &
      etaconst = h_nu0*NGammaDot/dV
         
      ! place ionization source in center of subdomain
-     eta(int(Nx/2),int(Ny/2),int(Nz/2)) = etaconst
+     eta(int(Nx/2,IKIND),int(Ny/2,IKIND),int(Nz/2,IKIND)) = etaconst
 
   !   homogeneous emissivity field w/ strength h_nu0*NGammaDot/dV
   elseif (ProbType == 462) then

File src/enzo/FSProb_SetupSystem.F90

 !                  BCs may move these to 0:Nx, 1:Nx+1, etc.
 !     Nx,Ny,Nz   - active mesh size in each direction
 !     NG*l/NG*r  - left/right ghost cells in each direction
-!     *{l,r}face - integer flag denoting whether direction/face 
+!     *{l,r}face - INTG_PREC flag denoting whether direction/face 
 !                  is external to the domain (0->int, 1->ext)
 !
 !     Note: the vector inputs are of size (Nx + NGxl + NGxr) in 
 !
 !=======================================================================
   implicit none
+#include "fortran_types.def"
   
   !--------------
   ! argument declarations
-  integer, intent(in) :: rank, kappa_h2on
-  integer, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
-  integer, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
-  integer, intent(in) :: BCZl, BCZr, x2s, x2e, Nz, NGzl, NGzr, zlface, zrface
-  REALSUB, intent(in) :: a, a0, adot, adot0
-  real,    intent(in) :: kappa_c, dt, theta, dx, dy, dz
-  real,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
-  real,    intent(in) :: E(*), E0(*), eta(*), kappa_arr(*)
-  real*8,  intent(out) :: mat(*)
-  real*8,  intent(out) :: rhs(*)
-  real,    intent(out) :: rhsnorm
-  integer, intent(out) :: ier
+  INTG_PREC, intent(in) :: rank, kappa_h2on
+  INTG_PREC, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
+  INTG_PREC, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
+  INTG_PREC, intent(in) :: BCZl, BCZr, x2s, x2e, Nz, NGzl, NGzr, zlface, zrface
+  P_PREC, intent(in) :: a, a0, adot, adot0
+  R_PREC,    intent(in) :: kappa_c, dt, theta, dx, dy, dz
+  R_PREC,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
+  R_PREC,    intent(in) :: E(*), E0(*), eta(*), kappa_arr(*)
+  REAL*8,  intent(out) :: mat(*)
+  REAL*8,  intent(out) :: rhs(*)
+  R_PREC,    intent(out) :: rhsnorm
+  INTG_PREC, intent(out) :: ier
 
   !=======================================================================
   
 !  PURPOSE: 3D version of the routine
 !=======================================================================
   implicit none
+#include "fortran_types.def"
   
   !--------------
   ! argument declarations
-  integer, intent(in) :: kappa_h2on
-  integer, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
-  integer, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
-  integer, intent(in) :: BCZl, BCZr, x2s, x2e, Nz, NGzl, NGzr, zlface, zrface
-  REALSUB, intent(in) :: a, a0, adot, adot0
-  real,    intent(in) :: kappa_c, dt, theta, dx, dy, dz
-  real,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
-  real, dimension(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr), intent(in) &
+  INTG_PREC, intent(in) :: kappa_h2on
+  INTG_PREC, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
+  INTG_PREC, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
+  INTG_PREC, intent(in) :: BCZl, BCZr, x2s, x2e, Nz, NGzl, NGzr, zlface, zrface
+  P_PREC, intent(in) :: a, a0, adot, adot0
+  R_PREC,    intent(in) :: kappa_c, dt, theta, dx, dy, dz
+  R_PREC,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
+  R_PREC, dimension(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr,1-NGzl:Nz+NGzr), intent(in) &
                        :: E, E0, eta, kappa
-  real*8,  intent(out) :: mat(7,x0s:x0e,x1s:x1e,x2s:x2e)
-  real*8,  intent(out) :: rhs(x0s:x0e,x1s:x1e,x2s:x2e)
-  real,    intent(out) :: rhsnorm
-  integer, intent(out) :: ier
+  REAL*8,  intent(out) :: mat(7,x0s:x0e,x1s:x1e,x2s:x2e)
+  REAL*8,  intent(out) :: rhs(x0s:x0e,x1s:x1e,x2s:x2e)
+  R_PREC,    intent(out) :: rhsnorm
+  INTG_PREC, intent(out) :: ier
 
   !--------------
   ! locals
-  integer :: i, j, k
-  real*8  :: dtfac, dtfac0, kap, kap0, eps, mu
-  real*8  :: c, dxi, dxi0, dyi, dyi0, dzi, dzi0
-  real*8  :: afac, afac0, Edir(3), Emax, delta_nU
-  real*8  :: E0d_x, Ed_x, E0d_y, Ed_y, E0d_z, Ed_z
+  INTG_PREC :: i, j, k
+  REAL*8  :: dtfac, dtfac0, kap, kap0, eps, mu
+  REAL*8  :: c, dxi, dxi0, dyi, dyi0, dzi, dzi0
+  REAL*8  :: afac, afac0, Edir(3), Emax, delta_nU
+  REAL*8  :: E0d_x, Ed_x, E0d_y, Ed_y, E0d_z, Ed_z
 
 !=======================================================================
   
 !  PURPOSE: 2D version of the routine
 !=======================================================================
   implicit none
+#include "fortran_types.def"
   
   !--------------
   ! argument declarations
-  integer, intent(in) :: kappa_h2on
-  integer, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
-  integer, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
-  REALSUB, intent(in) :: a, a0, adot, adot0
-  real,    intent(in) :: kappa_c, dt, theta, dx, dy
-  real,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
-  real, dimension(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr), intent(in) :: E, E0, eta, kappa
-  real*8,  intent(out) :: mat(5,x0s:x0e,x1s:x1e)
-  real*8,  intent(out) :: rhs(x0s:x0e,x1s:x1e)
-  real,    intent(out) :: rhsnorm
-  integer, intent(out) :: ier
+  INTG_PREC, intent(in) :: kappa_h2on
+  INTG_PREC, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
+  INTG_PREC, intent(in) :: BCYl, BCYr, x1s, x1e, Ny, NGyl, NGyr, ylface, yrface
+  P_PREC, intent(in) :: a, a0, adot, adot0
+  R_PREC,    intent(in) :: kappa_c, dt, theta, dx, dy
+  R_PREC,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
+  R_PREC, dimension(1-NGxl:Nx+NGxr,1-NGyl:Ny+NGyr), intent(in) :: E, E0, eta, kappa
+  REAL*8,  intent(out) :: mat(5,x0s:x0e,x1s:x1e)
+  REAL*8,  intent(out) :: rhs(x0s:x0e,x1s:x1e)
+  R_PREC,    intent(out) :: rhsnorm
+  INTG_PREC, intent(out) :: ier
 
   !--------------
   ! locals
-  integer :: i, j
-  real*8  :: dtfac, dtfac0, kap, kap0, eps, mu
-  real*8  :: c, dxi, dxi0, dyi, dyi0
-  real*8  :: afac, afac0, Edir(2), Emax, delta_nU
-  real*8  :: E0d_x, Ed_x, E0d_y, Ed_y
+  INTG_PREC :: i, j
+  REAL*8  :: dtfac, dtfac0, kap, kap0, eps, mu
+  REAL*8  :: c, dxi, dxi0, dyi, dyi0
+  REAL*8  :: afac, afac0, Edir(2), Emax, delta_nU
+  REAL*8  :: E0d_x, Ed_x, E0d_y, Ed_y
 
 !=======================================================================
   
 !  PURPOSE: 1D version of the routine
 !=======================================================================
   implicit none
+#include "fortran_types.def"
   
   !--------------
   ! argument declarations
-  integer, intent(in) :: kappa_h2on
-  integer, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
-  REALSUB, intent(in) :: a, a0, adot, adot0
-  real,    intent(in) :: kappa_c, dt, theta, dx
-  real,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
-  real, dimension(1-NGxl:Nx+NGxr), intent(in) :: E, E0, eta, kappa
-  real*8,  intent(out) :: mat(3,x0s:x0e)
-  real*8,  intent(out) :: rhs(x0s:x0e)
-  real,    intent(out) :: rhsnorm
-  integer, intent(out) :: ier
+  INTG_PREC, intent(in) :: kappa_h2on
+  INTG_PREC, intent(in) :: BCXl, BCXr, x0s, x0e, Nx, NGxl, NGxr, xlface, xrface
+  P_PREC, intent(in) :: a, a0, adot, adot0
+  R_PREC,    intent(in) :: kappa_c, dt, theta, dx
+  R_PREC,    intent(in) :: lUn, lUn0, rUn, rUn0, nUn, nUn0
+  R_PREC, dimension(1-NGxl:Nx+NGxr), intent(in) :: E, E0, eta, kappa
+  REAL*8,  intent(out) :: mat(3,x0s:x0e)
+  REAL*8,  intent(out) :: rhs(x0s:x0e)
+  R_PREC,    intent(out) :: rhsnorm
+  INTG_PREC, intent(out) :: ier
 
   !--------------
   ! locals
-  integer :: i
-  real*8  :: dtfac, dtfac0, kap, kap0, eps, mu
-  real*8  :: c, dxi, dxi0
-  real*8  :: afac, afac0, Edir, delta_nU, ONE
-  real*8  :: E0d_x, Ed_x
+  INTG_PREC :: i
+  REAL*8  :: dtfac, dtfac0, kap, kap0, eps, mu
+  REAL*8  :: c, dxi, dxi0
+  REAL*8  :: afac, afac0, Edir, delta_nU, ONE
+  REAL*8  :: E0d_x, Ed_x
 
 !=======================================================================
   

File src/enzo/Gadget.h

 #define  TABLESIZE 200		/* Max # of lines in TREECOOL */
 #define  MAXITER 200
 #define  SMALLNUM 1.0e-60
+
+#ifndef __GAMMA_DEFINED_
+#define __GAMMA_DEFINED_
 #define  GAMMA         (5.0/3.0)
 #define  GAMMA_MINUS1  (GAMMA-1.0)
+#endif
+
 #define  MINGASTEMP 0.1
 #define  HYDROGEN_MASSFRAC 0.76
 #define  PROTONMASS  1.6726e-24

File src/enzo/Grid_ComputeElementalDensity.C

 #include "Fluxes.h"
 #include "GridList.h"
 #include "ExternalBoundary.h"
-#include "fortran.def"
 #include "Grid.h"
 #include "CosmologyParameters.h"
  
  
       /* Convert log(densit) into an integer in the table */
  
-      logd = log10(max(nH, tiny));
+      logd = log10(max(nH, tiny_number));
       logd = min(max(logd, TableDensity[0]), TableDensity[TableSize[0]-1]);
  
       ilogd = int((logd-TableDensity[0])/deld);

File src/enzo/Grid_ZeusSolver.C

 
   /* Set minimum pressure (better if it were a parameter) */
 
-  pmin = tiny;
+  pmin = tiny_number;
 
   /* Error check */
 

File src/enzo/InexactNewton.h

 #define INEXACT_NEWTON_SOLVER_DEFINED__
 
 #include "preincludes.h"
-#include <stdlib.h>
+/* #include <stdlib.h> */
 #include <stdio.h>
 
 #include "macros_and_parameters.h"

File src/enzo/MTLPARAM.h

 C
+      INTG_PREC NUME, MAXLN, NIT, NID, NID2, NIB
+      R_PREC TEMMIN, DELT, DENMIN, DELD, FREQDEL, FREQMIN
+
       PARAMETER(NUME=12,MAXLN=220)
       PARAMETER(NIT=200,TEMMIN=3.0,DELT=0.03)
       PARAMETER(NID=300,DENMIN=-12.0,DELD=0.05,NID2=240)
       PARAMETER(NIB=400,FREQDEL=0.02,FREQMIN=1.0)
 C
-      COMMON/ATM/NJ(12),ABUNJ(12)
-     .          ,WJ(12,MAXLN),E3J(12,MAXLN),FJ(12,MAXLN)
-     .          ,EJ(12,30),EAJ(12,30)
-     .          ,S2J(12,30),LLJ(12,30),S3J(12,30)
-     .          ,S4J(12,30),S5J(12,30)
-     .          ,AN(NID),ABIN(NIB),IPHOT
+      INTG_PREC NJ(12), LLJ(12,30), IPHOT
+      R_PREC ABUNJ(12), WJ(12,MAXLN), E3J(12,MAXLN), 
+     .          FJ(12,MAXLN), EJ(12,30), EAJ(12,30),
+     .          S2J(12,30), S3J(12,30), S4J(12,30),
+     .          S5J(12,30), AN(NID), ABIN(NIB)
+
+      COMMON/ATM/NJ,ABUNJ,WJ,E3J,FJ,EJ,EAJ,S2J,LLJ,S3J,
+     .          S4J,S5J,AN,ABIN,IPHOT
 C
 C

File src/enzo/Make.config.assemble

 #    FFLAGS             Flags for the Fortran 77 compiler
 #    F90FLAGS           Flags for the Fortran 90 compiler
 #    LDFLAGS            Flags for the Linker      
-#                      
-# Preprocessor defines
-#
-#    DEFINES            Preprocessor defines for C, C++, and Fortran
 #
 # Object files
 #

File src/enzo/Make.mach.ncsa-bluedrop

+#=======================================================================
+#
+# FILE:        Make.mach.ncsa-bluedrop
+#
+# DESCRIPTION: Makefile settings for IBM BlueDrop
+#
+# AUTHOR:      Daniel R. Reynolds
+#
+# DATE:        2010-08-27
+#
+#=======================================================================
+
+MACH_TEXT  = NCSA Blue Drop
+MACH_VALID = 1
+MACH_FILE  = Make.mach.ncsa-bluedrop
+
+MACHINE_NOTES = "BlueDrop prototype for BlueWaters at UIUC/NCSA."
+
+#-----------------------------------------------------------------------
+# Commands to run test executables
+#-----------------------------------------------------------------------
+
+
+#-----------------------------------------------------------------------
+# Install paths (local variables)
+#-----------------------------------------------------------------------
+
+LOCAL_MPI_INSTALL   = 
+LOCAL_HDF5_INSTALL  = /home/harkness/HDF5/5-1.8.4-aix-64
+LOCAL_HDF4_INSTALL  = 
+LOCAL_HDF4_INSTALL  = 
+LOCAL_SPRNG_INSTALL = 
+LOCAL_PNG_INSTALL   = 
+LOCAL_HYPRE_INSTALL = /home/harkness/Hypre/hypre-2.6.0b
+LOCAL_ACML_INSTALL  = 
+LOCAL_ZLIB_INSTALL  = /usr/lib
+
+
+#-----------------------------------------------------------------------
+# Compiler settings
+#-----------------------------------------------------------------------
+
+MACH_FDEF      = "-WF,"
+
+MACH_CPP       = /usr/bin/cpp
+
+# With MPI
+
+MACH_CC_MPI    = mpCC
+MACH_CXX_MPI   = mpCC
+MACH_FC_MPI    = mpfort -compiler /opt/ibmcmp/xlf/13.1/bin/xlf90_r
+MACH_F90_MPI   = mpfort -compiler /opt/ibmcmp/xlf/13.1/bin/xlf90_r
+MACH_LD_MPI    = mpCC
+
+# Without MPI
+
+MACH_CC_NOMPI  = xlc_r
+MACH_CXX_NOMPI = xlC_r
+MACH_FC_NOMPI  = xlf_r
+MACH_F90_NOMPI = xlf90_r
+MACH_LD_NOMPI  = xlC_r
+
+#-----------------------------------------------------------------------
+# Machine-dependent defines
+#-----------------------------------------------------------------------
+
+MACH_DEFINES = -DLINUX_IBM_XL -DHAVE_GNUPLOT -DH5_USE_16_API -DNO_IO_LOG
+
+#-----------------------------------------------------------------------
+# Compiler flag settings
+#-----------------------------------------------------------------------
+
+MACH_CPPFLAGS = -traditional
+
+MACH_CFLAGS   = -qarch=pwr7 -qtune=pwr7 -qcache=auto -qthreaded -qsmp=noauto
+MACH_CXXFLAGS = -qarch=pwr7 -qtune=pwr7 -qcache=auto -qthreaded -qsmp=noauto -D__NO_MATH_INLINES 
+MACH_FFLAGS   = -qarch=pwr7 -qtune=pwr7 -qcache=auto -qsmp=omp -qmaxmem=1 -qthreaded -qextname -qfixed=132 
+MACH_F90FLAGS = -qarch=pwr7 -qtune=pwr7 -qcache=auto -qsmp=omp -qmaxmem=1 -qthreaded -qextname -qsuffix=f=f90 -qfree 
+MACH_LDFLAGS =  -qarch=pwr7 -qtune=pwr7 -qsmp=omp -qcache=auto -qthreaded
+
+#-----------------------------------------------------------------------
+# Precision-related flags
+#-----------------------------------------------------------------------
+
+MACH_FFLAGS_INTEGER_32 = #-qintsize=4
+MACH_FFLAGS_INTEGER_64 = #-qintsize=8
+MACH_FFLAGS_REAL_32    = #-qrealsize=4
+MACH_FFLAGS_REAL_64    = #-qrealsize=8 -qdpc=e
+
+#-----------------------------------------------------------------------
+# Optimization flags
+#-----------------------------------------------------------------------
+
+MACH_OPT_WARN        = -Wall -g -qsource -qstrict 
+MACH_OPT_DEBUG       = -g -O0 -p -pg -qsource -qstrict 
+MACH_OPT_HIGH        = -O2 -qsource -qstrict #-qdebug=nfuse,nsimdcost
+MACH_OPT_AGGRESSIVE  = -O3 -qstrict -qsimd=auto
+
+#-----------------------------------------------------------------------
+# Includes
+#-----------------------------------------------------------------------
+
+LOCAL_INCLUDES_MPI    = 
+LOCAL_INCLUDES_HDF5   = -I$(LOCAL_HDF5_INSTALL)/include
+LOCAL_INCLUDES_HYPRE  = -I$(LOCAL_HYPRE_INSTALL)/include
+LOCAL_INCLUDES_SPRNG  = -I$(LOCAL_SPRNG_INSTALL)/include
+LOCAL_INCLUDES_PNG    =
+
+MACH_INCLUDES         = $(LOCAL_INCLUDES_HDF5) $(LOCAL_INCLUDES_SPRNG)
+MACH_INCLUDES_MPI     = $(LOCAL_INCLUDES_MPI)
+MACH_INCLUDES_HYPRE   = $(LOCAL_INCLUDES_HYPRE)
+
+#-----------------------------------------------------------------------
+# Libraries
+#-----------------------------------------------------------------------
+#
+
+LOCAL_LIBS_MPI   = 
+LOCAL_LIBS_HDF5  = -L$(LOCAL_HDF5_INSTALL)/lib -lhdf5 -L$(LOCAL_ZLIB_INSTALL) -lz 
+LOCAL_LIBS_HYPRE = -L$(LOCAL_HYPRE_INSTALL)/lib -lHYPRE
+LOCAL_LIBS_SPRNG = -L$(LOCAL_SPRNG_INSTALL)/lib -llcg64
+LOCAL_LIBS_PNG   = -L$(LOCAL_PNG_INSTALL)/lib -lpng -lfreetype
+
+LOCAL_LIBS_MACH   = -L/opt/ibmcmp/xlf/13.1/lib64 -lxl -lxlf90_r -lxlf90_t -lxlfmath -lxlopt -lxlfpad -lxlfpmt4 -lxlfpmt8
+
+MACH_LIBS         = $(LOCAL_LIBS_HDF5) $(LOCAL_LIBS_MACH) #$(LOCAL_LIBS_SPRNG)
+MACH_LIBS_MPI     = $(LOCAL_LIBS_MPI)
+MACH_LIBS_HYPRE   = $(LOCAL_LIBS_HYPRE)

File src/enzo/Makefile

File contents unchanged.

File src/enzo/RadHydroRadShockInitialize.C

 #include "Hierarchy.h"
 #include "TopGridData.h"
 
-#define DEFAULT_MU 0.5  // fully ionized hydrogen gas
+#define DEF_MU 0.5  // fully ionized hydrogen gas
 
 // function prototypes
 int InitializeRateData(FLOAT Time);
   }
 
   /* error checking */
-  if (Mu != DEFAULT_MU) {
+  if (Mu != DEF_MU) {
     if (MyProcessorNumber == ROOT_PROCESSOR)
-      fprintf(stderr, "warning: mu =%f assumed in initialization; setting Mu = %f for consistency.\n", DEFAULT_MU);
-    Mu = DEFAULT_MU;
+      fprintf(stderr, "warning: mu =%f assumed in initialization; setting Mu = %f for consistency.\n", DEF_MU);
+    Mu = DEF_MU;
   }
 
   // set up CoolData object if not already set up
   // density (erg/cc) from input temperatures
   float gas_pressure;
   if ( CGSType == 1 ) 
-    gas_pressure  = DensityConstant * kb * GasTempConstant / DEFAULT_MU / mp;
+    gas_pressure  = DensityConstant * kb * GasTempConstant / DEF_MU / mp;
   if ( CGSType == 2 ) 
     gas_pressure  = (Gamma - 1.0) * Cv * DensityConstant * GasTempConstant;
 

File src/enzo/acml_st1.F

 #include "error.def"
+#include "fortran.def"
 
 #ifdef XT3
 
       subroutine acml_st1(x, n1, idir)
 
       implicit none
+#include "fortran_types.def"
 
-      integer :: n1, idir
-      complex :: x(n1)
+      INTG_PREC :: n1, idir
+      CMPLX_PREC :: x(n1)
 
-      real*4 :: factor
-      real*4 :: scale
+      REAL*4 :: factor
+      REAL*4 :: scale
       complex*8, allocatable :: work(:)
 
       integer*4 :: nwork, jdir
 
       if( idir == -1 ) then
         do i = 1, n1
-          x(i) = x(i) * sqrt(real(n1))
+          x(i) = x(i) * sqrt(REAL(n1,RKIND))
         end do
       else
         do i = 1, n1
-          x(i) = x(i) / sqrt(real(n1))
+          x(i) = x(i) / sqrt(REAL(n1,RKIND))
         end do
       end if
 
       subroutine acml_st1(x, n1, idir)
 
       implicit none
+#include "fortran_types.def"
 
-      integer :: n1, idir
-      complex :: x(n1)
+      INTG_PREC :: n1, idir
+      CMPLX_PREC :: x(n1)
 
-      real*8 :: factor
-      real*8 :: scale
+      REAL*8 :: factor
+      REAL*8 :: scale
       complex*16, allocatable :: work(:)
 
       integer*4 :: nwork, jdir
 
       if( idir == -1 ) then
         do i = 1, n1
-          x(i) = x(i) * sqrt(real(n1))
+          x(i) = x(i) * sqrt(REAL(n1,RKIND))
         end do
       else
         do i = 1, n1
-          x(i) = x(i) / sqrt(real(n1))
+          x(i) = x(i) / sqrt(REAL(n1,RKIND))
         end do
       end if
 
       subroutine acml_st1(x, n1, idir)
 
       implicit none
+#include "fortran_types.def"
 
-      integer n1, idir
-      complex x(n1)
+      INTG_PREC n1, idir
+      CMPLX_PREC x(n1)
 
       write(0,'("ACML stride 1 FFT error")')
       ERROR_MESSAGE

File src/enzo/calc_dt.F

+#include "fortran.def"
 c=======================================================================
 c////////////////////////  SUBROUTINE CALC_DT  \\\\\\\\\\\\\\\\\\\\\\\\\
 c
      &                   dx, dy, dz, vgx, vgy, vgz, gamma, ipfree, aye,
      &                   d, p, u, v, w, dt, dtviscous)
 #ifndef CONFIG_PFLOAT_16
-#include "fortran.def"
 c
 c  COMPUTES TIME STEP FOR NEXT CYCLE
 c
 c-----------------------------------------------------------------------
 c
       implicit NONE
+#include "fortran_types.def"
 c
 c     Arguments
 c
-      integer idim, jdim, kdim, i1, i2, j1, j2, k1, k2, rank, ipfree,
+      INTG_PREC idim, jdim, kdim, i1, i2, j1, j2, k1, k2, rank, ipfree,
      &        ihydro
-      REALSUB dx(idim), dy(jdim), dz(kdim)
-      real    dt, vgx, vgy, vgz, gamma, aye, C2, dtviscous
-      real    d(idim,jdim,kdim), p(idim,jdim,kdim), u(idim,jdim,kdim),
+      P_PREC dx(idim), dy(jdim), dz(kdim)
+      R_PREC    dt, vgx, vgy, vgz, gamma, aye, C2, dtviscous
+      R_PREC    d(idim,jdim,kdim), p(idim,jdim,kdim), u(idim,jdim,kdim),
      &        v(idim,jdim,kdim), w(idim,jdim,kdim)
 c
 c     Locals
 c
-      integer i,j,k
-      real    cs, dt1
+      INTG_PREC i,j,k
+      R_PREC    cs, dt1
 c
 c\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\///////////////////////////////////
 c=======================================================================
 c
       if (rank .eq. 1) then
          do i = i1+1, i2+1
-            cs = max(sqrt(gamma*p(i,1,1)/d(i,1,1)), tiny)
+            cs = max(sqrt(gamma*p(i,1,1)/d(i,1,1)), REAL(tiny,RKIND))
             if (ipfree .eq. 1) cs = tiny
-            dt = min(dt, real(dx(i)*aye/(cs + abs(u(i,1,1)-vgx))))
+            dt = min(dt, REAL(dx(i)*aye/(cs + abs(u(i,1,1)-vgx)),RKIND))
          enddo
          if (ihydro .eq. 2) then
             do i = i1+1, i2+1
                dtviscous = min(dtviscous,
-     &     real(dx(i)*aye/(4.d0*C2*max(-u(i+1,1,1)+u(i,1,1),tiny))))
+     &              REAL(dx(i)*aye/(4._RKIND*C2*
+     &              max(-u(i+1,1,1)+u(i,1,1),REAL(tiny,RKIND))),
+     &              RKIND))
             enddo
          endif
       endif
       if (rank .eq. 2) then
          do j = j1+1, j2+1
             do i = i1+1, i2+1
-               cs = max(sqrt(gamma*p(i,j,1)/d(i,j,1)), tiny)
+               cs = max(sqrt(gamma*p(i,j,1)/d(i,j,1)), 
+     &              REAL(tiny,RKIND))
                if (ipfree .eq. 1) cs = tiny