Context Navigation

iophy.F90 @ 5225

Last change on this file since 5225 was 5137, checked in by abarral, 4 months ago
Put gradsdef.h, tracstoke.h, clesphys.h into modules
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 52.5 KB

Line
1
2	! $Id: iophy.F90 5137 2024-07-28 20:25:12Z abarral $
3
4	MODULE iophy
5	USE lmdz_abort_physic, ONLY: abort_physic
6
7	! abd REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lat
8	! abd REAL,PRIVATE,ALLOCATABLE,DIMENSION(:),save :: io_lon
9	REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat
10	REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon
11	INTEGER, SAVE :: phys_domain_id
12	INTEGER, SAVE :: npstn
13	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij
14	INTEGER, SAVE :: itau_iophy
15	LOGICAL :: check_dim = .FALSE.
16
17	!$OMP THREADPRIVATE(itau_iophy)
18
19	INTERFACE histwrite_phy
20	MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios
21	END INTERFACE
22
23	INTERFACE histbeg_phy_all
24	MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points
25	END INTERFACE
26
27
28	CONTAINS
29
30	! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
31	SUBROUTINE set_itau_iophy(ito)
32	IMPLICIT NONE
33	INTEGER, INTENT(IN) :: ito
34	itau_iophy = ito
35	END SUBROUTINE
36
37	SUBROUTINE init_iophy_new(rlat,rlon)
38
39	USE dimphy, ONLY: klon
40	USE lmdz_phys_para, ONLY: gather, bcast, &
41	jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
42	mpi_size, mpi_rank, klon_mpi, &
43	is_sequential, is_south_pole_dyn
44	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
45	USE lmdz_print_control, ONLY: prt_level,lunout
46	USE ioipsl, ONLY: flio_dom_set
47	USE lmdz_wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init, using_xios
48	IMPLICIT NONE
49	REAL,DIMENSION(klon),INTENT(IN) :: rlon
50	REAL,DIMENSION(klon),INTENT(IN) :: rlat
51
52	REAL,DIMENSION(klon_glo) :: rlat_glo
53	REAL,DIMENSION(klon_glo) :: rlon_glo
54
55	INTEGER,DIMENSION(2) :: ddid
56	INTEGER,DIMENSION(2) :: dsg
57	INTEGER,DIMENSION(2) :: dsl
58	INTEGER,DIMENSION(2) :: dpf
59	INTEGER,DIMENSION(2) :: dpl
60	INTEGER,DIMENSION(2) :: dhs
61	INTEGER,DIMENSION(2) :: dhe
62	INTEGER :: i
63	INTEGER :: data_ibegin, data_iend
64
65	IF (using_xios) CALL wxios_context_init
66
67
68	IF (grid_type==unstructured) THEN
69
70	CALL wxios_domain_param_unstructured("dom_glo")
71
72	ELSE
73
74	CALL gather(rlat,rlat_glo)
75	CALL bcast(rlat_glo)
76	CALL gather(rlon,rlon_glo)
77	CALL bcast(rlon_glo)
78
79	!$OMP MASTER
80	ALLOCATE(io_lat(nbp_lat))
81	IF (klon_glo == 1) THEN
82	io_lat(1)=rlat_glo(1)
83	ELSE
84	io_lat(1)=rlat_glo(1)
85	io_lat(nbp_lat)=rlat_glo(klon_glo)
86	DO i=2,nbp_lat-1
87	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
88	ENDDO
89	ENDIF
90
91	ALLOCATE(io_lon(nbp_lon))
92	IF (klon_glo == 1) THEN
93	io_lon(1)=rlon_glo(1)
94	ELSE
95	io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
96	ENDIF
97
98	!! (I) dtnb : total number of domains
99	!! (I) dnb : domain number
100	!! (I) did(:) : distributed dimensions identifiers
101	!! (up to 5 dimensions are supported)
102	!! (I) dsg(:) : total number of points for each dimension
103	!! (I) dsl(:) : local number of points for each dimension
104	!! (I) dpf(:) : position of first local point for each dimension
105	!! (I) dpl(:) : position of last local point for each dimension
106	!! (I) dhs(:) : start halo size for each dimension
107	!! (I) dhe(:) : end halo size for each dimension
108	!! (C) cdnm : Model domain definition name.
109	!! The names actually supported are :
110	!! "BOX", "APPLE", "ORANGE".
111	!! These names are case insensitive.
112
113	ddid=(/ 1,2 /)
114	dsg=(/ nbp_lon, nbp_lat /)
115	dsl=(/ nbp_lon, jj_nb /)
116	dpf=(/ 1,jj_begin /)
117	dpl=(/ nbp_lon, jj_end /)
118	dhs=(/ ii_begin-1,0 /)
119	IF (mpi_rank==mpi_size-1) THEN
120	dhe=(/0,0/)
121	ELSE
122	dhe=(/ nbp_lon-ii_end,0 /)
123	ENDIF
124
125	#ifndef CPP_IOIPSL_NO_OUTPUT
126	CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
127	'APPLE',phys_domain_id)
128	#endif
129	IF (using_xios) THEN
130	! Set values for the mask:
131	IF (mpi_rank == 0) THEN
132	data_ibegin = 0
133	ELSE
134	data_ibegin = ii_begin - 1
135	END IF
136
137	IF (mpi_rank == mpi_size-1) THEN
138	data_iend = nbp_lon
139	ELSE
140	data_iend = ii_end + 1
141	END IF
142
143	IF (prt_level>=10) THEN
144	WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end
145	WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat
146	WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
147	WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend
148	WRITE(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn
149	ENDIF
150
151	! Initialize the XIOS domain coreesponding to this process:
152	ENDIF
153	!$OMP END MASTER
154
155	IF (using_xios) CALL wxios_domain_param("dom_glo")
156
157	ENDIF
158
159	END SUBROUTINE init_iophy_new
160
161
162	SUBROUTINE init_iophy(lat,lon)
163
164	USE lmdz_phys_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
165	mpi_size, mpi_rank
166	USE ioipsl, ONLY: flio_dom_set
167	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
168
169	IMPLICIT NONE
170
171	REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
172	REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
173
174	INTEGER,DIMENSION(2) :: ddid
175	INTEGER,DIMENSION(2) :: dsg
176	INTEGER,DIMENSION(2) :: dsl
177	INTEGER,DIMENSION(2) :: dpf
178	INTEGER,DIMENSION(2) :: dpl
179	INTEGER,DIMENSION(2) :: dhs
180	INTEGER,DIMENSION(2) :: dhe
181
182	!$OMP MASTER
183	ALLOCATE(io_lat(nbp_lat))
184	io_lat(:)=lat(:)
185	ALLOCATE(io_lon(nbp_lon))
186	io_lon(:)=lon(:)
187
188	ddid=(/ 1,2 /)
189	dsg=(/ nbp_lon, nbp_lat /)
190	dsl=(/ nbp_lon, jj_nb /)
191	dpf=(/ 1,jj_begin /)
192	dpl=(/ nbp_lon, jj_end /)
193	dhs=(/ ii_begin-1,0 /)
194	IF (mpi_rank==mpi_size-1) THEN
195	dhe=(/0,0/)
196	ELSE
197	dhe=(/ nbp_lon-ii_end,0 /)
198	ENDIF
199
200	#ifndef CPP_IOIPSL_NO_OUTPUT
201	CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
202	'APPLE',phys_domain_id)
203	#endif
204	!$OMP END MASTER
205
206	END SUBROUTINE init_iophy
207
208	SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
209	! USE dimphy
210	USE lmdz_phys_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
211	jj_begin, jj_end, jj_nb
212	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
213	USE ioipsl, ONLY: histbeg
214	USE lmdz_wxios, ONLY: wxios_add_file, using_xios
215	USE lmdz_clesphys
216
217	IMPLICIT NONE
218
219	CHARACTER(), INTENT(IN) :: name
220	INTEGER, INTENT(IN) :: itau0
221	REAL,INTENT(IN) :: zjulian
222	REAL,INTENT(IN) :: dtime
223	CHARACTER(LEN=*), INTENT(IN) :: ffreq
224	INTEGER,INTENT(IN) :: lev
225	INTEGER,INTENT(OUT) :: nhori
226	INTEGER,INTENT(OUT) :: nid_day
227
228	!$OMP MASTER
229	IF (is_sequential) THEN
230	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
231	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
232	ELSE
233	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
234	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
235	ENDIF
236
237	IF (using_xios) THEN
238	! ug OMP en chantier...
239	IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN
240	! ug Création du fichier
241	IF (.NOT. ok_all_xml) THEN
242	CALL wxios_add_file(name, ffreq, lev)
243	ENDIF
244	ENDIF
245	ENDIF
246	!$OMP END MASTER
247
248	END SUBROUTINE histbeg_phyxios
249
250	SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
251
252	USE lmdz_phys_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
253	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
254	USE ioipsl, ONLY: histbeg
255
256	IMPLICIT NONE
257
258	CHARACTER(), INTENT(IN) :: name
259	INTEGER, INTENT(IN) :: itau0
260	REAL,INTENT(IN) :: zjulian
261	REAL,INTENT(IN) :: dtime
262	INTEGER,INTENT(OUT) :: nhori
263	INTEGER,INTENT(OUT) :: nid_day
264
265	!$OMP MASTER
266	#ifndef CPP_IOIPSL_NO_OUTPUT
267	IF (is_sequential) THEN
268	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
269	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
270	ELSE
271	CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
272	1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
273	ENDIF
274	#endif
275	!$OMP END MASTER
276
277	END SUBROUTINE histbeg_phy
278
279
280	SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
281	plon,plat,plon_bounds,plat_bounds, &
282	nname,itau0,zjulian,dtime,nnhori,nnid_day)
283	USE dimphy, ONLY: klon
284	USE lmdz_phys_para, ONLY: gather, bcast, &
285	is_sequential, klon_mpi_begin, klon_mpi_end, &
286	mpi_rank
287	USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
288	USE ioipsl, ONLY: histbeg
289
290	IMPLICIT NONE
291
292	REAL,DIMENSION(klon),INTENT(IN) :: rlon
293	REAL,DIMENSION(klon),INTENT(IN) :: rlat
294	INTEGER, INTENT(IN) :: itau0
295	REAL,INTENT(IN) :: zjulian
296	REAL,INTENT(IN) :: dtime
297	INTEGER, INTENT(IN) :: pim
298	INTEGER, INTENT(OUT) :: nnhori
299	CHARACTER(len=20), INTENT(IN) :: nname
300	INTEGER, INTENT(OUT) :: nnid_day
301	INTEGER :: i
302	REAL,DIMENSION(klon_glo) :: rlat_glo
303	REAL,DIMENSION(klon_glo) :: rlon_glo
304	INTEGER, DIMENSION(pim), INTENT(IN) :: tabij
305	REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
306	INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
307	REAL,DIMENSION(pim,2), INTENT(OUT) :: plat_bounds, plon_bounds
308
309	INTEGER, SAVE :: tabprocbeg, tabprocend
310	!$OMP THREADPRIVATE(tabprocbeg, tabprocend)
311	INTEGER :: ip
312	INTEGER, PARAMETER :: nip=1
313	INTEGER :: npproc
314	REAL, ALLOCATABLE, DIMENSION(:) :: npplat, npplon
315	REAL, ALLOCATABLE, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
316	REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
317
318	CALL gather(rlat,rlat_glo)
319	CALL bcast(rlat_glo)
320	CALL gather(rlon,rlon_glo)
321	CALL bcast(rlon_glo)
322
323	!$OMP MASTER
324	DO i=1,pim
325
326	! PRINT*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
327
328	plon_bounds(i,1)=rlon_glo(tabij(i)-1)
329	plon_bounds(i,2)=rlon_glo(tabij(i)+1)
330	IF (plon_bounds(i,2)<=0..AND.plon_bounds(i,1)>=0.) THEN
331	IF (rlon_glo(tabij(i))>=0.) THEN
332	plon_bounds(i,2)=-1*plon_bounds(i,2)
333	ENDIF
334	ENDIF
335	IF (plon_bounds(i,2)>=0..AND.plon_bounds(i,1)<=0.) THEN
336	IF (rlon_glo(tabij(i))<=0.) THEN
337	plon_bounds(i,2)=-1*plon_bounds(i,2)
338	ENDIF
339	ENDIF
340
341	IF ( tabij(i)<=nbp_lon) THEN
342	plat_bounds(i,1)=rlat_glo(tabij(i))
343	ELSE
344	plat_bounds(i,1)=rlat_glo(tabij(i)-nbp_lon)
345	ENDIF
346	plat_bounds(i,2)=rlat_glo(tabij(i)+nbp_lon)
347
348	! PRINT*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2)
349	! PRINT*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2)
350
351	ENDDO
352	IF (is_sequential) THEN
353	npstn=pim
354	IF(.NOT. ALLOCATED(nptabij)) THEN
355	ALLOCATE(nptabij(pim))
356	ENDIF
357	DO i=1,pim
358	nptabij(i)=tabij(i)
359	ENDDO
360
361	CALL grid1dTo2d_glo(rlon_glo,zx_lon)
362	IF ((nbp_lon*nbp_lat)>1) THEN
363	DO i = 1, nbp_lon
364	zx_lon(i,1) = rlon_glo(i+1)
365	zx_lon(i,nbp_lat) = rlon_glo(i+1)
366	ENDDO
367	ENDIF
368	CALL grid1dTo2d_glo(rlat_glo,zx_lat)
369
370	DO i=1,pim
371	! PRINT*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
372
373	plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i))
374	plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
375
376	IF (ipt(i)==1) THEN
377	plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
378	plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
379	ENDIF
380
381	IF (ipt(i)==nbp_lon) THEN
382	plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
383	ENDIF
384
385	plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
386	plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
387
388	IF (jpt(i)==1) THEN
389	plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
390	plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
391	ENDIF
392
393	IF (jpt(i)==nbp_lat) THEN
394	plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
395	plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
396	ENDIF
397
398	! PRINT*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2)
399	! PRINT*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2)
400
401	ENDDO
402
403	#ifndef CPP_IOIPSL_NO_OUTPUT
404	CALL histbeg(nname,pim,plon,plon_bounds, &
405	plat,plat_bounds, &
406	itau0, zjulian, dtime, nnhori, nnid_day)
407	#endif
408	ELSE
409	npproc=0
410	DO ip=1, pim
411	tabprocbeg=klon_mpi_begin
412	tabprocend=klon_mpi_end
413	IF(tabij(ip)>=tabprocbeg.AND.tabij(ip)<=tabprocend) THEN
414	npproc=npproc+1
415	npstn=npproc
416	ENDIF
417	ENDDO
418	! PRINT*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn
419	IF(.NOT. ALLOCATED(nptabij)) THEN
420	ALLOCATE(nptabij(npstn))
421	ALLOCATE(npplon(npstn), npplat(npstn))
422	ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2))
423	ENDIF
424	npproc=0
425	DO ip=1, pim
426	IF(tabij(ip)>=tabprocbeg.AND.tabij(ip)<=tabprocend) THEN
427	npproc=npproc+1
428	nptabij(npproc)=tabij(ip)
429	! PRINT*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, &
430	! plon(ip),plat(ip),tabij(ip)
431	npplon(npproc)=plon(ip)
432	npplat(npproc)=plat(ip)
433	npplon_bounds(npproc,1)=plon_bounds(ip,1)
434	npplon_bounds(npproc,2)=plon_bounds(ip,2)
435	npplat_bounds(npproc,1)=plat_bounds(ip,1)
436	npplat_bounds(npproc,2)=plat_bounds(ip,2)
437	!!!
438	!!! print qui sert a reordonner les points stations selon l'ordre CFMIP
439	!!! ne pas enlever
440	PRINT*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip)
441	!!!
442	ENDIF
443	ENDDO
444	#ifndef CPP_IOIPSL_NO_OUTPUT
445	CALL histbeg(nname,npstn,npplon,npplon_bounds, &
446	npplat,npplat_bounds, &
447	itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
448	#endif
449	ENDIF
450	!$OMP END MASTER
451
452	END SUBROUTINE histbeg_phy_points
453
454
455	SUBROUTINE histdef2d_old(iff,lpoint,flag_var,nomvar,titrevar,unitvar)
456
457	USE ioipsl, ONLY: histdef
458	USE lmdz_phys_para, ONLY: jj_nb, is_master
459	USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
460	nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, &
461	ok_4xCO2atm
462	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
463	USE aero_mod, ONLY: naero_tot, name_aero_tau
464	USE lmdz_print_control, ONLY: prt_level,lunout
465	USE lmdz_clesphys
466
467	IMPLICIT NONE
468
469	INTEGER :: iff
470	INTEGER :: naero
471	LOGICAL :: lpoint
472	INTEGER, DIMENSION(nfiles) :: flag_var
473	CHARACTER(LEN=20) :: nomvar
474	CHARACTER(LEN=*) :: titrevar
475	CHARACTER(LEN=*) :: unitvar
476
477	REAL zstophym
478
479	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
480	zstophym=zoutm(iff)
481	ELSE
482	zstophym=zdtime_moy
483	ENDIF
484	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
485	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
486	CALL conf_physoutputs(nomvar,flag_var)
487
488	IF(.NOT.lpoint) THEN
489	IF ( flag_var(iff)<=lev_files(iff) ) THEN
490	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
491	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
492	type_ecri(iff), zstophym,zoutm(iff))
493	ENDIF
494	ELSE
495	IF ( flag_var(iff)<=lev_files(iff) ) THEN
496	CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
497	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
498	type_ecri(iff), zstophym,zoutm(iff))
499	ENDIF
500	ENDIF
501
502	! Set swaero_diag=true if at least one of the concerned variables are defined
503	IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. &
504	nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. &
505	nomvar=='topswai' .OR. nomvar=='solswai' ) THEN
506	IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
507	ENDIF
508
509	! Set dryaod_diag=true if at least one of the concerned variables are defined
510	IF (nomvar=='dryod550aer') THEN
511	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
512	ENDIF
513	DO naero = 1, naero_tot-1
514	IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
515	IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
516	ENDIF
517	ENDDO
518
519	! Set ok_4xCO2atm=true if at least one of the concerned variables are
520	! defined
521	IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' &
522	.OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' &
523	.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. &
524	nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.&
525	nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN
526	IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
527	ENDIF
528	END SUBROUTINE histdef2d_old
529
530	SUBROUTINE histdef3d_old(iff,lpoint,flag_var,nomvar,titrevar,unitvar)
531
532	USE ioipsl, ONLY: histdef
533	USE dimphy, ONLY: klev
534	USE lmdz_phys_para, ONLY: jj_nb, is_master
535	USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
536	nhorim, zdtime_moy, levmin, levmax, &
537	nvertm, nfiles
538	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
539	USE lmdz_print_control, ONLY: prt_level,lunout
540	USE lmdz_clesphys
541
542	IMPLICIT NONE
543
544	INTEGER :: iff
545	LOGICAL :: lpoint
546	INTEGER, DIMENSION(nfiles) :: flag_var
547	CHARACTER(LEN=20) :: nomvar
548	CHARACTER(LEN=*) :: titrevar
549	CHARACTER(LEN=*) :: unitvar
550
551	REAL zstophym
552
553	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
554	CALL conf_physoutputs(nomvar,flag_var)
555
556	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
557
558	IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
559	zstophym=zoutm(iff)
560	ELSE
561	zstophym=zdtime_moy
562	ENDIF
563
564	IF(.NOT.lpoint) THEN
565	IF ( flag_var(iff)<=lev_files(iff) ) THEN
566	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
567	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
568	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
569	zstophym, zoutm(iff))
570	ENDIF
571	ELSE
572	IF ( flag_var(iff)<=lev_files(iff) ) THEN
573	CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
574	npstn,1,nhorim(iff), klev, levmin(iff), &
575	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
576	type_ecri(iff), zstophym,zoutm(iff))
577	ENDIF
578	ENDIF
579	END SUBROUTINE histdef3d_old
580
581	SUBROUTINE histdef2d(iff,var)
582
583	USE ioipsl, ONLY: histdef
584	USE lmdz_phys_para, ONLY: jj_nb, is_master
585	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
586	clef_stations, phys_out_filenames, lev_files, &
587	nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
588	ok_4xCO2atm
589	USE lmdz_print_control, ONLY: prt_level,lunout
590	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
591	USE aero_mod, ONLY: naero_tot, name_aero_tau
592	USE lmdz_wxios, ONLY: wxios_add_field_to_file, using_xios
593	USE lmdz_print_control, ONLY: prt_level,lunout
594	USE lmdz_clesphys
595	IMPLICIT NONE
596
597	INTEGER :: iff
598	INTEGER :: naero
599	TYPE(ctrl_out) :: var
600
601	REAL zstophym
602	CHARACTER(LEN=20) :: typeecrit
603
604	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
605
606	! ug On récupère le type écrit de la structure:
607	! Assez moche, à refaire si meilleure méthode...
608	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
609	typeecrit = 'once'
610	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
611	typeecrit = 't_min(X)'
612	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
613	typeecrit = 't_max(X)'
614	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
615	typeecrit = 'inst(X)'
616	ELSE
617	typeecrit = type_ecri_files(iff)
618	ENDIF
619
620	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
621	zstophym=zoutm(iff)
622	ELSE
623	zstophym=zdtime_moy
624	ENDIF
625
626	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
627	CALL conf_physoutputs(var%name, var%flag)
628
629	IF(.NOT.clef_stations(iff)) THEN
630
631	IF (using_xios) THEN
632	IF (.NOT. ok_all_xml) THEN
633	IF ( var%flag(iff)<=lev_files(iff) ) THEN
634	CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
635	var%description, var%unit, var%flag(iff), typeecrit)
636	IF (prt_level >= 10) THEN
637	WRITE(lunout,*) 'histdef2d: CALL wxios_add_field_to_file var%name iff: ', &
638	trim(var%name),iff
639	ENDIF
640	ENDIF
641	ENDIF
642	ENDIF
643	#ifndef CPP_IOIPSL_NO_OUTPUT
644
645	IF ( var%flag(iff)<=lev_files(iff) ) THEN
646	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
647	nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
648	typeecrit, zstophym,zoutm(iff))
649	ENDIF
650	ELSE
651	IF ( var%flag(iff)<=lev_files(iff)) THEN
652	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
653	npstn,1,nhorim(iff), 1,1,1, -99, 32, &
654	typeecrit, zstophym,zoutm(iff))
655	ENDIF
656	#endif
657	ENDIF
658
659	! Set swaero_diag=true if at least one of the concerned variables are defined
660	!--OB 30/05/2016 use wider set of variables
661	IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
662	var%name=='topswai' .OR. var%name=='solswai' .OR. ( iflag_rrtm==1 .AND. ( &
663	var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
664	var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN
665	IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
666	ENDIF
667
668	! Set swaerofree_diag=true if at least one of the concerned variables are defined
669	IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. &
670	var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
671	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
672	ENDIF
673
674	! set dryaod_dry=true if at least one of the concerned variables are defined
675	IF (var%name=='dryod550aer') THEN
676	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
677	ENDIF
678
679	DO naero = 1, naero_tot-1
680	IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
681	IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
682	ENDIF
683	ENDDO
684	! Set ok_4xCO2atm=true if at least one of the concerned variables are
685	! defined
686	IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' &
687	.OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' &
688	.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. &
689	var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.&
690	var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN
691	IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
692	ENDIF
693	END SUBROUTINE histdef2d
694
695	SUBROUTINE histdef3d(iff,var)
696
697	USE ioipsl, ONLY: histdef
698	USE dimphy, ONLY: klev
699	USE lmdz_phys_para, ONLY: jj_nb, is_master
700	USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
701	clef_stations, phys_out_filenames, lev_files, &
702	nid_files, nhorim, swaerofree_diag, levmin, &
703	levmax, nvertm
704	USE lmdz_print_control, ONLY: prt_level,lunout
705	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
706	USE lmdz_wxios, ONLY: wxios_add_field_to_file, using_xios
707	USE lmdz_print_control, ONLY: prt_level,lunout
708	USE lmdz_clesphys
709
710	IMPLICIT NONE
711
712	INTEGER :: iff
713	TYPE(ctrl_out) :: var
714
715	REAL zstophym
716	CHARACTER(LEN=20) :: typeecrit
717
718	IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
719
720	! ug On récupère le type écrit de la structure:
721	! Assez moche, à refaire si meilleure méthode...
722	IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
723	typeecrit = 'once'
724	ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
725	typeecrit = 't_min(X)'
726	ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
727	typeecrit = 't_max(X)'
728	ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
729	typeecrit = 'inst(X)'
730	ELSE
731	typeecrit = type_ecri_files(iff)
732	ENDIF
733
734	! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
735	CALL conf_physoutputs(var%name,var%flag)
736
737	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
738	zstophym=zoutm(iff)
739	ELSE
740	zstophym=zdtime_moy
741	ENDIF
742
743	IF(.NOT.clef_stations(iff)) THEN
744
745	IF (using_xios) THEN
746
747	IF (.NOT. ok_all_xml) THEN
748	IF ( var%flag(iff)<=lev_files(iff) ) THEN
749	CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
750	var%description, var%unit, var%flag(iff), typeecrit)
751	IF (prt_level >= 10) THEN
752	WRITE(lunout,*) 'histdef3d: CALL wxios_add_field_to_file var%name iff: ', &
753	trim(var%name),iff
754	ENDIF
755	ENDIF
756	ENDIF
757	ENDIF
758	#ifndef CPP_IOIPSL_NO_OUTPUT
759
760	IF ( var%flag(iff)<=lev_files(iff) ) THEN
761	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
762	nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
763	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
764	zstophym, zoutm(iff))
765	ENDIF
766	ELSE
767	IF ( var%flag(iff)<=lev_files(iff)) THEN
768	CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
769	npstn,1,nhorim(iff), klev, levmin(iff), &
770	levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
771	typeecrit, zstophym,zoutm(iff))
772	ENDIF
773	#endif
774	ENDIF
775
776	! Set swaerofree_diag=true if at least one of the concerned variables are defined
777	IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
778	IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
779	ENDIF
780
781	END SUBROUTINE histdef3d
782
783	SUBROUTINE conf_physoutputs(nam_var,flag_var)
784	!!! Lecture des noms et niveau de sortie des variables dans output.def
785	! en utilisant les routines getin de IOIPSL
786	USE ioipsl, ONLY: getin
787	USE phys_output_var_mod, ONLY: nfiles
788	USE lmdz_print_control, ONLY: prt_level,lunout
789	IMPLICIT NONE
790
791	CHARACTER(LEN=*), INTENT(INOUT) :: nam_var
792	INTEGER, INTENT(INOUT) :: flag_var(nfiles)
793
794	IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
795	CALL getin('flag_'//nam_var,flag_var)
796	CALL getin('name_'//nam_var,nam_var)
797	IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
798
799	END SUBROUTINE conf_physoutputs
800
801
802	SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
803
804	USE dimphy, ONLY: klon
805	USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
806	is_sequential, klon_mpi_begin, klon_mpi_end, &
807	jj_nb, klon_mpi, is_master
808	USE ioipsl, ONLY: histwrite
809	USE lmdz_print_control, ONLY: prt_level,lunout
810	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
811
812	IMPLICIT NONE
813
814	INTEGER,INTENT(IN) :: nid
815	LOGICAL,INTENT(IN) :: lpoint
816	CHARACTER(), INTENT(IN) :: name
817	INTEGER, INTENT(IN) :: itau
818	REAL,DIMENSION(:),INTENT(IN) :: field
819	REAL,DIMENSION(klon_mpi) :: buffer_omp
820	INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
821	REAL :: Field2d(nbp_lon,jj_nb)
822
823	INTEGER :: ip
824	REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
825
826	IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
827	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
828
829	CALL Gather_omp(field,buffer_omp)
830	!$OMP MASTER
831	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
832	IF (.NOT.lpoint) THEN
833	ALLOCATE(index2d(nbp_lon*jj_nb))
834	ALLOCATE(fieldok(nbp_lon*jj_nb))
835	IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
836	CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
837	IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
838	ELSE
839	ALLOCATE(fieldok(npstn))
840	ALLOCATE(index2d(npstn))
841
842	IF (is_sequential) THEN
843	! klon_mpi_begin=1
844	! klon_mpi_end=klon
845	DO ip=1, npstn
846	fieldok(ip)=buffer_omp(nptabij(ip))
847	ENDDO
848	ELSE
849	DO ip=1, npstn
850	! PRINT*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
851	IF(nptabij(ip)>=klon_mpi_begin.AND. &
852	nptabij(ip)<=klon_mpi_end) THEN
853	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
854	ENDIF
855	ENDDO
856	ENDIF
857	IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
858	CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
859	IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
860
861	ENDIF
862	DEALLOCATE(index2d)
863	DEALLOCATE(fieldok)
864	!$OMP END MASTER
865
866
867	END SUBROUTINE histwrite2d_phy_old
868
869	SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
870
871	USE dimphy, ONLY: klon
872	USE lmdz_phys_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
873	is_sequential, klon_mpi_begin, klon_mpi_end, &
874	jj_nb, klon_mpi, is_master
875	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat
876	USE ioipsl, ONLY: histwrite
877	USE lmdz_print_control, ONLY: prt_level,lunout
878
879	IMPLICIT NONE
880
881	INTEGER,INTENT(IN) :: nid
882	LOGICAL,INTENT(IN) :: lpoint
883	CHARACTER(), INTENT(IN) :: name
884	INTEGER, INTENT(IN) :: itau
885	REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:)
886	REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
887	REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
888	INTEGER :: ip, n, nlev
889	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
890	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
891
892	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
893
894	IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
895	nlev=size(field,2)
896
897	CALL Gather_omp(field,buffer_omp)
898	!$OMP MASTER
899	CALL grid1Dto2D_mpi(buffer_omp,field3d)
900	IF (.NOT.lpoint) THEN
901	ALLOCATE(index3d(nbp_lonjj_nbnlev))
902	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
903	IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
904	CALL histwrite(nid,name,itau,Field3d,nbp_lonjj_nbnlev,index3d)
905	IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
906	ELSE
907	nlev=size(field,2)
908	ALLOCATE(index3d(npstn*nlev))
909	ALLOCATE(fieldok(npstn,nlev))
910
911	IF (is_sequential) THEN
912	! klon_mpi_begin=1
913	! klon_mpi_end=klon
914	DO n=1, nlev
915	DO ip=1, npstn
916	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
917	ENDDO
918	ENDDO
919	ELSE
920	DO n=1, nlev
921	DO ip=1, npstn
922	IF(nptabij(ip)>=klon_mpi_begin.AND. &
923	nptabij(ip)<=klon_mpi_end) THEN
924	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
925	ENDIF
926	ENDDO
927	ENDDO
928	ENDIF
929	IF (prt_level >= 10) WRITE(lunout,*)'Sending ',name,' to IOIPSL'
930	CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
931	IF (prt_level >= 10) WRITE(lunout,*)'Finished sending ',name,' to IOIPSL'
932	ENDIF
933	DEALLOCATE(index3d)
934	DEALLOCATE(fieldok)
935	!$OMP END MASTER
936
937	END SUBROUTINE histwrite3d_phy_old
938
939
940	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
941	SUBROUTINE histwrite2d_phy(var,field, STD_iff)
942
943	USE lmdz_phys_omp_transfert, ONLY: bcast_omp
944	USE dimphy, ONLY: klon, klev
945	USE lmdz_phys_para, ONLY: gather_omp, grid1dto2d_mpi, &
946	jj_nb, klon_mpi, klon_mpi_begin, &
947	klon_mpi_end, is_sequential, is_master
948	USE ioipsl, ONLY: histwrite
949	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
950	nfiles, vars_defined, clef_stations, &
951	nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
952	USE lmdz_print_control, ONLY: prt_level,lunout
953	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
954	USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
955	USE lmdz_print_control, ONLY: lunout, prt_level
956	USE lmdz_clesphys
957
958	IMPLICIT NONE
959
960	TYPE(ctrl_out), INTENT(IN) :: var
961	REAL, DIMENSION(:), INTENT(IN) :: field
962	INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
963
964	INTEGER :: iff, iff_beg, iff_end
965	LOGICAL, SAVE :: firstx
966	!$OMP THREADPRIVATE(firstx)
967
968	REAL,DIMENSION(klon_mpi) :: buffer_omp
969	INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
970	REAL :: Field2d(nbp_lon,jj_nb)
971
972	INTEGER :: ip
973	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
974	logical, save :: is_active = .TRUE.
975
976	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
977
978	IF (prt_level >= 10) THEN
979	WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
980	ENDIF
981
982	! ug RUSTINE POUR LES STD LEVS.....
983	IF (PRESENT(STD_iff)) THEN
984	iff_beg = STD_iff
985	iff_end = STD_iff
986	ELSE
987	iff_beg = 1
988	iff_end = nfiles
989	ENDIF
990
991	! On regarde si on est dans la phase de définition ou d'écriture:
992	IF (.NOT.vars_defined) THEN
993	!$OMP MASTER
994	!Si phase de définition.... on définit
995	IF (.NOT. ok_all_xml) THEN
996	IF (prt_level >= 10) THEN
997	WRITE(lunout,*)"histwrite2d_phy: .NOT.vars_defined ; time to define ", &
998	trim(var%name)
999	ENDIF
1000	DO iff=iff_beg, iff_end
1001	IF (clef_files(iff)) THEN
1002	CALL histdef2d(iff, var)
1003	ENDIF
1004	ENDDO
1005	ENDIF
1006	!$OMP END MASTER
1007	!--broadcasting the flags that have been changed in histdef2d on OMP masters
1008	CALL bcast_omp(swaero_diag)
1009	CALL bcast_omp(swaerofree_diag)
1010	CALL bcast_omp(dryaod_diag)
1011	CALL bcast_omp(ok_4xCO2atm)
1012
1013	ELSE
1014	IF (using_xios) THEN
1015	IF (ok_all_xml) THEN
1016	!$omp barrier
1017	!$omp master
1018	is_active = xios_field_is_active(var%name, at_current_timestep_arg=.FALSE.)
1019	!$omp end master
1020	!$omp barrier
1021	IF(.NOT. is_active) RETURN
1022	ENDIF
1023	ENDIF
1024
1025	!Et sinon on.... écrit
1026	IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) &
1027	CALL abort_physic('iophy::histwrite2d_phy',&
1028	'Field first DIMENSION not equal to klon/klev',1)
1029	IF (prt_level >= 10) THEn
1030	WRITE (lunout,*)"histwrite2d_phy: .NOT.vars_defined ; time to gather and write ", trim(var%name)
1031	ENDIF
1032
1033
1034	IF (SIZE(field) == klon) THEN
1035	CALL Gather_omp(field,buffer_omp)
1036	ELSE
1037	buffer_omp(:)=0.
1038	ENDIF
1039	!$OMP MASTER
1040	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1041
1042	! La boucle sur les fichiers:
1043	firstx=.TRUE.
1044
1045	IF (ok_all_xml) THEN
1046	IF (using_xios) THEN
1047	IF (prt_level >= 10) THEN
1048	WRITE(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name)
1049	ENDIF
1050
1051	IF (grid_type==regular_lonlat) THEN
1052	IF (SIZE(field) == klon) THEN
1053	CALL xios_send_field(var%name, Field2d)
1054	ELSE
1055	CALL xios_send_field(var%name, field)
1056	ENDIF
1057	ELSE IF (grid_type==unstructured) THEN
1058	IF (SIZE(field) == klon) THEN
1059	CALL xios_send_field(var%name, buffer_omp)
1060	ELSE
1061	CALL xios_send_field(var%name, field)
1062	ENDIF
1063
1064	ENDIF
1065	IF (prt_level >= 10) THEN
1066	WRITE(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',&
1067	trim(var%name)
1068	ENDIF
1069	ELSE
1070	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1071	ENDIF
1072	ELSE
1073	DO iff=iff_beg, iff_end
1074	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1075
1076	IF (using_xios) THEN
1077	IF (firstx) THEN
1078	IF (prt_level >= 10) THEN
1079	WRITE(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
1080	iff,trim(var%name)
1081	WRITE(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, CALL xios_send_field"
1082	ENDIF
1083	IF (grid_type==regular_lonlat) THEN
1084	IF (SIZE(field) == klon) THEN
1085	CALL xios_send_field(var%name, Field2d)
1086	ELSE
1087	CALL xios_send_field(var%name, field)
1088	ENDIF
1089	ELSE IF (grid_type==unstructured) THEN
1090	IF (SIZE(field) == klon) THEN
1091	CALL xios_send_field(var%name, buffer_omp)
1092	ELSE
1093	CALL xios_send_field(var%name, field)
1094	ENDIF
1095	ENDIF
1096
1097	firstx=.FALSE.
1098	ENDIF
1099	ENDIF
1100
1101	IF (.NOT.clef_stations(iff)) THEN
1102	ALLOCATE(index2d(nbp_lon*jj_nb))
1103	ALLOCATE(fieldok(nbp_lon*jj_nb))
1104	#ifndef CPP_IOIPSL_NO_OUTPUT
1105	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
1106	#endif
1107	! IF (using_xios) THEN
1108	! IF (iff == iff_beg) THEN
1109	! IF (prt_level >= 10) THEN
1110	! WRITE(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, CALL xios_send_field"
1111	! ENDIF
1112	! CALL xios_send_field(var%name, Field2d)
1113	! ENDIF
1114	! ENDIF
1115	ELSE
1116	ALLOCATE(fieldok(npstn))
1117	ALLOCATE(index2d(npstn))
1118
1119	IF (is_sequential) THEN
1120	DO ip=1, npstn
1121	fieldok(ip)=buffer_omp(nptabij(ip))
1122	ENDDO
1123	ELSE
1124	DO ip=1, npstn
1125	WRITE(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
1126	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1127	nptabij(ip)<=klon_mpi_end) THEN
1128	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1129	ENDIF
1130	ENDDO
1131	ENDIF ! of IF (is_sequential)
1132	#ifndef CPP_IOIPSL_NO_OUTPUT
1133	IF (prt_level >= 10) THEN
1134	WRITE(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, CALL wxios_write_2D"
1135	ENDIF
1136	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
1137	#endif
1138	ENDIF ! of IF(.NOT.clef_stations(iff))
1139
1140	DEALLOCATE(index2d)
1141	DEALLOCATE(fieldok)
1142	ENDIF !levfiles
1143	ENDDO ! of DO iff=iff_beg, iff_end
1144	ENDIF
1145	!$OMP END MASTER
1146	ENDIF ! vars_defined
1147
1148	IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
1149
1150	END SUBROUTINE histwrite2d_phy
1151
1152
1153	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1154	SUBROUTINE histwrite3d_phy(var, field, STD_iff)
1155
1156	USE lmdz_phys_omp_transfert, ONLY: bcast_omp
1157	USE dimphy, ONLY: klon, klev
1158	USE lmdz_phys_para, ONLY: gather_omp, grid1dto2d_mpi, &
1159	jj_nb, klon_mpi, klon_mpi_begin, &
1160	klon_mpi_end, is_sequential, is_master
1161	USE ioipsl, ONLY: histwrite
1162	USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
1163	nfiles, vars_defined, clef_stations, &
1164	nid_files, swaerofree_diag
1165	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
1166	USE lmdz_xios, ONLY: xios_send_field, xios_field_is_active, using_xios
1167	USE lmdz_print_control, ONLY: prt_level,lunout
1168	USE lmdz_clesphys
1169
1170	IMPLICIT NONE
1171
1172	TYPE(ctrl_out), INTENT(IN) :: var
1173	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1174	INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
1175
1176	INTEGER :: iff, iff_beg, iff_end
1177	LOGICAL, SAVE :: firstx
1178	!$OMP THREADPRIVATE(firstx)
1179	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1180	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1181	INTEGER :: ip, n, nlev, nlevx
1182	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1183	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1184	logical, save :: is_active = .TRUE.
1185
1186	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
1187
1188	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite3d ',var%name
1189
1190	! ug RUSTINE POUR LES STD LEVS.....
1191	IF (PRESENT(STD_iff)) THEN
1192	iff_beg = STD_iff
1193	iff_end = STD_iff
1194	ELSE
1195	iff_beg = 1
1196	iff_end = nfiles
1197	ENDIF
1198
1199	! On regarde si on est dans la phase de définition ou d'écriture:
1200	IF (.NOT.vars_defined) THEN
1201	!Si phase de définition.... on définit
1202	!$OMP MASTER
1203	DO iff=iff_beg, iff_end
1204	IF (clef_files(iff)) THEN
1205	CALL histdef3d(iff, var)
1206	ENDIF
1207	ENDDO
1208	!$OMP END MASTER
1209	!--broadcasting the flag that have been changed in histdef3d on OMP masters
1210	CALL bcast_omp(swaerofree_diag)
1211	ELSE
1212	IF (using_xios) THEN
1213	IF (ok_all_xml) THEN
1214	!$omp barrier
1215	!$omp master
1216	is_active = xios_field_is_active(var%name, at_current_timestep_arg=.FALSE.)
1217	!$omp end master
1218	!$omp barrier
1219	IF(.NOT. is_active) RETURN
1220	ENDIF
1221	ENDIF
1222
1223	!Et sinon on.... écrit
1224	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev &
1225	.AND. SIZE(field,1)/=klev+1) &
1226	CALL abort_physic('iophy::histwrite3d_phy', &
1227	'Field first DIMENSION not equal to klon/klev',1)
1228
1229	nlev=SIZE(field,2)
1230	nlevx=nlev
1231	! IF (nlev.EQ.klev+1) THEN
1232	! nlevx=klev
1233	! ELSE
1234	! nlevx=nlev
1235	! ENDIF
1236
1237	IF (SIZE(field,1) == klon) THEN
1238	CALL Gather_omp(field,buffer_omp)
1239	ELSE
1240	buffer_omp(:,:)=0.
1241	ENDIF
1242	!$OMP MASTER
1243	IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
1244
1245	! BOUCLE SUR LES FICHIERS
1246	firstx=.TRUE.
1247
1248	IF (ok_all_xml) THEN
1249	IF (using_xios) THEN
1250	IF (prt_level >= 10) THEN
1251	WRITE(lunout,*)'Dans iophy histwrite3D,var%name ',&
1252	trim(var%name)
1253	ENDIF
1254	IF (grid_type==regular_lonlat) THEN
1255	IF (SIZE(field,1) == klon) THEN
1256	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1257	ELSE
1258	CALL xios_send_field(var%name, field)
1259	ENDIF
1260	ELSE IF (grid_type==unstructured) THEN
1261	IF (SIZE(field,1) == klon) THEN
1262	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1263	ELSE
1264	CALL xios_send_field(var%name, field)
1265	ENDIF
1266	ENDIF
1267
1268	ELSE
1269	CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1270	ENDIF
1271	ELSE
1272
1273	DO iff=iff_beg, iff_end
1274	IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1275	IF (using_xios) THEN
1276	IF (firstx) THEN
1277	IF (prt_level >= 10) THEN
1278	WRITE(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
1279	iff,nlev,klev, firstx
1280	WRITE(lunout,*)'histwrite3d_phy: CALL xios_send_field for ', &
1281	trim(var%name), ' with iim jjm nlevx = ', &
1282	nbp_lon,jj_nb,nlevx
1283	ENDIF
1284	IF (grid_type==regular_lonlat) THEN
1285	IF (SIZE(field,1) == klon) THEN
1286	CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
1287	ELSE
1288	CALL xios_send_field(var%name, field)
1289	ENDIF
1290	ELSE IF (grid_type==unstructured) THEN
1291	IF (SIZE(field,1) == klon) THEN
1292	CALL xios_send_field(var%name, buffer_omp(:,1:nlevx))
1293	ELSE
1294	CALL xios_send_field(var%name, field)
1295	ENDIF
1296	ENDIF
1297
1298	firstx=.FALSE.
1299	ENDIF
1300	ENDIF
1301
1302	IF (.NOT.clef_stations(iff)) THEN
1303	ALLOCATE(index3d(nbp_lonjj_nbnlev))
1304	ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
1305
1306	#ifndef CPP_IOIPSL_NO_OUTPUT
1307	CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lonjj_nbnlev,index3d)
1308	#endif
1309
1310	! IF (using_xios) THEN
1311	! IF (iff == 1) THEN
1312	! CALL xios_send_field(var%name, Field3d(:,:,1:klev))
1313	! ENDIF
1314	! ENDIF
1315
1316	ELSE
1317	nlev=size(field,2)
1318	ALLOCATE(index3d(npstn*nlev))
1319	ALLOCATE(fieldok(npstn,nlev))
1320
1321	IF (is_sequential) THEN
1322	DO n=1, nlev
1323	DO ip=1, npstn
1324	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1325	ENDDO
1326	ENDDO
1327	ELSE
1328	DO n=1, nlev
1329	DO ip=1, npstn
1330	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1331	nptabij(ip)<=klon_mpi_end) THEN
1332	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1333	ENDIF
1334	ENDDO
1335	ENDDO
1336	ENDIF
1337	#ifndef CPP_IOIPSL_NO_OUTPUT
1338	CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
1339	#endif
1340	ENDIF
1341	DEALLOCATE(index3d)
1342	DEALLOCATE(fieldok)
1343	ENDIF
1344	ENDDO
1345	ENDIF
1346	!$OMP END MASTER
1347	ENDIF ! vars_defined
1348
1349	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite3d ',var%name
1350
1351	END SUBROUTINE histwrite3d_phy
1352
1353
1354	! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
1355	SUBROUTINE histwrite2d_xios(field_name,field)
1356
1357	USE dimphy, ONLY: klon, klev
1358	USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1359	is_sequential, klon_mpi_begin, klon_mpi_end, &
1360	jj_nb, klon_mpi, is_master
1361	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
1362	USE lmdz_xios, ONLY: xios_send_field
1363	USE lmdz_print_control, ONLY: prt_level,lunout
1364
1365	IMPLICIT NONE
1366
1367	CHARACTER(LEN=*), INTENT(IN) :: field_name
1368	REAL, DIMENSION(:), INTENT(IN) :: field
1369
1370	REAL,DIMENSION(klon_mpi) :: buffer_omp
1371	INTEGER, ALLOCATABLE, DIMENSION(:) :: index2d
1372	REAL :: Field2d(nbp_lon,jj_nb)
1373
1374	INTEGER :: ip
1375	REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
1376
1377	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name
1378
1379	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name
1380
1381	!Et sinon on.... écrit
1382	IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1)
1383	IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) THEN
1384	!$OMP MASTER
1385
1386	CALL xios_send_field(field_name,field)
1387	!$OMP END MASTER
1388	ELSE
1389	CALL Gather_omp(field,buffer_omp)
1390	!$OMP MASTER
1391
1392	IF (grid_type==unstructured) THEN
1393
1394	CALL xios_send_field(field_name, buffer_omp)
1395
1396	ELSE
1397
1398	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
1399
1400	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1401	!ATTENTION, STATIONS PAS GEREES !
1402	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1403	!IF(.NOT.clef_stations(iff)) THEN
1404	IF (.TRUE.) THEN
1405
1406	CALL xios_send_field(field_name, Field2d)
1407
1408	ELSE
1409	ALLOCATE(fieldok(npstn))
1410	ALLOCATE(index2d(npstn))
1411
1412	IF (is_sequential) THEN
1413	DO ip=1, npstn
1414	fieldok(ip)=buffer_omp(nptabij(ip))
1415	ENDDO
1416	ELSE
1417	DO ip=1, npstn
1418	PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip)
1419	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1420	nptabij(ip)<=klon_mpi_end) THEN
1421	fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
1422	ENDIF
1423	ENDDO
1424	ENDIF
1425	DEALLOCATE(index2d)
1426	DEALLOCATE(fieldok)
1427
1428	ENDIF
1429	ENDIF
1430	!$OMP END MASTER
1431	ENDIF
1432
1433	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name
1434	END SUBROUTINE histwrite2d_xios
1435
1436
1437	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1438	SUBROUTINE histwrite3d_xios(field_name, field)
1439
1440	USE dimphy, ONLY: klon, klev
1441	USE lmdz_phys_para, ONLY: gather_omp, grid1Dto2D_mpi, &
1442	is_sequential, klon_mpi_begin, klon_mpi_end, &
1443	jj_nb, klon_mpi, is_master
1444	USE lmdz_xios, ONLY: xios_send_field
1445	USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
1446	USE lmdz_print_control, ONLY: prt_level,lunout
1447
1448	IMPLICIT NONE
1449
1450	CHARACTER(LEN=*), INTENT(IN) :: field_name
1451	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1452
1453	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1454	REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1455	INTEGER :: ip, n, nlev
1456	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1457	REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1458
1459	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name
1460
1461	IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite3d_xios ',field_name
1462
1463	!Et on.... écrit
1464	IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) THEN
1465	WRITE(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field)
1466	CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1)
1467	ENDIF
1468
1469	IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) THEN
1470	!$OMP MASTER
1471	CALL xios_send_field(field_name,field)
1472	!$OMP END MASTER
1473	ELSE
1474	nlev=SIZE(field,2)
1475
1476
1477	CALL Gather_omp(field,buffer_omp)
1478	!$OMP MASTER
1479
1480	IF (grid_type==unstructured) THEN
1481
1482	CALL xios_send_field(field_name, buffer_omp(:,1:nlev))
1483
1484	ELSE
1485	CALL grid1Dto2D_mpi(buffer_omp,field3d)
1486
1487	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1488	!ATTENTION, STATIONS PAS GEREES !
1489	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1490	!IF (.NOT.clef_stations(iff)) THEN
1491	IF(.TRUE.)THEN
1492
1493	CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
1494
1495	ELSE
1496	nlev=size(field,2)
1497	ALLOCATE(index3d(npstn*nlev))
1498	ALLOCATE(fieldok(npstn,nlev))
1499
1500	IF (is_sequential) THEN
1501	DO n=1, nlev
1502	DO ip=1, npstn
1503	fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1504	ENDDO
1505	ENDDO
1506	ELSE
1507	DO n=1, nlev
1508	DO ip=1, npstn
1509	IF(nptabij(ip)>=klon_mpi_begin.AND. &
1510	nptabij(ip)<=klon_mpi_end) THEN
1511	fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1512	ENDIF
1513	ENDDO
1514	ENDDO
1515	ENDIF
1516	DEALLOCATE(index3d)
1517	DEALLOCATE(fieldok)
1518	ENDIF
1519	ENDIF
1520	!$OMP END MASTER
1521	ENDIF
1522
1523	IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite3d_xios ',field_name
1524
1525	END SUBROUTINE histwrite3d_xios
1526
1527	SUBROUTINE histwrite0d_xios(field_name, field)
1528	USE lmdz_xios, ONLY: xios_send_field
1529	USE lmdz_phys_para, ONLY: is_master
1530	USE lmdz_print_control, ONLY: prt_level,lunout
1531	USE phys_output_var_mod, ONLY: vars_defined
1532
1533	IMPLICIT NONE
1534
1535	CHARACTER(LEN=*), INTENT(IN) :: field_name
1536	REAL, INTENT(IN) :: field ! --> scalar
1537
1538	IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name
1539
1540	IF (vars_defined) THEN
1541	!$OMP MASTER
1542	CALL xios_send_field(field_name, field)
1543	!$OMP END MASTER
1544	ENDIF
1545
1546	END SUBROUTINE histwrite0d_xios
1547
1548	END MODULE iophy

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

Download in other formats:

Original Format