Directory: | ./ |
---|---|
File: | rad/rrtm_setcoef_140gp.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 66 | 68 | 97.1% |
Branches: | 28 | 38 | 73.7% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 119280 | SUBROUTINE RRTM_SETCOEF_140GP (KLEV,P_COLDRY,P_WKL,& | |
2 | & P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,& | ||
3 | & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,& | ||
4 | & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,PAVEL,P_TAVEL,P_SELFFAC,P_SELFFRAC,K_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 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
14 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
15 | |||
16 | USE PARRRTM , ONLY : JPLAY ,JPINPX | ||
17 | USE YOERRTRF , ONLY : PREFLOG ,TREF | ||
18 | |||
19 | IMPLICIT NONE | ||
20 | |||
21 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
22 | REAL(KIND=JPRB) ,INTENT(IN) :: P_COLDRY(JPLAY) | ||
23 | REAL(KIND=JPRB) ,INTENT(IN) :: P_WKL(JPINPX,JPLAY) | ||
24 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC00(JPLAY) | ||
25 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC01(JPLAY) | ||
26 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC10(JPLAY) | ||
27 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FAC11(JPLAY) | ||
28 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_FORFAC(JPLAY) | ||
29 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JP(JPLAY) | ||
30 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT(JPLAY) | ||
31 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_JT1(JPLAY) | ||
32 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLH2O(JPLAY) | ||
33 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCO2(JPLAY) | ||
34 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO3(JPLAY) | ||
35 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLN2O(JPLAY) | ||
36 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLCH4(JPLAY) | ||
37 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_COLO2(JPLAY) | ||
38 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_CO2MULT(JPLAY) | ||
39 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYTROP | ||
40 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYSWTCH | ||
41 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_LAYLOW | ||
42 | REAL(KIND=JPRB) ,INTENT(IN) :: PAVEL(JPLAY) | ||
43 | REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(JPLAY) | ||
44 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFAC(JPLAY) | ||
45 | REAL(KIND=JPRB) ,INTENT(OUT) :: P_SELFFRAC(JPLAY) | ||
46 | INTEGER(KIND=JPIM),INTENT(OUT) :: K_INDSELF(JPLAY) | ||
47 | !- from INTFAC | ||
48 | !- from INTIND | ||
49 | !- from PROFDATA | ||
50 | !- from PROFILE | ||
51 | !- from SELF | ||
52 | INTEGER(KIND=JPIM) :: JP1, I_LAY | ||
53 | |||
54 | REAL(KIND=JPRB) :: Z_CO2REG, Z_COMPFP, Z_FACTOR, Z_FP, Z_FT, Z_FT1, Z_PLOG, Z_SCALEFAC, Z_STPFAC, Z_WATER | ||
55 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
56 | |||
57 | !#include "yoeratm.h" | ||
58 | |||
59 |
1/2✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
|
119280 | IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',0,ZHOOK_HANDLE) |
60 | Z_STPFAC = 296._JPRB/1013._JPRB | ||
61 | |||
62 | 119280 | K_LAYTROP = 0 | |
63 | 119280 | K_LAYSWTCH = 0 | |
64 | 119280 | K_LAYLOW = 0 | |
65 |
2/2✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 119280 times.
|
4771200 | DO I_LAY = 1, KLEV |
66 | ! Find the two reference pressures on either side of the | ||
67 | ! layer pressure. Store them in JP and JP1. Store in FP the | ||
68 | ! fraction of the difference (in ln(pressure)) between these | ||
69 | ! two values that the layer pressure lies. | ||
70 | 4651920 | Z_PLOG = LOG(PAVEL(I_LAY)) | |
71 | 4651920 | K_JP(I_LAY) = INT(36._JPRB - 5*(Z_PLOG+0.04_JPRB)) | |
72 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | IF (K_JP(I_LAY) < 1) THEN |
73 | ✗ | K_JP(I_LAY) = 1 | |
74 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
|
4651920 | ELSEIF (K_JP(I_LAY) > 58) THEN |
75 | ✗ | K_JP(I_LAY) = 58 | |
76 | ENDIF | ||
77 | 4651920 | JP1 = K_JP(I_LAY) + 1 | |
78 | 4651920 | Z_FP = 5._JPRB * (PREFLOG(K_JP(I_LAY)) - Z_PLOG) | |
79 | |||
80 | ! Determine, for each reference pressure (JP and JP1), which | ||
81 | ! reference temperature (these are different for each | ||
82 | ! reference pressure) is nearest the layer temperature but does | ||
83 | ! not exceed it. Store these indices in JT and JT1, resp. | ||
84 | ! Store in FT (resp. FT1) the fraction of the way between JT | ||
85 | ! (JT1) and the next highest reference temperature that the | ||
86 | ! layer temperature falls. | ||
87 | |||
88 | 4651920 | K_JT(I_LAY) = INT(3._JPRB + (P_TAVEL(I_LAY)-TREF(K_JP(I_LAY)))/15._JPRB) | |
89 |
2/2✓ Branch 0 taken 570299 times.
✓ Branch 1 taken 4081621 times.
|
4651920 | IF (K_JT(I_LAY) < 1) THEN |
90 | 570299 | K_JT(I_LAY) = 1 | |
91 |
2/2✓ Branch 0 taken 3168 times.
✓ Branch 1 taken 4078453 times.
|
4081621 | ELSEIF (K_JT(I_LAY) > 4) THEN |
92 | 3168 | K_JT(I_LAY) = 4 | |
93 | ENDIF | ||
94 | 4651920 | Z_FT = ((P_TAVEL(I_LAY)-TREF(K_JP(I_LAY)))/15._JPRB) - REAL(K_JT(I_LAY)-3) | |
95 | 4651920 | K_JT1(I_LAY) = INT(3._JPRB + (P_TAVEL(I_LAY)-TREF(JP1))/15._JPRB) | |
96 |
2/2✓ Branch 0 taken 301175 times.
✓ Branch 1 taken 4350745 times.
|
4651920 | IF (K_JT1(I_LAY) < 1) THEN |
97 | 301175 | K_JT1(I_LAY) = 1 | |
98 |
2/2✓ Branch 0 taken 11679 times.
✓ Branch 1 taken 4339066 times.
|
4350745 | ELSEIF (K_JT1(I_LAY) > 4) THEN |
99 | 11679 | K_JT1(I_LAY) = 4 | |
100 | ENDIF | ||
101 | 4651920 | Z_FT1 = ((P_TAVEL(I_LAY)-TREF(JP1))/15._JPRB) - REAL(K_JT1(I_LAY)-3) | |
102 | |||
103 | 4651920 | Z_WATER = P_WKL(1,I_LAY)/P_COLDRY(I_LAY) | |
104 | 4651920 | Z_SCALEFAC = PAVEL(I_LAY) * Z_STPFAC / P_TAVEL(I_LAY) | |
105 | |||
106 | ! If the pressure is less than ~100mb, perform a different | ||
107 | ! set of species interpolations. | ||
108 | ! IF (PLOG .LE. 4.56) GO TO 5300 | ||
109 | !-------------------------------------- | ||
110 |
2/2✓ Branch 0 taken 2504880 times.
✓ Branch 1 taken 2147040 times.
|
4651920 | IF (Z_PLOG > 4.56_JPRB) THEN |
111 | 2504880 | K_LAYTROP = K_LAYTROP + 1 | |
112 | ! For one band, the "switch" occurs at ~300 mb. | ||
113 |
2/2✓ Branch 0 taken 1666664 times.
✓ Branch 1 taken 838216 times.
|
2504880 | IF (Z_PLOG >= 5.76_JPRB) K_LAYSWTCH = K_LAYSWTCH + 1 |
114 |
2/2✓ Branch 0 taken 946140 times.
✓ Branch 1 taken 1558740 times.
|
2504880 | IF (Z_PLOG >= 6.62_JPRB) K_LAYLOW = K_LAYLOW + 1 |
115 | |||
116 | 2504880 | P_FORFAC(I_LAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER) | |
117 | |||
118 | ! Set up factors needed to separately include the water vapor | ||
119 | ! self-continuum in the calculation of absorption coefficient. | ||
120 | !C SELFFAC(LAY) = WATER * SCALEFAC / (1.+WATER) | ||
121 | 2504880 | P_SELFFAC(I_LAY) = Z_WATER * P_FORFAC(I_LAY) | |
122 | 2504880 | Z_FACTOR = (P_TAVEL(I_LAY)-188.0_JPRB)/7.2_JPRB | |
123 | 2504880 | K_INDSELF(I_LAY) = MIN(9, MAX(1, INT(Z_FACTOR)-7)) | |
124 | 2504880 | P_SELFFRAC(I_LAY) = Z_FACTOR - REAL(K_INDSELF(I_LAY) + 7) | |
125 | |||
126 | ! Calculate needed column amounts. | ||
127 | 2504880 | P_COLH2O(I_LAY) = 1.E-20_JPRB * P_WKL(1,I_LAY) | |
128 | 2504880 | P_COLCO2(I_LAY) = 1.E-20_JPRB * P_WKL(2,I_LAY) | |
129 | 2504880 | P_COLO3(I_LAY) = 1.E-20_JPRB * P_WKL(3,I_LAY) | |
130 | 2504880 | P_COLN2O(I_LAY) = 1.E-20_JPRB * P_WKL(4,I_LAY) | |
131 | 2504880 | P_COLCH4(I_LAY) = 1.E-20_JPRB * P_WKL(6,I_LAY) | |
132 | 2504880 | P_COLO2(I_LAY) = 1.E-20_JPRB * P_WKL(7,I_LAY) | |
133 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2504880 times.
|
2504880 | IF (P_COLCO2(I_LAY) == 0.0_JPRB) P_COLCO2(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
134 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2504880 times.
|
2504880 | IF (P_COLN2O(I_LAY) == 0.0_JPRB) P_COLN2O(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
135 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2504880 times.
|
2504880 | IF (P_COLCH4(I_LAY) == 0.0_JPRB) P_COLCH4(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
136 | ! Using E = 1334.2 cm-1. | ||
137 | 2504880 | Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(I_LAY) | |
138 | P_CO2MULT(I_LAY)= (P_COLCO2(I_LAY) - Z_CO2REG) *& | ||
139 | 2504880 | & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(I_LAY))/(8.7604E-4_JPRB*P_TAVEL(I_LAY)) | |
140 | ! GO TO 5400 | ||
141 | !------------------ | ||
142 | ELSE | ||
143 | ! Above LAYTROP. | ||
144 | ! 5300 CONTINUE | ||
145 | |||
146 | ! Calculate needed column amounts. | ||
147 | 2147040 | P_FORFAC(I_LAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER) | |
148 | |||
149 | 2147040 | P_COLH2O(I_LAY) = 1.E-20_JPRB * P_WKL(1,I_LAY) | |
150 | 2147040 | P_COLCO2(I_LAY) = 1.E-20_JPRB * P_WKL(2,I_LAY) | |
151 | 2147040 | P_COLO3(I_LAY) = 1.E-20_JPRB * P_WKL(3,I_LAY) | |
152 | 2147040 | P_COLN2O(I_LAY) = 1.E-20_JPRB * P_WKL(4,I_LAY) | |
153 | 2147040 | P_COLCH4(I_LAY) = 1.E-20_JPRB * P_WKL(6,I_LAY) | |
154 | 2147040 | P_COLO2(I_LAY) = 1.E-20_JPRB * P_WKL(7,I_LAY) | |
155 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2147040 times.
|
2147040 | IF (P_COLCO2(I_LAY) == 0.0_JPRB) P_COLCO2(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
156 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2147040 times.
|
2147040 | IF (P_COLN2O(I_LAY) == 0.0_JPRB) P_COLN2O(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
157 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 2147040 times.
|
2147040 | IF (P_COLCH4(I_LAY) == 0.0_JPRB) P_COLCH4(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
158 | 2147040 | Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(I_LAY) | |
159 | P_CO2MULT(I_LAY)= (P_COLCO2(I_LAY) - Z_CO2REG) *& | ||
160 | 2147040 | & 272.63_JPRB*EXP(-1919.4_JPRB/P_TAVEL(I_LAY))/(8.7604E-4_JPRB*P_TAVEL(I_LAY)) | |
161 | !---------------- | ||
162 | ENDIF | ||
163 | ! 5400 CONTINUE | ||
164 | |||
165 | ! We have now isolated the layer ln pressure and temperature, | ||
166 | ! between two reference pressures and two reference temperatures | ||
167 | ! (for each reference pressure). We multiply the pressure | ||
168 | ! fraction FP with the appropriate temperature fractions to get | ||
169 | ! the factors that will be needed for the interpolation that yields | ||
170 | ! the optical depths (performed in routines TAUGBn for band n). | ||
171 | |||
172 | 4651920 | Z_COMPFP = 1.0_JPRB - Z_FP | |
173 | 4651920 | P_FAC10(I_LAY) = Z_COMPFP * Z_FT | |
174 | 4651920 | P_FAC00(I_LAY) = Z_COMPFP * (1.0_JPRB - Z_FT) | |
175 | 4651920 | P_FAC11(I_LAY) = Z_FP * Z_FT1 | |
176 | 4771200 | P_FAC01(I_LAY) = Z_FP * (1.0_JPRB - Z_FT1) | |
177 | |||
178 | ENDDO | ||
179 | |||
180 | ! MT 981104 | ||
181 | !-- Set LAYLOW for profiles with surface pressure less than 750 hPa. | ||
182 |
2/2✓ Branch 0 taken 6000 times.
✓ Branch 1 taken 113280 times.
|
119280 | IF (K_LAYLOW == 0) K_LAYLOW=1 |
183 | |||
184 |
1/2✓ Branch 0 taken 119280 times.
✗ Branch 1 not taken.
|
119280 | IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',1,ZHOOK_HANDLE) |
185 | 119280 | END SUBROUTINE RRTM_SETCOEF_140GP | |
186 |