Context Navigation

readaerosolstrato2_rrtm.F90 @ 3762

Last change on this file since 3762 was 3480, checked in by Laurent Fairhead, 6 years ago
Integration of revisions 3425 through 3427 from IPSLCM6.0.15 branch into the trunk LF
File size: 17.5 KB

Rev	Line
[2536]	1	!
	2	! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
	3	!
[3480]	4	SUBROUTINE readaerosolstrato2_rrtm(debut, ok_volcan)
[3435]	5
[2694]	6	USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
[2536]	7	nf95_inq_varid, nf95_open
[2694]	8	USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
[2536]	9
	10	USE phys_cal_mod, ONLY : mth_cur
[3435]	11	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dTo1d_glo, grid_type, unstructured
	12	USE mod_phys_lmdz_mpi_data
	13	USE mod_phys_lmdz_omp_data
[2536]	14	USE mod_phys_lmdz_para
	15	USE phys_state_var_mod
	16	USE phys_local_var_mod
	17	USE aero_mod
	18	USE dimphy
[2694]	19	USE YOERAD, ONLY : NLW
	20	USE YOMCST
[3437]	21	#ifdef CPP_XIOS
[3435]	22	USE xios
[3437]	23	#endif
	24
[2694]	25	IMPLICIT NONE
[2536]	26
[2539]	27	INCLUDE "clesphys.h"
[2536]	28
	29	CHARACTER (len = 80) :: abort_message
	30	CHARACTER (LEN=20) :: modname = 'readaerosolstrato2'
	31
	32	! Variable input
[2694]	33	LOGICAL, INTENT(IN) :: debut
[3480]	34	LOGICAL, INTENT(IN) :: ok_volcan !activate volcanic diags
[2536]	35
	36	! Variables locales
[2694]	37	INTEGER n_lat ! number of latitudes in the input data
	38	INTEGER n_lon ! number of longitudes
	39	INTEGER n_lev ! number of levels in the input data
	40	INTEGER n_month ! number of months in the input data
	41	INTEGER n_wav ! number of wavelengths in the input data
	42	REAL, POINTER:: latitude(:)
	43	REAL, POINTER:: time(:)
	44	REAL, POINTER:: lev(:)
	45	REAL, POINTER:: wav(:)
	46	INTEGER i,k,wave,band
[2744]	47	INTEGER, SAVE :: mth_pre=1
	48	!$OMP THREADPRIVATE(mth_pre)
[2536]	49
[2694]	50	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: tau_aer_strat
	51	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: piz_aer_strat
	52	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cg_aer_strat
	53	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: taulw_aer_strat
[2536]	54	!$OMP THREADPRIVATE(tau_aer_strat,piz_aer_strat,cg_aer_strat,taulw_aer_strat)
	55
	56	! Champs reconstitues
[2694]	57	REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
	58	REAL, ALLOCATABLE:: pizaerstrat(:, :, :, :)
	59	REAL, ALLOCATABLE:: cgaerstrat(:, :, :, :)
	60	REAL, ALLOCATABLE:: taulwaerstrat(:, :, :, :)
[2536]	61
[2694]	62	REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :, :)
	63	REAL, ALLOCATABLE:: pizaerstrat_mois(:, :, :, :)
	64	REAL, ALLOCATABLE:: cgaerstrat_mois(:, :, :, :)
	65	REAL, ALLOCATABLE:: taulwaerstrat_mois(:, :, :, :)
[2536]	66
[2694]	67	REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :, :)
	68	REAL, ALLOCATABLE:: pizaerstrat_mois_glo(:, :, :)
	69	REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :)
	70	REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :)
[3435]	71	REAL, ALLOCATABLE:: tauaerstrat_mpi(:, :, :)
	72	REAL, ALLOCATABLE:: pizaerstrat_mpi(:, :, :)
	73	REAL, ALLOCATABLE:: cgaerstrat_mpi(:, :, :)
	74	REAL, ALLOCATABLE:: taulwaerstrat_mpi(:, :, :)
[2536]	75
	76	! For NetCDF:
[2694]	77	INTEGER ncid_in ! IDs for input files
	78	INTEGER varid, ncerr
[2536]	79
	80	!--------------------------------------------------------
	81
