source: CONFIG_DEVT/LMDZOR_V6.2_work_ENSEMBLES/modeles/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 5493

Last change on this file since 5493 was 5493, checked in by ymipsl, 15 months ago

Ensemble management for orchidee.

YM

File size: 51.5 KB
Line 
1! ================================================================================================================================
2!  MODULE       : xios_orchidee
3!
4!  CONTACT      : orchidee-help _at_ listes.ipsl.fr
5!
6!  LICENCE      : IPSL (2006)
7!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8!
9!>\BRIEF   This module contains the initialization and interface to the XIOS code.
10!!
11!!\n DESCRIPTION: This module contains the interface for the use of the XIOS code. All call to XIOS are done in this module.
12!!                Revision 965 of XIOS/trunk or later is needed. This version is also called XIOS2.
13!!                Older revisions and XIOS1 can not be used.
14!!               
15!!                Summury of subroutines
16!!                      xios_orchidee_comm_init       : First call to XIOS to get the MPI communicator
17!!                      xios_orchidee_init            : Initialize variables needed for use of XIOS
18!!                                                      Deactivation of fields not calculated due specific run options
19!!                      xios_orchidee_update_calendar : Update the calandar in XIOS
20!!                      xios_orchidee_finalize        : Last call to XIOS for finalization
21!!                      xios_orchidee_send_field      : Interface to send fields with 1, 2 or 3 dimensions to XIOS
22!!                      xios_orchidee_send_field_r1d  : Internal subroutine for 1D(array) fields
23!!                      xios_orchidee_send_field_r2d  : Internal subroutine for 2D fields
24!!                      xios_orchidee_send_field_r3d  : Internal subroutine for 3D fields
25!!
26!!                It is only possible to use XIOS2. Note that compilation must be done with the preprocessing key XIOS
27!!                and CPP_PARA. Compiling without these keys makes it impossible to activate XIOS.
28!!                To activate running using XIOS, the flag XIOS_ORCHIDEE_OK=y must be set in run.def and the file iodef.xml must exist. 
29!!
30!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
31!!                   Removed possibility to use XIOS1, 21/10/2016
32!!
33!! REFERENCE(S) : None
34!!
35!! SVN          :
36!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/xios_orchidee.f90 $
37!! $Date: 2019-08-05 11:11:40 +0200 (Mon, 05 Aug 2019) $
38!! $Revision: 6151 $
39!! \n
40!_ ================================================================================================================================
41
42MODULE xios_orchidee
43
44#ifdef XIOS
45  USE xios
46#endif
47  USE defprec
48  USE pft_parameters_var, ONLY : nvm
49  USE constantes_var
50  USE constantes_soil_var, ONLY : nstm, nscm, diaglev, check_cwrr, ok_freeze_cwrr
51  USE time, ONLY : dt_sechiba
52  USE vertical_soil_var, ONLY : ngrnd, nslm
53  USE IOIPSL, ONLY : ioget_calendar, ju2ymds
54  USE mod_orchidee_para_var
55  USE mod_orchidee_transfert_para
56  USE ioipsl_para
57
58  IMPLICIT NONE
59  PRIVATE
60  PUBLIC :: xios_orchidee_init, xios_orchidee_change_context, &
61            xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
62            xios_orchidee_close_definition, &
63            xios_orchidee_send_field, xios_orchidee_recv_field, &
64            xios_orchidee_set_file_attr, xios_orchidee_set_field_attr, xios_orchidee_set_fieldgroup_attr, xios_orchidee_setvar
65
66
67  !
68  !! Declaration of public variables
69  !
70  LOGICAL, PUBLIC, SAVE           :: xios_orchidee_ok=.TRUE.     !! Use XIOS for diagnostic files
71  !$OMP THREADPRIVATE(xios_orchidee_ok)
72  LOGICAL, PUBLIC, SAVE           :: xios_interpolation          !! Do reading and interpolations with XIOS. If false, reading will be done with IOIOSL and interpolation using aggregate_p
73  !$OMP THREADPRIVATE(xios_interpolation)
74
75  REAL(r_std), PUBLIC, SAVE       :: xios_default_val=0          !! Default value (missing value) used in XIOS. The value 0 will be overwritten with the value taken from XIOS.
76  !$OMP THREADPRIVATE(xios_default_val)
77
78  !
79  !! Declaration of internal variables
80  !
81#ifdef XIOS
82  TYPE(xios_context)              :: ctx_hdl_orchidee      !! Handel for ORCHIDEE
83  !$OMP THREADPRIVATE(ctx_hdl_orchidee)
84#endif
85
86
87
88  !! ==============================================================================================================================
89  !! INTERFACE   : xios_orchidee_send_field
90  !!
91  !>\BRIEF         Send a field to XIOS.
92  !!
93  !! DESCRIPTION  :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
94  !!                  This interface should be called at each time-step for each output varaiables.
95  !!
96  !! \n
97  !_ ================================================================================================================================
98  INTERFACE xios_orchidee_send_field
99     MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d, &
100                      xios_orchidee_send_field_r4d, xios_orchidee_send_field_r5d
101  END INTERFACE
102
103  INTERFACE xios_orchidee_recv_field
104     MODULE PROCEDURE xios_orchidee_recv_field_r1d, xios_orchidee_recv_field_r2d, xios_orchidee_recv_field_r3d
105  END INTERFACE
106
107
108CONTAINS
109
110
111  !! ==============================================================================================================================
112  !! SUBROUTINE   : xios_orchidee_init
113  !!
114  !>\BRIEF         Initialize variables needed for use of XIOS.
115  !!
116  !! DESCRIPTION  :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step.
117  !!
118  !!                  In this subroutine also a section containg deactivation of some fields is found. The variables are
119  !!                  deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the
120  !!                  routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same
121  !!                  iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
122  !!                  is activated in the code can always be deactivated from the iodef.xml external file.
123  !!
124  !! \n
125  !_ ================================================================================================================================
126  SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH,                   &
127       date0,    year,      month,             day, julian_diff, &
128       lon_mpi,  lat_mpi,   soilth_lev )
129
130    USE grid, ONLY : grid_type, unstructured, regular_lonlat, regular_xy, nvertex, &
131                     longitude, latitude, bounds_lon, bounds_lat, ind_cell_glo
132    USE mod_orchidee_ensemble, ONLY : ensemble_management, whole_ensemble_size, whole_ensemble_rank, COMM_ORCHIDEE_ENSEMBLE
133    IMPLICIT NONE
134    !
135    !! 0. Variable and parameter declaration
136    !
137    !! 0.1 Input variables
138    !
139    INTEGER(i_std), INTENT(in)                            :: MPI_COMM_ORCH    !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
140    REAL(r_std), INTENT(in)                               :: date0            !! Julian day at first time step
141    INTEGER(i_std), INTENT(in)                            :: year, month, day !! Current date information
142    REAL(r_std), INTENT(in)                               :: julian_diff      !! Current day in the year [1,365(366)]
143    REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in)       :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
144    REAL(r_std),DIMENSION (ngrnd), INTENT(in)             :: soilth_lev       !! Vertical soil levels for thermal scheme (m)
145    !
146    !! 0.2 Local variables
147    !
148#ifdef XIOS
149
150    TYPE(xios_duration)            :: dtime_xios
151    TYPE(xios_date)                :: start_date
152    TYPE(xios_date)                :: time_origin
153    TYPE(xios_fieldgroup)          :: fieldgroup_handle
154    TYPE(xios_field)               :: field_handle
155    TYPE(xios_file)                :: file_handle
156#endif
157    INTEGER(i_std)                 :: i
158    INTEGER(i_std)                 :: year0, month0, day0 !! Time origin date information
159    REAL(r_std)                    :: sec0                !! Time origin date information
160    CHARACTER(LEN=20)              :: calendar_str        !! Name of current calendar
161    CHARACTER(LEN=30)              :: start_str           !! Current date as character string
162    CHARACTER(LEN=30)              :: startorig_str       !! Time origin date as character string
163
164    REAL(r_std),ALLOCATABLE        :: longitude_mpi(:), latitude_mpi(:)
165    REAL(r_std),ALLOCATABLE        :: bounds_lon_mpi(:,:),bounds_lat_mpi(:,:) 
166    INTEGER(i_std),ALLOCATABLE     :: ind_cell_mpi(:) 
167    LOGICAL                        :: xios_remap_output
168    !_ ================================================================================================================================
169   
170   
171    IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_init'
172
173    !Config Key   = XIOS_ORCHIDEE_OK
174    !Config Desc  = Use XIOS for writing diagnostics file
175    !Config If    =
176    !Config Def   = y
177    !Config Help  = Compiling and linking with XIOS library is necessary.
178    !Config Units = [FLAG]
179    CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
180    IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
181
182   
183    ! Coherence test between flag and preprocessing key
184#ifndef XIOS
185    IF (xios_orchidee_ok) THEN
186       CALL ipslerr_p(3,'xios_orchidee_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS',&
187            'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def', '')
188    END IF
189#endif
190
191
192
193    IF (xios_orchidee_ok) THEN
194      !Config Key   = XIOS_INTERPOLATION
195      !Config Desc  = Actiave reading and intrepolation using XIOS
196      !Config If    = XIOS_ORCHIDEE_OK
197      !Config Def   = n
198      !Config Help  = This flag allows the user to decide to use xios
199      !Config         interpolation or standard method for reading input files
200      !Config Units = [FLAG]
201      xios_interpolation = .FALSE.
202      CALL getin_p('XIOS_INTERPOLATION', xios_interpolation)
203
204
205      !Config Key   = XIOS_REMAP_OUTPUT
206      !Config Desc  = Actiave remaping of diagnostic output files to regular grid
207      !Config If    = XIOS_ORCHIDEE_OK .AND. grid_type=unstructured
208      !Config Def   = True
209      !Config Help  = Set this flag to false to output an unstructured grid on its natvie grid without interpolation
210      !Config Units = [FLAG]
211      xios_remap_output=.TRUE.
212      CALL getin_p("XIOS_REMAP_OUTPUT",xios_remap_output) 
213
214   ELSE
215      ! Deactivate interpolation with XIOS not possible wihtout having
216      ! xios_orchidee_ok=true
217      xios_interpolation = .FALSE.
218   END IF
219
220   ! Force xios_interpolation=.TRUE. if using unstructured grid
221   IF (grid_type==unstructured .AND. .NOT. xios_interpolation) THEN
222      WRITE(numout,*) 'xios_interpolation must be true for unstructured grid. It is now changed to true.'
223      xios_interpolation=.TRUE.
224   END IF
225   IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_interpolation=', xios_interpolation
226
227
228    !
229    !! 1. Set date and calendar information on the format needed by XIOS
230    !
231
232    ! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
233    CALL ioget_calendar(calendar_str)
234
235    IF (calendar_str == 'gregorian') THEN
236       calendar_str='gregorian'
237    ELSE IF (calendar_str == 'noleap') THEN
238       calendar_str='noleap'
239    ELSE IF (calendar_str == '360d') THEN
240       calendar_str='d360'
241    END IF
242
243    ! Transform the time origin from julian days into year, month, day and seconds
244    CALL ju2ymds(date0, year0, month0, day0, sec0)
245
246    IF (grid_type==unstructured) THEN
247      IF (is_omp_root) THEN
248        ALLOCATE(longitude_mpi(ij_nb))
249        ALLOCATE(latitude_mpi(ij_nb))
250        ALLOCATE(bounds_lon_mpi(ij_nb,nvertex))
251        ALLOCATE(bounds_lat_mpi(ij_nb,nvertex))
252        ALLOCATE(ind_cell_mpi(ij_nb))
253      ELSE
254        ALLOCATE(longitude_mpi(0))
255        ALLOCATE(latitude_mpi(0))
256        ALLOCATE(bounds_lon_mpi(0,0))
257        ALLOCATE(bounds_lat_mpi(0,0))
258        ALLOCATE(ind_cell_mpi(0))
259      ENDIF
260     
261      CALL gather_unindexed_omp(longitude,longitude_mpi)
262      CALL gather_unindexed_omp(latitude,latitude_mpi)
263      CALL gather_unindexed_omp(bounds_lon,bounds_lon_mpi)
264      CALL gather_unindexed_omp(bounds_lat,bounds_lat_mpi)
265      CALL gather_unindexed_omp(ind_cell_glo,ind_cell_mpi)
266    ENDIF
267   
268   
269    IF (xios_orchidee_ok .AND. is_omp_root) THEN
270#ifdef XIOS
271       !
272       !! 2. Context initialization
273       !
274       CALL xios_context_initialize("orchidee",COMM_ORCHIDEE_ENSEMBLE)
275       CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
276       CALL xios_set_current_context(ctx_hdl_orchidee)
277
278       !
279       !! 2. Calendar, timstep and date definition
280       !
281       dtime_xios%second=dt_sechiba
282
283       CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
284            time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
285
286       !
287       !! 3. Domain definition
288       !
289       IF (grid_type==regular_lonlat) THEN
290          ! Global domain
291          CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
292          ! Local MPI domain
293          CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
294         
295          ! Define how data is stored on memory : 1D array for only continental points
296          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
297          CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
298         
299          ! Define longitudes and latitudes on local MPI domain
300          CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
301         
302       ELSE IF (grid_type==regular_xy ) THEN
303          ! Case not yet fully implemented
304          CALL ipslerr_p(3,'xios_orchidee_init', 'Implemention for grid_type=regular_xy is not finalized',&
305               'Initialization of the domain must be looked over in the code', '')
306
307! Following was done in previous version for case grid_type=regular_xy
308!         ! Local MPI domain
309!          CALL xios_set_domain_attr("domain_landpoints",type="curvilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
310!
311!          ! Define how data is stored on memory : 1D array for only continental points
312!          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
313!          CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)     
314!
315!          ! Define longitudes and latitudes on local MPI domain depending on grid_type
316!          CALL xios_set_domain_attr("domain_landpoints",lonvalue_2d=lon_mpi,latvalue_2d=lat_mpi)
317
318       ELSE IF (grid_type==unstructured) THEN
319         
320          ! Global domain
321          CALL xios_set_domain_attr("domain_landpoints", ni_glo=jjm_g, type="unstructured", nvertex=nvertex)
322          ! Local MPI domain
323          CALL xios_set_domain_attr("domain_landpoints", ibegin=ij_begin-1, ni=ij_nb)
324         
325          ! Define how data is stored on memory : 1D array for only continental points
326          CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ni=nbp_mpi, data_i_index=kindex_mpi-1) 
327         
328          ! Define longitudes and latitudes on local MPI domain
329          CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=longitude_mpi,latvalue_1d=latitude_mpi)
330          CALL xios_set_domain_attr("domain_landpoints",bounds_lon_1d=RESHAPE(bounds_lon_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
331          CALL xios_set_domain_attr("domain_landpoints",bounds_lat_1d=RESHAPE(bounds_lat_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
332
333
334          IF (xios_remap_output) THEN
335             
336             ! Define output grid as domain_landpoints_regular (grid specified in xml files)
337             CALL xios_set_domain_attr("domain_landpoints_out",domain_ref="domain_landpoints_regular")
338             
339             CALL xios_set_fieldgroup_attr("remap_expr",expr="@this_ref")
340             CALL xios_set_fieldgroup_attr("remap_1ts",   freq_op=xios_duration_convert_from_string("1ts"))
341             CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s"))
342             CALL xios_set_fieldgroup_attr("remap_1h",    freq_op=xios_duration_convert_from_string("1h"))
343             CALL xios_set_fieldgroup_attr("remap_3h",    freq_op=xios_duration_convert_from_string("3h"))
344             CALL xios_set_fieldgroup_attr("remap_6h",    freq_op=xios_duration_convert_from_string("6h"))
345             CALL xios_set_fieldgroup_attr("remap_1d",    freq_op=xios_duration_convert_from_string("1d"))
346             CALL xios_set_fieldgroup_attr("remap_1mo",   freq_op=xios_duration_convert_from_string("1mo"))
347             CALL xios_set_fieldgroup_attr("remap_1y",    freq_op=xios_duration_convert_from_string("1y"))
348          ENDIF
349
350       END IF
351
352       !
353       !! 4. Axis definition
354       !
355       CALL xios_set_axis_attr("ensemble",n_glo=whole_ensemble_size,begin=whole_ensemble_rank, n=1)
356 
357       CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
358       CALL xios_set_axis_attr("nlut",n_glo=nlut ,VALUE=(/(REAL(i,r_std),i=1,nlut)/))
359       CALL xios_set_axis_attr("ncarb",n_glo=ncarb ,VALUE=(/(REAL(i,r_std),i=1,ncarb)/))
360       CALL xios_set_axis_attr("nparts",n_glo=nparts,VALUE=(/(REAL(i,r_std),i=1,nparts)/))
361       CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
362       CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=soilth_lev(:))
363       CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
364       CALL xios_set_axis_attr("ncsm", n_glo=nscm,VALUE=(/(REAL(i,r_std),i=1,nscm)/))
365       CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
366       CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
367       CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
368       CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
369       CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
370       CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
371       CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
372       CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
373             
374       !
375       !! 5. Get the default value (missing value) used by XIOS. This value is set in field_def_orchidee.xml
376       !
377       CALL xios_get_fieldgroup_attr("field_definition", default_value=xios_default_val)
378       IF (printlev>=2) WRITE(numout,*) 'Default value read from XIOS, xios_default_val=',xios_default_val
379
380       !
381       !! 5. Deactivation of some fields if they are not calculated
382       !
383       IF ( OFF_LINE_MODE ) THEN
384          CALL xios_set_field_attr("riverflow_cpl",enabled=.FALSE.)
385          CALL xios_set_field_attr("coastalflow_cpl",enabled=.FALSE.)
386       END IF
387
388       IF ( .NOT. river_routing ) THEN
389          CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
390          CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
391          CALL xios_set_field_attr("riversret",enabled=.FALSE.)
392          CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
393          CALL xios_set_field_attr("fastr",enabled=.FALSE.)
394          CALL xios_set_field_attr("slowr",enabled=.FALSE.)
395          CALL xios_set_field_attr("streamr",enabled=.FALSE.)
396          CALL xios_set_field_attr("laker",enabled=.FALSE.)
397          CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
398          CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
399          CALL xios_set_field_attr("pondr",enabled=.FALSE.)
400          CALL xios_set_field_attr("floodr",enabled=.FALSE.)
401          CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
402          CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
403          CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
404          CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
405          CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
406          CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
407          CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
408          CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
409          CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
410          CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
411          CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
412          CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
413          CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
414          CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
415          CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
416          CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
417          CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
418       END IF
419
420
421       IF (.NOT. ok_freeze_cwrr) THEN
422          CALL xios_set_field_attr("profil_froz_hydro",enabled=.FALSE.)
423          CALL xios_set_field_attr("temp_hydro",enabled=.FALSE.)
424       END IF
425
426       
427       IF (.NOT. check_cwrr) THEN
428          CALL xios_set_field_attr("check_infilt",enabled=.FALSE.)
429          CALL xios_set_field_attr("check_tr",enabled=.FALSE.)
430          CALL xios_set_field_attr("check_over",enabled=.FALSE.)
431          CALL xios_set_field_attr("check_under",enabled=.FALSE.)
432          CALL xios_set_field_attr("check_top",enabled=.FALSE.)
433          CALL xios_set_field_attr("qflux",enabled=.FALSE.)
434       END IF
435
436       IF ( .NOT. do_floodplains ) THEN
437          CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
438          CALL xios_set_field_attr("floodh",enabled=.FALSE.)       
439          CALL xios_set_field_attr("floodout",enabled=.FALSE.)       
440       END IF
441
442       ! Deactivate some stomate fields.
443       ! These fields were traditionally added in sechiba_history.nc output file.
444       IF ( .NOT. ok_stomate ) THEN
445          CALL xios_set_field_attr("nee",enabled=.FALSE.)
446          CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
447          CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
448          CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
449          CALL xios_set_field_attr("npp",enabled=.FALSE.)
450       END IF
451
452       IF ( .NOT. do_irrigation ) THEN
453          CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
454          CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
455          CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
456       END IF
457
458       IF ( .NOT. ok_bvoc)THEN
459          CALL xios_set_field_attr("PAR",enabled=.FALSE.)
460          CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
461          CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
462          CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
463          CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
464          CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
465          CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
466          CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
467          CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
468          CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
469          CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
470          CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
471          CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
472          CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
473          CALL xios_set_field_attr('flx_apinen'   ,enabled=.FALSE.)
474          CALL xios_set_field_attr('flx_bpinen'   ,enabled=.FALSE.)
475          CALL xios_set_field_attr('flx_limonen'  ,enabled=.FALSE.)
476          CALL xios_set_field_attr('flx_myrcen'   ,enabled=.FALSE.)
477          CALL xios_set_field_attr('flx_sabinen'  ,enabled=.FALSE.)
478          CALL xios_set_field_attr('flx_camphen'  ,enabled=.FALSE.)
479          CALL xios_set_field_attr('flx_3caren'   ,enabled=.FALSE.)
480          CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
481          CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
482          CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
483          CALL xios_set_field_attr("CRF",enabled=.FALSE.)
484          CALL xios_set_field_attr("fco2",enabled=.FALSE.)
485       END IF
486
487       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
488          CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
489          CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
490       END IF
491
492       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
493          CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
494          CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
495       END IF
496
497       IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
498          CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
499          CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
500          CALL xios_set_field_attr("laisun",enabled=.FALSE.)
501          CALL xios_set_field_attr("laish",enabled=.FALSE.)
502       END IF
503
504       IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
505          CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
506       END IF
507
508       IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
509          CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
510          CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
511       END IF
512
513       ! Set record_offset for enable start in the middle of the year.
514       ! julian_diff is the day of the year where the current run start
515       IF (printlev>=3) WRITE(numout,*) 'In xios_orchidee_init, julian_diff, INT(julian_diff) =', &
516            julian_diff, INT(julian_diff)
517
518       IF (ok_nudge_mc .AND. nudge_interpol_with_xios) THEN
519          ! Activate the input file with id="nudge_moistc" specified in file_def_orchidee.xml.
520          ! The nudging file should be called nudge_moistc.nc (see name in the xml file) and is
521          ! supposed to contain daily values for the full year for the variable moistc.
522          CALL xios_set_file_attr("nudge_moistc",enabled=.TRUE.)
523          ! Set record_offset to start read at correct day in the nudging file.
524          CALL xios_set_file_attr("nudge_moistc",record_offset=INT(julian_diff))
525       ELSE
526          ! Deactivate input file for nudging of soil moisture
527          CALL xios_set_file_attr("nudge_moistc",enabled=.FALSE.)
528          ! Deactivate variables related to soil moisture nudgnig
529          CALL xios_set_field_attr("mask_moistc_interp",enabled=.FALSE.)
530          CALL xios_set_field_attr("moistc_interp",enabled=.FALSE.)
531
532          ! Deactivate output variables related to soil moisture nudging
533          CALL xios_set_field_attr("mc_read_current",enabled=.FALSE.)
534          CALL xios_set_field_attr("mc_read_prev",enabled=.FALSE.)
535          CALL xios_set_field_attr("mc_read_next",enabled=.FALSE.)
536          CALL xios_set_field_attr("mask_mc_interp_out",enabled=.FALSE.)
537       END IF
538       IF (.NOT. ok_nudge_mc ) CALL xios_set_field_attr("nudgincsm",enabled=.FALSE.)
539
540       IF (ok_nudge_snow .AND. nudge_interpol_with_xios) THEN
541          ! Activate the input file with id="nudge_snow" specified in file_def_orchidee.xml.
542          ! The nudging file should be called nudge_snow.nc (see name in the xml file) and is
543          ! supposed to contain daily values for the full year for the variables snowdz, snowtemp and snowrho.
544          CALL xios_set_file_attr("nudge_snow",enabled=.TRUE.)
545          ! Set record_offset to start read at correct day in the nudging file.
546          CALL xios_set_file_attr("nudge_snow",record_offset=INT(julian_diff))
547       ELSE
548          ! Deactivate input file for nudging of snow variables
549          CALL xios_set_file_attr("nudge_snow",enabled=.FALSE.)
550
551          ! Deactivate input variables related to snow nudging
552          CALL xios_set_field_attr("mask_snow_interp",enabled=.FALSE.)
553          CALL xios_set_field_attr("snowdz_interp",enabled=.FALSE.)
554          CALL xios_set_field_attr("snowrho_interp",enabled=.FALSE.)
555          CALL xios_set_field_attr("snowtemp_interp",enabled=.FALSE.)
556
557          ! Deactivate output variables related to snow nudging
558          CALL xios_set_field_attr("snowdz_read_current",enabled=.FALSE.)
559          CALL xios_set_field_attr("snowdz_read_prev",enabled=.FALSE.)
560          CALL xios_set_field_attr("snowdz_read_next",enabled=.FALSE.)
561          CALL xios_set_field_attr("snowrho_read_current",enabled=.FALSE.)
562          CALL xios_set_field_attr("snowrho_read_prev",enabled=.FALSE.)
563          CALL xios_set_field_attr("snowrho_read_next",enabled=.FALSE.)
564          CALL xios_set_field_attr("snowtemp_read_current",enabled=.FALSE.)
565          CALL xios_set_field_attr("snowtemp_read_prev",enabled=.FALSE.)
566          CALL xios_set_field_attr("snowtemp_read_next",enabled=.FALSE.)
567          CALL xios_set_field_attr("mask_snow_interp_out",enabled=.FALSE.)
568       END IF
569       IF (.NOT. ok_nudge_snow) CALL xios_set_field_attr("nudgincswe",enabled=.FALSE.)
570
571       IF (impaze) THEN
572          CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
573          CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
574          CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
575          CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
576       END IF
577
578       IF (.NOT. do_wood_harvest) THEN
579          CALL xios_set_field_attr("PROD10_HARVEST",enabled=.FALSE.)
580          CALL xios_set_field_attr("FLUX10_HARVEST",enabled=.FALSE.)
581          CALL xios_set_field_attr("PROD100_HARVEST",enabled=.FALSE.)
582          CALL xios_set_field_attr("FLUX100_HARVEST",enabled=.FALSE.)
583          CALL xios_set_field_attr("CONVFLUX_HARVEST",enabled=.FALSE.)
584          CALL xios_set_field_attr("CFLUX_PROD10_HARVEST",enabled=.FALSE.)
585          CALL xios_set_field_attr("CFLUX_PROD100_HARVEST",enabled=.FALSE.)
586          CALL xios_set_field_attr("WOOD_HARVEST",enabled=.FALSE.)
587          CALL xios_set_field_attr("WOOD_HARVEST_PFT",enabled=.FALSE.)
588       END IF
589
590
591#endif
592    END IF
593
594    IF (xios_orchidee_ok) THEN
595       ! Send variables to all OMP thredds
596       CALL bcast(xios_default_val)
597       CALL bcast(almaoutput)
598    END IF
599
600    IF (printlev>=3) WRITE(numout,*) 'End xios_orchidee_init'
601  END SUBROUTINE xios_orchidee_init
602
603
604  SUBROUTINE xios_orchidee_close_definition
605
606    IF (printlev >=4) WRITE(numout,*) 'Start xios_orchidee_close_definition'
607    IF (xios_orchidee_ok .AND. is_omp_root) THEN
608#ifdef XIOS
609
610       !
611       !! 6. Close context
612       !
613       CALL xios_close_context_definition()     
614
615       !
616       !! 7. Activate almaoutput if needed
617       !! Some extra calculations have to be done for the variables 
618       !! delsoilmoist, delintercept, delswe and soilwet.
619       !! Set almaoutput=true if at least one of these variables are defined in an output file.
620       !! If not, keep the initial value of almaoutput.
621       IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
622            xios_field_is_active("delswe")       .OR. xios_field_is_active("soilwet")      .OR. &
623            xios_field_is_active("twbr")) THEN
624
625          almaoutput=.TRUE.
626          IF (printlev >=3) WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
627       END IF
628#endif
629    END IF
630
631    IF (xios_orchidee_ok) THEN
632       ! Send variables to all OMP thredds
633       CALL bcast(xios_default_val)
634       CALL bcast(almaoutput)
635    END IF
636    IF (printlev >=4) WRITE(numout,*) 'End xios_orchidee_close_definition'
637  END SUBROUTINE xios_orchidee_close_definition
638 
639 
640 
641  !! ==============================================================================================================================
642  !! SUBROUTINE   : xios_orchidee_change_context
643  !!
644  !>\BRIEF         Use this subroutine to switch between different context.
645  !!               This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
646  !!               begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
647  !!
648  !! DESCRIPTION  :\n
649  !!                 
650  !! \n
651  !_ ================================================================================================================================
652  SUBROUTINE xios_orchidee_change_context(new_context)
653    !
654    !! 0. Variable and parameter declaration
655    !
656    !!    Input variable
657    CHARACTER(LEN=*),INTENT(IN)              :: new_context
658
659    !! Local variables
660#ifdef XIOS
661    TYPE(xios_context) :: ctx_hdl
662#endif
663    !_ ================================================================================================================================
664
665    IF (xios_orchidee_ok .AND. is_omp_root) THEN
666#ifdef XIOS
667       CALL xios_get_handle(new_context,ctx_hdl)
668       CALL xios_set_current_context(ctx_hdl)
669#endif
670    END IF
671   
672  END SUBROUTINE xios_orchidee_change_context
673
674  !! ==============================================================================================================================
675  !! SUBROUTINE   : xios_orchidee_update_calendar
676  !!
677  !>\BRIEF          Update the calandar in XIOS.
678  !!
679  !! DESCRIPTION  :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
680  !!                  This subroutine should be called in the beginning of each time-step. The first
681  !!                  time-step in a new execution should always start at 1. Therefore, first calculate
682  !!                  an offset that is substracted to the current time step in sechiba.
683  !!
684  !! \n
685  !_ ================================================================================================================================
686  SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
687    !
688    !! 0. Variable and parameter declaration
689    !
690    !! 0.1 Input variables
691    !
692    INTEGER(i_std), INTENT(IN) :: itau_sechiba    !! Current time step of the model
693    !
694    !! 0.2 Local variables
695    !
696    LOGICAL, SAVE         :: first=.TRUE.         !! Flag for first entering in subroutine
697    INTEGER(i_std), SAVE  :: offset               !! Offset to substract from itau_sechiba
698    INTEGER(i_std)        :: itau_xios            !! Current time step for XIOS
699
700    !_ ================================================================================================================================
701
702    IF (xios_orchidee_ok .AND. is_omp_root) THEN
703#ifdef XIOS
704       ! Calculate the offset
705       IF (first) THEN
706          offset=itau_sechiba-1
707          first=.FALSE.
708       END IF
709
710       ! Substract the offset to the current time step in sechiba
711       itau_xios=itau_sechiba-offset
712
713       ! Send the new time step to XIOS
714       IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
715       CALL xios_update_calendar(itau_xios)
716#endif
717    END IF
718  END SUBROUTINE xios_orchidee_update_calendar
719  !! ==============================================================================================================================
720  !! SUBROUTINE   : xios_orchidee_context_finalize
721  !!
722  !>\BRIEF         Finalize orchidee context.
723  !!
724  !! DESCRIPTION  :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
725  !!                  modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
726  !!                  coupeld mode.
727  !!                 
728  !! \n
729  !_ ================================================================================================================================
730  SUBROUTINE xios_orchidee_context_finalize
731
732    !_ ================================================================================================================================
733
734    IF (xios_orchidee_ok .AND. is_omp_root) THEN
735       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
736#ifdef XIOS
737       CALL xios_context_finalize()
738#endif
739    END IF
740  END SUBROUTINE xios_orchidee_context_finalize
741
742
743  !! ==============================================================================================================================
744  !! SUBROUTINE   : xios_orchidee_finalize
745  !!
746  !>\BRIEF         Last call to XIOS for finalization.
747  !!
748  !! DESCRIPTION  :\n Last call to XIOS for finalization of the orchidee context and XIOS.
749  !!                  This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
750  !!                  model that finalizes XIOS. In that case, the context orchidee must be finalized using the
751  !!                  subroutine xios_orchidee_context_finalize
752  !!                 
753  !! \n
754  !_ ================================================================================================================================
755  SUBROUTINE xios_orchidee_finalize
756
757    !_ ================================================================================================================================
758
759    IF (xios_orchidee_ok .AND. is_omp_root) THEN
760       IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
761#ifdef XIOS
762       CALL xios_context_finalize()
763       CALL xios_finalize()
764#endif
765    END IF
766  END SUBROUTINE xios_orchidee_finalize
767
768
769  !! ==============================================================================================================================
770  !! SUBROUTINE   : xios_orchidee_send_field_r1d
771  !!
772  !>\BRIEF          Subroutine for sending 1D (array) fields to XIOS.
773  !!
774  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 1D fields (array).
775  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
776  !!
777  !! \n
778  !_ ================================================================================================================================
779  SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
780    !
781    !! 0. Variable and parameter declaration
782    !
783    !! 0.1 Input variables
784    !
785    CHARACTER(len=*), INTENT(IN)          :: field_id
786    REAL(r_std), DIMENSION(:), INTENT(IN) :: field
787
788    !! 0.2 Local variables
789    REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
790
791    !_ ================================================================================================================================
792    IF (xios_orchidee_ok) THEN
793       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
794
795       ! Gather all omp domains on the mpi domains
796       CALL gather_omp(field, field_mpi)
797
798       ! All master threads send the field to XIOS
799       IF (is_omp_root) THEN
800#ifdef XIOS
801          CALL xios_send_field(field_id,field_mpi)
802#endif
803       END IF
804    END IF
805  END SUBROUTINE xios_orchidee_send_field_r1d
806
807
808  !! ==============================================================================================================================
809  !! SUBROUTINE   : xios_orchidee_send_field_r2d
810  !!
811  !>\BRIEF          Subroutine for sending 2D fields to XIOS.
812  !!
813  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 2D fields.
814  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
815  !!
816  !! \n
817  !_ ================================================================================================================================
818  SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
819    !
820    !! 0. Variable and parameter declaration
821    !
822    !! 0.1 Input variables
823    !
824    CHARACTER(len=*), INTENT(IN)            :: field_id
825    REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
826
827    !! 0.2 Local variables
828    REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
829
830    !_ ================================================================================================================================
831    IF (xios_orchidee_ok) THEN
832       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
833
834       ! Gather all omp domains on the mpi domains
835       CALL gather_omp(field, field_mpi)
836
837       ! All master threads send the field to XIOS
838       IF (is_omp_root) THEN
839#ifdef XIOS
840          CALL xios_send_field(field_id,field_mpi)
841#endif
842       END IF
843    END IF
844  END SUBROUTINE xios_orchidee_send_field_r2d
845
846
847  !! ==============================================================================================================================
848  !! SUBROUTINE   : xios_orchidee_send_field_r3d
849  !!
850  !>\BRIEF          Subroutine for sending 3D fields to XIOS.
851  !!
852  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 3D fields.
853  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
854  !!
855  !! \n
856  !_ ================================================================================================================================
857  SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
858    !
859    !! 0. Variable and parameter declaration
860    !
861    !! 0.1 Input variables
862    !
863    CHARACTER(len=*), INTENT(IN)              :: field_id
864    REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
865
866    !! 0.2 Local variables
867    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
868
869    !_ ================================================================================================================================
870    IF (xios_orchidee_ok) THEN
871       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
872
873       ! Gather all omp domains on the mpi domains
874       CALL gather_omp(field, field_mpi)
875
876       ! All master threads send the field to XIOS
877       IF (is_omp_root) THEN
878#ifdef XIOS
879          CALL xios_send_field(field_id,field_mpi)
880#endif
881       END IF
882    END IF
883  END SUBROUTINE xios_orchidee_send_field_r3d
884
885  !! ==============================================================================================================================
886  !! SUBROUTINE   : xios_orchidee_send_field_r4d
887  !!
888  !>\BRIEF          Subroutine for sending 4D fields to XIOS.
889  !!
890  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 4D fields.
891  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
892  !!
893  !! \n
894  !_ ================================================================================================================================
895  SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
896    !
897    !! 0. Variable and parameter declaration
898    !
899    !! 0.1 Input variables
900    !
901    CHARACTER(len=*), INTENT(IN)              :: field_id
902    REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
903
904    !! 0.2 Local variables
905    INTEGER :: jv
906    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
907
908    !_ ================================================================================================================================
909    IF (xios_orchidee_ok) THEN
910       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
911
912       ! Gather all omp domains on the mpi domains
913       CALL gather_omp(field, field_mpi)
914
915       ! All master threads send the field to XIOS
916       IF (is_omp_root) THEN
917#ifdef XIOS
918          CALL xios_send_field(field_id,field_mpi)
919#endif
920       END IF
921    END IF
922  END SUBROUTINE xios_orchidee_send_field_r4d
923
924  !! ==============================================================================================================================
925  !! SUBROUTINE   : xios_orchidee_send_field_r5d
926  !!
927  !>\BRIEF          Subroutine for sending 5D fields to XIOS.
928  !!
929  !! DESCRIPTION  :\n Send one field to XIOS. This is the interface for 5D fields.
930  !!                  NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
931  !!
932  !! \n
933  !_ ================================================================================================================================
934  SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
935    !
936    !! 0. Variable and parameter declaration
937    !
938    !! 0.1 Input variables
939    !
940    CHARACTER(len=*), INTENT(IN)              :: field_id
941    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
942
943    !! 0.2 Local variables
944    INTEGER :: jv
945    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
946
947    !_ ================================================================================================================================
948    IF (xios_orchidee_ok) THEN
949       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
950
951       ! Gather all omp domains on the mpi domains
952       CALL gather_omp(field, field_mpi)
953
954       ! All master threads send the field to XIOS
955       IF (is_omp_root) THEN
956#ifdef XIOS
957          CALL xios_send_field(field_id,field_mpi)
958#endif
959       END IF
960    END IF
961  END SUBROUTINE xios_orchidee_send_field_r5d
962 
963  !! ==============================================================================================================================
964  !! SUBROUTINE   : xios_orchidee_recv_field_r2d
965  !!
966  !>\BRIEF          Subroutine for receiving 1D (kjpindex) fields to XIOS.
967  !!
968  !! DESCRIPTION  :\n
969  !!
970  !! \n
971  !_ ================================================================================================================================
972  SUBROUTINE xios_orchidee_recv_field_r1d(field_id,field)
973    !
974    !! 0. Variable and parameter declaration
975    !
976    !! 0.1 Input variables
977    !
978    CHARACTER(len=*), INTENT(IN)              :: field_id
979   
980    !! 0.2 Output variables
981    REAL(r_std), DIMENSION(:), INTENT(OUT)    :: field
982
983    !! 0.2 Local variables
984    REAL(r_std), DIMENSION(nbp_mpi)           :: field_mpi
985
986    !_ ================================================================================================================================
987    IF (xios_orchidee_ok) THEN
988       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r1d, field_id=',field_id
989
990       ! All master threads receive the field from XIOS
991       IF (is_omp_root) THEN
992#ifdef XIOS
993          CALL xios_recv_field(field_id,field_mpi)
994          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r1d, field_id=',field_id
995#endif
996       END IF
997
998       ! Scatter the mpi domains on local omp domains
999       CALL scatter_omp(field_mpi, field)
1000
1001    END IF
1002  END SUBROUTINE xios_orchidee_recv_field_r1d
1003
1004  !! ==============================================================================================================================
1005  !! SUBROUTINE   : xios_orchidee_recv_field_r2d
1006  !!
1007  !>\BRIEF          Subroutine for receiving 2D(kjpindex and 1 vertical axe) fields to XIOS.
1008  !!
1009  !! DESCRIPTION  :\n
1010  !!
1011  !! \n
1012  !_ ================================================================================================================================
1013  SUBROUTINE xios_orchidee_recv_field_r2d(field_id,field)
1014    !
1015    !! 0. Variable and parameter declaration
1016    !
1017    !! 0.1 Input variables
1018    !
1019    CHARACTER(len=*), INTENT(IN)              :: field_id
1020   
1021    !! 0.2 Output variables
1022    REAL(r_std), DIMENSION(:,:), INTENT(OUT)  :: field
1023
1024    !! 0.2 Local variables
1025    REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
1026
1027    !_ ================================================================================================================================
1028    IF (xios_orchidee_ok) THEN
1029       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r2d, field_id=',field_id
1030
1031       ! All master threads recieve the field from XIOS
1032       IF (is_omp_root) THEN
1033#ifdef XIOS
1034          CALL xios_recv_field(field_id,field_mpi)
1035          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r2d, field_id=',field_id
1036#endif
1037       END IF
1038
1039       ! Scatter the mpi domains on local omp domains
1040       CALL scatter_omp(field_mpi, field)
1041
1042    END IF
1043  END SUBROUTINE xios_orchidee_recv_field_r2d
1044
1045  !! ==============================================================================================================================
1046  !! SUBROUTINE   : xios_orchidee_recv_field_r3d
1047  !!
1048  !>\BRIEF          Subroutine for receiving 3D(kjpindex and 2 vertical axes) fields to XIOS.
1049  !!
1050  !! DESCRIPTION  :\n
1051  !!
1052  !! \n
1053  !_ ================================================================================================================================
1054  SUBROUTINE xios_orchidee_recv_field_r3d(field_id,field)
1055    !
1056    !! 0. Variable and parameter declaration
1057    !
1058    !! 0.1 Input variables
1059    !
1060    CHARACTER(len=*), INTENT(IN)              :: field_id
1061   
1062    !! 0.2 Output variables
1063    REAL(r_std), DIMENSION(:,:,:), INTENT(OUT) :: field
1064
1065    !! 0.2 Local variables
1066    REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
1067
1068    !_ ================================================================================================================================
1069    IF (xios_orchidee_ok) THEN
1070       IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r3d, field_id=',field_id
1071
1072       ! All master threads receive the field from XIOS
1073       IF (is_omp_root) THEN
1074#ifdef XIOS
1075          CALL xios_recv_field(field_id,field_mpi)
1076          IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r3d, field_id=',field_id
1077#endif
1078       END IF
1079
1080       ! Scatter the mpi domains on local omp domains
1081       CALL scatter_omp(field_mpi, field)
1082
1083    END IF
1084  END SUBROUTINE xios_orchidee_recv_field_r3d
1085
1086
1087
1088  SUBROUTINE xios_orchidee_set_file_attr(attr, name, enabled)
1089    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
1090    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
1091    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
1092
1093    IF (xios_orchidee_ok .AND. is_omp_root) THEN
1094
1095#ifdef XIOS
1096       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1097         CALL xios_set_file_attr(attr, name=name, enabled=enabled)
1098       ELSE IF (PRESENT(name)) THEN
1099         CALL xios_set_file_attr(attr, name=name)
1100       ELSE IF (PRESENT(enabled)) THEN
1101         CALL xios_set_file_attr(attr, enabled=enabled)
1102       ELSE
1103         CALL xios_set_file_attr(attr)
1104       END IF
1105#endif
1106
1107    END IF
1108
1109  END SUBROUTINE xios_orchidee_set_file_attr
1110 
1111  SUBROUTINE xios_orchidee_set_field_attr(attr,name, enabled)
1112    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
1113    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
1114    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
1115
1116    IF (xios_orchidee_ok .AND. is_omp_root) THEN
1117
1118#ifdef XIOS
1119       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1120         CALL xios_set_field_attr(attr, name=name, enabled=enabled)
1121       ELSE IF (PRESENT(name)) THEN
1122         CALL xios_set_field_attr(attr, name=name)
1123       ELSE IF (PRESENT(enabled)) THEN
1124         CALL xios_set_field_attr(attr, enabled=enabled)
1125       ELSE
1126         CALL xios_set_field_attr(attr)
1127       END IF
1128#endif
1129
1130    END IF
1131
1132
1133  END SUBROUTINE xios_orchidee_set_field_attr
1134 
1135  SUBROUTINE xios_orchidee_set_fieldgroup_attr(attr,name, enabled)
1136    CHARACTER(LEN=*), INTENT(IN)            :: attr     ! Name of the attribut
1137    CHARACTER(LEN=*), INTENT(IN), OPTIONAL  :: name     ! New name
1138    LOGICAL, INTENT(IN), OPTIONAL             :: enabled ! Flag
1139
1140    IF (xios_orchidee_ok .AND. is_omp_root) THEN
1141
1142#ifdef XIOS
1143       IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1144         CALL xios_set_fieldgroup_attr(attr, name=name, enabled=enabled)
1145       ELSE IF (PRESENT(name)) THEN
1146         CALL xios_set_fieldgroup_attr(attr, name=name)
1147       ELSE IF (PRESENT(enabled)) THEN
1148         CALL xios_set_fieldgroup_attr(attr, enabled=enabled)
1149       ELSE
1150         CALL xios_set_fieldgroup_attr(attr)
1151       END IF
1152#endif
1153
1154    END IF
1155
1156
1157  END SUBROUTINE xios_orchidee_set_fieldgroup_attr
1158 
1159  FUNCTION xios_orchidee_setvar(varname,varvalue) RESULT (out)
1160    CHARACTER(LEN=*), INTENT(IN) :: varname  ! Name of the variable
1161    REAL, INTENT(IN)               :: varvalue ! Value of the variable
1162    LOGICAL :: out
1163
1164    IF (xios_orchidee_ok .AND. is_omp_root) THEN
1165#ifdef XIOS
1166      out=xios_setvar(varname, varvalue)
1167#endif
1168    END IF
1169
1170  END FUNCTION xios_orchidee_setvar
1171
1172END MODULE xios_orchidee
1173
Note: See TracBrowser for help on using the repository browser.