GCC Code Coverage Report


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