Context Navigation

optcv.F90 @ 3955

Last change on this file since 3955 was 3947, checked in by debatzbr, 7 weeks ago
Pluto PCM: add sanity check for single scattering albedo computation BBT
Property svn:executable set to ``*
File size: 17.7 KB

Line
1	MODULE optcv_mod
2
3	IMPLICIT NONE
4
5	CONTAINS
6
7	SUBROUTINE OPTCV(DTAUV,TAUV,TAUCUMV,PLEV, &
8	QXVAER,QSVAER,GVAER,WBARV,COSBV, &
9	TAURAY,TAUAERO,TMID,PMID,TAUGSURF,QVAR,MUVAR,&
10	DTAUV_AER,WBARV_AER)
11
12	use radinc_h, only: L_NLAYRAD, L_NLEVRAD, L_LEVELS, L_NSPECTV, L_NGAUSS, L_REFVAR, NAERKIND
13	use radcommon_h, only: gasv, tlimit, wrefVAR, Cmk, tgasref, pfgasref,wnov,scalep,indv,glat_ig
14	use gases_h, only: gfrac, ngasmx, igas_H2, igas_H2O, igas_He, igas_N2, &
15	igas_CH4, igas_N2
16	use comcstfi_mod, only: g, r, mugaz
17	use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,callmufi,Fabs_aers_VI,Fabs_aerf_VI
18	use recombin_corrk_mod, only: corrk_recombin, gasv_recomb
19	use tpindex_mod, only: tpindex
20
21	implicit none
22
23	!==================================================================
24	!
25	! Purpose
26	! -------
27	! Calculates shortwave optical constants at each level.
28	!
29	! Authors
30	! -------
31	! Adapted from the NASA Ames code by R. Wordsworth (2009)
32	!
33	!==================================================================
34	!
35	! THIS SUBROUTINE SETS THE OPTICAL CONSTANTS IN THE VISUAL
36	! IT CALCULATES FOR EACH LAYER, FOR EACH SPECTRAL INTERVAL IN THE VISUAL
37	! LAYER: WBAR, DTAU, COSBAR
38	! LEVEL: TAU
39	!
40	! TAUV(L,NW,NG) is the cumulative optical depth at the top of radiation code
41	! layer L. NW is spectral wavelength interval, ng the Gauss point index.
42	!
43	! TLEV(L) - Temperature at the layer boundary
44	! PLEV(L) - Pressure at the layer boundary (i.e. level)
45	! GASV(NT,NPS,NW,NG) - Visible k-coefficients
46	!
47	!-------------------------------------------------------------------
48
49
50	real*8,intent(out) :: DTAUV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
51	real*8 DTAUKV(L_LEVELS,L_NSPECTV,L_NGAUSS)
52	real*8,intent(out) :: TAUV(L_NLEVRAD,L_NSPECTV,L_NGAUSS)
53	real*8,intent(out) :: TAUCUMV(L_LEVELS,L_NSPECTV,L_NGAUSS)
54	real*8,intent(in) :: PLEV(L_LEVELS)
55	real*8,intent(in) :: TMID(L_LEVELS), PMID(L_LEVELS)
56	real*8,intent(out) :: COSBV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
57	real*8,intent(out) :: WBARV(L_NLAYRAD,L_NSPECTV,L_NGAUSS)
58
59	! for aerosols
60	real*8,intent(in) :: QXVAER(L_LEVELS,L_NSPECTV,NAERKIND)
61	real*8,intent(in) :: QSVAER(L_LEVELS,L_NSPECTV,NAERKIND)
62	real*8,intent(in) :: GVAER(L_LEVELS,L_NSPECTV,NAERKIND)
63	real*8,intent(in) :: TAUAERO(L_LEVELS,NAERKIND)
64	real*8,intent(out) :: DTAUV_AER(L_NLAYRAD,L_NSPECTV,NAERKIND)
65	real*8,intent(out) :: WBARV_AER(L_NLAYRAD,L_NSPECTV,NAERKIND)
66
67	! local arrays (saved for convenience as need be allocated)
68	real*8,save,allocatable :: TAUAEROLK(:,:,:)
69	real*8,save,allocatable :: TAEROS(:,:,:)
70	!$OMP THREADPRIVATE(TAUAEROLK,TAEROS)
71
72	integer L, NW, NG, K, LK, IAER
73	integer MT(L_LEVELS), MP(L_LEVELS), NP(L_LEVELS)
74	real*8 ANS, TAUGAS
75	real*8,intent(in) :: TAURAY(L_NSPECTV) ! Rayleigh scattering
76	real*8 TRAY(L_LEVELS,L_NSPECTV) ! Rayleigh scattering
77	real*8 DPR(L_LEVELS), U(L_LEVELS)
78	real*8 LCOEF(4), LKCOEF(L_LEVELS,4)
79
80	real*8,intent(out) :: taugsurf(L_NSPECTV,L_NGAUSS-1)
81	real*8 DCONT,DAERO
82	real*8 DRAYAER
83	double precision wn_cont, p_cont, p_air, T_cont, dtemp, dtempc
84	double precision p_cross
85
86	! variable species mixing ratio variables
87	real*8,intent(in) :: QVAR(L_LEVELS)
88	real*8,intent(in) :: MUVAR(L_LEVELS)
89	real*8 :: WRATIO(L_LEVELS)
90	real*8 KCOEF(4)
91	integer NVAR(L_LEVELS)
92
93	! temporary variables to reduce memory access time to gasv
94	real*8 tmpk(2,2)
95	real*8 tmpkvar(2,2,2)
96
97	! temporary variables for multiple aerosol calculation
98	real*8 atemp(L_NLAYRAD,L_NSPECTV)
99	real*8 btemp(L_NLAYRAD,L_NSPECTV)
100	real*8 ctemp(L_NLAYRAD,L_NSPECTV)
101
102	! variables for k in units m^-1
103	real*8 dz(L_LEVELS)
104
105	! Variables for aerosol absorption
106	real*8 Fabs_aer(NAERKIND)
107	real*8 wbarv_prime
108
109	integer igas, jgas
110
111	integer interm
112
113	logical :: firstcall=.true.
114	!$OMP THREADPRIVATE(firstcall)
115
116	if (firstcall) then
117	! allocate local arrays of size "naerkind" (which are also
118	! "saved" so that this is done only once in for all even if
119	! we don't need to store the value from a time step to the next)
120	allocate(TAUAEROLK(L_LEVELS,L_NSPECTV,NAERKIND))
121	allocate(TAEROS(L_LEVELS,L_NSPECTV,NAERKIND))
122	firstcall=.false.
123	endif ! of if (firstcall)
124
125	!! AS: to save time in computing continuum (see bilinearbig)
126	IF (.not.ALLOCATED(indv)) THEN
127	ALLOCATE(indv(L_NSPECTV,ngasmx,ngasmx))
128	indv = -9999 ! this initial value means "to be calculated"
129	ENDIF
130
131	!=======================================================================
132	! Determine the total gas opacity throughout the column, for each
133	! spectral interval, NW, and each Gauss point, NG.
134	! Calculate the continuum opacities, i.e., those that do not depend on
135	! NG, the Gauss index.
136
137	dtauv(:,:,:) = 0.0
138	tauv(:,:,:) = 0.0
139	taucumv(:,:,:) = 0.0
140
141	taugsurf(:,:) = 0.0
142	dpr(:) = 0.0 ! pressure difference between levels
143	lkcoef(:,:) = 0.0
144	DTAUKV(:,:,:) = 0.0
145	dtauv_aer(:,:,:) = 0.0
146	wbarv_aer(:,:,:) = 1.0
147
148	if(callmufi) then
149	Fabs_aer(1) = Fabs_aers_VI
150	Fabs_aer(2) = Fabs_aerf_VI
151	else
152	Fabs_aer(:) = 1.0
153	endif
154
155	do K=2,L_LEVELS
156	DPR(k) = PLEV(K)-PLEV(K-1)
157
158	! if we have continuum opacities, we need dz
159	if(kastprof)then
160	dz(k) = dpr(k)(1000.0d08.3145d0/muvar(k))TMID(K)/(gPMID(K))
161	U(k) = CmkDPR(k)mugaz/muvar(k)
162	else
163	dz(k) = dpr(k)RTMID(K)/(glat_igPMID(K))mugaz/muvar(k)
164	U(k) = CmkDPR(k)mugaz/muvar(k) ! only Cmk line in optci.F
165	!JL13 the mugaz/muvar factor takes into account water meanmolecular weight if water is present
166	endif
167
168	call tpindex(PMID(K),TMID(K),QVAR(K),pfgasref,tgasref,WREFVAR, &
169	LCOEF,MT(K),MP(K),NVAR(K),WRATIO(K))
170
171	do LK=1,4
172	LKCOEF(K,LK) = LCOEF(LK)
173	end do
174	end do ! levels
175
176	! Spectral dependance of aerosol absorption
177	!JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR
178	! but visible does not handle very well diffusion in first layer.
179	! The tauaero and tauray are thus set to 0 (a small value for rayleigh because the code crashes otherwise)
180	! in the 4 first semilayers in optcv, but not optci.
181	! This solves random variations of the sw heating at the model top.
182	do iaer=1,naerkind
183	do NW=1,L_NSPECTV
184	TAEROS(1:4,NW,IAER)=0.d0
185	do K=5,L_LEVELS
186	TAEROS(K,NW,IAER) = TAUAERO(K,IAER) * QXVAER(K,NW,IAER)
187	! Aerosol absorption correction --> impact on opacity.
188	if (callmufi .and. (TAEROS(K,NW,IAER).gt.0.d0)) then
189	TAEROS(K,NW,IAER) = TAEROS(K,NW,IAER) * &
190	((QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER)) + Fabs_aer(IAER)*(1.-(QSVAER(K,NW,IAER)/QXVAER(K,NW,IAER))))
191	endif
192	end do ! L_LEVELS
193	end do ! L_NSPECTV
194	end do ! naerkind
195
196	! Rayleigh scattering
197	do NW=1,L_NSPECTV
198	TRAY(1:4,NW) = 1d-30
199	do K=5,L_LEVELS
200	TRAY(K,NW) = TAURAY(NW) * DPR(K)
201	end do ! levels
202	end do
203
204	! we ignore K=1...
205	do K=2,L_LEVELS
206
207	do NW=1,L_NSPECTV
208
209	DRAYAER = TRAY(K,NW)
210	! DRAYAER is Tau RAYleigh scattering, plus AERosol opacity
211	do iaer=1,naerkind
212	DRAYAER = DRAYAER + TAEROS(K,NW,IAER)
213	end do
214
215	DCONT = 0.0 ! continuum absorption
216
217	if(continuum.and.(.not.graybody).and.callgasvis)then
218	! include continua if necessary
219	wn_cont = dble(wnov(nw))
220	T_cont = dble(TMID(k))
221	do igas=1,ngasmx
222
223	if(gfrac(igas).eq.-1)then ! variable
224	p_cont = dble(PMID(k)scalepQVAR(k)) ! qvar = mol/mol
225	else
226	p_cont = dble(PMID(k)scalepgfrac(igas)*(1.-QVAR(k)))
227	endif
228
229	dtemp=0.0
230	if(igas.eq.igas_N2)then
231
232	interm = indv(nw,igas,igas)
233	! call interpolateN2N2(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
234	indv(nw,igas,igas) = interm
235	! only goes to 500 cm^-1, so unless we're around a cold brown dwarf, this is irrelevant in the visible
236
237	! elseif(igas.eq.igas_H2)then !AF24: removed
238
239	elseif(igas.eq.igas_CH4)then
240
241	! first do self-induced absorption
242	interm = indv(nw,igas,igas)
243	call interpolateCH4CH4(wn_cont,T_cont,p_cont,dtemp,.false.,interm)
244	indv(nw,igas,igas) = interm
245
246	! then cross-interactions with other gases !AF24: removed
247
248	! elseif(igas.eq.igas_H2O.and.T_cont.gt.100.0)then !AF24: removed
249
250	endif
251	DCONT = DCONT + dtemp
252
253	enddo
254
255	DCONT = DCONT*dz(k)
256
257	endif
258
259	do ng=1,L_NGAUSS-1
260
261	! Now compute TAUGAS
262
263	! Interpolate between water mixing ratios
264	! WRATIO = 0.0 if the requested water amount is equal to, or outside the
265	! the water data range
266
267	if(L_REFVAR.eq.1)then ! added by RW for special no variable case
268
269	! JVO 2017 : added tmpk because the repeated calls to gasi/v increased dramatically
270	! the execution time of optci/v -> ~ factor 2 on the whole radiative
271	! transfer on the tested simulations !
272
273	IF (corrk_recombin) THEN ! Added by JVO
274	tmpk = GASV_RECOMB(MT(K):MT(K)+1,MP(K):MP(K)+1,1,NW,NG) ! contains the mix of recombined species
275	ELSE
276	tmpk = GASV(MT(K):MT(K)+1,MP(K):MP(K)+1,1,NW,NG)
277	ENDIF
278
279	KCOEF(1) = tmpk(1,1) ! KCOEF(1) = GASV(MT(K),MP(K),1,NW,NG)
280	KCOEF(2) = tmpk(1,2) ! KCOEF(2) = GASV(MT(K),MP(K)+1,1,NW,NG)
281	KCOEF(3) = tmpk(2,2) ! KCOEF(3) = GASV(MT(K)+1,MP(K)+1,1,NW,NG)
282	KCOEF(4) = tmpk(2,1) ! KCOEF(4) = GASV(MT(K)+1,MP(K),1,NW,NG)
283
284	else
285
286	IF (corrk_recombin) THEN
287	tmpkvar = GASV_RECOMB(MT(K):MT(K)+1,MP(K):MP(K)+1,NVAR(K):NVAR(K)+1,NW,NG)
288	ELSE
289	tmpkvar = GASV(MT(K):MT(K)+1,MP(K):MP(K)+1,NVAR(K):NVAR(K)+1,NW,NG)
290	ENDIF
291
292	KCOEF(1) = tmpkvar(1,1,1) + WRATIO(K) * &
293	( tmpkvar(1,1,2)-tmpkvar(1,1,1) )
294
295	KCOEF(2) = tmpkvar(1,2,1) + WRATIO(K) * &
296	( tmpkvar(1,2,2)-tmpkvar(1,2,1) )
297
298	KCOEF(3) = tmpkvar(2,2,1) + WRATIO(K) * &
299	( tmpkvar(2,2,2)-tmpkvar(2,2,1) )
300
301	KCOEF(4) = tmpkvar(2,1,1) + WRATIO(K) * &
302	( tmpkvar(2,1,2)-tmpkvar(2,1,1) )
303
304
305	endif
306
307	! Interpolate the gaseous k-coefficients to the requested T,P values
308
309	ANS = LKCOEF(K,1)KCOEF(1) + LKCOEF(K,2)KCOEF(2) + &
310	LKCOEF(K,3)KCOEF(3) + LKCOEF(K,4)KCOEF(4)
311
312	TAUGAS = U(k)*ANS
313
314	TAUGSURF(NW,NG) = TAUGSURF(NW,NG) + TAUGAS + DCONT
315	DTAUKV(K,nw,ng) = TAUGAS &
316	+ DRAYAER & ! DRAYAER includes all scattering contributions
317	+ DCONT ! For parameterized continuum aborption
318
319	end do
320
321	! Now fill in the "clear" part of the spectrum (NG = L_NGAUSS),
322	! which holds continuum opacity only
323
324	NG = L_NGAUSS
325	DTAUKV(K,nw,ng) = DRAYAER + DCONT ! Scattering + parameterized continuum absorption
326
327	end do
328	end do
329
330
331	!=======================================================================
332	! Now the full treatment for the layers, where besides the opacity
333	! we need to calculate the scattering albedo and asymmetry factors
334
335	!JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR
336	! but not in the visible
337	! The tauaero is thus set to 0 in the 4 first semilayers in optcv, but not optci.
338	! This solves random variations of the sw heating at the model top.
339	do iaer=1,naerkind
340	DO NW=1,L_NSPECTV
341	TAUAEROLK(1:4,NW,IAER)=0.d0
342	DO K=5,L_LEVELS
343	TAUAEROLK(K,NW,IAER) = TAUAERO(K,IAER) * QSVAER(K,NW,IAER) ! effect of scattering albedo
344	ENDDO
345	ENDDO
346	end do
347
348	DO NW=1,L_NSPECTV
349	DO L=1,L_NLAYRAD-1
350	K = 2*L+1
351	atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind)) + &
352	SUM(GVAER(K+1,NW,1:naerkind) * TAUAEROLK(K+1,NW,1:naerkind))
353	! Aerosol absorption correction --> impact on single scattering albedo.
354	if (callmufi) then
355	! Spherical aerosols
356	if ((TAEROS(K,NW,1).gt.0.d0) .and. TAEROS(K+1,NW,1).gt.0.d0) then
357	btemp(L,NW) = TAUAEROLK(K,NW,1) / &
358	(QSVAER(K,NW,1)/QXVAER(K,NW,1) + &
359	Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1))) + &
360	TAUAEROLK(K+1,NW,1) / &
361	(QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1) + &
362	Fabs_aer(1)*(1.-QSVAER(K+1,NW,1)/QXVAER(K+1,NW,1)))
363	else
364	btemp(L,NW) = TAUAEROLK(K,NW,1) + TAUAEROLK(K+1,NW,1)
365	endif
366	! Fractal aerosols
367	if ((TAEROS(K,NW,2).gt.0.d0) .and. TAEROS(K+1,NW,2).gt.0.d0) then
368	btemp(L,NW) = btemp(L,NW) + &
369	(TAUAEROLK(K,NW,2) / &
370	(QSVAER(K,NW,2)/QXVAER(K,NW,2) + &
371	Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2)))) + &
372	(TAUAEROLK(K+1,NW,2) / &
373	(QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2) + &
374	Fabs_aer(2)*(1.-QSVAER(K+1,NW,2)/QXVAER(K+1,NW,2))))
375	else
376	btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2) + TAUAEROLK(K+1,NW,2)
377	endif
378	else
379	btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind)) + SUM(TAUAEROLK(K+1,NW,1:naerkind))
380	endif ! callmufi
381	ctemp(L,NW) = btemp(L,NW) + 0.9999*(TRAY(K,NW) + TRAY(K+1,NW)) ! JVO 2017 : does this 0.999 is really meaningful ?
382
383	btemp(L,NW) = btemp(L,NW) + TRAY(K,NW) + TRAY(K+1,NW)
384	COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
385	END DO ! L vertical loop
386
387	! Last level
388	!-----------
389	L = L_NLAYRAD
390	K = 2*L+1
391	atemp(L,NW) = SUM(GVAER(K,NW,1:naerkind) * TAUAEROLK(K,NW,1:naerkind))
392	! Aerosol absorption correction --> impact on single scattering albedo.
393	if (callmufi) then
394	! Spherical aerosols
395	if (TAEROS(K,NW,1).gt.0.d0) then
396	btemp(L,NW) = TAUAEROLK(K,NW,1) / &
397	(QSVAER(K,NW,1)/QXVAER(K,NW,1) + &
398	Fabs_aer(1)*(1.-QSVAER(K,NW,1)/QXVAER(K,NW,1)))
399	else
400	btemp(L,NW) = TAUAEROLK(K,NW,1)
401	endif
402	! Fractal aerosols
403	if (TAEROS(K,NW,2).gt.0.d0) then
404	btemp(L,NW) = btemp(L,NW) + &
405	(TAUAEROLK(K,NW,2) / &
406	(QSVAER(K,NW,2)/QXVAER(K,NW,2) + &
407	Fabs_aer(2)*(1.-QSVAER(K,NW,2)/QXVAER(K,NW,2))))
408	else
409	btemp(L,NW) = btemp(L,NW) + TAUAEROLK(K,NW,2)
410	endif
411	else
412	btemp(L,NW) = SUM(TAUAEROLK(K,NW,1:naerkind))
413	endif ! callmufi
414	ctemp(L,NW) = btemp(L,NW) + 0.9999*TRAY(K,NW) ! JVO 2017 : does this 0.999 is really meaningful ?
415
416	btemp(L,NW) = btemp(L,NW) + TRAY(K,NW)
417	COSBV(L,NW,1:L_NGAUSS) = atemp(L,NW)/btemp(L,NW)
418	END DO ! NW spectral loop
419
420	DO NG=1,L_NGAUSS
421	DO NW=1,L_NSPECTV
422	DO L=1,L_NLAYRAD-1
423
424	K = 2*L+1
425	DTAUV(L,nw,ng) = DTAUKV(K,NW,NG) + DTAUKV(K+1,NW,NG)
426	WBARV(L,nw,ng) = ctemp(L,NW) / DTAUV(L,nw,ng)
427
428	END DO ! L vertical loop
429
430	! Last level
431
432	L = L_NLAYRAD
433	K = 2*L+1
434	DTAUV(L,nw,ng) = DTAUKV(K,NW,NG)
435
436	WBARV(L,NW,NG) = ctemp(L,NW) / DTAUV(L,NW,NG)
437
438	END DO ! NW spectral loop
439	END DO ! NG Gauss loop
440
441	! Aerosols extinction optical depths
442	DO iaer = 1, naerkind
443	DO nw = 1, L_NSPECTV
444	DO L = 1, L_NLAYRAD-1
445	K = 2*L+1
446	DTAUV_AER(L,nw,iaer) = TAEROS(K,nw,iaer) + TAEROS(K+1,nw,iaer)
447
448	IF (QXVAER(K,nw,iaer) > 0.0D0) THEN
449	wbarv_prime = (QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer)) / &
450	(QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer) + Fabs_aer(iaer)*(1.-QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer)))
451	ELSE
452	wbarv_prime = 1.0
453	ENDIF
454	WBARV_AER(L,nw,iaer) = wbarv_prime * TAEROS(K,nw,iaer)
455	IF (QXVAER(K+1,nw,iaer) > 0.0D0) THEN
456	wbarv_prime = (QSVAER(K+1,nw,iaer)/QXVAER(K+1,nw,iaer)) / &
457	(QSVAER(K+1,nw,iaer)/QXVAER(K+1,nw,iaer) + Fabs_aer(iaer)*(1.-QSVAER(K+1,nw,iaer)/QXVAER(K+1,nw,iaer)))
458	ELSE
459	wbarv_prime = 1.0
460	ENDIF
461	WBARV_AER(L,nw,iaer) = WBARV_AER(L,nw,iaer) + (wbarv_prime * TAEROS(K+1,nw,iaer))
462	IF (DTAUV_AER(L,nw,iaer) > 0.0D0) THEN
463	WBARV_AER(L,nw,iaer) = WBARV_AER(L,nw,iaer) / DTAUV_AER(L,nw,iaer)
464	ELSE
465	WBARV_AER(L,nw,iaer) = 1.0
466	ENDIF
467	END DO ! L vertical loop
468
469	! Last level
470	!-----------
471	L = L_NLAYRAD
472	K = 2*L+1
473	DTAUV_AER(L,nw,iaer) = TAEROS(K,nw,iaer)
474	IF (QXVAER(K,nw,iaer) > 0.0D0) THEN
475	WBARV_AER(L,nw,iaer) = (QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer)) / &
476	(QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer) + Fabs_aer(iaer)*(1.-QSVAER(K,nw,iaer)/QXVAER(K,nw,iaer)))
477	ELSE
478	WBARV_AER(L,nw,iaer) = 1.0
479	ENDIF
480	END DO ! nw spectral loop
481	END DO ! iaer Gauss loop
482
483	! Total extinction optical depths
484	DO NG=1,L_NGAUSS ! full gauss loop
485	DO NW=1,L_NSPECTV
486	TAUV(1,NW,NG)=0.0D0
487	TAUCUMV(1,NW,NG)=0.0D0
488
489	DO K=2,L_LEVELS
490	TAUCUMV(K,NW,NG)=TAUCUMV(K-1,NW,NG)+DTAUKV(K,NW,NG)
491	END DO
492
493	DO L=1,L_NLAYRAD
494	TAUV(L,NW,NG)=TAUCUMV(2*L,NW,NG)
495	END DO
496	TAUV(L,NW,NG)=TAUCUMV(2*L_NLAYRAD+1,NW,NG)
497	END DO
498	END DO ! end full gauss loop
499
500	end subroutine optcv
501
502	END MODULE optcv_mod

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

Download in other formats:

Original Format