diff --git a/src/ifs_interface/iom.F90 b/src/ifs_interface/iom.F90 index df83597e6..674f29e25 100644 --- a/src/ifs_interface/iom.F90 +++ b/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 diff --git a/src/ifs_interface/mpp_io.F90 b/src/ifs_interface/mpp_io.F90 index e285b111a..d22080026 100644 --- a/src/ifs_interface/mpp_io.F90 +++ b/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. diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 7d3cf6e84..28dfc9cdf 100644 --- a/src/io_meandata.F90 +++ b/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 ! !