Context Navigation

readaerosolstrato2_rrtm.F90 @ 5456

Last change on this file since 5456 was 5294, checked in by Laurent Fairhead, 2 months ago
Keeping clesphys.h was not the right solution 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
[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
[5294]	22	! Temporary fix waiting for cleaner interface (or not)
	23	USE clesphys_mod_h, ONLY: NSW
	24
[2694]	25	IMPLICIT NONE
[2536]	26
[5294]	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
[4489]	42	REAL, ALLOCATABLE:: latitude(:)
	43	REAL, ALLOCATABLE:: time(:)
	44	REAL, ALLOCATABLE:: lev(:)
	45	REAL, ALLOCATABLE:: wav(:)
[2694]	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
	285	IF (is_omp_master) THEN
	286	ALLOCATE(tauaerstrat_mpi(klon_mpi, klev, NSW))
	287	ALLOCATE(pizaerstrat_mpi(klon_mpi, klev, NSW))
	288	ALLOCATE(cgaerstrat_mpi(klon_mpi, klev, NSW))
	289	ALLOCATE(taulwaerstrat_mpi(klon_mpi, klev, NLW))
	290
	291	CALL xios_send_field("tauaerstrat_in",SPREAD(tauaerstrat(:,:,:,mth_cur),1,8))
	292	CALL xios_recv_field("tauaerstrat_out",tauaerstrat_mpi)
	293	CALL xios_send_field("pizaerstrat_in",SPREAD(pizaerstrat(:,:,:,mth_cur),1,8))
	294	CALL xios_recv_field("pizaerstrat_out",pizaerstrat_mpi)
	295	CALL xios_send_field("cgaerstrat_in",SPREAD(cgaerstrat(:,:,:,mth_cur),1,8))
	296	CALL xios_recv_field("cgaerstrat_out",cgaerstrat_mpi)
	297	CALL xios_send_field("taulwaerstrat_in",SPREAD(taulwaerstrat(:,:,:,mth_cur),1,8))
	298	CALL xios_recv_field("taulwaerstrat_out",taulwaerstrat_mpi)
	299	ELSE
	300	ALLOCATE(tauaerstrat_mpi(0, 0, 0))
	301	ALLOCATE(pizaerstrat_mpi(0, 0, 0))
	302	ALLOCATE(cgaerstrat_mpi(0, 0, 0))
	303	ALLOCATE(taulwaerstrat_mpi(0, 0, 0))
	304	ENDIF
	305
	306	CALL scatter_omp(tauaerstrat_mpi,tau_aer_strat)
	307	CALL scatter_omp(pizaerstrat_mpi,piz_aer_strat)
	308	CALL scatter_omp(cgaerstrat_mpi,cg_aer_strat)
	309	CALL scatter_omp(taulwaerstrat_mpi,taulw_aer_strat)
	310	ELSE
	311
[2536]	312	!--scatter on all proc
[3435]	313	CALL scatter(tauaerstrat_mois_glo,tau_aer_strat)
	314	CALL scatter(pizaerstrat_mois_glo,piz_aer_strat)
	315	CALL scatter(cgaerstrat_mois_glo,cg_aer_strat)
	316	CALL scatter(taulwaerstrat_mois_glo,taulw_aer_strat)
[3465]	317	IF (is_mpi_root.AND.is_omp_root) DEALLOCATE(tauaerstrat_mois, pizaerstrat_mois, cgaerstrat_mois, taulwaerstrat_mois)
[2536]	318
[3435]	319	ENDIF
	320
[2725]	321	IF (is_mpi_root.AND.is_omp_root) THEN
[3435]	322	DEALLOCATE(tauaerstrat, pizaerstrat, cgaerstrat,taulwaerstrat)
	323	ENDIF
	324
[2536]	325
	326	!$OMP BARRIER
	327
	328	ENDIF !--debut ou nouveau mois
	329
	330	!--total vertical aod at the 5 SW wavelengths
	331	!--for now use band 3 AOD into all 5 wavelengths
[2550]	332	!--it is only a reasonable approximation for 550 nm (wave=2)
[2536]	333	band=3
	334	DO i=1, klon
	335	DO k=1, klev
	336	IF (stratomask(i,k).GT.0.999999) THEN
[2550]	337	DO wave=1, nwave_sw
	338	tausum_aero(i,wave,id_STRAT_phy)=tausum_aero(i,wave,id_STRAT_phy)+tau_aer_strat(i,k,band)
[2536]	339	ENDDO
	340	ENDIF
	341	ENDDO
	342	ENDDO
	343
[3480]	344	IF (.NOT. ok_volcan) THEN
	345	!
	346	!--this is the default case
	347	!--stratospheric aerosols are added to both index 2 and 1 for double radiation calls
[2536]	348	!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
[2539]	349	DO band=1, NSW
[2725]	350	WHERE (stratomask.GT.0.999999)
[3480]	351	!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW
[2725]	352	cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)piz_aero_sw_rrtm(:,:,2,band)tau_aero_sw_rrtm(:,:,2,band) + &
	353	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	354	MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	355	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	356	piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	357	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	358	MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
	359	tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
