Merge pull request #16 from ecmwf-ifs/feature/CY49R1_sync

Synchronise with CY49R1 - ifs-source/contrib/fiat

CMakeLists.txt

@@ -37,6 +37,14 @@ ecbuild_add_option( FEATURE DR_HOOK_MULTI_PRECISION_HANDLES
                     DESCRIPTION "[DEPRECATED] Support single precision handles for DR_HOOK"
                     DEFAULT OFF )
 
+ecbuild_add_option( FEATURE DOUBLE_PRECISION
+                    DEFAULT ON
+                    DESCRIPTION "Compilation of parkind_dp" )
+
+ecbuild_add_option( FEATURE SINGLE_PRECISION
+                    DEFAULT ON
+                    DESCRIPTION "Compilation of parkind_sp" )
+
 ecbuild_add_option( FEATURE WARNINGS
                     DEFAULT ON
                     DESCRIPTION "Add warnings to compiler" )

cmake/fiat-import.cmake.in

@@ -15,6 +15,8 @@ set( fiat_VERSION_STR @fiat_VERSION_STR@ )
 set( fiat_HAVE_MPI    @fiat_HAVE_MPI@ )
 set( fiat_HAVE_OMP    @fiat_HAVE_OMP@ )
 set( fiat_HAVE_FCKIT  @fckit_HAVE_FCKIT@ )
+set( fiat_HAVE_SINGLE_PRECISION   @fiat_HAVE_SINGLE_PRECISION@ )
+set( fiat_HAVE_DOUBLE_PRECISION   @fiat_HAVE_DOUBLE_PRECISION@ )
 set( fiat_SOURCE_FILENAMES      @fiat_SOURCE_FILENAMES@ )
 
 if( fiat_HAVE_OMP AND NOT TARGET OpenMP::OpenMP_Fortran )
@@ -36,3 +38,15 @@ else()
   set(_no_whole_archive "-Wl,--no-whole-archive")
 endif()
 set(MPI_SERIAL_LIBRARIES ${_whole_archive} mpi_serial ${_no_whole_archive})
+
+##################################################################
+## Handle components
+
+set( ${CMAKE_FIND_PACKAGE_NAME}_single_FOUND ${fiat_HAVE_SINGLE_PRECISION} )
+set( ${CMAKE_FIND_PACKAGE_NAME}_double_FOUND ${fiat_HAVE_DOUBLE_PRECISION} )
+
+foreach( _component ${${CMAKE_FIND_PACKAGE_NAME}_FIND_COMPONENTS} )
+  if( NOT ${CMAKE_FIND_PACKAGE_NAME}_${_component}_FOUND AND ${CMAKE_FIND_PACKAGE_NAME}_FIND_REQUIRED )
+    message( SEND_ERROR "fiat was not build with support for COMPONENT ${_component}" )
+  endif()
+endforeach()

src/fiat/drhook/drhook.c

@@ -560,7 +560,7 @@ static volatile sig_atomic_t signal_handler_called = 0;
 static volatile sig_atomic_t signal_handler_ignore_atexit = 0;
 static volatile sig_atomic_t unlimited_corefile_retcode = 9999;
 static volatile unsigned long long int saved_corefile_hardlimit = 0;
-static int allow_coredump = -1; /* -1 denotes ALL MPI-tasks, 1..NPES == myproc, 0 = coredump will not be enabled by DrHook at init */
+static int allow_coredump = 0; /* -1 denotes ALL MPI-tasks, 1..NPES == myproc, 0 = coredump will not be enabled by DrHook at init */
 static drhook_sig_t siglist[1+NSIG] = { 0 };
 static char *a_out = NULL;
 static char *mon_out = NULL;

src/fiat/gstats/gstats_print.F90

@@ -441,7 +441,8 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN)
        &'  RECVS  AVG(kb) TOTAL(MB) MB/s '
 
       DO JNUM=501,1000
