diff --git a/src/ifs_interface/iom.F90 b/src/ifs_interface/iom.F90 index 7d7335c0d..77334b695 100644 --- a/src/ifs_interface/iom.F90 +++ b/src/ifs_interface/iom.F90 @@ -55,12 +55,15 @@ SUBROUTINE iom_enable_multio() SUBROUTINE multio_custom_error_handler(context, err, info) USE mpi + USE, intrinsic :: iso_fortran_env, ONLY: int64 + USE :: multio_api_constants_mod, ONLY: multio_failure_info IMPLICIT NONE - INTEGER(8), INTENT(INOUT) :: context ! Use mpi communicator as context - INTEGER, INTENT(IN) :: err - CLASS(multio_failure_info), INTENT(in) :: info - INTEGER :: mpierr + + INTEGER(int64), INTENT(INOUT) :: context ! Use mpi communicator as context + INTEGER, INTENT(IN) :: err + TYPE(multio_failure_info), INTENT(in) :: info + INTEGER :: mpierr IF (err /= MULTIO_SUCCESS) THEN CALL ctl_stop( 'MULTIO ERROR: ', multio_error_string(err, info)) @@ -73,15 +76,19 @@ SUBROUTINE multio_custom_error_handler(context, err, info) SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm ) USE mpi + USE :: multio_api, ONLY: failure_handler_t IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: client_id - INTEGER,INTENT(IN), OPTIONAL :: local_comm - INTEGER,INTENT(OUT), OPTIONAL :: return_comm - INTEGER,INTENT(IN), OPTIONAL :: global_comm - TYPE(multio_configuration) :: conf_ctx - INTEGER :: err - CHARACTER(len=16) :: err_str + + CHARACTER(LEN=*), INTENT(IN) :: client_id + INTEGER, INTENT(IN), OPTIONAL :: local_comm + INTEGER, INTENT(OUT), OPTIONAL :: return_comm + INTEGER, INTENT(IN), OPTIONAL :: global_comm + + TYPE(multio_configuration) :: conf_ctx + INTEGER :: err + CHARACTER(len=16) :: err_str + PROCEDURE(failure_handler_t), POINTER :: pf IF (lnomultio) RETURN @@ -120,7 +127,8 @@ SUBROUTINE iom_initialize(client_id, local_comm, return_comm, global_comm ) END IF ! Setting a failure handler that reacts on interface problems or exceptions that are not handled within the interface - err = conf_ctx%set_failure_handler(multio_custom_error_handler, mio_parent_comm) + pf => multio_custom_error_handler + err = conf_ctx%set_failure_handler(pf, mio_parent_comm) if (err /= MULTIO_SUCCESS) then CALL ctl_stop( 'setting multio failure handler failed: ', multio_error_string(err)) end if @@ -176,11 +184,16 @@ SUBROUTINE iom_finalize() END SUBROUTINE iom_finalize SUBROUTINE iom_init_server(server_comm) + USE :: multio_api, ONLY: failure_handler_t + IMPLICIT NONE - INTEGER, INTENT(IN) :: server_comm - type(multio_configuration) :: conf_ctx - INTEGER :: err - CHARACTER(len=16) :: err_str + + INTEGER, INTENT(IN) :: server_comm + + TYPE(multio_configuration) :: conf_ctx + INTEGER :: err + CHARACTER(len=16) :: err_str + PROCEDURE(failure_handler_t), POINTER :: pf IF (lnomultio) RETURN @@ -216,7 +229,8 @@ SUBROUTINE iom_init_server(server_comm) ! Setting a failure handler that reacts on interface problems or exceptions that are not handled within the interface ! Set handler before invoking blocking start server call - err = conf_ctx%set_failure_handler(multio_custom_error_handler, mio_parent_comm) + pf => multio_custom_error_handler + err = conf_ctx%set_failure_handler(pf, mio_parent_comm) IF (err /= MULTIO_SUCCESS) THEN CALL ctl_stop('setting multio failure handler failed: ', multio_error_string(err)) END IF @@ -268,27 +282,27 @@ SUBROUTINE iom_send_fesom_domains(partit, mesh) CALL ctl_stop('send_fesom_domains: ngrid, md%new() failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("name", "N grid") + cerr = md%set("name", "N grid") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: ngrid, md%set_string(name) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("category", "fesom-domain-nodemap") + cerr = md%set("category", "fesom-domain-nodemap") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: ngrid, md%set_string(category) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("representation", "unstructured") + cerr = md%set("representation", "unstructured") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: ngrid, md%set_string(representation) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_int("globalSize", mesh%nod2D) + cerr = md%set("globalSize", mesh%nod2D) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: ngrid, md%set_int(globalSize) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_bool("toAllServers", .TRUE._1) + cerr = md%set("toAllServers", .TRUE._1) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: ngrid, md%set_bool(toAllServers) failed: ', multio_error_string(cerr)) END IF @@ -310,27 +324,27 @@ SUBROUTINE iom_send_fesom_domains(partit, mesh) CALL ctl_stop('send_fesom_domains: egrid, md%new() failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("name", "C grid") + cerr = md%set("name", "C grid") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: egrid, md%set_string(name) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("category", "fesom-domain-elemmap") + cerr = md%set("category", "fesom-domain-elemmap") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: egrid, md%set_string(category) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("representation", "unstructured") + cerr = md%set("representation", "unstructured") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: egrid, md%set_string(representation) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_int("globalSize", mesh%elem2D) + cerr = md%set("globalSize", mesh%elem2D) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: egrid, md%set_int(globalSize) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_bool("toAllServers", .TRUE._1) + cerr = md%set("toAllServers", .TRUE._1) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_domains: egrid, md%set_bool(toAllServers) failed: ', multio_error_string(cerr)) END IF @@ -362,69 +376,69 @@ SUBROUTINE iom_send_fesom_data(data) CALL ctl_stop('send_fesom_data: md%new() failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("category", data%category) + cerr = md%set("category", data%category) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(category) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_int("globalSize", data%globalSize) + cerr = md%set("globalSize", data%globalSize) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_int(globalSize) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_int("level", data%level) + cerr = md%set("level", data%level) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_int(level) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_bool("toAllServers", .FALSE._1) + cerr = md%set("toAllServers", .FALSE._1) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_bool(toAllServers) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("name", trim(data%name)) + cerr = md%set("name", trim(data%name)) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(name) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("gridType", "unstructured_grid") + cerr = md%set("gridType", "unstructured_grid") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(gridType) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("unstructuredGridType", MeshId) + cerr = md%set("unstructuredGridType", MeshId) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(unstructuredGridType) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("unstructuredGridSubtype", data%gridType(1:1)) + cerr = md%set("unstructuredGridSubtype", data%gridType(1:1)) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(unstructuredGridSubtype) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("operation", "average") + cerr = md%set("operation", "average") IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(operation) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_string("domain", data%gridType) + cerr = md%set("domain", data%gridType) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_string(domain) failed: ', multio_error_string(cerr)) END IF - cerr = md%set_int("currentDate", data%currentDate) - cerr = md%set_int("currentTime", data%currentTime) - cerr = md%set_int("previousDate", data%previousDate) - cerr = md%set_int("previousTime", data%previousTime) - cerr = md%set_int("startDate", data%startDate) - cerr = md%set_int("startTime", data%startTime) - cerr = md%set_int("sampleInterval", data%sampleInterval) + cerr = md%set("currentDate", data%currentDate) + cerr = md%set("currentTime", data%currentTime) + cerr = md%set("previousDate", data%previousDate) + cerr = md%set("previousTime", data%previousTime) + cerr = md%set("startDate", data%startDate) + cerr = md%set("startTime", data%startTime) + cerr = md%set("sampleInterval", data%sampleInterval) ! cerr = md%set_int("sampleIntervalInSeconds", data%sampleInterval) - cerr = md%set_string("sampleIntervalUnit", 'S') - cerr = md%set_int("sampleIntervalInSeconds", data%sampleInterval) - cerr = md%set_int("timeStep", data%sampleInterval) !we do not distinguish between the timestep & sampling interval legacy code for MULTIO - cerr = md%set_int("step-frequency", data%lastcounter) - cerr = md%set_int("step", data%step) + cerr = md%set("sampleIntervalUnit", 'S') + cerr = md%set("sampleIntervalInSeconds", data%sampleInterval) + cerr = md%set("timeStep", data%sampleInterval) !we do not distinguish between the timestep & sampling interval legacy code for MULTIO + cerr = md%set("step-frequency", data%lastcounter) + cerr = md%set("step", data%step) IF (cerr /= MULTIO_SUCCESS) THEN CALL ctl_stop('send_fesom_data: md%set_int(date) failed: ', multio_error_string(cerr)) END IF