Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_ra_sw.F @ 3094

Last change on this file since 3094 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 21.1 KB

Line
1	!WRF:MODEL_LAYER:PHYSICS
2	!
3	MODULE module_ra_sw
4
5	REAL,PRIVATE,SAVE :: CSSCA
6
7	CONTAINS
8
9	!------------------------------------------------------------------
10	SUBROUTINE SWRAD(dt,RTHRATEN,GSW,XLAT,XLONG,ALBEDO, &
11	rho_phy,T3D,QV3D,QC3D,QR3D, &
12	QI3D,QS3D,QG3D,P3D,pi3D,dz8w,GMT, &
13	R,CP,G,JULDAY, &
14	XTIME,DECLIN,SOLCON, &
15	F_QV,F_QC,F_QR,F_QI,F_QS,F_QG, &
16	pm2_5_dry,pm2_5_water,pm2_5_dry_ec, &
17	RADFRQ,ICLOUD,DEGRAD,warm_rain, &
18	ids,ide, jds,jde, kds,kde, &
19	ims,ime, jms,jme, kms,kme, &
20	its,ite, jts,jte, kts,kte, &
21	slope_rad,topo_shading,ht, & ! Optional
22	dx,dy,sina,cosa,shadowmask, & ! Optional
23	cosz_urb2d,omg_urb2d & !Optional urban
24	)
25	!------------------------------------------------------------------
26	IMPLICIT NONE
27	!------------------------------------------------------------------
28	INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
29	ims,ime, jms,jme, kms,kme, &
30	its,ite, jts,jte, kts,kte
31
32	LOGICAL, INTENT(IN ) :: warm_rain
33	INTEGER, INTENT(IN ) :: icloud
34
35	REAL, INTENT(IN ) :: RADFRQ,DEGRAD, &
36	XTIME,DECLIN,SOLCON
37	!
38	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
39	INTENT(IN ) :: P3D, &
40	pi3D, &
41	rho_phy, &
42	dz8w, &
43	T3D
44	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL , &
45	INTENT(IN ) :: pm2_5_dry, &
46	pm2_5_water, &
47	pm2_5_dry_ec
48
49
50	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
51	INTENT(INOUT) :: RTHRATEN
52	!
53	REAL, DIMENSION( ims:ime, jms:jme ), &
54	INTENT(IN ) :: XLAT, &
55	XLONG, &
56	ALBEDO
57	!
58	REAL, DIMENSION( ims:ime, jms:jme ), &
59	INTENT(INOUT) :: GSW
60	!
61	REAL, INTENT(IN ) :: GMT,R,CP,G,dt
62	!
63	INTEGER, INTENT(IN ) :: JULDAY
64
65
66
67	!
68	! Optional
69	!
70	REAL, OPTIONAL, INTENT(IN) :: dx,dy
71
72	REAL, DIMENSION( ims:ime, jms:jme ), &
73	OPTIONAL, INTENT(IN) :: sina,cosa,ht
74	REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
75	OPTIONAL, &
76	INTENT(IN ) :: &
77	QV3D, &
78	QC3D, &
79	QR3D, &
80	QI3D, &
81	QS3D, &
82	QG3D
83
84	INTEGER, OPTIONAL, INTENT(IN) :: slope_rad,topo_shading
85
86	INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: shadowmask
87
88	LOGICAL, OPTIONAL, INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
89
90	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme), INTENT(OUT) :: COSZ_URB2D, OMG_URB2D !Optional urban
91	! LOCAL VARS
92
93	REAL, DIMENSION( kts:kte ) :: &
94	TTEN1D, &
95	RHO01D, &
96	P1D, &
97	DZ, &
98	T1D, &
99	QV1D, &
100	QC1D, &
101	QR1D, &
102	QI1D, &
103	QS1D, &
104	QG1D
105	!
106	REAL:: XLAT0,XLONG0,ALB0,GSW0
107
108	REAL :: COSZ, OMG !urban
109	!
110	INTEGER :: i,j,K,NK
111	LOGICAL :: predicate , do_topo_shading
112	real :: aer_dry1(kts:kte),aer_water1(kts:kte)
113
114	real :: sinalpha,cosalpha,hx,hy,slope,slp_azi,pi
115	integer :: shadow
116
117	!------------------------------------------------------------------
118
119	pi = 4.*atan(1.)
120
121	j_loop: DO J=jts,jte
122	i_loop: DO I=its,ite
123
124	! reverse vars
125	DO K=kts,kte
126	QV1D(K)=0.
127	QC1D(K)=0.
128	QR1D(K)=0.
129	QI1D(K)=0.
130	QS1D(K)=0.
131	QG1D(K)=0.
132	ENDDO
133
134	DO K=kts,kte
135	NK=kme-1-K+kms
136	TTEN1D(K)=0.
137
138	T1D(K)=T3D(I,NK,J)
139	P1D(K)=P3D(I,NK,J)
140	RHO01D(K)=rho_phy(I,NK,J)
141	DZ(K)=dz8w(I,NK,J)
142	ENDDO
143
144	IF( PRESENT(pm2_5_dry) .AND. PRESENT(pm2_5_water) )THEN
145	DO K=kts,kte
146	NK=kme-1-K+kms
147	aer_dry1(k) = pm2_5_dry(i,nk,j)
148	aer_water1(k) = pm2_5_water(i,nk,j)
149	ENDDO
150	ELSE
151	DO K=kts,kte
152	aer_dry1(k) = 0.
153	aer_water1(k) = 0.
154	ENDDO
155	ENDIF
156
157	IF (PRESENT(F_QV) .AND. PRESENT(QV3D)) THEN
158	IF (F_QV) THEN
159	DO K=kts,kte
160	NK=kme-1-K+kms
161	QV1D(K)=QV3D(I,NK,J)
162	QV1D(K)=max(0.,QV1D(K))
163	ENDDO
164	ENDIF
165	ENDIF
166
167	IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
168	IF (F_QC) THEN
169	DO K=kts,kte
170	NK=kme-1-K+kms
171	QC1D(K)=QC3D(I,NK,J)
172	QC1D(K)=max(0.,QC1D(K))
173	ENDDO
174	ENDIF
175	ENDIF
176
177	IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
178	IF (F_QR) THEN
179	DO K=kts,kte
180	NK=kme-1-K+kms
181	QR1D(K)=QR3D(I,NK,J)
182	QR1D(K)=max(0.,QR1D(K))
183	ENDDO
184	ENDIF
185	ENDIF
186
187	!
188	IF ( PRESENT( F_QI ) ) THEN
189	predicate = F_QI
190	ELSE
191	predicate = .FALSE.
192	ENDIF
193
194	IF ( predicate .AND. PRESENT( QI3D ) ) THEN
195	DO K=kts,kte
196	NK=kme-1-K+kms
197	QI1D(K)=QI3D(I,NK,J)
198	QI1D(K)=max(0.,QI1D(K))
199	ENDDO
200	ELSE
201	IF (.not. warm_rain) THEN
202	DO K=kts,kte
203	IF(T1D(K) .lt. 273.15) THEN
204	QI1D(K)=QC1D(K)
205	QC1D(K)=0.
206	QS1D(K)=QR1D(K)
207	QR1D(K)=0.
208	ENDIF
209	ENDDO
210	ENDIF
211	ENDIF
212
213	IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
214	IF (F_QS) THEN
215	DO K=kts,kte
216	NK=kme-1-K+kms
217	QS1D(K)=QS3D(I,NK,J)
218	QS1D(K)=max(0.,QS1D(K))
219	ENDDO
220	ENDIF
221	ENDIF
222
223	IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
224	IF (F_QG) THEN
225	DO K=kts,kte
226	NK=kme-1-K+kms
227	QG1D(K)=QG3D(I,NK,J)
228	QG1D(K)=max(0.,QG1D(K))
229	ENDDO
230	ENDIF
231	ENDIF
232
233	XLAT0=XLAT(I,J)
234	XLONG0=XLONG(I,J)
235	ALB0=ALBEDO(I,J)
236
237	IF (PRESENT(topo_shading)) THEN
238	IF (topo_shading.eq.1) THEN
239	do_topo_shading = .TRUE.
240	ELSE
241	do_topo_shading = .FALSE.
242	END IF
243	ELSE
244	do_topo_shading = .FALSE.
245	END IF
246
247	shadow = 0
248	IF (do_topo_shading) THEN
249	IF(PRESENT(slope_rad) .AND. PRESENT(shadowmask))THEN
250	! Computations for slope-dependent radiation
251
252	sinalpha = sina(i,j)
253	cosalpha = cosa(i,j)
254
255	! Compute slope and slope azimuth of local grid point
256
257	if ((i.ge.ids+1).and.(i.le.ide-2)) then
258	hx = (ht(i+1,j)-ht(i-1,j))/(2.*dx)
259	else if (i.eq.ids) then
260	hx = (ht(i+1,j)-ht(i,j))/dx
261	else if (i.eq.ide-1) then
262	hx = (ht(i,j)-ht(i-1,j))/dx
263	endif
264	if ((j.ge.jds+1).and.(j.le.jde-2)) then
265	hy = (ht(i,j+1)-ht(i,j-1))/(2.*dy)
266	else if (j.eq.jds) then
267	hy = (ht(i,j+1)-ht(i,j))/dy
268	else if (j.eq.jde-1) then
269	hy = (ht(i,j)-ht(i,j-1))/dy
270	endif
271
272	slope = atan((hx2+hy2)**.5)
273	if (slope.lt.1.e-4) then
274	slope = 0.
275	slp_azi = 0.
276	else
277	slp_azi = atan2(hx,hy)+pi
278	! Rotate slope azimuth to lat-lon grid
279	if (cosalpha.ge.0) then
280	slp_azi = slp_azi - asin(sinalpha)
281	else
282	slp_azi = slp_azi - (pi - asin(sinalpha))
283	endif
284	endif
285
286	shadow = shadowmask(i,j)
287	ENDIF
288
289	CALL SWPARA(TTEN1D,GSW0,XLAT0,XLONG0,ALB0, &
290	T1D,QV1D,QC1D,QR1D,QI1D,QS1D,QG1D,P1D, &
291	XTIME,GMT,RHO01D,DZ, &
292	R,CP,G,DECLIN,SOLCON, &
293	COSZ, OMG, & !urban
294	RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1, &
295	kts,kte,slope_rad,shadow,slp_azi,slope )
296	ELSE
297	CALL SWPARA(TTEN1D,GSW0,XLAT0,XLONG0,ALB0, &
298	T1D,QV1D,QC1D,QR1D,QI1D,QS1D,QG1D,P1D, &
299	XTIME,GMT,RHO01D,DZ, &
300	R,CP,G,DECLIN,SOLCON, &
301	COSZ, OMG, & !urban
302	RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1, &
303	kts,kte )
304	ENDIF
305
306	IF (PRESENT(COSZ_URB2D) .AND. PRESENT(OMG_URB2D)) THEN
307	COSZ_URB2D(I,J)=COSZ !urban
308	OMG_URB2D(I,J)=OMG !urban
309	ENDIF
310
311	GSW(I,J)=GSW0
312	DO K=kts,kte
313	NK=kme-1-K+kms
314	RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+TTEN1D(NK)/pi3D(I,K,J)
315	ENDDO
316	!
317	ENDDO i_loop
318	ENDDO j_loop
319
320	END SUBROUTINE SWRAD
321
322	!------------------------------------------------------------------
323	SUBROUTINE SWPARA(TTEN,GSW,XLAT,XLONG,ALBEDO, &
324	T,QV,QC,QR,QI,QS,QG,P, &
325	XTIME, GMT, RHO0, DZ, &
326	R,CP,G,DECLIN,SOLCON, &
327	COSZ, OMG, & !urban
328	RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1, &
329	kts,kte,slope_rad,shadow,slp_azi,slope )
330	!------------------------------------------------------------------
331	! TO CALCULATE SHORT-WAVE ABSORPTION AND SCATTERING IN CLEAR
332	! AIR AND REFLECTION AND ABSORPTION IN CLOUD LAYERS (STEPHENS,
333	! 1984)
334	! CHANGES:
335	! REDUCE EFFECTS OF ICE CLOUDS AND PRECIP ON LIQUID WATER PATH
336	! ADD EFFECT OF GRAUPEL
337	!------------------------------------------------------------------
338
339	IMPLICIT NONE
340
341	INTEGER, INTENT(IN ) :: kts,kte
342	!
343	REAL, DIMENSION( kts:kte ), INTENT(IN ) :: &
344	RHO0, &
345	T, &
346	P, &
347	DZ, &
348	QV, &
349	QC, &
350	QR, &
351	QI, &
352	QS, &
353	QG
354
355	REAL, DIMENSION( kts:kte ), INTENT(INOUT):: TTEN
356	!
357	REAL, INTENT(IN ) :: XTIME,GMT,R,CP,G,DECLIN, &
358	SOLCON,XLAT,XLONG,ALBEDO, &
359	RADFRQ, DEGRAD
360	!
361	INTEGER, INTENT(IN) :: icloud
362	REAL, INTENT(INOUT) :: GSW
363	! For slope-dependent radiation
364
365	INTEGER, OPTIONAL, INTENT(IN) :: slope_rad,shadow
366	REAL, OPTIONAL, INTENT(IN) :: slp_azi,slope
367
368	! LOCAL VARS
369	!
370	REAL, DIMENSION( kts:kte+1 ) :: SDOWN
371
372	REAL, DIMENSION( kts:kte ) :: XLWP, &
373	XATP, &
374	XWVP, &
375	aer_dry1,aer_water1, &
376	RO
377	!
378	REAL, DIMENSION( 4, 5 ) :: ALBTAB, &
379	ABSTAB
380
381	REAL, DIMENSION( 4 ) :: XMUVAL
382
383	REAL, INTENT(OUT) :: COSZ !urban
384	REAL, INTENT(OUT) :: OMG !urban
385
386	REAL :: beta
387
388	!------------------------------------------------------------------
389
390	DATA ALBTAB/0.,0.,0.,0., &
391	69.,58.,40.,15., &
392	90.,80.,70.,60., &
393	94.,90.,82.,78., &
394	96.,92.,85.,80./
395
396	DATA ABSTAB/0.,0.,0.,0., &
397	0.,2.5,4.,5., &
398	0.,2.6,7.,10., &
399	0.,3.3,10.,14., &
400	0.,3.7,10.,15./
401
402	DATA XMUVAL/0.,0.2,0.5,1.0/
403
404	REAL :: bext340, absc, alba, alw, csza,dabsa,dsca,dabs
405	REAL :: bexth2o, dscld, hrang,ff,oldalb,oldabs,oldabc
406	REAL :: soltop, totabs, tloctm, ugcm, uv,xabs,xabsa,wv
407	REAL :: wgm, xalb, xi, xsca, xt24,xmu,xabsc,trans0,yj
408	REAL :: xxlat,ww
409	INTEGER :: iil,ii,jjl,ju,k,iu
410
411	! For slope-dependent radiation
412
413	REAL :: diffuse_frac, corr_fac, csza_slp
414
415
416	GSW=0.0
417	bext340=5.E-6
418	bexth2o=5.E-6
419	SOLTOP=SOLCON
420	XT24=MOD(XTIME+RADFRQ*0.5,1440.)
421	TLOCTM=GMT+XT24/60.+XLONG/15.
422	HRANG=15.(TLOCTM-12.)DEGRAD
423	XXLAT=XLAT*DEGRAD
424	CSZA=SIN(XXLAT)SIN(DECLIN)+COS(XXLAT)COS(DECLIN)*COS(HRANG)
425
426	COSZ = CSZA !urban
427	OMG = HRANG !urban
428
429	! RETURN IF NIGHT
430	IF(CSZA.LE.1.E-9)GOTO 7
431	!
432	DO K=kts, kte
433
434	! P in the unit of 10mb
435	RO(K)=P(K)/(R*T(K))
436	XWVP(K)=RO(K)QV(K)DZ(K)*1000.
437	! KG/M**2
438	XATP(K)=RO(K)*DZ(K)
439	ENDDO
440	!
441	! G/M**2
442	! REDUCE WEIGHT OF LIQUID AND ICE IN SHORT-WAVE SCHEME
443	! ADD GRAUPEL EFFECT (ASSUMED SAME AS RAIN)
444	!
445	IF (ICLOUD.EQ.0)THEN
446	DO K=kts, kte
447	XLWP(K)=0.
448	ENDDO
449	ELSE
450	DO K=kts, kte
451	XLWP(K)=RO(K)1000.DZ(K)(QC(K)+0.1QI(K)+0.05* &
452	QR(K)+0.02QS(K)+0.05QG(K))
453	ENDDO
454	ENDIF
455	!
456	XMU=CSZA
457	SDOWN(1)=SOLTOP*XMU
458	! SET WW (G/M**2) LIQUID WATER PATH INTEGRATED DOWN
459	! SET UV (G/M**2) WATER VAPOR PATH INTEGRATED DOWN
460	WW=0.
461	UV=0.
462	OLDALB=0.
463	OLDABC=0.
464	TOTABS=0.
465	! CONTRIBUTIONS DUE TO CLEAR AIR AND CLOUD
466	DSCA=0.
467	DABS=0.
468	DSCLD=0.
469	!
470	! CONTRIBUTION DUE TO AEROSOLS (FOR CHEMISTRY)
471	DABSA=0.
472	!
473	DO 200 K=kts,kte
474	WW=WW+XLWP(K)
475	UV=UV+XWVP(K)
476	! WGM IS WW/COS(THETA) (G/M**2)
477	! UGCM IS UV/COS(THETA) (G/CM**2)
478	WGM=WW/XMU
479	UGCM=UV*0.0001/XMU
480	!
481	OLDABS=TOTABS
482	! WATER VAPOR ABSORPTION AS IN LACIS AND HANSEN (1974)
483	TOTABS=2.9UGCM/((1.+141.5UGCM)*0.635+5.925UGCM)
484	! APPROXIMATE RAYLEIGH + AEROSOL SCATTERING
485	! XSCA=1.E-5*XATP(K)/XMU
486	! XSCA=(1.E-5XATP(K)+aer_dry1(K)bext340+aer_water1(K)*bexth2o)/XMU
487	beta=0.4*(1.0-XMU)+0.1
488	! CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
489	XSCA=(csscaXATP(K)+betaaer_dry1(K)bext340DZ(K) &
490	+betaaer_water1(K)bexth2o*DZ(K))/XMU
491
492	! LAYER VAPOR ABSORPTION DONE FIRST
493	XABS=(TOTABS-OLDABS)*(SDOWN(1)-DSCLD-DSCA-DABSA)/SDOWN(K)
494	!rs AEROSOL ABSORB (would be elemental carbon). So far XABSA = 0.
495	XABSA=0.
496	IF(XABS.LT.0.)XABS=0.
497	!
498	ALW=ALOG10(WGM+1.)
499	IF(ALW.GT.3.999)ALW=3.999
500	!
501	DO II=1,3
502	IF(XMU.GT.XMUVAL(II))THEN
503	IIL=II
504	IU=II+1
505	XI=(XMU-XMUVAL(II))/(XMUVAL(II+1)-XMUVAL(II))+FLOAT(IIL)
506	ENDIF
507	ENDDO
508	!
509	JJL=IFIX(ALW)+1
510	JU=JJL+1
511	YJ=ALW+1.
512	! CLOUD ALBEDO
513	ALBA=(ALBTAB(IU,JU)(XI-IIL)(YJ-JJL) &
514	+ALBTAB(IIL,JU)(IU-XI)(YJ-JJL) &
515	+ALBTAB(IU,JJL)(XI-IIL)(JU-YJ) &
516	+ALBTAB(IIL,JJL)(IU-XI)(JU-YJ)) &
517	/((IU-IIL)*(JU-JJL))
518	! CLOUD ABSORPTION
519	ABSC=(ABSTAB(IU,JU)(XI-IIL)(YJ-JJL) &
520	+ABSTAB(IIL,JU)(IU-XI)(YJ-JJL) &
521	+ABSTAB(IU,JJL)(XI-IIL)(JU-YJ) &
522	+ABSTAB(IIL,JJL)(IU-XI)(JU-YJ)) &
523	/((IU-IIL)*(JU-JJL))
524	! LAYER ALBEDO AND ABSORPTION
525	XALB=(ALBA-OLDALB)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
526	XABSC=(ABSC-OLDABC)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
527	IF(XALB.LT.0.)XALB=0.
528	IF(XABSC.LT.0.)XABSC=0.
529	DSCLD=DSCLD+(XALB+XABSC)SDOWN(K)0.01
530	DSCA=DSCA+XSCA*SDOWN(K)
531	DABS=DABS+XABS*SDOWN(K)
532	DABSA=DABSA+XABSA*SDOWN(K)
533	OLDALB=ALBA
534	OLDABC=ABSC
535	! LAYER TRANSMISSIVITY
536	TRANS0=100.-XALB-XABSC-XABS100.-XSCA100.
537	IF(TRANS0.LT.1.)THEN
538	FF=99./(XALB+XABSC+XABS100.+XSCA100.)
539	XALB=XALB*FF
540	XABSC=XABSC*FF
541	XABS=XABS*FF
542	XSCA=XSCA*FF
543	TRANS0=1.
544	ENDIF
545	SDOWN(K+1)=AMAX1(1.E-9,SDOWN(K)TRANS00.01)
546	TTEN(K)=SDOWN(K)(XABSC+XABS100.+XABSA100.)0.01/( &
547	RO(K)CPDZ(K))
548	200 CONTINUE
549	!
550	GSW=(1.-ALBEDO)*SDOWN(kte+1)
551
552	IF (PRESENT(slope_rad)) THEN
553	! Slope-dependent solar radiation part
554
555	if (slope_rad.eq.1) then
556
557	! Parameterize diffuse fraction of global solar radiation as a function of the ratio between TOA radiation and surface global radiation
558
559	diffuse_frac = min(1.,1/(max(0.1,2.1-2.8*log(log(SDOWN(kts)/max(SDOWN(kte+1),1.e-3))))))
560	if ((slope.eq.0).or.(diffuse_frac.eq.1).or.(csza.lt.1.e-2)) then ! no topographic effects when all radiation is diffuse or the sun is too close to the horizon
561	corr_fac = 1
562	goto 140
563	endif
564
565	! cosine of zenith angle over sloping topography
566
567	csza_slp = ((SIN(XXLAT)COS(HRANG)) &
568	(-cos(slp_azi)sin(slope))-SIN(HRANG)(sin(slp_azi)*sin(slope))+ &
569	(COS(XXLAT)COS(HRANG))cos(slope))* &
570	COS(DECLIN)+(COS(XXLAT)(cos(slp_azi)sin(slope))+ &
571	SIN(XXLAT)cos(slope))SIN(DECLIN)
572	IF(csza_slp.LE.1.E-4) csza_slp = 0
573
574	! Topographic shading
575
576	if (shadow.eq.1) csza_slp = 0
577
578	! Correction factor for sloping topography; the diffuse fraction of solar radiation is assumed to be unaffected by the slope
579	corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
580
581	140 continue
582
583	GSW=(1.-ALBEDO)SDOWN(kte+1)corr_fac
584
585	endif
586	ENDIF
587
588	7 CONTINUE
589	!
590	END SUBROUTINE SWPARA
591
592	!====================================================================
593	SUBROUTINE swinit(swrad_scat, &
594	allowed_to_read , &
595	ids, ide, jds, jde, kds, kde, &
596	ims, ime, jms, jme, kms, kme, &
597	its, ite, jts, jte, kts, kte )
598	!--------------------------------------------------------------------
599	IMPLICIT NONE
600	!--------------------------------------------------------------------
601	LOGICAL , INTENT(IN) :: allowed_to_read
602	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
603	ims, ime, jms, jme, kms, kme, &
604	its, ite, jts, jte, kts, kte
605
606	REAL , INTENT(IN) :: swrad_scat
607
608	! CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
609	cssca = swrad_scat * 1.e-5
610
611	END SUBROUTINE swinit
612
613	END MODULE module_ra_sw

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

Download in other formats:

Original Format