! defined : CPP_IOIPSL, CPP_XIOS, CPP_IOIPSL_NO_OUTPUT ! ok_all_xml must be true MODULE iophy_xios use iophy, only: check_dim implicit none INTERFACE histwrite_phy MODULE PROCEDURE histwrite2d_phy, histwrite3d_phy, histwrite0d_xios END INTERFACE CONTAINS subroutine debug_print(message) USE print_control_mod, ONLY: lunout, prt_level character(*) :: message IF (prt_level >= 10) THEN WRITE (lunout, *) message ENDIF end subroutine SUBROUTINE histwrite2d_phy(var, field) USE mod_phys_lmdz_para, ONLY: is_master USE phys_output_var_mod, ONLY: ctrl_out USE xios_interface, ONLY: xios_field_is_active USE print_control_mod, ONLY: lunout IMPLICIT NONE INCLUDE 'clesphys.h' TYPE(ctrl_out), INTENT(INOUT) :: var REAL, DIMENSION(:), INTENT(IN) :: field if(.not. var%check_enabled) then !$omp barrier !$omp master var%enabled = xios_field_is_active(trim(var%name), at_current_timestep_arg=.false.) var%check_enabled = .true. !$omp end master !$omp barrier endif if(.not. var%enabled) return call histwrite2d_xios(trim(var%name), field) END SUBROUTINE histwrite2d_phy SUBROUTINE histwrite3d_phy(var, field) USE mod_phys_lmdz_para, ONLY: is_master USE phys_output_var_mod, ONLY: ctrl_out USE print_control_mod, ONLY: lunout USE xios_interface, ONLY: xios_field_is_active IMPLICIT NONE INCLUDE 'clesphys.h' TYPE(ctrl_out), INTENT(INOUT) :: var REAL, DIMENSION(:, :), INTENT(IN) :: field ! --> field(klon,:) if(.not. var%check_enabled) then !$omp barrier !$omp master var%enabled = xios_field_is_active(trim(var%name), at_current_timestep_arg=.false.) var%check_enabled = .true. !$omp end master !$omp barrier endif if(.not. var%enabled) return call histwrite3d_xios(trim(var%name), field) END SUBROUTINE histwrite3d_phy SUBROUTINE histwrite2d_xios(field_name, field) USE dimphy, ONLY: klon, klev USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & jj_nb, klon_mpi, is_master USE mod_grid_phy_lmdz, ONLY: nbp_lon, grid_type, unstructured, regular_lonlat USE xios_interface, ONLY: xios_send_field USE print_control_mod, ONLY: lunout IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: field_name REAL, DIMENSION(:), INTENT(IN) :: field REAL, DIMENSION(klon_mpi) :: buffer_omp REAL :: Field2d(nbp_lon, jj_nb) IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite2d_xios for ', field_name call debug_print('Begin histrwrite2d_xios '//field_name) if( SIZE(field)==klon .and. grid_type == unstructured ) then ! This is a thread-distributed array on unstructured grid : need gather CALL Gather_omp(field, buffer_omp) !$omp master CALL xios_send_field(field_name, buffer_omp) !$omp end master else if( SIZE(field)==klon .and. grid_type == regular_lonlat) then ! This is a thread-distributed array on lonlat grid : need gather + grid1Dto2D CALL Gather_omp(field, buffer_omp) !$omp master CALL grid1Dto2D_mpi(buffer_omp, Field2d) !IF(.NOT.clef_stations(iff)) THEN CALL xios_send_field(field_name, Field2d) !$omp end master else if( SIZE(field) == klev .OR. SIZE(field) == klev + 1 ) then ! This is a thread-shared array : write directly !$omp master CALL xios_send_field(field_name, field) !$omp end master else CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev or unknown grid_type',1) endif call debug_print('End histrwrite2d_xios '//field_name) END SUBROUTINE histwrite2d_xios SUBROUTINE histwrite3d_xios(field_name, field) USE dimphy, ONLY: klon, klev USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & jj_nb, klon_mpi, is_master USE xios_interface, ONLY: xios_send_field USE mod_grid_phy_lmdz, ONLY: nbp_lon, grid_type, regular_lonlat, unstructured USE print_control_mod, ONLY: lunout IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: field_name REAL, DIMENSION(:, :), INTENT(IN) :: field ! --> field(klon,:) REAL, DIMENSION(klon_mpi, SIZE(field, 2)) :: buffer_omp REAL :: Field3d(nbp_lon, jj_nb, SIZE(field, 2)) INTEGER :: buffer_size_2 buffer_size_2 = SIZE(field, 2) if( buffer_size_2 == klev+1 ) buffer_size_2 = klev IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite3d_xios for ', field_name call debug_print('Begin histrwrite3d_xios '//field_name) IF( SIZE(field, 1) == klev .OR. SIZE(field, 1) == klev + 1 ) THEN !$omp master CALL xios_send_field(field_name, field(:,1:buffer_size_2)) !$omp end master ELSE IF ( SIZE(field, 1) == klon .and. grid_type == unstructured ) THEN CALL Gather_omp(field, buffer_omp) !$omp master CALL xios_send_field(field_name, buffer_omp(:, 1:buffer_size_2)) !$omp end master ELSE IF ( SIZE(field, 1) == klon .and. grid_type == regular_lonlat ) THEN CALL Gather_omp(field, buffer_omp) !$omp master CALL grid1Dto2D_mpi(buffer_omp, field3d) !IF (.NOT.clef_stations(iff)) THEN CALL xios_send_field(field_name, Field3d(:, :, 1:buffer_size_2)) !$omp end master ELSE write (lunout, *) ' histrwrite3d_xios ', field_name, SIZE(field) CALL abort_physic('iophy::histwrite3d_xios', 'Field first DIMENSION not equal to klon/klev, or unknown grid_type', 1) END IF call debug_print('End histrwrite3d_xios '//field_name) END SUBROUTINE histwrite3d_xios SUBROUTINE histwrite0d_xios(field_name, field) USE xios_interface, ONLY: xios_send_field USE mod_phys_lmdz_para, ONLY: is_master USE print_control_mod, ONLY: lunout IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: field_name REAL, INTENT(IN) :: field ! --> scalar IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite0d_xios for ', field_name !$omp MASTER CALL xios_send_field(field_name, field) !$omp END MASTER END SUBROUTINE histwrite0d_xios END MODULE iophy_xios