source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/iophy_xios.f90 @ 3757

! 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