Merge pull request #592 from raguridan/updates_2.5.0.4_de

Updates 2.5.0.4 de

src/ifs_interface/iom.F90

@@ -19,6 +19,7 @@ MODULE iom
     PUBLIC iom_initialize, iom_init_server, iom_finalize
     PUBLIC iom_send_fesom_domains
     PUBLIC iom_field_request, iom_send_fesom_data
+    PUBLIC iom_flush
 
     PRIVATE ctl_stop
     !!----------------------------------------------------------------------
@@ -64,6 +65,7 @@ SUBROUTINE multio_custom_error_handler(context, err, info)
 
     SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm )
         USE mpi
+        USE mpp_io, ONLY: lnomultio
 
         IMPLICIT NONE
         CHARACTER(LEN=*), INTENT(IN)      :: client_id
@@ -74,6 +76,8 @@ SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm )
         INTEGER :: err
         CHARACTER(len=16)                 :: err_str
 
+        IF (lnomultio.EQ..TRUE._1) RETURN
+
         mio_parent_comm = mpi_comm_world
 
         err = multio_initialise()
@@ -148,9 +152,13 @@ SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm )
     END SUBROUTINE iom_initialize
 
     SUBROUTINE iom_finalize()
+        USE mpp_io, ONLY: lnomultio
+
         IMPLICIT NONE
         INTEGER :: err
 
+        IF (lnomultio.EQ..TRUE._1) 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 +171,15 @@ 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
+        USE mpp_io, ONLY: lnomultio
+
+        IMPLICIT NONE
+        INTEGER, INTENT(IN) :: server_comm
+        type(multio_configuration)        :: conf_ctx
+        INTEGER                           :: err
+        CHARACTER(len=16)                 :: err_str
+
+        IF (lnomultio.EQ..TRUE._1) RETURN
 
         mio_parent_comm = server_comm
 
@@ -230,6 +242,7 @@ SUBROUTINE iom_init_server(server_comm)
     END SUBROUTINE iom_init_server
 
     SUBROUTINE iom_send_fesom_domains(partit, mesh)
+        USE mpp_io, ONLY: lnomultio
         USE MOD_MESH
         USE MOD_PARTIT
 
@@ -247,6 +260,8 @@ SUBROUTINE iom_send_fesom_domains(partit, mesh)
 #include "../associate_part_ass.h"
 #include "../associate_mesh_ass.h"
 
+        IF (lnomultio.EQ..TRUE._1) 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))
@@ -331,6 +346,7 @@ SUBROUTINE iom_send_fesom_domains(partit, mesh)
     END SUBROUTINE iom_send_fesom_domains
 
     SUBROUTINE iom_send_fesom_data(data)
+        USE mpp_io, ONLY: lnomultio
         USE g_clock
         USE g_config, only: MeshId
         IMPLICIT NONE
@@ -339,6 +355,8 @@ SUBROUTINE iom_send_fesom_data(data)
         INTEGER                                 :: cerr
         TYPE(multio_metadata)                   :: md
 
+        IF (lnomultio.EQ..TRUE._1) RETURN
+
         cerr = md%new(mio_handle)
         IF (cerr /= MULTIO_SUCCESS) THEN
             CALL ctl_stop('send_fesom_data: md%new() failed: ', multio_error_string(cerr))
@@ -422,6 +440,50 @@ SUBROUTINE iom_send_fesom_data(data)
         END IF
     END SUBROUTINE
 
+    SUBROUTINE iom_flush(domain, step)
+        USE mpp_io, ONLY: lnomultio
+
+        IMPLICIT NONE
+
+        CHARACTER(6), INTENT(IN)                :: domain
+        INTEGER, INTENT(IN)                     :: step
+
+        INTEGER                                 :: cerr
+        TYPE(multio_metadata)                   :: md
+
+        IF (lnomultio.EQ..TRUE._1) 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

@@ -19,7 +19,8 @@ MODULE mpp_io
 
     INTEGER :: ntask_multio  = 0
     INTEGER :: ntask_xios    = 0
-    LOGICAL, PUBLIC  :: lioserver, lmultioserver, lmultiproc
+    LOGICAL, PUBLIC :: lioserver, lmultioserver, lmultiproc
+    LOGICAL, PUBLIC :: lnomultio = .TRUE._1
     INTEGER :: ntask_notio
     INTEGER, SAVE :: mppallrank, mppallsize, mppiorank, mppiosize
     INTEGER, SAVE :: mppmultiorank, mppmultiosize
@@ -78,6 +79,10 @@ SUBROUTINE mpp_io_init( iicomm,  lio, irequired, iprovided, lmpi1 )
         WRITE(*,namio)
         CLOSE(10)
 
+        IF (ntask_multio /= 0) THEN
+            lnomultio = .FALSE._1
+        ENDIF
+
         IF ( ntask_xios + ntask_multio == 0 ) THEN
             iicomm = mpi_comm_world
             lio=.FALSE.

src/io_meandata.F90

@@ -1163,6 +1163,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
 
@@ -1182,6 +1186,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
@@ -1213,6 +1222,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.
@@ -1316,6 +1329,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
 !
 !