[2539]	82	IF (.not.ALLOCATED(tau_aer_strat)) ALLOCATE(tau_aer_strat(klon,klev,NSW))
	83	IF (.not.ALLOCATED(piz_aer_strat)) ALLOCATE(piz_aer_strat(klon,klev,NSW))
	84	IF (.not.ALLOCATED(cg_aer_strat)) ALLOCATE(cg_aer_strat(klon,klev,NSW))
[2536]	85
[2539]	86	IF (.not.ALLOCATED(taulw_aer_strat)) ALLOCATE(taulw_aer_strat(klon,klev,NLW))
[2536]	87
	88	!--we only read monthly strat aerosol data
	89	IF (debut.OR.mth_cur.NE.mth_pre) THEN
	90
	91	!--only root reads the data
[2725]	92	IF (is_mpi_root.AND.is_omp_root) THEN
[2536]	93
	94	!--check mth_cur
[2725]	95	IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
	96	print *,'probleme avec le mois dans readaerosolstrat =', mth_cur
	97	ENDIF
[2536]	98
	99	!--initialize n_lon as input data is 2D (lat-alt) only
[2725]	100	n_lon = nbp_lon
[2536]	101
	102	!--Starts with SW optical properties
	103
[2725]	104	CALL nf95_open("tauswstrat.2D.nc", nf90_nowrite, ncid_in)
[2536]	105
[2725]	106	CALL nf95_inq_varid(ncid_in, "LEV", varid)
	107	CALL nf95_gw_var(ncid_in, varid, lev)
	108	n_lev = size(lev)
	109	IF (n_lev.NE.klev) THEN
	110	abort_message='Le nombre de niveaux n est pas egal a klev'
	111	CALL abort_physic(modname,abort_message,1)
	112	ENDIF
[2536]	113
[2725]	114	CALL nf95_inq_varid(ncid_in, "LAT", varid)
	115	CALL nf95_gw_var(ncid_in, varid, latitude)
	116	n_lat = size(latitude)
[3435]	117
	118	IF (grid_type/=unstructured) THEN
	119	IF (n_lat.NE.nbp_lat) THEN
	120	print *, 'latitude=', n_lat, nbp_lat
	121	abort_message='Le nombre de lat n est pas egal a nbp_lat'
	122	CALL abort_physic(modname,abort_message,1)
	123	ENDIF
[2725]	124	ENDIF
[2536]	125
[2725]	126	CALL nf95_inq_varid(ncid_in, "TIME", varid)
	127	CALL nf95_gw_var(ncid_in, varid, time)
	128	n_month = size(time)
	129	IF (n_month.NE.12) THEN
	130	abort_message='Le nombre de month n est pas egal a 12'
	131	CALL abort_physic(modname,abort_message,1)
	132	ENDIF
[2536]	133
[2725]	134	CALL nf95_inq_varid(ncid_in, "WAV", varid)
	135	CALL nf95_gw_var(ncid_in, varid, wav)
	136	n_wav = size(wav)
	137	print *, 'WAV aerosol strato=', n_wav, wav
	138	IF (n_wav.NE.NSW) THEN
	139	abort_message='Le nombre de wav n est pas egal a NSW'
	140	CALL abort_physic(modname,abort_message,1)
	141	ENDIF
[2536]	142
[2725]	143	ALLOCATE(tauaerstrat(n_lat, n_lev, n_wav, n_month))
	144	ALLOCATE(pizaerstrat(n_lat, n_lev, n_wav, n_month))
	145	ALLOCATE(cgaerstrat(n_lat, n_lev, n_wav, n_month))
[2536]	146
	147	!--reading stratospheric aerosol tau per layer
[2725]	148	CALL nf95_inq_varid(ncid_in, "TAU_SUN", varid)
	149	ncerr = nf90_get_var(ncid_in, varid, tauaerstrat)
	150	print *,'code erreur readaerosolstrato=', ncerr, varid
[2536]	151
	152	!--reading stratospheric aerosol omega per layer
[2725]	153	CALL nf95_inq_varid(ncid_in, "OME_SUN", varid)
	154	ncerr = nf90_get_var(ncid_in, varid, pizaerstrat)
	155	print *,'code erreur readaerosolstrato=', ncerr, varid
[2536]	156
	157	!--reading stratospheric aerosol g per layer