-        IF(NUMSEND(JNUM) /= 0 .OR. NUMRECV(JNUM) /= 0 ) THEN
+        IF((NUMSEND(JNUM) /= 0 .OR. NUMRECV(JNUM) /= 0 ) &
+           .AND. TIMESUM(JNUM) > 0.0_JPRD) THEN
            SENDRATE=SENDBYTES(JNUM)*1.E-6_JPRD/TIMESUM(JNUM)
            RECVRATE=RECVBYTES(JNUM)*1.E-6_JPRD/TIMESUM(JNUM)
            IF(NUMSEND(JNUM) /= 0) THEN
@@ -585,7 +586,8 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN)
      &'   NUM   ROUTINE                              '//&
      &'  SUM(s)  SEND(GB)  RECV(GB)    GB/s'
     DO JNUM=501,1000
-       IF(TOTSENDBYTES(JNUM).GT.0.0_JPRD.OR.TOTRECVBYTES(JNUM).GT.0.0_JPRD) THEN
+       IF((TOTSENDBYTES(JNUM).GT.0.0_JPRD.OR.TOTRECVBYTES(JNUM).GT.0.0_JPRD) &
+          .AND. MAXCOMMTIME(JNUM) > 0.0_JPRD) THEN
           WRITE(KULOUT,'(I6,1X,A40,f6.1,2F10.1,F8.1)') &
            &  JNUM,CCDESC(JNUM),MAXCOMMTIME(JNUM),&
            &  TOTSENDBYTES(JNUM)*1.E-9_JPRD, &

src/fiat/gstats/gstats_psut.F90

@@ -36,7 +36,7 @@ SUBROUTINE GSTATS_PSUT
     ILBUF = 2
   ENDIF
   DO JROC=2,NPROC_STATS
-   IF (MYPROC_STATS .eq. jroc ) THEN
+   IF (MYPROC_STATS .EQ. JROC ) THEN
     ZTBUF(1) = ZCLOCKB
     ZTBUF(2) = ZCLOCK
     ILSEND = 2

src/fiat/gstats/gstats_query.F90

@@ -0,0 +1,76 @@
+SUBROUTINE GSTATS_QUERY(KNUM,PTIME)
+
+!**** *GSTATS_QUERY*  - Get current value of gstats timer
+
+!     PURPOSE.
+!     --------
+!       To query values of gstats timer for use in live output 
+
+
+!**   INTERFACE.
+!     ----------
+!       *CALL* *GSTATS(KNUM,PTIME)
+
+!        EXPLICIT ARGUMENTS
+!        --------------------
+!        KNUM - timing event number (for list of already defined events
+!               see routine STATS_OUTPUT)
+!        PTIME    - Output current value of timer
+
+!        IMPLICIT ARGUMENTS
+!        --------------------
+!        Module YOMGSTATS
+
+!     METHOD.
+!     -------
+
+!     REFERENCE.
+!     ----------
+!        ECMWF Research Department documentation of the IFS
+
+!     AUTHOR.
+!     -------
+!        P. Gillies ECMWF
+
+!     MODIFICATIONS.
+!     --------------
+!        ORIGINAL : 2021-03-03 
+
+!     ------------------------------------------------------------------
+
+USE EC_PARKIND  ,ONLY : JPRD, JPIM
+USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
+
+USE YOMGSTATS  
+USE OML_MOD
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KNUM
+REAL(KIND=JPRD),INTENT(OUT) :: PTIME
+REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
+
+IF (LHOOK) CALL DR_HOOK('GSTATS_QUERY',0,ZHOOK_HANDLE)
+
+IF(LSTATS) THEN
+
+! only process gstats calls for master thread
+
+  IF(OML_MY_THREAD() <= 1) THEN
+
+    ! Return current total value of specified timer
+    IF(NCALLS(KNUM)>1) THEN
+      PTIME=TIMESUM(KNUM)
+    ELSE
+      PTIME=0.0_JPRD
+    ENDIF
+
+  ENDIF
+
+ELSE
+  PTIME=0.0_JPRD
+ENDIF
+
+IF (LHOOK) CALL DR_HOOK('GSTATS_QUERY',1,ZHOOK_HANDLE)
+
+END SUBROUTINE GSTATS_QUERY

