source: trunk/LMDZ.MARS/libf/phymars/xios_output_mod.F90 @ 3026

Last change on this file since 3026 was 2941, checked in by romain.vande, 21 months ago

Mars Dynamico : Adapt routines to the new version of Dynamico and the subslope parametrization.
File size: 10.8 KB
Line 
1MODULE xios_output_mod
2
3 IMPLICIT NONE
4 
5 INTEGER,PRIVATE,SAVE :: time_it=0 ! store number of iterations with calls to XIOS since start
6! does not need to be threadprivate; managed by omp master
7
8 CHARACTER(LEN=*), PARAMETER :: context_id= "LMDZ" ! same as in context_lmdz_physics.xml
9 
10#ifdef CPP_XIOS
11
12 INTERFACE send_xios_field
13    MODULE PROCEDURE histwrite0d_xios,histwrite1d_xios,histwrite2d_xios,histwrite3d_xios
14 END INTERFACE
15 
16
17CONTAINS
18
19  SUBROUTINE initialize_xios_output(day,timeofday,dtphys,daysec,&
20                                    presnivs,pseudoalt,mlayer)
21  USE mod_phys_lmdz_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
22                                mpi_size, mpi_rank, klon_mpi, &
23                                is_sequential, is_south_pole_dyn
24  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
25  USE print_control_mod, ONLY: lunout, prt_level
26  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
27  USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
28  USE nrtype, ONLY: pi
29  use comslope_mod, ONLY: nslope,def_slope_mean
30#ifdef CPP_XIOS
31  USE xios
32#endif
33  USE wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_closedef
34  IMPLICIT NONE
35 
36  REAL,INTENT(IN) :: day ! Number of elapsed sols since reference Ls=0.
37  REAL,INTENT(IN) :: timeofday ! "Universal time", given as fraction of sol (e.g.: 0.5 for noon).
38  REAL,INTENT(IN) :: dtphys ! physics time step (s)
39  REAL,INTENT(IN) :: daysec ! lengthof a standard day (s)
40  REAL,INTENT(IN) :: presnivs(:) ! vertical grid approximate pressure (Pa)
41  REAL,INTENT(IN) :: pseudoalt(:) ! vertical grid approximate altitude (km)
42  REAL,INTENT(IN) :: mlayer(:) ! soil layer depth at intermediate level (m)
43 
44 
45  INTEGER :: data_ibegin, data_iend
46  TYPE(xios_duration) :: timestep
47  TYPE(xios_date) :: time_origin
48  TYPE(xios_date) :: start_date
49 
50!$OMP BARRIER
51!$OMP MASTER
52
53    ! 1. Declare available vertical axes to be used in output files:
54    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for presnivs"
55    CALL xios_set_axis_attr("presnivs", n_glo=size(presnivs), value=presnivs,&
56                            unit="Pa",positive="down")
57    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for altitude"
58    CALL xios_set_axis_attr("altitude", n_glo=size(pseudoalt), value=pseudoalt,&
59                            unit="km",positive="up")
60    CALL xios_set_axis_attr("interlayer", n_glo=size(pseudoalt)+1,&
61                            unit="km",positive="up")
62    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for soil"
63    CALL xios_set_axis_attr("soil_layers", n_glo=size(mlayer), value=mlayer,&
64                            unit="m",positive="down")
65    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for subslope"
66    CALL xios_set_axis_attr("subslope", n_glo=nslope, value=def_slope_mean,&
67                            unit="degree",positive="up")
68   
69    ! 2. Declare horizontal domain
70    ! Set values for the mask:
71!    IF (mpi_rank == 0) THEN
72!        data_ibegin = 0
73!    ELSE
74!        data_ibegin = ii_begin - 1
75!    END IF
76
77!    IF (mpi_rank == mpi_size-1) THEN
78!        data_iend = nbp_lon
79!    ELSE
80!        data_iend = ii_end + 1
81!    END IF
82
83!    if (prt_level>=10) then
84!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
85!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
86!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
87!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
88!      write(lunout,*) "initialize_xios_output: mpirank=",mpi_rank," is_south_pole=",is_south_pole_dyn
89!    endif
90
91!$OMP END MASTER
92!$OMP BARRIER
93    ! Initialize the XIOS domain coreesponding to this process:
94    if (prt_level>=10) write(lunout,*) "initialize_xios_output: call wxios_domain_param"
95!    CALL wxios_domain_param("dom_glo", is_sequential, nbp_lon, jj_nb, nbp_lon, nbp_lat, &
96!                            1, nbp_lon, ii_begin, ii_end, jj_begin, jj_end,             &
97!                            klon_mpi+2*(nbp_lon-1), data_ibegin, data_iend,             &
98!                            lat_reg*(180./pi), lon_reg*(180./pi),                       &
99!                            is_south_pole_dyn,mpi_rank)
100
101    IF (grid_type==unstructured) THEN
102      CALL wxios_domain_param_unstructured("dom_glo")
103    ELSE
104      CALL wxios_domain_param("dom_glo")
105    ENDIF
106
107!$OMP MASTER
108    ! 3. Declare calendar and time step
109    if (prt_level>=10) then
110     write(lunout,*) "initialize_xios_output: build calendar"
111    endif
112    timestep%second=1
113    if (nint(dtphys).ne.dtphys) then
114      write(*,*) "initialize_xios_output: warning physics timestep is not an integer!"
115    endif
116    if (nint(daysec).ne.daysec) then
117      write(*,*) "initialize_xios_output: warning day length is not an integer!"
118    endif
119    ! Important: do no operations involving dates and calendars
120    ! before defining the calendar!
121    CALL xios_define_calendar(type="user_defined", &
122                              timestep=timestep, &
123                              day_length=nint(daysec/dtphys), &
124                              month_lengths=[61,66,66,65,60,54,50,46,47,47,51,56])
125    !NB: it would make more sense to define months and their length in the
126    ! xml files and not to have them hard coded here.... to be improved...
127   
128    ! time origin of the simulation (default: 1st year/1st month/1st day, Ls=0)
129    time_origin=xios_date(1,1,1,0,0,0)
130    CALL xios_set_time_origin(time_origin=time_origin)
131!    if (prt_level>=10) then
132     write(lunout,*) "initialize_xios_output: time_origin=",time_origin
133!    endif
134
135    ! Now define the start time of this simulation
136    ! NB: we substract dtphys because we want to set the origin of the time axis
137    start_date=time_origin
138    call xios_set_start_date(start_date=start_date)
139    if (prt_level>=10) then
140     write(lunout,*) "initialize_xios_output: start_date=",start_date
141    endif
142
143    ! 4. Finalize the context:
144    if (prt_level>=10) write(*,*) "initialize_xios_output: call wxios_closedef"
145    CALL wxios_closedef()
146    if (prt_level>=10) write(*,*) "initialize_xios_output: after call wxios_closedef"
147
148!$OMP END MASTER
149!$OMP BARRIER
150 
151  END SUBROUTINE initialize_xios_output
152
153!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
154
155  SUBROUTINE finalize_xios_output
156  USE xios
157  IMPLICIT NONE
158!$OMP BARRIER   
159!$OMP MASTER
160    CALL xios_context_finalize
161!$OMP END MASTER   
162!$OMP BARRIER   
163 
164  END SUBROUTINE finalize_xios_output
165
166!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
167
168  SUBROUTINE update_xios_timestep
169  USE xios
170  IMPLICIT NONE
171    CALL set_xios_context
172!$OMP MASTER
173    time_it=time_it+1
174    CALL xios_update_calendar(time_it)
175!$OMP END MASTER   
176  END SUBROUTINE update_xios_timestep
177
178!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
179
180  SUBROUTINE set_xios_context
181  USE XIOS
182  IMPLICIT NONE
183    TYPE(xios_context) :: ctx_hdl
184
185!$OMP MASTER
186    CALL xios_get_handle(context_id,ctx_hdl)
187    CALL xios_set_current_context(ctx_hdl)
188!$OMP END MASTER   
189  END SUBROUTINE set_xios_context
190
191!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
192
193  SUBROUTINE histwrite0d_xios(field_name,field)
194  USE xios, ONLY: xios_send_field
195  USE print_control_mod, ONLY: prt_level, lunout
196  IMPLICIT NONE
197 
198    CHARACTER(LEN=*), INTENT(IN) :: field_name
199    REAL, INTENT(IN) :: field
200   
201    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite0d_xios ',trim(field_name)
202!$OMP MASTER
203    CALL xios_send_field(field_name,field)
204!$OMP END MASTER
205   
206    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite0d_xios ',trim(field_name)
207   
208  END SUBROUTINE histwrite0d_xios
209
210!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
211
212  SUBROUTINE histwrite1d_xios(field_name,field,dimens)
213  USE xios, ONLY: xios_send_field
214  USE print_control_mod, ONLY: prt_level, lunout
215  IMPLICIT NONE
216 
217    CHARACTER(LEN=*), INTENT(IN) :: field_name
218    REAL, DIMENSION(:), INTENT(IN) :: field
219    INTEGER, INTENT(IN) :: dimens
220    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite1d_xios ',trim(field_name)
221!$OMP MASTER
222    CALL xios_send_field(field_name,field)
223!$OMP END MASTER
224   
225    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite1d_xios ',trim(field_name)
226   
227  END SUBROUTINE histwrite1d_xios
228
229!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
230
231  SUBROUTINE histwrite2d_xios(field_name,field)
232  USE dimphy, only: klon
233  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
234                                jj_nb, klon_mpi
235  USE xios, only: xios_send_field
236  USE print_control_mod, ONLY: prt_level, lunout
237  USE mod_grid_phy_lmdz, ONLY: nbp_lon
238  IMPLICIT NONE
239
240    CHARACTER(LEN=*), INTENT(IN) :: field_name
241    REAL, DIMENSION(:), INTENT(IN) :: field
242     
243    REAL,DIMENSION(klon_mpi) :: buffer_omp
244    REAL :: Field2d(nbp_lon,jj_nb)
245
246    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
247    IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
248   
249    CALL Gather_omp(field,buffer_omp)   
250!$OMP MASTER
251    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
252   
253    CALL xios_send_field(field_name, Field2d)
254!$OMP END MASTER   
255
256    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',trim(field_name)
257  END SUBROUTINE histwrite2d_xios
258
259!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
260
261  SUBROUTINE histwrite3d_xios(field_name, field)
262  USE dimphy, only: klon, klev
263  USE mod_phys_lmdz_para, only: gather_omp, grid1Dto2D_mpi, &
264                                jj_nb, klon_mpi
265  USE xios, only: xios_send_field
266  USE print_control_mod, ONLY: prt_level,lunout
267  USE mod_grid_phy_lmdz, ONLY: nbp_lon
268
269  IMPLICIT NONE
270
271    CHARACTER(LEN=*), INTENT(IN) :: field_name
272    REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
273
274    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
275    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
276    INTEGER :: ip, n, nlev
277
278  IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',trim(field_name)
279
280    !Et on.... écrit
281    IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
282    nlev=SIZE(field,2)
283
284
285    CALL Gather_omp(field,buffer_omp)
286!$OMP MASTER
287    CALL grid1Dto2D_mpi(buffer_omp,field3d)
288
289    CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
290!$OMP END MASTER   
291
292    IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',trim(field_name)
293  END SUBROUTINE histwrite3d_xios
294
295#endif
296
297END MODULE xios_output_mod
Note: See TracBrowser for help on using the repository browser.