[2725]	158	CALL nf95_inq_varid(ncid_in, "GGG_SUN", varid)
	159	ncerr = nf90_get_var(ncid_in, varid, cgaerstrat)
	160	print *,'code erreur readaerosolstrato sw=', ncerr, varid
[2536]	161
[2725]	162	CALL nf95_close(ncid_in)
[2536]	163
[3435]	164
	165	IF (grid_type/=unstructured) THEN
	166	ALLOCATE(tauaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
	167	ALLOCATE(pizaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
	168	ALLOCATE(cgaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
	169
	170	ALLOCATE(tauaerstrat_mois_glo(klon_glo, n_lev, n_wav))
	171	ALLOCATE(pizaerstrat_mois_glo(klon_glo, n_lev, n_wav))
	172	ALLOCATE(cgaerstrat_mois_glo(klon_glo, n_lev, n_wav))
[2536]	173	!--select the correct month
	174	!--and copy into 1st longitude
[3435]	175	tauaerstrat_mois(1,:,:,:) = tauaerstrat(:,:,:,mth_cur)
	176	pizaerstrat_mois(1,:,:,:) = pizaerstrat(:,:,:,mth_cur)
	177	cgaerstrat_mois(1,:,:,:) = cgaerstrat(:,:,:,mth_cur)
[2536]	178
	179	!--copy longitudes
[3435]	180	DO i=2, n_lon
	181	tauaerstrat_mois(i,:,:,:) = tauaerstrat_mois(1,:,:,:)
	182	pizaerstrat_mois(i,:,:,:) = pizaerstrat_mois(1,:,:,:)
	183	cgaerstrat_mois(i,:,:,:) = cgaerstrat_mois(1,:,:,:)
	184	ENDDO
[2536]	185
	186	!---reduce to a klon_glo grid
[3435]	187	DO band=1, NSW
	188	CALL grid2dTo1d_glo(tauaerstrat_mois(:,:,:,band),tauaerstrat_mois_glo(:,:,band))
	189	CALL grid2dTo1d_glo(pizaerstrat_mois(:,:,:,band),pizaerstrat_mois_glo(:,:,band))
	190	CALL grid2dTo1d_glo(cgaerstrat_mois(:,:,:,band),cgaerstrat_mois_glo(:,:,band))
	191	ENDDO
	192	ENDIF
[2536]	193	!--Now LW optical properties
	194	!
[3435]	195
[2725]	196	CALL nf95_open("taulwstrat.2D.nc", nf90_nowrite, ncid_in)
[2536]	197
[2725]	198	CALL nf95_inq_varid(ncid_in, "LEV", varid)
	199	CALL nf95_gw_var(ncid_in, varid, lev)
	200	n_lev = size(lev)
	201	IF (n_lev.NE.klev) THEN
	202	abort_message='Le nombre de niveaux n est pas egal a klev'
	203	CALL abort_physic(modname,abort_message,1)
	204	ENDIF
[2536]	205
[2725]	206	CALL nf95_inq_varid(ncid_in, "LAT", varid)
	207	CALL nf95_gw_var(ncid_in, varid, latitude)
	208	n_lat = size(latitude)
[3435]	209
	210	IF (grid_type/=unstructured) THEN
	211	IF (n_lat.NE.nbp_lat) THEN
	212	abort_message='Le nombre de lat n est pas egal a nbp_lat'
	213	CALL abort_physic(modname,abort_message,1)
	214	ENDIF
[2725]	215	ENDIF
[3435]	216
[2725]	217	CALL nf95_inq_varid(ncid_in, "TIME", varid)
	218	CALL nf95_gw_var(ncid_in, varid, time)
	219	n_month = size(time)
	220	IF (n_month.NE.12) THEN
	221	abort_message='Le nombre de month n est pas egal a 12'
	222	CALL abort_physic(modname,abort_message,1)
	223	ENDIF
[2536]	224
[2725]	225	CALL nf95_inq_varid(ncid_in, "WAV", varid)
	226	CALL nf95_gw_var(ncid_in, varid, wav)
	227	n_wav = size(wav)
	228	print *, 'WAV aerosol strato=', n_wav, wav
	229	IF (n_wav.NE.NLW) THEN
	230	abort_message='Le nombre de wav n est pas egal a NLW'
	231	CALL abort_physic(modname,abort_message,1)
	232	ENDIF
[2536]	233
[2725]	234	ALLOCATE(taulwaerstrat(n_lat, n_lev, n_wav, n_month))
[2536]	235
	236	!--reading stratospheric aerosol lw tau per layer
[2725]	237	CALL nf95_inq_varid(ncid_in, "TAU_EAR", varid)
	238	ncerr = nf90_get_var(ncid_in, varid, taulwaerstrat)
	239	print *,'code erreur readaerosolstrato lw=', ncerr, varid
[2536]	240
[2725]	241	CALL nf95_close(ncid_in)
[2536]	242
[3435]	243	IF (grid_type/=unstructured) THEN
	244
	245	ALLOCATE(taulwaerstrat_mois(n_lon, n_lat, n_lev, n_wav))
	246	ALLOCATE(taulwaerstrat_mois_glo(klon_glo, n_lev, n_wav))
	247
[2536]	248	!--select the correct month
	249	!--and copy into 1st longitude
[3435]	250	taulwaerstrat_mois(1,:,:,:) = taulwaerstrat(:,:,:,mth_cur)
[2536]	251	!--copy longitudes
[3435]	252	DO i=2, n_lon
	253	taulwaerstrat_mois(i,:,:,:) = taulwaerstrat_mois(1,:,:,:)
	254	ENDDO
[2536]	255
	256	!---reduce to a klon_glo grid
[3435]	257	DO band=1, NLW
	258	CALL grid2dTo1d_glo(taulwaerstrat_mois(:,:,:,band),taulwaerstrat_mois_glo(:,:,band))
	259	ENDDO
	260	ENDIF
	261
[2725]	262	ELSE !--proc other than mpi_root and omp_root
	263	!--dummy allocation needed for debug mode
[2536]	264
[2725]	265	ALLOCATE(tauaerstrat_mois_glo(1,1,1))
	266	ALLOCATE(pizaerstrat_mois_glo(1,1,1))
	267	ALLOCATE(cgaerstrat_mois_glo(1,1,1))
	268	ALLOCATE(taulwaerstrat_mois_glo(1,1,1))
	269
[3435]	270	ALLOCATE(tauaerstrat(0,0,0,12))
	271	ALLOCATE(pizaerstrat(0,0,0,12))
	272	ALLOCATE(cgaerstrat(0,0,0,12))
	273	ALLOCATE(taulwaerstrat(0,0,0,12))
	274
	275
[2725]	276	ENDIF !--is_mpi_root and is_omp_root
	277
[2536]	278	!$OMP BARRIER
	279
	280	!--keep memory of previous month
[2725]	281	mth_pre=mth_cur
[2536]	282
[3435]	283	IF (grid_type==unstructured) THEN
	284
[3438]	285	#ifdef CPP_XIOS
	286
[3435]	287	IF (is_omp_master) THEN
	288	ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW))
	289	ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW))
	290	ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW))
	291	ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW))
	292
	293	CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8))
	294	CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi)
	295	CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8))
	296	CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi)
	297	CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8))
	298	CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi)
	299	CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8))
	300	CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi)
	301	ELSE
	302	ALLOCATE(tauaerstrat_mpi(0, 0, 0))
	303	ALLOCATE(pizaerstrat_mpi(0, 0, 0))
	304	ALLOCATE(cgaerstrat_mpi(0, 0, 0))
	305	ALLOCATE(taulwaerstrat_mpi(0, 0, 0))
	306	ENDIF
	307
	308	CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
	309	CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat)
	310	CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat)
	311	CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat)
