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

Last change on this file since 2932 was 2545, checked in by romain.vande, 3 years ago

MARS Dynamico:

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