[3908] | 1 | SUBROUTINE RRTM_SETCOEF_140GP (KIDIA,KFDIA,KLEV,P_COLDRY,P_WBROAD,P_WKL,& |
---|
| 2 | & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,& |
---|
| 3 | & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4, P_COLO2,P_CO2MULT, P_COLBRD, & |
---|
| 4 | & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,PAVEL,P_TAVEL,P_SELFFAC,P_SELFFRAC,K_INDSELF,& |
---|
| 5 | & K_INDMINOR,P_SCALEMINOR,P_SCALEMINORN2,P_MINORFRAC,& |
---|
| 6 | & PRAT_H2OCO2, PRAT_H2OCO2_1, PRAT_H2OO3, PRAT_H2OO3_1, & |
---|
| 7 | & PRAT_H2ON2O, PRAT_H2ON2O_1, PRAT_H2OCH4, PRAT_H2OCH4_1, & |
---|
| 8 | & PRAT_N2OCO2, PRAT_N2OCO2_1, PRAT_O3CO2, PRAT_O3CO2_1) |
---|
| 9 | |
---|
| 10 | ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
---|
| 11 | ! NEC 25-Oct-2007 Optimisations |
---|
| 12 | ! 201305 ABozzo updated to rrtmg_lw_v4.85 |
---|
| 13 | |
---|
| 14 | |
---|
| 15 | ! Purpose: For a given atmosphere, calculate the indices and |
---|
| 16 | ! fractions related to the pressure and temperature interpolations. |
---|
| 17 | ! Also calculate the values of the integrated Planck functions |
---|
| 18 | ! for each band at the level and layer temperatures. |
---|
| 19 | |
---|
| 20 | USE PARKIND1 , ONLY : JPIM, JPRB |
---|
| 21 | USE YOMHOOK , ONLY : LHOOK, DR_HOOK |
---|
| 22 | USE PARRRTM , ONLY : JPINPX |
---|
| 23 | USE YOERRTRF , ONLY : PREFLOG ,TREF, CHI_MLS |
---|
| 24 | |
---|
| 25 | IMPLICIT NONE |
---|
| 26 | |
---|
| 27 | INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA |
---|
| 28 | INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA |
---|
| 29 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV |
---|
| 30 | REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(KIDIA:KFDIA,KLEV) |
---|
| 31 | REAL(KIND=JPRB) ,INTENT(IN) :: P_WBROAD(KIDIA:KFDIA,KLEV) |
---|
| 32 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLBRD(KIDIA:KFDIA,KLEV) |
---|
| 33 | REAL(KIND=JPRB) ,INTENT(IN) :: P_WKL(KIDIA:KFDIA,JPINPX,KLEV) |
---|
| 34 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC00(KIDIA:KFDIA,KLEV) |
---|
| 35 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC01(KIDIA:KFDIA,KLEV) |
---|
| 36 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC10(KIDIA:KFDIA,KLEV) |
---|
| 37 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC11(KIDIA:KFDIA,KLEV) |
---|
| 38 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFAC(KIDIA:KFDIA,KLEV) |
---|
| 39 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFRAC(KIDIA:KFDIA,KLEV) |
---|
| 40 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JP(KIDIA:KFDIA,KLEV) |
---|
| 41 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT(KIDIA:KFDIA,KLEV) |
---|
| 42 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT1(KIDIA:KFDIA,KLEV) |
---|
| 43 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLH2O(KIDIA:KFDIA,KLEV) |
---|
| 44 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCO2(KIDIA:KFDIA,KLEV) |
---|
| 45 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO3(KIDIA:KFDIA,KLEV) |
---|
| 46 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLN2O(KIDIA:KFDIA,KLEV) |
---|
| 47 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCH4(KIDIA:KFDIA,KLEV) |
---|
| 48 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO2(KIDIA:KFDIA,KLEV) |
---|
| 49 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_CO2MULT(KIDIA:KFDIA,KLEV) |
---|
| 50 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYTROP(KIDIA:KFDIA) |
---|
| 51 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYSWTCH(KIDIA:KFDIA) |
---|
| 52 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYLOW(KIDIA:KFDIA) |
---|
| 53 | REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(KIDIA:KFDIA,KLEV) |
---|
| 54 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(KIDIA:KFDIA,KLEV) |
---|
| 55 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFAC(KIDIA:KFDIA,KLEV) |
---|
| 56 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFRAC(KIDIA:KFDIA,KLEV) |
---|
| 57 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDSELF(KIDIA:KFDIA,KLEV) |
---|
| 58 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDFOR(KIDIA:KFDIA,KLEV) |
---|
| 59 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDMINOR(KIDIA:KFDIA,KLEV) |
---|
| 60 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SCALEMINOR(KIDIA:KFDIA,KLEV) |
---|
| 61 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SCALEMINORN2(KIDIA:KFDIA,KLEV) |
---|
| 62 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_MINORFRAC(KIDIA:KFDIA,KLEV) |
---|
| 63 | REAL(KIND=JPRB) ,INTENT(OUT) :: & ! |
---|
| 64 | & PRAT_H2OCO2(KIDIA:KFDIA,KLEV),PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), & |
---|
| 65 | & PRAT_H2OO3(KIDIA:KFDIA,KLEV) ,PRAT_H2OO3_1(KIDIA:KFDIA,KLEV), & |
---|
| 66 | & PRAT_H2ON2O(KIDIA:KFDIA,KLEV),PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), & |
---|
| 67 | & PRAT_H2OCH4(KIDIA:KFDIA,KLEV),PRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), & |
---|
| 68 | & PRAT_N2OCO2(KIDIA:KFDIA,KLEV),PRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), & |
---|
| 69 | & PRAT_O3CO2(KIDIA:KFDIA,KLEV) ,PRAT_O3CO2_1(KIDIA:KFDIA,KLEV) |
---|
| 70 | !- from INTFAC |
---|
| 71 | !- from INTIND |
---|
| 72 | !- from PROFDATA |
---|
| 73 | !- from PROFILE |
---|
| 74 | !- from SELF |
---|
| 75 | INTEGER(KIND=JPIM) :: JP1, JLAY |
---|
| 76 | INTEGER(KIND=JPIM) :: JLON |
---|
| 77 | |
---|
| 78 | REAL(KIND=JPRB) :: Z_CO2REG, Z_COMPFP, Z_FACTOR, Z_FP, Z_FT, Z_FT1, Z_PLOG, Z_SCALEFAC, Z_STPFAC, Z_WATER |
---|
| 79 | REAL(KIND=JPRB) :: ZHOOK_HANDLE |
---|
| 80 | |
---|
| 81 | !#include "yoeratm.h" |
---|
| 82 | |
---|
| 83 | ASSOCIATE(NFLEVG=>KLEV) |
---|
| 84 | IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',0,ZHOOK_HANDLE) |
---|
| 85 | |
---|
| 86 | DO JLON = KIDIA, KFDIA |
---|
| 87 | Z_STPFAC = 296._JPRB/1013._JPRB |
---|
| 88 | |
---|
| 89 | K_LAYTROP(JLON) = 0 |
---|
| 90 | K_LAYSWTCH(JLON) = 0 |
---|
| 91 | K_LAYLOW(JLON) = 0 |
---|
| 92 | DO JLAY = 1, KLEV |
---|
| 93 | ! Find the two reference pressures on either side of the |
---|
| 94 | ! layer pressure. Store them in JP and JP1. Store in FP the |
---|
| 95 | ! fraction of the difference (in ln(pressure)) between these |
---|
| 96 | ! two values that the layer pressure lies. |
---|
| 97 | Z_PLOG = LOG(PAVEL(JLON,JLAY)) |
---|
| 98 | K_JP(JLON,JLAY) = INT(36._JPRB - 5*(Z_PLOG+0.04_JPRB)) |
---|
| 99 | IF (K_JP(JLON,JLAY) < 1) THEN |
---|
| 100 | K_JP(JLON,JLAY) = 1 |
---|
| 101 | ELSEIF (K_JP(JLON,JLAY) > 58) THEN |
---|
| 102 | K_JP(JLON,JLAY) = 58 |
---|
| 103 | ENDIF |
---|
| 104 | JP1 = K_JP(JLON,JLAY) + 1 |
---|
| 105 | Z_FP = 5._JPRB * (PREFLOG(K_JP(JLON,JLAY)) - Z_PLOG) |
---|
| 106 | ! bound Z_FP in case Z_PLOG is outside range of ref. pressure PREFLOG |
---|
| 107 | ! (in LVERTFE, pressure at last full level is known, but not in finite diff (NH) |
---|
| 108 | Z_FP = max(-1._JPRB,min(1._JPRB,Z_FP)) |
---|
| 109 | ! Determine, for each reference pressure (JP and JP1), which |
---|
| 110 | ! reference temperature (these are different for each |
---|
| 111 | ! reference pressure) is nearest the layer temperature but does |
---|
| 112 | ! not exceed it. Store these indices in JT and JT1, resp. |
---|
| 113 | ! Store in FT (resp. FT1) the fraction of the way between JT |
---|
| 114 | ! (JT1) and the next highest reference temperature that the |
---|
| 115 | ! layer temperature falls. |
---|
| 116 | |
---|
| 117 | K_JT(JLON,JLAY) = INT(3._JPRB + (P_TAVEL(JLON,JLAY)-TREF(K_JP(JLON,JLAY)))/15._JPRB) |
---|
| 118 | IF (K_JT(JLON,JLAY) < 1) THEN |
---|
| 119 | K_JT(JLON,JLAY) = 1 |
---|
| 120 | ELSEIF (K_JT(JLON,JLAY) > 4) THEN |
---|
| 121 | K_JT(JLON,JLAY) = 4 |
---|
| 122 | ENDIF |
---|
| 123 | Z_FT = ((P_TAVEL(JLON,JLAY)-TREF(K_JP(JLON,JLAY)))/15._JPRB) - REAL(K_JT(JLON,JLAY)-3) |
---|
| 124 | K_JT1(JLON,JLAY) = INT(3._JPRB + (P_TAVEL(JLON,JLAY)-TREF(JP1))/15._JPRB) |
---|
| 125 | IF (K_JT1(JLON,JLAY) < 1) THEN |
---|
| 126 | K_JT1(JLON,JLAY) = 1 |
---|
| 127 | ELSEIF (K_JT1(JLON,JLAY) > 4) THEN |
---|
| 128 | K_JT1(JLON,JLAY) = 4 |
---|
| 129 | ENDIF |
---|
| 130 | Z_FT1 = ((P_TAVEL(JLON,JLAY)-TREF(JP1))/15._JPRB) - REAL(K_JT1(JLON,JLAY)-3) |
---|
| 131 | |
---|
| 132 | Z_WATER = P_WKL(JLON,1,JLAY)/P_COLDRY(JLON,JLAY) |
---|
| 133 | Z_SCALEFAC = PAVEL(JLON,JLAY) * Z_STPFAC / P_TAVEL(JLON,JLAY) |
---|
| 134 | |
---|
| 135 | ! If the pressure is less than ~100mb, perform a different |
---|
| 136 | ! set of species interpolations. |
---|
| 137 | ! IF (PLOG .LE. 4.56) GO TO 5300 |
---|
| 138 | !-------------------------------------- |
---|
| 139 | IF (Z_PLOG > 4.56_JPRB) THEN |
---|
| 140 | K_LAYTROP(JLON) = K_LAYTROP(JLON) + 1 |
---|
| 141 | ! For one band, the "switch" occurs at ~300 mb. |
---|
| 142 | ! IF (Z_PLOG >= 5.76_JPRB) K_LAYSWTCH(JLON) = K_LAYSWTCH(JLON) + 1 |
---|
| 143 | ! IF (Z_PLOG >= 6.62_JPRB) K_LAYLOW(JLON) = K_LAYLOW(JLON) + 1 |
---|
| 144 | |
---|
| 145 | |
---|
| 146 | ! water vapor foreign continuum |
---|
| 147 | P_FORFAC(JLON,JLAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER) |
---|
| 148 | Z_FACTOR = (332.0_JPRB-P_TAVEL(JLON,JLAY))/36.0_JPRB |
---|
| 149 | K_INDFOR(JLON,JLAY) = MIN(2, MAX(1, INT(Z_FACTOR))) |
---|
| 150 | P_FORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDFOR(JLON,JLAY)) |
---|
| 151 | |
---|
| 152 | ! Set up factors needed to separately include the water vapor |
---|
| 153 | ! self-continuum in the calculation of absorption coefficient. |
---|
| 154 | !C SELFFAC(LAY) = WATER * SCALEFAC / (1.+WATER) |
---|
| 155 | P_SELFFAC(JLON,JLAY) = Z_WATER * P_FORFAC(JLON,JLAY) |
---|
| 156 | Z_FACTOR = (P_TAVEL(JLON,JLAY)-188.0_JPRB)/7.2_JPRB |
---|
| 157 | K_INDSELF(JLON,JLAY) = MIN(9, MAX(1, INT(Z_FACTOR)-7)) |
---|
| 158 | P_SELFFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDSELF(JLON,JLAY) + 7) |
---|
| 159 | |
---|
| 160 | ! Set up factors needed to separately include the minor gases |
---|
| 161 | ! in the calculation of absorption coefficient |
---|
| 162 | P_SCALEMINOR(JLON,JLAY) = PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY) |
---|
| 163 | P_SCALEMINORN2(JLON,JLAY) = (PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)) & |
---|
| 164 | & *(P_WBROAD(JLON,JLAY)/(P_COLDRY(JLON,JLAY)+P_WKL(JLON,1,JLAY))) |
---|
| 165 | Z_FACTOR = (P_TAVEL(JLON,JLAY)-180.8_JPRB)/7.2_JPRB |
---|
| 166 | K_INDMINOR(JLON,JLAY) = MIN(18, MAX(1, INT(Z_FACTOR))) |
---|
| 167 | P_MINORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDMINOR(JLON,JLAY)) |
---|
| 168 | |
---|
| 169 | ! Setup reference ratio to be used in calculation of binary |
---|
| 170 | ! species parameter in lower atmosphere. |
---|
| 171 | PRAT_H2OCO2(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY)) |
---|
| 172 | PRAT_H2OCO2_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1) |
---|
| 173 | |
---|
| 174 | PRAT_H2OO3(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(3,K_JP(JLON,JLAY)) |
---|
| 175 | PRAT_H2OO3_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(3,K_JP(JLON,JLAY)+1) |
---|
| 176 | |
---|
| 177 | PRAT_H2ON2O(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(4,K_JP(JLON,JLAY)) |
---|
| 178 | PRAT_H2ON2O_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(4,K_JP(JLON,JLAY)+1) |
---|
| 179 | |
---|
| 180 | PRAT_H2OCH4(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(6,K_JP(JLON,JLAY)) |
---|
| 181 | PRAT_H2OCH4_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(6,K_JP(JLON,JLAY)+1) |
---|
| 182 | |
---|
| 183 | PRAT_N2OCO2(JLON,JLAY)=CHI_MLS(4,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY)) |
---|
| 184 | PRAT_N2OCO2_1(JLON,JLAY)=CHI_MLS(4,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1) |
---|
| 185 | |
---|
| 186 | |
---|
| 187 | |
---|
| 188 | ! Calculate needed column amounts. |
---|
| 189 | P_COLH2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,1,JLAY) |
---|
| 190 | P_COLCO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,2,JLAY) |
---|
| 191 | P_COLO3(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,3,JLAY) |
---|
| 192 | P_COLN2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,4,JLAY) |
---|
| 193 | P_COLCH4(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,6,JLAY) |
---|
| 194 | P_COLO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,7,JLAY) |
---|
| 195 | P_COLBRD(JLON,JLAY) = 1.E-20_JPRB * P_WBROAD(JLON,JLAY) |
---|
| 196 | IF (P_COLCO2(JLON,JLAY) == 0.0_JPRB) P_COLCO2(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 197 | IF (P_COLN2O(JLON,JLAY) == 0.0_JPRB) P_COLN2O(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 198 | IF (P_COLCH4(JLON,JLAY) == 0.0_JPRB) P_COLCH4(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 199 | ! Using E = 1334.2 cm-1. |
---|
| 200 | Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 201 | P_CO2MULT(JLON,JLAY)= (P_COLCO2(JLON,JLAY) - Z_CO2REG) *& |
---|
| 202 | & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(JLON,JLAY))/(8.7604E-4_JPRB*P_TAVEL(JLON,JLAY)) |
---|
| 203 | ! GO TO 5400 |
---|
| 204 | !------------------ |
---|
| 205 | ELSE |
---|
| 206 | ! Above LAYTROP. |
---|
| 207 | ! 5300 CONTINUE |
---|
| 208 | |
---|
| 209 | ! Calculate needed column amounts. |
---|
| 210 | P_FORFAC(JLON,JLAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER) |
---|
| 211 | Z_FACTOR = (P_TAVEL(JLON,JLAY)-188.0_JPRB)/36.0_JPRB |
---|
| 212 | K_INDFOR(JLON,JLAY) = 3 |
---|
| 213 | P_FORFRAC(JLON,JLAY) = Z_FACTOR - 1.0_JPRB |
---|
| 214 | |
---|
| 215 | ! Set up factors needed to separately include the water vapor |
---|
| 216 | ! self-continuum in the calculation of absorption coefficient. |
---|
| 217 | P_SELFFAC(JLON,JLAY) = Z_WATER * P_FORFAC(JLON,JLAY) |
---|
| 218 | |
---|
| 219 | ! Set up factors needed to separately include the minor gases |
---|
| 220 | ! in the calculation of absorption coefficient |
---|
| 221 | P_SCALEMINOR(JLON,JLAY) = PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY) |
---|
| 222 | P_SCALEMINORN2(JLON,JLAY) = (PAVEL(JLON,JLAY)/P_TAVEL(JLON,JLAY)) & |
---|
| 223 | & * (P_WBROAD(JLON,JLAY)/(P_COLDRY(JLON,JLAY)+P_WKL(JLON,1,JLAY))) |
---|
| 224 | Z_FACTOR = (P_TAVEL(JLON,JLAY)-180.8_JPRB)/7.2_JPRB |
---|
| 225 | K_INDMINOR(JLON,JLAY) = MIN(18, MAX(1, INT(Z_FACTOR))) |
---|
| 226 | P_MINORFRAC(JLON,JLAY) = Z_FACTOR - REAL(K_INDMINOR(JLON,JLAY)) |
---|
| 227 | |
---|
| 228 | ! Setup reference ratio to be used in calculation of binary |
---|
| 229 | ! species parameter in upper atmosphere. |
---|
| 230 | PRAT_H2OCO2(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY)) |
---|
| 231 | PRAT_H2OCO2_1(JLON,JLAY)=CHI_MLS(1,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1) |
---|
| 232 | |
---|
| 233 | PRAT_O3CO2(JLON,JLAY)=CHI_MLS(3,K_JP(JLON,JLAY))/CHI_MLS(2,K_JP(JLON,JLAY)) |
---|
| 234 | PRAT_O3CO2_1(JLON,JLAY)=CHI_MLS(3,K_JP(JLON,JLAY)+1)/CHI_MLS(2,K_JP(JLON,JLAY)+1) |
---|
| 235 | |
---|
| 236 | |
---|
| 237 | ! Calculate needed column amounts. |
---|
| 238 | P_COLH2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,1,JLAY) |
---|
| 239 | P_COLCO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,2,JLAY) |
---|
| 240 | P_COLO3(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,3,JLAY) |
---|
| 241 | P_COLN2O(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,4,JLAY) |
---|
| 242 | P_COLCH4(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,6,JLAY) |
---|
| 243 | P_COLO2(JLON,JLAY) = 1.E-20_JPRB * P_WKL(JLON,7,JLAY) |
---|
| 244 | P_COLBRD(JLON,JLAY) = 1.E-20_JPRB * P_WBROAD(JLON,JLAY) |
---|
| 245 | IF (P_COLCO2(JLON,JLAY) == 0.0_JPRB) P_COLCO2(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 246 | IF (P_COLN2O(JLON,JLAY) == 0.0_JPRB) P_COLN2O(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 247 | IF (P_COLCH4(JLON,JLAY) == 0.0_JPRB) P_COLCH4(JLON,JLAY) = 1.E-32_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 248 | Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(JLON,JLAY) |
---|
| 249 | P_CO2MULT(JLON,JLAY)= (P_COLCO2(JLON,JLAY) - Z_CO2REG) *& |
---|
| 250 | & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(JLON,JLAY))/(8.7604E-4_JPRB*P_TAVEL(JLON,JLAY)) |
---|
| 251 | !---------------- |
---|
| 252 | ENDIF |
---|
| 253 | ! 5400 CONTINUE |
---|
| 254 | |
---|
| 255 | ! We have now isolated the layer ln pressure and temperature, |
---|
| 256 | ! between two reference pressures and two reference temperatures |
---|
| 257 | ! (for each reference pressure). We multiply the pressure |
---|
| 258 | ! fraction FP with the appropriate temperature fractions to get |
---|
| 259 | ! the factors that will be needed for the interpolation that yields |
---|
| 260 | ! the optical depths (performed in routines TAUGBn for band n). |
---|
| 261 | |
---|
| 262 | Z_COMPFP = 1.0_JPRB - Z_FP |
---|
| 263 | P_FAC10(JLON,JLAY) = Z_COMPFP * Z_FT |
---|
| 264 | P_FAC00(JLON,JLAY) = Z_COMPFP * (1.0_JPRB - Z_FT) |
---|
| 265 | P_FAC11(JLON,JLAY) = Z_FP * Z_FT1 |
---|
| 266 | P_FAC01(JLON,JLAY) = Z_FP * (1.0_JPRB - Z_FT1) |
---|
| 267 | |
---|
| 268 | ! Rescale selffac and forfac for use in taumol |
---|
| 269 | P_SELFFAC(JLON,JLAY) = P_COLH2O(JLON,JLAY)*P_SELFFAC(JLON,JLAY) |
---|
| 270 | P_FORFAC(JLON,JLAY) = P_COLH2O(JLON,JLAY)*P_FORFAC(JLON,JLAY) |
---|
| 271 | |
---|
| 272 | |
---|
| 273 | ENDDO |
---|
| 274 | |
---|
| 275 | ! MT 981104 |
---|
| 276 | !-- Set LAYLOW for profiles with surface pressure less than 750 hPa. |
---|
| 277 | IF (K_LAYLOW(JLON) == 0) K_LAYLOW(JLON)=1 |
---|
| 278 | ENDDO |
---|
| 279 | |
---|
| 280 | IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',1,ZHOOK_HANDLE) |
---|
| 281 | |
---|
| 282 | END ASSOCIATE |
---|
| 283 | END SUBROUTINE RRTM_SETCOEF_140GP |
---|