Merge pull request #619 from FESOM/updates_2.5.0.4_de

get 2.5.0.6_de back into main

src/CMakeLists.txt

@@ -46,6 +46,12 @@ endif()
 if(${FESOM_PLATFORM_STRATEGY} STREQUAL  levante.dkrz.de )
    message(STATUS "multithreading disabled for Levante") # multithreading suddenly produces an error, disable it until a fix is found. issue #413
    option(DISABLE_MULTITHREADING "disable asynchronous operations" ON)
+elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL  leo-dcgp )
+   message(STATUS "multithreading disabled for Leonardo") # multithreading suddenly produces an error, disable it until a fix is found. issue #413
+   option(DISABLE_MULTITHREADING "disable asynchronous operations" ON)
+elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL  mn5-gpp )
+   message(STATUS "multithreading disabled for MN5 GPP") # multithreading suddenly produces an error, disable it until a fix is found. issue #413
+   option(DISABLE_MULTITHREADING "disable asynchronous operations" ON)
 elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL  albedo )
    message(STATUS "multithreading disabled for Albedo") # multithreading suddenly produces an error, disable it until a fix is found. issue #413
    option(DISABLE_MULTITHREADING "disable asynchronous operations" ON)
@@ -125,14 +131,15 @@ if(USE_ICEPACK)
                               ${src_home}/icepack_drivers/Icepack/columnphysics/*.F90)
    list(APPEND sources_Fortran ${sources_ice_pack})
 elseif(ENABLE_IFS_INTERFACE) # ICEPACK + IFS_INTERFACE NOT SUPPORTED (YET)
+   if(ENABLE_MULTIO)
+      list(APPEND sources_Fortran ${src_home}/ifs_interface/iom.F90)
+   endif()
+
    list(APPEND sources_Fortran ${src_home}/ifs_interface/ifs_interface.F90
                                ${src_home}/ifs_interface/ifs_modules.F90
                                ${src_home}/ifs_interface/ifs_notused.F90
                                ${src_home}/ifs_interface/mpp_io.F90)
 endif()
-if(ENABLE_MULTIO)
-   list(APPEND sources_Fortran ${src_home}/ifs_interface/iom.F90)
-endif()
 
 # generate a custom file from fesom_version_info.F90 which includes the current git SHA
 set(FESOM_ORIGINAL_VERSION_FILE ${src_home}/fesom_version_info.F90)
@@ -224,6 +231,10 @@ if(${CMAKE_Fortran_COMPILER_ID} STREQUAL  Intel )
    target_compile_options(${PROJECT_NAME} PRIVATE -r8 -i4 -fp-model precise -no-prec-div -no-prec-sqrt -fimf-use-svml -ip -init=zero -no-wrap-margin -fpe0) # add -fpe0 for RAPS environment
    if(${FESOM_PLATFORM_STRATEGY} STREQUAL  levante.dkrz.de )
       target_compile_options(${PROJECT_NAME} PRIVATE -march=core-avx2 -mtune=core-avx2)
+   elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL leo-dcgp )
+      target_compile_options(${PROJECT_NAME} PRIVATE -O3 -xCORE-AVX512 -qopt-zmm-usage=high -align array64byte -ipo)
+   elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL mn5-gpp )
+      target_compile_options(${PROJECT_NAME} PRIVATE -O3 -xCORE-AVX512 -qopt-zmm-usage=high -align array64byte -ipo)
    elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL  albedo)
       target_compile_options(${PROJECT_NAME} PRIVATE -march=core-avx2 -O3 -ip -fPIC -qopt-malloc-options=2 -qopt-prefetch=5 -unroll-aggressive) #NEC mpi option
    elseif(${FESOM_PLATFORM_STRATEGY} STREQUAL atosecmwf )

src/fesom_module.F90

@@ -89,6 +89,9 @@ module fesom_main_storage_module
 !           this way FESOM can e.g. be used as a library with an external time loop driver
 !           used with IFS-FESOM
 module fesom_module
+#if defined  __ifsinterface
+  use, intrinsic :: ieee_exceptions
+#endif
   implicit none
   public fesom_init, fesom_runloop, fesom_finalize
   private
@@ -110,6 +113,15 @@ subroutine fesom_init(fesom_total_nsteps)
         stop
       end if
 #endif
+
+!SUVI: disable overflow, underflow for entire model when used  in coupled with ifs
+!      bad practice, use it only in case of Emergency
+!#if defined  __ifsinterface
+!    call ieee_set_halting_mode(ieee_overflow, .false.)
+!    call ieee_set_halting_mode(ieee_underflow, .false.)
+!    call ieee_set_halting_mode(ieee_invalid, .false.)
+!#endif
+
 
       mpi_is_initialized = .false.
       f%fesom_did_mpi_init = .false.

src/gen_support.F90

@@ -85,6 +85,7 @@ subroutine smooth_nod2D(arr, N, partit, mesh)
        arr(node)=work_array(node)
     ENDDO
 !$OMP END PARALLEL DO
+!$OMP BARRIER
 !$OMP MASTER
     call exchange_nod(arr, partit)
 !$OMP END MASTER
@@ -151,6 +152,7 @@ subroutine smooth_nod3D(arr, N_smooth, partit, mesh)
      END DO
   END DO
 !$OMP END DO  
+!$OMP BARRIER
 !$OMP MASTER
   call exchange_nod(arr, partit)
 !$OMP END MASTER
@@ -185,6 +187,7 @@ subroutine smooth_nod3D(arr, N_smooth, partit, mesh)
         END DO
      END DO
 !$OMP END DO
+!$OMP BARRIER
 !$OMP MASTER
      call exchange_nod(arr, partit)
 !$OMP END MASTER
@@ -224,6 +227,7 @@ subroutine smooth_elem2D(arr, N, partit, mesh)
             work_array(node)=work_array(node)/vol
         END DO
 !$OMP END DO
+!$OMP BARRIER
 !$OMP MASTER
         call exchange_nod(work_array, partit)
 !$OMP END MASTER
@@ -234,6 +238,7 @@ subroutine smooth_elem2D(arr, N, partit, mesh)
             arr(elem)=sum(work_array(elnodes))/3.0_WP  ! Here, we need the inverse and scale by 1/3
         ENDDO
 !$OMP END DO
+!$OMP BARRIER
 !$OMP MASTER
         call exchange_elem(arr, partit)
 !$OMP END MASTER
@@ -286,6 +291,7 @@ subroutine smooth_elem3D(arr, N, partit, mesh)
                 work_array(node)=work_array(node)/vol
             END DO
 !$OMP END DO
+!$OMP BARRIER
 !$OMP MASTER
             call exchange_nod(work_array, partit)
 !$OMP END MASTER

src/ifs_interface/iom.F90

@@ -16,9 +16,13 @@ MODULE iom
     TYPE(multio_handle) :: mio_handle
     INTEGER(8), PRIVATE :: mio_parent_comm
 
+    PUBLIC iom_enable_multio
     PUBLIC iom_initialize, iom_init_server, iom_finalize
     PUBLIC iom_send_fesom_domains
     PUBLIC iom_field_request, iom_send_fesom_data
+    PUBLIC iom_flush
+
+    LOGICAL :: lnomultio = .TRUE.
 
     PRIVATE ctl_stop
     !!----------------------------------------------------------------------
@@ -44,6 +48,11 @@ MODULE iom
 
 CONTAINS
 
+    SUBROUTINE iom_enable_multio()
+        IMPLICIT NONE
+        lnomultio = .FALSE.
+    END SUBROUTINE
+
     SUBROUTINE multio_custom_error_handler(context, err, info)
         USE mpi
 
@@ -74,6 +83,8 @@ SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm )
         INTEGER :: err
         CHARACTER(len=16)                 :: err_str
 
+        IF (lnomultio) RETURN
+
         mio_parent_comm = mpi_comm_world
 
         err = multio_initialise()
@@ -151,6 +162,8 @@ SUBROUTINE iom_finalize()
         IMPLICIT NONE
         INTEGER :: err
 
+        IF (lnomultio) RETURN
+
         err = mio_handle%close_connections();
         IF (err /= MULTIO_SUCCESS) THEN
             CALL ctl_stop('mio_handle%close_connections failed: ', multio_error_string(err))
@@ -163,11 +176,13 @@ SUBROUTINE iom_finalize()
     END SUBROUTINE iom_finalize
 
     SUBROUTINE iom_init_server(server_comm)
-       IMPLICIT NONE
-       INTEGER, INTENT(IN) :: server_comm
-       type(multio_configuration)        :: conf_ctx
-       INTEGER                           :: err
-       CHARACTER(len=16)                 :: err_str
+        IMPLICIT NONE
+        INTEGER, INTENT(IN) :: server_comm
+        type(multio_configuration)        :: conf_ctx
+        INTEGER                           :: err
+        CHARACTER(len=16)                 :: err_str
+
+        IF (lnomultio) RETURN
 
         mio_parent_comm = server_comm
 
@@ -246,6 +261,8 @@ SUBROUTINE iom_send_fesom_domains(partit, mesh)
 #include "../associate_part_ass.h"
 #include "../associate_mesh_ass.h"
 
+        IF (lnomultio) RETURN
+
         cerr = md%new(mio_handle)
         IF (cerr /= MULTIO_SUCCESS) THEN
             CALL ctl_stop('send_fesom_domains: ngrid, md%new() failed: ', multio_error_string(cerr))
@@ -337,6 +354,9 @@ SUBROUTINE iom_send_fesom_data(data)
         TYPE(iom_field_request), INTENT(INOUT)  :: data
         INTEGER                                 :: cerr
         TYPE(multio_metadata)                   :: md
+
+        IF (lnomultio) RETURN
+
         cerr = md%new(mio_handle)
         IF (cerr /= MULTIO_SUCCESS) THEN
             CALL ctl_stop('send_fesom_data: md%new() failed: ', multio_error_string(cerr))
@@ -420,6 +440,48 @@ SUBROUTINE iom_send_fesom_data(data)
         END IF
     END SUBROUTINE
 
+    SUBROUTINE iom_flush(domain, step)
+        IMPLICIT NONE
+
+        CHARACTER(6), INTENT(IN)                :: domain
+        INTEGER, INTENT(IN)                     :: step
+
+        INTEGER                                 :: cerr
+        TYPE(multio_metadata)                   :: md
+
+        IF (lnomultio) RETURN
+
+        cerr = md%new(mio_handle)
+        IF (cerr /= MULTIO_SUCCESS) THEN
+            CALL ctl_stop('iom_flush: md%new() failed: ', multio_error_string(cerr))
+        END IF
+
+        cerr = md%set_bool("toAllServers", .TRUE._1)
+        IF (cerr /= MULTIO_SUCCESS) THEN
+            CALL ctl_stop('iom_flush: md%set_bool(toAllServers) failed: ', multio_error_string(cerr))
+        END IF
+
+        cerr = md%set_string("domain", domain)
+        IF (cerr /= MULTIO_SUCCESS) THEN
+            CALL ctl_stop('iom_flush: md%set_string(domain) failed: ', multio_error_string(cerr))
+        END IF
+
+        cerr = md%set_int("step", step)
+        IF (cerr /= MULTIO_SUCCESS) THEN
+           CALL ctl_stop('iom_flush: md%set_int(step) failed: ', multio_error_string(cerr))
+        END IF
+
+        cerr = mio_handle%flush(md)
+        IF (cerr /= MULTIO_SUCCESS) THEN
+            CALL ctl_stop('iom_flush: mio_handle%multio_flush failed: ', multio_error_string(cerr))
+        END IF
+
+        cerr = md%delete()
+        IF (cerr /= MULTIO_SUCCESS) THEN
+            CALL ctl_stop('iom_flush: md%delete failed: ', multio_error_string(cerr))
+        END IF
+    END SUBROUTINE
+
     SUBROUTINE ctl_stop(m1, m2, m3, m4)
         USE mpi
 

src/ifs_interface/mpp_io.F90

@@ -7,7 +7,7 @@
 
 MODULE mpp_io
 #if defined(__MULTIO)        
-    USE iom, only : iom_initialize, iom_init_server, iom_finalize
+    USE iom, only : iom_enable_multio, iom_initialize, iom_init_server, iom_finalize
 #endif
     IMPLICIT NONE
     PRIVATE
@@ -19,7 +19,7 @@ MODULE mpp_io
 
     INTEGER :: ntask_multio  = 0
     INTEGER :: ntask_xios    = 0
-    LOGICAL, PUBLIC  :: lioserver, lmultioserver, lmultiproc
+    LOGICAL, PUBLIC :: lioserver, lmultioserver, lmultiproc
     INTEGER :: ntask_notio
     INTEGER, SAVE :: mppallrank, mppallsize, mppiorank, mppiosize
     INTEGER, SAVE :: mppmultiorank, mppmultiosize
@@ -78,6 +78,12 @@ SUBROUTINE mpp_io_init( iicomm,  lio, irequired, iprovided, lmpi1 )
         WRITE(*,namio)
         CLOSE(10)
 
+#if defined(__MULTIO)
+        IF (ntask_multio /= 0) THEN
+            CALL iom_enable_multio()
+        ENDIF
+#endif
+
         IF ( ntask_xios + ntask_multio == 0 ) THEN
             iicomm = mpi_comm_world
             lio=.FALSE.

src/io_meandata.F90

@@ -1317,6 +1317,10 @@ subroutine output(istep, ice, dynamics, tracers, partit, mesh)
     type(t_ice)   , intent(inout), target :: ice
     character(:), allocatable             :: filepath
     real(real64)                          :: rtime !timestamp of the record
+#if defined(__MULTIO)
+    logical       :: output_done
+    logical       :: trigger_flush
+#endif
 
 ctime=timeold+(dayold-1.)*86400
 
@@ -1337,6 +1341,11 @@ subroutine output(istep, ice, dynamics, tracers, partit, mesh)
     !___________________________________________________________________________
     !PS if (partit%flag_debug .and. partit%mype==0)  print *, achar(27)//'[33m'//' -I/O-> call update_means'//achar(27)//'[0m'  
     call update_means
+
+#if defined(__MULTIO)
+    output_done = .false.
+#endif
+
     !___________________________________________________________________________
     ! loop over defined streams
     do n=1, io_NSTREAMS
@@ -1368,6 +1377,10 @@ subroutine output(istep, ice, dynamics, tracers, partit, mesh)
             call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1)
             stop
         endif
+
+#if defined(__MULTIO)
+        output_done = output_done .or. do_output
+#endif
 
         !_______________________________________________________________________
         ! if its time for output --> do_output==.true.
@@ -1475,6 +1488,13 @@ subroutine output(istep, ice, dynamics, tracers, partit, mesh)
         endif ! --> if (do_output) then
     end do ! --> do n=1, io_NSTREAMS
     lfirst=.false.
+
+#if defined(__MULTIO)
+    if (output_done) then
+        call iom_flush('N grid', istep)
+    end if
+#endif
+
 end subroutine
 !
 !

src/oce_ale_pressure_bv.F90

@@ -491,9 +491,9 @@ subroutine pressure_bv(tracers, partit, mesh)
         end if
     end do
 !$OMP END DO
+!$OMP BARRIER
 !$OMP END PARALLEL
 call smooth_nod (bvfreq, 1, partit, mesh)
-!$OMP BARRIER
 end subroutine pressure_bv
 !
 !
@@ -2835,10 +2835,10 @@ subroutine sw_alpha_beta(TF1,SF1, partit, mesh)
    end do
  end do
 !$OMP END DO
+!$OMP BARRIER
 !$OMP END PARALLEL
 call exchange_nod(sw_alpha, partit)
 call exchange_nod(sw_beta, partit)
-!$OMP BARRIER
 end subroutine sw_alpha_beta
 !
 !
@@ -2870,6 +2870,7 @@ subroutine compute_sigma_xy(TF1,SF1, partit, mesh)
   real(kind=WP),  intent(IN)             :: TF1(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D), SF1(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D)
   real(kind=WP)                          :: tx(mesh%nl-1), ty(mesh%nl-1), sx(mesh%nl-1), sy(mesh%nl-1), vol(mesh%nl-1), testino(2)
   integer                                :: n, nz, elnodes(3),el, k, nln, uln, nle, ule
+  real(kind=WP)                          :: aux(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D)
 
 #include "associate_part_def.h"
 #include "associate_mesh_def.h"
@@ -2924,9 +2925,18 @@ subroutine compute_sigma_xy(TF1,SF1, partit, mesh)
         sigma_xy(2,uln:nln,n) = (-sw_alpha(uln:nln,n)*ty(uln:nln)+sw_beta(uln:nln,n)*sy(uln:nln))/vol(uln:nln)*density_0
   END DO
 !$OMP END DO
-!$OMP END PARALLEL
-  call exchange_nod(sigma_xy, partit)
 !$OMP BARRIER
+!$OMP END PARALLEL
+! call exchange_nod(sigma_xy, partit)
+CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr)
+aux=sigma_xy(1,:,:)
+call exchange_nod(aux, partit)
+sigma_xy(1,:,:)=aux
+CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr)
+aux=sigma_xy(2,:,:)
+call exchange_nod(aux, partit)
+sigma_xy(2,:,:)=aux
+CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr)
 end subroutine compute_sigma_xy
 !
 !
@@ -2978,10 +2988,10 @@ subroutine compute_neutral_slope(partit, mesh)
         enddo
     enddo
 !$OMP END DO
+!$OMP BARRIER
 !$OMP END PARALLEL
     call exchange_nod(neutral_slope, partit)
     call exchange_nod(slope_tapered, partit)
-!$OMP BARRIER
 end subroutine compute_neutral_slope
 !
 !