From 6fb01f64fe2bcdb4668e520eb458ffd3477e5e6f Mon Sep 17 00:00:00 2001 From: KAWASHIMA Takahiro Date: Thu, 6 Dec 2018 15:22:29 +0900 Subject: [PATCH] mpi/c: Fix MPI_TYPE_CREATE_F90_{REAL,COMPLEX} This commit fixes edge cases of `r = 38` and `r = 308`. As defined in the MPI standard, `TYPE_CREATE_F90_REAL` and `TYPE_CREATE_F90_COMPLEX` must be consistent with the Fortran `SELECTED_REAL_KIND` function. The `SELECTED_REAL_KIND` function is defined based on the `RANGE` function. The `RANGE` function returns `INT(MIN(LOG10(HUGE(X)), -LOG10(TINY(X))))` for a real value `X`. The old code considers only `INT(LOG10(HUGE(X)))` using `*_MAX_10_EXP`. This commit adds `INT(-LOG10(TINY(X)))` part using `*_MIN_10_EXP`. This bug affected the following `p`-`r` combinations. | p | r | expected | returned | expected | returned | | :------------ | --: | :-------- | :-------- | :------- | :-------- | | MPI_UNDEFINED | 38 | REAL8 | REAL4 | COMPLEX16 | COMPLEX8 | | 0 <= p <= 6 | 38 | REAL8 | REAL4 | COMPLEX16 | COMPLEX8 | | MPI_UNDEFINED | 308 | REAL16 | REAL8 | COMPLEX32 | COMPLEX16 | | 0 <= p <= 15 | 308 | REAL16 | REAL8 | COMPLEX32 | COMPLEX16 | MPICH returns the same result as Open MPI with this fix. Signed-off-by: KAWASHIMA Takahiro --- ompi/mpi/c/type_create_f90_complex.c | 9 +++++---- ompi/mpi/c/type_create_f90_real.c | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/ompi/mpi/c/type_create_f90_complex.c b/ompi/mpi/c/type_create_f90_complex.c index 3016b3509c..6d021c1680 100644 --- a/ompi/mpi/c/type_create_f90_complex.c +++ b/ompi/mpi/c/type_create_f90_complex.c @@ -18,6 +18,7 @@ * and Technology (RIST). All rights reserved. * Copyright (c) 2017 IBM Corporation. All rights reserved. * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -83,10 +84,10 @@ int MPI_Type_create_f90_complex(int p, int r, MPI_Datatype *newtype) * cache. */ - if( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; - else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) ) *newtype = &ompi_mpi_ldblcplex.dt; - else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) ) *newtype = &ompi_mpi_dblcplex.dt; - else *newtype = &ompi_mpi_cplex.dt; + if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; + else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_ldblcplex.dt; + else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_dblcplex.dt; + else *newtype = &ompi_mpi_cplex.dt; if( *newtype != &ompi_mpi_datatype_null.dt ) { ompi_datatype_t* datatype; diff --git a/ompi/mpi/c/type_create_f90_real.c b/ompi/mpi/c/type_create_f90_real.c index 0f2b8ace10..4784a9b10d 100644 --- a/ompi/mpi/c/type_create_f90_real.c +++ b/ompi/mpi/c/type_create_f90_real.c @@ -18,6 +18,7 @@ * and Technology (RIST). All rights reserved. * Copyright (c) 2017 IBM Corporation. All rights reserved. * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow @@ -83,10 +84,10 @@ int MPI_Type_create_f90_real(int p, int r, MPI_Datatype *newtype) * cache. */ - if( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; - else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) ) *newtype = &ompi_mpi_long_double.dt; - else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) ) *newtype = &ompi_mpi_double.dt; - else *newtype = &ompi_mpi_float.dt; + if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; + else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_long_double.dt; + else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_double.dt; + else *newtype = &ompi_mpi_float.dt; if( *newtype != &ompi_mpi_datatype_null.dt ) { ompi_datatype_t* datatype;