Context Navigation

cosp_output_mod.F90 @ 2268

Last change on this file since 2268 was 2268, checked in by idelkadi, 10 years ago
Mise a jour et corrections pour les sorties Cosp via Xios.
File size: 11.7 KB

Line
1	! A.Idelkadi sept 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2	!! Module pour declarer et initialiser les parametres de controle des fichiers de sorties et des champs a sortir
3	!! La routine cosp_output_open (appelee 1 seule fois dans phy_cosp.F90) permet :
4	!! de creer les fichiers avec leurs grilles horizontales et verticales
5	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6	MODULE cosp_output_mod
7
8	USE MOD_COSP_CONSTANTS
9	USE MOD_COSP_TYPES
10
11	! cosp_output_mod
12	INTEGER, PRIVATE :: i
13	!!!!!!! Controle des fichier de sorties Cosp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14	LOGICAL, DIMENSION(3), SAVE :: cosp_outfilekeys
15	INTEGER, DIMENSION(3), SAVE :: cosp_nidfiles
16	!$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles)
17	INTEGER, DIMENSION(3), SAVE :: nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp
18	REAL, DIMENSION(3), SAVE :: zoutm_cosp
19	!$OMP THREADPRIVATE(nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp, zoutm_cosp)
20	REAL, SAVE :: zdtimemoy_cosp
21	!$OMP THREADPRIVATE(zdtimemoy_cosp)
22	CHARACTER(LEN=20), DIMENSION(3), SAVE :: cosp_outfiletypes
23	CHARACTER(LEN=20), DIMENSION(3), SAVE :: cosp_outfilenames
24	REAL, DIMENSION(3), SAVE :: cosp_ecritfiles
25	!$OMP THREADPRIVATE(cosp_outfiletypes, cosp_outfilenames, cosp_ecritfiles)
26
27	!!!! Controle des variables a sortir dans les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28	TYPE ctrl_outcosp
29	LOGICAL,DIMENSION(3) :: cles !!! Sortir ou non le champs
30	CHARACTER(len=20) :: name
31	CHARACTER(len=150) :: description !!! Nom
32	CHARACTER(len=20) :: unit !!! Unite
33	CHARACTER(len=20),DIMENSION(3) :: cosp_typeecrit !!! Operation (ave, inst, ...)
34	END TYPE ctrl_outcosp
35	! CALIPSO vars
36	TYPE(ctrl_outcosp), SAVE :: o_cllcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
37	"cllcalipso", "Lidar Low-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
38	TYPE(ctrl_outcosp), SAVE :: o_clmcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
39	"clmcalipso", "Lidar Mid-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
40	TYPE(ctrl_outcosp), SAVE :: o_clhcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
41	"clhcalipso", "Lidar Hight-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
42	TYPE(ctrl_outcosp), SAVE :: o_cltcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
43	"cltcalipso", "Lidar Total Cloud Fraction", "1", (/ ('', i=1, 3) /))
44	TYPE(ctrl_outcosp), SAVE :: o_clcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
45	"clcalipso", "Lidar Cloud Fraction (532 nm)", "1", (/ ('', i=1, 3) /))
46	TYPE(ctrl_outcosp), SAVE :: o_cfad_lidarsr532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
47	"cfad_lidarsr532", "Lidar Scattering Ratio CFAD (532 nm)", "1", (/ ('', i=1, 3) /))
48	TYPE(ctrl_outcosp), SAVE :: o_parasol_refl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
49	"parasol_refl", "PARASOL-like mono-directional reflectance","1", (/ ('', i=1, 3) /))
50	TYPE(ctrl_outcosp), SAVE :: o_parasol_crefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
51	"parasol_crefl", "PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))
52	TYPE(ctrl_outcosp), SAVE :: o_Ncrefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
53	"Ncrefl", "Nb PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))
54	TYPE(ctrl_outcosp), SAVE :: o_atb532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
55	"atb532", "Lidar Attenuated Total Backscatter (532 nm)","1", (/ ('', i=1, 3) /))
56	TYPE(ctrl_outcosp), SAVE :: o_beta_mol532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
57	"beta_mol532", "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", (/ ('', i=1, 3) /))
58	! ISCCP vars
59	TYPE(ctrl_outcosp), SAVE :: o_sunlit = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
60	"sunlit", "1 for day points, 0 for nightime","1",(/ ('', i=1, 3) /))
61	TYPE(ctrl_outcosp), SAVE :: o_clisccp2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
62	"clisccp2", "Cloud Fraction as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
63	TYPE(ctrl_outcosp), SAVE :: o_boxtauisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
64	"boxtauisccp", "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
65	TYPE(ctrl_outcosp), SAVE :: o_boxptopisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
66	"boxptopisccp", "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", (/ ('', i=1, 3) /))
67	TYPE(ctrl_outcosp), SAVE :: o_tclisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
68	"tclisccp", "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
69	TYPE(ctrl_outcosp), SAVE :: o_ctpisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
70	"ctpisccp", "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", (/ ('', i=1, 3) /))
71	TYPE(ctrl_outcosp), SAVE :: o_tauisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
72	"tauisccp", "Optical Depth as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
73	TYPE(ctrl_outcosp), SAVE :: o_albisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
74	"albisccp", "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
75	TYPE(ctrl_outcosp), SAVE :: o_meantbisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
76	"meantbisccp", " Mean all-sky 10.5 micron brightness temperature as calculated &
77	by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
78	TYPE(ctrl_outcosp), SAVE :: o_meantbclrisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
79	"meantbclrisccp", "Mean clear-sky 10.5 micron brightness temperature as calculated &
80	by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
81
82	LOGICAL, SAVE :: cosp_varsdefined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
83
84	CONTAINS
85
86	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
87	!!!!!!!!! Ouverture des fichier et definition des axes!!!!!!!!
88	!! histbeg, histvert
89	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
90
91	SUBROUTINE cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
92	ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
93	ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)
94
95
96	USE iophy
97	USE ioipsl
98	USE phys_cal_mod
99
100	#ifdef CPP_XIOS
101	! ug Pour les sorties XIOS
102	USE wxios
103	#endif
104
105	IMPLICIT NONE
106
107	!!! Variables d'entree
108	integer :: Nlevlmdz, Ncolumns ! Number of levels
109	real,dimension(Nlevlmdz) :: presnivs
110	real :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
111	logical :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, use_vgrid, ok_all_xml
112	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
113
114	!!! Variables locales
115	integer :: idayref, iff, ii
116	real :: zjulian,zjulian_start
117	real,dimension(Ncolumns) :: column_ax
118	CHARACTER(LEN=20), DIMENSION(3) :: chfreq = (/ '1day', '1d', '3h' /)
119
120	!!! Variables d'entree
121	include "temps.h"
122	INCLUDE 'iniprint.h'
123
124	#ifdef CPP_XIOS
125	! ug Variables utilisées pour récupérer le calendrier pour xios
126	INTEGER :: x_an, x_mois, x_jour
127	REAL :: x_heure
128	INTEGER :: ini_an, ini_mois, ini_jour
129	REAL :: ini_heure
130	#endif
131
132	WRITE(lunout,*) 'Debut cosp_output_mod.F90'
133	print*,'cosp_varsdefined',cosp_varsdefined
134	! Initialisations (Valeurs par defaut)
135
136	do ii=1,Ncolumns
137	column_ax(ii) = real(ii)
138	enddo
139
140
141	cosp_outfilenames(1) = 'histmthCOSP'
142	cosp_outfilenames(2) = 'histdayCOSP'
143	cosp_outfilenames(3) = 'histhfCOSP'
144
145	cosp_outfiletypes(1) = 'ave(X)'
146	cosp_outfiletypes(2) = 'ave(X)'
147	cosp_outfiletypes(3) = 'ave(X)'
148
149	cosp_outfilekeys(1) = ok_mensuelCOSP
150	cosp_outfilekeys(2) = ok_journeCOSP
151	cosp_outfilekeys(3) = ok_hfCOSP
152
153	cosp_ecritfiles(1) = mth_len*86400.
154	cosp_ecritfiles(2) = 1.*86400.
155	cosp_ecritfiles(3) = 0.125*86400.
156
157	! Lecture des parametres dans output.def ou config.def
158
159	CALL getin('cosp_outfilenames',cosp_outfilenames)
160	CALL getin('cosp_outfilekeys',cosp_outfilekeys)
161	CALL getin('cosp_ecritfiles',cosp_ecritfiles)
162	CALL getin('cosp_outfiletypes',cosp_outfiletypes)
163
164	WRITE(lunout,*)'cosp_outfilenames=',cosp_outfilenames
165	WRITE(lunout,*)'cosp_outfilekeys=',cosp_outfilekeys
166	WRITE(lunout,*)'cosp_ecritfiles=',cosp_ecritfiles
167	WRITE(lunout,*)'cosp_outfiletypes=',cosp_outfiletypes
168
169	idayref = day_ref
170	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
171	CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)
172
173	#ifdef CPP_XIOS
174	! ug R\'eglage du calendrier xios
175	!Temps julian => an, mois, jour, heure
176	! CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
177	! CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
178	! CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
179	! ini_mois, ini_jour, ini_heure )
180	! ug dï¿½claration des axes verticaux de chaque fichier:
181	! if (use_vgrid) then
182	CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
183	! else
184	! WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid
185	! CALL wxios_add_vaxis("presnivs", vgrid%Nlvgrid, presnivs)
186	! endif
187	WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz ',Nlevlmdz
188	CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
189	WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ',PARASOL_NREFL
190	CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
191	WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7
192	CALL wxios_add_vaxis("pressure2", 7, ISCCP_PC)
193	WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns
194	CALL wxios_add_vaxis("column", Ncolumns, column_ax)
195	#endif
196
197	zdtimemoy_cosp = freq_COSP ! Frequence ou l on moyenne
198
199	DO iff=1,3
200	zoutm_cosp(iff) = cosp_ecritfiles(iff) ! Frequence ou l on ecrit en seconde
201
202	IF (cosp_outfilekeys(iff)) THEN
203	CALL histbeg_phy_all(cosp_outfilenames(iff),itau_phy,zjulian,&
204	dtime,nhoricosp(iff),cosp_nidfiles(iff))
205	print*,'histbeg_phy nhoricosp(iff),cosp_nidfiles(iff)', &
206	nhoricosp(iff),cosp_nidfiles(iff)
207
208	#ifdef CPP_XIOS
209	IF (.not. ok_all_xml) then
210	WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
211	CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
212	ENDIF
213	#endif
214
215	#ifndef CPP_IOIPSL_NO_OUTPUT
216	! Definition de l'axe vertical
217	if (use_vgrid) then
218	! Axe vertical Cosp 40 niveaux (en m)
219	CALL histvert(cosp_nidfiles(iff),"height","height","m",vgrid%Nlvgrid,vgrid%z,nvert(iff))
220	else
221	! Axe vertical modele LMDZ presnivs
222	CALL histvert(cosp_nidfiles(iff),"presnivs","Vertical levels","Pa",vgrid%Nlvgrid,presnivs,nvert(iff),"down")
223	endif
224	! Axe vertical niveaux modele (en m)
225	CALL histvert(cosp_nidfiles(iff),"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertmcosp(iff))
226
227	CALL histvert(cosp_nidfiles(iff),"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp(iff))
228
229	CALL histvert(cosp_nidfiles(iff),"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp(iff),"down")
230
231	CALL histvert(cosp_nidfiles(iff),"column","column","count",Ncolumns,column_ax(1:Ncolumns),nvertcol(iff))
232	#endif
233
234	ENDIF
235	ENDDO
236
237	end SUBROUTINE cosp_output_open
238
239	END MODULE cosp_output_mod

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

Download in other formats:

Original Format