Context Navigation

iophy.F90 @ 5119

Last change on this file since 5119 was 5117, checked in by abarral, 4 months ago
rename modules properly lmdz_* move some unused files to obsolete/ (lint) uppercase fortran keywords
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.7 KB

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

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

Download in other formats:

Original Format