| 1 | !****************************************************************************** |
|---|
| 2 | SUBROUTINE RRTM_TAUMOL14 (KLEV,TAU,& |
|---|
| 3 | &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,& |
|---|
| 4 | &COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC) |
|---|
| 5 | |
|---|
| 6 | ! BAND 14: 2250-2380 cm-1 (low - CO2; high - CO2) |
|---|
| 7 | |
|---|
| 8 | ! Modifications |
|---|
| 9 | ! |
|---|
| 10 | ! D Salmond 1999-07-14 speed-up |
|---|
| 11 | |
|---|
| 12 | |
|---|
| 13 | #include "tsmbkind.h" |
|---|
| 14 | |
|---|
| 15 | USE PARRRTM , ONLY : JPLAY ,JPBAND ,JPGPT ,JPXSEC , NGS13 |
|---|
| 16 | USE YOERRTWN , ONLY : NG ,NSPA ,NSPB |
|---|
| 17 | USE YOERRTA14, ONLY : NG14 ,ABSA ,ABSB ,FRACREFA, FRACREFB,& |
|---|
| 18 | &KA , KB ,SELFREF |
|---|
| 19 | |
|---|
| 20 | IMPLICIT NONE |
|---|
| 21 | |
|---|
| 22 | ! Output |
|---|
| 23 | REAL_B :: TAU (JPGPT,JPLAY) |
|---|
| 24 | |
|---|
| 25 | ! DUMMY INTEGER SCALARS |
|---|
| 26 | INTEGER_M :: KLEV |
|---|
| 27 | |
|---|
| 28 | !- from AER |
|---|
| 29 | REAL_B :: TAUAERL(JPLAY,JPBAND) |
|---|
| 30 | |
|---|
| 31 | !- from INTFAC |
|---|
| 32 | REAL_B :: FAC00(JPLAY) |
|---|
| 33 | REAL_B :: FAC01(JPLAY) |
|---|
| 34 | REAL_B :: FAC10(JPLAY) |
|---|
| 35 | REAL_B :: FAC11(JPLAY) |
|---|
| 36 | |
|---|
| 37 | !- from INTIND |
|---|
| 38 | INTEGER_M :: JP(JPLAY) |
|---|
| 39 | INTEGER_M :: JT(JPLAY) |
|---|
| 40 | INTEGER_M :: JT1(JPLAY) |
|---|
| 41 | |
|---|
| 42 | !- from PROFDATA |
|---|
| 43 | REAL_B :: COLCO2(JPLAY) |
|---|
| 44 | INTEGER_M :: LAYTROP |
|---|
| 45 | |
|---|
| 46 | !- from SELF |
|---|
| 47 | REAL_B :: SELFFAC(JPLAY) |
|---|
| 48 | REAL_B :: SELFFRAC(JPLAY) |
|---|
| 49 | INTEGER_M :: INDSELF(JPLAY) |
|---|
| 50 | |
|---|
| 51 | !- from SP |
|---|
| 52 | REAL_B :: PFRAC(JPGPT,JPLAY) |
|---|
| 53 | |
|---|
| 54 | |
|---|
| 55 | ! LOCAL INTEGER SCALARS |
|---|
| 56 | INTEGER_M :: IG, IND0, IND1, INDS, LAY |
|---|
| 57 | |
|---|
| 58 | |
|---|
| 59 | ! Input |
|---|
| 60 | !#include "yoeratm.h" |
|---|
| 61 | |
|---|
| 62 | ! REAL TAUAER(JPLAY) |
|---|
| 63 | ! EQUIVALENCE (TAUAERL(1,14),TAUAER) |
|---|
| 64 | |
|---|
| 65 | ! Compute the optical depth by interpolating in ln(pressure) and |
|---|
| 66 | ! temperature. Below LAYTROP, the water vapor self-continuum |
|---|
| 67 | ! is interpolated (in temperature) separately. |
|---|
| 68 | |
|---|
| 69 | DO LAY = 1, LAYTROP |
|---|
| 70 | IND0 = ((JP(LAY)-1)*5+(JT(LAY)-1))*NSPA(14) + 1 |
|---|
| 71 | IND1 = (JP(LAY)*5+(JT1(LAY)-1))*NSPA(14) + 1 |
|---|
| 72 | INDS = INDSELF(LAY) |
|---|
| 73 | !-- DS_990714 |
|---|
| 74 | ! DO IG = 1, NG14 |
|---|
| 75 | IG=1 |
|---|
| 76 | TAU (NGS13+IG,LAY) = COLCO2(LAY) *& |
|---|
| 77 | &(FAC00(LAY) * ABSA(IND0 ,IG) +& |
|---|
| 78 | & FAC10(LAY) * ABSA(IND0+1,IG) +& |
|---|
| 79 | & FAC01(LAY) * ABSA(IND1 ,IG) +& |
|---|
| 80 | & FAC11(LAY) * ABSA(IND1+1,IG) +& |
|---|
| 81 | &SELFFAC(LAY) * (SELFREF(INDS,IG) + & |
|---|
| 82 | &SELFFRAC(LAY) *& |
|---|
| 83 | &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG))))& |
|---|
| 84 | &+ TAUAERL(LAY,14) |
|---|
| 85 | PFRAC(NGS13+IG,LAY) = FRACREFA(IG) |
|---|
| 86 | IG=2 |
|---|
| 87 | TAU (NGS13+IG,LAY) = COLCO2(LAY) *& |
|---|
| 88 | &(FAC00(LAY) * ABSA(IND0 ,IG) +& |
|---|
| 89 | & FAC10(LAY) * ABSA(IND0+1,IG) +& |
|---|
| 90 | & FAC01(LAY) * ABSA(IND1 ,IG) +& |
|---|
| 91 | & FAC11(LAY) * ABSA(IND1+1,IG) +& |
|---|
| 92 | &SELFFAC(LAY) * (SELFREF(INDS,IG) +& |
|---|
| 93 | &SELFFRAC(LAY) *& |
|---|
| 94 | &(SELFREF(INDS+1,IG) - SELFREF(INDS,IG))))& |
|---|
| 95 | &+ TAUAERL(LAY,14) |
|---|
| 96 | PFRAC(NGS13+IG,LAY) = FRACREFA(IG) |
|---|
| 97 | ! END DO |
|---|
| 98 | !-- DS_990714 |
|---|
| 99 | ENDDO |
|---|
| 100 | |
|---|
| 101 | DO LAY = LAYTROP+1, KLEV |
|---|
| 102 | IND0 = ((JP(LAY)-13)*5+(JT(LAY)-1))*NSPB(14) + 1 |
|---|
| 103 | IND1 = ((JP(LAY)-12)*5+(JT1(LAY)-1))*NSPB(14) + 1 |
|---|
| 104 | !-- DS_990714 |
|---|
| 105 | ! DO IG = 1, NG14 |
|---|
| 106 | IG=1 |
|---|
| 107 | TAU (NGS13+IG,LAY) = COLCO2(LAY) *& |
|---|
| 108 | &(FAC00(LAY) * ABSB(IND0 ,IG) +& |
|---|
| 109 | & FAC10(LAY) * ABSB(IND0+1,IG) +& |
|---|
| 110 | & FAC01(LAY) * ABSB(IND1 ,IG) +& |
|---|
| 111 | & FAC11(LAY) * ABSB(IND1+1,IG)) & |
|---|
| 112 | &+ TAUAERL(LAY,14) |
|---|
| 113 | PFRAC(NGS13+IG,LAY) = FRACREFB(IG) |
|---|
| 114 | IG=2 |
|---|
| 115 | TAU (NGS13+IG,LAY) = COLCO2(LAY) *& |
|---|
| 116 | &(FAC00(LAY) * ABSB(IND0 ,IG) +& |
|---|
| 117 | & FAC10(LAY) * ABSB(IND0+1,IG) +& |
|---|
| 118 | & FAC01(LAY) * ABSB(IND1 ,IG) +& |
|---|
| 119 | & FAC11(LAY) * ABSB(IND1+1,IG)) & |
|---|
| 120 | &+ TAUAERL(LAY,14) |
|---|
| 121 | PFRAC(NGS13+IG,LAY) = FRACREFB(IG) |
|---|
| 122 | ! END DO |
|---|
| 123 | !-- DS_990714 |
|---|
| 124 | ENDDO |
|---|
| 125 | |
|---|
| 126 | RETURN |
|---|
| 127 | END SUBROUTINE RRTM_TAUMOL14 |
|---|
