Context Navigation

phys_cosp.F90.prev @ 2216

Last change on this file since 2216 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

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: 19.1 KB

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

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

Download in other formats:

Original Format