src/fiat/mpl/internal/mpl_gatherv_mod.F90

@@ -91,8 +91,8 @@ MODULE MPL_GATHERV_MOD
 INTEGER(KIND=JPIM)    :: ZDUM_INT
 
 INTERFACE MPL_GATHERV
-MODULE PROCEDURE MPL_GATHERV_REAL8,MPL_GATHERV_REAL4,MPL_GATHERV_INT,&
-               & MPL_GATHERV_INT_SCALAR
+MODULE PROCEDURE MPL_GATHERV_REAL8,MPL_GATHERV_REAL4,MPL_GATHERV_CHAR_SCALAR,&
+               & MPL_GATHERV_INT,MPL_GATHERV_INT_SCALAR
 END INTERFACE
 
 PUBLIC MPL_GATHERV
@@ -109,7 +109,6 @@ SUBROUTINE MPL_GATHERV_PREAMB1(IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYP
 #endif
 
 
-
 INTEGER(KIND=JPIM),INTENT(OUT) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT
 INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE,KREQUEST
@@ -363,6 +362,83 @@ SUBROUTINE MPL_GATHERV_REAL8(PSENDBUF,KROOT,PRECVBUF,KRECVCOUNTS,KSENDCOUNT,KREC
 
 END SUBROUTINE MPL_GATHERV_REAL8
 
+SUBROUTINE MPL_GATHERV_CHAR_SCALAR(CSENDBUF,KROOT,CRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
+                            & KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
+
+
+#ifdef USE_8_BYTE_WORDS
+  USE MPI4TO8, ONLY : &
+    MPI_GATHERV => MPI_GATHERV8
+#endif
+
+
+CHARACTER(LEN=*)                        :: CSENDBUF
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL  :: KRECVCOUNTS(:),KSENDCOUNT
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL  :: KROOT
+CHARACTER(LEN=*),OPTIONAL               :: CRECVBUF(:)
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL  :: KRECVDISPL(:),KCOMM,KMP_TYPE
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST
+CHARACTER(LEN=*),INTENT(IN),OPTIONAL    :: CDSTRING
+
+INTEGER(KIND=JPIM) :: IRECVDISPL(MPL_NUMPROC)
+INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE
+INTEGER(KIND=JPIM) :: IRECVBUFSIZE,ISENDCOUNT
+INTEGER(KIND=JPIM) :: IDUM,IST,IEND,JK !,ICOUNT
+
+IF(PRESENT(KSENDCOUNT)) THEN
+  ISENDCOUNT=KSENDCOUNT
+ELSE
+  ISENDCOUNT = LEN(CSENDBUF)
+ENDIF
+
+CALL MPL_GATHERV_PREAMB1(IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE,KCOMM,KROOT,KMP_TYPE,KREQUEST)
+
+IF(IPL_MYRANK == IROOT) THEN
+  IF( .NOT. PRESENT(CRECVBUF)) CALL MPL_MESSAGE(&
+   & CDMESSAGE='MPL_GATHERV:RECVBUF MISSING',CDSTRING=CDSTRING,LDABORT=LLABORT)
+  IRECVBUFSIZE = LEN(CRECVBUF)*SIZE(CRECVBUF)
+#ifndef NAG
+  IF( (LOC(CRECVBUF(UBOUND(CRECVBUF,1))) - LOC(CRECVBUF(LBOUND(CRECVBUF,1)))) /= (IRECVBUFSIZE-LEN(CRECVBUF) ) .AND. &
+    & IRECVBUFSIZE > 0 ) THEN
+    CALL MPL_MESSAGE(CDMESSAGE='MPL_GATHERV: RECVBUF NOT CONTIGUOUS ',LDABORT=LLABORT)
+  ENDIF
+#endif
+  CALL MPL_GATHERV_PREAMB2(IPL_NUMPROC,IPL_MYRANK,IRECVBUFSIZE,ISENDCOUNT,&
+       & KRECVCOUNTS,IRECVDISPL,KRECVDISPL,CDSTRING)
+
+  IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
+    CALL MPI_GATHERV(CSENDBUF,ISENDCOUNT,INT(MPI_CHARACTER),CRECVBUF(1),KRECVCOUNTS,&
+     &  IRECVDISPL,INT(MPI_CHARACTER),IROOT-1,ICOMM,IERROR)
+  ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
+    CALL MPI_IGATHERV(CSENDBUF,ISENDCOUNT,INT(MPI_CHARACTER),CRECVBUF(1),KRECVCOUNTS,&
+     &  IRECVDISPL,INT(MPI_CHARACTER),IROOT-1,ICOMM,KREQUEST,IERROR)
+  ENDIF
+  IF(LMPLSTATS) THEN
+    CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_CHARACTER))
+    CALL MPL_RECVSTATS(SUM(KRECVCOUNTS),INT(MPI_CHARACTER))
+  ENDIF
+ELSE
+  IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN
+    CALL MPI_GATHERV(CSENDBUF,ISENDCOUNT,INT(MPI_CHARACTER),ZDUM_JPRD,1, &
+     &  1,INT(MPI_CHARACTER),IROOT-1,ICOMM,IERROR)
+  ELSEIF(IMP_TYPE == JP_NON_BLOCKING_STANDARD .OR. IMP_TYPE == JP_NON_BLOCKING_BUFFERED) THEN
+    CALL MPI_IGATHERV(CSENDBUF,ISENDCOUNT,INT(MPI_CHARACTER),ZDUM_JPRD,1, &
+     &  1,INT(MPI_CHARACTER),IROOT-1,ICOMM,KREQUEST,IERROR)
+  ENDIF
+  IF(LMPLSTATS) THEN
+    CALL MPL_SENDSTATS(ISENDCOUNT,INT(MPI_CHARACTER))
+  ENDIF
+ENDIF
+
+IF(PRESENT(KERROR)) THEN
+  KERROR=IERROR
+ELSE
+  IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_GATHERV',CDSTRING,&
+   & LDABORT=LLABORT)
+ENDIF
+
+END SUBROUTINE MPL_GATHERV_CHAR_SCALAR
+
 SUBROUTINE MPL_GATHERV_INT(KSENDBUF,KROOT,KRECVBUF,KRECVCOUNTS,KSENDCOUNT,KRECVDISPL, &
                             &  KMP_TYPE,KCOMM,KERROR,KREQUEST,CDSTRING)
 

