1 !WRF:MODEL_LAYER:PHYSICS
5 REAL,PRIVATE,SAVE :: CSSCA
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,GHG_INPUT, &
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 coszen,julian, & ! jararias, 14/08/2013
22 obscur) ! amontornes-bcodina 2015/09 solar eclipses
23 !------------------------------------------------------------------
25 !------------------------------------------------------------------
26 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
27 ims,ime, jms,jme, kms,kme, &
28 its,ite, jts,jte, kts,kte
30 LOGICAL, INTENT(IN ) :: warm_rain
31 INTEGER, INTENT(IN ) :: icloud,ghg_input
33 REAL, INTENT(IN ) :: RADFRQ,DEGRAD, &
36 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
42 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), OPTIONAL , &
43 INTENT(IN ) :: pm2_5_dry, &
48 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
49 INTENT(INOUT) :: RTHRATEN
51 REAL, DIMENSION( ims:ime, jms:jme ), &
52 INTENT(IN ) :: XLAT, &
56 REAL, DIMENSION( ims:ime, jms:jme ), &
59 REAL, INTENT(IN ) :: GMT,R,CP,G,dt
61 INTEGER, INTENT(IN ) :: JULDAY
63 ! --- jararias 14/08/2013
64 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZEN
65 REAL, OPTIONAL, INTENT(IN) :: JULIAN
67 !-- amontornes-bcodina 2015/09
68 ! obscur --> degree of obscuration for solar eclipses prediction (2D)
69 real, dimension(ims:ime,jms:jme), INTENT(IN) :: obscur
74 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
84 LOGICAL, OPTIONAL, INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
88 REAL, DIMENSION( kts:kte ) :: &
101 REAL:: XLAT0,XLONG0,ALB0,GSW0
105 LOGICAL :: predicate , do_topo_shading
106 real :: aer_dry1(kts:kte),aer_water1(kts:kte)
108 ! amontornes-bcodina 2015/09 solar eclipses
109 ! obscur0 --> degree of obscuration for solar eclipses prediction at one point
112 !------------------------------------------------------------------
133 RHO01D(K)=rho_phy(I,NK,J)
137 IF( PRESENT(pm2_5_dry) .AND. PRESENT(pm2_5_water) )THEN
140 aer_dry1(k) = pm2_5_dry(i,nk,j)
141 aer_water1(k) = pm2_5_water(i,nk,j)
150 IF (PRESENT(F_QV) .AND. PRESENT(QV3D)) THEN
155 QV1D(K)=max(0.,QV1D(K))
160 IF (PRESENT(F_QC) .AND. PRESENT(QC3D)) THEN
165 QC1D(K)=max(0.,QC1D(K))
170 IF (PRESENT(F_QR) .AND. PRESENT(QR3D)) THEN
175 QR1D(K)=max(0.,QR1D(K))
181 IF ( PRESENT( F_QI ) ) THEN
187 IF ( predicate .AND. PRESENT( QI3D ) ) THEN
191 QI1D(K)=max(0.,QI1D(K))
194 IF (.not. warm_rain) THEN
196 IF(T1D(K) .lt. 273.15) THEN
206 IF (PRESENT(F_QS) .AND. PRESENT(QS3D)) THEN
211 QS1D(K)=max(0.,QS1D(K))
216 IF (PRESENT(F_QG) .AND. PRESENT(QG3D)) THEN
221 QG1D(K)=max(0.,QG1D(K))
230 ! slope code removed - factor now done in surface driver
231 CALL SWPARA(TTEN1D,GSW0,XLAT0,XLONG0,ALB0, &
232 T1D,QV1D,QC1D,QR1D,QI1D,QS1D,QG1D,P1D, &
233 XTIME,GMT,RHO01D,DZ, &
234 R,CP,G,DECLIN,SOLCON, &
235 RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1, &
237 coszen(i,j),julian,obscur0 ) ! jararias, 14/08/2013, amontornes-bcodina 2015/09 solar eclipses
241 RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+TTEN1D(NK)/pi3D(I,K,J)
249 !------------------------------------------------------------------
250 SUBROUTINE SWPARA(TTEN,GSW,XLAT,XLONG,ALBEDO, &
251 T,QV,QC,QR,QI,QS,QG,P, &
252 XTIME, GMT, RHO0, DZ, &
253 R,CP,G,DECLIN,SOLCON, &
254 RADFRQ,ICLOUD,DEGRAD,aer_dry1,aer_water1, &
255 kts,kte,coszen,julian,obscur0, & ! amontornes-bcodina 2015/09 solar eclipses
256 slope_rad,shadow,slp_azi,slope )
257 !------------------------------------------------------------------
258 ! TO CALCULATE SHORT-WAVE ABSORPTION AND SCATTERING IN CLEAR
259 ! AIR AND REFLECTION AND ABSORPTION IN CLOUD LAYERS (STEPHENS,
262 ! REDUCE EFFECTS OF ICE CLOUDS AND PRECIP ON LIQUID WATER PATH
263 ! ADD EFFECT OF GRAUPEL
264 !------------------------------------------------------------------
268 INTEGER, INTENT(IN ) :: kts,kte
270 REAL, DIMENSION( kts:kte ), INTENT(IN ) :: &
282 REAL, DIMENSION( kts:kte ), INTENT(INOUT):: TTEN
284 REAL, INTENT(IN ) :: XTIME,GMT,R,CP,G,DECLIN, &
285 SOLCON,XLAT,XLONG,ALBEDO, &
288 REAL, INTENT(IN) :: COSZEN, JULIAN
291 INTEGER, INTENT(IN) :: icloud
292 REAL, INTENT(INOUT) :: GSW
293 ! For slope-dependent radiation
295 INTEGER, OPTIONAL, INTENT(IN) :: slope_rad,shadow
296 REAL, OPTIONAL, INTENT(IN) :: slp_azi,slope
297 REAL, INTENT(IN) :: obscur0
301 REAL, DIMENSION( kts:kte+1 ) :: SDOWN
303 REAL, DIMENSION( kts:kte ) :: XLWP, &
306 aer_dry1,aer_water1, &
309 REAL, DIMENSION( 4, 5 ) :: ALBTAB, &
312 REAL, DIMENSION( 4 ) :: XMUVAL
316 !------------------------------------------------------------------
318 DATA ALBTAB/0.,0.,0.,0., &
324 DATA ABSTAB/0.,0.,0.,0., &
330 DATA XMUVAL/0.,0.2,0.5,1.0/
332 REAL :: bext340, absc, alba, alw, csza,dabsa,dsca,dabs
333 REAL :: bexth2o, dscld, hrang,ff,oldalb,oldabs,oldabc
334 REAL :: soltop, totabs, tloctm, ugcm, uv,xabs,xabsa,wv
335 REAL :: wgm, xalb, xi, xsca, xt24,xmu,xabsc,trans0,yj
337 INTEGER :: iil,ii,jjl,ju,k,iu
338 REAL :: da,eot ! jararias 14/08/2013
340 ! For slope-dependent radiation
342 REAL :: diffuse_frac, corr_fac, csza_slp
348 SOLTOP = SOLCON*(1-obscur0)
352 IF(CSZA.LE.1.E-9)GOTO 7
354 ! amontornes-bcodina 2015/09 solar eclipses eclipse
355 IF(SOLTOP.LE.1.E-9)GOTO 7
359 ! P in the unit of 10mb
361 XWVP(K)=RO(K)*QV(K)*DZ(K)*1000.
367 ! REDUCE WEIGHT OF LIQUID AND ICE IN SHORT-WAVE SCHEME
368 ! ADD GRAUPEL EFFECT (ASSUMED SAME AS RAIN)
376 XLWP(K)=RO(K)*1000.*DZ(K)*(QC(K)+0.1*QI(K)+0.05* &
377 QR(K)+0.02*QS(K)+0.05*QG(K))
383 ! SET WW (G/M**2) LIQUID WATER PATH INTEGRATED DOWN
384 ! SET UV (G/M**2) WATER VAPOR PATH INTEGRATED DOWN
390 ! CONTRIBUTIONS DUE TO CLEAR AIR AND CLOUD
395 ! CONTRIBUTION DUE TO AEROSOLS (FOR CHEMISTRY)
401 ! WGM IS WW/COS(THETA) (G/M**2)
402 ! UGCM IS UV/COS(THETA) (G/CM**2)
407 ! WATER VAPOR ABSORPTION AS IN LACIS AND HANSEN (1974)
408 TOTABS=2.9*UGCM/((1.+141.5*UGCM)**0.635+5.925*UGCM)
409 ! APPROXIMATE RAYLEIGH + AEROSOL SCATTERING
410 ! XSCA=1.E-5*XATP(K)/XMU
411 ! XSCA=(1.E-5*XATP(K)+aer_dry1(K)*bext340+aer_water1(K)*bexth2o)/XMU
412 beta=0.4*(1.0-XMU)+0.1
413 ! CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
414 XSCA=(cssca*XATP(K)+beta*aer_dry1(K)*bext340*DZ(K) &
415 +beta*aer_water1(K)*bexth2o*DZ(K))/XMU
417 ! LAYER VAPOR ABSORPTION DONE FIRST
418 XABS=(TOTABS-OLDABS)*(SDOWN(1)-DSCLD-DSCA-DABSA)/SDOWN(K)
419 !rs AEROSOL ABSORB (would be elemental carbon). So far XABSA = 0.
421 IF(XABS.LT.0.)XABS=0.
424 IF(ALW.GT.3.999)ALW=3.999
427 IF(XMU.GT.XMUVAL(II))THEN
430 XI=(XMU-XMUVAL(II))/(XMUVAL(II+1)-XMUVAL(II))+FLOAT(IIL)
438 ALBA=(ALBTAB(IU,JU)*(XI-IIL)*(YJ-JJL) &
439 +ALBTAB(IIL,JU)*(IU-XI)*(YJ-JJL) &
440 +ALBTAB(IU,JJL)*(XI-IIL)*(JU-YJ) &
441 +ALBTAB(IIL,JJL)*(IU-XI)*(JU-YJ)) &
444 ABSC=(ABSTAB(IU,JU)*(XI-IIL)*(YJ-JJL) &
445 +ABSTAB(IIL,JU)*(IU-XI)*(YJ-JJL) &
446 +ABSTAB(IU,JJL)*(XI-IIL)*(JU-YJ) &
447 +ABSTAB(IIL,JJL)*(IU-XI)*(JU-YJ)) &
449 ! LAYER ALBEDO AND ABSORPTION
450 XALB=(ALBA-OLDALB)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
451 XABSC=(ABSC-OLDABC)*(SDOWN(1)-DSCA-DABS)/SDOWN(K)
452 IF(XALB.LT.0.)XALB=0.
453 IF(XABSC.LT.0.)XABSC=0.
454 DSCLD=DSCLD+(XALB+XABSC)*SDOWN(K)*0.01
455 DSCA=DSCA+XSCA*SDOWN(K)
456 DABS=DABS+XABS*SDOWN(K)
457 DABSA=DABSA+XABSA*SDOWN(K)
460 ! LAYER TRANSMISSIVITY
461 TRANS0=100.-XALB-XABSC-XABS*100.-XSCA*100.
463 FF=99./(XALB+XABSC+XABS*100.+XSCA*100.)
470 SDOWN(K+1)=AMAX1(1.E-9,SDOWN(K)*TRANS0*0.01)
471 TTEN(K)=SDOWN(K)*(XABSC+XABS*100.+XABSA*100.)*0.01/( &
475 GSW=(1.-ALBEDO)*SDOWN(kte+1)
477 IF (PRESENT(slope_rad)) THEN
478 ! Slope-dependent solar radiation part
480 if (slope_rad.eq.1) then
482 ! Parameterize diffuse fraction of global solar radiation as a function of the ratio between TOA radiation and surface global radiation
484 diffuse_frac = min(1.,1/(max(0.1,2.1-2.8*log(log(SDOWN(kts)/max(SDOWN(kte+1),1.e-3))))))
485 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
490 ! cosine of zenith angle over sloping topography
492 csza_slp = ((SIN(XXLAT)*COS(HRANG))* &
493 (-cos(slp_azi)*sin(slope))-SIN(HRANG)*(sin(slp_azi)*sin(slope))+ &
494 (COS(XXLAT)*COS(HRANG))*cos(slope))* &
495 COS(DECLIN)+(COS(XXLAT)*(cos(slp_azi)*sin(slope))+ &
496 SIN(XXLAT)*cos(slope))*SIN(DECLIN)
497 IF(csza_slp.LE.1.E-4) csza_slp = 0
499 ! Topographic shading
501 if (shadow.eq.1) csza_slp = 0
503 ! Correction factor for sloping topography; the diffuse fraction of solar radiation is assumed to be unaffected by the slope
504 corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
508 GSW=(1.-ALBEDO)*SDOWN(kte+1)*corr_fac
515 END SUBROUTINE SWPARA
517 !====================================================================
518 SUBROUTINE swinit(swrad_scat, &
520 ids, ide, jds, jde, kds, kde, &
521 ims, ime, jms, jme, kms, kme, &
522 its, ite, jts, jte, kts, kte )
523 !--------------------------------------------------------------------
525 !--------------------------------------------------------------------
526 LOGICAL , INTENT(IN) :: allowed_to_read
527 INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
528 ims, ime, jms, jme, kms, kme, &
529 its, ite, jts, jte, kts, kte
531 REAL , INTENT(IN) :: swrad_scat
533 ! CSSCA - CLEAR-SKY SCATTERING SET FROM NAMELIST SWRAD_SCAT
534 cssca = swrad_scat * 1.e-5
536 END SUBROUTINE swinit
538 END MODULE module_ra_sw