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

Last change on this file since 3754 was 3754, checked in by adurocher, 4 years ago

Fix conditional compilation to compile without XIOS

File size: 6.1 KB
Line 
1! defined : CPP_IOIPSL, CPP_XIOS, CPP_IOIPSL_NO_OUTPUT
2! ok_all_xml must be true
3MODULE iophy_xios
4  use iophy, only: check_dim
5  implicit none
6
7  INTERFACE histwrite_phy
8    MODULE PROCEDURE histwrite2d_phy, histwrite3d_phy,  histwrite0d_xios
9  END INTERFACE
10
11CONTAINS
12  subroutine debug_print(message)
13    USE print_control_mod, ONLY: lunout, prt_level
14    character(*) :: message
15    IF (prt_level >= 10) THEN
16      WRITE (lunout, *) message
17    ENDIF
18  end subroutine
19
20  SUBROUTINE histwrite2d_phy(var, field)
21    USE mod_phys_lmdz_para, ONLY: is_master
22    USE phys_output_var_mod, ONLY: ctrl_out
23    USE xios_interface, ONLY: xios_field_is_active
24    USE print_control_mod, ONLY: lunout
25    IMPLICIT NONE
26    INCLUDE 'clesphys.h'
27
28    TYPE(ctrl_out), INTENT(INOUT) :: var
29    REAL, DIMENSION(:), INTENT(IN) :: field
30
31    if(.not. var%check_enabled) then
32      !$omp barrier
33      !$omp master
34      var%enabled = xios_field_is_active(trim(var%name), at_current_timestep_arg=.false.)
35      var%check_enabled = .true.
36      !$omp end master
37      !$omp barrier
38    endif
39    if(.not. var%enabled) return
40
41    call histwrite2d_xios(trim(var%name), field)
42
43  END SUBROUTINE histwrite2d_phy
44
45  SUBROUTINE histwrite3d_phy(var, field)
46    USE mod_phys_lmdz_para, ONLY: is_master
47    USE phys_output_var_mod, ONLY: ctrl_out
48    USE print_control_mod, ONLY: lunout
49    USE xios_interface, ONLY: xios_field_is_active
50    IMPLICIT NONE
51    INCLUDE 'clesphys.h'
52
53    TYPE(ctrl_out), INTENT(INOUT) :: var
54    REAL, DIMENSION(:, :), INTENT(IN) :: field ! --> field(klon,:)
55
56    if(.not. var%check_enabled) then
57      !$omp barrier
58      !$omp master
59      var%enabled = xios_field_is_active(trim(var%name), at_current_timestep_arg=.false.)
60      var%check_enabled = .true.
61      !$omp end master
62      !$omp barrier
63    endif
64    if(.not. var%enabled) return
65
66    call histwrite3d_xios(trim(var%name), field)
67
68  END SUBROUTINE histwrite3d_phy
69
70  SUBROUTINE histwrite2d_xios(field_name, field)
71
72    USE dimphy, ONLY: klon, klev
73    USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
74                                  jj_nb, klon_mpi, is_master
75    USE mod_grid_phy_lmdz, ONLY: nbp_lon, grid_type, unstructured, regular_lonlat
76    USE xios_interface, ONLY: xios_send_field
77    USE print_control_mod, ONLY: lunout
78
79    IMPLICIT NONE
80
81    CHARACTER(LEN=*), INTENT(IN) :: field_name
82    REAL, DIMENSION(:), INTENT(IN) :: field
83
84    REAL, DIMENSION(klon_mpi) :: buffer_omp
85    REAL :: Field2d(nbp_lon, jj_nb)
86
87    IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite2d_xios for ', field_name
88
89    call debug_print('Begin histrwrite2d_xios '//field_name)
90
91    if( SIZE(field)==klon .and. grid_type == unstructured ) then
92      ! This is a thread-distributed array on unstructured grid : need gather
93      CALL Gather_omp(field, buffer_omp)
94      !$omp master
95        CALL xios_send_field(field_name, buffer_omp)
96      !$omp end master
97    else if( SIZE(field)==klon .and. grid_type == regular_lonlat) then
98      ! This is a thread-distributed array on lonlat grid : need gather + grid1Dto2D
99      CALL Gather_omp(field, buffer_omp)
100      !$omp master
101        CALL grid1Dto2D_mpi(buffer_omp, Field2d)
102        !IF(.NOT.clef_stations(iff)) THEN
103        CALL xios_send_field(field_name, Field2d)
104      !$omp end master
105    else if( SIZE(field) == klev .OR. SIZE(field) == klev + 1 ) then
106      ! This is a thread-shared array : write directly
107      !$omp master
108        CALL xios_send_field(field_name, field)
109      !$omp end master
110    else
111      CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev or unknown grid_type',1)
112    endif
113
114    call debug_print('End histrwrite2d_xios '//field_name)
115  END SUBROUTINE histwrite2d_xios
116
117  SUBROUTINE histwrite3d_xios(field_name, field)
118
119    USE dimphy, ONLY: klon, klev
120    USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, &
121                                  jj_nb, klon_mpi, is_master
122    USE xios_interface, ONLY: xios_send_field
123    USE mod_grid_phy_lmdz, ONLY: nbp_lon, grid_type, regular_lonlat, unstructured
124    USE print_control_mod, ONLY: lunout
125
126    IMPLICIT NONE
127
128    CHARACTER(LEN=*), INTENT(IN) :: field_name
129    REAL, DIMENSION(:, :), INTENT(IN) :: field ! --> field(klon,:)
130
131    REAL, DIMENSION(klon_mpi, SIZE(field, 2)) :: buffer_omp
132    REAL :: Field3d(nbp_lon, jj_nb, SIZE(field, 2))
133
134    INTEGER :: buffer_size_2
135
136    buffer_size_2 = SIZE(field, 2)
137    if( buffer_size_2 == klev+1 ) buffer_size_2 = klev
138
139    IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite3d_xios for ', field_name
140
141    call debug_print('Begin histrwrite3d_xios '//field_name)
142
143    IF( SIZE(field, 1) == klev .OR. SIZE(field, 1) == klev + 1 ) THEN
144      !$omp master
145        CALL xios_send_field(field_name, field(:,1:buffer_size_2))
146      !$omp end master
147    ELSE IF ( SIZE(field, 1) == klon .and. grid_type == unstructured ) THEN
148      CALL Gather_omp(field, buffer_omp)
149      !$omp master
150        CALL xios_send_field(field_name, buffer_omp(:, 1:buffer_size_2))
151      !$omp end master
152    ELSE IF ( SIZE(field, 1) == klon .and. grid_type == regular_lonlat ) THEN
153      CALL Gather_omp(field, buffer_omp)
154      !$omp master
155        CALL grid1Dto2D_mpi(buffer_omp, field3d)
156        !IF (.NOT.clef_stations(iff)) THEN
157        CALL xios_send_field(field_name, Field3d(:, :, 1:buffer_size_2))
158      !$omp end master
159    ELSE
160      write (lunout, *) ' histrwrite3d_xios ', field_name, SIZE(field)
161      CALL abort_physic('iophy::histwrite3d_xios', 'Field first DIMENSION not equal to klon/klev, or unknown grid_type', 1)
162    END IF
163   
164    call debug_print('End histrwrite3d_xios '//field_name)
165
166  END SUBROUTINE histwrite3d_xios
167
168  SUBROUTINE histwrite0d_xios(field_name, field)
169    USE xios_interface, ONLY: xios_send_field
170    USE mod_phys_lmdz_para, ONLY: is_master
171    USE print_control_mod, ONLY: lunout
172    IMPLICIT NONE
173
174    CHARACTER(LEN=*), INTENT(IN) :: field_name
175    REAL, INTENT(IN) :: field ! --> scalar
176
177    IF (check_dim .AND. is_master) WRITE (lunout, *) 'histwrite0d_xios for ', field_name
178
179    !$omp MASTER
180    CALL xios_send_field(field_name, field)
181    !$omp END MASTER
182
183  END SUBROUTINE histwrite0d_xios
184END MODULE iophy_xios
Note: See TracBrowser for help on using the repository browser.