Context Navigation

source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/build/ppsrc/INCA_PARA/xios_inca.f90 @ 6610

Last change on this file since 6610 was 6610, checked in by acosce, 10 months ago
INCA used for ICOLMDZORINCA_CO2_Transport_GMD_2023
File size: 43.2 KB

Line
1
2
3
4
5
6
7
8
9
10
11
12
13	MODULE xios_inca
14
15	USE xios
16	USE PRINT_INCA
17	USE MOD_GRID_INCA
18	USE MOD_INCA_MPI_DATA
19	USE MOD_INCA_PARA
20	USE MOD_CONST_MPI_INCA
21	USE CONST_LMDZ
22	USE IOIPSL
23	USE PARAM_CHEM
24	USE SURF_CHEM_MOD
25	USE RATE_INDEX_MOD
26	USE CHEM_TRACNM, ONLY: solsym
27	USE SPECIES_NAMES
28	USE AEROSOL_DIAG, ONLY : naero_grp, mrfname,mrfname_xml, mrfname_long, las, cla
29	USE AEROSOL_MOD
30
31	IMPLICIT NONE
32	PRIVATE
33	PUBLIC :: xios_inca_init , xios_inca_change_context, &
34	xios_inca_update_calendar, xios_inca_context_finalize, &
35	xios_inca_send_field, xios_inca_recv_field, xios_inca_recv_field_glo, xios_inca_recv_field_mpi
36
37	!
38	!! Declaration of internal variables
39	!
40	TYPE(xios_context) :: ctx_hdl_inca !! Handel for INCA
41	!$OMP THREADPRIVATE(ctx_hdl_inca)
42	TYPE(xios_fieldgroup) :: reacflux_hdl,reacrate_hdl, invoxy_hdl, phtrate_hdl, extfrc_hdl, extfrc_col_hdl, conc_spcs_hdl, emi_hdl, dryvd_hdl
43	TYPE(xios_fieldgroup) :: tauinca1_hdl, pizinca1_hdl, cginca1_hdl, tauinca2_hdl, pizinca2_hdl, cginca2_hdl
44	TYPE(xios_fieldgroup) :: drydep_hdl, hrate_hdl, od_hdl, od3d_hdl, source_hdl, emiNoBio_hdl,emiOrch_hdl
45	TYPE(xios_fieldgroup) :: source0_hdl, source0_read_hdl, invoxy0_hdl, invoxy0_read_hdl
46	TYPE(xios_fieldgroup) :: sed_hdl,wet_hdl,load_hdl,emialt_hdl,mdw_hdl,aerh2o_hdl
47	TYPE(xios_fieldgroup) :: tau1_hdl, tau2_hdl,piz1_hdl,piz2_hdl,cg1_hdl,cg2_hdl
48	TYPE(xios_fieldgroup) :: swtoaas_hdl,swtoacs_hdl,swsrfas_hdl,swsrfcs_hdl,fswtoaas_hdl,fswtoacs_hdl,fswsrfas_hdl,fswsrfcs_hdl, wetloss_hdl
49	TYPE(xios_field) :: child
50	!$OMP THREADPRIVATE(reacflux_hdl, reacrate_hdl,invoxy_hdl, phtrate_hdl, extfrc_hdl, extfrc_col_hdl, conc_spcs_hdl, emi_hdl,dryvd_hdl, child)
51	!$OMP THREADPRIVATE(tauinca1_hdl, pizinca1_hdl, cginca1_hdl, tauinca2_hdl, pizinca2_hdl, cginca2_hdl)
52	!$OMP THREADPRIVATE(drydep_hdl, hrate_hdl, od_hdl, od3d_hdl, source_hdl, emiNoBio_hdl,emiOrch_hdl)
53	!$OMP THREADPRIVATE(sed_hdl,wet_hdl,load_hdl,emialt_hdl,mdw_hdl,aerh2o_hdl)
54	!$OMP THREADPRIVATE(tau1_hdl, tau2_hdl,piz1_hdl,piz2_hdl,cg1_hdl,cg2_hdl)
55	!$OMP THREADPRIVATE(swtoaas_hdl,swtoacs_hdl,swsrfas_hdl,swsrfcs_hdl,fswtoaas_hdl,fswtoacs_hdl,fswsrfas_hdl,fswsrfcs_hdl, wetloss_hdl)
56	!$OMP THREADPRIVATE(source0_hdl, source0_read_hdl, invoxy0_hdl, invoxy0_read_hdl)
57
58	CHARACTER(len=*),PARAMETER :: id="client" !! Id for initialization of INCA in 1
59
60	! ====================================================================
61	! INTERFACE : xios_inca_send_field
62	!
63	! Send a field to 1.
64	!
65	! DESCRIPTION : Send a field to 1. The field can have 1, 2 or 3 dimensions.
66	! This interface should be called at each time-step for each output varaiables.
67	!
68	! ====================================================================
69
70	INTERFACE xios_inca_send_field
71	MODULE PROCEDURE xios_inca_send_field_r2d, xios_inca_send_field_r1d,xios_inca_send_field_r0d
72	END INTERFACE
73
74
75	INTERFACE xios_inca_recv_field
76	MODULE PROCEDURE xios_inca_recv_field_r0d, xios_inca_recv_field_r1d, xios_inca_recv_field_r2d,xios_inca_recv_field_r3d
77	END INTERFACE
78
79	INTERFACE xios_inca_recv_field_mpi
80	MODULE PROCEDURE xios_inca_recv_field_mpi_r1d
81	END INTERFACE
82
83	INTERFACE xios_inca_recv_field_glo
84	MODULE PROCEDURE xios_inca_recv_field_glo_r1d,xios_inca_recv_field_glo_r2d,xios_inca_recv_field_glo_r3d
85	END INTERFACE
86
87
88	CONTAINS
89	! ====================================================================
90	! SUBROUTINE : xios_inca_init
91	!
92	! Initialize variables needed for use of 1.
93	!
94	! DESCRIPTION : Initialization of specific varaiables needed to use 1 such as model domain and time step.
95	!
96	!
97	! ====================================================================
98
99	SUBROUTINE xios_inca_init(&
100	COMM_LMDZ, timestep, year, month, day, &
101	hour, ini_an, ini_mois, ini_jour, ini_heure, &
102	io_lon, io_lat, presnivs)
103
104
105	USE PARAM_CHEM, ONLY : use_group, LMDZ_10m_winds
106	USE MOD_GEOMETRY_INCA, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
107	USE MOD_GRID_INCA, ONLY : nvertex, plon_glo, grid_type, regular_lonlat, unstructured
108	USE MOD_INCA_MPI_DATA, ONLY : ij_nb
109	USE CONST_MOD, ONLY: PI
110	USE INCA_DIM
111	USE PRINT_INCA
112	IMPLICIT NONE
113
114	!
115	!! 0. Variable and parameter declaration
116	!
117	!! 0.1 Input variables
118	!
119	INTEGER, INTENT(in) :: COMM_LMDZ !! Inca MPI communicator (from module mod_inca_mpi_data)
120	INTEGER, INTENT(in) :: year, month, day, ini_an, ini_mois, ini_jour !! Current date information
121	REAL, INTENT(in) :: hour, ini_heure
122	REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
123	REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
124	REAL, INTENT(in) :: timestep
125	REAL, INTENT(in) :: presnivs(PLEV)
126	!
127	!! 0.2 Local variables
128	!
129	LOGICAL :: find
130	INTEGER :: i
131	INTEGER :: it,la
132	CHARACTER(LEN=30) :: start_str , time_orig !! Current date as character string
133
134	TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0)
135
136	LOGICAL :: mask(iim_glo,jj_nb) !Masque pour les problÃšmes de recouvrement MPI
137
138	REAL, DIMENSION(nbveget) :: veget
139	REAL, DIMENSION(nbsurf) :: surf
140	REAL, DIMENSION(PLEV+1) :: paprsniv
141	REAL, DIMENSION(PLEV) :: klev_value
142	REAL, DIMENSION(12) :: timeco2_value
143	REAL, DIMENSION(2920) :: timeco2h_value
144	INTEGER :: n, length, ni, nj
145	CHARACTER(len=13) :: tmp_name
146
147	! variables pour la grille non structuree de dynamico
148	REAL :: lon_mpi(plon_mpi)
149	REAL :: lat_mpi(plon_mpi)
150	REAL :: boundslon_mpi(plon_mpi,nvertex)
151	REAL :: boundslat_mpi(plon_mpi,nvertex)
152	INTEGER :: ind_cell_glo_mpi(plon_mpi)
153
154
155	! ===================================================================
156
157	!
158	!! 1. Set date and calendar information on the format needed by 1
159	!
160
161
162	IF (grid_type == unstructured) THEN
163
164	! write(,) ' dans xios_inca cell = ', ind_cell_glo
165	! call flush(6)
166
167	CALL gather_omp(longitude*180/PI,lon_mpi)
168	CALL gather_omp(latitude*180/PI,lat_mpi)
169	CALL gather_omp(boundslon*180/PI,boundslon_mpi)
170	CALL gather_omp(boundslat*180/PI,boundslat_mpi)
171	CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
172	endif
173
174
175	!$OMP MASTER
176	!
177	!! 2. Context initialization
178	!
179	CALL xios_context_initialize("inca",COMM_LMDZ)
180	CALL xios_get_handle("inca",ctx_hdl_inca)
181	CALL xios_set_current_context(ctx_hdl_inca)
182
183
184	! Groupes pour les restart
185	! ecriture
186	CALL xios_get_handle("source" , source_hdl )
187	CALL xios_get_handle("inv_oxy" , invoxy_hdl )
188	CALL xios_get_handle("tauinca1", tauinca1_hdl )
189	CALL xios_get_handle("pizinca1", pizinca1_hdl )
190	CALL xios_get_handle("cginca1" , cginca1_hdl )
191	CALL xios_get_handle("tauinca2", tauinca2_hdl )
192	CALL xios_get_handle("pizinca2", pizinca2_hdl )
193	CALL xios_get_handle("cginca2" , cginca2_hdl )
194
195	! lecture
196	CALL xios_get_handle("source0" , source0_hdl )
197	CALL xios_get_handle("invoxy0" , invoxy0_hdl )
198
199	CALL xios_get_handle("source0_read" , source0_read_hdl )
200	CALL xios_get_handle("invoxy0_read" , invoxy0_read_hdl )
201
202
203
204	! Groupes pour les output du code
205	IF(use_group)THEN
206
207	CALL xios_get_handle("reac_flux" , reacflux_hdl)
208	CALL xios_get_handle("reac_rate" , reacrate_hdl)
209	CALL xios_get_handle("photo_rate" , phtrate_hdl)
210	CALL xios_get_handle("ext_forc" , extfrc_hdl)
211	CALL xios_get_handle("ext_forc_col" , extfrc_col_hdl)
212	CALL xios_get_handle("conc_species" , conc_spcs_hdl)
213	CALL xios_get_handle("emi_species" , emi_hdl)
214	CALL xios_get_handle("emi_noBioNat" , emiNoBio_hdl)
215	CALL xios_get_handle("emi_FromOrch" , emiOrch_hdl)
216	CALL xios_get_handle("dryvd_species" , dryvd_hdl)
217	CALL xios_get_handle("drydep_species", drydep_hdl)
218	CALL xios_get_handle("henry_const" , hrate_hdl)
219	CALL xios_get_handle("Opt_thick" , od_hdl)
220	CALL xios_get_handle("Opt_thick3D" , od3d_hdl)
221	CALL xios_get_handle("sed_aero" , sed_hdl)
222	CALL xios_get_handle("wet_aero" , wet_hdl)
223	CALL xios_get_handle("load_aero" , load_hdl)
224	CALL xios_get_handle("emialt_aero" , emialt_hdl)
225	CALL xios_get_handle("mdw_aero" , mdw_hdl)
226	CALL xios_get_handle("aerh2o_aero" , aerh2o_hdl)
227	CALL xios_get_handle("oduvvis_aero", tau1_hdl)
228	CALL xios_get_handle("odvisir_aero", tau2_hdl)
229	CALL xios_get_handle("ssauvvis_aero", piz1_hdl)
230	CALL xios_get_handle("ssavisir_aero", piz2_hdl)
231	CALL xios_get_handle("asyuvvis_aero", cg1_hdl)
232	CALL xios_get_handle("asyvisir_aero", cg2_hdl)
233	CALL xios_get_handle("swtoaas_aero",swtoaas_hdl )
234	CALL xios_get_handle("swtoacs_aero",swtoacs_hdl )
235	CALL xios_get_handle("swsrfas_aero",swsrfas_hdl )
236	CALL xios_get_handle("swsrfcs_aero",swsrfcs_hdl )
237	CALL xios_get_handle("fswtoaas_aero",fswtoaas_hdl )
238	CALL xios_get_handle("fswtoacs_aero",fswtoacs_hdl )
239	CALL xios_get_handle("fswsrfas_aero",fswsrfas_hdl )
240	CALL xios_get_handle("fswsrfcs_aero",fswsrfcs_hdl )
241	CALL xios_get_handle("wetloss",wetloss_hdl )
242
243	ENDIF
244
245
246	!
247	!! 2. Calendar and date definition
248	!
249	!RÃ©glage du calendrier:
250	SELECT CASE (calend)
251	CASE('earth_360d')
252	CALL xios_define_calendar(TYPE="D360",time_origin=xios_date(year,month,day,INT(hour),0,0),start_date=xios_date(ini_an, ini_mois, ini_jour, INT(ini_heure),0,0))
253	CASE('earth_365d')
254	CALL xios_define_calendar(TYPE="NoLeap",time_origin=xios_date(year,month,day,INT(hour),0,0),start_date=xios_date(ini_an, ini_mois, ini_jour, INT(ini_heure),0,0))
255	CASE('gregorian')
256	CALL xios_define_calendar(TYPE="Gregorian",time_origin=xios_date(year,month,day,INT(hour),0,0),start_date=xios_date(ini_an, ini_mois, ini_jour, INT(ini_heure),0,0))
257	CASE DEFAULT
258	CALL print_err(3, 'wxios_set_cal',' Mauvais choix de calendrier', '', '')
259	END SELECT
260
261
262	!! 3. Send the time-step length to 1
263	!
264
265	dtime%second = timestep
266	CALL xios_set_timestep(dtime)
267
268	!
269	!! 4. Domain definition
270	!
271	! Global domain
272	!On parametrise le domaine:
273	! write(,) 'XIOS INCA initialisation grille ', grid_type, ' regular_lonlat = ', regular_lonlat, ' unstructured = ', unstructured
274
275	if (grid_type == regular_lonlat) THEN
276	CALL xios_set_domain_attr("dom_chem", ni_glo=iim_glo, ibegin=0, ni=iim_glo, TYPE="rectilinear")
277	CALL xios_set_domain_attr("dom_chem", nj_glo=jjm_glo, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
278	CALL xios_set_domain_attr("dom_chem", lonvalue_1D=(io_lon(1:iim_glo)+1000)-1000, latvalue_1D=io_lat(jj_begin:jj_end))
279
280
281	IF (.NOT.is_sequential) THEN
282	mask(:,:)=.TRUE.
283	IF (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
284	IF (ii_end<jj_nb) mask(ii_end+1:iim_glo,jj_nb) = .FALSE.
285	! special case for south pole
286	IF ((ii_end.EQ.1).AND.(is_south_pole)) mask(1:iim_glo,jj_nb)=.TRUE.
287	CALL xios_set_domain_attr("dom_chem", mask_1D=RESHAPE(mask(:,:),(/iim_glo*jj_nb/)))
288	END IF
289
290
291
292	ELSE IF (grid_type == unstructured) THEN
293
294	CALL xios_set_domain_attr("dom_chem", ni_glo=jjm_glo, type="unstructured", nvertex=nvertex)
295	CALL xios_set_domain_attr("dom_chem", ibegin=ij_begin-1, ni=ij_nb)
296	CALL xios_set_domain_attr("dom_chem", nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi)
297	CALL xios_set_domain_attr("dom_chem", bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
298	CALL xios_set_domain_attr("dom_chem", i_index=ind_cell_glo_mpi(:)-1)
299
300
301	IF (xios_remap_output) THEN
302	! Define output grid as domain_landpoints_regular (grid specified in xml files)
303	CALL xios_set_domain_attr("dom_chem_out",domain_ref="dom_chem_regular")
304
305	CALL xios_set_fieldgroup_attr("remap_expr",expr="@this_ref")
306	CALL xios_set_fieldgroup_attr("remap_1ts", freq_op=xios_duration_convert_from_string("1ts"))
307	CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s"))
308	CALL xios_set_fieldgroup_attr("remap_1h", freq_op=xios_duration_convert_from_string("1h"))
309	CALL xios_set_fieldgroup_attr("remap_3h", freq_op=xios_duration_convert_from_string("3h"))
310	CALL xios_set_fieldgroup_attr("remap_6h", freq_op=xios_duration_convert_from_string("6h"))
311	CALL xios_set_fieldgroup_attr("remap_1d", freq_op=xios_duration_convert_from_string("1d"))
312	CALL xios_set_fieldgroup_attr("remap_1mo", freq_op=xios_duration_convert_from_string("1mo"))
313
314	ENDIF
315
316	ENDIF
317
318	!! 5. Axis definition
319	!
320	DO i=1,nbveget
321	veget(i) = i
322	END DO
323
324	DO i=1,nbsurf
325	surf(i) = i
326	END DO
327
328	DO i=1,PLEV+1
329	paprsniv(i) = real(i)
330	END DO
331
332	DO i=1,PLEV
333	klev_value(i) = real(i)
334	enddo
335
336	CALL xios_set_axis_attr("presnivs",n_glo=PLEV,VALUE=presnivs)
337	CALL xios_set_axis_attr("paprsniv",n_glo=PLEV+1,VALUE=paprsniv)
338	CALL xios_set_axis_attr("veget", n_glo=nbveget, VALUE=veget)
339	CALL xios_set_axis_attr("surf", n_glo=nbsurf, VALUE=surf)
340	CALL xios_set_axis_attr("klev", n_glo=PLEV, VALUE=klev_value(1:PLEV))
341	CALL xios_set_axis_attr("bnds",n_glo=2, VALUE=(/1.,2./))
342
343	if (grid_type == regular_lonlat) THEN
344	IF (xios_is_valid_axis("axis_lat")) THEN
345	CALL xios_set_axis_attr( "axis_lat", n_glo=jjm_glo, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
346	ENDIF
347	endif
348
349	! Declaration interactivement pour la definition des variables des groupes xml
350	! au fur et a mesure le lien nom_variable / name_xml sera reproduit dans le fichier
351	! inca_IDxml.out
352
353	!-----------------------------------------------------
354	!-----------------------------------------------------
355	! Groupes pour les restarts
356	!-----------------------------------------------------
357	!-----------------------------------------------------
358	! ecriture
359	! Sources
360	DO n=1,8
361	CALL xios_add_child(source_hdl, child, "source_"//trim(tracnam(n)))
362	CALL xios_set_attr(child,name="source"//TRIM(tracnam(n)), unit="kg m-2 s-1")
363	ENDDO!
364
365	! invariants
366	DO n=1, 12
367	CALL xios_add_child(invoxy_hdl, child, "inv_"//TRIM(invname(n)))
368	CALL xios_set_attr(child,name="inv_"//TRIM(invname(n)), unit="cm-3" )
369	CALL write_xml_info("inv_"//TRIM(invname(n)), "inv_"//TRIM(invname(n)),"false", "cm-3","presnivs","false")
370	ENDDO
371
372	! lecture
373	! Sources
374	DO n=1,8
375	CALL xios_add_child(source0_hdl, child, "source"//trim(tracnam(n))//"id")
376	CALL xios_set_attr(child,name="source"//TRIM(tracnam(n)))
377
378	CALL xios_add_child(source0_read_hdl, child, "source"//trim(tracnam(n))//"_read")
379	CALL xios_set_attr(child,field_ref="source"//trim(tracnam(n))//"id")
380	ENDDO
381
382	! invariants
383	DO n=1, 12
384	CALL xios_add_child(invoxy0_hdl, child, "inv_"//TRIM(invname(n))//"id")
385	CALL xios_set_attr(child,name="inv_"//TRIM(invname(n)) )
386
387	CALL xios_add_child(invoxy0_read_hdl, child, "inv_"//TRIM(invname(n))//"_read")
388	CALL xios_set_attr(child,field_ref="inv_"//TRIM(invname(n))//"id")
389
390	ENDDO
391
392
393
394	! a retirer si nous ne sommes pas dans le cas aerosols
395	CALL xios_set_field_attr("ccm1", enabled=.FALSE.)
396	CALL xios_set_field_attr("ccm2", enabled=.FALSE.)
397	CALL xios_set_field_attr("h2oc", enabled=.FALSE.)
398
399	!-----------------------------------------------------
400	!-----------------------------------------------------
401	! Groupes pour les output
402	!-----------------------------------------------------
403	!-----------------------------------------------------
404	IF(use_group)THEN
405
406	DO n=1,8
407
408	!-----------------------------------------------
409	! declaration des concentrations d'especes
410	!-----------------------------------------------
411	CALL xios_add_child(conc_spcs_hdl,child,tracnam(n))
412
413	CALL xios_set_attr(child,name="vmr"//TRIM(name_xml(n)),unit="mol mol-1", long_name=TRIM(tracnam(n))//" Volume Mixing Ratio")
414	CALL write_xml_info(TRIM(tracnam(n)), "vmr"//TRIM(name_xml(n)), TRIM(tracnam(n))//" Volume Mixing Ratio","mol mol-1","presnivs","false")
415
416	!-----------------------------------------------
417	! declaration des emissions
418	!-----------------------------------------------
419	CALL xios_add_child(emi_hdl,child,"Emi_"//tracnam(n))
420	CALL xios_set_attr(child,name="emi"//TRIM(name_xml(n)), unit="kg m-2 s-1", long_name="Total Emission Rate of "//TRIM(tracnam(n)))
421	CALL write_xml_info("Emi_"//TRIM(tracnam(n)), "emi"//TRIM(name_xml(n)), "Total Emission Rate of "//TRIM(tracnam(n)),"kg m-2 s-1","false","false")
422
423	!-----------------------------------------------
424	! declaration des vitesses de deposition seches
425	!-----------------------------------------------
426	CALL xios_add_child(dryvd_hdl,child,"Dep_"//tracnam(n))
427	CALL xios_set_attr(child,name="dryvd"//TRIM(name_xml(n)), unit="cm s-1", long_name="Dry Deposition Velocity of "//TRIM(tracnam(n)))
428	CALL write_xml_info("Dep_"//TRIM(tracnam(n)), "dryvd"//TRIM(name_xml(n)), "Dry Deposition Velocity of "//TRIM(tracnam(n)),"cm s-1","false","false")
429
430
431
432	!-----------------------------------------------
433	! declaration des depots sec
434	!-----------------------------------------------
435	CALL xios_add_child(drydep_hdl,child,"Dflux_"//tracnam(n))
436	CALL xios_set_attr(child,name="dry"//TRIM(name_xml(n)), unit="kg m-2 s-1", long_name="Dry Deposition of "//TRIM(tracnam(n)))
437	CALL write_xml_info("Dflux_"//TRIM(tracnam(n)), "dry"//TRIM(name_xml(n)), "Dry Deposition of "//TRIM(tracnam(n)),"kg m-2 s-1","false","false")
438
439	ENDDO
440
441	!-----------------------------------------------
442	! groupe reaction flux
443	!-----------------------------------------------
444	DO n=1, 12
445	CALL xios_add_child(reacflux_hdl, child, "flux_"//TRIM(reacname(n)))
446	CALL xios_set_attr(child, name="flux_"//TRIM(reacname(n)), unit="molec.cm-3.s-1")
447	CALL write_xml_info("flux_"//TRIM(reacname(n)), "flux_"//TRIM(reacname(n)), "false","molec.cm-3.s-1","presnivs","false")
448
449	CALL xios_add_child(reacrate_hdl, child, "reacrate_"//TRIM(reacname(n)))
450	CALL xios_set_attr(child, name="reacrate_"//TRIM(reacname(n)))
451	ENDDO
452
453
454
455	!-----------------------------------------------
456	! groupe phtrate
457	!-----------------------------------------------
458	DO n=1, 2
459	CALL xios_add_child(phtrate_hdl, child, "phtrate_"//TRIM(reacname(n)))
460	CALL xios_set_attr(child, name="phtrate_"//TRIM(reacname(n)), long_name="photolysis rate for "//TRIM(reacname(n)), unit="s-1")
461	CALL write_xml_info("phtrate_"//TRIM(reacname(n)),"phtrate_"//TRIM(reacname(n)),"photolysis rate for "//TRIM(reacname(n)),"s-1","presnivs","false")
462	ENDDO
463
464	DO n=1, 1
465	!-----------------------------------------------
466	! groupe external forcing
467	!-----------------------------------------------
468	CALL xios_add_child(extfrc_hdl, child, "extfrc_"//TRIM(extname(n)))
469	CALL xios_set_attr(child, name="extfrc_"//TRIM(extname(n)), unit="??")
470	CALL write_xml_info("extfrc_"//TRIM(extname(n)), "extfrc_"//TRIM(extname(n)),"false","false","presnivs","false")
471
472	!-----------------------------------------------
473	! groupe vertically integrated external forcing
474	!-----------------------------------------------
475	CALL xios_add_child(extfrc_col_hdl, child, "extfrc_"//TRIM(extname(n))//"_col")
476	CALL xios_set_attr(child, name="extfrc_"//TRIM(extname(n))//"_col", unit="kg/m2/s")
477	CALL write_xml_info("extfrc_"//TRIM(extname(n))//"_col", "extfrc_"//TRIM(extname(n))//"_col","Vertically integrated 3D emission","kg/m2/s","false","false")
478	ENDDO
479
480	!-----------------------------------------------
481	! groupe constantes d'henry des reactions heterogenes
482	!-----------------------------------------------
483	DO n=1, 1
484	CALL xios_add_child(hrate_hdl, child, "hrate_"//TRIM(hetname(n)))
485	CALL xios_set_attr(child, name="hrate_"//TRIM(hetname(n)), unit="s-1")
486	CALL write_xml_info("hrate_"//TRIM(hetname(n)),"hrate_"//TRIM(hetname(n)),"false","s-1","presnivs","false")
487
488	CALL xios_add_child(wetloss_hdl, child, "wetloss_"//TRIM(hetname(n)))
489	CALL xios_set_attr(child, name="wetloss_"//TRIM(hetname(n)))
490	CALL write_xml_info("wetloss_"//TRIM(hetname(n)),"wetloss_"//TRIM(hetname(n)),"false","[kg m-2 s-1]","presnivs","false")
491
492	ENDDO
493
494	IF (config_inca .NE. 'aeNP') THEN
495	! forcing diagnostics
496	DO la=1,naero_grp
497
498
499	CALL xios_add_child(tau1_hdl, child, "ODUVVIS_"//TRIM(mrfname(la)))
500	CALL xios_set_attr(child,name="oduvvis"//TRIM(mrfname_xml(la)),long_name="Optical thickness band1 "//TRIM(mrfname_long(la)))
501	CALL write_xml_info("ODUVVIS_"//TRIM(mrfname(la)),"oduvvis"//TRIM(mrfname_xml(la)),"Optical thickness band1 "//TRIM(mrfname_long(la)),"false","presnivs","false")
502
503	CALL xios_add_child(tau2_hdl, child,"ODVISIR_"//TRIM(mrfname(la)) )
504	CALL xios_set_attr(child,name="odvisir"//TRIM(mrfname_xml(la)),long_name="Optical thickness band2 "//TRIM(mrfname_long(la)))
505	CALL write_xml_info("ODVISIR_"//TRIM(mrfname(la)),"odvisir"//TRIM(mrfname_xml(la)),"Optical thickness band2 "//TRIM(mrfname_long(la)),"false","presnivs","false")
506
507	CALL xios_add_child(piz1_hdl, child, "SSAUVVIS_"//TRIM(mrfname(la)))
508	CALL xios_set_attr(child,name="ssauvvis"//TRIM(mrfname_xml(la)),long_name="Single scattering albedo band1 "//TRIM(mrfname_long(la)))
509	CALL write_xml_info("SSAUVVIS_"//TRIM(mrfname(la)),"ssauvvis"//TRIM(mrfname_xml(la)),"Single scattering albedo band1 "//TRIM(mrfname_long(la)),"false","presnivs","false")
510
511	CALL xios_add_child(piz2_hdl, child,"SSAVISIR_"//TRIM(mrfname(la)) )
512	CALL xios_set_attr(child,name="ssavisir"//TRIM(mrfname_xml(la)),long_name="Single scattering albedo band2 "//TRIM(mrfname_long(la)))
513	CALL write_xml_info("SSAVISIR_"//TRIM(mrfname(la)),"ssavisir"//TRIM(mrfname_xml(la)),"Single scattering albedo band2 "//TRIM(mrfname_long(la)),"false","presnivs","false")
514
515	CALL xios_add_child(cg1_hdl, child, "ASYUVVIS_"//TRIM(mrfname(la)))
516	CALL xios_set_attr(child,name="asyuvvis"//TRIM(mrfname_xml(la)),long_name="Asymmetry parameter band1 "//TRIM(mrfname_long(la)))
517	CALL write_xml_info("ASYUVVIS_"//TRIM(mrfname(la)),"asyuvvis"//TRIM(mrfname_xml(la)),"Asymmetry parameter band1 "//TRIM(mrfname_long(la)),"false","presnivs","false")
518
519	CALL xios_add_child(cg2_hdl, child,"ASYVISIR_"//TRIM(mrfname(la)) )
520	CALL xios_set_attr(child,name="asyvisir"//TRIM(mrfname_xml(la)),long_name="Asymmetry parameter band2 "//TRIM(mrfname_long(la)))
521	CALL write_xml_info("ASYVISIR_"//TRIM(mrfname(la)),"asyvisir"//TRIM(mrfname_xml(la)),"Asymmetry parameter band2 "//TRIM(mrfname_long(la)),"false","presnivs","false")
522
523
524	CALL xios_add_child(swtoaas_hdl, child, "SWTOAAS_"//TRIM(mrfname(la)) )
525	CALL write_xml_info("SWTOAAS_"//TRIM(mrfname(la)),"SWTOAAS_"//TRIM(mrfname(la)),"false","false","false","false" )
526
527	CALL xios_add_child(swtoacs_hdl, child, "SWTOACS_"//TRIM(mrfname(la)) )
528	CALL write_xml_info("SWTOACS_"//TRIM(mrfname(la)),"SWTOACS_"//TRIM(mrfname(la)),"false","false","false","false" )
529
530	CALL xios_add_child(swsrfas_hdl, child, "SWSRFAS_"//TRIM(mrfname(la)) )
531	CALL write_xml_info("SWSRFAS_"//TRIM(mrfname(la)),"SWSRFAS_"//TRIM(mrfname(la)),"false","false","false","false" )
532
533	CALL xios_add_child(swsrfcs_hdl, child, "SWSRFCS_"//TRIM(mrfname(la)) )
534	CALL write_xml_info("SWSRFCS_"//TRIM(mrfname(la)),"SWSRFCS_"//TRIM(mrfname(la)),"false","false","false","false" )
535
536	CALL xios_add_child(fswtoaas_hdl, child, "FSWTOAAS_"//TRIM(mrfname(la)) )
537	CALL write_xml_info("FSWTOAAS_"//TRIM(mrfname(la)),"FSWTOAAS_"//TRIM(mrfname(la)),"false","false","false","false" )
538
539	CALL xios_add_child(fswtoacs_hdl, child, "FSWTOACS_"//TRIM(mrfname(la)) )
540	CALL write_xml_info("FSWTOACS_"//TRIM(mrfname(la)),"FSWTOACS_"//TRIM(mrfname(la)),"false","false","false","false" )
541
542	CALL xios_add_child(fswsrfas_hdl, child, "FSWSRFAS_"//TRIM(mrfname(la)) )
543	CALL write_xml_info("FSWSRFAS_"//TRIM(mrfname(la)),"FSWSRFAS_"//TRIM(mrfname(la)),"false","false","false","false" )
544
545	CALL xios_add_child(fswsrfcs_hdl, child, "FSWSRFCS_"//TRIM(mrfname(la)) )
546	CALL write_xml_info("FSWSRFCS_"//TRIM(mrfname(la)),"FSWSRFCS_"//TRIM(mrfname(la)),"false","false","false","false" )
547
548
549	ENDDO
550	ENDIF
551
552	IF (CoupSurfAtm) THEN !!! couplage avec orchidee
553
554	! declaration des emissions provenant du fichier non vegetales dans le cas d'un couplage avec Orchidee
555	! on traite differemment le cas des nombres ASN, AIN, SSN, CSN, CIN
556	DO i=1,nb_flux
557	length = len_trim(field_emi_names(i))
558	tmp_name = field_emi_names(i)
559	CALL xios_add_child(emiNoBio_hdl,child,"EmiNoBio_"//TRIM(tmp_name(5:length)))
560	CALL xios_set_attr(child,name="emiNoBio"//TRIM(tmp_name(5:length)), unit="kg m-2 s-1", long_name="Total Emission Rate of "//TRIM(TRIM(tmp_name(5:length))),enabled=.TRUE.)
561	CALL write_xml_info("EmiNoBio_"//TRIM(tmp_name(5:length)), "emiNoBio_"//TRIM(tmp_name(5:length)),"Total Emission Rate of "//TRIM(TRIM(tmp_name(5:length))),"kg m-2 s-1","false",".TRUE.")
562	ENDDO
563
564	DO i=1,nb_flux
565	length = len_trim(field_emi_names(i))
566	tmp_name = field_emi_names(i)
567	CALL xios_add_child(emiNoBio_hdl,child,"EmiBio_"//TRIM(tmp_name(5:length)))
568	CALL xios_set_attr(child,name="emiBio"//TRIM(tmp_name(5:length)), unit="kg m-2 s-1", long_name="Total Emission Rate of "//TRIM(TRIM(tmp_name(5:length))),enabled=.TRUE.)
569	CALL write_xml_info("EmiBio_"//TRIM(tmp_name(5:length)), "emiBio_"//TRIM(tmp_name(5:length)),"Total Emission Rate of "//TRIM(TRIM(tmp_name(5:length))),"kg m-2 s-1","false",".TRUE.")
570	ENDDO
571
572	DO i=1,nb_flux
573	CALL xios_set_field_attr("EmiNoBio_"//TRIM(tmp_name(5:length)), enabled=.TRUE.)
574	CALL xios_set_field_attr("EmiBio_"//TRIM(tmp_name(5:length)), enabled=.TRUE.)
575	CALL xios_set_field_attr(field_emi_names(i),enabled=.TRUE.)
576	CALL xios_set_field_attr('tot'//field_emi_names(i),enabled=.TRUE.)
577	ENDDO
578	ENDIF
579
580	ENDIF! IF(use_group)THEN
581
582
583
584
585	!
586	!! 6. Close context
587	!
588	CALL xios_close_context_definition()
589
590
591	! on interroge xios pour connaitre les dimensions de la grille vents 320x160 sur
592	! sur chaque proc mpi
593	!
594	IF (.not. LMDZ_10m_winds) THEN
595	call xios_get_domain_attr("wind_file", ni=ni_winds, nj=nj_winds)
596	call xios_get_axis_attr("wind_time", n_glo=ntime_winds)
597	endif
598
599	call xios_get_axis_attr("chemLR_time", n_glo=ntime_chemLR)
600	call xios_get_axis_attr("npp_time", n_glo=ntime_npp)
601	call xios_get_axis_attr("landuse_type", n_glo=ntype_landuse)
602	!
603	call xios_get_axis_attr("oxyd_time", n_glo=ntime_oxyd)
604	call xios_get_axis_attr("oxyd_presnivs", n_glo=presnivs_oxyd)
605	CALL xios_get_domain_attr("oxyd_dom", ni= ni_oxyd, nj= nj_oxyd)
606
607	CALL xios_get_axis_attr("time_co2_h", n_glo=ntime_co2h)
608
609
610	!$OMP END MASTER
611
612	IF (.not. LMDZ_10m_winds) THEN
613	CALL bcast_omp(ni_winds)
614	CALL bcast_omp(nj_winds)
615	CALL bcast_omp(ntime_winds)
616	endif
617	CALL bcast_omp(ntime_chemLR)
618	CALL bcast_omp(ntime_npp)
619	CALL bcast_omp(ntype_landuse)
620	CALL bcast_omp(ntime_oxyd)
621	CALL bcast_omp(presnivs_oxyd)
622	CALL bcast_omp(ni_oxyd)
623	CALL bcast_omp(nj_oxyd)
624	CALL bcast_omp(ntime_co2h)
625
626
627
628
629	END SUBROUTINE xios_inca_init
630
631
632	! ======================================================================
633	! SUBROUTINE : xios_inca_change_context
634	!
635	! Use this subroutine to switch between different context.
636	! This subroutine must be called when running in
637	! coupled mode at each time INCA is called, in the
638	! begining and end of intersurf_gathered. First call
639	! is done after xios_inca_init is done.
640	!
641	!
642	!
643	! ======================================================================
644	SUBROUTINE xios_inca_change_context(new_context)
645	!
646	!! 0. Variable and parameter declaration
647	!
648	!! Input variable
649	CHARACTER(LEN=*),INTENT(IN) :: new_context
650
651	!! Local variables
652	TYPE(xios_context) :: ctx_hdl
653
654	!$OMP MASTER
655	CALL xios_get_handle(new_context,ctx_hdl)
656	CALL xios_set_current_context(ctx_hdl)
657	!$OMP END MASTER
658
659
660	END SUBROUTINE xios_inca_change_context
661
662	! ====================================================================
663	! SUBROUTINE : xios_inca_update_calendar
664	!
665	! Update the calandar in 1.
666	!
667	! DESCRIPTION : Update the calendar in 1 : let 1 know that INCA
668	! avanced one time-step. This subroutine should be called
669	! in the beginning of each time-step. The first
670	! time-step in a new execution should always start at 1.
671	! Therefore, first calculate an offset that is substracted
672	! to the current time step in sechiba.
673	!
674	!
675	! ====================================================================
676	SUBROUTINE xios_inca_update_calendar(itau)
677	!
678	!! 0. Variable and parameter declaration
679	!
680	!! 0.1 Input variables
681	!
682	INTEGER, INTENT(IN) :: itau !! Current time step of the model
683	!
684
685	!_ ==================================================================
686
687	!$OMP MASTER
688	CALL xios_update_calendar(itau)
689	!$OMP END MASTER
690
691
692	END SUBROUTINE xios_inca_update_calendar
693
694
695	! =====================================================================
696	! SUBROUTINE : xios_inca_context_finalize
697	!
698	! Finalize inca context.
699	!
700	! DESCRIPTION : This subroutine finalizes the inca context without
701	! finalizing 1. In coupled mode, the atmospheric
702	! modele must finalize 1. This subroutine is
703	! called in the end of the execution of INCA only in
704	! coupeld mode.
705	!
706	!
707	! ======================================================================
708	SUBROUTINE xios_inca_context_finalize
709
710	!$OMP MASTER
711	CALL xios_context_finalize()
712	!$OMP END MASTER
713
714
715	END SUBROUTINE xios_inca_context_finalize
716
717
718
719
720	! ======================================================================
721	! SUBROUTINE : xios_inca_send_field_r0d
722	!
723	! Subroutine for sending 1D (array) fields to 1.
724	!
725	! DESCRIPTION : Send one field to 1. This is the interface for 1D fields (array).
726	! NB! This subroutine should not be called directly.
727	! Use interface xios_inca_send_field.
728	!
729	! =====================================================================
730	SUBROUTINE xios_inca_send_field_r0d(field_id,field)
731	!
732	!! 0. Variable and parameter declaration
733	!
734	!! 0.1 Input variables
735	!
736	CHARACTER(len=*), INTENT(IN) :: field_id
737	REAL, INTENT(IN) :: field
738
739	! All master threads send the field to 1
740	!$OMP MASTER
741	CALL xios_send_field(field_id,field)
742	!$OMP END MASTER
743
744
745	END SUBROUTINE xios_inca_send_field_r0d
746
747	! ======================================================================
748	! SUBROUTINE : xios_inca_send_field_r1d
749	!
750	! Subroutine for sending 2D (array) fields to 1.
751	!
752	! DESCRIPTION : Send one field to 1. This is the interface for 2D fields (array).
753	! NB! This subroutine should not be called directly.
754	! Use interface xios_inca_send_field.
755	! We modify the action in fonction of the array size.
756	! with the size(field) we will determinate if we need to
757	! transform this field on 2d grid or not.
758	!
759	! =====================================================================
760	SUBROUTINE xios_inca_send_field_r1d(field_id,field)
761	USE INCA_DIM
762	IMPLICIT NONE
763	!
764	!! 0. Variable and parameter declaration
765	!
766	!! 0.1 Input variables
767	!
768	CHARACTER(len=*), INTENT(IN) :: field_id
769	REAL, DIMENSION(:), INTENT(IN) :: field
770
771	!! 0.2 Local variables
772	REAL, DIMENSION(nbp_mpi) :: field_mpi
773	REAL, DIMENSION(iim_glo,jj_nb) :: field2d_mpi
774
775
776	IF (SIZE(field) .EQ. PLON) THEN
777	! Gather all omp domains on the mpi domains
778	CALL gather_omp(field, field_mpi)
779
780	! All master threads send the field to 1
781	!$OMP MASTER
782	CALL grid1dTo2d_mpi(field_mpi,field2d_mpi)
783	CALL xios_send_field(field_id,field2d_mpi)
784	!$OMP END MASTER
785
786	ELSEIF ((SIZE(field) .EQ. PLEV) .or. (SIZE(field) .EQ. PLEV+1)) THEN
787
788	!$OMP MASTER
789	CALL xios_send_field(field_id,field)
790	!$OMP END MASTER
791
792	ELSE IF (SIZE(field) .EQ. PLON_MPI) THEN ! Cas d'un appel purement mpi
793
794	! Gather all omp domains on the mpi domains
795	CALL grid1dTo2d_mpi(field,field2d_mpi)
796	CALL xios_send_field(field_id,field2d_mpi)
797
798	ELSE ! le cas n'est pas prÃ©vu
799
800
801	WRITE(lunout,*) field_id, "xios_send_field r1d cas non prevu "
802	WRITE(lunout,*) "size ", field_id, " = ", size(field) , " different de ", PLON, PLEV, PLEV+1 , PLON_MPI
803
804	STOP "see inca output "
805
806	ENDIF
807
808
809	END SUBROUTINE xios_inca_send_field_r1d
810
811
812
813	! ==========================================================================
814	! SUBROUTINE : xios_inca_send_field_r2d
815	!
816	! Subroutine for sending 2D fields to 1.
817	!
818	! DESCRIPTION : Send one field to 1. This is the interface for INCA 2D fields.
819	! NB! This subroutine should not be called directly.
820	! Use interface xios_inca_send_field.
821	! with the size(field,1) we will determinate if we need to
822	! transform this field on 2d grid or not.
823	!
824	! ==========================================================================
825	SUBROUTINE xios_inca_send_field_r2d(field_id,field)
826	USE PRINT_INCA
827	!
828	!! 0. Variable and parameter declaration
829	!
830	!! 0.1 Input variables
831	!
832	CHARACTER(len=*), INTENT(IN) :: field_id
833	REAL, DIMENSION(:,:), INTENT(IN) :: field
834
835	!! 0.2 Local variables
836	REAL, DIMENSION(nbp_mpi,SIZE(field,2)) :: field_mpi
837	REAL, DIMENSION(iim_glo,jj_nb,SIZE(field,2)) :: field2d_mpi
838
839
840	IF (SIZE(field, 1) .EQ. PLON) THEN
841
842	! Gather all omp domains on the mpi domains
843	CALL gather_omp(field, field_mpi)
844	! All master threads send the field to 1
845	!$OMP MASTER
846	CALL grid1dTo2d_mpi(field_mpi,field2d_mpi)
847	CALL xios_send_field(field_id,field2d_mpi)
848	!$OMP END MASTER
849
850	ELSE
851
852	!$OMP MASTER
853	CALL xios_send_field(field_id, field)
854	!$OMP END MASTER
855
856
857	ENDIF
858
859
860	END SUBROUTINE xios_inca_send_field_r2d
861
862
863
864	SUBROUTINE xios_inca_recv_field_r0d(field_id,field)
865	USE PRINT_INCA
866	!
867	!! 0. Variable and parameter declaration
868	!
869	!! 0.1 Input variables
870	!
871	CHARACTER(len=*), INTENT(IN) :: field_id
872
873	!! 0.2 Output variables
874	REAL, INTENT(OUT) :: field
875
876	!_ ================================================================================================================================
877
878
879	!$OMP MASTER
880	CALL xios_recv_field(field_id,field)
881	!$OMP END MASTER
882	call bcast_omp(field)
883
884
885	END SUBROUTINE xios_inca_recv_field_r0d
886
887
888
889
890	SUBROUTINE xios_inca_recv_field_r1d(field_id,field)
891	USE PRINT_INCA
892	!
893	!! 0. Variable and parameter declaration
894	!
895	!! 0.1 Input variables
896	!
897	CHARACTER(len=*), INTENT(IN) :: field_id
898
899	!! 0.2 Output variables
900	REAL, DIMENSION(:), INTENT(OUT) :: field
901	REAL, DIMENSION(iim_glo,jj_nb) :: field2d_mpi
902	REAL, DIMENSION(PLON_MPI) :: field_mpi
903
904	!_ ================================================================================================================================
905
906	! All master threads recieve the field from 1
907	IF (size(field) .eq. PLON) THEN ! cas MPI_OMP
908
909
910	!$OMP MASTER
911	CALL xios_recv_field(field_id,field2d_mpi)
912	CALL grid2dTo1d_mpi(field2d_mpi, field_mpi)
913	!$OMP END MASTER
914	call scatter_omp(field_mpi, field)
915
916	ELSE
917
918	WRITE(lunout,*) field_id, 'Entering xios_inca_recv_field_r1d cas non prevu size = ', size(field), ' PLON = ', PLON
919	stop "exit see inca_output "
920
921	ENDIF
922
923	END SUBROUTINE xios_inca_recv_field_r1d
924
925
926
927
928	SUBROUTINE xios_inca_recv_field_r2d(field_id,field)
929	!
930	!! 0. Variable and parameter declaration
931	!
932	!! 0.1 Input variables
933	!
934	CHARACTER(len=*), INTENT(IN) :: field_id
935
936	!! 0.2 Output variables
937	REAL, DIMENSION(:,:), INTENT(OUT) :: field
938	REAL, DIMENSION(iim_glo,jj_nb,SIZE(field,2)) :: field2d_mpi
939	REAL, DIMENSION(PLON_MPI,SIZE(field,2)) :: field_mpi
940
941
942	!_ ================================================================================================================================
943	if (size(field,1) .eq. PLON) THEN
944	! on va recevoir un champ en lon,lat et le transformer sur la grille 1d
945	!$OMP MASTER
946	CALL xios_recv_field(field_id,field2d_mpi)
947	CALL grid2dTo1d_mpi(field2d_mpi, field_mpi)
948	!$OMP END MASTER
949	call scatter_omp(field_mpi, field)
950
951	ELSE
952
953
954	WRITE(lunout,*) field_id, 'cas non prevu xios_inca_recv_field_r2d, size = ',size(field,1), " PLON = ", PLON
955	STOP "see inca output "
956
957
958	ENDIF
959
960
961	END SUBROUTINE xios_inca_recv_field_r2d
962
963	SUBROUTINE xios_inca_recv_field_r3d(field_id,field)
964	!
965	!! 0. Variable and parameter declaration
966	!
967	!! 0.1 Input variables
968	!
969	CHARACTER(len=*), INTENT(IN) :: field_id
970
971	!! 0.2 Output variables
972	REAL, DIMENSION(:,:,:), INTENT(OUT) :: field
973	REAL, DIMENSION(iim_glo,jj_nb,SIZE(field,2), size(field,3)) :: field3d_mpi
974	REAL, DIMENSION(PLON_MPI,SIZE(field,2), size(field,3) ) :: field_mpi
975
976
977	!_ ================================================================================================================================
978
979
980	! All master threads recieve the field from 1
981	if (size(field,1) .eq. PLON) then
982
983	! on va recevoir un champ en lon,lat et le transformer sur la grille 1d
984	!$OMP MASTER
985	CALL xios_recv_field(field_id,field3d_mpi)
986	CALL grid2dTo1d_mpi(field3d_mpi, field_mpi)
987	!$OMP END MASTER
988	call scatter_omp(field_mpi, field)
989
990	else
991
992	WRITE(lunout,*) field_id, 'cas non prevu xios_inca_recv_field_r3d, size = ',size(field,1), " PLON = ", PLON
993	STOP "see inca output "
994
995
996	endif
997
998	END SUBROUTINE xios_inca_recv_field_r3d
999
1000
1001
1002	SUBROUTINE xios_inca_recv_field_mpi_r1d(field_id,field)
1003	USE PRINT_INCA
1004	!
1005	!! 0. Variable and parameter declaration
1006	!
1007	!! 0.1 Input variables
1008	!
1009	CHARACTER(len=*), INTENT(IN) :: field_id
1010
1011	!! 0.2 Output variables
1012	REAL, DIMENSION(:), INTENT(OUT) :: field
1013	REAL, DIMENSION(iim_glo,jj_nb) :: field2d_mpi
1014	REAL, DIMENSION(PLON_MPI) :: field_mpi
1015
1016	!_ ================================================================================================================================
1017	WRITE(lunout,*) 'Entering xios_inca_recv_field_mpi_r1d, field_id=',field_id
1018
1019	! All master threads recieve the field from 1
1020	IF (SIZE(field) .EQ. PLON_MPI) THEN ! cas purement MPI
1021
1022	WRITE(lunout,*) 'Entering xios_inca_recv_field_r1d cas PLON_MPI'
1023
1024
1025	CALL xios_recv_field(field_id,field2d_mpi)
1026	CALL grid2dTo1d_mpi(field2d_mpi, field)
1027
1028	ELSE
1029
1030	WRITE(lunout,*) field_id, " xios_inca_recv_field_mpi_r1d size", size(field), " is not PLON_MPI ", PLON_MPI
1031	STOP "see inca output "
1032
1033	ENDIF
1034
1035	END SUBROUTINE xios_inca_recv_field_mpi_r1d
1036
1037
1038
1039
1040
1041
1042	SUBROUTINE xios_inca_recv_field_glo_r1d(field_id,field)
1043
1044	USE PRINT_INCA
1045	!
1046	!! 0. Variable and parameter declaration
1047	!
1048	!! 0.1 Input variables
1049	!
1050	CHARACTER(len=*), INTENT(IN) :: field_id
1051
1052	!! 0.2 Output variables
1053	REAL, DIMENSION(:), INTENT(OUT) :: field
1054
1055
1056	!$OMP MASTER
1057	CALL xios_recv_field(field_id,field)
1058	!$OMP END MASTER
1059	CALL bcast_omp(field)
1060
1061	END SUBROUTINE xios_inca_recv_field_glo_r1d
1062
1063
1064
1065	SUBROUTINE xios_inca_recv_field_glo_r2d(field_id,field)
1066
1067	USE PRINT_INCA
1068	!
1069	!! 0. Variable and parameter declaration
1070	!
1071	!! 0.1 Input variables
1072	!
1073	CHARACTER(len=*), INTENT(IN) :: field_id
1074
1075	!! 0.2 Output variables
1076	REAL, DIMENSION(:,:), INTENT(OUT) :: field
1077
1078
1079	!$OMP MASTER
1080	CALL xios_recv_field(field_id,field)
1081	!$OMP END MASTER
1082	CALL bcast_omp(field)
1083
1084	END SUBROUTINE xios_inca_recv_field_glo_r2d
1085
1086
1087
1088
1089
1090	SUBROUTINE xios_inca_recv_field_glo_r3d(field_id,field)
1091
1092	USE PRINT_INCA
1093	!
1094	!! 0. Variable and parameter declaration
1095	!
1096	!! 0.1 Input variables
1097	!
1098	CHARACTER(len=*), INTENT(IN) :: field_id
1099
1100	!! 0.2 Output variables
1101	REAL, DIMENSION(:,:,:), INTENT(OUT) :: field
1102
1103
1104
1105	!$OMP MASTER
1106	CALL xios_recv_field(field_id,field)
1107	!$OMP END MASTER
1108	CALL bcast_omp(field)
1109
1110	END SUBROUTINE xios_inca_recv_field_glo_r3d
1111
1112
1113
1114
1115
1116	SUBROUTINE write_xml_info(str1, str2, str3, str4, str5, str6)
1117	CHARACTER(LEN=*) , INTENT(in):: str1,str2,str3, str4, str5, str6
1118	CHARACTER(LEN=200) :: str3_out,str4_out,str5_out, str6_out
1119
1120	!$OMP MASTER
1121	IF (is_mpi_root) THEN
1122	! WRITE(outxml,*) "ID = ", str1," / name = ", str2,"
1123	IF(str3=='false') THEN
1124	str3_out=' '
1125	ELSE
1126	str3_out=' long_name="'//TRIM(str3)//'" '
1127	ENDIF
1128
1129	IF(str4=='false') THEN
1130	str4_out=' '
1131	ELSE
1132	str4_out=' unit="'//TRIM(str4)//'" '
1133	ENDIF
1134
1135	IF(str5=='false') THEN
1136	str5_out=' '
1137	ELSE
1138	str5_out=' axis_ref="'//TRIM(str5)//'" '
1139	ENDIF
1140
1141	IF(str6=='false') THEN
1142	str6_out=' '
1143	ELSE
1144	str6_out=' enabled="'//TRIM(str6)//'" '
1145	ENDIF
1146
1147	WRITE(outxml,"(4x,a,a,a,a,a,a,a,/)", advance="no") '<field id="'//TRIM(str1)//TRIM('"'),' name="'//TRIM(str2)//TRIM('"'),TRIM(str3_out),TRIM(str4_out),TRIM(str5_out),TRIM(str6_out),TRIM('/>')
1148
1149	ENDIF
1150	!$OMP END MASTER
1151
1152	END SUBROUTINE write_xml_info
1153
1154	END MODULE xios_inca
1155
1156

Note: See TracBrowser for help on using the repository browser.

Download in other formats: