1 |
|
71568 |
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 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',0,ZHOOK_HANDLE) |
60 |
|
|
Z_STPFAC = 296._JPRB/1013._JPRB |
61 |
|
|
|
62 |
|
71568 |
K_LAYTROP = 0 |
63 |
|
71568 |
K_LAYSWTCH = 0 |
64 |
|
71568 |
K_LAYLOW = 0 |
65 |
✓✓ |
2862720 |
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 |
|
2791152 |
Z_PLOG = LOG(PAVEL(I_LAY)) |
71 |
|
2791152 |
K_JP(I_LAY) = INT(36._JPRB - 5*(Z_PLOG+0.04_JPRB)) |
72 |
✗✓ |
2791152 |
IF (K_JP(I_LAY) < 1) THEN |
73 |
|
|
K_JP(I_LAY) = 1 |
74 |
✗✓ |
2791152 |
ELSEIF (K_JP(I_LAY) > 58) THEN |
75 |
|
|
K_JP(I_LAY) = 58 |
76 |
|
|
ENDIF |
77 |
|
2791152 |
JP1 = K_JP(I_LAY) + 1 |
78 |
|
2791152 |
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 |
|
2791152 |
K_JT(I_LAY) = INT(3._JPRB + (P_TAVEL(I_LAY)-TREF(K_JP(I_LAY)))/15._JPRB) |
89 |
✓✓ |
2791152 |
IF (K_JT(I_LAY) < 1) THEN |
90 |
|
335683 |
K_JT(I_LAY) = 1 |
91 |
✓✓ |
2455469 |
ELSEIF (K_JT(I_LAY) > 4) THEN |
92 |
|
3164 |
K_JT(I_LAY) = 4 |
93 |
|
|
ENDIF |
94 |
|
2791152 |
Z_FT = ((P_TAVEL(I_LAY)-TREF(K_JP(I_LAY)))/15._JPRB) - REAL(K_JT(I_LAY)-3) |
95 |
|
2791152 |
K_JT1(I_LAY) = INT(3._JPRB + (P_TAVEL(I_LAY)-TREF(JP1))/15._JPRB) |
96 |
✓✓ |
2791152 |
IF (K_JT1(I_LAY) < 1) THEN |
97 |
|
182902 |
K_JT1(I_LAY) = 1 |
98 |
✓✓ |
2608250 |
ELSEIF (K_JT1(I_LAY) > 4) THEN |
99 |
|
11683 |
K_JT1(I_LAY) = 4 |
100 |
|
|
ENDIF |
101 |
|
2791152 |
Z_FT1 = ((P_TAVEL(I_LAY)-TREF(JP1))/15._JPRB) - REAL(K_JT1(I_LAY)-3) |
102 |
|
|
|
103 |
|
2791152 |
Z_WATER = P_WKL(1,I_LAY)/P_COLDRY(I_LAY) |
104 |
|
2791152 |
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 |
✓✓ |
2791152 |
IF (Z_PLOG > 4.56_JPRB) THEN |
111 |
|
1502928 |
K_LAYTROP = K_LAYTROP + 1 |
112 |
|
|
! For one band, the "switch" occurs at ~300 mb. |
113 |
✓✓ |
1502928 |
IF (Z_PLOG >= 5.76_JPRB) K_LAYSWTCH = K_LAYSWTCH + 1 |
114 |
✓✓ |
1502928 |
IF (Z_PLOG >= 6.62_JPRB) K_LAYLOW = K_LAYLOW + 1 |
115 |
|
|
|
116 |
|
1502928 |
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 |
|
1502928 |
P_SELFFAC(I_LAY) = Z_WATER * P_FORFAC(I_LAY) |
122 |
|
1502928 |
Z_FACTOR = (P_TAVEL(I_LAY)-188.0_JPRB)/7.2_JPRB |
123 |
|
1502928 |
K_INDSELF(I_LAY) = MIN(9, MAX(1, INT(Z_FACTOR)-7)) |
124 |
|
1502928 |
P_SELFFRAC(I_LAY) = Z_FACTOR - REAL(K_INDSELF(I_LAY) + 7) |
125 |
|
|
|
126 |
|
|
! Calculate needed column amounts. |
127 |
|
1502928 |
P_COLH2O(I_LAY) = 1.E-20_JPRB * P_WKL(1,I_LAY) |
128 |
|
1502928 |
P_COLCO2(I_LAY) = 1.E-20_JPRB * P_WKL(2,I_LAY) |
129 |
|
1502928 |
P_COLO3(I_LAY) = 1.E-20_JPRB * P_WKL(3,I_LAY) |
130 |
|
1502928 |
P_COLN2O(I_LAY) = 1.E-20_JPRB * P_WKL(4,I_LAY) |
131 |
|
1502928 |
P_COLCH4(I_LAY) = 1.E-20_JPRB * P_WKL(6,I_LAY) |
132 |
|
1502928 |
P_COLO2(I_LAY) = 1.E-20_JPRB * P_WKL(7,I_LAY) |
133 |
✗✓ |
1502928 |
IF (P_COLCO2(I_LAY) == 0.0_JPRB) P_COLCO2(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
134 |
✗✓ |
1502928 |
IF (P_COLN2O(I_LAY) == 0.0_JPRB) P_COLN2O(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
135 |
✗✓ |
1502928 |
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 |
|
1502928 |
Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(I_LAY) |
138 |
|
|
P_CO2MULT(I_LAY)= (P_COLCO2(I_LAY) - Z_CO2REG) *& |
139 |
|
1502928 |
& 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 |
|
1288224 |
P_FORFAC(I_LAY) = Z_SCALEFAC / (1.0_JPRB+Z_WATER) |
148 |
|
|
|
149 |
|
1288224 |
P_COLH2O(I_LAY) = 1.E-20_JPRB * P_WKL(1,I_LAY) |
150 |
|
1288224 |
P_COLCO2(I_LAY) = 1.E-20_JPRB * P_WKL(2,I_LAY) |
151 |
|
1288224 |
P_COLO3(I_LAY) = 1.E-20_JPRB * P_WKL(3,I_LAY) |
152 |
|
1288224 |
P_COLN2O(I_LAY) = 1.E-20_JPRB * P_WKL(4,I_LAY) |
153 |
|
1288224 |
P_COLCH4(I_LAY) = 1.E-20_JPRB * P_WKL(6,I_LAY) |
154 |
|
1288224 |
P_COLO2(I_LAY) = 1.E-20_JPRB * P_WKL(7,I_LAY) |
155 |
✗✓ |
1288224 |
IF (P_COLCO2(I_LAY) == 0.0_JPRB) P_COLCO2(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
156 |
✗✓ |
1288224 |
IF (P_COLN2O(I_LAY) == 0.0_JPRB) P_COLN2O(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
157 |
✗✓ |
1288224 |
IF (P_COLCH4(I_LAY) == 0.0_JPRB) P_COLCH4(I_LAY) = 1.E-32_JPRB * P_COLDRY(I_LAY) |
158 |
|
1288224 |
Z_CO2REG = 3.55E-24_JPRB * P_COLDRY(I_LAY) |
159 |
|
|
P_CO2MULT(I_LAY)= (P_COLCO2(I_LAY) - Z_CO2REG) *& |
160 |
|
1288224 |
& 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 |
|
2791152 |
Z_COMPFP = 1.0_JPRB - Z_FP |
173 |
|
2791152 |
P_FAC10(I_LAY) = Z_COMPFP * Z_FT |
174 |
|
2791152 |
P_FAC00(I_LAY) = Z_COMPFP * (1.0_JPRB - Z_FT) |
175 |
|
2791152 |
P_FAC11(I_LAY) = Z_FP * Z_FT1 |
176 |
|
2862720 |
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 |
✓✓ |
71568 |
IF (K_LAYLOW == 0) K_LAYLOW=1 |
183 |
|
|
|
184 |
✓✗ |
71568 |
IF (LHOOK) CALL DR_HOOK('RRTM_SETCOEF_140GP',1,ZHOOK_HANDLE) |
185 |
|
71568 |
END SUBROUTINE RRTM_SETCOEF_140GP |