diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index d2a5b05e6522074b2500c6902501bc488b29c4e7..b7686962ca5cf08e65b81f7a756e6901aea622be 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -96,6 +96,7 @@ END MODULE MODI_FLASH_GEOM_ELEC_n
! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics!!
! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 19/04/2019: use modd_precision kinds
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -2067,6 +2068,8 @@ END SUBROUTINE CHARGE_POCKET
!* 0. DECLARATIONS
! ------------
!
+use modd_precision, only: MNHINT64, MNHINT64_MPI
+
IMPLICIT NONE
!
!* 0.1 declaration of dummy arguments
@@ -2086,10 +2089,10 @@ LOGICAL :: GRANDOM ! T = the gridpoints are chosen randomly
INTEGER, DIMENSION(NPROC) :: INBPT_PROC
REAL, DIMENSION(:), ALLOCATABLE :: ZAUX
!
-INTEGER*8, DIMENSION(:), ALLOCATABLE :: I8VECT , I8VECT_LL
-INTEGER , DIMENSION(:), ALLOCATABLE :: IRANK , IRANK_LL , IORDER_LL
-INTEGER :: JI,JJ,JK,JIL , ICHOICE,IPOINT
-INTEGER, DIMENSION(NPROC+1) :: IDISPL
+INTEGER :: JI,JJ,JK,JIL , ICHOICE,IPOINT
+INTEGER, DIMENSION(NPROC+1) :: IDISPL
+INTEGER(kind=MNHINT64), DIMENSION(:), ALLOCATABLE :: I8VECT , I8VECT_LL
+INTEGER, DIMENSION(:), ALLOCATABLE :: IRANK , IRANK_LL , IORDER_LL
!
!
!
@@ -2175,8 +2178,8 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
ALLOCATE(I8VECT_LL(IPT_DIST_GLOB))
ALLOCATE(IRANK_LL(IPT_DIST_GLOB))
ALLOCATE(IORDER_LL(IPT_DIST_GLOB))
- CALL MPI_ALLGATHERV(I8VECT,IPT_DIST, MPI_INTEGER8,I8VECT_LL , &
- INBPT_PROC, IDISPL, MPI_INTEGER8, NMNH_COMM_WORLD, IERR)
+ CALL MPI_ALLGATHERV(I8VECT,IPT_DIST, MNHINT64_MPI,I8VECT_LL , &
+ INBPT_PROC, IDISPL, MNHINT64_MPI, NMNH_COMM_WORLD, IERR)
CALL MPI_ALLGATHERV(IRANK,IPT_DIST, MPI_INTEGER,IRANK_LL , &
INBPT_PROC, IDISPL, MPI_INTEGER, NMNH_COMM_WORLD, IERR)
CALL N8QUICK_SORT(I8VECT_LL, IORDER_LL)
@@ -2198,7 +2201,7 @@ DO WHILE (IM .LE. IDELTA_IND .AND. ISTOP .NE. 1)
!print*,"OUT => I8VECT_LL(ICHOICE)=",I8VECT_ll(ICHOICE),JI,JJ,JK,ICHOICE
ZFLASH(JI,JJ,JK,IL) = 2.
END IF
- I8VECT_LL(ICHOICE) = 0.
+ I8VECT_LL(ICHOICE) = 0
ENDIF
END DO
END DO
@@ -2622,9 +2625,11 @@ RECURSIVE SUBROUTINE N8QUICK_SORT(PLIST, KORDER)
! Modified by Alan Miller to include an associated integer array which gives
! the positions of the elements in the original order.
!
+use modd_precision, only: MNHINT64
+
IMPLICIT NONE
!
-INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST
+INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST
INTEGER, DIMENSION (:), INTENT(OUT) :: KORDER
!
! Local variable
@@ -2642,13 +2647,18 @@ END SUBROUTINE N8QUICK_SORT
!
RECURSIVE SUBROUTINE N8QUICK_SORT_1(KLEFT_END, KRIGHT_END, PLIST1, KORDER1)
-INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
-INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST1
-INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER1
+use modd_precision, only: MNHINT64
+
+implicit none
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER(kind=MNHINT64), DIMENSION (:), INTENT(INOUT) :: PLIST1
+INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER1
! Local variables
-INTEGER :: JI, JJ, ITEMP
-INTEGER*8 :: ZREF, ZTEMP
-INTEGER, PARAMETER :: IMAX_SIMPLE_SORT_SIZE = 6
+INTEGER, PARAMETER :: IMAX_SIMPLE_SORT_SIZE = 6
+
+INTEGER :: JI, JJ, ITEMP
+INTEGER(kind=MNHINT64) :: ZREF, ZTEMP
IF (KRIGHT_END < KLEFT_END + IMAX_SIMPLE_SORT_SIZE) THEN
! Use interchange sort for small PLISTs
@@ -2691,8 +2701,8 @@ ELSE
END IF
END DO
- IF (KLEFT_END < JJ) CALL N8QUICK_SORT_1(KLEFT_END, JJ, PLIST1, KORDER1)
- IF (JI < KRIGHT_END) CALL N8QUICK_SORT_1(JI, KRIGHT_END,PLIST1,KORDER1)
+ IF ( KLEFT_END < JJ ) CALL N8QUICK_SORT_1( KLEFT_END, JJ, PLIST1, KORDER1 )
+ IF ( JI < KRIGHT_END ) CALL N8QUICK_SORT_1( JI, KRIGHT_END, PLIST1, KORDER1 )
END IF
END SUBROUTINE N8QUICK_SORT_1
@@ -2701,12 +2711,16 @@ END SUBROUTINE N8QUICK_SORT_1
!
SUBROUTINE N8INTERCHANGE_SORT(KLEFT_END, KRIGHT_END, PLIST2, KORDER2)
-INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
-INTEGER*8, DIMENSION (:), INTENT(INOUT) :: PLIST2
-INTEGER, DIMENSION (:), INTENT(INOUT) :: KORDER2
+use modd_precision, only: MNHINT64
+
+implicit none
+
+INTEGER, INTENT(IN) :: KLEFT_END, KRIGHT_END
+INTEGER(kind=MNHINT64), DIMENSION(:), INTENT(INOUT) :: PLIST2
+INTEGER, DIMENSION(:), INTENT(INOUT) :: KORDER2
! Local variables
-INTEGER :: JI, JJ, ITEMP
-INTEGER*8 :: ZTEMP
+INTEGER :: JI, JJ, ITEMP
+INTEGER(kind=MNHINT64) :: ZTEMP
! boucle sur tous les points
DO JI = KLEFT_END, KRIGHT_END - 1
@@ -2738,10 +2752,12 @@ END SUBROUTINE N8INTERCHANGE_SORT
!-------------------------------------------------------------------------------
SUBROUTINE MNH_RANDOM_NUMBER(ZRANDOM)
- REAL :: ZRANDOM
- INTEGER ,SAVE :: NSEED_MNH = 26032012
+ use modd_precision, only: MNHINT32
+
+ REAL :: ZRANDOM
+ INTEGER(kind=MNHINT32), SAVE :: NSEED_MNH = 26032012_MNHINT32
- ZRANDOM = r8_uniform_01 (NSEED_MNH)
+ ZRANDOM = real( r8_uniform_01( NSEED_MNH ), kind(ZRANDOM) )
END SUBROUTINE MNH_RANDOM_NUMBER
@@ -2820,37 +2836,39 @@ END SUBROUTINE N8INTERCHANGE_SORT
!
! Parameters:
!
- ! Input/output, integer ( kind = 4 ) SEED, the "seed" value, which should
+ ! Input/output, integer ( kind = MNHINT32 ) SEED, the "seed" value, which should
! NOT be 0. On output, SEED has been updated.
!
- ! Output, real ( kind = 8 ) R8_UNIFORM_01, a new pseudorandom variate,
+ ! Output, real ( kind = MNHREAL64 ) R8_UNIFORM_01, a new pseudorandom variate,
! strictly between 0 and 1.
!
- use mode_msg
+ use modd_precision, only: MNHINT32, MNHREAL64
+
+ implicit none
- IMPLICIT NONE
+ integer(kind = MNHINT32), intent(inout) :: seed
+ real(kind=MNHREAL64) :: r8_uniform_01
- INTEGER ( kind = 4 ), PARAMETER :: i4_huge = 2147483647
- INTEGER ( kind = 4 ) k
- REAL r8_uniform_01
- INTEGER ( kind = 4 ) seed
+ integer(kind = MNHINT32), parameter :: i4_huge = 2147483647_MNHINT32
- IF ( seed == 0 ) THEN
+ integer(kind = MNHINT32) :: k
+
+ if ( seed == 0_MNHINT32 ) THEN
call Print_msg( NVERB_FATAL, 'GEN', 'r8_uniform_01', 'seed dummy argument must be different of 0' )
- END IF
+ end if
- k = seed / 127773
+ k = seed / 127773_MNHINT32
- seed = 16807 * ( seed - k * 127773 ) - k * 2836
+ seed = 16807_MNHINT32 * ( seed - k * 127773_MNHINT32 ) - k * 2836_MNHINT32
- IF ( seed < 0 ) THEN
+ if ( seed < 0_MNHINT32 ) then
seed = seed + i4_huge
- END IF
+ end if
- r8_uniform_01 = REAL ( seed ) * 4.656612875D-10
+ r8_uniform_01 = real(seed) * 4.656612875d-10
- RETURN
- END FUNCTION r8_uniform_01
+ return
+ end function r8_uniform_01
!
END SUBROUTINE FLASH_GEOM_ELEC_n
!
diff --git a/src/MNH/isocom.f b/src/MNH/isocom.f
index f61d7aa0a2b4521278f97dbd00241fc8c7f32ca8..b02dbe9f597d2c93ca9f49458d7dfb825558f88c 100644
--- a/src/MNH/isocom.f
+++ b/src/MNH/isocom.f
@@ -13,7 +13,7 @@ C ======================== ARGUMENTS / USAGE ===========================
C
C INPUT:
C 1. [WI]
-C REAL*8 array of length [5].
+C REAL(kind(0.0d0)) array of length [5].
C Concentrations, expressed in moles/m3. Depending on the type of
C problem solved (specified in CNTRL(1)), WI contains either
C GAS+AEROSOL or AEROSOL only concentratios.
@@ -24,15 +24,15 @@ C WI(4) - nitrate
C WI(5) - chloride
C
C 2. [RHI]
-C REAL*8 variable.
+C REAL(kind(0.0d0)) variable.
C Ambient relative humidity expressed on a (0,1) scale.
C
C 3. [TEMPI]
-C REAL*8 variable.
+C REAL(kind(0.0d0)) variable.
C Ambient temperature expressed in Kelvins.
C
C 4. [CNTRL]
-C REAL*8 array of length [2].
+C REAL(kind(0.0d0)) array of length [2].
C Parameters that control the type of problem solved.
C
C CNTRL(1): Defines the type of problem solved.
@@ -47,7 +47,7 @@ C 1 - The aerosol is in only liquid state (metastable aerosol)
C
C OUTPUT:
C 1. [WT]
-C REAL*8 array of length [5].
+C REAL(kind(0.0d0)) array of length [5].
C Total concentrations (GAS+AEROSOL) of species, expressed in moles/m3.
C If the foreward probelm is solved (CNTRL(1)=0), array WT is
C identical to array WI.
@@ -58,14 +58,14 @@ C WT(4) - total nitrate
C WT(5) - total chloride
C
C 2. [GAS]
-C REAL*8 array of length [03].
+C REAL(kind(0.0d0)) array of length [03].
C Gaseous species concentrations, expressed in moles/m3.
C GAS(1) - NH3
C GAS(2) - HNO3
C GAS(3) - HCl
C
C 3. [AERLIQ]
-C REAL*8 array of length [11].
+C REAL(kind(0.0d0)) array of length [11].
C Liquid aerosol species concentrations, expressed in moles/m3.
C AERLIQ(01) - H+(aq)
C AERLIQ(02) - Na+(aq)
@@ -81,7 +81,7 @@ C AERLIQ(11) - HNO3(aq) (undissociated)
C AERLIQ(12) - OH-(aq)
C
C 4. [AERSLD]
-C REAL*8 array of length [09].
+C REAL(kind(0.0d0)) array of length [09].
C Solid aerosol species concentrations, expressed in moles/m3.
C AERSLD(01) - NaNO3(s)
C AERSLD(02) - NH4NO3(s)
@@ -98,7 +98,7 @@ C CHARACTER(len=15) variable.
C Returns the subcase which the input corresponds to.
C
C 6. [OTHER]
-C REAL*8 array of length [6].
+C REAL(kind(0.0d0)) array of length [6].
C Returns solution information.
C
C OTHER(1): Shows if aerosol water exists.
@@ -126,6 +126,7 @@ C
C Modifications:
C P. Wautelet 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q
C P. Wautelet 22/01/2019: replace obsolete SNGL intrinsics by REAL intrinsics
+C P. Wautelet 19/04/2019: use kind(0.0d0) instead of kind=8
C=======================================================================
C
SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL,
@@ -280,7 +281,7 @@ C Defines the maximum number of iterations for activity coefficient
C calculations.
C
C 6. [EPSACTI]
-C REAL*8 variable.
+C REAL(kind(0.0d0)) variable.
C Defines the convergence criterion for activity coefficient
C calculations.
C
@@ -1379,12 +1380,12 @@ C *** WRITTEN BY ATHANASIOS NENES
C
C=======================================================================
C
-C REAL*8 FUNCTION GETASR (SO4I, RHI)
+C REAL(kind(0.0d0)) FUNCTION GETASR (SO4I, RHI)
FUNCTION GETASR (SO4I, RHI)
PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS)
COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S)
- REAL*8 SO4I, RHI
- REAL*8 GETASR
+ REAL(kind(0.0d0)) SO4I, RHI
+ REAL(kind(0.0d0)) GETASR
CCC
CCC *** SOLVE USING FULL COMPUTATIONS, NOT LOOK-UP TABLES **************
CCC
@@ -1531,7 +1532,7 @@ C=======================================================================
C
SUBROUTINE CALCHA
INCLUDE 'isrpia.inc'
- REAL*8 KAPA
+ REAL(kind(0.0d0)) KAPA
CC CHARACTER ERRINF*40
C
C *** CALCULATE HCL DISSOLUTION *****************************************
@@ -1628,7 +1629,7 @@ C=======================================================================
C
SUBROUTINE CALCNA
INCLUDE 'isrpia.inc'
- REAL*8 KAPA
+ REAL(kind(0.0d0)) KAPA
CC CHARACTER ERRINF*40
C
C *** CALCULATE HNO3 DISSOLUTION ****************************************
@@ -1809,7 +1810,7 @@ C=======================================================================
C
SUBROUTINE CALCNHA
INCLUDE 'isrpia.inc'
- REAL*8 M1, M2, M3
+ REAL(kind(0.0d0)) M1, M2, M3
CHARACTER ERRINF*40
C
C *** SPECIAL CASE; WATER=ZERO ******************************************
@@ -1968,7 +1969,7 @@ C=======================================================================
C
SUBROUTINE CALCAMAQ (NH4I, OHI, DELT)
INCLUDE 'isrpia.inc'
- REAL*8 NH4I
+ REAL(kind(0.0d0)) NH4I
CC CHARACTER ERRINF*40
C
C *** EQUILIBRIUM CONSTANTS
@@ -2028,7 +2029,7 @@ C=======================================================================
C
SUBROUTINE CALCAMAQ2 (GGNH3, NH4I, OHI, NH3AQ)
INCLUDE 'isrpia.inc'
- REAL*8 NH4I, NH3AQ
+ REAL(kind(0.0d0)) NH4I, NH3AQ
C
C *** EQUILIBRIUM CONSTANTS
C
@@ -2072,7 +2073,7 @@ C=======================================================================
C
SUBROUTINE CALCCLAQ (CLI, HI, DELT)
INCLUDE 'isrpia.inc'
- REAL*8 CLI
+ REAL(kind(0.0d0)) CLI
C
C *** EQUILIBRIUM CONSTANTS
C
@@ -2123,7 +2124,7 @@ C=======================================================================
C
SUBROUTINE CALCCLAQ2 (GGCL, CLI, HI, CLAQ)
INCLUDE 'isrpia.inc'
- REAL*8 CLI
+ REAL(kind(0.0d0)) CLI
C
C *** EQUILIBRIUM CONSTANTS
C
@@ -2166,7 +2167,7 @@ C=======================================================================
C
SUBROUTINE CALCNIAQ (NO3I, HI, DELT)
INCLUDE 'isrpia.inc'
- REAL*8 NO3I
+ REAL(kind(0.0d0)) NO3I
C
C *** EQUILIBRIUM CONSTANTS
C
@@ -2220,7 +2221,7 @@ C=======================================================================
C
SUBROUTINE CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)
INCLUDE 'isrpia.inc'
- REAL*8 NO3I, NO3AQ
+ REAL(kind(0.0d0)) NO3I, NO3AQ
C
C *** EQUILIBRIUM CONSTANTS
C
@@ -2816,7 +2817,7 @@ C
C
REAL EX10, URF
REAL G0(3,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4)
- REAL*8 MPL, XIJ, YJI
+ REAL(kind(0.0d0)) MPL, XIJ, YJI
PARAMETER (URF=0.5)
C
G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H
@@ -3591,8 +3592,8 @@ CC Author : Athanasios Nenes
CC
CC ======================= ARGUMENTS / USAGE =============================
CC
-CC VAR is the REAL*8 variable which value is to be saved
-CC DEF is a REAL*8 variable, with the default value of VAR.
+CC VAR is the REAL(kind(0.0d0)) variable which value is to be saved
+CC DEF is a REAL(kind(0.0d0)) variable, with the default value of VAR.
CC PROMPT is a CHARACTER varible containing the prompt string.
CC PRFMT is a CHARACTER variable containing the FORMAT specifier
CC for the default value DEF.
@@ -3615,7 +3616,7 @@ CC
CC
CC***********************************************************************
CHARACTER PROMPT*(*), PRFMT*(*), BUFFER*128
- REAL*8 DEF, VAR
+ REAL(kind(0.0d0)) DEF, VAR
INTEGER IERR
C
IERR = 0
@@ -3778,10 +3779,10 @@ C=======================================================================
C
SUBROUTINE POLY3 (A1, A2, A3, ROOT, ISLV)
C
- IMPLICIT REAL*8 (A-H, O-Z)
+ IMPLICIT REAL(kind(0.0d0)) (A-H, O-Z)
PARAMETER (EXPON=1.D0/3.D0, ZERO=0.D0, THET1=120.D0/180.D0,
& THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50)
- REAL*8 X(3)
+ REAL(kind(0.0d0)) X(3)
C
C *** SPECIAL CASE : QUADRATIC*X EQUATION *****************************
C
@@ -3878,7 +3879,7 @@ C=======================================================================
C
SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV)
C
- IMPLICIT REAL*8 (A-H, O-Z)
+ IMPLICIT REAL(kind(0.0d0)) (A-H, O-Z)
PARAMETER (ZERO=0.D0, EPS=1D-15, MAXIT=100, NDIV=5)
C
FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3
@@ -3944,7 +3945,7 @@ C
ccc PROGRAM DRIVER
-ccc REAL*8 ROOT
+ccc REAL(kind(0.0d0)) ROOT
cccC
ccc CALL POLY3 (-1.d0, 1.d0, -1.d0, ROOT, ISLV)
ccc IF (ISLV.NE.0) STOP 'Error in POLY3'
@@ -4093,7 +4094,7 @@ C ======================== ARGUMENTS / USAGE ===========================
C
C INPUT:
C 1. [WI]
-C REAL*8 array of length [5].
+C REAL(kind(0.0d0)) array of length [5].
C Concentrations, expressed in moles/m3. Depending on the type of
C problem solved, WI contains either GAS+AEROSOL or AEROSOL only
C concentratios.
@@ -4104,11 +4105,11 @@ C WI(4) - nitrate
C WI(5) - chloride
C
C 2. [RHI]
-C REAL*8 variable.
+C REAL(kind(0.0d0)) variable.
C Ambient relative humidity expressed in a (0,1) scale.
C
C 3. [TEMPI]
-C REAL*8 variable.
+C REAL(kind(0.0d0)) variable.
C Ambient temperature expressed in Kelvins.
C
C 4. [IPROB]
@@ -4121,14 +4122,14 @@ C contains AEROSOL concentrations only.
C
C OUTPUT:
C 1. [GAS]
-C REAL*8 array of length [03].
+C REAL(kind(0.0d0)) array of length [03].
C Gaseous species concentrations, expressed in moles/m3.
C GAS(1) - NH3
C GAS(2) - HNO3
C GAS(3) - HCl
C
C 2. [AERLIQ]
-C REAL*8 array of length [11].
+C REAL(kind(0.0d0)) array of length [11].
C Liquid aerosol species concentrations, expressed in moles/m3.
C AERLIQ(01) - H+(aq)
C AERLIQ(02) - Na+(aq)
@@ -4143,7 +4144,7 @@ C AERLIQ(10) - HNCl(aq) (undissociated)
C AERLIQ(11) - HNO3(aq) (undissociated)
C
C 3. [AERSLD]
-C REAL*8 array of length [09].
+C REAL(kind(0.0d0)) array of length [09].
C Solid aerosol species concentrations, expressed in moles/m3.
C AERSLD(01) - NaNO3(s)
C AERSLD(02) - NH4NO3(s)
@@ -4439,11 +4440,11 @@ C The size of the error stack (maximum number of errors that can
C be stored before the stack exhausts).
C
C 7. [TIN]
-C REAL*8 variable
+C REAL(kind(0.0d0)) variable
C The value used for a very small number.
C
C 8. [GRT]
-C REAL*8 variable
+C REAL(kind(0.0d0)) variable
C The value used for a very large number.
C
C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
diff --git a/src/MNH/lima_functions.f90 b/src/MNH/lima_functions.f90
index 30fd902b4ef4169f78e2e5a60dca84911d1b7c71..f253b700aa334c5879f149748cf21cfa4e489c00 100644
--- a/src/MNH/lima_functions.f90
+++ b/src/MNH/lima_functions.f90
@@ -4,8 +4,8 @@
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
-! P.Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
-!
+! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
+! P. Wautelet 19/04/2019: use modd_precision kinds
!-----------------------------------------------------------------
!#################################
MODULE MODI_LIMA_FUNCTIONS
@@ -222,13 +222,15 @@ END FUNCTION DELTA_VEC
!###########################
SUBROUTINE gaulag(x,w,n,alf)
!###########################
+ use modd_precision, only: MNHREAL64
+
INTEGER n,MAXIT
REAL alf,w(n),x(n)
- REAL(kind=8) :: EPS
+ REAL(kind=MNHREAL64) :: EPS
PARAMETER (EPS=3.D-14,MAXIT=10)
INTEGER i,its,j
REAL ai
- REAL(kind=8) :: p1,p2,p3,pp,z,z1
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
!
REAL SUMW
!
@@ -277,12 +279,14 @@ END SUBROUTINE gaulag
!##########################################
SUBROUTINE gauher(x,w,n)
!##########################################
+ use modd_precision, only: MNHREAL64
+
INTEGER n,MAXIT
REAL w(n),x(n)
- REAL(kind=8) :: EPS,PIM4
+ REAL(kind=MNHREAL64) :: EPS,PIM4
PARAMETER (EPS=3.D-14,PIM4=.7511255444649425D0,MAXIT=10)
INTEGER i,its,j,m
- REAL(kind=8) :: p1,p2,p3,pp,z,z1
+ REAL(kind=MNHREAL64) :: p1,p2,p3,pp,z,z1
!
REAL SUMW
!
diff --git a/src/MNH/modd_tmat.f90 b/src/MNH/modd_tmat.f90
index b9d6909e525d6d9880d36546ef869aa4ecb16279..a954b1a2f88079802001915892edec33216f6e73 100644
--- a/src/MNH/modd_tmat.f90
+++ b/src/MNH/modd_tmat.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################
MODULE MODD_TMAT
! #################
@@ -28,7 +29,8 @@
!! -------------
!!
!! Original 23/03/2010
-!!
+! P. Wautelet 19/04/2019: use kind(0.0d0) instead of kind=8
+!
!-------------------------------------------------------------------------------
!
@@ -57,16 +59,16 @@ REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: XIT21,XIT22
!COMMON /CT/ dimensions : (NPN2,NPN2)
-REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE,SAVE :: XTR1,XTI1
+REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE,SAVE :: XTR1,XTI1
!COMMON /CTT/ dimensions : (NPN2,NPN2)
-REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE,SAVE :: XQR,XQI,XRGQR,XRGQI
+REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE,SAVE :: XQR,XQI,XRGQR,XRGQI
!
!COMMON /CBESS/ dimensions (NPNG2,NPN1)
-REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE,SAVE ::XJ,XY,XJR,XJI,XDJ
-REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE,SAVE ::XDJR,XDJI,XDY
+REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE,SAVE ::XJ,XY,XJR,XJI,XDJ
+REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE,SAVE ::XDJR,XDJI,XDY
END MODULE MODD_TMAT
diff --git a/src/MNH/mode_datetime.f90 b/src/MNH/mode_datetime.f90
index 2684e11d48a4426dea6321524ba93edc6ebe080a..b6547cfa9cb7714be3b7c73a5d0f12d9b1398777 100644
--- a/src/MNH/mode_datetime.f90
+++ b/src/MNH/mode_datetime.f90
@@ -5,6 +5,7 @@
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
+! P. Wautelet 19/04/2019: use modd_precision kinds
!-----------------------------------------------------------------
MODULE MODE_DATETIME
!
@@ -38,29 +39,31 @@ SUBROUTINE DATETIME_TIME2REFERENCE(TPDATE,PDIST)
!
!Compute number of seconds since reference date (and time)
!
+use modd_precision, only: MNHINT64
+
TYPE(DATE_TIME), INTENT(IN) :: TPDATE
REAL, INTENT(OUT) :: PDIST
!
-INTEGER(KIND=8) :: ILEAPS !Number of leap days
-INTEGER(KIND=8) :: IDAYS !Number of days since reference date
-INTEGER(KIND=8) :: IYEARS !Number of years since reference date
-INTEGER(KIND=8) :: IDAY_CUR, IMONTH_CUR, IYEAR_CUR !Currrent day, month and year
-REAL :: ZSEC !Current time of the day (in seconds)
-TYPE(DATE_TIME) :: TZDATE
+INTEGER(KIND=MNHINT64) :: ILEAPS !Number of leap days
+INTEGER(KIND=MNHINT64) :: IDAYS !Number of days since reference date
+INTEGER(KIND=MNHINT64) :: IYEARS !Number of years since reference date
+INTEGER(KIND=MNHINT64) :: IDAY_CUR, IMONTH_CUR, IYEAR_CUR !Currrent day, month and year
+REAL :: ZSEC !Current time of the day (in seconds)
+TYPE(DATE_TIME) :: TZDATE
!
-ILEAPS = 0
-IDAYS = 0
+ILEAPS = 0_MNHINT64
+IDAYS = 0_MNHINT64
!
TZDATE = TPDATE
CALL DATETIME_CORRECTDATE(TZDATE)
!
-IYEAR_CUR = TZDATE%TDATE%YEAR
-IMONTH_CUR = TZDATE%TDATE%MONTH
-IDAY_CUR = TZDATE%TDATE%DAY
+IYEAR_CUR = int( TZDATE%TDATE%YEAR, kind=MNHINT64 )
+IMONTH_CUR = int( TZDATE%TDATE%MONTH, kind=MNHINT64 )
+IDAY_CUR = int( TZDATE%TDATE%DAY, kind=MNHINT64 )
ZSEC = TZDATE%TIME
!
!Compute number of days since beginning of the year
-IF ( ((MOD(IYEAR_CUR,4_8)==0).AND.(MOD(IYEAR_CUR,100_8)/=0)) .OR. (MOD(IYEAR_CUR,400_8)==0)) ILEAPS=1
+IF ( ((MOD(IYEAR_CUR,4_MNHINT64)==0).AND.(MOD(IYEAR_CUR,100_MNHINT64)/=0)) .OR. (MOD(IYEAR_CUR,400_MNHINT64)==0)) ILEAPS=1
SELECT CASE(IMONTH_CUR)
CASE(1)
IDAYS = IDAY_CUR-1
@@ -88,8 +91,8 @@ SELECT CASE(IMONTH_CUR)
IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31+30+31+30
END SELECT
!
-IYEARS = IYEAR_CUR-TPREFERENCE_DATE%TDATE%YEAR
-IF (IYEARS<0) THEN
+IYEARS = IYEAR_CUR - int( TPREFERENCE_DATE%TDATE%YEAR, kind=MNHINT64 )
+IF ( IYEARS < 0_MNHINT64 ) THEN
CALL PRINT_MSG(NVERB_WARNING,'GEN','DATETIME_TIME2REFERENCE', &
'input year is smaller than reference year => result could be invalid')
END IF
diff --git a/src/MNH/mode_tmat.f90 b/src/MNH/mode_tmat.f90
index 9de6651339a1a9b187f10cde8f36629bf357b551..6c22fdabbe8eecbd80297423af55e4db1c8a246c 100644
--- a/src/MNH/mode_tmat.f90
+++ b/src/MNH/mode_tmat.f90
@@ -2,7 +2,7 @@
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
+!-------------------------------------------------------------------------------
! algorithme initial créé par Michael Mishchenko (2000)
!
! algorithme modifié par Corinne Burlaud (2000) puis Olivier Brunau (2002)
@@ -18,6 +18,7 @@
! P. Wautelet 22/01/2019: replace double precision declarations by real(kind(0.0d0)) (to allow compilation by NAG compiler)
! P. Wautelet 22/02/2019: add kind parameter for CMPLX intrinsics (if not it default to single precision)
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 19/04/2019: use kind(0.0d0) instead of kind=8
!
!****************************************************************************
@@ -296,7 +297,7 @@
use mode_msg
- IMPLICIT REAL*8 (A-H,O-Z)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1, NPN2=2*NPN1,&
!! NPN4=NPN1, NPN6=NPN4+1)
@@ -304,32 +305,32 @@
INTEGER param,oscil
- REAL*8 SIGBETA,Fbeta
- REAL*8 PDtotal,PDalpha,PDbeta,Poids
+ REAL(kind(0.0d0)) SIGBETA,Fbeta
+ REAL(kind(0.0d0)) PDtotal,PDalpha,PDbeta,Poids
- REAL*8 LAM,MRR,MRI,Deq,X(NPNG2),W(NPNG2),S(NPNG2),SS(NPNG2),&
+ REAL(kind(0.0d0)) LAM,MRR,MRI,Deq,X(NPNG2),W(NPNG2),S(NPNG2),SS(NPNG2),&
AN(NPN1),R(NPNG2),DR(NPNG2),&
DDR(NPNG2),DRR(NPNG2),DRI(NPNG2),ANN(NPN1,NPN1)
- REAL*8 NUMZ,DENZ,NUMTZ,DENTZ,ZDRT,NTotal
- REAL*8 NUMD,DEND,DELTA,NUMTD,DENTD,DELTAT
- REAL*8 PAS,KDP
+ REAL(kind(0.0d0)) NUMZ,DENZ,NUMTZ,DENTZ,ZDRT,NTotal
+ REAL(kind(0.0d0)) NUMD,DEND,DELTA,NUMTD,DENTD,DELTAT
+ REAL(kind(0.0d0)) PAS,KDP
- REAL*8 THET0,THET,Elev,AXI
+ REAL(kind(0.0d0)) THET0,THET,Elev,AXI
- REAL*8 MYS11cr,MYS22cr
+ REAL(kind(0.0d0)) MYS11cr,MYS22cr
-!! REAL*8 TR1(NPN2,NPN2),TI1(NPN2,NPN2)
+!! REAL(kind(0.0d0)) TR1(NPN2,NPN2),TI1(NPN2,NPN2)
!! REAL*4 RT11(NPN6,NPN4,NPN4),RT12(NPN6,NPN4,NPN4),&
!! RT21(NPN6,NPN4,NPN4),RT22(NPN6,NPN4,NPN4),&
! ! IT11(NPN6,NPN4,NPN4),IT12(NPN6,NPN4,NPN4),&
!! IT21(NPN6,NPN4,NPN4),IT22(NPN6,NPN4,NPN4)
- COMPLEX*16 S11,S12,S21,S22
- COMPLEX*16 S11u,S12u,S21u,S22u
+ COMPLEX(kind(0.0d0)) S11,S12,S21,S22
+ COMPLEX(kind(0.0d0)) S11u,S12u,S21u,S22u
- REAL*8 S11carre,S22carre
- COMPLEX*16 NUMrhoAB,NUMTrhoAB
+ REAL(kind(0.0d0)) S11carre,S22carre
+ COMPLEX(kind(0.0d0)) NUMrhoAB,NUMTrhoAB
!! COMMON /CT/ TR1,TI1
!! COMMON /TMAT/ RT11,RT12,RT21,RT22,IT11,IT12,IT21,IT22
@@ -1171,17 +1172,17 @@
!c INCLUDE 'ampld.par.f'
!! Parameter (NPN1=200,NPN4=NPN1, NPN6=NPN4+1)
- IMPLICIT REAL*8 (A-B,D-H,O-Z), COMPLEX*16 (C)
- REAL*8 AL(3,2),AL1(3,2),AP(2,3),AP1(2,3),B(3,3),&
+ IMPLICIT REAL(kind(0.0d0)) (A-B,D-H,O-Z), COMPLEX(kind(0.0d0)) (C)
+ REAL(kind(0.0d0)) AL(3,2),AL1(3,2),AP(2,3),AP1(2,3),B(3,3),&
R(2,2),R1(2,2),C(3,2),CA,CB,CT,CP,CTP,CPP,CT1,CP1,&
CTP1,CPP1
-!C REAL*8 ZDR,NUM,DEN
- REAL*8 DV1(NPN6),DV2(NPN6),DV01(NPN6),DV02(NPN6)
+!C REAL(kind(0.0d0)) ZDR,NUM,DEN
+ REAL(kind(0.0d0)) DV1(NPN6),DV2(NPN6),DV01(NPN6),DV02(NPN6)
!! REAL*4 TR11(NPN6,NPN4,NPN4),TR12(NPN6,NPN4,NPN4),&
!! TR21(NPN6,NPN4,NPN4),TR22(NPN6,NPN4,NPN4),&
!! TI11(NPN6,NPN4,NPN4),TI12(NPN6,NPN4,NPN4),&
!! TI21(NPN6,NPN4,NPN4),TI22(NPN6,NPN4,NPN4)
- COMPLEX*16 CAL(NPN4,NPN4),VV,VH,HV,HH
+ COMPLEX(kind(0.0d0)) CAL(NPN4,NPN4),VV,VH,HV,HH
!! COMMON /TMAT/ TR11,TR12,TR21,TR22,TI11,TI12,TI21,TI22
IF (ALPHA.LT.0D0.OR.ALPHA.GT.360D0.OR.&
@@ -1477,8 +1478,8 @@
USE MODD_TMAT, ONLY: NPN1,NPN4,NPN6
!! Parameter (NPN1=200,NPN4=NPN1, NPN6=NPN4+1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 DV1(NPN6), DV2(NPN6)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) DV1(NPN6), DV2(NPN6)
DO N=1,NMAX
DV1(N)=0D0
@@ -1550,9 +1551,9 @@
SUBROUTINE CONST(NGAUSS,NMAX,X,W,AN,ANN,S,SS)
USE MODD_TMAT, ONLY: NPN1,NPNG1,NPNG2
- IMPLICIT REAL*8 (A-H,O-Z)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1)
- REAL*8 X(NPNG2),W(NPNG2),&
+ REAL(kind(0.0d0)) X(NPNG2),W(NPNG2),&
S(NPNG2),SS(NPNG2),&
AN(NPN1),ANN(NPN1,NPN1),DD(NPN1)
@@ -1592,8 +1593,8 @@
USE MODD_TMAT, ONLY: NPN1,NPNG1,NPNG2
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 X(NPNG2),R(NPNG2),DR(NPNG2),MRR,MRI,LAM,&
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) X(NPNG2),R(NPNG2),DR(NPNG2),MRR,MRI,LAM,&
Z(NPNG2),ZR(NPNG2),ZI(NPNG2),&
DDR(NPNG2),DRR(NPNG2),DRI(NPNG2)
@@ -1648,8 +1649,8 @@
!C**********************************************************************
SUBROUTINE RSP1(X,NG,NGAUSS,REV,EPS,R,DR)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 X(NG),R(NG),DR(NG)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) X(NG),R(NG),DR(NG)
A=REV*EPS**(1D0/3D0)
AA=A*A
@@ -1678,8 +1679,8 @@
USE MODD_TMAT,ONLY : XJ,XY,XJR,XJI,XDJ,XDY,XDJR,XDJI,NPN1,NPNG1,NPNG2
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 X(NG),XR(NG),XI(NG),&
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) X(NG),XR(NG),XI(NG),&
!! J(NPNG2,NPN1),Y(NPNG2,NPN1),JR(NPNG2,NPN1),&
!! JI(NPNG2,NPN1),DJ(NPNG2,NPN1),DY(NPNG2,NPN1),&
!! DJR(NPNG2,NPN1),DJI(NPNG2,NPN1),&
@@ -1717,8 +1718,8 @@
!C**********************************************************************
SUBROUTINE RJB(X,Y,U,NMAX,NNMAX)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 Y(NMAX),U(NMAX),Z(800)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) Y(NMAX),U(NMAX),Z(800)
L=NMAX+NNMAX
XX=1D0/X
@@ -1749,8 +1750,8 @@
!C**********************************************************************
SUBROUTINE RYB(X,Y,V,NMAX)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 Y(NMAX),V(NMAX)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) Y(NMAX),V(NMAX)
C=COS(X)
S=SIN(X)
@@ -1787,9 +1788,9 @@
USE MODD_TMAT,ONLY:NPN1
!! Parameter (NPN1=200)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 YR(NMAX),YI(NMAX),UR(NMAX),UI(NMAX)
- REAL*8 CYR(NPN1),CYI(NPN1),CZR(1200),CZI(1200)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) YR(NMAX),YI(NMAX),UR(NMAX),UI(NMAX)
+ REAL(kind(0.0d0)) CYR(NPN1),CYI(NPN1),CZR(1200),CZI(1200)
L=NMAX+NNMAX
XRXI=1D0/(XR*XR+XI*XI)
@@ -1869,8 +1870,8 @@
NPN1,NPNG1,NPNG2,NPN2,NPN4,NPN6
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1, NPN2=2*NPN1,&
!! NPN4=NPN1,NPN6=NPN4+1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 X(NPNG2),W(NPNG2),AN(NPN1),&
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) X(NPNG2),W(NPNG2),AN(NPN1),&
R(NPNG2),DR(NPNG2),SIG(NPN2),&
!! J(NPNG2,NPN1),Y(NPNG2,NPN1),&
!! JR(NPNG2,NPN1),JI(NPNG2,NPN1),DJ(NPNG2,NPN1),&
@@ -1880,12 +1881,12 @@
D1(NPNG2,NPN1),D2(NPNG2,NPN1),&
DRI(NPNG2),RR(NPNG2),&
DV1(NPN1),DV2(NPN1)
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: R11,R12,R21,R22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: I11,I12,I21,I22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: RG11,RG12,RG21,RG22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: IG11,IG12,IG21,IG22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: R11,R12,R21,R22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: I11,I12,I21,I22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: RG11,RG12,RG21,RG22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: IG11,IG12,IG21,IG22
- REAL*8 ANN(NPN1,NPN1),&
+ REAL(kind(0.0d0)) ANN(NPN1,NPN1),&
!! QR(NPN2,NPN2),QI(NPN2,NPN2),&
!! RGQR(NPN2,NPN2),RGQI(NPN2,NPN2),&
TQR(NPN2,NPN2),TQI(NPN2,NPN2),&
@@ -2129,8 +2130,8 @@ DEALLOCATE(IG22)
!c INCLUDE 'ampld.par.f'
!! Parameter (NPN1=200, NPNG1=600, NPNG2=2*NPNG1, NPN2=2*NPN1, &
!! NPN4=NPN1, NPN6=NPN4+1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 X(NPNG2),W(NPNG2),AN(NPN1),S(NPNG2),SS(NPNG2),&
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) X(NPNG2),W(NPNG2),AN(NPN1),S(NPNG2),SS(NPNG2),&
R(NPNG2),DR(NPNG2),SIG(NPN2),&
!! J(NPNG2,NPN1),Y(NPNG2,NPN1),&
!! JR(NPNG2,NPN1),JI(NPNG2,NPN1),DJ(NPNG2,NPN1),&
@@ -2140,12 +2141,12 @@ DEALLOCATE(IG22)
D1(NPNG2,NPN1),D2(NPNG2,NPN1),&
DRI(NPNG2),DS(NPNG2),DSS(NPNG2),RR(NPNG2),&
DV1(NPN1),DV2(NPN1)
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: R11,R12,R21,R22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: I11,I12,I21,I22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: RG11,RG12,RG21,RG22
- REAL(KIND=8),DIMENSION(:,:),ALLOCATABLE :: IG11,IG12,IG21,IG22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: R11,R12,R21,R22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: I11,I12,I21,I22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: RG11,RG12,RG21,RG22
+ REAL(kind(0.0d0)),DIMENSION(:,:),ALLOCATABLE :: IG11,IG12,IG21,IG22
- REAL*8 ANN(NPN1,NPN1),&
+ REAL(kind(0.0d0)) ANN(NPN1,NPN1),&
!! QR(NPN2,NPN2),QI(NPN2,NPN2),&
!! RGQR(NPN2,NPN2),RGQI(NPN2,NPN2),&
TQR(NPN2,NPN2),TQI(NPN2,NPN2),&
@@ -2458,8 +2459,8 @@ DEALLOCATE(IG22)
USE MODD_TMAT, ONLY:NPN1
!! Parameter (NPN1=200)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 DV1(NPN1),DV2(NPN1)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) DV1(NPN1),DV2(NPN1)
A=1D0
QS=SQRT(1D0-X*X)
@@ -2523,12 +2524,12 @@ DEALLOCATE(IG22)
!! Parameter (NPN1=200, NPN2=2*NPN1)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 F(NPN2,NPN2),&
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) F(NPN2,NPN2),&
!! QR(NPN2,NPN2),QI(NPN2,NPN2),&
!! RGQR(NPN2,NPN2),RGQI(NPN2,NPN2),&
A(NPN2,NPN2),C(NPN2,NPN2),D(NPN2,NPN2),E(NPN2,NPN2)
-!! REAL*8 TR1(NPN2,NPN2),TI1(NPN2,NPN2)
+!! REAL(kind(0.0d0)) TR1(NPN2,NPN2),TI1(NPN2,NPN2)
!c INTEGER IPVT(NPN2)
!! COMMON /CT/ TR1,TI1
!! COMMON /CTT/ QR,QI,RGQR,RGQI
@@ -2587,7 +2588,7 @@ DEALLOCATE(IG22)
!C********************************************************************
SUBROUTINE PROD(A,B,C,NDIM,N)
- REAL*8 A(NDIM,N),B(NDIM,N),C(NDIM,N),cij
+ REAL(kind(0.0d0)) A(NDIM,N),B(NDIM,N),C(NDIM,N),cij
DO I=1,N
DO J=1,N
@@ -2607,9 +2608,9 @@ DEALLOCATE(IG22)
SUBROUTINE INV1(NMAX,F,A)
USE MODD_TMAT,ONLY : NPN1,NPN2
- IMPLICIT REAL*8 (A-H,O-Z)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
!! Parameter (NPN1=200, NPN2=2*NPN1)
- REAL*8 A(NPN2,NPN2),F(NPN2,NPN2),B(NPN1),&
+ REAL(kind(0.0d0)) A(NPN2,NPN2),F(NPN2,NPN2),B(NPN1),&
WORK(NPN1),Q1(NPN1,NPN1),Q2(NPN1,NPN1),&
P1(NPN1,NPN1),P2(NPN1,NPN1)
INTEGER IPVT(NPN1),IND1(NPN1),IND2(NPN1)
@@ -2663,8 +2664,8 @@ DEALLOCATE(IG22)
!C*********************************************************************
SUBROUTINE INVERT(NDIM,N,A,X,COND,IPVT,WORK,B)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 A(NDIM,N),X(NDIM,N),WORK(N),B(N)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) A(NDIM,N),X(NDIM,N),WORK(N),B(N)
INTEGER IPVT(N)
CALL DECOMP (NDIM,N,A,COND,IPVT,WORK)
@@ -2693,8 +2694,8 @@ DEALLOCATE(IG22)
!C********************************************************************
SUBROUTINE DECOMP (NDIM,N,A,COND,IPVT,WORK)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 A(NDIM,N),COND,WORK(N)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) A(NDIM,N),COND,WORK(N)
INTEGER IPVT(N)
IPVT(N)=1
@@ -2804,8 +2805,8 @@ DEALLOCATE(IG22)
!C**********************************************************************
SUBROUTINE SOLVE (NDIM,N,A,B,IPVT)
- IMPLICIT REAL*8 (A-H,O-Z)
- REAL*8 A(NDIM,N),B(N)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,O-Z)
+ REAL(kind(0.0d0)) A(NDIM,N),B(N)
INTEGER IPVT(N)
IF (N.NE.1) THEN
@@ -2846,8 +2847,8 @@ DEALLOCATE(IG22)
!C**********************************************************************
SUBROUTINE GAUSS(N,IND1,IND2,Z,W)
- IMPLICIT REAL*8 (A-H,P-Z)
- REAL*8 Z(N),W(N)
+ IMPLICIT REAL(kind(0.0d0)) (A-H,P-Z)
+ REAL(kind(0.0d0)) Z(N),W(N)
DATA A,B,C /1D0,2D0,3D0/
IND=MOD(N,2)
@@ -2915,11 +2916,3 @@ DEALLOCATE(IG22)
RETURN
END
-
-
-
-
-
-
-
-