1 |
|
|
!*************************************************************************** |
2 |
|
1 |
SUBROUTINE RRTM_INIT_140GP |
3 |
|
|
!*************************************************************************** |
4 |
|
|
! Reformatted for F90 by JJMorcrette, ECMWF, 980714 |
5 |
|
|
|
6 |
|
|
! Parameters |
7 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
8 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
9 |
|
|
|
10 |
|
|
USE PARRRTM , ONLY : JPBAND ,JPG ,JPGPT |
11 |
|
|
USE YOERRTWN , ONLY : NG |
12 |
|
|
USE YOERRTFTR, ONLY : NGC ,NGN ,NGM , WT |
13 |
|
|
! Output |
14 |
|
|
USE YOERRTBG2, ONLY : CORR1 ,CORR2 |
15 |
|
|
USE YOERRTRWT, ONLY : FREFA ,FREFB ,FREFADF ,FREFBDF ,RWGT |
16 |
|
|
|
17 |
|
|
|
18 |
|
|
IMPLICIT NONE |
19 |
|
|
REAL(KIND=JPRB) :: Z_WTSM(JPG) |
20 |
|
|
|
21 |
|
|
INTEGER(KIND=JPIM) :: I, IBND, IG, IGC, IGCSM, IND, IPR, IPRSM, IPT |
22 |
|
|
|
23 |
|
|
REAL(KIND=JPRB) :: Z_FP, Z_RTFP, Z_WTSUM |
24 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
25 |
|
|
|
26 |
|
|
#include "rrtm_kgb1.intfb.h" |
27 |
|
|
#include "rrtm_kgb10.intfb.h" |
28 |
|
|
#include "rrtm_kgb11.intfb.h" |
29 |
|
|
#include "rrtm_kgb12.intfb.h" |
30 |
|
|
#include "rrtm_kgb13.intfb.h" |
31 |
|
|
#include "rrtm_kgb14.intfb.h" |
32 |
|
|
#include "rrtm_kgb15.intfb.h" |
33 |
|
|
#include "rrtm_kgb16.intfb.h" |
34 |
|
|
#include "rrtm_kgb2.intfb.h" |
35 |
|
|
#include "rrtm_kgb3.intfb.h" |
36 |
|
|
#include "rrtm_kgb4.intfb.h" |
37 |
|
|
#include "rrtm_kgb5.intfb.h" |
38 |
|
|
#include "rrtm_kgb6.intfb.h" |
39 |
|
|
#include "rrtm_kgb7.intfb.h" |
40 |
|
|
#include "rrtm_kgb8.intfb.h" |
41 |
|
|
#include "rrtm_kgb9.intfb.h" |
42 |
|
|
|
43 |
|
|
#include "rrtm_cmbgb1.intfb.h" |
44 |
|
|
#include "rrtm_cmbgb10.intfb.h" |
45 |
|
|
#include "rrtm_cmbgb11.intfb.h" |
46 |
|
|
#include "rrtm_cmbgb12.intfb.h" |
47 |
|
|
#include "rrtm_cmbgb13.intfb.h" |
48 |
|
|
#include "rrtm_cmbgb14.intfb.h" |
49 |
|
|
#include "rrtm_cmbgb15.intfb.h" |
50 |
|
|
#include "rrtm_cmbgb16.intfb.h" |
51 |
|
|
#include "rrtm_cmbgb2.intfb.h" |
52 |
|
|
#include "rrtm_cmbgb3.intfb.h" |
53 |
|
|
#include "rrtm_cmbgb4.intfb.h" |
54 |
|
|
#include "rrtm_cmbgb5.intfb.h" |
55 |
|
|
#include "rrtm_cmbgb6.intfb.h" |
56 |
|
|
#include "rrtm_cmbgb7.intfb.h" |
57 |
|
|
#include "rrtm_cmbgb8.intfb.h" |
58 |
|
|
#include "rrtm_cmbgb9.intfb.h" |
59 |
|
|
|
60 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',0,ZHOOK_HANDLE) |
61 |
|
|
|
62 |
|
|
! Read the absorption-related coefficients over the 16 x 16 g-points |
63 |
|
|
|
64 |
|
1 |
CALL RRTM_KGB1 |
65 |
|
1 |
CALL RRTM_KGB2 |
66 |
|
1 |
CALL RRTM_KGB3 |
67 |
|
1 |
CALL RRTM_KGB4 |
68 |
|
1 |
CALL RRTM_KGB5 |
69 |
|
1 |
CALL RRTM_KGB6 |
70 |
|
1 |
CALL RRTM_KGB7 |
71 |
|
1 |
CALL RRTM_KGB8 |
72 |
|
1 |
CALL RRTM_KGB9 |
73 |
|
1 |
CALL RRTM_KGB10 |
74 |
|
1 |
CALL RRTM_KGB11 |
75 |
|
1 |
CALL RRTM_KGB12 |
76 |
|
1 |
CALL RRTM_KGB13 |
77 |
|
1 |
CALL RRTM_KGB14 |
78 |
|
1 |
CALL RRTM_KGB15 |
79 |
|
1 |
CALL RRTM_KGB16 |
80 |
|
|
|
81 |
|
|
! Calculate lookup tables for functions needed in routine TAUMOL (TAUGB2) |
82 |
|
|
|
83 |
|
|
! FH 2017/05/03 |
84 |
|
|
! Ce facteur de correction CORR2 est vraiment bizare parce qu'on |
85 |
|
|
! impose 1. aux bornes, en I=1 et I=200 mais la fonction |
86 |
|
|
! CORE=( 1 - sqrt(i/im) ) / ( 1 - i/im ) = 1/ ( 1 + sqrt(i/im)) |
87 |
|
|
! vaut 1 en i=1 et 1/2 en i=im ... |
88 |
|
|
|
89 |
|
1 |
CORR1(0) = 1.0_JPRB |
90 |
|
1 |
CORR1(200) = 1.0_JPRB |
91 |
|
1 |
CORR2(0) = 1.0_JPRB |
92 |
|
1 |
CORR2(200) = 1.0_JPRB |
93 |
✓✓ |
200 |
DO I = 1,199 |
94 |
|
199 |
Z_FP = 0.005_JPRB*REAL(I) |
95 |
|
199 |
Z_RTFP = SQRT(Z_FP) |
96 |
|
199 |
CORR1(I) = Z_RTFP/Z_FP |
97 |
|
200 |
CORR2(I) = (1.0_JPRB-Z_RTFP)/(1.0_JPRB-Z_FP) |
98 |
|
|
ENDDO |
99 |
|
|
|
100 |
|
|
! Perform g-point reduction from 16 per band (256 total points) to |
101 |
|
|
! a band dependant number (140 total points) for all absorption |
102 |
|
|
! coefficient input data and Planck fraction input data. |
103 |
|
|
! Compute relative weighting for new g-point combinations. |
104 |
|
|
|
105 |
|
|
IGCSM = 0 |
106 |
✓✓ |
17 |
DO IBND = 1,JPBAND |
107 |
|
|
IPRSM = 0 |
108 |
✓✓ |
17 |
IF (NGC(IBND) < 16) THEN |
109 |
✓✓ |
122 |
DO IGC = 1,NGC(IBND) |
110 |
|
108 |
IGCSM = IGCSM + 1 |
111 |
|
|
Z_WTSUM = 0.0_JPRB |
112 |
✓✓ |
332 |
DO IPR = 1, NGN(IGCSM) |
113 |
|
224 |
IPRSM = IPRSM + 1 |
114 |
|
332 |
Z_WTSUM = Z_WTSUM + WT(IPRSM) |
115 |
|
|
ENDDO |
116 |
|
122 |
Z_WTSM(IGC) = Z_WTSUM |
117 |
|
|
ENDDO |
118 |
✓✓ |
238 |
DO IG = 1,NG(IBND) |
119 |
|
224 |
IND = (IBND-1)*16 + IG |
120 |
|
238 |
RWGT(IND) = WT(IG)/Z_WTSM(NGM(IND)) |
121 |
|
|
ENDDO |
122 |
|
|
ELSE |
123 |
✓✓ |
34 |
DO IG = 1,NG(IBND) |
124 |
|
32 |
IGCSM = IGCSM + 1 |
125 |
|
32 |
IND = (IBND-1)*16 + IG |
126 |
|
34 |
RWGT(IND) = 1.0_JPRB |
127 |
|
|
ENDDO |
128 |
|
|
ENDIF |
129 |
|
|
ENDDO |
130 |
|
|
|
131 |
|
|
! Initialize arrays for combined Planck fraction data. |
132 |
|
|
|
133 |
✓✓ |
14 |
DO IPT = 1,13 |
134 |
✓✓ |
1834 |
DO IPR = 1, JPGPT |
135 |
|
1820 |
FREFA(IPR,IPT) = 0.0_JPRB |
136 |
|
1833 |
FREFADF(IPR,IPT) = 0.0_JPRB |
137 |
|
|
ENDDO |
138 |
|
|
ENDDO |
139 |
✓✓ |
7 |
DO IPT = 1,6 |
140 |
✓✓ |
847 |
DO IPR = 1, JPGPT |
141 |
|
840 |
FREFB(IPR,IPT) = 0.0_JPRB |
142 |
|
846 |
FREFBDF(IPR,IPT) = 0.0_JPRB |
143 |
|
|
ENDDO |
144 |
|
|
ENDDO |
145 |
|
|
|
146 |
|
|
! Reduce g-points for relevant data in each LW spectral band. |
147 |
|
|
|
148 |
|
1 |
CALL RRTM_CMBGB1 |
149 |
|
1 |
CALL RRTM_CMBGB2 |
150 |
|
1 |
CALL RRTM_CMBGB3 |
151 |
|
1 |
CALL RRTM_CMBGB4 |
152 |
|
1 |
CALL RRTM_CMBGB5 |
153 |
|
1 |
CALL RRTM_CMBGB6 |
154 |
|
1 |
CALL RRTM_CMBGB7 |
155 |
|
1 |
CALL RRTM_CMBGB8 |
156 |
|
1 |
CALL RRTM_CMBGB9 |
157 |
|
1 |
CALL RRTM_CMBGB10 |
158 |
|
1 |
CALL RRTM_CMBGB11 |
159 |
|
1 |
CALL RRTM_CMBGB12 |
160 |
|
1 |
CALL RRTM_CMBGB13 |
161 |
|
1 |
CALL RRTM_CMBGB14 |
162 |
|
1 |
CALL RRTM_CMBGB15 |
163 |
|
1 |
CALL RRTM_CMBGB16 |
164 |
|
|
|
165 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('RRTM_INIT_140GP',1,ZHOOK_HANDLE) |
166 |
|
1 |
END SUBROUTINE RRTM_INIT_140GP |