[3438]	312	#endif
[3435]	313	ELSE
	314
[2536]	315	!--scatter on all proc
[3435]	316	CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
	317	CALL scatter(pizaerstrat_mois_glo,piz_aer_strat)
	318	CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
	319	CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
[3465]	320	IF (is_mpi_root.AND.is_omp_root) DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois)
[2536]	321
[3435]	322	ENDIF
	323
[2725]	324	IF (is_mpi_root.AND.is_omp_root) THEN
[3435]	325	DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat)
	326	ENDIF
	327
[2536]	328
	329	!$OMP BARRIER
	330
	331	ENDIF !--debut ou nouveau mois
	332
	333	!--total vertical aod at the 5 SW wavelengths
	334	!--for now use band 3 AOD into all 5 wavelengths
[2550]	335	!--it is only a reasonable approximation for 550 nm (wave=2)
[2536]	336	band=3
	337	DO i=1, klon
	338	DO k=1, klev
	339	IF (stratomask(i,k).GT.0.999999) THEN
[2550]	340	DO wave=1, nwave_sw
	341	tausum_aero(i,wave,id_STRAT_phy)=tausum_aero(i,wave,id_STRAT_phy)+tau_aer_strat(i,k,band)
[2536]	342	ENDDO
	343	ENDIF
	344	ENDDO
	345	ENDDO
	346