[3480]	360	!--strat aerosols are added to index 1 : natural aerosols only for bands 1 to NSW
	361	cg_aero_sw_rrtm(:,:,1,band) = ( cg_aero_sw_rrtm(:,:,1,band)piz_aero_sw_rrtm(:,:,1,band)tau_aero_sw_rrtm(:,:,1,band) + &
	362	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	363	MAX( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
	364	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	365	piz_aero_sw_rrtm(:,:,1,band) = ( piz_aero_sw_rrtm(:,:,1,band)*tau_aero_sw_rrtm(:,:,1,band) + &
	366	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	367	MAX( tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band), 1.e-15 )
	368	tau_aero_sw_rrtm(:,:,1,band) = tau_aero_sw_rrtm(:,:,1,band) + tau_aer_strat(:,:,band)
[2536]	369	ENDWHERE
	370	ENDDO
[3480]	371	!
	372	ELSE
	373	!
	374	!--this is the VOLMIP case
	375	!--stratospheric aerosols are only added to index 2 in this case
	376	!--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones
	377	DO band=1, NSW
	378	WHERE (stratomask.GT.0.999999)
	379	!--strat aerosols are added to index 2 : natural and anthropogenic aerosols for bands 1 to NSW
	380	cg_aero_sw_rrtm(:,:,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)piz_aero_sw_rrtm(:,:,2,band)tau_aero_sw_rrtm(:,:,2,band) + &
	381	cg_aer_strat(:,:,band)piz_aer_strat(:,:,band)tau_aer_strat(:,:,band) ) / &
	382	MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	383	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band), 1.e-15 )
	384	piz_aero_sw_rrtm(:,:,2,band) = ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &
	385	piz_aer_strat(:,:,band)*tau_aer_strat(:,:,band) ) / &
	386	MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band), 1.e-15 )
	387	tau_aero_sw_rrtm(:,:,2,band) = tau_aero_sw_rrtm(:,:,2,band) + tau_aer_strat(:,:,band)
	388	ENDWHERE
	389	ENDDO
	390	ENDIF
[2536]	391
[2550]	392	!--total vertical aod at 10 um
	393	!--this is approximated from band 7 of RRTM
	394	band=7
	395	DO i=1, klon
	396	DO k=1, klev
	397	IF (stratomask(i,k).GT.0.999999) THEN
	398	DO wave=1, nwave_lw
	399	tausum_aero(i,nwave_sw+wave,id_STRAT_phy)=tausum_aero(i,nwave_sw+wave,id_STRAT_phy)+taulw_aer_strat(i,k,band)
	400	ENDDO
	401	ENDIF
	402	ENDDO
	403	ENDDO
	404
[3480]	405	IF (.NOT. ok_volcan) THEN
	406	!--this is the default case
	407	!--stratospheric aerosols are added to both index 2 and 1
[2539]	408	DO band=1, NLW
[2725]	409	WHERE (stratomask.GT.0.999999)
	410	tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
	411	tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,1,band) + taulw_aer_strat(:,:,band)
	412	ENDWHERE
[2536]	413	ENDDO
[3480]	414	!
	415	ELSE
	416	!
	417	!--this is the VOLMIP case
	418	DO band=1, NLW
	419	!--stratospheric aerosols are not added to index 1
	420	!--and we copy index 2 in index 1 because we want the same dust aerosol LW properties as above
	421	tau_aero_lw_rrtm(:,:,1,band) = tau_aero_lw_rrtm(:,:,2,band)
	422	!
	423	WHERE (stratomask.GT.0.999999)
	424	!--stratospheric aerosols are only added to index 2
	425	tau_aero_lw_rrtm(:,:,2,band) = tau_aero_lw_rrtm(:,:,2,band) + taulw_aer_strat(:,:,band)
	426	ENDWHERE
	427	ENDDO
	428	ENDIF
[2536]	429
	430	!--default SSA value if there is no aerosol
	431	!--to avoid 0 values that seems to cause some problem to RRTM
	432	WHERE (tau_aero_sw_rrtm.LT.1.e-14)
	433	piz_aero_sw_rrtm = 1.0
	434	ENDWHERE
	435
	436	!--in principle this should not be necessary
	437	!--as these variables have min values already but just in case
	438	!--put 1e-15 min value to both SW and LW AOD
	439	tau_aero_sw_rrtm = MAX(tau_aero_sw_rrtm,1.e-15)
	440	tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
	441
[2694]	442	END SUBROUTINE readaerosolstrato2_rrtm

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

Download in other formats:

Original Format