src/fiat/system/internal/linux_bind.c

@@ -1,8 +1,10 @@
 /*
+ * (C) Copyright 2005- ECMWF.
  * (C) Copyright 2005- Meteo France.
- * 
+ *
  * This software is licensed under the terms of the Apache Licence Version 2.0
  * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+ *
  * In applying this licence, ECMWF does not waive the privileges and immunities
  * granted to it by virtue of its status as an intergovernmental organisation
  * nor does it submit to any jurisdiction.
@@ -29,12 +31,12 @@ static char * getcpumask (char *buffer, size_t size)
   cpu_set_t mask;
   unsigned int ncpu;
   unsigned int icpu;
-  
+
   ncpu = sysconf (_SC_NPROCESSORS_CONF);
-  
+
   sched_getaffinity (0, sizeof (mask), &mask);
 
-  for (icpu = 0; icpu < ncpu; icpu++) 
+  for (icpu = 0; icpu < ncpu; icpu++)
     buffer[icpu] = CPU_ISSET (icpu, &mask) ? '1' : '0';
 
   buffer[ncpu] = '\0';
@@ -78,11 +80,11 @@ void linux_bind_dump_ (int * prank, int * psize)
   }
 
 #ifdef _OPENMP
-#pragma omp parallel 
+#pragma omp parallel
 #endif
   {
     char buffer[1024];
-    int iomp = 
+    int iomp =
 #ifdef _OPENMP
       omp_get_thread_num ()
 #else
@@ -97,7 +99,7 @@ void linux_bind_dump_ (int * prank, int * psize)
 #ifdef _OPENMP
 #pragma omp critical
 #endif
-            fprintf (fp, "\n                                                    mask = %s iomp = %2d", 
+            fprintf (fp, "\n                                                    mask = %s iomp = %2d",
                      getcpumask (buffer, sizeof (buffer)), iomp);
           }
 #ifdef _OPENMP
@@ -151,12 +153,12 @@ void linux_bind_ (int * prank, int * psize)
     }
 
 #ifdef _OPENMP
-#pragma omp parallel 
+#pragma omp parallel
 #endif
   {
     char * c;
     cpu_set_t mask;
-    int iomp = 
+    int iomp =
 #ifdef _OPENMP
       omp_get_thread_num ()
 #else
@@ -183,7 +185,7 @@ void linux_bind_ (int * prank, int * psize)
     for (icpu = 0; isdigit (*c); icpu++, c++)
       if (*c != '0')
         CPU_SET (icpu, &mask);
-     
+
     sched_setaffinity (0, sizeof (mask), &mask);
 
 end_parallel:

src/fiat/system/internal/linuxtrbk.c

@@ -1,5 +1,5 @@
 /*
- * (C) Copyright 2005- ECMWF.
+ * (C) Copyright 2006- ECMWF.
  * 
  * This software is licensed under the terms of the Apache Licence Version 2.0
  * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.

src/fiat/util/qsortc.F90

@@ -1,3 +1,4 @@
+! (C) Copyright 2005- ECMWF.
 ! (C) Copyright 2005- Meteo France.
 ! 
 ! This software is licensed under the terms of the Apache Licence Version 2.0

src/parkind/CMakeLists.txt

@@ -6,25 +6,30 @@
 # granted to it by virtue of its status as an intergovernmental organisation
 # nor does it submit to any jurisdiction.
 
-foreach( target parkind_sp parkind_dp )
+set( HAVE_dp ${HAVE_DOUBLE_PRECISION} )
+set( HAVE_sp ${HAVE_SINGLE_PRECISION} )
 
-  ecbuild_add_library(
-    TARGET  ${target} 
-    SOURCES parkind1.F90 
-            parkind2.F90
-  )
+foreach( prec sp dp )
+  if( HAVE_${prec} )
+    set( target parkind_${prec} )
+    ecbuild_add_library(
+      TARGET  ${target}
+      SOURCES parkind1.F90
+              parkind2.F90
+    )
 
-  fiat_target_fortran_module_directory(
-    TARGET            ${target}
-    MODULE_DIRECTORY  ${CMAKE_BINARY_DIR}/module/${target}
-    INSTALL_DIRECTORY module/${target}
-  )
+    if( EC_OS_BITS EQUAL "64" )
+      target_compile_definitions( ${target} PRIVATE ADDRESS64 )
+    endif()
 
-  if( EC_OS_BITS EQUAL "64" )
-    target_compile_definitions( parkind_sp PRIVATE ADDRESS64 )
+    fiat_target_fortran_module_directory(
+      TARGET            ${target}
+      MODULE_DIRECTORY  ${CMAKE_BINARY_DIR}/module/${target}
+      INSTALL_DIRECTORY module/${target}
+    )
   endif()
-
 endforeach()
 
-target_compile_definitions( parkind_sp PRIVATE PARKIND1_SINGLE )
-
+if( TARGET parkind_sp )
+  target_compile_definitions( parkind_sp PRIVATE PARKIND1_SINGLE )
+endif()