From e0fd51ecfc1c9778e88662f69e67679df7f40cbe Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Fri, 17 Dec 2021 11:24:34 +0100
Subject: [PATCH] Philippe 17/12/2021: add missing definitions of parameter ONE
(in POLY3 and POLY3B)
---
src/MNH/isocom.f | 19 +++++++++++--------
1 file changed, 11 insertions(+), 8 deletions(-)
diff --git a/src/MNH/isocom.f b/src/MNH/isocom.f
index f2e6503e6..d92460fe1 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
--
GitLab