Context Navigation

phys_cosp.F90 @ 3931

Last change on this file since 3931 was 1318, checked in by yann meurdesoif, 15 years ago
YM : Parallelisation COSP MPI+OpenMP
File size: 20.5 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
	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
[1318]	72	USE mod_grid_phy_lmdz
[1262]	73	use ioipsl
	74	use iophy
	75
	76	IMPLICIT NONE
	77
	78	! Local variables
[1318]	79	character(len=64),PARAMETER :: cosp_input_nl='cosp_input_nl.txt'
	80	character(len=64),PARAMETER :: cosp_output_nl='cosp_output_nl.txt'
[1262]	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
[1318]	87	!$OMP THREADPRIVATE(Npoints)
[1262]	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
[1318]	94	!$OMP THREADPRIVATE(cfg)
[1262]	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
[1318]	108	!$OMP THREADPRIVATE(emsfc_lw)
[1262]	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
[1318]	121	!$OMP THREADPRIVATE(nid_day_cosp,nid_mth_cosp,nid_hf_cosp)
[1262]	122	logical, save :: debut_cosp=.true.
[1318]	123	!$OMP THREADPRIVATE(debut_cosp)
[1262]	124	integer :: itau_wcosp
[1318]	125	character(len=10),dimension(Ncollmdz),parameter :: chcol=(/'c01','c02','c03','c04','c05','c06','c07','c08','c09','c10', &
[1262]	126	'c11','c12','c13','c14','c15','c16','c17','c18','c19','c20'/)
	127	real,dimension(Ncollmdz) :: column_ax
	128	integer, save :: Nlevout
[1318]	129	!$OMP THREADPRIVATE(Nlevout)
[1262]	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, &
[1318]	148	npoints_it,ncolumns,nlevels,use_vgrid,nlr,csat_vgrid,finput, &
[1262]	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
[1318]	163	NPoints=Nptslmdz
[1262]	164	! Lecture du namelist input
[1318]	165	CALL read_cosp_input
	166
[1262]	167	! Clefs Outputs
	168	call read_cosp_output_nl(cosp_output_nl,cfg)
	169
[1318]	170	if ( (Ncollmdz.ne.Ncolumns).or. (Nlevlmdz.ne.Nlevels) ) then
[1262]	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
[1318]	178
[1262]	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
[1293]	203	call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
[1262]	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
[1293]	325	column_ax(ii) = real(ii)
[1262]	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
[1318]	471
	472	CONTAINS
	473
	474	SUBROUTINE read_cosp_input
[1262]	475
[1318]	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
[1262]	519	end subroutine phys_cosp

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

Download in other formats:

Original Format