SUBROUTINE RRTM_ECRT_140GP_MCICA & &( KIDIA, KFDIA, KLON, KLEV, KCOLS ,& & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, & & PTS , PTH , PT , & & PEMIS, PEMIW, & & PQ , PCO2 , PCH4, PN2O , PNO2, PC11, PC12, PC22, PCL4, POZN, PCLDF , PTAUCLDI, & & PCLDFRAC, PTAUCLD, PCOLDRY, PWBRODL, PWKL, PWX , & & PTAUAERL, PAVEL , PTAVEL , PZ , PTZ , PTBOUND, PSEMISS , KREFLECT) !----compiled for Cray with -h nopattern---- ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 ! Read in atmospheric profile from ECMWF radiation code, and prepare it ! for use in RRTM. Set other RRTM input parameters. Values are passed ! back through existing RRTM arrays and commons. !- Modifications ! 2000-05-15 Deborah Salmond Speed-up ! JJMorcrette 20050110 McICA version ! NEC 25-Oct-2007 Optimisations ! PBechtold+NSemane 09-Jul-2012 Gravity ! 201305 ABozzo PWBRODL,O2 USE PARKIND1 , ONLY : JPIM, JPRB USE YOMHOOK , ONLY : LHOOK, DR_HOOK USE YOMCST , ONLY : RG USE PARRRTM , ONLY : JPBAND, JPXSEC, JPINPX USE YOERAD , ONLY : NSPMAPL USE YOESW , ONLY : RAER USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL USE YOM_YGFL , ONLY : YGFL USE YOMDYNCORE,ONLY : RPLRG !------------------------------Arguments-------------------------------- IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes) INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16) REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa) REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa) REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (K) REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (K) REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (K) REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) ! Non-window surface emissivity REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) ! Window surface emissivity REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr) REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV) ! N2O mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PCL4(KLON,KLEV) ! CCL4 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KCOLS,KLEV) ! Cloud fraction REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLDI(KLON,KLEV,KCOLS) ! Cloud optical depth REAL(KIND=JPRB) ,INTENT(OUT) :: PCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV) ! Cloud fraction REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUCLD(KIDIA:KFDIA,KLEV,KCOLS) ! Spectral optical thickness REAL(KIND=JPRB) ,INTENT(OUT) :: PCOLDRY(KIDIA:KFDIA,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PWBRODL(KIDIA:KFDIA,KLEV) ! broadening gas column density (mol/cm2) REAL(KIND=JPRB) ,INTENT(OUT) :: PWKL(KIDIA:KFDIA,JPINPX,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases REAL(KIND=JPRB) ,INTENT(OUT) :: PTAUAERL(KIDIA:KFDIA,KLEV,JPBAND) REAL(KIND=JPRB) ,INTENT(OUT) :: PAVEL(KIDIA:KFDIA,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PTAVEL(KIDIA:KFDIA,KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PZ(KIDIA:KFDIA,0:KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PTZ(KIDIA:KFDIA,0:KLEV) REAL(KIND=JPRB) ,INTENT(OUT) :: PTBOUND(KIDIA:KFDIA) REAL(KIND=JPRB) ,INTENT(OUT) :: PSEMISS(KIDIA:KFDIA,JPBAND) INTEGER(KIND=JPIM),INTENT(OUT) :: KREFLECT(KIDIA:KFDIA) ! real rch4 ! CH4 mass mixing ratio ! real rn2o ! N2O mass mixing ratio ! real rcfc11 ! CFC11 mass mixing ratio ! real rcfc12 ! CFC12 mass mixing ratio ! real rcfc22 ! CFC22 mass mixing ratio ! real rccl4 ! CCl4 mass mixing ratio !- from AER !- from PROFILE !- from SURFACE REAL(KIND=JPRB) :: ztauaer(5) REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol) REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol) REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol) REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol) REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol) REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol) REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3 REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2 REAL(KIND=JPRB) :: ZAMC22 ! Molecular weight of CFC22 (g/mol) - CHF2CL REAL(KIND=JPRB) :: ZAMCL4 ! Molecular weight of CCl4 (g/mol) - CCL4 REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole) REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/s**2) REAL(KIND=JPRB) :: ZSUMMOL ! Atomic weights for conversion from mass to volume mixing ratios; these ! are the same values used in ECRT to assure accurate conversion to vmr data ZAMD / 28.970_JPRB / data ZAMW / 18.0154_JPRB / data ZAMCO2 / 44.011_JPRB / data ZAMO / 47.9982_JPRB / data ZAMCH4 / 16.043_JPRB / data ZAMN2O / 44.013_JPRB / data ZAMC11 / 137.3686_JPRB / data ZAMC12 / 120.9140_JPRB / data ZAMC22 / 86.4690_JPRB / data ZAMCL4 / 153.8230_JPRB / data ZAVGDRO/ 6.02214E23_JPRB / INTEGER(KIND=JPIM) :: IATM, JMOL, IXMAX, J1, J2, IAE, IKL, JK, JCOLS, JL, JLW INTEGER(KIND=JPIM) :: ITMOL, INXMOL REAL(KIND=JPRB) :: ZAMM REAL(KIND=JPRB) :: ZHOOK_HANDLE ! *** ! *** mji ! Initialize all molecular amounts and aerosol optical depths to zero here, ! then pass ECRT amounts into RRTM arrays below. ! DATA ZWKL /MAXPRDW*0.0/ ! DATA ZWX /MAXPROD*0.0/ ! DATA KREFLECT /0/ ! Activate cross section molecules: ! NXMOL - number of cross-sections input by user ! IXINDX(I) - index of cross-section molecule corresponding to Ith ! cross-section specified by user ! = 0 -- not allowed in RRTM ! = 1 -- CCL4 ! = 2 -- CFC11 ! = 3 -- CFC12 ! = 4 -- CFC22 ! DATA KXMOL /2/ ! DATA KXINDX /0,2,3,0,31*0/ ! IREFLECT=KREFLECT ! NXMOL=KXMOL ASSOCIATE(NFLEVG=>KLEV, & & NACTAERO=>YGFL%NACTAERO) IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',0,ZHOOK_HANDLE) ZGRAVIT=(RG/RPLRG)*1.E2_JPRB DO JL = KIDIA, KFDIA KREFLECT(JL)=0 INXMOL=2 ENDDO !DO J1=1,35 ! IXINDX(J1)=0 DO J2=1,KLEV DO J1=1,35 DO JL = KIDIA, KFDIA PWKL(JL,J1,J2)=0.0_JPRB ENDDO ENDDO ENDDO !IXINDX(2)=2 !IXINDX(3)=3 ! Set parameters needed for RRTM execution: IATM = 0 ! IXSECT = 1 ! NUMANGS = 0 ! IOUT = -1 IXMAX = 4 ! Bands 6,7,8 are considered the 'window' and allowed to have a ! different surface emissivity (as in ECMWF). Eli wrote this part.... DO JL = KIDIA, KFDIA PSEMISS(JL,1) = PEMIS(JL) PSEMISS(JL,2) = PEMIS(JL) PSEMISS(JL,3) = PEMIS(JL) PSEMISS(JL,4) = PEMIS(JL) PSEMISS(JL,5) = PEMIS(JL) PSEMISS(JL,6) = PEMIW(JL) PSEMISS(JL,7) = PEMIW(JL) PSEMISS(JL,8) = PEMIW(JL) PSEMISS(JL,9) = PEMIS(JL) PSEMISS(JL,10) = PEMIS(JL) PSEMISS(JL,11) = PEMIS(JL) PSEMISS(JL,12) = PEMIS(JL) PSEMISS(JL,13) = PEMIS(JL) PSEMISS(JL,14) = PEMIS(JL) PSEMISS(JL,15) = PEMIS(JL) PSEMISS(JL,16) = PEMIS(JL) ! Set surface temperature. PTBOUND(JL) = PTS(JL) ! Install ECRT arrays into RRTM arrays for pressure, temperature, ! and molecular amounts. Pressures are converted from Pascals ! (ECRT) to mb (RRTM). H2O, CO2, O3 and trace gas amounts are ! converted from mass mixing ratio to volume mixing ratio. CO2 ! converted with same dry air and CO2 molecular weights used in ! ECRT to assure correct conversion back to the proper CO2 vmr. ! The dry air column COLDRY (in molec/cm2) is calculated from ! the level pressures PZ (in mb) based on the hydrostatic equation ! and includes a correction to account for H2O in the layer. The ! molecular weight of moist air (amm) is calculated for each layer. ! Note: RRTM levels count from bottom to top, while the ECRT input ! variables count from the top down and must be reversed ITMOL = 7 PZ(JL,0) = PAPH(JL,KLEV+1)/100._JPRB PTZ(JL,0) = PTH(JL,KLEV+1) ENDDO DO JK = 1, KLEV DO JL = KIDIA, KFDIA PAVEL(JL,JK) = PAP(JL,KLEV-JK+1)/100._JPRB PTAVEL(JL,JK) = PT(JL,KLEV-JK+1) PZ(JL,JK) = PAPH(JL,KLEV-JK+1)/100._JPRB PTZ(JL,JK) = PTH(JL,KLEV-JK+1) PWKL(JL,1,JK) = PQ(JL,KLEV-JK+1)*ZAMD/ZAMW PWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD/ZAMCO2 PWKL(JL,3,JK) = POZN(JL,KLEV-JK+1)*ZAMD/ZAMO PWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD/ZAMN2O PWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD/ZAMCH4 PWKL(JL,7,JK) = 0.209488_JPRB ZAMM = (1.0_JPRB-PWKL(JL,1,JK))*ZAMD + PWKL(JL,1,JK)*ZAMW PCOLDRY(JL,JK) = (PZ(JL,JK-1)-PZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM*(1.0_JPRB+PWKL(JL,1,JK))) ENDDO ENDDO !- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays IF (LAERRRTM) THEN IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN DO JLW=1,16 DO JK=1,KLEV IKL=KLEV-JK+1 DO JL=KIDIA,KFDIA PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW) ENDDO ENDDO ENDDO ELSEIF (.NOT.LAERCSTR) THEN DO JLW=1,16 DO JK=1,KLEV IKL=KLEV-JK+1 DO JL=KIDIA,KFDIA PTAUAERL(JL,JK,JLW)=PAERTAUL(JL,IKL,JLW)+RAER(NSPMAPL(JLW),6)*PAER(JL,6,IKL) ENDDO ENDDO ENDDO ENDIF ELSE !- Fill RRTM aerosol arrays with operational ECMWF aerosols, ! do the mixing and distribute over the 16 spectral intervals DO JK=1,KLEV IKL=KLEV-JK+1 DO JL = KIDIA, KFDIA IAE=1 ZTAUAER(IAE) =& & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) PTAUAERL(JL,JK, 1)=ZTAUAER(1) PTAUAERL(JL,JK, 2)=ZTAUAER(1) IAE=2 ZTAUAER(IAE) =& & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) PTAUAERL(JL,JK, 3)=ZTAUAER(2) PTAUAERL(JL,JK, 4)=ZTAUAER(2) PTAUAERL(JL,JK, 5)=ZTAUAER(2) IAE=3 ZTAUAER(IAE) =& & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) PTAUAERL(JL,JK, 6)=ZTAUAER(3) PTAUAERL(JL,JK, 8)=ZTAUAER(3) PTAUAERL(JL,JK, 9)=ZTAUAER(3) IAE=4 ZTAUAER(IAE) =& & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) PTAUAERL(JL,JK, 7)=ZTAUAER(4) IAE=5 ZTAUAER(IAE) =& & RAER(IAE,1)*PAER(JL,1,IKL)+RAER(IAE,2)*PAER(JL,2,IKL)& & +RAER(IAE,3)*PAER(JL,3,IKL)+RAER(IAE,4)*PAER(JL,4,IKL)& & +RAER(IAE,5)*PAER(JL,5,IKL)+RAER(IAE,6)*PAER(JL,6,IKL) PTAUAERL(JL,JK,10)=ZTAUAER(5) PTAUAERL(JL,JK,11)=ZTAUAER(5) PTAUAERL(JL,JK,12)=ZTAUAER(5) PTAUAERL(JL,JK,13)=ZTAUAER(5) PTAUAERL(JL,JK,14)=ZTAUAER(5) PTAUAERL(JL,JK,15)=ZTAUAER(5) PTAUAERL(JL,JK,16)=ZTAUAER(5) ENDDO ENDDO ENDIF DO J2=1,KLEV DO J1=1,JPXSEC DO JL = KIDIA, KFDIA PWX(JL,J1,J2)=0.0_JPRB ENDDO ENDDO ENDDO DO JK = 1, KLEV DO JL = KIDIA, KFDIA !- Set cross section molecule amounts from ECRT; convert to vmr PWX(JL,1,JK) = PCL4(JL,KLEV-JK+1) * ZAMD/ZAMCL4 PWX(JL,2,JK) = PC11(JL,KLEV-JK+1) * ZAMD/ZAMC11 PWX(JL,3,JK) = PC12(JL,KLEV-JK+1) * ZAMD/ZAMC12 PWX(JL,4,JK) = PC22(JL,KLEV-JK+1) * ZAMD/ZAMC22 PWX(JL,1,JK) = PCOLDRY(JL,JK) * PWX(JL,1,JK) * 1.E-20_JPRB PWX(JL,2,JK) = PCOLDRY(JL,JK) * PWX(JL,2,JK) * 1.E-20_JPRB PWX(JL,3,JK) = PCOLDRY(JL,JK) * PWX(JL,3,JK) * 1.E-20_JPRB PWX(JL,4,JK) = PCOLDRY(JL,JK) * PWX(JL,4,JK) * 1.E-20_JPRB !- Here, all molecules in WKL and WX are in volume mixing ratio; convert to ! molec/cm2 based on COLDRY for use in RRTM !CDIR UNROLL=6 ZSUMMOL = 0.0_JPRB !AB broadening gases DO JMOL = 2, ITMOL ZSUMMOL = ZSUMMOL + PWKL(JL,JMOL,JK) ENDDO PWBRODL(JL,JK) = PCOLDRY(JL,JK) * (1._JPRB - ZSUMMOL) DO JMOL = 1, ITMOL PWKL(JL,JMOL,JK) = PCOLDRY(JL,JK) * PWKL(JL,JMOL,JK) ENDDO ENDDO ENDDO !- McICA: No overlap; simple copy of optical thickness; layer cloud cover is 0. or 1. DO JK=1,KLEV DO JCOLS=1,KCOLS DO JL = KIDIA, KFDIA PCLDFRAC(JL,JCOLS,JK)=PCLDF(JL,JCOLS,JK) PTAUCLD(JL,JK,JCOLS) =PTAUCLDI(JL,JK,JCOLS) ENDDO ENDDO ENDDO ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('RRTM_ECRT_140GP_MCICA',1,ZHOOK_HANDLE) END ASSOCIATE END SUBROUTINE RRTM_ECRT_140GP_MCICA