!----------------------------------------------------------------------- ! MODULE MODULE_RADIATION ! !----------------------------------------------------------------------- ! !*** THE RADIATION DRIVERS AND PACKAGES ! !--------------------- !--- Modifications --- !--------------------- ! 2010-04-02 Vasic - Removed WFR driver !----------------------------------------------------------------------- ! USE MODULE_KINDS USE MODULE_RA_GFDL,ONLY : GFDL,CAL_MON_DAY,ZENITH USE MODULE_RA_RRTM,ONLY : RRTM USE MODULE_CONSTANTS,ONLY : CAPPA,CP,EPSQ,G,P608,PI,R_D,STBOLT ! USE module_mp_thompson, ONLY : cal_cldfra3 use module_radiation_driver_nmmb, only : radupdate_nmmb use machine, only : kind_phys ! !----------------------------------------------------------------------- ! IMPLICIT NONE ! !----------------------------------------------------------------------- ! PRIVATE ! PUBLIC :: RADIATION ! !----------------------------------------------------------------------- !----------------------------------------------------------------------- !*** THE RADIATION PACKAGE OPTIONS !----------------------------------------------------------------------- !----------------------------------------------------------------------- ! !*** Shortwave ! INTEGER,PARAMETER :: GFDLSWSCHEME=99 & !<--- (GFDL) ,SWRADSCHEME=1 & !<--- (Dudhia, WRF) ,GSFCSWSCHEME=2 & !<--- (Goddard, WRF) ,RRTMSWSCHEME=3 !<--- (RRTM) ! !*** Longwave ! INTEGER,PARAMETER :: GFDLLWSCHEME=99 & !<--- (GFDL) ,RRTMLWSCHEME=3 !<--- (RRTM) ! !----------------------------------------------------------------------- ! CONTAINS ! !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& !----------------------------------------------------------------------- SUBROUTINE RADIATION(ITIMESTEP,DT,JULDAY,JULYR,XTIME,JULIAN & & ,IHRST,NPHS,GLAT,GLON & & ,NRADS,NRADL & & ,PRSI,PRSL & & ,T,Q & & ,THS,ALBEDO & & ,QC,QR,QI,QS,QG,NI & & ,F_QC,F_QR,F_QI,F_QS,F_QG,F_NI & & ,SM,CLDFRA & & ,RLWTT,RSWTT & & ,RLWIN,RSWIN & & ,RSWINC,RLWINC,RSWOUC,RLWOUC & & ,RLWOUCtoa,RSWOUCtoa & & ,RSWOUT & & ,RLWTOA,RSWTOA & & ,CZMEAN,SIGT4 & & ,CFRACL,CFRACM,CFRACH & & ,ACFRST & & ,ACFRCV & & ,CUPPT,SNOW & & ,HTOP,HBOT & & ,SHORTWAVE,LONGWAVE & & ,CLDFRACTION & & ,DYH & & ,JDAT & & ,CW,O3 & & ,F_ICE,F_RAIN & & ,F_RIMEF & & ,SI,TSKIN & & ,Z0,SICE & & ,MXSNAL & & ,STDH,VVL & & ,ALBVB,ALBNB & ! vis+uv & near IR beam & ,ALBVD,ALBND & ! vis+uv & near IR diffuse & ,SNOWC & & ,LM,IMS,IME,MYPE) !----------------------------------------------------------------------- !*** NOTE *** ! RLWIN - downward longwave at the surface (=GLW) ! RSWIN - downward shortwave at the surface (=XXX) ! RSWINC - CLEAR-SKY downward shortwave at the surface (=SWDOWN, new for AQ) !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- !$$$ SUBPROGRAM DOCUMENTATION BLOCK ! . . . ! SUBPROGRAM: RADIATION RADIATION OUTER DRIVER ! PRGRMMR: BLACK ORG: W/NP22 DATE: 2002-06-04 ! ! ABSTRACT: ! RADIATION SERVES AS THE INTERFACE BETWEEN THE NMMB PHYSICS COMPONENT ! AND THE WRF RADIATION DRIVER. ! ! PROGRAM HISTORY LOG: ! 02-06-04 BLACK - ORIGINATOR ! 02-09-09 WOLFE - CONVERTING TO GLOBAL INDEXING ! 04-11-18 BLACK - THREADED ! 06-07-20 BLACK - INCORPORATED INTO NMMB PHYSICS COMPONENT ! 08-08 JANJIC - Synchronize WATER array and Q. ! 08-11-23 janjic - general hybrid coordinate ! ! USAGE: CALL RADIATION FROM PHY_RUN ! ! ATTRIBUTES: ! LANGUAGE: FORTRAN 90 ! MACHINE : IBM !$$$ !----------------------------------------------------------------------- ! INTEGER,PARAMETER :: JMS=1,JME=1 ! !------------------------ !*** Argument Variables !------------------------ ! INTEGER,INTENT(IN) :: LM,IMS,IME,MYPE & ,IHRST,ITIMESTEP,JULDAY,JULYR & ,NPHS,NRADL,NRADS ! INTEGER,INTENT(IN) :: JDAT(8) ! REAL,INTENT(IN) :: DT,JULIAN,XTIME ! REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CUPPT & ,ALBVB,ALBNB & ! MODIS direct beam albedos ,ALBVD,ALBND & ! MODIS diffuse albedos ,DYH & ,GLAT,GLON & ,SM & ,SNOW,SNOWC,THS,SI & ,TSKIN,Z0,SICE & ,MXSNAL,STDH ! REAL,DIMENSION(IMS:IME,JMS:JME,LM),INTENT(IN) :: Q,T,CW,O3 & ,F_ICE,F_RAIN & ,F_RIMEF ! REAL,DIMENSION(IMS:IME,LM) ,INTENT(IN) :: VVL,PRSL REAL,DIMENSION(IMS:IME,LM+1),INTENT(IN) :: PRSI ! !-- Modify ALBEDO array if MODIS albedos are used in the RRTM ! REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACFRCV,ACFRST & ,RLWIN,RLWTOA & ,RSWIN,RSWOUT & ,HBOT,HTOP & ,ALBEDO & ! allow to modify ,RSWINC,RLWINC & ,RSWOUC,RLWOUC & ,RLWOUCtoa & ,RSWOUCtoa & ,RSWTOA ! REAL,DIMENSION(IMS:IME,JMS:JME,LM),INTENT(INOUT) :: RLWTT,RSWTT,QC,QI,QS,QR,QG,NI ! REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: CFRACH,CFRACL & ,CFRACM,CZMEAN & ,SIGT4 ! REAL,DIMENSION(IMS:IME,JMS:JME,1:LM),INTENT(OUT) :: CLDFRA ! LOGICAL,INTENT(IN) :: F_QC,F_QR,F_QI,F_QS,F_QG,F_NI ! CHARACTER(99),INTENT(IN) :: LONGWAVE,SHORTWAVE,CLDFRACTION ! !--------------------- !*** Local Variables !--------------------- ! !....................................................................... INTEGER :: I,II,J,JDAY,JMONTH,K,NRAD ! INTEGER :: LW_PHYSICS=0,SW_PHYSICS=0,CLD_FRACTION ! INTEGER,DIMENSION(3) :: IDAT ! REAL :: DAYI,GMT,HOUR,PLYR,RADT,TIMES,TDUM,QIdum,QLdum ! real (kind=kind_phys) :: SLAG, SDEC, CDEC, SOLCON, DTSW, DTX ! REAL,DIMENSION(1:LM) :: QL ! REAL,DIMENSION(IMS:IME,JMS:JME) :: GSW & & ,TOT,TSFC,XLAND & & ,GLW,SWDOWN,SWDOWNC,CZEN & & ,CUPPTR,gridkm ! REAL,DIMENSION(IMS:IME,JMS:JME,1:LM+1) :: PHINT ! REAL,DIMENSION(IMS:IME,JMS:JME,1:LM) :: PI3D & ,THRATEN,THRATENLW & ,THRATENSW & ,PRL,RHO,QV & ,QCW,QCI,QSNOW,NCI & ,QTdum,FIdum,FRdum ! LOGICAL :: GFDL_LW, GFDL_SW, LSSWR ! !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- !***** !***** NOTE: THIS IS HARDWIRED FOR CALLS TO LONGWAVE AND SHORTWAVE !***** AT EQUAL INTERVALS !***** !----------------------------------------------------------------------- ! NRAD=NRADS RADT=DT*NRADS/60. ! !----------------------------------------------------------------------- !*** NOTE: THE NMMB HAS IJK STORAGE WITH LAYER 1 AT THE TOP. !*** THE WRF PHYSICS DRIVERS HAVE IKJ STORAGE WITH LAYER 1 !*** AT THE BOTTOM. !----------------------------------------------------------------------- ! !....................................................................... !$omp parallel do private (j,i,k,plyr,ql) !....................................................................... DO J=JMS,JME DO I=IMS,IME ! XLAND(I,J)=SM(I,J)+1. ! !----------------------------------------------------------------------- !*** FILL THE SINGLE-COLUMN INPUT !----------------------------------------------------------------------- ! DO K=1,LM ! PLYR=PRSL(I,K) ! QL(K)=AMAX1(Q(I,J,K),EPSQ) ! PHINT(I,J,K)=PRSI(I,K) PI3D(I,J,K)=(PLYR*1.E-5)**CAPPA ! Exner funtion ! THRATEN(I,J,K)=0. THRATENLW(I,J,K)=0. THRATENSW(I,J,K)=0. PRL(I,J,K)=PLYR ! model layer pressure RHO(I,J,K)=PLYR/(R_D*T(I,J,K)*(1.+P608*Q(I,J,K))) ! Air density (kg/m**3) ENDDO ! PHINT(I,J,LM+1)=PRSI(I,LM+1) ! !----------------------------------------------------------------------- ! TSFC(I,J)=THS(I,J)*(PHINT(I,J,LM+1)*1.E-5)**CAPPA ! ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! GMT=REAL(IHRST) ! !....................................................................... !$omp parallel do private (k,j,i) !....................................................................... DO K=1,LM DO J=JMS,JME DO I=IMS,IME CLDFRA(I,J,K)=0. ENDDO ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! !....................................................................... !$omp parallel do private (j,i) !....................................................................... DO J=JMS,JME DO I=IMS,IME CFRACH(I,J)=0. CFRACL(I,J)=0. CFRACM(I,J)=0. CZMEAN(I,J)=0. SIGT4(I,J)=0. SWDOWN(I,J)=0. ! TOTAL (clear+cloudy sky) shortwave down at the surface SWDOWNC(I,J)=0. ! CLEAR SKY shortwave down at the surface GSW(I,J)=0. ! Net (down - up) total (clear+cloudy sky) shortwave at the surface GLW(I,J)=0. ! Total longwave down at the surface CUPPTR(I,J)=CUPPT(I,J) ! Temporary array set to zero in radiation ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! !----------------------------------------------------------------------- !*** SYNCHRONIZE MIXING RATIO IN WATER ARRAY WITH SPECIFIC HUMIDITY. !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- ! !*** CALL THE INNER DRIVER. ! !----------------------------------------------------------------------- ! ! !----------------------------------------------------------------------- ! !*** A PRIMARY MODIFICATION TO THE WRF DRIVER IS THE SPECIFICATION !*** OF THE PACKAGES IN THE SELECT_CASE BLOCKS BEING CHANGED FROM !*** INTEGERS (LISTED IN THE PHYSICS SECTION OF THE WRF REGISTRY) !*** TO CHARACTERS (AS DEFINED IN THE ESMF CONFIG FILE). ! !----------------------------------------------------------------------- !*** TRANSLATE THE RADIATION OPTIONS IN THE CONFIG FILE TO THEIR !*** ANALOGS IN THE WRF REGISTRY SO THAT THE WRF RADIATION DRIVER !*** REMAINS UNTOUCHED. !----------------------------------------------------------------------- ! SELECT CASE (TRIM(SHORTWAVE)) CASE ('gfdl') SW_PHYSICS=99 CASE ('dudh') SW_PHYSICS=1 CASE ('gsfc') SW_PHYSICS=2 CASE ('rrtm') SW_PHYSICS=3 CASE DEFAULT WRITE(0,*)' User selected SHORTWAVE=',TRIM(SHORTWAVE) WRITE(0,*)' Improper selection of SW scheme in RADIATION' STOP ! or call abort END SELECT SELECT CASE (TRIM(LONGWAVE)) CASE ('gfdl') LW_PHYSICS=99 CASE ('rrtm') LW_PHYSICS=3 CASE DEFAULT WRITE(0,*)' User selected LONGWAVE=',TRIM(LONGWAVE) WRITE(0,*)' Improper selection of LW scheme in RADIATION' STOP ! or call abort END SELECT !========================================================================== ! Put "call radupdate_nmmb" here for threading safe !========================================================================== !---- for forcast purpose IDAT=JDAT DTSW =NRADS*DT ! [s] LSSWR=MOD(ITIMESTEP,NRADS)==0 IF (SW_PHYSICS .EQ. 3 .or. LW_PHYSICS .EQ. 3) THEN DTX =DT call radupdate_nmmb & ! --- inputs: & ( JDAT, JDAT, DTSW, DTX, LSSWR, MYPE, & ! --- outputs: & SLAG, SDEC, CDEC, SOLCON & & ) ENDIF !========================================================================== !========================================================================== ! !----------------------------------------------------------------------- ! CALL RADIATION_DRIVER !----------------------------------------------------------------------- IF (LW_PHYSICS .EQ. 0 .AND. SW_PHYSICS .EQ. 0) RETURN IF (ITIMESTEP .EQ. 1 .OR. MOD(ITIMESTEP,NRAD) .EQ. 0) THEN GFDL_LW = .FALSE. GFDL_SW = .FALSE. !----------------------------------------------------------------------- !*** Initialize Data !----------------------------------------------------------------------- ! DO J=JMS,JME DO I=IMS,IME GSW(I,J)=0. GLW(I,J)=0. SWDOWN(I,J)=0. ENDDO ENDDO ! DO K=1,LM DO J=JMS,JME DO I=IMS,IME THRATEN(I,J,K)=0. ENDDO ENDDO ENDDO !----------------------------------------------------------------------- ! lwrad_gfdl_select: SELECT CASE(lw_physics) ! !----------------------------------------------------------------------- CASE (GFDLLWSCHEME) !-- Do nothing, since cloud fractions (with partial cloudiness effects) !-- are defined in GFDL LW/SW schemes and do not need to be initialized. CASE (RRTMLWSCHEME) !-- Do nothing, since cloud fractions is calculated in RRTM CASE DEFAULT CALL CAL_CLDFRA(CLDFRA,QC,QI,F_QC,F_QI,IMS,IME,JMS,JME,LM) END SELECT lwrad_gfdl_select !----------------------------------------------------------------------- ! lwrad_select: SELECT CASE(lw_physics) ! !----------------------------------------------------------------------- CASE (RRTMLWSCHEME) !==== cloud fraction modification (HM Lin, 201503) =========== ! !--- use Thompson cloud fraction cfr3_select: SELECT CASE (TRIM(CLDFRACTION)) CASE ('thompson') ! -- THOMPSON CLOUD FRACTION IF(MYPE==0)THEN write(6,*) 'DEBUG-GT: using thompson cloud fraction scheme' ENDIF CLD_FRACTION=88 ! !--- Use dummy arrays QCW, QCI, QSNOW, NCI for Thompson cloud fraction scheme ! These arrays are updated in cal_cldfra3, and the adjust cloud fields are ! provided as input to RRTM and used by the radiation, but they are **not ! used** to change (update) the model arrays QC, QI, QS, and NI (those ! remain unchanged; BSF 4/13/2015). ! DO K=1,LM DO J=JMS,JME DO I=IMS,IME QV(I,J,K)=Q(I,J,K)/(1.-Q(I,J,K)) QCW(I,J,K)=QC(I,J,K) QCI(I,J,K)=0. QSNOW(I,J,K)=0. NCI(I,J,K)=0. IF (F_QI) QCI(I,J,K)=QI(I,J,K) IF (F_QS) QSNOW(I,J,K)=QS(I,J,K) IF (F_NI) NCI(I,J,K)=NI(I,J,K) ENDDO ENDDO ENDDO ! DO J=JMS,JME DO I=IMS,IME gridkm(i,j) = DYH(i,j)/1000. ! convert m to km ENDDO ENDDO CALL cal_cldfra3(CLDFRA, & QV,QCW,QCI,QSNOW,F_NI,NCI, & PRL,T,RHO,XLAND, gridkm, & ! note:12.=gridkm is only for testing IMS,IME,JMS,JME,1,LM) ! DO K=1,LM DO J=JMS,JME DO I=IMS,IME FIdum(I,J,K)=F_ICE(I,J,K) FRdum(I,J,K)=F_RAIN(I,J,K) QLdum=QCW(I,J,K) QIdum=QCI(I,J,K)+QSNOW(I,J,K) IF (F_QR) QLdum=QLdum+QR(I,J,K) IF (F_QG) QIdum=QIdum+QG(I,J,K) QTdum(I,J,K)=QLdum+QIdum IF (QTdum(I,J,K)>0.) FIdum(I,J,K)=QIdum/QTdum(I,J,K) IF (QLdum>0.) FRdum(I,J,K)=QR(I,J,K)/QLdum ENDDO ENDDO ENDDO CASE DEFAULT CLD_FRACTION=0 DO K=1,LM DO J=JMS,JME DO I=IMS,IME QTdum(I,J,K)=CW(I,J,K) FIdum(I,J,K)=F_ICE(I,J,K) FRdum(I,J,K)=F_RAIN(I,J,K) QCW(I,J,K)=QC(I,J,K) IF (F_QI) QCI(I,J,K)=QI(I,J,K) IF (F_QS) QSNOW(I,J,K)=QS(I,J,K) IF (F_NI) NCI(I,J,K)=NI(I,J,K) ENDDO ENDDO ENDDO END SELECT cfr3_select !----------------------------------------------------------------------- ! CALL RRTM(ITIMESTEP,DT,JDAT & ,NPHS,GLAT,GLON & ,NRADS,NRADL & ,PRSI,PRSL & ,T,Q,QTdum,O3 & ! QTdum was CW ,ALBEDO & ,ALBVB,ALBNB,ALBVD,ALBND & ! MODIS albedos ,FIdum,FRdum & ! FIdum,FRdum were F_ICE,F_RAIN ,QCW,QCI,QSNOW,QR,QG,NCI & ! QCW,QCI,QSNOW,NCI were QC,QI,QS,NI ,F_QC,F_QI,F_QS,F_QR,F_QG,F_NI & ,CLD_FRACTION & ,SM,CLDFRA & ,RLWTT,RSWTT & ,RLWIN,RSWIN & ,RSWINC,RLWINC,RSWOUC,RLWOUC,RLWOUCtoa,RSWOUCtoa & ,RSWOUT & ,RLWTOA,RSWTOA & ,CZMEAN,SIGT4 & ,CFRACL,CFRACM,CFRACH & ,ACFRST & ,ACFRCV & ,CUPPT,SNOWC,SI & ! was SNOW ,HTOP,HBOT & ,TSKIN,Z0,SICE,F_RIMEF,MXSNAL,STDH,VVL & ,IMS,IME,JMS,JME & ,IMS,IME,JMS,JME & ,LM & ,SOLCON & ,MYPE ) CASE (GFDLLWSCHEME) gfdl_lw = .true. CALL GFDL( & DT=dt,XLAND=xland & ,PHINT=phint,T=t & ,Q=Q & ,QW=QC & ,QI=QI & ,QS=QS & ,F_QC=F_QC,F_QI=F_QI,F_QS=F_QS & ,TSK2D=tsfc,GLW=GLW,RSWIN=SWDOWN,GSW=GSW & ,RSWINC=SWDOWNC,CLDFRA=CLDFRA,PI3D=PI3D & ,GLAT=glat,GLON=glon,HTOP=htop,HBOT=hbot & ,ALBEDO=albedo,CUPPT=cupptr & ,SNOW=snow,G=g,GMT=gmt & ,NSTEPRA=nrad,NPHS=nphs,ITIMESTEP=itimestep & ,XTIME=xtime,JULIAN=julian & ,JULYR=julyr,JULDAY=julday & ,GFDL_LW=gfdl_lw,GFDL_SW=gfdl_sw & ,CFRACL=cfracl,CFRACM=cfracm,CFRACH=cfrach & ,ACFRST=acfrst & ,ACFRCV=acfrcv & ,RSWTOA=rswtoa,RLWTOA=rlwtoa,CZMEAN=czmean & ,THRATEN=thraten,THRATENLW=thratenlw & ,THRATENSW=thratensw & ,IDS=ims,IDE=ime, JDS=jms,JDE=jme, KDS=1,KDE=lm+1 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=lm+1 & ,ITS=IMS,ITE=IME, JTS=JMS,JTE=JME, KTS=1,KTE=lm & ) CASE DEFAULT WRITE(0,*)'The longwave option does not exist: lw_physics = ', lw_physics STOP ! or call abort !----------------------------------------------------------------------- END SELECT lwrad_select !----------------------------------------------------------------------- ! swrad_select: SELECT CASE(sw_physics) ! !----------------------------------------------------------------------- CASE (SWRADSCHEME) !!! CALL SWRAD() CASE (GSFCSWSCHEME) !!! CALL GSFCSWRAD() CASE (RRTMSWSCHEME) !-- Already called complete RRTM SW/LW scheme in LW part of driver !!! CALL RRTM() CASE (GFDLSWSCHEME) gfdl_sw = .true. CALL GFDL( & DT=dt,XLAND=xland & ,PHINT=phint,T=t & ,Q=Q & ,QW=QC & ,QI=QI & ,QS=QS & ,F_QC=F_QC,F_QI=F_QI,F_QS=F_QS & ,TSK2D=tsfc,GLW=GLW,RSWIN=SWDOWN,GSW=GSW & ,RSWINC=SWDOWNC,CLDFRA=CLDFRA,PI3D=PI3D & ,GLAT=glat,GLON=glon,HTOP=htop,HBOT=hbot & ,ALBEDO=albedo,CUPPT=cupptr & ,SNOW=snow,G=g,GMT=gmt & ,NSTEPRA=nrad,NPHS=nphs,ITIMESTEP=itimestep & ,XTIME=xtime,JULIAN=julian & ,JULYR=julyr,JULDAY=julday & ,GFDL_LW=gfdl_lw,GFDL_SW=gfdl_sw & ,CFRACL=cfracl,CFRACM=cfracm,CFRACH=cfrach & ,ACFRST=acfrst & ,ACFRCV=acfrcv & ,RSWTOA=rswtoa,RLWTOA=rlwtoa,CZMEAN=czmean & ,THRATEN=thraten,THRATENLW=thratenlw & ,THRATENSW=thratensw & ,IDS=ims,IDE=ime, JDS=jms,JDE=jme, KDS=1,KDE=lm+1 & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=1,KME=lm+1 & ,ITS=IMS,ITE=IME, JTS=JMS,JTE=JME, KTS=1,KTE=lm & ) CASE DEFAULT WRITE(0,*)'The shortwave option does not exist: sw_physics = ', sw_physics STOP ! or call abort !----------------------------------------------------------------------- END SELECT swrad_select !----------------------------------------------------------------------- ! ENDIF ! !----------------------------------------------------------------------- ! IF(TRIM(SHORTWAVE)=='rrtm')THEN RETURN ENDIF ! !----------------------------------------------------------------------- ! !*** UPDATE FLUXES AND TEMPERATURE TENDENCIES. ! !----------------------------------------------------------------------- !*** SHORTWAVE !----------------------------------------------------------------------- ! !----------------------------------------------------------------------- IF(MOD(ITIMESTEP,NRADS)==0)THEN !----------------------------------------------------------------------- ! IF(TRIM(SHORTWAVE)/='gfdl')THEN ! !----------------------------------------------------------------------- !*** COMPUTE CZMEAN FOR NON-GFDL SHORTWAVE !----------------------------------------------------------------------- ! DO J=JMS,JME DO I=IMS,IME CZMEAN(I,J)=0. TOT(I,J)=0. ENDDO ENDDO ! CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY) IDAT(1)=JMONTH IDAT(2)=JDAY IDAT(3)=JULYR ! DO II=0,NRADS,NPHS TIMES=ITIMESTEP*DT+II*DT CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN & & ,IMS,IME,JMS,JME) DO J=JMS,JME DO I=IMS,IME IF(CZEN(I,J)>0.)THEN CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J) TOT(I,J)=TOT(I,J)+1. ENDIF ENDDO ENDDO ! ENDDO ! DO J=JMS,JME DO I=IMS,IME IF(TOT(I,J)>0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J) ENDDO ENDDO ! !----------------------------------------------------------------------- !*** COMPUTE TOTAL SFC SHORTWAVE DOWN FOR NON-GFDL SCHEMES !----------------------------------------------------------------------- ! DO J=JMS,JME DO I=IMS,IME ! SWDOWN(I,J)=GSW(I,J)/(1.-ALBEDO(I,J)) !--- No value currently available for clear-sky solar fluxes from ! non GFDL schemes, though it's needed for air quality forecasts. ! For the time being, set to the total downward solar fluxes. SWDOWNC(I,J)=SWDOWN(I,J) ! ENDDO ENDDO ! ENDIF !End non-GFDL/non-RRTM block !----------------------------------------------------------------------- ! !....................................................................... !$omp parallel do private(i,j,k) !....................................................................... DO J=JMS,JME DO I=IMS,IME ! RSWIN(I,J)=SWDOWN(I,J) RSWINC(I,J)=SWDOWNC(I,J) RSWOUT(I,J)=SWDOWN(I,J)-GSW(I,J) ! DO K=1,LM RSWTT(I,J,K)=THRATENSW(I,J,K)*PI3D(I,J,K) ENDDO ! ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! ENDIF ! !----------------------------------------------------------------------- !*** LONGWAVE !----------------------------------------------------------------------- ! IF(MOD(ITIMESTEP,NRADL)==0)THEN ! !....................................................................... !$omp parallel do private(i,j,k,tdum) !....................................................................... DO J=JMS,JME DO I=IMS,IME ! TDUM=T(I,J,LM) SIGT4(I,J)=STBOLT*TDUM*TDUM*TDUM*TDUM ! DO K=1,LM RLWTT(I,J,K)=THRATENLW(I,J,K)*PI3D(I,J,K) ENDDO ! RLWIN(I,J)=GLW(I,J) ! ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! ENDIF ! !----------------------------------------------------------------------- ! END SUBROUTINE RADIATION ! !----------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& !----------------------------------------------------------------------- SUBROUTINE cal_cldfra(CLDFRA,QC,QI,F_QC,F_QI,ims,ime,jms,jme,lm) !--------------------------------------------------------------------- IMPLICIT NONE !--------------------------------------------------------------------- INTEGER, INTENT(IN ) :: ims,ime, jms,jme, lm ! REAL, DIMENSION( ims:ime, jms:jme, 1:lm ), INTENT(OUT ) :: & CLDFRA REAL, DIMENSION( ims:ime, jms:jme, 1:lm ), INTENT(IN ) :: & QI, & QC LOGICAL,INTENT(IN) :: F_QC,F_QI REAL thresh INTEGER:: i,j,k ! !DESCRIPTION: ! Compute cloud fraction from input ice and cloud water fields ! if provided. ! ! Whether QI or QC is active or not is determined from the logical ! switches f_qi and f_qc. They are passed in to the routine ! to enable testing to see if QI and QC represent active fields. ! !--------------------------------------------------------------------- thresh=1.0e-6 IF ( f_qi .AND. f_qc ) THEN !....................................................................... !$omp parallel do private(k,j,i) !....................................................................... DO k = 1,lm DO j = jms,jme DO i = ims,ime IF ( QC(i,j,k)+QI(I,j,k) .gt. thresh) THEN CLDFRA(i,j,k)=1. ELSE CLDFRA(i,j,k)=0. ENDIF ENDDO ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! ELSE IF ( f_qc ) THEN !....................................................................... !$omp parallel do private(k,j,i) !....................................................................... DO k = 1,lm DO j = jms,jme DO i = ims,ime IF ( QC(i,j,k) .gt. thresh) THEN CLDFRA(i,j,k)=1. ELSE CLDFRA(i,j,k)=0. ENDIF ENDDO ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ! ELSE ! !....................................................................... !$omp parallel do private(k,j,i) !....................................................................... DO k = 1,lm DO j = jms,jme DO i = ims,ime CLDFRA(i,j,k)=0. ENDDO ENDDO ENDDO !....................................................................... !$omp end parallel do !....................................................................... ENDIF END SUBROUTINE cal_cldfra !--------------------------------------------------------------------- !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& !--------------------------------------------------------------------- ! END MODULE MODULE_RADIATION ! !-----------------------------------------------------------------------