Context Navigation

phys_cosp.F90 @ 5360

Last change on this file since 5360 was 1293, checked in by lguez, 15 years ago

1) Replaced calls to "float" by calls to "real" and "dble" in
"phys_cosp". "call construct_cosp_gridbox(float(itap),..." was a bug
since the corresponding dummy argument has the type "double
precision". (And "float" is not in the Fortran standard.)

2) Modifications for the program "create_etat0_limit" only, "gcm" is
not touched:

2.1) Removed generic interface "startget" in module "startvar". Replaced
calls to "startget" by calls to "startget_phys2d", "startget_dyn" and
"startget_phys1d".

2.2) Simplified the interface of "startget_dyn" and made it more secure by
removing arguments for sizes of arrays and using assumed-shape array
arguments.

2.3) Corrected bug in call to "startget_dyn" for northward velocity. See
ticket #25 in Trac.

2.4) Collected procedures "inter_barxy", "inter_barx", "inter_bary",
"ord_coord" and "ord_coordm" in a module. "inter_barxy" is the only
public procedure in the module. Rewrote those five procedures: removed
arguments for sizes of arrays; used assumed-shape array arguments;
used array expressions; translated some spaghetti code in "inter_bary"
into structured code; corrected bug in "inter_bary", described by
ticket #26 in Trac.

2.5) Corrected a bug in "inter_bary": "y0" was initialized at 0
instead of -90. This bug made values at the south pole wrong. (This bug
has been acknowledeged by P. Le Van.)

2.6) Made the variable "champ" in procedure "limit_netcdf" an array of
rank 2. Thus it can be an argument in the call to the newly-secured
"inter_barxy".

2.7) The files "start.nc", "startphy.nc" and "limit.nc" are impacted
by this revision. There is a significant change in the variable "vcov"
of "start.nc". See
http://web.lmd.jussieu.fr/~lglmd/Rev_1293/index.html. Note also the
changed value of "vcov" at the south pole. There is very little change
in other variables, in all three files.

