| 1 | SUBROUTINE RRTM_SETCOEF_140GP (KLEV,COLDRY,WKL & |
|---|
| 2 | &, FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1 & |
|---|
| 3 | &, COLH2O,COLCO2,COLO3,COLN2O,COLCH4,COLO2,CO2MULT & |
|---|
| 4 | &, LAYTROP,LAYSWTCH,LAYLOW,PAVEL,TAVEL,SELFFAC,SELFFRAC,INDSELF) |
|---|
| 5 | |
|---|
| 6 | ! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
|---|
| 7 | |
|---|
| 8 | ! Purpose: For a given atmosphere, calculate the indices and |
|---|
| 9 | ! fractions related to the pressure and temperature interpolations. |
|---|
| 10 | ! Also calculate the values of the integrated Planck functions |
|---|
| 11 | ! for each band at the level and layer temperatures. |
|---|
| 12 | |
|---|
| 13 | #include "tsmbkind.h" |
|---|
| 14 | |
|---|
| 15 | USE PARRRTM , ONLY : JPLAY ,JPBAND ,JPGPT ,JPINPX |
|---|
| 16 | USE YOERRTRF , ONLY : PREF ,PREFLOG ,TREF |
|---|
| 17 | |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | |
|---|
| 20 | REAL_B :: COLDRY(JPLAY) |
|---|
| 21 | REAL_B :: WKL(JPINPX,JPLAY) |
|---|
| 22 | |
|---|
| 23 | ! DUMMY INTEGER SCALARS |
|---|
| 24 | INTEGER_M :: KLEV |
|---|
| 25 | |
|---|
| 26 | !- from INTFAC |
|---|
| 27 | REAL_B :: FAC00(JPLAY) |
|---|
| 28 | REAL_B :: FAC01(JPLAY) |
|---|
| 29 | REAL_B :: FAC10(JPLAY) |
|---|
| 30 | REAL_B :: FAC11(JPLAY) |
|---|
| 31 | REAL_B :: FORFAC(JPLAY) |
|---|
| 32 | |
|---|
| 33 | !- from INTIND |
|---|
| 34 | INTEGER_M :: JP(JPLAY) |
|---|
| 35 | INTEGER_M :: JT(JPLAY) |
|---|
| 36 | INTEGER_M :: JT1(JPLAY) |
|---|
| 37 | |
|---|
| 38 | !- from PROFDATA |
|---|
| 39 | REAL_B :: COLH2O(JPLAY) |
|---|
| 40 | REAL_B :: COLCO2(JPLAY) |
|---|
| 41 | REAL_B :: COLO3 (JPLAY) |
|---|
| 42 | REAL_B :: COLN2O(JPLAY) |
|---|
| 43 | REAL_B :: COLCH4(JPLAY) |
|---|
| 44 | REAL_B :: COLO2 (JPLAY) |
|---|
| 45 | REAL_B :: CO2MULT(JPLAY) |
|---|
| 46 | INTEGER_M :: LAYTROP |
|---|
| 47 | INTEGER_M :: LAYSWTCH |
|---|
| 48 | INTEGER_M :: LAYLOW |
|---|
| 49 | |
|---|
| 50 | !- from PROFILE |
|---|
| 51 | REAL_B :: PAVEL(JPLAY) |
|---|
| 52 | REAL_B :: TAVEL(JPLAY) |
|---|
| 53 | |
|---|
| 54 | !- from SELF |
|---|
| 55 | REAL_B :: SELFFAC(JPLAY) |
|---|
| 56 | REAL_B :: SELFFRAC(JPLAY) |
|---|
| 57 | INTEGER_M :: INDSELF(JPLAY) |
|---|
| 58 | |
|---|
| 59 | |
|---|
| 60 | ! LOCAL INTEGER SCALARS |
|---|
| 61 | INTEGER_M :: JP1, LAY |
|---|
| 62 | |
|---|
| 63 | ! LOCAL REAL SCALARS |
|---|
| 64 | REAL_B :: CO2REG, COMPFP, FACTOR, FP, FT, FT1, PLOG, SCALEFAC, STPFAC, WATER |
|---|
| 65 | |
|---|
| 66 | |
|---|
| 67 | !#include "yoeratm.h" |
|---|
| 68 | |
|---|
| 69 | STPFAC = 296._JPRB/1013._JPRB |
|---|
| 70 | |
|---|
| 71 | LAYTROP = 0 |
|---|
| 72 | LAYSWTCH = 0 |
|---|
| 73 | LAYLOW = 0 |
|---|
| 74 | |
|---|
| 75 | !Martin control |
|---|
| 76 | !PRINT*,'PAVEL(:)',PAVEL(:) |
|---|
| 77 | !PRINT*,'SIZE(PAVEL)',SIZE(PAVEL) |
|---|
| 78 | !Martin control |
|---|
| 79 | |
|---|
| 80 | DO LAY = 1, KLEV |
|---|
| 81 | ! Find the two reference pressures on either side of the |
|---|
| 82 | ! layer pressure. Store them in JP and JP1. Store in FP the |
|---|
| 83 | ! fraction of the difference (in ln(pressure)) between these |
|---|
| 84 | ! two values that the layer pressure lies. |
|---|
| 85 | ! Martin modif to gather MAR and LMDZ: |
|---|
| 86 | IF (PAVEL(LAY) == 0. ) PAVEL(LAY) = (PAVEL(LAY-1))/2. |
|---|
| 87 | PLOG = LOG(PAVEL(LAY)) |
|---|
| 88 | JP(LAY) = INT(36._JPRB - 5*(PLOG+0.04_JPRB)) |
|---|
| 89 | IF (JP(LAY) < 1) THEN |
|---|
| 90 | JP(LAY) = 1 |
|---|
| 91 | ELSEIF (JP(LAY) > 58) THEN |
|---|
| 92 | JP(LAY) = 58 |
|---|
| 93 | ENDIF |
|---|
| 94 | JP1 = JP(LAY) + 1 |
|---|
| 95 | FP = 5._JPRB * (PREFLOG(JP(LAY)) - PLOG) |
|---|
| 96 | |
|---|
| 97 | ! Determine, for each reference pressure (JP and JP1), which |
|---|
| 98 | ! reference temperature (these are different for each |
|---|
| 99 | ! reference pressure) is nearest the layer temperature but does |
|---|
| 100 | ! not exceed it. Store these indices in JT and JT1, resp. |
|---|
| 101 | ! Store in FT (resp. FT1) the fraction of the way between JT |
|---|
| 102 | ! (JT1) and the next highest reference temperature that the |
|---|
| 103 | ! layer temperature falls. |
|---|
| 104 | JT(LAY) = INT(3._JPRB + (TAVEL(LAY)-TREF(JP(LAY)))/15._JPRB) |
|---|
| 105 | IF (JT(LAY) < 1) THEN |
|---|
| 106 | JT(LAY) = 1 |
|---|
| 107 | ELSEIF (JT(LAY) > 4) THEN |
|---|
| 108 | JT(LAY) = 4 |
|---|
| 109 | ENDIF |
|---|
| 110 | FT = ((TAVEL(LAY)-TREF(JP(LAY)))/15._JPRB) - REAL(JT(LAY)-3) |
|---|
| 111 | JT1(LAY) = INT(3._JPRB + (TAVEL(LAY)-TREF(JP1))/15._JPRB) |
|---|
| 112 | IF (JT1(LAY) < 1) THEN |
|---|
| 113 | JT1(LAY) = 1 |
|---|
| 114 | ELSEIF (JT1(LAY) > 4) THEN |
|---|
| 115 | JT1(LAY) = 4 |
|---|
| 116 | ENDIF |
|---|
| 117 | FT1 = ((TAVEL(LAY)-TREF(JP1))/15._JPRB) - REAL(JT1(LAY)-3) |
|---|
| 118 | |
|---|
| 119 | WATER = WKL(1,LAY)/COLDRY(LAY) |
|---|
| 120 | SCALEFAC = PAVEL(LAY) * STPFAC / TAVEL(LAY) |
|---|
| 121 | |
|---|
| 122 | ! If the pressure is less than ~100mb, perform a different |
|---|
| 123 | ! set of species interpolations. |
|---|
| 124 | ! IF (PLOG .LE. 4.56) GO TO 5300 |
|---|
| 125 | !-------------------------------------- |
|---|
| 126 | IF (PLOG > 4.56_JPRB) THEN |
|---|
| 127 | LAYTROP = LAYTROP + 1 |
|---|
| 128 | ! For one band, the "switch" occurs at ~300 mb. |
|---|
| 129 | IF (PLOG >= 5.76_JPRB) LAYSWTCH = LAYSWTCH + 1 |
|---|
| 130 | IF (PLOG >= 6.62_JPRB) LAYLOW = LAYLOW + 1 |
|---|
| 131 | |
|---|
| 132 | FORFAC(LAY) = SCALEFAC / (_ONE_+WATER) |
|---|
| 133 | |
|---|
| 134 | ! Set up factors needed to separately include the water vapor |
|---|
| 135 | ! self-continuum in the calculation of absorption coefficient. |
|---|
| 136 | !C SELFFAC(LAY) = WATER * SCALEFAC / (1.+WATER) |
|---|
| 137 | SELFFAC(LAY) = WATER * FORFAC(LAY) |
|---|
| 138 | FACTOR = (TAVEL(LAY)-188.0_JPRB)/7.2_JPRB |
|---|
| 139 | INDSELF(LAY) = MIN(9, MAX(1, INT(FACTOR)-7)) |
|---|
| 140 | SELFFRAC(LAY) = FACTOR - REAL(INDSELF(LAY) + 7) |
|---|
| 141 | |
|---|
| 142 | ! Calculate needed column amounts. |
|---|
| 143 | COLH2O(LAY) = 1.E-20_JPRB * WKL(1,LAY) |
|---|
| 144 | COLCO2(LAY) = 1.E-20_JPRB * WKL(2,LAY) |
|---|
| 145 | COLO3(LAY) = 1.E-20_JPRB * WKL(3,LAY) |
|---|
| 146 | COLN2O(LAY) = 1.E-20_JPRB * WKL(4,LAY) |
|---|
| 147 | COLCH4(LAY) = 1.E-20_JPRB * WKL(6,LAY) |
|---|
| 148 | COLO2(LAY) = 1.E-20_JPRB * WKL(7,LAY) |
|---|
| 149 | IF (COLCO2(LAY) == _ZERO_) COLCO2(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 150 | IF (COLN2O(LAY) == _ZERO_) COLN2O(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 151 | IF (COLCH4(LAY) == _ZERO_) COLCH4(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 152 | ! Using E = 1334.2 cm-1. |
|---|
| 153 | CO2REG = 3.55E-24_JPRB * COLDRY(LAY) |
|---|
| 154 | CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *& |
|---|
| 155 | &272.63_JPRB*EXP(-1919.4_JPRB/TAVEL(LAY))/(8.7604E-4_JPRB*TAVEL(LAY)) |
|---|
| 156 | ! GO TO 5400 |
|---|
| 157 | !------------------ |
|---|
| 158 | ELSE |
|---|
| 159 | ! Above LAYTROP. |
|---|
| 160 | ! 5300 CONTINUE |
|---|
| 161 | |
|---|
| 162 | ! Calculate needed column amounts. |
|---|
| 163 | FORFAC(LAY) = SCALEFAC / (_ONE_+WATER) |
|---|
| 164 | |
|---|
| 165 | COLH2O(LAY) = 1.E-20_JPRB * WKL(1,LAY) |
|---|
| 166 | COLCO2(LAY) = 1.E-20_JPRB * WKL(2,LAY) |
|---|
| 167 | COLO3(LAY) = 1.E-20_JPRB * WKL(3,LAY) |
|---|
| 168 | COLN2O(LAY) = 1.E-20_JPRB * WKL(4,LAY) |
|---|
| 169 | COLCH4(LAY) = 1.E-20_JPRB * WKL(6,LAY) |
|---|
| 170 | COLO2(LAY) = 1.E-20_JPRB * WKL(7,LAY) |
|---|
| 171 | IF (COLCO2(LAY) == _ZERO_) COLCO2(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 172 | IF (COLN2O(LAY) == _ZERO_) COLN2O(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 173 | IF (COLCH4(LAY) == _ZERO_) COLCH4(LAY) = 1.E-32_JPRB * COLDRY(LAY) |
|---|
| 174 | CO2REG = 3.55E-24_JPRB * COLDRY(LAY) |
|---|
| 175 | CO2MULT(LAY)= (COLCO2(LAY) - CO2REG) *& |
|---|
| 176 | &272.63_JPRB*EXP(-1919.4_JPRB/TAVEL(LAY))/(8.7604E-4_JPRB*TAVEL(LAY)) |
|---|
| 177 | !---------------- |
|---|
| 178 | ENDIF |
|---|
| 179 | ! 5400 CONTINUE |
|---|
| 180 | |
|---|
| 181 | ! We have now isolated the layer ln pressure and temperature, |
|---|
| 182 | ! between two reference pressures and two reference temperatures |
|---|
| 183 | ! (for each reference pressure). We multiply the pressure |
|---|
| 184 | ! fraction FP with the appropriate temperature fractions to get |
|---|
| 185 | ! the factors that will be needed for the interpolation that yields |
|---|
| 186 | ! the optical depths (performed in routines TAUGBn for band n). |
|---|
| 187 | |
|---|
| 188 | COMPFP = _ONE_ - FP |
|---|
| 189 | FAC10(LAY) = COMPFP * FT |
|---|
| 190 | FAC00(LAY) = COMPFP * (_ONE_ - FT) |
|---|
| 191 | FAC11(LAY) = FP * FT1 |
|---|
| 192 | FAC01(LAY) = FP * (_ONE_ - FT1) |
|---|
| 193 | |
|---|
| 194 | ENDDO |
|---|
| 195 | |
|---|
| 196 | ! MT 981104 |
|---|
| 197 | !-- Set LAYLOW for profiles with surface pressure less than 750 hPa. |
|---|
| 198 | IF (LAYLOW == 0) LAYLOW=1 |
|---|
| 199 | |
|---|
| 200 | RETURN |
|---|
| 201 | END SUBROUTINE RRTM_SETCOEF_140GP |
|---|
