Context Navigation

phys_cosp.F90 @ 2160

Last change on this file since 2160 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

Rev	Line
[1262]	1	! Simulateur COSP : Cfmip Observation Simulator Package
[1526]	2
[1262]	3	! ISCCP, Radar (QuickBeam), Lidar et Parasol (ACTSIM), MISR, RTTOVS
	4	!Idelkadi Abderrahmane Aout-Septembre 2009
	5
[1368]	6	subroutine phys_cosp( itap,dtime,freq_cosp, &
	7	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
[2160]	8	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
[1999]	9	Nptslmdz,Nlevlmdz,lon,lat, presnivs,overlaplmdz,sunlit, &
[1526]	10	ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phis,phi,ph,p,skt,t, &
[1262]	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)
[1999]	24	! fracTerLic, !Fraction terre a convertir en masque
[1262]	25	! u_wind,v_wind, !Vents a 10m ???
	26	! phi, !Geopotentiel
[1999]	27	! phis, !Geopotentiel sol
[1262]	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
[1327]	75	USE mod_grid_phy_lmdz
[1262]	76	use ioipsl
	77	use iophy
[1999]	78	use cosp_output_mod
	79	use cosp_output_write_mod
[1262]	80
	81	IMPLICIT NONE
	82
	83	! Local variables
[1327]	84	character(len=64),PARAMETER :: cosp_input_nl='cosp_input_nl.txt'
	85	character(len=64),PARAMETER :: cosp_output_nl='cosp_output_nl.txt'
[1262]	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
[1327]	89	!$OMP THREADPRIVATE(Npoints)
[1262]	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
[1327]	96	!$OMP THREADPRIVATE(cfg)
[1262]	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
[1327]	110	!$OMP THREADPRIVATE(emsfc_lw)
[1262]	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
[1999]	119	integer :: ii
	120	real :: ecrit_day,ecrit_hf,ecrit_mth
[2160]	121	logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, ok_all_xml
[1999]	122
[1262]	123	logical, save :: debut_cosp=.true.
[1327]	124	!$OMP THREADPRIVATE(debut_cosp)
[1526]	125
[1262]	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, &
[1526]	132	zlev,zlev_half,mr_ozone,radliq,radice,dtau_s,dem_s,ref_liq,ref_ice
[1262]	133	real,dimension(Nptslmdz,Nlevlmdz) :: fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
[1999]	134	real,dimension(Nptslmdz) :: lon,lat,skt,fracTerLic,u_wind,v_wind,phis,sunlit
[1262]	135	real,dimension(Nlevlmdz) :: presnivs
	136	integer :: itap,k,ip
	137	real :: dtime,freq_cosp
[1999]	138
[1262]	139	!
[2160]	140	namelist/COSP_INPUT/overlap,isccp_topheight,isccp_topheight_direction, &
	141	npoints_it,ncolumns,use_vgrid,nlr,csat_vgrid, &
[1262]	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
[1327]	156	NPoints=Nptslmdz
[1526]	157	Nlevels=Nlevlmdz
	158
[1262]	159	! Lecture du namelist input
[1327]	160	CALL read_cosp_input
	161
[1262]	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
[1999]	170	print*,' Cles des differents simulateurs cosp :'
[1262]	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
[1999]	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
[1262]	178	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	179	! Allocate memory for gridbox type
	180	!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	181	print *, 'Allocating memory for gridbox type...'
	182
[1327]	183	call construct_cosp_gridbox(dble(itap),radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
[1262]	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
[1526]	200	gbx%zlev = phi/9.81
[1262]	201
[1526]	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
[1262]	210
	211	gbx%T = T
	212	gbx%q = rh*100.
	213	gbx%sh = sh
[1999]	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)
[1262]	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
[1999]	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
[1262]	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)
[1999]	293
	294	!+++++++++++++ Open output files and define output files axis !+++++++++++++
	295	if (debut_cosp) then
	296
[2160]	297	!$OMP MASTER
[1999]	298	print *, ' Open outpts files and define axis'
	299	call cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
[2160]	300	ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml, &
[1999]	301	ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)
[2160]	302	!$OMP END MASTER
	303	!$OMP BARRIER
[1999]	304	debut_cosp=.false.
	305	endif ! debut_cosp
[1262]	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
[1999]	313	!!!!!!!!!!!!!!!!!! Ecreture des sorties Cosp !!!!!!!!!!!!!!r!!!!!!:!!!!!
	314	print *, 'Calling write output'
[2160]	315	call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, &
	316	cfg, gbx, vgrid, sglidar, stlidar, isccp)
[1262]	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
[1327]	336
	337	CONTAINS
	338
	339	SUBROUTINE read_cosp_input
[1262]	340
[1327]	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
[1262]	381	end subroutine phys_cosp

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

Download in other formats:

Original Format