Context Navigation

readaerosolstrato2_rrtm.F90 @ 5229

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

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

Download in other formats:

Original Format