[3480]	347	IF (.NOT. ok_volcan) THEN
	348	!
	349	!--this is the default case
	350	!--stratospheric aerosols are added to both index 2 and 1 for double radiation calls
[2536]	351	!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
[2539]	352	DO band=1, NSW
[2725]	353	WHERE (stratomask.GT.0.999999)
[3480]	354	!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW
[2725]	355	cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)piz_aero_sw_rrtm(:,:,2,band)tau_aero_sw_rrtm(:,:,2,band) + &
	356	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	357	MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	358	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	359	piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	360	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	361	MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
	362	tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
[3480]	363	!--strat aerosols are added to index 1 : natural aerosols only for bands 1 to NSW
	364	cg_aero_sw_rrtm(:,:,1,band) = ( cg_aero_sw_rrtm(:,:,1,band)piz_aero_sw_rrtm(:,:,1,band)tau_aero_sw_rrtm(:,:,1,band) + &
	365	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	366	MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
	367	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	368	piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
	369	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	370	MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 )
	371	tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band)
[2536]	372	ENDWHERE
	373	ENDDO
[3480]	374	!
	375	ELSE
	376	!
	377	!--this is the VOLMIP case
	378	!--stratospheric aerosols are only added to index 2 in this case
	379	!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
	380	DO band=1, NSW
	381	WHERE (stratomask.GT.0.999999)
	382	!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW
	383	cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)piz_aero_sw_rrtm(:,:,2,band)tau_aero_sw_rrtm(:,:,2,band) + &
	384	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	385	MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	386	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	387	piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	388	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	389	MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
	390	tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
	391	ENDWHERE
	392	ENDDO
	393	ENDIF
[2536]	394
[2550]	395	!--total vertical aod at 10 um
	396	!--this is approximated from band 7 of RRTM
	397	band=7
	398	DO i=1, klon
	399	DO k=1, klev
	400	IF (stratomask(i,k).GT.0.999999) THEN
	401	DO wave=1, nwave_lw
	402	tausum_aero(i,nwave_sw+wave,id_STRAT_phy)=tausum_aero(i,nwave_sw+wave,id_STRAT_phy)+taulw_aer_strat(i,k,band)
	403	ENDDO
	404	ENDIF
	405	ENDDO
	406	ENDDO
	407
[3480]	408	IF (.NOT. ok_volcan) THEN
	409	!--this is the default case
	410	!--stratospheric aerosols are added to both index 2 and 1
[2539]	411	DO band=1, NLW
[2725]	412	WHERE (stratomask.GT.0.999999)
	413	tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
	414	tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) + taulw_aer_strat(:,:,band)
	415	ENDWHERE
[2536]	416	ENDDO
[3480]	417	!
	418	ELSE
	419	!
	420	!--this is the VOLMIP case
	421	DO band=1, NLW
	422	!--stratospheric aerosols are not added to index 1
	423	!--and we copy index 2 in index 1 because we want the same dust aerosol LW properties as above
	424	tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,2,band)
	425	!
	426	WHERE (stratomask.GT.0.999999)
	427	!--stratospheric aerosols are only added to index 2
	428	tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
	429	ENDWHERE
	430	ENDDO
	431	ENDIF
[2536]	432
	433	!--default SSA value if there is no aerosol
	434	!--to avoid 0 values that seems to cause some problem to RRTM
	435	WHERE (tau_aero_sw_rrtm.LT.1.e-14)
	436	piz_aero_sw_rrtm = 1.0
	437	ENDWHERE
	438
	439	!--in principle this should not be necessary
	440	!--as these variables have min values already but just in case
	441	!--put 1e-15 min value to both SW and LW AOD
	442	tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15)
	443	tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
	444
[2694]	445	END SUBROUTINE readaerosolstrato2_rrtm

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

Download in other formats:

Original Format