Context Navigation

cosp_output_write_mod.F90 @ 2311

Last change on this file since 2311 was 2311, checked in by Ehouarn Millour, 9 years ago

Further modifications to enforce physics/dynamics separation:

moved iniprint.h and misc_mod back to dyn3d_common, as these should only be used by dynamics.
created print_control_mod in the physics to store flags prt_level, lunout, debug to be local to physics (should be used rather than iniprint.h)
created abort_physic.F90 , which does the same job as abort_gcm() did, but should be used instead when in physics.
reactivated inifis (turned it into a module, inifis_mod.F90) to initialize physical constants and print_control_mod flags.

File size: 17.9 KB

Line
1	!!!! Abderrahmane Idelkadi aout 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2	! Module pour definir (au 1er appel) et ecrire les variables dans les fichiers de sortie cosp
3	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4	MODULE cosp_output_write_mod
5
6	USE cosp_output_mod
7
8	INTEGER, SAVE :: itau_iocosp
9	!$OMP THREADPRIVATE(itau_iocosp)
10	INTEGER, save :: Nlevout, Ncolout
11	!$OMP THREADPRIVATE(Nlevout, Ncolout)
12
13	! INTERFACE histwrite_cosp
14	! MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp
15	! END INTERFACE
16
17	CONTAINS
18
19	SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, &
20	cfg, gbx, vgrid, sglidar, stlidar, isccp)
21
22	USE ioipsl
23	USE control_mod
24	USE print_control_mod, ONLY: lunout,prt_level
25
26	#ifdef CPP_XIOS
27	USE wxios, only: wxios_closedef
28	USE xios, only: xios_update_calendar
29	#endif
30
31	!!! Variables d'entree
32	integer :: itap, Nlevlmdz, Ncolumns, Npoints
33	real :: freq_COSP, dtime
34	type(cosp_config) :: cfg ! Control outputs
35	type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
36	type(cosp_sglidar) :: sglidar ! Output from lidar simulator
37	type(cosp_isccp) :: isccp ! Output from ISCCP simulator
38	type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
39	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
40
41	!!! Variables locales
42	integer :: icl
43	logical :: ok_sync
44	integer :: itau_wcosp
45	real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
46
47	include "temps.h"
48
49	Nlevout = vgrid%Nlvgrid
50	Ncolout = Ncolumns
51
52	! A refaire
53	itau_wcosp = itau_phy + itap + start_time * day_step / iphysiq
54	if (prt_level >= 10) then
55	WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step, iphysiq =', &
56	itau_wcosp, itap, start_time, day_step, iphysiq
57	endif
58
59	! On le donne a cosp_output_write_mod pour que les histwrite y aient acces:
60	CALL set_itau_iocosp(itau_wcosp)
61	if (prt_level >= 10) then
62	WRITE(lunout,*)'itau_iocosp =',itau_iocosp
63	endif
64
65	ok_sync = .TRUE.
66
67	!DO iinit=1, iinitend
68	! AI sept 2014 cette boucle supprimee
69	! On n'ecrit pas quand itap=1 (cosp)
70
71	if (prt_level >= 10) then
72	WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend
73	endif
74
75	!#ifdef CPP_XIOS
76	! !$OMP MASTER
77	!IF (cosp_varsdefined) THEN
78	! if (prt_level >= 10) then
79	! WRITE(lunout,*)'Apell xios_update_calendar cosp_varsdefined iinitend ', &
80	! cosp_varsdefined,iinitend
81	! endif
82	! CALL xios_update_calendar(itau_wcosp)
83	!ENDIF
84	! !$OMP END MASTER
85	! !$OMP BARRIER
86	!#endif
87
88	if (cfg%Llidar_sim) then
89	! Pb des valeurs indefinies, on les met a 0
90	! A refaire proprement
91	do k = 1,Nlevout
92	do ip = 1,Npoints
93	if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
94	stlidar%lidarcld(ip,k)=Cosp_fill_value
95	endif
96	enddo
97
98	do ii= 1,SR_BINS
99	do ip = 1,Npoints
100	if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
101	stlidar%cfad_sr(ip,ii,k)=Cosp_fill_value
102	endif
103	enddo
104	enddo
105	enddo
106
107	do ip = 1,Npoints
108	do k = 1,Nlevlmdz
109	if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
110	sglidar%beta_mol(ip,k)=Cosp_fill_value
111	endif
112
113	do ii= 1,Ncolumns
114	if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
115	sglidar%beta_tot(ip,ii,k)=Cosp_fill_value
116	endif
117	enddo
118
119	enddo !k = 1,Nlevlmdz
120	enddo !ip = 1,Npoints
121
122	do k = 1,LIDAR_NCAT
123	do ip = 1,Npoints
124	if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
125	stlidar%cldlayer(ip,k)=Cosp_fill_value
126	endif
127	enddo
128	enddo
129
130	print*,'Appel histwrite2d_cosp'
131	CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
132	CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
133	CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
134	CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
135	CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
136
137	do icl=1,SR_BINS
138	CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
139	enddo
140
141	CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
142
143	do k=1,PARASOL_NREFL
144	do ip=1, Npoints
145	if (stlidar%cldlayer(ip,4).gt.0.01) then
146	parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
147	stlidar%cldlayer(ip,4)
148	Ncref(ip,k) = 1.
149	else
150	parasolcrefl(ip,k)=0.
151	Ncref(ip,k) = 0.
152	endif
153	enddo
154	enddo
155	CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
156	CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
157
158	do icl=1,Ncolumns
159	CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
160	enddo
161	CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
162	endif !Lidar
163
164	if (cfg%Lisccp_sim) then
165
166	! Traitement des valeurs indefinies
167	do ip = 1,Npoints
168	if(isccp%totalcldarea(ip).eq.-1.E+30)then
169	isccp%totalcldarea(ip)=Cosp_fill_value
170	endif
171	if(isccp%meanptop(ip).eq.-1.E+30)then
172	isccp%meanptop(ip)=Cosp_fill_value
173	endif
174	if(isccp%meantaucld(ip).eq.-1.E+30)then
175	isccp%meantaucld(ip)=Cosp_fill_value
176	endif
177	if(isccp%meanalbedocld(ip).eq.-1.E+30)then
178	isccp%meanalbedocld(ip)=Cosp_fill_value
179	endif
180	if(isccp%meantb(ip).eq.-1.E+30)then
181	isccp%meantb(ip)=Cosp_fill_value
182	endif
183	if(isccp%meantbclr(ip).eq.-1.E+30)then
184	isccp%meantbclr(ip)=Cosp_fill_value
185	endif
186
187	do k=1,7
188	do ii=1,7
189	if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
190	isccp%fq_isccp(ip,ii,k)=Cosp_fill_value
191	endif
192	enddo
193	enddo
194
195	do ii=1,Ncolumns
196	if(isccp%boxtau(ip,ii).eq.-1.E+30)then
197	isccp%boxtau(ip,ii)=Cosp_fill_value
198	endif
199	enddo
200
201	do ii=1,Ncolumns
202	if(isccp%boxptop(ip,ii).eq.-1.E+30)then
203	isccp%boxptop(ip,ii)=Cosp_fill_value
204	endif
205	enddo
206	enddo
207
208	CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
209	do icl=1,7
210	CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
211	enddo
212	CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
213	CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
214	CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
215	CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
216	CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
217	CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
218	CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
219	CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
220	endif ! Isccp
221
222	IF(.NOT.cosp_varsdefined) THEN
223	!$OMP MASTER
224	#ifndef CPP_IOIPSL_NO_OUTPUT
225	DO iff=1,3
226	IF (cosp_outfilekeys(iff)) THEN
227	CALL histend(cosp_nidfiles(iff))
228	ENDIF ! cosp_outfilekeys
229	ENDDO ! iff
230	#endif
231	! Fermeture dans phys_output_write
232	!#ifdef CPP_XIOS
233	!On finalise l'initialisation:
234	!CALL wxios_closedef()
235	!#endif
236
237	!$OMP END MASTER
238	!$OMP BARRIER
239	cosp_varsdefined = .TRUE.
240	END IF
241
242	IF(cosp_varsdefined) THEN
243	! On synchronise les fichiers pour IOIPSL
244	#ifndef CPP_IOIPSL_NO_OUTPUT
245	!$OMP MASTER
246	DO iff=1,3
247	IF (ok_sync .AND. cosp_outfilekeys(iff)) THEN
248	CALL histsync(cosp_nidfiles(iff))
249	ENDIF
250	END DO
251	!$OMP END MASTER
252	#endif
253	ENDIF !cosp_varsdefined
254
255	END SUBROUTINE cosp_output_write
256
257	! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod:
258	SUBROUTINE set_itau_iocosp(ito)
259	IMPLICIT NONE
260	INTEGER, INTENT(IN) :: ito
261	itau_iocosp = ito
262	END SUBROUTINE
263
264	SUBROUTINE histdef2d_cosp (iff,var)
265
266	USE ioipsl
267	USE dimphy
268	use iophy
269	USE mod_phys_lmdz_para
270	USE print_control_mod, ONLY: lunout,prt_level
271	#ifdef CPP_XIOS
272	USE wxios
273	#endif
274
275	IMPLICIT NONE
276
277	INCLUDE "dimensions.h"
278	INCLUDE "temps.h"
279	INCLUDE "clesphys.h"
280
281	INTEGER :: iff
282	TYPE(ctrl_outcosp) :: var
283
284	REAL zstophym
285	CHARACTER(LEN=20) :: typeecrit
286
287	! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
288	! Assez moche, Ã\| refaire si meilleure mÃ©thode...
289	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
290	typeecrit = 'once'
291	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
292	typeecrit = 't_min(X)'
293	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
294	typeecrit = 't_max(X)'
295	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
296	typeecrit = 'inst(X)'
297	ELSE
298	typeecrit = cosp_outfiletypes(iff)
299	ENDIF
300
301	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
302	zstophym=zoutm_cosp(iff)
303	ELSE
304	zstophym=zdtimemoy_cosp
305	ENDIF
306
307	#ifdef CPP_XIOS
308	IF (.not. ok_all_xml) then
309	IF ( var%cles(iff) ) THEN
310	if (prt_level >= 10) then
311	WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
312	endif
313	CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
314	var%description, var%unit, 1, typeecrit)
315	ENDIF
316	ENDIF
317	#endif
318
319	#ifndef CPP_IOIPSL_NO_OUTPUT
320	IF ( var%cles(iff) ) THEN
321	CALL histdef (cosp_nidfiles(iff), var%name, var%description, var%unit, &
322	iim,jj_nb,nhoricosp(iff), 1,1,1, -99, 32, &
323	typeecrit, zstophym,zoutm_cosp(iff))
324	ENDIF
325	#endif
326
327	END SUBROUTINE histdef2d_cosp
328
329	SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
330	USE ioipsl
331	USE dimphy
332	use iophy
333	USE mod_phys_lmdz_para
334	USE print_control_mod, ONLY: lunout,prt_level
335
336	#ifdef CPP_XIOS
337	USE wxios
338	#endif
339
340
341	IMPLICIT NONE
342
343	INCLUDE "dimensions.h"
344	INCLUDE "temps.h"
345	INCLUDE "clesphys.h"
346
347	INTEGER :: iff, klevs
348	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES variables 4D
349	INTEGER, INTENT(IN) :: nvertsave
350	TYPE(ctrl_outcosp) :: var
351
352	REAL zstophym
353	CHARACTER(LEN=20) :: typeecrit, nomi
354	CHARACTER(LEN=20) :: nom
355	character(len=2) :: str2
356	CHARACTER(len=20) :: nam_axvert
357
358	! Axe vertical
359	IF (nvertsave.eq.nvertp(iff)) THEN
360	klevs=PARASOL_NREFL
361	nam_axvert="sza"
362	ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
363	klevs=7
364	nam_axvert="pressure2"
365	ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
366	klevs=Ncolout
367	nam_axvert="column"
368	ELSE
369	klevs=Nlevout
370	nam_axvert="presnivs"
371	ENDIF
372
373	! ug RUSTINE POUR LES Champs 4D
374	IF (PRESENT(ncols)) THEN
375	write(str2,'(i2.2)')ncols
376	nomi=var%name
377	nom="c"//str2//"_"//nomi
378	ELSE
379	nom=var%name
380	END IF
381
382	! ug On rÃ©cupÃ¨re le type Ã©crit de la structure:
383	! Assez moche, Ã\| refaire si meilleure mÃ©thode...
384	IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
385	typeecrit = 'once'
386	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
387	typeecrit = 't_min(X)'
388	ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
389	typeecrit = 't_max(X)'
390	ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
391	typeecrit = 'inst(X)'
392	ELSE
393	typeecrit = cosp_outfiletypes(iff)
394	ENDIF
395
396	IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
397	zstophym=zoutm_cosp(iff)
398	ELSE
399	zstophym=zdtimemoy_cosp
400	ENDIF
401
402	#ifdef CPP_XIOS
403	IF (.not. ok_all_xml) then
404	IF ( var%cles(iff) ) THEN
405	if (prt_level >= 10) then
406	WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
407	endif
408	CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
409	var%description, var%unit, 1, typeecrit, nam_axvert)
410	ENDIF
411	ENDIF
412	#endif
413
414	#ifndef CPP_IOIPSL_NO_OUTPUT
415	IF ( var%cles(iff) ) THEN
416	CALL histdef (cosp_nidfiles(iff), nom, var%description, var%unit, &
417	iim, jj_nb, nhoricosp(iff), klevs, 1, &
418	klevs, nvertsave, 32, typeecrit, &
419	zstophym, zoutm_cosp(iff))
420	ENDIF
421	#endif
422
423	END SUBROUTINE histdef3d_cosp
424
425	SUBROUTINE histwrite2d_cosp(var,field)
426	USE dimphy
427	USE mod_phys_lmdz_para
428	USE ioipsl
429	use iophy
430	USE print_control_mod, ONLY: lunout,prt_level
431
432	#ifdef CPP_XIOS
433	USE xios, only: xios_send_field
434	#endif
435
436	IMPLICIT NONE
437	INCLUDE 'dimensions.h'
438	INCLUDE 'clesphys.h'
439
440	TYPE(ctrl_outcosp), INTENT(IN) :: var
441	REAL, DIMENSION(:), INTENT(IN) :: field
442
443	INTEGER :: iff
444
445	REAL,DIMENSION(klon_mpi) :: buffer_omp
446	INTEGER, allocatable, DIMENSION(:) :: index2d
447	REAL :: Field2d(iim,jj_nb)
448	CHARACTER(LEN=20) :: nomi, nom
449	character(len=2) :: str2
450	LOGICAL, SAVE :: firstx
451	!$OMP THREADPRIVATE(firstx)
452
453	IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
454
455	! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
456	IF(.NOT.cosp_varsdefined) THEN
457	!$OMP MASTER
458	!Si phase de dÃ©finition.... on dÃ©finit
459	CALL conf_cospoutputs(var%name,var%cles)
460	DO iff=1, 3
461	IF (cosp_outfilekeys(iff)) THEN
462	CALL histdef2d_cosp(iff, var)
463	ENDIF
464	ENDDO
465	!$OMP END MASTER
466	ELSE
467	!Et sinon on.... Ã©crit
468	IF (SIZE(field)/=klon) &
469	CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
470
471	CALL Gather_omp(field,buffer_omp)
472	!$OMP MASTER
473	CALL grid1Dto2D_mpi(buffer_omp,Field2d)
474
475	! La boucle sur les fichiers:
476	firstx=.true.
477	DO iff=1, 3
478	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
479	ALLOCATE(index2d(iim*jj_nb))
480	#ifndef CPP_IOIPSL_NO_OUTPUT
481	CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,iim*jj_nb,index2d)
482	#endif
483	deallocate(index2d)
484	#ifdef CPP_XIOS
485	IF (.not. ok_all_xml) then
486	if (firstx) then
487	if (prt_level >= 10) then
488	WRITE(lunout,*)'xios_send_field variable ',var%name
489	endif
490	CALL xios_send_field(var%name, Field2d)
491	firstx=.false.
492	endif
493	ENDIF
494	#endif
495	ENDIF
496	ENDDO
497
498	#ifdef CPP_XIOS
499	IF (ok_all_xml) THEN
500	if (prt_level >= 10) then
501	WRITE(lunout,*)'xios_send_field variable ',var%name
502	endif
503	CALL xios_send_field(var%name, Field2d)
504	ENDIF
505	#endif
506
507	!$OMP END MASTER
508	ENDIF ! vars_defined
509	IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
510	END SUBROUTINE histwrite2d_cosp
511
512	! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
513	! AI sept 2013
514	SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
515	USE dimphy
516	USE mod_phys_lmdz_para
517	USE ioipsl
518	use iophy
519	USE print_control_mod, ONLY: lunout,prt_level
520
521	#ifdef CPP_XIOS
522	USE xios, only: xios_send_field
523	#endif
524
525
526	IMPLICIT NONE
527	INCLUDE 'dimensions.h'
528	INCLUDE 'clesphys.h'
529
530	TYPE(ctrl_outcosp), INTENT(IN) :: var
531	REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
532	INTEGER, INTENT(IN), OPTIONAL :: ncols ! ug RUSTINE POUR LES Champs 4D.....
533	INTEGER, DIMENSION(3), INTENT(IN) :: nverts
534
535	INTEGER :: iff, k
536
537	REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
538	REAL :: Field3d(iim,jj_nb,SIZE(field,2))
539	INTEGER :: ip, n, nlev
540	INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
541	CHARACTER(LEN=20) :: nomi, nom
542	character(len=2) :: str2
543	LOGICAL, SAVE :: firstx
544	!$OMP THREADPRIVATE(firstx)
545
546	IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
547
548	! ug RUSTINE POUR LES STD LEVS.....
549	IF (PRESENT(ncols)) THEN
550	write(str2,'(i2.2)')ncols
551	nomi=var%name
552	nom="c"//str2//"_"//nomi
553	ELSE
554	nom=var%name
555	END IF
556	! On regarde si on est dans la phase de dÃ©finition ou d'Ã©criture:
557	IF(.NOT.cosp_varsdefined) THEN
558	!Si phase de dÃ©finition.... on dÃ©finit
559	!$OMP MASTER
560	CALL conf_cospoutputs(var%name,var%cles)
561	DO iff=1, 3
562	IF (cosp_outfilekeys(iff)) THEN
563	CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
564	ENDIF
565	ENDDO
566	!$OMP END MASTER
567	ELSE
568	!Et sinon on.... Ã©crit
569	IF (SIZE(field,1)/=klon) &
570	CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
571	nlev=SIZE(field,2)
572
573
574	CALL Gather_omp(field,buffer_omp)
575	!$OMP MASTER
576	CALL grid1Dto2D_mpi(buffer_omp,field3d)
577
578	! BOUCLE SUR LES FICHIERS
579	firstx=.true.
580	DO iff=1, 3
581	IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
582	ALLOCATE(index3d(iimjj_nbnlev))
583	#ifndef CPP_IOIPSL_NO_OUTPUT
584	CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,iimjj_nbnlev,index3d)
585	#endif
586
587	#ifdef CPP_XIOS
588	IF (.not. ok_all_xml) then
589	IF (firstx) THEN
590	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
591	IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
592	firstx=.FALSE.
593	ENDIF
594	ENDIF
595	#endif
596	deallocate(index3d)
597	ENDIF
598	ENDDO
599	#ifdef CPP_XIOS
600	IF (ok_all_xml) THEN
601	CALL xios_send_field(nom, Field3d(:,:,1:nlev))
602	IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
603	ENDIF
604	#endif
605
606	!$OMP END MASTER
607	ENDIF ! vars_defined
608	IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
609	END SUBROUTINE histwrite3d_cosp
610
611	SUBROUTINE conf_cospoutputs(nam_var,cles_var)
612	!!! Lecture des noms et cles de sortie des variables dans config.def
613	! en utilisant les routines getin de IOIPSL
614	use ioipsl
615	USE print_control_mod, ONLY: lunout,prt_level
616
617	IMPLICIT NONE
618
619	CHARACTER(LEN=20) :: nam_var, nnam_var
620	LOGICAL, DIMENSION(3) :: cles_var
621
622	! Lecture dans config.def ou output.def de cles_var et name_var
623	CALL getin('cles_'//nam_var,cles_var)
624	CALL getin('name_'//nam_var,nam_var)
625	IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
626
627	END SUBROUTINE conf_cospoutputs
628
629	END MODULE cosp_output_write_mod

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

Download in other formats:

Original Format