diff --git a/src/MNH/isocom.f b/src/MNH/isocom.f index f2e6503e663a2f39655c053f185dd64501f7421c..d92460fe1ac19f237be0ac2bd6c7a9fa2c79deab 100644 --- a/src/MNH/isocom.f +++ b/src/MNH/isocom.f @@ -1,8 +1,15 @@ -CMNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier +CMNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier CMNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence CMNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt CMNH_LIC for details. version 1. 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 P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function +C P. Wautelet 17/12/2021: add missing definitions of parameter ONE (in POLY3 and POLY3B) +C======================================================================= C C *** ISORROPIA CODE C *** SUBROUTINE ISOROPIA @@ -123,11 +130,6 @@ C C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY C *** WRITTEN BY ATHANASIOS NENES 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 P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function C======================================================================= C SUBROUTINE ISOROPIA (WI, RHI, TEMPI, CNTRL, @@ -3782,7 +3784,8 @@ C C 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) + & THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50, + & ONE=1.D0 ) REAL(kind(0.0d0)) X(3) C C *** SPECIAL CASE : QUADRATIC*X EQUATION ***************************** @@ -3881,7 +3884,7 @@ C SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV) C IMPLICIT REAL(kind(0.0d0)) (A-H, O-Z) - PARAMETER (ZERO=0.D0, EPS=1D-15, MAXIT=100, NDIV=5) + PARAMETER (ZERO=0.D0, ONE=1.D0, EPS=1D-15, MAXIT=100, NDIV=5) C FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3 C