Context Navigation

phys_cosp.F90 @ 4999

Last change on this file since 4999 was 2160, checked in by Laurent Fairhead, 10 years ago
Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand
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
File size: 17.1 KB

Line
1	! Simulateur COSP : Cfmip Observation Simulator Package
2
3	! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS
4	!Idelkadi Abderrahmane Aout-Septembre 2009
5
6	subroutine phys_cosp( itap,dtime,freq_cosp, &
7	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
8	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
9	Nptslmdz,Nlevlmdz,lon,lat, presnivs,overlaplmdz,sunlit, &
10	ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phis,phi,ph,p,skt,t, &
11	sh,rh,tca,cca,mr_lsliq,mr_lsice,fl_lsrainI,fl_lssnowI, &
12	fl_ccrainI,fl_ccsnowI,mr_ozone,dtau_s,dem_s)
13
14	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15	!!!! Inputs :
16	! itap, !Increment de la physiq
17	! dtime, !Pas de temps physiq
18	! overlap, !Overlap type in SCOPS
19	! Npoints, !Nb de points de la grille physiq
20	! Nlevels, !Nb de niveaux verticaux
21	! Ncolumns, !Number of subcolumns
22	! lon,lat, !Longitudes et latitudes de la grille LMDZ
23	! ref_liq,ref_ice, !Rayons effectifs des particules liq et ice (en microm)
24	! fracTerLic, !Fraction terre a convertir en masque
25	! u_wind,v_wind, !Vents a 10m ???
26	! phi, !Geopotentiel
27	! phis, !Geopotentiel sol
28	! ph, !pression pour chaque inter-couche
29	! p, !Pression aux milieux des couches
30	! skt,t, !Temp au sol et temp 3D
31	! sh, !Humidite specifique
32	! rh, !Humidite relatif
33	! tca, !Fraction nuageuse
34	! cca !Fraction nuageuse convective
35	! mr_lsliq, !Liq Cloud water content
36	! mr_lsice, !Ice Cloud water content
37	! mr_ccliq, !Convective Cloud Liquid water content
38	! mr_ccice, !Cloud ice water content
39	! fl_lsrain, !Large scale precipitation lic
40	! fl_lssnow, !Large scale precipitation ice
41	! fl_ccrain, !Convective precipitation lic
42	! fl_ccsnow, !Convective precipitation ice
43	! mr_ozone, !Concentration ozone (Kg/Kg)
44	! dem_s !Cloud optical emissivity
45	! dtau_s !Cloud optical thickness
46	! emsfc_lw = 1. !Surface emissivity dans radlwsw.F90
47
48	!!! Outputs :
49	! calipso2D, !Lidar Low/heigh/Mean/Total-level Cloud Fraction
50	! calipso3D, !Lidar Cloud Fraction (532 nm)
51	! cfadlidar, !Lidar Scattering Ratio CFAD (532 nm)
52	! parasolrefl, !PARASOL-like mono-directional reflectance
53	! atb, !Lidar Attenuated Total Backscatter (532 nm)
54	! betamol, !Lidar Molecular Backscatter (532 nm)
55	! cfaddbze, !Radar Reflectivity Factor CFAD (94 GHz)
56	! clcalipso2, !Cloud frequency of occurrence as seen by CALIPSO but not CloudSat
57	! dbze, !Efective_reflectivity_factor
58	! cltlidarradar, !Lidar and Radar Total Cloud Fraction
59	! clMISR, !Cloud Fraction as Calculated by the MISR Simulator
60	! clisccp2, !Cloud Fraction as Calculated by the ISCCP Simulator
61	! boxtauisccp, !Optical Depth in Each Column as Calculated by the ISCCP Simulator
62	! boxptopisccp, !Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator
63	! tclisccp, !Total Cloud Fraction as Calculated by the ISCCP Simulator
64	! ctpisccp, !Mean Cloud Top Pressure as Calculated by the ISCCP Simulator
65	! tauisccp, !Mean Optical Depth as Calculated by the ISCCP Simulator
66	! albisccp, !Mean Cloud Albedo as Calculated by the ISCCP Simulator
67	! meantbisccp, !Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
68	! meantbclrisccp !Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
69	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
70
71	USE MOD_COSP_CONSTANTS
72	USE MOD_COSP_TYPES
73	USE MOD_COSP
74	USE mod_phys_lmdz_para
75	USE mod_grid_phy_lmdz
76	use ioipsl
77	use iophy
78	use cosp_output_mod
79	use cosp_output_write_mod
80
81	IMPLICIT NONE
82
83	! Local variables
84	character(len=64),PARAMETER :: cosp_input_nl='cosp_input_nl.txt'
85	character(len=64),PARAMETER :: cosp_output_nl='cosp_output_nl.txt'
86	integer, save :: isccp_topheight,isccp_topheight_direction,overlap
87	integer,save :: Ncolumns ! Number of subcolumns in SCOPS
88	integer, save :: Npoints ! Number of gridpoints
89	!$OMP THREADPRIVATE(Npoints)
90	integer, save :: Nlevels ! Number of levels
91	Integer :: Nptslmdz,Nlevlmdz ! Nb de points issus de physiq.F
92	integer, save :: Nlr ! Number of levels in statistical outputs
93	integer, save :: Npoints_it ! Max number of gridpoints to be processed in one iteration
94	integer :: i
95	type(cosp_config),save :: cfg ! Configuration options
96	!$OMP THREADPRIVATE(cfg)
97	type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
98	type(cosp_subgrid) :: sgx ! Subgrid outputs
99	type(cosp_sgradar) :: sgradar ! Output from radar simulator
100	type(cosp_sglidar) :: sglidar ! Output from lidar simulator
101	type(cosp_isccp) :: isccp ! Output from ISCCP simulator
102	type(cosp_misr) :: misr ! Output from MISR simulator
103	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
104	type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator
105	type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
106
107	integer :: t0,t1,count_rate,count_max
108	integer :: Nlon,Nlat,geomode
109	real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw
110	!$OMP THREADPRIVATE(emsfc_lw)
111	integer,dimension(RTTOV_MAX_CHANNELS),save :: Channels
112	real,dimension(RTTOV_MAX_CHANNELS),save :: Surfem
113	integer, save :: surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay
114	integer, save :: Nprmts_max_hydro,Naero,Nprmts_max_aero,lidar_ice_type
115	integer, save :: platform,satellite,Instrument,Nchannels
116	logical, save :: use_vgrid,csat_vgrid,use_precipitation_fluxes,use_reff
117
118	! Declaration necessaires pour les sorties IOIPSL
119	integer :: ii
120	real :: ecrit_day,ecrit_hf,ecrit_mth
121	logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, ok_all_xml
122
123	logical, save :: debut_cosp=.true.
124	!$OMP THREADPRIVATE(debut_cosp)
125
126	include "dimensions.h"
127
128	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
129	integer :: overlaplmdz ! overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
130	real,dimension(Nptslmdz,Nlevlmdz) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
131	fl_lsrain,fl_lssnow,fl_ccrain,fl_ccsnow,fl_lsgrpl, &
132	zlev,zlev_half,mr_ozone,radliq,radice,dtau_s,dem_s,ref_liq,ref_ice
133	real,dimension(Nptslmdz,Nlevlmdz) :: fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
134	real,dimension(Nptslmdz) :: lon,lat,skt,fracTerLic,u_wind,v_wind,phis,sunlit
135	real,dimension(Nlevlmdz) :: presnivs
136	integer :: itap,k,ip
137	real :: dtime,freq_cosp
138
139	!
140	namelist/COSP_INPUT/overlap,isccp_topheight,isccp_topheight_direction, &
141	npoints_it,ncolumns,use_vgrid,nlr,csat_vgrid, &
142	radar_freq,surface_radar,use_mie_tables, &
143	use_gas_abs,do_ray,melt_lay,k2,Nprmts_max_hydro,Naero,Nprmts_max_aero, &
144	lidar_ice_type,use_precipitation_fluxes,use_reff, &
145	platform,satellite,Instrument,Nchannels, &
146	Channels,Surfem,ZenAng,co2,ch4,n2o,co
147
148	!---------------- End of declaration of variables --------------
149
150
151	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
152	! Read namelist with COSP inputs
153	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
154
155	if (debut_cosp) then
156	NPoints=Nptslmdz
157	Nlevels=Nlevlmdz
158
159	! Lecture du namelist input
160	CALL read_cosp_input
161
162	! Clefs Outputs
163	call read_cosp_output_nl(cosp_output_nl,cfg)
164
165	if (overlaplmdz.ne.overlap) then
166	print*,'Attention overlaplmdz different de overlap lu dans namelist '
167	endif
168	print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
169
170	print*,' Cles des differents simulateurs cosp :'
171	print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
172	cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
173
174	endif ! debut_cosp
175
176	! print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
177	! itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
178	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
179	! Allocate memory for gridbox type
180	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
181	print *, 'Allocating memory for gridbox type...'
182
183	call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
184	Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
185	lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
186	use_precipitation_fluxes,use_reff, &
187	Platform,Satellite,Instrument,Nchannels,ZenAng, &
188	channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
189
190	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
191	! Here code to populate input structure
192	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
193
194	print *, 'Populating input structure...'
195	gbx%longitude = lon
196	gbx%latitude = lat
197
198	gbx%p = p !
199	gbx%ph = ph
200	gbx%zlev = phi/9.81
201
202	zlev_half(:,1) = phis(:)/9.81
203	do k = 2, Nlevels
204	do ip = 1, Npoints
205	zlev_half(ip,k) = phi(ip,k)/9.81 + &
206	(phi(ip,k)-phi(ip,k-1))/9.81 * (ph(ip,k)-p(ip,k)) / (p(ip,k)-p(ip,k-1))
207	enddo
208	enddo
209	gbx%zlev_half = zlev_half
210
211	gbx%T = T
212	gbx%q = rh*100.
213	gbx%sh = sh
214	! On ne veut pas que cosp distingue les nuages stratiformes et convectifs
215	! on passe les contenus totaux (conv+strat)
216	gbx%cca = 0. !convective_cloud_amount (1)
217	gbx%tca = tca ! total_cloud_amount (1)
218	gbx%psfc = ph(:,1) !pression de surface
219	gbx%skt = skt !Skin temperature (K)
220
221	do ip = 1, Npoints
222	if (fracTerLic(ip).ge.0.5) then
223	gbx%land(ip) = 1.
224	else
225	gbx%land(ip) = 0.
226	endif
227	enddo
228	gbx%mr_ozone = mr_ozone !mass_fraction_of_ozone_in_air (kg/kg)
229	! A voir l equivalent LMDZ (u10m et v10m)
230	gbx%u_wind = u_wind !eastward_wind (m s-1)
231	gbx%v_wind = v_wind !northward_wind
232
233	! sunlit calcule a partir de la fraction d ensoleillement par jour
234	do ip = 1, Npoints
235	if (sunlit(ip).le.0.) then
236	gbx%sunlit(ip)=0.
237	else
238	gbx%sunlit(ip)=1.
239	endif
240	enddo
241
242	! A voir l equivalent LMDZ
243	mr_ccliq = 0.0
244	mr_ccice = 0.0
245	gbx%mr_hydro(:,:,I_LSCLIQ) = mr_lsliq !mixing_ratio_large_scale_cloud_liquid (kg/kg)
246	gbx%mr_hydro(:,:,I_LSCICE) = mr_lsice !mixing_ratio_large_scale_cloud_ic
247	gbx%mr_hydro(:,:,I_CVCLIQ) = mr_ccliq !mixing_ratio_convective_cloud_liquid
248	gbx%mr_hydro(:,:,I_CVCICE) = mr_ccice !mixing_ratio_convective_cloud_ice
249	! A revoir
250	fl_lsrain = fl_lsrainI + fl_ccrainI
251	fl_lssnow = fl_lssnowI + fl_ccsnowI
252	gbx%rain_ls = fl_lsrain !flux_large_scale_cloud_rain (kg m^-2 s^-1)
253	gbx%snow_ls = fl_lssnow !flux_large_scale_cloud_snow
254	! A voir l equivalent LMDZ
255	fl_lsgrpl=0.
256	fl_ccsnow = 0.
257	fl_ccrain = 0.
258	gbx%grpl_ls = fl_lsgrpl !flux_large_scale_cloud_graupel
259	gbx%rain_cv = fl_ccrain !flux_convective_cloud_rain
260	gbx%snow_cv = fl_ccsnow !flux_convective_cloud_snow
261
262	gbx%Reff(:,:,I_LSCLIQ) = ref_liq*1e-6
263	gbx%Reff(:,:,I_LSCICE) = ref_ice*1e-6
264	gbx%Reff(:,:,I_CVCLIQ) = ref_liq*1e-6
265	gbx%Reff(:,:,I_CVCICE) = ref_ice*1e-6
266
267	! ISCCP simulator
268	gbx%dtau_s = dtau_s
269	gbx%dtau_c = 0.
270	gbx%dem_s = dem_s
271	gbx%dem_c = 0.
272
273	! Surafce emissivity
274	emsfc_lw = 1.
275
276	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
277	! Define new vertical grid
278	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
279	print *, 'Defining new vertical grid...'
280	call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
281
282	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
283	! Allocate memory for other types
284	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
285	print *, 'Allocating memory for other types...'
286	call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx)
287	call construct_cosp_sgradar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar)
288	call construct_cosp_radarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar)
289	call construct_cosp_sglidar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar)
290	call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar)
291	call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
292	call construct_cosp_misr(cfg,Npoints,misr)
293
294	!+++++++++++++ Open output files and define output files axis !+++++++++++++
295	if (debut_cosp) then
296
297	!$OMP MASTER
298	print *, ' Open outpts files and define axis'
299	call cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
300	ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
301	ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)
302	!$OMP END MASTER
303	!$OMP BARRIER
304	debut_cosp=.false.
305	endif ! debut_cosp
306	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
307	! Call simulator
308	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
309	print *, 'Calling simulator...'
310	call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
311	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
312
313	!!!!!!!!!!!!!!!!!! Ecreture des sorties Cosp !!!!!!!!!!!!!!r!!!!!!:!!!!!
314	print *, 'Calling write output'
315	call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, &
316	cfg, gbx, vgrid, sglidar, stlidar, isccp)
317
318	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
319	! Deallocate memory in derived types
320	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
321	print *, 'Deallocating memory...'
322	call free_cosp_gridbox(gbx)
323	call free_cosp_subgrid(sgx)
324	call free_cosp_sgradar(sgradar)
325	call free_cosp_radarstats(stradar)
326	call free_cosp_sglidar(sglidar)
327	call free_cosp_lidarstats(stlidar)
328	call free_cosp_isccp(isccp)
329	call free_cosp_misr(misr)
330	call free_cosp_vgrid(vgrid)
331
332	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
333	! Time in s. Only for testing purposes
334	! call system_clock(t1,count_rate,count_max)
335	! print ,(t1-t0)1.0/count_rate
336
337	CONTAINS
338
339	SUBROUTINE read_cosp_input
340
341	IF (is_master) THEN
342	OPEN(10,file=cosp_input_nl,status='old')
343	READ(10,nml=cosp_input)
344	CLOSE(10)
345	ENDIF
346	CALL bcast(overlap)
347	CALL bcast(isccp_topheight)
348	CALL bcast(isccp_topheight_direction)
349	CALL bcast(npoints_it)
350	CALL bcast(ncolumns)
351	CALL bcast(use_vgrid)
352	CALL bcast(nlr)
353	CALL bcast(csat_vgrid)
354	CALL bcast(radar_freq)
355	CALL bcast(surface_radar)
356	CALL bcast(use_mie_tables)
357	CALL bcast(use_gas_abs)
358	CALL bcast(do_ray)
359	CALL bcast(melt_lay)
360	CALL bcast(k2)
361	CALL bcast(Nprmts_max_hydro)
362	CALL bcast(Naero)
363	CALL bcast(Nprmts_max_aero)
364	CALL bcast(lidar_ice_type)
365	CALL bcast(use_precipitation_fluxes)
366	CALL bcast(use_reff)
367	CALL bcast(platform)
368	CALL bcast(satellite)
369	CALL bcast(Instrument)
370	CALL bcast(Nchannels)
371	CALL bcast(Channels)
372	CALL bcast(Surfem)
373	CALL bcast(ZenAng)
374	CALL bcast(co2)
375	CALL bcast(ch4)
376	CALL bcast(n2o)
377	CALL bcast(co)
378	!$OMP BARRIER
379	END SUBROUTINE read_cosp_input
380
381	end subroutine phys_cosp

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

Download in other formats:

Original Format