Context Navigation

phys_cosp.F90 @ 4000

Last change on this file since 4000 was 1318, checked in by yann meurdesoif, 15 years ago
YM : Parallelisation COSP MPI+OpenMP
File size: 20.5 KB

Line
1	! Simulateur COSP : Cfmip Observation Simulator Package
2	! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS
3	!Idelkadi Abderrahmane Aout-Septembre 2009
4
5
6	subroutine phys_cosp( itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf, &
7	overlaplmdz,Nptslmdz,Nlevlmdz,lon,lat, presnivs, &
8	ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phi,ph,p,skt,t, &
9	sh,rh,tca,cca,mr_lsliq,mr_lsice,fl_lsrainI,fl_lssnowI, &
10	fl_ccrainI,fl_ccsnowI,mr_ozone,dtau_s,dem_s)
11
12	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
13	!!!! Inputs :
14	! itap, !Increment de la physiq
15	! dtime, !Pas de temps physiq
16	! overlap, !Overlap type in SCOPS
17	! Npoints, !Nb de points de la grille physiq
18	! Nlevels, !Nb de niveaux verticaux
19	! Ncolumns, !Number of subcolumns
20	! lon,lat, !Longitudes et latitudes de la grille LMDZ
21	! ref_liq,ref_ice, !Rayons effectifs des particules liq et ice (en microm)
22	! fracTerLic, !Fraction terre a convertir en masque
23	! u_wind,v_wind, !Vents a 10m ???
24	! phi, !Geopotentiel
25	! ph, !pression pour chaque inter-couche
26	! p, !Pression aux milieux des couches
27	! skt,t, !Temp au sol et temp 3D
28	! sh, !Humidite specifique
29	! rh, !Humidite relatif
30	! tca, !Fraction nuageuse
31	! cca !Fraction nuageuse convective
32	! mr_lsliq, !Liq Cloud water content
33	! mr_lsice, !Ice Cloud water content
34	! mr_ccliq, !Convective Cloud Liquid water content
35	! mr_ccice, !Cloud ice water content
36	! fl_lsrain, !Large scale precipitation lic
37	! fl_lssnow, !Large scale precipitation ice
38	! fl_ccrain, !Convective precipitation lic
39	! fl_ccsnow, !Convective precipitation ice
40	! mr_ozone, !Concentration ozone (Kg/Kg)
41	! dem_s !Cloud optical emissivity
42	! dtau_s !Cloud optical thickness
43	! emsfc_lw = 1. !Surface emissivity dans radlwsw.F90
44
45	!!! Outputs :
46	! calipso2D, !Lidar Low/heigh/Mean/Total-level Cloud Fraction
47	! calipso3D, !Lidar Cloud Fraction (532 nm)
48	! cfadlidar, !Lidar Scattering Ratio CFAD (532 nm)
49	! parasolrefl, !PARASOL-like mono-directional reflectance
50	! atb, !Lidar Attenuated Total Backscatter (532 nm)
51	! betamol, !Lidar Molecular Backscatter (532 nm)
52	! cfaddbze, !Radar Reflectivity Factor CFAD (94 GHz)
53	! clcalipso2, !Cloud frequency of occurrence as seen by CALIPSO but not CloudSat
54	! dbze, !Efective_reflectivity_factor
55	! cltlidarradar, !Lidar and Radar Total Cloud Fraction
56	! clMISR, !Cloud Fraction as Calculated by the MISR Simulator
57	! clisccp2, !Cloud Fraction as Calculated by the ISCCP Simulator
58	! boxtauisccp, !Optical Depth in Each Column as Calculated by the ISCCP Simulator
59	! boxptopisccp, !Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator
60	! tclisccp, !Total Cloud Fraction as Calculated by the ISCCP Simulator
61	! ctpisccp, !Mean Cloud Top Pressure as Calculated by the ISCCP Simulator
62	! tauisccp, !Mean Optical Depth as Calculated by the ISCCP Simulator
63	! albisccp, !Mean Cloud Albedo as Calculated by the ISCCP Simulator
64	! meantbisccp, !Mean all-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
65	! meantbclrisccp !Mean clear-sky 10.5 micron brightness temperature as calculated by the ISCCP Simulator
66	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
67
68	USE MOD_COSP_CONSTANTS
69	USE MOD_COSP_TYPES
70	USE MOD_COSP
71	USE mod_phys_lmdz_para
72	USE mod_grid_phy_lmdz
73	use ioipsl
74	use iophy
75
76	IMPLICIT NONE
77
78	! Local variables
79	character(len=64),PARAMETER :: cosp_input_nl='cosp_input_nl.txt'
80	character(len=64),PARAMETER :: cosp_output_nl='cosp_output_nl.txt'
81	character(len=512), save :: finput ! Input file name
82	character(len=512), save :: cmor_nl
83	integer, save :: isccp_topheight,isccp_topheight_direction,overlap
84	integer,save :: Ncolumns ! Number of subcolumns in SCOPS
85	integer,parameter :: Ncollmdz=20
86	integer, save :: Npoints ! Number of gridpoints
87	!$OMP THREADPRIVATE(Npoints)
88	integer, save :: Nlevels ! Number of levels
89	Integer :: Nptslmdz,Nlevlmdz ! Nb de points issus de physiq.F
90	integer, save :: Nlr ! Number of levels in statistical outputs
91	integer, save :: Npoints_it ! Max number of gridpoints to be processed in one iteration
92	integer :: i
93	type(cosp_config),save :: cfg ! Configuration options
94	!$OMP THREADPRIVATE(cfg)
95	type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
96	type(cosp_subgrid) :: sgx ! Subgrid outputs
97	type(cosp_sgradar) :: sgradar ! Output from radar simulator
98	type(cosp_sglidar) :: sglidar ! Output from lidar simulator
99	type(cosp_isccp) :: isccp ! Output from ISCCP simulator
100	type(cosp_misr) :: misr ! Output from MISR simulator
101	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
102	type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator
103	type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
104
105	integer :: t0,t1,count_rate,count_max
106	integer :: Nlon,Nlat,geomode
107	real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw
108	!$OMP THREADPRIVATE(emsfc_lw)
109	integer,dimension(RTTOV_MAX_CHANNELS),save :: Channels
110	real,dimension(RTTOV_MAX_CHANNELS),save :: Surfem
111	integer, save :: surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay
112	integer, save :: Nprmts_max_hydro,Naero,Nprmts_max_aero,lidar_ice_type
113	integer, save :: platform,satellite,Instrument,Nchannels
114	logical, save :: use_vgrid,csat_vgrid,use_precipitation_fluxes,use_reff
115
116	! Declaration necessaires pour les sorties IOIPSL
117	integer :: ii,idayref
118	real :: zjulian,zstoday,zstomth,zstohf,zout,ecrit_day,ecrit_hf,ecrit_mth
119	integer :: nhori,nvert,nvertp,nvertisccp,nvertm,nvertcol
120	integer, save :: nid_day_cosp,nid_mth_cosp,nid_hf_cosp
121	!$OMP THREADPRIVATE(nid_day_cosp,nid_mth_cosp,nid_hf_cosp)
122	logical, save :: debut_cosp=.true.
123	!$OMP THREADPRIVATE(debut_cosp)
124	integer :: itau_wcosp
125	character(len=10),dimension(Ncollmdz),parameter :: chcol=(/'c01','c02','c03','c04','c05','c06','c07','c08','c09','c10', &
126	'c11','c12','c13','c14','c15','c16','c17','c18','c19','c20'/)
127	real,dimension(Ncollmdz) :: column_ax
128	integer, save :: Nlevout
129	!$OMP THREADPRIVATE(Nlevout)
130
131	include "dimensions.h"
132	include "temps.h"
133
134	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
135	integer :: overlaplmdz ! overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
136	! real,dimension(Npoints,Nlevels) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
137	real,dimension(Nptslmdz,Nlevlmdz) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
138	fl_lsrain,fl_lssnow,fl_ccrain,fl_ccsnow,fl_lsgrpl, &
139	zlev,mr_ozone,radliq,radice,dtau_s,dem_s,ref_liq,ref_ice
140	real,dimension(Nptslmdz,Nlevlmdz) :: fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
141	real,dimension(Nptslmdz) :: lon,lat,skt,fracTerLic,u_wind,v_wind
142	real,dimension(Nlevlmdz) :: presnivs
143	integer :: itap,k,ip
144	real :: dtime,freq_cosp
145
146	!
147	namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight,isccp_topheight_direction, &
148	npoints_it,ncolumns,nlevels,use_vgrid,nlr,csat_vgrid,finput, &
149	radar_freq,surface_radar,use_mie_tables, &
150	use_gas_abs,do_ray,melt_lay,k2,Nprmts_max_hydro,Naero,Nprmts_max_aero, &
151	lidar_ice_type,use_precipitation_fluxes,use_reff, &
152	platform,satellite,Instrument,Nchannels, &
153	Channels,Surfem,ZenAng,co2,ch4,n2o,co
154
155	!---------------- End of declaration of variables --------------
156
157
158	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
159	! Read namelist with COSP inputs
160	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
161
162	if (debut_cosp) then
163	NPoints=Nptslmdz
164	! Lecture du namelist input
165	CALL read_cosp_input
166
167	! Clefs Outputs
168	call read_cosp_output_nl(cosp_output_nl,cfg)
169
170	if ( (Ncollmdz.ne.Ncolumns).or. (Nlevlmdz.ne.Nlevels) ) then
171	print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F = ', &
172	Nptslmdz, Nlevlmdz, Ncollmdz
173	print*,'Nb points Horiz, Vert, Sub-col lus dans namelist = ', &
174	Npoints, Nlevels, Ncolumns
175	print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F est different de celui lu par namelist '
176	call abort
177	endif
178
179	if (overlaplmdz.ne.overlap) then
180	print*,'Attention overlaplmdz different de overlap lu dans namelist '
181	endif
182	print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
183
184	print*,' Cles sorties cosp :'
185	print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
186	cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
187
188	endif ! debut_cosp
189
190	print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
191	itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
192	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
193	! Allocate local arrays
194	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
195	! call system_clock(t0,count_rate,count_max) !!! Only for testing purposes
196
197
198	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
199	! Allocate memory for gridbox type
200	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
201	print *, 'Allocating memory for gridbox type...'
202
203	call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
204	Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
205	lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
206	use_precipitation_fluxes,use_reff, &
207	Platform,Satellite,Instrument,Nchannels,ZenAng, &
208	channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
209
210	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
211	! Here code to populate input structure
212	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
213
214	print *, 'Populating input structure...'
215	gbx%longitude = lon
216	gbx%latitude = lat
217
218	gbx%p = p !
219	gbx%ph = ph
220	gbx%zlev_half = phi/9.81
221
222	do k = 1, Nlevels-1
223	do ip = 1, Npoints
224	zlev(ip,k) = phi(ip,k)/9.81 + (phi(ip,k+1)-phi(ip,k))/9.81 * (ph(ip,k)-ph(ip,k+1))/p(ip,k)
225	enddo
226	enddo
227	do ip = 1, Npoints
228	zlev(ip,Nlevels) = zlev(ip,Nlevels-1)+ 2.*(phi(ip,Nlevels)/9.81-zlev(ip,Nlevels-1))
229	END DO
230	gbx%zlev = zlev
231
232	gbx%T = T
233	gbx%q = rh*100.
234	gbx%sh = sh
235	gbx%cca = cca !convective_cloud_amount (1)
236	gbx%tca = tca ! total_cloud_amount (1)
237	gbx%psfc = ph(:,1) !pression de surface
238	gbx%skt = skt !Skin temperature (K)
239
240	do ip = 1, Npoints
241	if (fracTerLic(ip).ge.0.5) then
242	gbx%land(ip) = 1.
243	else
244	gbx%land(ip) = 0.
245	endif
246	enddo
247	gbx%mr_ozone = mr_ozone !mass_fraction_of_ozone_in_air (kg/kg)
248	! A voir l equivalent LMDZ (u10m et v10m)
249	gbx%u_wind = u_wind !eastward_wind (m s-1)
250	gbx%v_wind = v_wind !northward_wind
251	! Attention
252	gbx%sunlit = 1
253
254	! A voir l equivalent LMDZ
255	mr_ccliq = 0.0
256	mr_ccice = 0.0
257	gbx%mr_hydro(:,:,I_LSCLIQ) = mr_lsliq !mixing_ratio_large_scale_cloud_liquid (kg/kg)
258	gbx%mr_hydro(:,:,I_LSCICE) = mr_lsice !mixing_ratio_large_scale_cloud_ic
259	gbx%mr_hydro(:,:,I_CVCLIQ) = mr_ccliq !mixing_ratio_convective_cloud_liquid
260	gbx%mr_hydro(:,:,I_CVCICE) = mr_ccice !mixing_ratio_convective_cloud_ice
261	! A revoir
262	fl_lsrain = fl_lsrainI + fl_ccrainI
263	fl_lssnow = fl_lssnowI + fl_ccsnowI
264	gbx%rain_ls = fl_lsrain !flux_large_scale_cloud_rain (kg m^-2 s^-1)
265	gbx%snow_ls = fl_lssnow !flux_large_scale_cloud_snow
266	! A voir l equivalent LMDZ
267	fl_lsgrpl=0.
268	fl_ccsnow = 0.
269	fl_ccrain = 0.
270	gbx%grpl_ls = fl_lsgrpl !flux_large_scale_cloud_graupel
271	gbx%rain_cv = fl_ccrain !flux_convective_cloud_rain
272	gbx%snow_cv = fl_ccsnow !flux_convective_cloud_snow
273
274	!Attention Teste
275	! do k = 1, Nlevels
276	! do ip = 1, Npoints
277	!! liquid particles :
278	! radliq(ip,k) = 12.0e-06
279	! if (k.le.3) radliq(ip,k) = 11.0e-06
280
281	! ice particles :
282	! if ( (t(ip,k)-273.15).gt.-81.4 ) then
283	! radice(ip,k) = (0.71(t(ip,k)-273.15)+61.29)1e-6
284	! else
285	! radice(ip,k) = 3.5*1e-6
286	! endif
287	! END DO
288	! END DO
289
290	! gbx%Reff(:,:,I_LSCLIQ) = radliq
291	! gbx%Reff(:,:,I_LSCICE) = radice
292	! gbx%Reff(:,:,I_CVCLIQ) = radliq
293	! gbx%Reff(:,:,I_CVCICE) = radice
294	! print*,'radliq(1,:)=',radliq(1,:)
295	! print*,'radice(1,:)=',radice(1,:)
296
297	gbx%Reff(:,:,I_LSCLIQ) = ref_liq*1e-6
298	gbx%Reff(:,:,I_LSCICE) = ref_ice*1e-6
299	gbx%Reff(:,:,I_CVCLIQ) = ref_liq*1e-6
300	gbx%Reff(:,:,I_CVCICE) = ref_ice*1e-6
301	! print,'ref_liq(1,:)=',ref_liq(1,:)1e-6
302	! print,'ref_liq(1,:)=',ref_ice(1,:)1e-6
303
304	! ISCCP simulator
305	gbx%dtau_s = dtau_s
306	gbx%dtau_c = 0.
307	gbx%dem_s = dem_s
308	gbx%dem_c = 0.
309
310	! Surafce emissivity
311	emsfc_lw = 1.
312
313	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
314	! Define new vertical grid
315	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
316	print *, 'Defining new vertical grid...'
317	call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
318
319	if (debut_cosp) then
320	! Creer le fichier de sorie, definir les variable de sortie
321	! Axe verticale (Pa ou Km)
322	Nlevout = vgrid%Nlvgrid
323
324	do ii=1,Ncolumns
325	column_ax(ii) = real(ii)
326	enddo
327
328	include "ini_histmthCOSP.h"
329	include "ini_histdayCOSP.h"
330	include "ini_histhfCOSP.h"
331
332
333	! print*,'Fin Initialisation des sorties COSP, debut_cosp =',debut_cosp
334	! print*,'R_UNDEF=',R_UNDEF
335
336	debut_cosp=.false.
337	endif ! debut_cosp
338
339	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
340	! Allocate memory for other types
341	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
342	print *, 'Allocating memory for other types...'
343	call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx)
344	call construct_cosp_sgradar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar)
345	call construct_cosp_radarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar)
346	call construct_cosp_sglidar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar)
347	call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar)
348	call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
349	call construct_cosp_misr(cfg,Npoints,misr)
350	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
351	! Call simulator
352	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
353	print *, 'Calling simulator...'
354	call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
355	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
356	! Write outputs to CMOR-compliant NetCDF
357	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
358
359	! A traiter le cas ou l on a des valeurs indefinies
360	! Attention teste
361
362	! if(1.eq.0)then
363
364
365	do k = 1,Nlevout
366	do ip = 1,Npoints
367	if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
368	stlidar%lidarcld(ip,k)=0.
369	endif
370	enddo
371
372
373	do ii= 1,SR_BINS
374	do ip = 1,Npoints
375	if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
376	stlidar%cfad_sr(ip,ii,k)=0.
377	endif
378	enddo
379	enddo
380	enddo
381
382	do ip = 1,Npoints
383	do k = 1,Nlevlmdz
384	if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
385	sglidar%beta_mol(ip,k)=0.
386	endif
387
388	do ii= 1,Ncolumns
389	if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
390	sglidar%beta_tot(ip,ii,k)=0.
391	endif
392	enddo
393
394	enddo !k = 1,Nlevlmdz
395	enddo !ip = 1,Npoints
396
397	do k = 1,LIDAR_NCAT
398	do ip = 1,Npoints
399	if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
400	stlidar%cldlayer(ip,k)=0.
401	endif
402	enddo
403	enddo
404
405	! endif
406
407	do ip = 1,Npoints
408	if(isccp%totalcldarea(ip).eq.-1.E+30)then
409	isccp%totalcldarea(ip)=0.
410	endif
411	if(isccp%meanptop(ip).eq.-1.E+30)then
412	isccp%meanptop(ip)=0.
413	endif
414	if(isccp%meantaucld(ip).eq.-1.E+30)then
415	isccp%meantaucld(ip)=0.
416	endif
417	if(isccp%meanalbedocld(ip).eq.-1.E+30)then
418	isccp%meanalbedocld(ip)=0.
419	endif
420	if(isccp%meantb(ip).eq.-1.E+30)then
421	isccp%meantb(ip)=0.
422	endif
423	if(isccp%meantbclr(ip).eq.-1.E+30)then
424	isccp%meantbclr(ip)=0.
425	endif
426
427	do k=1,7
428	do ii=1,7
429	if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
430	isccp%fq_isccp(ip,ii,k)=0.
431	endif
432	enddo
433	enddo
434
435	do ii=1,Ncolumns
436	if(isccp%boxtau(ip,ii).eq.-1.E+30)then
437	isccp%boxtau(ip,ii)=0.
438	endif
439	enddo
440
441	do ii=1,Ncolumns
442	if(isccp%boxptop(ip,ii).eq.-1.E+30)then
443	isccp%boxptop(ip,ii)=0.
444	endif
445	enddo
446	enddo
447
448	include "write_histmthCOSP.h"
449	include "write_histdayCOSP.h"
450	include "write_histhfCOSP.h"
451
452
453	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
454	! Deallocate memory in derived types
455	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
456	print *, 'Deallocating memory...'
457	call free_cosp_gridbox(gbx)
458	call free_cosp_subgrid(sgx)
459	call free_cosp_sgradar(sgradar)
460	call free_cosp_radarstats(stradar)
461	call free_cosp_sglidar(sglidar)
462	call free_cosp_lidarstats(stlidar)
463	call free_cosp_isccp(isccp)
464	call free_cosp_misr(misr)
465	call free_cosp_vgrid(vgrid)
466
467	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
468	! Time in s. Only for testing purposes
469	! call system_clock(t1,count_rate,count_max)
470	! print ,(t1-t0)1.0/count_rate
471
472	CONTAINS
473
474	SUBROUTINE read_cosp_input
475
476	IF (is_master) THEN
477	OPEN(10,file=cosp_input_nl,status='old')
478	READ(10,nml=cosp_input)
479	CLOSE(10)
480	ENDIF
481	CALL bcast(cmor_nl)
482	CALL bcast(overlap)
483	CALL bcast(isccp_topheight)
484	CALL bcast(isccp_topheight_direction)
485	CALL bcast(npoints_it)
486	CALL bcast(ncolumns)
487	CALL bcast(nlevels)
488	CALL bcast(use_vgrid)
489	CALL bcast(nlr)
490	CALL bcast(csat_vgrid)
491	CALL bcast(finput)
492	CALL bcast(radar_freq)
493	CALL bcast(surface_radar)
494	CALL bcast(use_mie_tables)
495	CALL bcast(use_gas_abs)
496	CALL bcast(do_ray)
497	CALL bcast(melt_lay)
498	CALL bcast(k2)
499	CALL bcast(Nprmts_max_hydro)
500	CALL bcast(Naero)
501	CALL bcast(Nprmts_max_aero)
502	CALL bcast(lidar_ice_type)
503	CALL bcast(use_precipitation_fluxes)
504	CALL bcast(use_reff)
505	CALL bcast(platform)
506	CALL bcast(satellite)
507	CALL bcast(Instrument)
508	CALL bcast(Nchannels)
509	CALL bcast(Channels)
510	CALL bcast(Surfem)
511	CALL bcast(ZenAng)
512	CALL bcast(co2)
513	CALL bcast(ch4)
514	CALL bcast(n2o)
515	CALL bcast(co)
516	!$OMP BARRIER
517	END SUBROUTINE read_cosp_input
518
519	end subroutine phys_cosp

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

Download in other formats:

Original Format