File size: 19.2 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 ioipsl
73	use iophy
74
75	IMPLICIT NONE
76
77	! Local variables
78	character(len=64) :: cosp_input_nl='cosp_input_nl.txt'
79	character(len=64) :: cosp_output_nl='cosp_output_nl.txt'
80	character(len=512), save :: finput ! Input file name
81	character(len=512), save :: cmor_nl
82	integer, save :: isccp_topheight,isccp_topheight_direction,overlap
83	integer,save :: Ncolumns ! Number of subcolumns in SCOPS
84	integer,parameter :: Ncollmdz=20
85	integer, save :: Npoints ! Number of gridpoints
86	integer, save :: Nlevels ! Number of levels
87	Integer :: Nptslmdz,Nlevlmdz ! Nb de points issus de physiq.F
88	integer, save :: Nlr ! Number of levels in statistical outputs
89	integer, save :: Npoints_it ! Max number of gridpoints to be processed in one iteration
90	integer :: i
91	type(cosp_config),save :: cfg ! Configuration options
92	type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP
93	type(cosp_subgrid) :: sgx ! Subgrid outputs
94	type(cosp_sgradar) :: sgradar ! Output from radar simulator
95	type(cosp_sglidar) :: sglidar ! Output from lidar simulator
96	type(cosp_isccp) :: isccp ! Output from ISCCP simulator
97	type(cosp_misr) :: misr ! Output from MISR simulator
98	type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats
99	type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator
100	type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
101
102	integer :: t0,t1,count_rate,count_max
103	integer :: Nlon,Nlat,geomode
104	real,save :: radar_freq,k2,ZenAng,co2,ch4,n2o,co,emsfc_lw
105	integer,dimension(RTTOV_MAX_CHANNELS),save :: Channels
106	real,dimension(RTTOV_MAX_CHANNELS),save :: Surfem
107	integer, save :: surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay
108	integer, save :: Nprmts_max_hydro,Naero,Nprmts_max_aero,lidar_ice_type
109	integer, save :: platform,satellite,Instrument,Nchannels
110	logical, save :: use_vgrid,csat_vgrid,use_precipitation_fluxes,use_reff
111
112	! Declaration necessaires pour les sorties IOIPSL
113	integer :: ii,idayref
114	real :: zjulian,zstoday,zstomth,zstohf,zout,ecrit_day,ecrit_hf,ecrit_mth
115	integer :: nhori,nvert,nvertp,nvertisccp,nvertm,nvertcol
116	integer, save :: nid_day_cosp,nid_mth_cosp,nid_hf_cosp
117	logical, save :: debut_cosp=.true.
118	integer :: itau_wcosp
119	character(len=10),dimension(Ncollmdz) :: chcol=(/'c01','c02','c03','c04','c05','c06','c07','c08','c09','c10', &
120	'c11','c12','c13','c14','c15','c16','c17','c18','c19','c20'/)
121	real,dimension(Ncollmdz) :: column_ax
122	integer, save :: Nlevout
123
124	include "dimensions.h"
125	include "temps.h"
126
127	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
128	integer :: overlaplmdz ! overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
129	! real,dimension(Npoints,Nlevels) :: height,phi,p,ph,T,sh,rh,tca,cca,mr_lsliq,mr_lsice,mr_ccliq,mr_ccice, &
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,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
135	real,dimension(Nlevlmdz) :: presnivs
136	integer :: itap,k,ip
137	real :: dtime,freq_cosp
138
139	!
140	namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight,isccp_topheight_direction, &
141	npoints,npoints_it,ncolumns,nlevels,use_vgrid,nlr,csat_vgrid,finput, &
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	! Lecture du namelist input
157	open(10,file=cosp_input_nl,status='old')
158	read(10,nml=cosp_input)
159	close(10)
160	! Clefs Outputs
161	call read_cosp_output_nl(cosp_output_nl,cfg)
162
163	if ( (Ncollmdz.ne.Ncolumns).or.(Nptslmdz.ne.Npoints).or.(Nlevlmdz.ne.Nlevels) ) then
164	print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F = ', &
165	Nptslmdz, Nlevlmdz, Ncollmdz
166	print*,'Nb points Horiz, Vert, Sub-col lus dans namelist = ', &
167	Npoints, Nlevels, Ncolumns
168	print*,'Nb points Horiz, Vert, Sub-col passes par physiq.F est different de celui lu par namelist '
169	call abort
170	endif
171
172	if (overlaplmdz.ne.overlap) then
173	print*,'Attention overlaplmdz different de overlap lu dans namelist '
174	endif
175	print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
176
177	print*,' Cles sorties cosp :'
178	print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
179	cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
180
181	endif ! debut_cosp
182
183	print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
184	itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
185	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
186	! Allocate local arrays
187	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
188	! call system_clock(t0,count_rate,count_max) !!! Only for testing purposes
189
190
191	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
192	! Allocate memory for gridbox type
193	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
194	print *, 'Allocating memory for gridbox type...'
195
196	call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
197	Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
198	lidar_ice_type,isccp_topheight,isccp_topheight_direction,overlap,emsfc_lw, &
199	use_precipitation_fluxes,use_reff, &
200	Platform,Satellite,Instrument,Nchannels,ZenAng, &
201	channels(1:Nchannels),surfem(1:Nchannels),co2,ch4,n2o,co,gbx)
202
203	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
204	! Here code to populate input structure
205	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
206
207	print *, 'Populating input structure...'
208	gbx%longitude = lon
209	gbx%latitude = lat
210
211	gbx%p = p !
212	gbx%ph = ph
213	gbx%zlev_half = phi/9.81
214
215	do k = 1, Nlevels-1
216	do ip = 1, Npoints
217	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)
218	enddo
219	enddo
220	do ip = 1, Npoints
221	zlev(ip,Nlevels) = zlev(ip,Nlevels-1)+ 2.*(phi(ip,Nlevels)/9.81-zlev(ip,Nlevels-1))
222	END DO
223	gbx%zlev = zlev
224
225	gbx%T = T
226	gbx%q = rh*100.
227	gbx%sh = sh
228	gbx%cca = cca !convective_cloud_amount (1)
229	gbx%tca = tca ! total_cloud_amount (1)
230	gbx%psfc = ph(:,1) !pression de surface
231	gbx%skt = skt !Skin temperature (K)
232
233	do ip = 1, Npoints
234	if (fracTerLic(ip).ge.0.5) then
235	gbx%land(ip) = 1.
236	else
237	gbx%land(ip) = 0.
238	endif
239	enddo
240	gbx%mr_ozone = mr_ozone !mass_fraction_of_ozone_in_air (kg/kg)
241	! A voir l equivalent LMDZ (u10m et v10m)
242	gbx%u_wind = u_wind !eastward_wind (m s-1)
243	gbx%v_wind = v_wind !northward_wind
244	! Attention
245	gbx%sunlit = 1
246
247	! A voir l equivalent LMDZ
248	mr_ccliq = 0.0
249	mr_ccice = 0.0
250	gbx%mr_hydro(:,:,I_LSCLIQ) = mr_lsliq !mixing_ratio_large_scale_cloud_liquid (kg/kg)
251	gbx%mr_hydro(:,:,I_LSCICE) = mr_lsice !mixing_ratio_large_scale_cloud_ic
252	gbx%mr_hydro(:,:,I_CVCLIQ) = mr_ccliq !mixing_ratio_convective_cloud_liquid
253	gbx%mr_hydro(:,:,I_CVCICE) = mr_ccice !mixing_ratio_convective_cloud_ice
254	! A revoir
255	fl_lsrain = fl_lsrainI + fl_ccrainI
256	fl_lssnow = fl_lssnowI + fl_ccsnowI
257	gbx%rain_ls = fl_lsrain !flux_large_scale_cloud_rain (kg m^-2 s^-1)
258	gbx%snow_ls = fl_lssnow !flux_large_scale_cloud_snow
259	! A voir l equivalent LMDZ
260	fl_lsgrpl=0.
261	fl_ccsnow = 0.
262	fl_ccrain = 0.
263	gbx%grpl_ls = fl_lsgrpl !flux_large_scale_cloud_graupel
264	gbx%rain_cv = fl_ccrain !flux_convective_cloud_rain
265	gbx%snow_cv = fl_ccsnow !flux_convective_cloud_snow
266
267	!Attention Teste
268	! do k = 1, Nlevels
269	! do ip = 1, Npoints
270	!! liquid particles :
271	! radliq(ip,k) = 12.0e-06
272	! if (k.le.3) radliq(ip,k) = 11.0e-06
273
274	! ice particles :
275	! if ( (t(ip,k)-273.15).gt.-81.4 ) then
276	! radice(ip,k) = (0.71(t(ip,k)-273.15)+61.29)1e-6
277	! else
278	! radice(ip,k) = 3.5*1e-6
279	! endif
280	! END DO
281	! END DO
282
283	! gbx%Reff(:,:,I_LSCLIQ) = radliq
284	! gbx%Reff(:,:,I_LSCICE) = radice
285	! gbx%Reff(:,:,I_CVCLIQ) = radliq
286	! gbx%Reff(:,:,I_CVCICE) = radice
287	! print*,'radliq(1,:)=',radliq(1,:)
288	! print*,'radice(1,:)=',radice(1,:)
289
290	gbx%Reff(:,:,I_LSCLIQ) = ref_liq*1e-6
291	gbx%Reff(:,:,I_LSCICE) = ref_ice*1e-6
292	gbx%Reff(:,:,I_CVCLIQ) = ref_liq*1e-6
293	gbx%Reff(:,:,I_CVCICE) = ref_ice*1e-6
294	! print,'ref_liq(1,:)=',ref_liq(1,:)1e-6
295	! print,'ref_liq(1,:)=',ref_ice(1,:)1e-6
296
297	! ISCCP simulator
298	gbx%dtau_s = dtau_s
299	gbx%dtau_c = 0.
300	gbx%dem_s = dem_s
301	gbx%dem_c = 0.
302
303	! Surafce emissivity
304	emsfc_lw = 1.
305
306	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
307	! Define new vertical grid
308	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
309	print *, 'Defining new vertical grid...'
310	call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
311
312	if (debut_cosp) then
313	! Creer le fichier de sorie, definir les variable de sortie
314	! Axe verticale (Pa ou Km)
315	Nlevout = vgrid%Nlvgrid
316
317	do ii=1,Ncolumns
318	column_ax(ii) = real(ii)
319	enddo
320
321	include "ini_histmthCOSP.h"
322	include "ini_histdayCOSP.h"
323	include "ini_histhfCOSP.h"
324
325
326	! print*,'Fin Initialisation des sorties COSP, debut_cosp =',debut_cosp
327	! print*,'R_UNDEF=',R_UNDEF
328
329	debut_cosp=.false.
330	endif ! debut_cosp
331
332	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
333	! Allocate memory for other types
334	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
335	print *, 'Allocating memory for other types...'
336	call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx)
337	call construct_cosp_sgradar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar)
338	call construct_cosp_radarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar)
339	call construct_cosp_sglidar(cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar)
340	call construct_cosp_lidarstats(cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar)
341	call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
342	call construct_cosp_misr(cfg,Npoints,misr)
343	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
344	! Call simulator
345	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
346	print *, 'Calling simulator...'
347	call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
348	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
349	! Write outputs to CMOR-compliant NetCDF
350	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
351
352	! A traiter le cas ou l on a des valeurs indefinies
353	! Attention teste
354
355	! if(1.eq.0)then
356
357
358	do k = 1,Nlevout
359	do ip = 1,Npoints
360	if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
361	stlidar%lidarcld(ip,k)=0.
362	endif
363	enddo
364
365
366	do ii= 1,SR_BINS
367	do ip = 1,Npoints
368	if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
369	stlidar%cfad_sr(ip,ii,k)=0.
370	endif
371	enddo
372	enddo
373	enddo
374
375	do ip = 1,Npoints
376	do k = 1,Nlevlmdz
377	if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
378	sglidar%beta_mol(ip,k)=0.
379	endif
380
381	do ii= 1,Ncolumns
382	if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
383	sglidar%beta_tot(ip,ii,k)=0.
384	endif
385	enddo
386
387	enddo !k = 1,Nlevlmdz
388	enddo !ip = 1,Npoints
389
390	do k = 1,LIDAR_NCAT
391	do ip = 1,Npoints
392	if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
393	stlidar%cldlayer(ip,k)=0.
394	endif
395	enddo
396	enddo
397
398	! endif
399
400	do ip = 1,Npoints
401	if(isccp%totalcldarea(ip).eq.-1.E+30)then
402	isccp%totalcldarea(ip)=0.
403	endif
404	if(isccp%meanptop(ip).eq.-1.E+30)then
405	isccp%meanptop(ip)=0.
406	endif
407	if(isccp%meantaucld(ip).eq.-1.E+30)then
408	isccp%meantaucld(ip)=0.
409	endif
410	if(isccp%meanalbedocld(ip).eq.-1.E+30)then
411	isccp%meanalbedocld(ip)=0.
412	endif
413	if(isccp%meantb(ip).eq.-1.E+30)then
414	isccp%meantb(ip)=0.
415	endif
416	if(isccp%meantbclr(ip).eq.-1.E+30)then
417	isccp%meantbclr(ip)=0.
418	endif
419
420	do k=1,7
421	do ii=1,7
422	if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
423	isccp%fq_isccp(ip,ii,k)=0.
424	endif
425	enddo
426	enddo
427
428	do ii=1,Ncolumns
429	if(isccp%boxtau(ip,ii).eq.-1.E+30)then
430	isccp%boxtau(ip,ii)=0.
431	endif
432	enddo
433
434	do ii=1,Ncolumns
435	if(isccp%boxptop(ip,ii).eq.-1.E+30)then
436	isccp%boxptop(ip,ii)=0.
437	endif
438	enddo
439	enddo
440
441	include "write_histmthCOSP.h"
442	include "write_histdayCOSP.h"
443	include "write_histhfCOSP.h"
444
445
446	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
447	! Deallocate memory in derived types
448	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
449	print *, 'Deallocating memory...'
450	call free_cosp_gridbox(gbx)
451	call free_cosp_subgrid(sgx)
452	call free_cosp_sgradar(sgradar)
453	call free_cosp_radarstats(stradar)
454	call free_cosp_sglidar(sglidar)
455	call free_cosp_lidarstats(stlidar)
456	call free_cosp_isccp(isccp)
457	call free_cosp_misr(misr)
458	call free_cosp_vgrid(vgrid)
459
460	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
461	! Time in s. Only for testing purposes
462	! call system_clock(t1,count_rate,count_max)
463	! print ,(t1-t0)1.0/count_rate
464
465	end subroutine phys_cosp

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

Download in other formats:

Original Format